[pdl] 01/05: Imported Upstream version 2.007
Andreas Tille
tille at debian.org
Fri Jan 15 12:44:36 UTC 2016
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository pdl.
commit 3d4ed1b83c9bbc652276e697118eebac7a3a0a2d
Author: Andreas Tille <tille at debian.org>
Date: Fri Jan 15 13:22:38 2016 +0100
Imported Upstream version 2.007
---
Basic/AutoLoader.pm | 312 +
Basic/Bad/Makefile.PL | 48 +
Basic/Bad/bad.pd | 1460 ++
Basic/Complex/Makefile.PL | 19 +
Basic/Complex/complex.pd | 1295 ++
Basic/Constants.pm | 84 +
Basic/Core/Basic.pm | 776 +
Basic/Core/Char.pm | 320 +
Basic/Core/Core.pm.PL | 4259 ++++
Basic/Core/Core.xs.PL | 1723 ++
Basic/Core/Dbg.pm | 170 +
Basic/Core/Dev.pm | 701 +
Basic/Core/Exporter.pm | 84 +
Basic/Core/Makefile.PL | 306 +
Basic/Core/Types.pm.PL | 761 +
Basic/Core/pdl.h.PL | 429 +
Basic/Core/pdl_hfiles.p | 43 +
Basic/Core/pdlapi.c | 1601 ++
Basic/Core/pdlconv.c.PL | 351 +
Basic/Core/pdlcore.c.PL | 1360 ++
Basic/Core/pdlcore.h.PL | 389 +
Basic/Core/pdlhash.c | 87 +
Basic/Core/pdlmagic.c | 541 +
Basic/Core/pdlmagic.h | 140 +
Basic/Core/pdlsections.g | 264 +
Basic/Core/pdlsimple.h.PL | 59 +
Basic/Core/pdltest.c | 49 +
Basic/Core/pdlthread.c | 708 +
Basic/Core/pdlthread.h | 84 +
Basic/Core/ppport.h | 6437 ++++++
Basic/Core/typemap | 26 +
Basic/Core/typemap.pdl | 26 +
Basic/Gen/Inline/MakePdlppInstallable.pm | 76 +
Basic/Gen/Inline/Makefile.PL | 8 +
Basic/Gen/Inline/Pdlpp.pm | 779 +
Basic/Gen/Makefile.PL | 82 +
Basic/Gen/PP.pm | 3590 ++++
Basic/Gen/PP/CType.pm | 182 +
Basic/Gen/PP/Dims.pm | 82 +
Basic/Gen/PP/PDLCode.pm | 1325 ++
Basic/Gen/PP/PdlParObj.pm | 469 +
Basic/Gen/PP/Signature.pm | 142 +
Basic/Gen/PP/Struct.pm | 5 +
Basic/Gen/PP/SymTab.pm | 71 +
Basic/Gen/PP/Var.pm | 13 +
Basic/Gen/PP/XS.pm | 17 +
Basic/Gen/PP/dump.pp | 101 +
Basic/Gen/pptemplate.PL | 196 +
Basic/Lite.pm | 52 +
Basic/LiteF.pm | 59 +
Basic/Lvalue.pm | 92 +
Basic/Makefile.PL | 51 +
Basic/Math/Makefile.PL | 176 +
Basic/Math/NOTES | 41 +
Basic/Math/acosh.c | 105 +
Basic/Math/asinh.c | 106 +
Basic/Math/atanh.c | 95 +
Basic/Math/const.c | 80 +
Basic/Math/cpoly.c | 819 +
Basic/Math/cpoly.h | 14 +
Basic/Math/infinity.c | 10 +
Basic/Math/j0.c | 261 +
Basic/Math/j1.c | 234 +
Basic/Math/jn.c | 123 +
Basic/Math/math.pd | 446 +
Basic/Math/mconf.h | 180 +
Basic/Math/mtherr.c | 102 +
Basic/Math/ndtr.c | 301 +
Basic/Math/ndtri.c | 184 +
Basic/Math/polevl.c | 98 +
Basic/Math/protos.h | 45 +
Basic/Math/quiet_nan.c | 12 +
Basic/Math/rint.c | 42 +
Basic/Math/yn.c | 113 +
Basic/Matrix.pm | 446 +
Basic/MatrixOps/Makefile.PL | 20 +
Basic/MatrixOps/NOTES | 28 +
Basic/MatrixOps/README.ssl | 37 +
Basic/MatrixOps/blas.c | 157 +
Basic/MatrixOps/complex.c | 70 +
Basic/MatrixOps/complex.h | 35 +
Basic/MatrixOps/eigen.c | 938 +
Basic/MatrixOps/eigen.h | 27 +
Basic/MatrixOps/eigens.c | 178 +
Basic/MatrixOps/matrix.c | 544 +
Basic/MatrixOps/matrix.h | 51 +
Basic/MatrixOps/matrixops.pd | 1438 ++
Basic/MatrixOps/protos.h | 45 +
Basic/MatrixOps/simq.c | 177 +
Basic/MatrixOps/sslib.c | 45 +
Basic/MatrixOps/sslib.h | 42 +
Basic/MatrixOps/svd.c | 145 +
Basic/Ops/Makefile.PL | 22 +
Basic/Ops/ops.pd | 389 +
Basic/Options.pm | 1010 +
Basic/PDL.pm | 213 +
Basic/Pod/API.pod | 442 +
Basic/Pod/BadValues.pod | 744 +
Basic/Pod/Course.pod | 492 +
Basic/Pod/Dataflow.pod | 261 +
Basic/Pod/Delta.pod | 63 +
Basic/Pod/FAQ.pod | 1585 ++
Basic/Pod/Index.pod | 615 +
Basic/Pod/Indexing.pod | 1563 ++
Basic/Pod/Internals.pod | 605 +
Basic/Pod/MATLAB.pod | 874 +
Basic/Pod/Makefile.PL | 50 +
Basic/Pod/Modules.pod | 483 +
Basic/Pod/Objects.pod | 114 +
Basic/Pod/PP.pod | 2447 +++
Basic/Pod/ParallelCPU.pod | 157 +
Basic/Pod/Philosophy.pod | 148 +
Basic/Pod/QuickStart.pod | 615 +
Basic/Pod/Scilab.pod | 813 +
Basic/Pod/Threading.pod | 961 +
Basic/Pod/Tips.pod | 130 +
Basic/Pod/Tutorials.pod | 131 +
Basic/Primitive/Makefile.PL | 58 +
Basic/Primitive/primitive.pd | 3397 +++
Basic/Reduce.pm | 197 +
Basic/Slices/Makefile.PL | 20 +
Basic/Slices/slices.pd | 3579 ++++
Basic/SourceFilter/Changes | 41 +
Basic/SourceFilter/FilterSimple.pm | 17 +
Basic/SourceFilter/FilterUtilCall.pm | 53 +
Basic/SourceFilter/Makefile.PL | 26 +
Basic/SourceFilter/ModuleCompile.pm | 11 +
Basic/SourceFilter/NiceSlice.pm | 1124 +
Basic/SourceFilter/example | 44 +
Basic/SourceFilter/local.perldlrc | 31 +
Basic/Test/Makefile.PL | 19 +
Basic/Test/tests.pd | 149 +
Basic/Ufunc/Makefile.PL | 50 +
Basic/Ufunc/ufunc.pd | 1461 ++
Basic/default.perldlrc | 39 +
Bugs.pod | 177 +
COPYING | 63 +
Changes | 25180 +++++++++++++++++++++++
Changes_CVS | 3983 ++++
DEPENDENCIES | 251 +
DEVELOPMENT | 194 +
Demos/BAD2_demo.pm.PL | 168 +
Demos/BAD_demo.pm.PL | 239 +
Demos/Cartography_demo.pm | 178 +
Demos/General.pm | 168 +
Demos/Gnuplot_demo.pm | 332 +
Demos/Makefile.PL | 43 +
Demos/PGPLOT_OO_demo.pm | 134 +
Demos/PGPLOT_demo.pm | 223 +
Demos/Prima.pm | 618 +
Demos/Screen.pm | 62 +
Demos/Transform_demo.pm | 335 +
Demos/TriD/mandel.pl | 52 +
Demos/TriD/test3.p | 121 +
Demos/TriD/test4.p | 75 +
Demos/TriD/test5.p | 56 +
Demos/TriD/test7.p | 29 +
Demos/TriD/test8.p | 114 +
Demos/TriD/test9.p | 26 +
Demos/TriD/testimg.p | 30 +
Demos/TriD/testvib.p | 111 +
Demos/TriD/tmathgraph.p | 54 +
Demos/TriD/tvrml.p | 56 +
Demos/TriD/tvrml2.p | 72 +
Demos/TriD1.pm | 155 +
Demos/TriD2.pm | 121 +
Demos/TriDGallery.pm | 207 +
Demos/earth-interp.pl | 63 +
Demos/earth.txt | 18826 +++++++++++++++++
Doc/Doc.pm | 938 +
Doc/Doc/Config.pm.PL | 43 +
Doc/Doc/Perldl.pm | 701 +
Doc/Makefile.PL | 27 +
Doc/README | 106 +
Doc/TODO | 9 +
Doc/mkhtmldoc.pl | 309 +
Doc/mkpdlfuncpod | 93 +
Doc/scantree.pl | 130 +
Example/Benchmark/Bench.pm | 39 +
Example/Benchmark/Bench.xs | 58 +
Example/Benchmark/Makefile.PL | 10 +
Example/Benchmark/README | 6 +
Example/Benchmark/time.pl | 11 +
Example/Fit/lmfit_example.pl | 87 +
Example/IO/wmpeg.pl | 62 +
Example/InlinePdlpp/Module/Makefile.PL | 8 +
Example/InlinePdlpp/Module/MyInlineMod.pm | 119 +
Example/InlinePdlpp/Module/t/myinlinemod.t | 33 +
Example/InlinePdlpp/inlpp.pl | 29 +
Example/InlinePdlpp/inlpp_link.pl | 39 +
Example/InlinePdlpp/inlppminimal.pl | 22 +
Example/PGPLOT/pgplot.pl | 278 +
Example/PGPLOT/std_pgplot.pl | 173 +
Example/PLplot/refresh.pdl | 190 +
Example/Simplex/tsimp2.pl | 71 +
Example/Simplex/tsimp_needs_pgplot.pl | 50 +
Example/TriD/3dtest.pl | 18 +
Example/TriD/line3d.pl | 19 +
Example/TriD/old_trid_clip.pl | 111 +
Graphics/Graphics2D.pm | 984 +
Graphics/IIS/Makefile.PL | 39 +
Graphics/IIS/iis.pd | 655 +
Graphics/IIS/libiis.h | 154 +
Graphics/IIS/pdliisdisp.c | 390 +
Graphics/LUT/LUT.pm | 241 +
Graphics/LUT/Makefile.PL | 10 +
Graphics/LUT/README | 5 +
Graphics/LUT/ramps/Makefile.PL | 21 +
Graphics/LUT/ramps/equa.fits | Bin 0 -> 5760 bytes
Graphics/LUT/ramps/expo.fits | Bin 0 -> 5760 bytes
Graphics/LUT/ramps/gamma.fits | Bin 0 -> 5760 bytes
Graphics/LUT/ramps/jigsaw.fits | Bin 0 -> 5760 bytes
Graphics/LUT/ramps/lasritt.fits | Bin 0 -> 5760 bytes
Graphics/LUT/ramps/log.fits | Bin 0 -> 5760 bytes
Graphics/LUT/ramps/neg.fits | Bin 0 -> 5760 bytes
Graphics/LUT/ramps/neglog.fits | Bin 0 -> 5760 bytes
Graphics/LUT/ramps/null.fits | Bin 0 -> 5760 bytes
Graphics/LUT/ramps/ramp.fits | Bin 0 -> 5760 bytes
Graphics/LUT/ramps/stairs.fits | Bin 0 -> 5760 bytes
Graphics/LUT/tables/Makefile.PL | 21 +
Graphics/LUT/tables/aips0.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/backgr.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/bgyrw.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/blue.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/blulut.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/color.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/green.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/heat.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/idl11.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/idl12.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/idl14.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/idl15.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/idl2.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/idl4.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/idl5.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/idl6.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/isophot.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/light.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/manycol.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/pastel.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/rainbow.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/rainbow1.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/rainbow2.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/rainbow3.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/rainbow4.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/ramp.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/random.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/random1.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/random2.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/random3.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/random4.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/random5.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/random6.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/real.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/red.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/smooth.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/smooth1.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/smooth2.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/smooth3.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/staircase.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/stairs8.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/stairs9.fits | Bin 0 -> 8640 bytes
Graphics/LUT/tables/standard.fits | Bin 0 -> 8640 bytes
Graphics/Limits/Limits.pm | 1464 ++
Graphics/Limits/Makefile.PL | 15 +
Graphics/Makefile.PL | 45 +
Graphics/PGPLOT/Makefile.PL | 16 +
Graphics/PGPLOT/PGPLOT.pm | 589 +
Graphics/PGPLOT/PGPLOTOptions.pm | 413 +
Graphics/PGPLOT/Window/Makefile.PL | 16 +
Graphics/PGPLOT/Window/Window.pm | 7097 +++++++
Graphics/PGPLOT/Window/Window.xs | 118 +
Graphics/PGPLOT/Window/typemap | 8 +
Graphics/PLplot/Changes | 104 +
Graphics/PLplot/Makefile.PL | 279 +
Graphics/PLplot/README | 77 +
Graphics/PLplot/plplot.pd | 5263 +++++
Graphics/State.pm | 141 +
Graphics/TriD/Makefile.PL | 35 +
Graphics/TriD/OpenGLQ/Makefile.PL | 41 +
Graphics/TriD/OpenGLQ/openglq.pd | 322 +
Graphics/TriD/POGL/MANIFEST | 6 +
Graphics/TriD/POGL/Makefile.PL | 19 +
Graphics/TriD/POGL/OpenGL.pm | 437 +
Graphics/TriD/POGL/README | 40 +
Graphics/TriD/POGL/ignore.txt | 10 +
Graphics/TriD/POGL/t/00-load.t | 7 +
Graphics/TriD/Rout/Makefile.PL | 16 +
Graphics/TriD/Rout/rout.pd | 491 +
Graphics/TriD/TriD.pm | 1076 +
Graphics/TriD/TriD/ArcBall.pm | 122 +
Graphics/TriD/TriD/ButtonControl.pm | 126 +
Graphics/TriD/TriD/Contours.pm | 333 +
Graphics/TriD/TriD/Control3D.pm | 65 +
Graphics/TriD/TriD/GL.pm | 1178 ++
Graphics/TriD/TriD/GoBoard.pm | 100 +
Graphics/TriD/TriD/Graph.pm | 416 +
Graphics/TriD/TriD/Image.pm | 141 +
Graphics/TriD/TriD/Labels.pm | 61 +
Graphics/TriD/TriD/Lines.pm | 61 +
Graphics/TriD/TriD/Logo.pm | 481 +
Graphics/TriD/TriD/MathGraph.pm | 177 +
Graphics/TriD/TriD/Mesh.pm | 208 +
Graphics/TriD/TriD/OOGL.pm | 44 +
Graphics/TriD/TriD/Object.pm | 110 +
Graphics/TriD/TriD/Objects.pm | 306 +
Graphics/TriD/TriD/Polygonize.pm | 134 +
Graphics/TriD/TriD/Quaternion.pm | 174 +
Graphics/TriD/TriD/SimpleScaler.pm | 59 +
Graphics/TriD/TriD/Surface.pm | 48 +
Graphics/TriD/TriD/TextObjects.pm | 19 +
Graphics/TriD/TriD/VRML.pm | 761 +
Graphics/TriD/TriD/ViewPort.pm | 118 +
Graphics/TriD/TriD/Window.pm | 249 +
Graphics/TriD/VRML/Makefile.PL | 7 +
Graphics/TriD/VRML/VRML.pm | 346 +
Graphics/TriD/VRML/VRML/Protos.pm | 55 +
INSTALL | 217 +
INTERNATIONALIZATION | 11 +
IO/Browser/Makefile.PL | 72 +
IO/Browser/browse.c | 408 +
IO/Browser/browser.pd | 66 +
IO/Browser/hints/dec_osf.pl | 10 +
IO/Dicom/Dicom.pm | 388 +
IO/Dicom/Makefile.PL | 14 +
IO/Dumper.pm | 630 +
IO/ENVI/readenvi.pdl | 344 +
IO/FITS/FITS.pm | 2862 +++
IO/FITS/Makefile.PL | 52 +
IO/FastRaw/FastRaw.pm | 462 +
IO/FastRaw/Makefile.PL | 7 +
IO/FlexRaw/FlexRaw.pm | 864 +
IO/FlexRaw/Makefile.PL | 7 +
IO/GD/Changes | 18 +
IO/GD/GD.pd | 2291 +++
IO/GD/Makefile.PL | 159 +
IO/GD/TODO | 10 +
IO/GD/typemap | 11 +
IO/HDF/Changes | 76 +
IO/HDF/HDF.pm | 300 +
IO/HDF/Makefile.PL | 191 +
IO/HDF/SD/Changes | 3 +
IO/HDF/SD/MANIFEST | 3 +
IO/HDF/SD/Makefile.PL | 29 +
IO/HDF/SD/SD.pd | 1618 ++
IO/HDF/TODO | 39 +
IO/HDF/VS/Changes | 3 +
IO/HDF/VS/MANIFEST | 3 +
IO/HDF/VS/Makefile.PL | 30 +
IO/HDF/VS/VS.pd | 793 +
IO/HDF/buildfunc.pm | 114 +
IO/HDF/typemap | 55 +
IO/IDL/IDL.pm | 870 +
IO/IDL/Makefile.PL | 14 +
IO/IDL/README | 56 +
IO/IO.pod | 290 +
IO/Makefile.PL | 28 +
IO/Misc/Makefile.PL | 20 +
IO/Misc/misc.pd | 1589 ++
IO/Pnm/Makefile.PL | 20 +
IO/Pnm/Pic.pm | 1024 +
IO/Pnm/pnm.pd | 620 +
IO/Storable/Makefile.PL | 22 +
IO/Storable/storable.pd | 193 +
Known_problems | 138 +
Lib/CallExt/CallExt.pm | 242 +
Lib/CallExt/CallExt.xs | 65 +
Lib/CallExt/Makefile.PL | 14 +
Lib/Compression/Makefile.PL | 14 +
Lib/Compression/compression.pd | 256 +
Lib/Compression/ricecomp.c | 696 +
Lib/DiskCache.pm | 422 +
Lib/FFT/Makefile.PL | 21 +
Lib/FFT/fft.pd | 609 +
Lib/FFT/fftn.c | 1208 ++
Lib/FFT/fftn.h | 115 +
Lib/Filter/LinPred.pm | 286 +
Lib/Filter/Linear.pm | 90 +
Lib/Filter/Makefile.PL | 11 +
Lib/Fit/Gaussian/Makefile.PL | 21 +
Lib/Fit/Gaussian/gauss.c | 464 +
Lib/Fit/Gaussian/gaussian.pd | 216 +
Lib/Fit/LM.pm | 314 +
Lib/Fit/Linfit.pm | 166 +
Lib/Fit/Makefile.PL | 11 +
Lib/Fit/Polynomial.pm | 154 +
Lib/Func.pm | 948 +
Lib/GIS/Makefile.PL | 9 +
Lib/GIS/Proj/Makefile.PL | 207 +
Lib/GIS/Proj/Proj.pd | 699 +
Lib/GIS/Proj/README | 53 +
Lib/GIS/Proj/TODO | 5 +
Lib/GIS/Proj/include/projects.h | 476 +
Lib/GSL/DIFF/FUNC.c | 41 +
Lib/GSL/DIFF/Makefile.PL | 76 +
Lib/GSL/DIFF/gsl_diff.pd | 174 +
Lib/GSL/INTEG/FUNC.c | 55 +
Lib/GSL/INTEG/Makefile.PL | 76 +
Lib/GSL/INTEG/gsl_integ.pd | 979 +
Lib/GSL/INTERP/Makefile.PL | 83 +
Lib/GSL/INTERP/gsl_interp.pd | 456 +
Lib/GSL/INTERP/gslerr.h | 7 +
Lib/GSL/INTERP/typemap | 3 +
Lib/GSL/MROOT/FUNC.c | 222 +
Lib/GSL/MROOT/Makefile.PL | 110 +
Lib/GSL/MROOT/gsl_mroot.pd | 132 +
Lib/GSL/Makefile.PL | 69 +
Lib/GSL/RNG/Makefile.PL | 70 +
Lib/GSL/RNG/README | 10 +
Lib/GSL/RNG/gsl_random.pd | 1273 ++
Lib/GSL/RNG/typemap | 12 +
Lib/GSL/SF/Makefile.PL | 60 +
Lib/GSL/SF/README | 14 +
Lib/GSL/SF/airy/Makefile.PL | 21 +
Lib/GSL/SF/airy/gsl_sf_airy.pd | 138 +
Lib/GSL/SF/bessel/Makefile.PL | 21 +
Lib/GSL/SF/bessel/gsl_sf_bessel.pd | 364 +
Lib/GSL/SF/clausen/Makefile.PL | 21 +
Lib/GSL/SF/clausen/gsl_sf_clausen.pd | 53 +
Lib/GSL/SF/coulomb/Makefile.PL | 21 +
Lib/GSL/SF/coulomb/gsl_sf_coulomb.pd | 101 +
Lib/GSL/SF/coupling/Makefile.PL | 21 +
Lib/GSL/SF/coupling/gsl_sf_coupling.pd | 78 +
Lib/GSL/SF/dawson/Makefile.PL | 21 +
Lib/GSL/SF/dawson/gsl_sf_dawson.pd | 53 +
Lib/GSL/SF/debye/Makefile.PL | 21 +
Lib/GSL/SF/debye/gsl_sf_debye.pd | 89 +
Lib/GSL/SF/dilog/Makefile.PL | 21 +
Lib/GSL/SF/dilog/gsl_sf_dilog.pd | 69 +
Lib/GSL/SF/elementary/Makefile.PL | 21 +
Lib/GSL/SF/elementary/gsl_sf_elementary.pd | 66 +
Lib/GSL/SF/ellint/Makefile.PL | 21 +
Lib/GSL/SF/ellint/gsl_sf_ellint.pd | 164 +
Lib/GSL/SF/elljac/Makefile.PL | 21 +
Lib/GSL/SF/elljac/gsl_sf_elljac.pd | 50 +
Lib/GSL/SF/erf/Makefile.PL | 21 +
Lib/GSL/SF/erf/gsl_sf_erf.pd | 102 +
Lib/GSL/SF/exp/Makefile.PL | 21 +
Lib/GSL/SF/exp/gsl_sf_exp.pd | 80 +
Lib/GSL/SF/expint/Makefile.PL | 21 +
Lib/GSL/SF/expint/gsl_sf_expint.pd | 153 +
Lib/GSL/SF/fermi_dirac/Makefile.PL | 21 +
Lib/GSL/SF/fermi_dirac/gsl_sf_fermi_dirac.pd | 115 +
Lib/GSL/SF/gamma/Makefile.PL | 21 +
Lib/GSL/SF/gamma/gsl_sf_gamma.pd | 285 +
Lib/GSL/SF/gegenbauer/Makefile.PL | 21 +
Lib/GSL/SF/gegenbauer/gsl_sf_gegenbauer.pd | 65 +
Lib/GSL/SF/gslerr.h | 5 +
Lib/GSL/SF/hyperg/Makefile.PL | 21 +
Lib/GSL/SF/hyperg/gsl_sf_hyperg.pd | 147 +
Lib/GSL/SF/laguerre/Makefile.PL | 21 +
Lib/GSL/SF/laguerre/gsl_sf_laguerre.pd | 55 +
Lib/GSL/SF/legendre/Makefile.PL | 21 +
Lib/GSL/SF/legendre/gsl_sf_legendre.pd | 225 +
Lib/GSL/SF/log/Makefile.PL | 21 +
Lib/GSL/SF/log/gsl_sf_log.pd | 72 +
Lib/GSL/SF/poly/Makefile.PL | 21 +
Lib/GSL/SF/poly/gsl_sf_poly.pd | 56 +
Lib/GSL/SF/pow_int/Makefile.PL | 21 +
Lib/GSL/SF/pow_int/gsl_sf_pow_int.pd | 57 +
Lib/GSL/SF/psi/Makefile.PL | 21 +
Lib/GSL/SF/psi/gsl_sf_psi.pd | 85 +
Lib/GSL/SF/synchrotron/Makefile.PL | 21 +
Lib/GSL/SF/synchrotron/gsl_sf_synchrotron.pd | 67 +
Lib/GSL/SF/transport/Makefile.PL | 21 +
Lib/GSL/SF/transport/gsl_sf_transport.pd | 95 +
Lib/GSL/SF/trig/Makefile.PL | 21 +
Lib/GSL/SF/trig/gsl_sf_trig.pd | 221 +
Lib/GSL/SF/zeta/Makefile.PL | 21 +
Lib/GSL/SF/zeta/gsl_sf_zeta.pd | 79 +
Lib/Image2D/Makefile.PL | 36 +
Lib/Image2D/image2d.pd | 2417 +++
Lib/Image2D/resample.c | 362 +
Lib/Image2D/resample.h | 41 +
Lib/Image2D/rotate.c | 250 +
Lib/ImageND/Makefile.PL | 10 +
Lib/ImageND/imagend.pd | 857 +
Lib/ImageRGB/Makefile.PL | 20 +
Lib/ImageRGB/imagergb.pd | 267 +
Lib/ImageRGB/pdlppm.h | 5 +
Lib/ImageRGB/ppm_quant.c | 672 +
Lib/Interpolate/Interpolate.pm | 580 +
Lib/Interpolate/Makefile.PL | 8 +
Lib/Interpolate/Slatec/Makefile.PL | 29 +
Lib/Interpolate/Slatec/Slatec.pm | 421 +
Lib/Makefile.PL | 17 +
Lib/Minuit/FCN.c | 140 +
Lib/Minuit/Makefile.PL | 179 +
Lib/Minuit/minuit.pd | 655 +
Lib/Minuit/minuitlib/futils.f | 17 +
Lib/Minuit/minuitlib/intracfalse.f | 7 +
Lib/Minuit/minuitlib/minuit.f | 7842 +++++++
Lib/Opt/Makefile.PL | 15 +
Lib/Opt/Simplex/Makefile.PL | 7 +
Lib/Opt/Simplex/Simplex.pm | 229 +
Lib/Slatec/Makefile.PL | 148 +
Lib/Slatec/slatec.pd | 1691 ++
Lib/Slatec/slatec/chfcm.f | 151 +
Lib/Slatec/slatec/chfdv.f | 165 +
Lib/Slatec/slatec/chfev.f | 155 +
Lib/Slatec/slatec/chfie.f | 108 +
Lib/Slatec/slatec/d1mach.f | 502 +
Lib/Slatec/slatec/dasum.f | 80 +
Lib/Slatec/slatec/daxpy.f | 92 +
Lib/Slatec/slatec/dchfcm.f | 152 +
Lib/Slatec/slatec/dchfdv.f | 170 +
Lib/Slatec/slatec/dchfev.f | 160 +
Lib/Slatec/slatec/dchfie.f | 109 +
Lib/Slatec/slatec/ddot.f | 89 +
Lib/Slatec/slatec/dgeco.f | 207 +
Lib/Slatec/slatec/dgedi.f | 141 +
Lib/Slatec/slatec/dgefa.f | 117 +
Lib/Slatec/slatec/dgesl.f | 136 +
Lib/Slatec/slatec/dp1vlu.f | 151 +
Lib/Slatec/slatec/dpchbs.f | 217 +
Lib/Slatec/slatec/dpchce.f | 247 +
Lib/Slatec/slatec/dpchci.f | 185 +
Lib/Slatec/slatec/dpchcm.f | 237 +
Lib/Slatec/slatec/dpchcs.f | 237 +
Lib/Slatec/slatec/dpchdf.f | 108 +
Lib/Slatec/slatec/dpchfd.f | 324 +
Lib/Slatec/slatec/dpchfe.f | 310 +
Lib/Slatec/slatec/dpchia.f | 269 +
Lib/Slatec/slatec/dpchic.f | 347 +
Lib/Slatec/slatec/dpchid.f | 195 +
Lib/Slatec/slatec/dpchim.f | 283 +
Lib/Slatec/slatec/dpchkt.f | 96 +
Lib/Slatec/slatec/dpchsp.f | 392 +
Lib/Slatec/slatec/dpchst.f | 59 +
Lib/Slatec/slatec/dpchsw.f | 197 +
Lib/Slatec/slatec/dpcoef.f | 78 +
Lib/Slatec/slatec/dpoco.f | 208 +
Lib/Slatec/slatec/dpodi.f | 136 +
Lib/Slatec/slatec/dpofa.f | 83 +
Lib/Slatec/slatec/dpolft.f | 357 +
Lib/Slatec/slatec/dscal.f | 80 +
Lib/Slatec/slatec/dswap.f | 102 +
Lib/Slatec/slatec/ezfft1.f | 89 +
Lib/Slatec/slatec/ezfftb.f | 119 +
Lib/Slatec/slatec/ezfftf.f | 96 +
Lib/Slatec/slatec/ezffti.f | 47 +
Lib/Slatec/slatec/fdump.f | 31 +
Lib/Slatec/slatec/i1mach.f | 888 +
Lib/Slatec/slatec/idamax.f | 82 +
Lib/Slatec/slatec/isamax.f | 82 +
Lib/Slatec/slatec/j4save.f | 65 +
Lib/Slatec/slatec/pchbs.f | 216 +
Lib/Slatec/slatec/pchce.f | 246 +
Lib/Slatec/slatec/pchci.f | 184 +
Lib/Slatec/slatec/pchcm.f | 236 +
Lib/Slatec/slatec/pchcs.f | 235 +
Lib/Slatec/slatec/pchdf.f | 106 +
Lib/Slatec/slatec/pchfd.f | 320 +
Lib/Slatec/slatec/pchfe.f | 308 +
Lib/Slatec/slatec/pchia.f | 265 +
Lib/Slatec/slatec/pchic.f | 341 +
Lib/Slatec/slatec/pchid.f | 190 +
Lib/Slatec/slatec/pchim.f | 280 +
Lib/Slatec/slatec/pchkt.f | 95 +
Lib/Slatec/slatec/pchsp.f | 388 +
Lib/Slatec/slatec/pchst.f | 57 +
Lib/Slatec/slatec/pchsw.f | 192 +
Lib/Slatec/slatec/pcoef.f | 78 +
Lib/Slatec/slatec/polfit.f | 352 +
Lib/Slatec/slatec/pvalue.f | 148 +
Lib/Slatec/slatec/pythag.f | 39 +
Lib/Slatec/slatec/r1mach.f | 419 +
Lib/Slatec/slatec/radb2.f | 61 +
Lib/Slatec/slatec/radb3.f | 85 +
Lib/Slatec/slatec/radb4.f | 109 +
Lib/Slatec/slatec/radb5.f | 132 +
Lib/Slatec/slatec/radbg.f | 189 +
Lib/Slatec/slatec/radf2.f | 61 +
Lib/Slatec/slatec/radf3.f | 83 +
Lib/Slatec/slatec/radf4.f | 105 +
Lib/Slatec/slatec/radf5.f | 128 +
Lib/Slatec/slatec/radfg.f | 194 +
Lib/Slatec/slatec/rfftb.f | 96 +
Lib/Slatec/slatec/rfftb1.f | 143 +
Lib/Slatec/slatec/rfftf.f | 97 +
Lib/Slatec/slatec/rfftf1.f | 144 +
Lib/Slatec/slatec/rs.f | 90 +
Lib/Slatec/slatec/sasum.f | 79 +
Lib/Slatec/slatec/saxpy.f | 92 +
Lib/Slatec/slatec/sdot.f | 89 +
Lib/Slatec/slatec/sgeco.f | 207 +
Lib/Slatec/slatec/sgedi.f | 140 +
Lib/Slatec/slatec/sgefa.f | 117 +
Lib/Slatec/slatec/sgesl.f | 137 +
Lib/Slatec/slatec/snrm2.f | 161 +
Lib/Slatec/slatec/spoco.f | 208 +
Lib/Slatec/slatec/spodi.f | 136 +
Lib/Slatec/slatec/spofa.f | 81 +
Lib/Slatec/slatec/srot.f | 89 +
Lib/Slatec/slatec/srotg.f | 106 +
Lib/Slatec/slatec/sscal.f | 80 +
Lib/Slatec/slatec/ssvdc.f | 487 +
Lib/Slatec/slatec/sswap.f | 102 +
Lib/Slatec/slatec/tql2.f | 203 +
Lib/Slatec/slatec/tqlrat.f | 165 +
Lib/Slatec/slatec/tred1.f | 142 +
Lib/Slatec/slatec/tred2.f | 166 +
Lib/Slatec/slatec/xerbla.f | 55 +
Lib/Slatec/slatec/xercnt.f | 60 +
Lib/Slatec/slatec/xerhlt.f | 39 +
Lib/Slatec/slatec/xermsg.f | 364 +
Lib/Slatec/slatec/xerprn.f | 228 +
Lib/Slatec/slatec/xersve.f | 155 +
Lib/Slatec/slatec/xgetua.f | 51 +
Lib/Transform/Cartography/Cartography.pm | 2935 +++
Lib/Transform/Cartography/Makefile.PL | 11 +
Lib/Transform/Cartography/earth_coast.vec.fits | Bin 0 -> 437760 bytes
Lib/Transform/Cartography/earth_day.jpg | Bin 0 -> 95456 bytes
Lib/Transform/Cartography/earth_night.jpg | Bin 0 -> 55100 bytes
Lib/Transform/Makefile.PL | 13 +
Lib/Transform/Proj4/Makefile.PL | 211 +
Lib/Transform/Proj4/Proj4.pd | 531 +
Lib/Transform/Proj4/README | 53 +
Lib/Transform/Proj4/TODO | 5 +
Lib/Transform/transform.pd | 3912 ++++
MANIFEST | 812 +
MANIFEST.SKIP | 269 +
META.json | 64 +
META.yml | 42 +
Makefile.PL | 816 +
PDLdb.pl | 9550 +++++++++
Perldl2/Makefile.PL | 61 +
Perldl2/Plugin/CleanErrors.pm | 59 +
Perldl2/Plugin/Makefile.PL | 13 +
Perldl2/Plugin/NiceSlice.pm | 75 +
Perldl2/Plugin/PDLCommands.pm | 107 +
Perldl2/Plugin/PrintControl.pm | 94 +
Perldl2/Profile/Makefile.PL | 8 +
Perldl2/Profile/Perldl2.pm | 290 +
Perldl2/README | 141 +
Perldl2/Script.pm | 49 +
Perldl2/TODO | 321 +
Perldl2/pdl2 | 118 +
README | 144 +
Release_Notes | 1782 ++
TODO | 525 +
TestTools/Mem/foobar | 7 +
TestTools/Mem/tmem.pl | 68 +
cygwin/INSTALL | 440 +
cygwin/README | 119 +
cygwin/drivers.list | 114 +
cygwin/g77_gcc.conf | 135 +
debian/README.Debian | 16 +
debian/changelog | 680 +
debian/compat | 1 +
debian/control | 71 +
debian/copyright | 75 +
debian/dh_pdl | 127 +
debian/f77conf.pl | 67 +
debian/fix_man_encoding.sed | 2 +
debian/fix_man_name.sed | 5 +
debian/patches/series | 1 +
debian/pdl.dirs | 3 +
debian/pdl.doc-base | 14 +
debian/pdl.docs | 5 +
debian/pdl.install | 3 +
debian/pdl.links | 4 +
debian/pdl.lintian-overrides | 9 +
debian/pdl.manpages | 1 +
debian/pdl.menu | 5 +
debian/pdl.postinst | 43 +
debian/pdl.prerm | 40 +
debian/pdl.remove | 5 +
debian/pdl.triggers | 1 +
debian/perldl.conf | 255 +
debian/rules | 128 +
debian/source/format | 1 +
debian/write_config_debian.pl | 23 +
inc/Carp.pm | 581 +
inc/Carp/Heavy.pm | 10 +
inc/Devel/CheckLib.pm | 487 +
m51.fits | Bin 0 -> 593280 bytes
macosx/README | 7 +
pdl.PL | 94 +
pdldoc.PL | 221 +
perldl.PL | 1386 ++
perldl.conf | 250 +
t/aaa_load.t | 6 +
t/argtest.t | 54 +
t/autoload.t | 48 +
t/bad.t | 512 +
t/basic.t | 72 +
t/bess.t | 32 +
t/bool.t | 37 +
t/callext.c | 81 +
t/callext.t | 77 +
t/clump.t | 102 +
t/complex.t | 82 +
t/config.t | 29 +
t/constants.t | 19 +
t/constructor.t | 202 +
t/conv.t | 47 +
t/core.t | 214 +
t/croak.t | 54 +
t/diskcache.t | 48 +
t/dumper.t | 92 +
t/erf.t | 30 +
t/erfi.t | 24 +
t/familyfree.t | 31 +
t/fastraw.t | 118 +
t/fft.t | 97 +
t/fits.t | 302 +
t/flexraw.t | 128 +
t/flexraw_fortran.t | 680 +
t/flow.t | 438 +
t/foo.t | 74 +
t/func.pdl | 13 +
t/func.t | 92 +
t/gauss.t | 49 +
t/gd_oo_tests.t | 547 +
t/gd_tests.t | 397 +
t/gis_proj.t | 187 +
t/gsl_diff.t | 46 +
t/gsl_integ.t | 145 +
t/gsl_interp.t | 58 +
t/gsl_mroot.t | 47 +
t/gsl_rng.t | 142 +
t/gsl_sf.t | 35 +
t/hdf_sd.t | 356 +
t/hdf_vdata.t | 180 +
t/hdf_vgroup.t | 107 +
t/hdrs.t | 56 +
t/hist.t | 50 +
t/howbig.t | 21 +
t/ica.t | 126 +
t/image2d.t | 177 +
t/imagend.t | 90 +
t/imagergb.t | 71 +
t/inline-comment-test.t | 110 +
t/inlinepdlpp.t | 56 +
t/interp.t | 51 +
t/interp_slatec.t | 80 +
t/interpol.t | 29 +
t/iotypes.t | 41 +
t/lgamma.t | 49 +
t/limits_00.t | 16 +
t/limits_errb.t | 56 +
t/limits_keyspecs.t | 78 +
t/limits_normalize_dsets.t | 343 +
t/limits_range.t | 53 +
t/limits_round.t | 66 +
t/limits_trans.t | 73 +
t/limits_trans_err.t | 44 +
t/limits_ulimits.t | 232 +
t/linfit.t | 129 +
t/lut.t | 40 +
t/lvalue.t | 28 +
t/magic.t | 58 +
t/matmult.t | 51 +
t/matrix.t | 15 +
t/matrixops.t | 185 +
t/minuit.t | 78 +
t/misc.t | 209 +
t/niceslice.t | 224 +
t/nsdatahandle.t | 19 +
t/ones.t | 31 +
t/opengl.t | 69 +
t/ops.t | 158 +
t/pdl_from_string.t | 569 +
t/pdlchar.t | 64 +
t/pgplot.t | 146 +
t/physical.t | 44 +
t/pic_16bit.t | 70 +
t/picnorgb.t | 136 +
t/picrgb.t | 139 +
t/plplot.t | 543 +
t/plplot_no_fork.win32 | 31 +
t/pnm.t | 97 +
t/poly.t | 44 +
t/polyroots.t | 24 +
t/pp_croaking.t | 31 +
t/pp_line_numbers.t | 62 +
t/pptest.t | 92 +
t/primitive.t | 241 +
t/primitive2.t | 110 +
t/proj_transform.t | 425 +
t/proj_transform2.t | 397 +
t/pthread.t | 140 +
t/pthreadBarf.t | 66 +
t/pthread_auto.t | 126 +
t/reduce.t | 26 +
t/refs.t | 60 +
t/requiredmods.t | 38 +
t/rim.t | 44 +
t/round.t | 19 +
t/scope.t | 60 +
t/segfault.t | 11 +
t/simplex.t | 51 +
t/slatec.t | 277 +
t/slice-exceptions.t | 48 +
t/slice.t | 384 +
t/storable.t | 81 +
t/subclass.t | 100 +
t/subclass2.t | 133 +
t/subclass3.t | 166 +
t/subclass4.t | 89 +
t/thread.t | 91 +
t/thread_def.t | 79 +
t/transform.t | 78 +
t/trig.t | 26 +
t/ufunc.t | 136 +
t/unpdl.t | 18 +
t/vaffine.t | 23 +
t/xvals.t | 72 +
utils/perldlpp.pl | 56 +
win32/INSTALL | 140 +
win32/win32f77.pl | 122 +
812 files changed, 261098 insertions(+)
diff --git a/Basic/AutoLoader.pm b/Basic/AutoLoader.pm
new file mode 100644
index 0000000..5e96171
--- /dev/null
+++ b/Basic/AutoLoader.pm
@@ -0,0 +1,312 @@
+
+=head1 NAME
+
+PDL::AutoLoader - MatLab style AutoLoader for PDL
+
+=head1 SYNOPSIS
+
+ use PDL::AutoLoader;
+ $a = func1(...); # Load file func1.pdl
+ $b = func2(...); # Load file func2.pdl
+
+ $PDL::AutoLoader::Rescan = 1; # Enable re-scanning
+
+=head1 DESCRIPTION
+
+This module implements a MatLab style AutoLoader for PDL. If an unknown
+function C<func()> is called, PDL looks for a file called C<func.pdl>.
+If it finds one, it compiles the file and calls the function C<func>.
+
+The list of directories to search in is given by the shell environment
+variable C<PDLLIB>. This is a colon-separated list of directories. On
+MSWindows systems, is it a I<semicolon> -separated list of directories.
+
+For example, in csh:
+
+ setenv PDLLIB "/home/joe/pdllib:/local/pdllib"
+
+B<Note>: This variable is unrelated to Perl's C<PERL5LIB>.
+
+If you add a leading '+' on a directory name, PDL will search the
+entire directory tree below that point. Internally, PDL stores the
+dirctory list in the variable C<@PDLLIB>, which can be modified at
+run time.
+
+For example, in csh:
+
+ setenv PDLLIB "+/home/joe/PDL"
+
+will search /home/joe/PDL and all its subdirectories for .pdl files.
+
+=head2 AUTO-SCANNING
+
+The variable C<$PDL::AutoLoader::Rescan> controls whether files
+are automatically re-scanned for changes at the C<perldl> or
+C<pdl2> command line.
+
+If C<$PDL::AutoLoader::Rescan == 1> and the file is changed
+then the new definition is reloaded auto-matically before
+executing the C<perldl> or C<pdl2> command line. Which means
+in practice you can edit files, save changes and have C<perldl>
+or C<pdl2> see the changes automatically.
+
+The default is '0' - i.e. to have this feature disabled.
+
+As this feature is only pertinent to the PDL shell it imposes
+no overhead on PDL scripts. Yes Bob you can have your cake and
+eat it too!
+
+Note: files are only re-evaled if they are determined to have
+been changed according to their date/time stamp.
+
+No doubt this interface could be improved upon some more. :-)
+
+=head2 Sample file:
+
+ sub foo { # file 'foo.pdl' - define the 'foo' function
+ my $x=shift;
+ return sqrt($x**2 + $x**3 + 2);
+ }
+ 1; # File returns true (i.e. loaded successfully)
+
+=head1 AUTHOR
+
+Copyright(C) 1997 Karl Glazebrook (kgb at aaoepp.aao.gov.au);
+several extensions by Craig DeForest (deforest at boulder.swri.edu)
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=head1 BUGS
+
+No doubt this interface could be improved upon some more. :-)
+
+Will probably be quite slow if C<$PDL::AutoLoader::Rescan == 1>
+and thousands of functions have been autoloaded.
+
+There could be a race condition in which the file changes
+while the internal autoloader code is being executed but it
+should be harmless.
+
+Probably has not been tested enough!
+
+=head1 SEE ALSO
+
+For an alternative approach to managing a personal collaction of
+modules and functions, see L<local::lib>.
+
+=cut
+
+BEGIN{
+ if (defined $ENV{"PDLLIB"}) {
+ if ( $^O eq 'MSWin32' ) { # win32 flavors
+ @PDLLIB = (".",split(';',$ENV{"PDLLIB"}));
+ s/"//g for @PDLLIB;
+ } else { # unixen systems
+ @PDLLIB = (".",split(':',$ENV{"PDLLIB"}));
+ }
+ @PDLLIB = grep length, @PDLLIB;
+ }
+ $PDL::AutoLoader::Rescan=0;
+ %PDL::AutoLoader::FileInfo = ();
+}
+
+# Code to reload stuff if changed
+
+sub PDL::AutoLoader::reloader {
+ return unless $PDL::AutoLoader::Rescan;
+
+ # Now check functions and reload if changed
+
+ my ($file, $old_t);
+ for my $func (keys %PDL::AutoLoader::FileInfo) {
+ ($file, $old_t) = @{ $PDL::AutoLoader::FileInfo{$func} };
+ if ( (stat($file))[9]>$old_t ) { # Reload
+ print "Reloading $file as file changed...\n" if $PDL::verbose;
+ &PDL::AutoLoader::autoloader_do($file);
+ $PDL::AutoLoader::FileInfo{$func} = [ $file, (stat($file))[9] ];
+ }
+ }
+}
+
+# Used for Beta, and should probably be used generall in this mod
+#use File::Spec;
+
+sub PDL::AutoLoader::import {
+
+ # Beta folder support
+# foreach (@INC) {
+# $Beta_dir = File::Spec->catfile($_, 'PDL', 'Beta');
+# push @PDLLIB, "+$Beta_dir" if -d $Beta_dir;
+# }
+
+my $pkg = (caller())[0];
+my $toeval = "package $pkg;\n";
+
+# Make sure that the eval gets NiceSlice if we have it in this level
+# (it's a drag that preprocessors aren't transitive...)
+$toeval .= "use PDL::NiceSlice;\n" if(defined $PDL::NiceSlice::VERSION);
+
+$toeval .= <<'EOD';
+$PDLLIB_CT = 0;
+
+push @PERLDL::AUTO, \&PDL::AutoLoader::reloader;
+
+
+sub AUTOLOAD {
+ local @INC = @INC;
+ my @args = @_;
+ $AUTOLOAD =~ /::([^:]*)$/;
+ my $func = $1;
+
+ # Trap spurious calls from 'use UnknownModule'
+
+ goto &$AUTOLOAD if ord($func)==0;
+
+ # Check if the PDLLIB needs to be expanded and, if so, expand it.
+ # This only updates when PDLLIB changes size, which should be OK
+ # for most things but doesn't catch new directories in expanded
+ # directory trees. It seems like an OK compromise between never
+ # catching anything and always thrashing through the directories.
+ if($PDLLIB_CT != scalar(@PDLLIB)) {
+ @PDLLIB_EXPANDED = PDL::AutoLoader::expand_path(@PDLLIB);
+ $PDLLIB_CT = scalar(@PDLLIB);
+ }
+
+ print "Loading $func.pdl ..." if $PDL::verbose;
+ my $file;
+
+ my $s = "PDL AutoLoader: Undefined subroutine $func() cannot be autoloaded.\n";
+
+ for my $dir (@PDLLIB_EXPANDED) {
+ $file = $dir . "/" . "$func.pdl";
+ if (-e $file) {
+
+ print "found $file\n" if $PDL::verbose;
+
+ &PDL::AutoLoader::autoloader_do($file);
+
+
+ # Remember autoloaded functions and do some reasonably
+ # smart cacheing of file/directory change times
+
+ if ($PDL::AutoLoader::Rescan) {
+ $PDL::AutoLoader::FileInfo{$func} = [ $file, (stat($file))[9] ];
+ }
+
+ # Now go to the autoload function
+ ##goto &$AUTOLOAD(@args) unless ($@ || !defined(&{$AUTOLOAD}));
+ return &$AUTOLOAD(@args) unless ($@ || !defined(&{$AUTOLOAD}));
+
+ die $s."\tWhile parsing file `$file':\n$@\n" if($@);
+ die $s."\tFile `$file' doesn't \n\tdefine ${AUTOLOAD}().\n"
+
+ }
+ }
+
+ die $s."\tNo file `$func.pdl' was found in your \@PDLLIB path.\n";
+}
+
+EOD
+
+eval $toeval;
+
+}
+
+
+# Simple 'do' doesn't work with preprocessing -- this replaces
+# "do file" and sticks NiceSlice in manually if it's needed (yuck).
+
+sub PDL::AutoLoader::autoloader_do {
+ my ($file) = shift;
+
+ if(defined($PDL::NiceSlice::VERSION)) {
+
+ print "AutoLoader: NiceSlice enabled...\n" if($PDL::debug);
+
+ if(open(AUTOLOAD_FILE,"<$file")) {
+ my($script) = &PDL::NiceSlice::perldlpp("PDL::NiceSlice", join("",<AUTOLOAD_FILE>));
+ eval $script;
+ }
+ } else {
+ print "AutoLoader: no NiceSlice...\n" if($PDL::debug);
+ do $file;
+ }
+}
+
+
+# Expand directories recursively...
+sub PDL::AutoLoader::expand_dir {
+ local $d;
+ local @list;
+ local @subdirs;
+
+ local $dir = shift;
+
+ if(! -d $dir) { return undef; }
+ push(@list,$dir);
+
+ opendir(FOO,$dir);
+
+ @subdirs = grep((!m/^\./ && ($_="$dir/$_") && (-d $_)), readdir(FOO));
+ closedir FOO;
+
+ while(defined ($d = shift @subdirs)) {
+ push(@list,&PDL::AutoLoader::expand_dir($d));
+ }
+ return @list;
+}
+
+
+=head2 PDL::AutoLoader::expand_path
+
+=for ref
+
+Expand a compactified path into a dir list
+
+You supply a pathlist and leading '+' and '~' characters get expanded into
+full directories. Normally you don't want to use this -- it's internal to the
+autoloader -- but some utilities, like the online documentation searcher, need
+to be able to use it.
+
+=cut
+
+sub PDL::AutoLoader::expand_path {
+ my @PDLLIB = @_;
+ my @PDLLIB_EXPANDED;
+
+ print "AutoLoader: Expanding directories from ".join(':', at PDLLIB)."...\n"
+ if($PDL::debug);
+ local $_;
+ foreach $_(@PDLLIB) {
+ # Expand ~{name} and ~ conventions.
+ if(s/^(\+?)\~(\+||[a-zA-Z0-9]*)//) {
+ if($2 eq '+') {
+ # Expand shell '+' to CWD.
+ $_= $1 . ($ENV{'PWD'} || '.');
+ } elsif(!$2) {
+ # No name mentioned -- use current user.
+ # Ideally would use File::HomeDir->my_home() here
+ $_ = $1 . ( $ENV{'HOME'} || (( getpwnam( getlogin || getpwuid($<) ))[7]) ) . $_;
+ } else {
+ # Name mentioned - try to get that user's home directory.
+ $_ = $1 . ( (getpwnam($2))[7] ) . $_;
+ }
+ }
+
+ # If there's a leading '+', include all subdirs too.
+ push(@PDLLIB_EXPANDED,
+ s/^\+// ? &PDL::AutoLoader::expand_dir($_) : $_
+ );
+ }
+
+ print "AutoLoader: returning ",join(",", at PDLLIB_EXPANDED),"\n" if($PDL::debug);
+ @PDLLIB_EXPANDED;
+}
+
+
+;# Exit with OK status
+
+1;
diff --git a/Basic/Bad/Makefile.PL b/Basic/Bad/Makefile.PL
new file mode 100644
index 0000000..7bc5b98
--- /dev/null
+++ b/Basic/Bad/Makefile.PL
@@ -0,0 +1,48 @@
+
+# Makefile.PL for PDL::Bad module.
+
+# we create a Bad.pm whatever the value of
+# PDL_CONFIG - it's just the contents that will be
+# different...
+#
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+# bad value support?
+use vars qw( $bvalflag $usenan $bvalPerPdl );
+use File::Spec;
+require File::Spec->catfile( File::Spec->updir, "Core", "badsupport.p" );
+
+# print a banner to the screen
+print "\n\t";
+if ( $bvalflag ) {
+ print "Congratulations - building PDL with bad value support (WITH_BADVAL=1)\n\t";
+
+ if ( $usenan ) {
+ print "+ using NaN for floating-point bad value";
+ } else {
+ print "+ using -FLT_MAX/-DBL_MAX for floating-point bad values";
+ }
+ print "\n\t+ with per-piddle bad values (EXPERIMENTAL FEATURE)"
+ if $bvalPerPdl;
+} else {
+ print "building PDL without bad value support (WITH_BADVAL!=1)";
+}
+print "\n\n";
+
+ at pack = (["bad.pd",Bad,PDL::Bad]);
+
+%hash = pdlpp_stdargs_int(@::pack);
+
+#$hash{LIBS} = ['-lm'];
+
+WriteMakefile(%hash);
+
+# we add ../Core/badsupport.p to the dependencies of Bad.pm
+# - not very elegant
+#
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Basic/Bad/bad.pd b/Basic/Bad/bad.pd
new file mode 100644
index 0000000..416d87f
--- /dev/null
+++ b/Basic/Bad/bad.pd
@@ -0,0 +1,1460 @@
+' # Needed for CPAN indexing?
+package PDL::Bad;
+';
+
+=pod
+
+=head1 bad.pd
+
+The PDL definition for bad value handling.
+
+What you are reading is the pod documentation as extracted directly from
+the .pd file, which is not what you will see reported on your own
+machine. (I'm guessing you're reading this from CPAN.) What you see on
+your own machine depends on your PDL's configuration, as discussed near
+the bottom of this document.
+
+=head1 DESCRIPTION
+
+The contents of Bad.pm depend on whether we have
+bad-value support in PDL.
+
+If we do not have bad support then the module just
+contains a set of methods which essentially do nothing
+(they may return 0 or undef or a copy of the input
+piddle [thankfully PDL::copy handles inplace ops])
+
+=cut
+
+
+use strict;
+
+# check for bad value support
+use PDL::Config;
+my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
+my $usenan = $PDL::Config{BADVAL_USENAN} || 0;
+my $bvalPerPdl = $PDL::Config{BADVAL_PER_PDL} || 0;
+
+#########################################################
+
+=head1 Docs for no Bad Value support
+
+If you don't have bad value support enabled, your docs for this module
+will look something like this.
+
+=cut
+
+# if no bad-value support, this is easy
+
+unless ( $bvalflag ) {
+
+ my $bulk_of_file = <<'!NO!SUBS!';
+
+=head2 NAME
+
+PDL::Bad - PDL does not process bad values
+
+=head2 DESCRIPTION
+
+PDL has been compiled with WITH_BADVAL either 0 or undef,
+so it does not contain any bad-value support code.
+Actually, a number of methods are defined, but they are only
+placeholders to make writing other code, that has to handle
+WITH_BADVAL being true or false, easier.
+
+Implementation details are given in
+L<PDL::BadValues>.
+
+=head2 SYNOPSIS
+
+ use PDL::Bad;
+ print "\nBad value support in PDL is turned " .
+ $PDL::Bad::Status ? "on" : "off" . ".\n";
+
+ Bad value support in PDL is turned off.
+
+=head2 VARIABLES
+
+There are currently three variables that this module defines
+which may be of use.
+
+=over 4
+
+=item $PDL::Bad::Status
+
+Set to 0
+
+=item $PDL::Bad::UseNaN
+
+Set to 0
+
+=item $PDL::Bad::PerPdl
+
+Set to 0
+
+=back
+
+=cut
+
+# really should be a constant
+$PDL::Bad::Status = 0;
+$PDL::Bad::UseNaN = 0;
+$PDL::Bad::PerPdl = 0;
+
+# dummy routines
+#
+*badflag = \&PDL::badflag;
+*badvalue = \&PDL::badvalue;
+*orig_badvalue = \&PDL::orig_badvalue;
+
+sub PDL::badflag { return 0; } # no piddles can contain bad values by design
+sub PDL::badvalue { return undef; }
+sub PDL::orig_badvalue { return undef; }
+
+*check_badflag = \&PDL::check_badflag;
+sub PDL::check_badflag { return 0; } # no piddles can contain bad values by design
+
+*isbad = \&PDL::isbad;
+*isgood = \&PDL::isgood;
+
+sub PDL::isbad { return 0; } # no piddles can contain bad values by design
+sub PDL::isgood { return 1; } # no piddles can contain bad values by design
+
+*nbadover = \&PDL::nbadover;
+*ngoodover = \&PDL::ngoodover;
+*nbad = \&PDL::nbad;
+*ngood = \&PDL::ngood;
+
+# Pars => 'a(n); int+ [o]b();',
+# collapse the input piddle along it's first dimension and set to 0's
+# - using sumover to do the projection as I'm too lazy to do it
+# myself
+#
+sub PDL::nbadover { return PDL::sumover( $_[0] * 0 ); }
+sub PDL::ngoodover { return PDL::sumover( $_[0] * 0 + 1 ); }
+
+sub PDL::nbad { return 0; }
+sub PDL::ngood { return $_[0]->nelem; }
+
+*setbadat = \&PDL::setbadat;
+*setbadif = \&PDL::setbadif;
+
+# As these can't be done inplace we try to keep the
+# same behaviour here
+#
+sub PDL::setbadat { $_[0]->set_inplace(0); return $_[0]->copy; }
+sub PDL::setbadif { $_[0]->set_inplace(0); return $_[0]->copy; }
+
+*setvaltobad = \&PDL::setvaltobad;
+*setbadtoval = \&PDL::setvaltobad;
+*setnantobad = \&PDL::setnantobad;
+*setbadtonan = \&PDL::setbadtonan;
+
+# this can be done inplace
+# fortunately PDL::copy handles inplace ops
+sub PDL::setvaltobad { return $_[0]->copy; }
+sub PDL::setbadtoval { return $_[0]->copy; }
+sub PDL::setnantobad { return $_[0]->copy; }
+sub PDL::setbadtonan { return $_[0]->copy; }
+
+*copybad = \&PDL::copybad;
+
+sub PDL::copybad { return $_[0]->copy; } # ignore the mask
+
+!NO!SUBS!
+
+ # Replace the head2 with head1
+ $bulk_of_file =~ s/head2/head1/g;
+ pp_addpm({At=>'Top'},$bulk_of_file);
+
+
+ pp_add_exported( '',
+ 'badflag check_badflag badvalue orig_badvalue nbad nbadover ngood ngoodover ' .
+ 'setbadat setbadif setvaltobad setbadtoval setnantobad setbadtonan copybad '.
+ 'isbad isgood ' );
+
+ pp_done();
+ exit;
+
+} # unless: $bvalflag
+
+#########################################################
+
+# _finite in VC++
+if ($^O =~ /MSWin/) {
+pp_addhdr('
+#define finite _finite
+#include <float.h>
+');
+}
+
+pp_add_exported( '',
+ 'badflag check_badflag badvalue orig_badvalue nbad nbadover ngood ngoodover ' .
+ 'setbadat ' );
+
+# If UseNaN == 0, we need to have a variable containing the
+# value for NaN. This is taken from Basic/Core/Core.xs.PL
+#
+if ( $usenan == 0 ) {
+ require PDL::Core::Dev; PDL::Core::Dev->import;
+ pp_addhdr( "\nstatic union { unsigned char __c[4]; float __d; } __pdl_nan = {\n" );
+ if ( isbigendian() ) {
+ pp_addhdr( "{ 0x7f, 0xc0, 0, 0 } };\n\n" );
+ } else {
+ pp_addhdr( "{ 0, 0, 0xc0, 0x7f } };\n\n" );
+ }
+ pp_addhdr( "float _nan_float;\ndouble _nan_double;\n\n" );
+ pp_add_boot( " _nan_float = __pdl_nan.__d;\n _nan_double = (double) __pdl_nan.__d;\n" );
+
+} # if: $usenan
+
+## Header
+pp_addpm({At=>'Top'},<<'!NO!SUBS!');
+
+=head1 NAME
+
+PDL::Bad - PDL does process bad values
+
+=head1 DESCRIPTION
+
+PDL has been compiled with WITH_BADVAL set to 1. Therefore,
+you can enter the wonderful world of bad value support in
+PDL.
+
+This module is loaded when you do C<use PDL>,
+C<Use PDL::Lite> or C<PDL::LiteF>.
+
+Implementation details are given in
+L<PDL::BadValues>.
+
+=head1 SYNOPSIS
+
+ use PDL::Bad;
+ print "\nBad value support in PDL is turned " .
+ $PDL::Bad::Status ? "on" : "off" . ".\n";
+
+ Bad value support in PDL is turned on.
+
+ and some other things
+
+=head1 VARIABLES
+
+There are currently three variables that this module defines
+which may be of use.
+
+=over 4
+
+=item $PDL::Bad::Status
+
+Set to 1
+
+=item $PDL::Bad::UseNaN
+
+Set to 1 if PDL was compiled with C<BADVAL_USENAN> set,
+0 otherwise.
+
+=item $PDL::Bad::PerPdl
+
+Set to 1 if PDL was compiled with the I<experimental>
+C<BADVAL_PER_PDL> option set, 0 otherwise.
+
+=back
+
+=cut
+
+!NO!SUBS!
+
+pp_addpm(<<"!WITH!SUBS!");
+
+# really should be constants
+\$PDL::Bad::Status = 1;
+\$PDL::Bad::UseNaN = $usenan;
+\$PDL::Bad::PerPdl = $bvalPerPdl;
+
+use strict;
+
+use PDL::Types;
+use PDL::Primitive;
+
+############################################################
+############################################################
+
+!WITH!SUBS!
+
+# we want the following to be in PDL, not PDL::Bad, hence
+my $xshdr = "MODULE = PDL::Bad PACKAGE = PDL";
+
+#
+# we want badflag() to avoid unnecessary calls to PDL->propogate_badflag(),
+# since it has to recurse through all the children of a piddle
+#
+
+pp_addxs( <<"!WITH!SUBS!");
+$xshdr
+
+int
+badflag(x,newval=0)
+ pdl *x
+ int newval
+ CODE:
+ if (items>1) {
+ int oldval = ((x->state & PDL_BADVAL) > 0);
+ if ( !newval && oldval ) {
+ /* asked to unset, present value is set */
+ x->state &= ~PDL_BADVAL;
+ PDL->propogate_badflag( x, 0 );
+ } else if ( newval && !oldval ) {
+ /* asked to set, present value is unset */
+ x->state |= PDL_BADVAL;
+ PDL->propogate_badflag( x, 1 );
+ }
+ }
+ RETVAL = ((x->state & PDL_BADVAL) > 0);
+ OUTPUT:
+ RETVAL
+
+!WITH!SUBS!
+
+pp_addpm(<<'!NO!SUBS!');
+############################################################
+############################################################
+
+*badflag = \&PDL::badflag;
+*badvalue = \&PDL::badvalue;
+*orig_badvalue = \&PDL::orig_badvalue;
+
+############################################################
+############################################################
+
+=head2 badflag
+
+=for ref
+
+getter/setter for the bad data flag
+
+=for example
+
+ if ( $a->badflag() ) {
+ print "Data may contain bad values.\n";
+ }
+ $a->badflag(1); # set bad data flag
+ $a->badflag(0); # unset bad data flag
+
+When called as a setter, this modifies the piddle on which
+it is called. This always returns a Perl scalar with the
+final value of the bad flag.
+
+A return value of 1 does not guarantee the presence of
+bad data in a piddle; all it does is say that we need to
+I<check> for the presence of such beasties. To actually
+find out if there are any bad values present in a piddle,
+use the L<check_badflag|/check_badflag> method.
+
+=for bad
+
+This function works with piddles that have bad values. It
+always returns a Perl scalar, so it never returns bad values.
+
+=head2 badvalue
+
+=for ref
+
+returns the value used to indicate a missing (or bad) element
+for the given piddle type. You can give it a piddle,
+a PDL::Type object, or one of C<$PDL_B>, C<$PDL_S>, etc.
+
+=for example
+
+ $badval = badvalue( float );
+ $a = ones(ushort,10);
+ print "The bad data value for ushort is: ",
+ $a->badvalue(), "\n";
+
+This can act as a setter (e.g. C<< $a->badvalue(23) >>)
+if the data type is an integer or C<$PDL::Bad::UseNaN == 0>.
+Note that this B<never touches the data in the piddle>.
+That is, if C<$a> already has bad values, they will not
+be changed to use the given number and if any elements of
+C<$a> have that value, they will unceremoniously be marked
+as bad data. See L</setvaltobad>, L</setbadtoval>, and
+L</setbadif> for ways to actually modify the data in piddles
+
+If the C<$PDL::Bad::PerPdl> flag is set then it is possible to
+change the bad value on a per-piddle basis, so
+
+ $a = sequence (10);
+ $a->badvalue (3); $a->badflag (1);
+ $b = sequence (10);
+ $b->badvalue (4); $b->badflag (1);
+
+will set $a to be C<[0 1 2 BAD 4 5 6 7 8 9]> and $b to be
+C<[0 1 2 3 BAD 5 6 7 8 9]>. If the flag is not set then both
+$a and $b will be set to C<[0 1 2 3 BAD 5 6 7 8 9]>. Please
+note that the code to support per-piddle bad values is
+I<experimental> in the current release, and it requires that
+you modify the settings under which PDL is compiled.
+
+=for bad
+
+This method does not care if you call it on an input piddle
+that has bad values. It always returns a Perl scalar
+with the current or new bad value.
+
+=head2 orig_badvalue
+
+=for ref
+
+returns the original value used to represent bad values for
+a given type.
+
+This routine operates the same as L<badvalue|/badvalue>,
+except you can not change the values.
+
+It also has an I<awful> name.
+
+=for example
+
+ $orig_badval = orig_badvalue( float );
+ $a = ones(ushort,10);
+ print "The original bad data value for ushort is: ",
+ $a->orig_badvalue(), "\n";
+
+=for bad
+
+This method does not care if you call it on an input piddle
+that has bad values. It always returns a Perl scalar
+with the original bad value for the associated type.
+
+=head2 check_badflag
+
+=for ref
+
+Clear the bad-value flag of a piddle if it does not
+contain any bad values
+
+Given a piddle whose bad flag is set, check whether it
+actually contains any bad values and, if not, clear the flag.
+It returns the final state of the bad-value flag.
+
+=for example
+
+ print "State of bad flag == ", $pdl->check_badflag;
+
+=for bad
+
+This method accepts piddles with or without bad values. It
+returns a Perl scalar with the final bad-value flag, so it
+never returns bad values itself.
+
+=cut
+
+*check_badflag = \&PDL::check_badflag;
+
+sub PDL::check_badflag {
+ my $pdl = shift;
+ $pdl->badflag(0) if $pdl->badflag and $pdl->nbad == 0;
+ return $pdl->badflag;
+} # sub: check_badflag()
+
+!NO!SUBS!
+
+pp_addhdr <<'EOHDR';
+static pdl* new_pdlscalar(int datatype)
+ {
+ pdl *p = PDL->pdlnew();
+ PDL->setdims (p, NULL, 0); /* set dims */
+ p->datatype = datatype; /* and data type */
+ PDL->allocdata (p); /* allocate the data chunk */
+
+ return p;
+ }
+EOHDR
+
+use PDL::Types;
+my $ntypes = $#PDL::Types::names;
+
+my $str;
+foreach my $i ( 0 .. $ntypes ) {
+ my $type = PDL::Type->new( $i );
+ my $ctype = $type->ctype;
+ my $realctype = $type->realctype;
+ my $typesym = $type->symbol;
+
+ my $cname = $type->ctype;
+ $cname =~ s/^PDL_//;
+ my $storage = "PDL->bvals.$cname";
+
+ my $init_code = << "EOC";
+ pdl* p;
+ $ctype *data;
+ p = new_pdlscalar($typesym);
+ data = ($ctype *) p->data;
+
+EOC
+
+ my $set_code = "if ( items > 0 ) { $storage = ($realctype) val; }";
+
+ # if UseNaN is true, then we can not change the value used to
+ # represent bad elements since it's a NaN. At least, not for
+ # for floating point types
+ # - is there a better way of checking for the condition since
+ # the current one needs to be changed whenever the types are changed
+ #
+ $set_code = "" if $usenan and ($type->ppsym eq "F" or $type->ppsym eq "D");
+
+ $str .=
+"
+pdl *
+_badvalue_int${i}(val=0)
+ double val
+ CODE:
+ {
+ $init_code
+ $set_code
+ *data = ($ctype) $storage;
+ RETVAL = p;
+ }
+ OUTPUT:
+ RETVAL
+
+pdl *
+_badvalue_per_pdl_int${i}(pdl_val, val=0)
+ pdl* pdl_val
+ double val
+ CODE:
+ {
+ $init_code
+ if ( items > 1 ) {
+ pdl_val->badvalue = val;
+ pdl_val->has_badvalue = 1;
+ PDL->propogate_badvalue( pdl_val );
+ }
+
+ if (pdl_val->has_badvalue == 0) {
+ *data = ($ctype) $storage;
+ } else {
+ *data = ($ctype) pdl_val->badvalue;
+ }
+
+ RETVAL = p;
+ }
+ OUTPUT:
+ RETVAL
+
+
+pdl *
+_default_badvalue_int${i}()
+ CODE:
+ $init_code
+ *data = ($ctype) PDL->bvals.default_$cname;
+ RETVAL = p;
+ OUTPUT:
+ RETVAL
+
+";
+
+
+
+} # foreach: $i = 0 .. $ntypes
+
+pp_addxs( "\n$xshdr\n\n$str\n" );
+
+pp_addpm(<<'!NO!SUBS!');
+
+# note:
+# if sent a piddle, we have to change it's bad values
+# (but only if it contains bad values)
+# - there's a slight overhead in that the badflag is
+# cleared and then set (hence propogating to all
+# children) but we'll ignore that)
+# - we can ignore this for float/double types
+# since we can't change the bad value
+#
+sub PDL::badvalue {
+ no strict 'refs';
+
+ my ( $self, $val ) = @_;
+ my $num;
+ if ( UNIVERSAL::isa($self,"PDL") ) {
+ $num = $self->get_datatype;
+ if ( $num < 4 and defined($val) and $self->badflag ) {
+ $self->inplace->setbadtoval( $val );
+ $self->badflag(1);
+ }
+
+ if ($PDL::Config{BADVAL_PER_PDL}) {
+ my $name = "PDL::_badvalue_per_pdl_int$num";
+ if ( defined $val ) {
+ return &{$name}($self, $val )->sclr;
+ } else {
+ return &{$name}($self)->sclr;
+ }
+ }
+
+ } elsif ( UNIVERSAL::isa($self,"PDL::Type") ) {
+ $num = $self->enum;
+ } else {
+ # assume it's a number
+ $num = $self;
+ }
+
+ my $name = "PDL::_badvalue_int$num";
+ if ( defined $val ) {
+ return &{$name}( $val )->sclr;
+ } else {
+ return &{$name}()->sclr;
+ }
+
+} # sub: badvalue()
+
+sub PDL::orig_badvalue {
+ no strict 'refs';
+
+ my $self = shift;
+ my $num;
+ if ( UNIVERSAL::isa($self,"PDL") ) {
+ $num = $self->get_datatype;
+ } elsif ( UNIVERSAL::isa($self,"PDL::Type") ) {
+ $num = $self->enum;
+ } else {
+ # assume it's a number
+ $num = $self;
+ }
+
+ my $name = "PDL::_default_badvalue_int$num";
+ return &${name}();
+
+} # sub: orig_badvalue()
+
+############################################################
+############################################################
+
+!NO!SUBS!
+
+pp_def('isbad' . <<'=cut',
+
+=head2 isbad
+
+=for sig
+
+ Signature: (a(); int [o]b())
+
+=for ref
+
+Returns a binary mask indicating which values of
+the input are bad values
+
+Returns a 1 if the value is bad, 0 otherwise.
+Similar to L<isfinite|PDL::Math/isfinite>.
+
+=for example
+
+ $a = pdl(1,2,3);
+ $a->badflag(1);
+ set($a,1,$a->badvalue);
+ $b = isbad($a);
+ print $b, "\n";
+ [0 1 0]
+
+=for bad
+
+This method works with input piddles that are bad. The ouptut piddle
+will never contain bad values, but its bad value flag will be the
+same as the input piddle's flag.
+
+=cut
+
+ HandleBad => 1,
+ Code =>
+ '$b() = 0;',
+ BadCode =>
+ '$b() = $ISBAD(a());',
+ CopyBadStatusCode => '',
+
+ );
+
+pp_def('isgood' . <<'=cut',
+
+=head2 isgood
+
+=for sig
+
+ Signature: (a(); int [o]b())
+
+=for ref
+
+Is a value good?
+
+Returns a 1 if the value is good, 0 otherwise.
+Also see L<isfinite|PDL::Math/isfinite>.
+
+=for example
+
+ $a = pdl(1,2,3);
+ $a->badflag(1);
+ set($a,1,$a->badvalue);
+ $b = isgood($a);
+ print $b, "\n";
+ [1 0 1]
+
+=for bad
+
+This method works with input piddles that are bad. The ouptut piddle
+will never contain bad values, but its bad value flag will be the
+same as the input piddle's flag.
+
+=cut
+
+ HandleBad => 1,
+ Code =>
+ '$b() = 1;',
+ BadCode =>
+ '$b() = $ISGOOD(a());',
+ CopyBadStatusCode => '',
+ );
+
+
+# perhaps these should have pm code which returns the
+# answer if the bad flag is not set
+pp_def('nbadover' . <<'=cut',
+
+=head2 nbadover
+
+=for sig
+
+ Signature: (a(n); int+ [o] b())
+
+=for ref
+
+Find the number of bad elements along the 1st dimension.
+
+This function reduces the dimensionality of a piddle by one by finding the
+number of bad elements along the 1st dimension. In this sense it shares
+much in common with the functions defined in L<PDL::Ufunc>. In particular,
+by using L<xchg|PDL::Slices/xchg> and similar dimension rearranging methods,
+it is possible to perform this calculation over I<any> dimension.
+
+=for usage
+
+ $a = nbadover($b);
+
+=for example
+
+ $spectrum = nbadover $image->xchg(0,1)
+
+=for bad
+
+nbadover processes input values that are bad. The ouput piddle will not have
+any bad values, but the bad flag will be set if the input piddle had its bad
+flag set.
+
+=cut
+
+ HandleBad => 1,
+ Code => '$b() = 0;',
+ BadCode => q{
+ $GENERIC(b) cnt = 0;
+ loop(n) %{
+ if ( $ISBAD(a()) ) { cnt++; }
+ %}
+ $b() = cnt;
+ },
+);
+
+pp_def('ngoodover' . <<'=cut',
+
+=head2 ngoodover
+
+=for sig
+
+ Signature: (a(n); int+ [o] b())
+
+=for ref
+
+Find the number of good elements along the 1st dimension.
+
+This function reduces the dimensionality of a piddle
+by one by finding the number of good elements
+along the 1st dimension.
+
+By using L<xchg|PDL::Slices/xchg> etc. it is possible to use
+I<any> dimension.
+
+=for usage
+
+ $a = ngoodover($b);
+
+=for example
+
+ $spectrum = ngoodover $image->xchg(0,1)
+
+=for bad
+
+ngoodover processes input values that are bad. The ouput piddle will not have
+any bad values, but the bad flag will be set if the input piddle had its bad
+flag set.
+
+=cut
+
+ HandleBad => 1,
+ Code =>
+ '$b() = ($GENERIC(b)) $SIZE(n);',
+ BadCode =>
+ '$GENERIC(b) cnt = 0;
+ loop(n) %{
+ if ( $ISGOOD(a()) ) { cnt++; }
+ %}
+ $b() = cnt;',
+ );
+
+# Generate small ops functions to do entire array
+foreach my $op (
+ ['nbad','nbadover'],
+ ['ngood','ngoodover'],
+ ) {
+ pp_addpm(<<"EOD");
+
+*$op->[0] = \\&PDL::$op->[0];
+sub PDL::$op->[0] {
+ my(\$x) = \@_; my \$tmp;
+ \$x->clump(-1)->$op->[1](\$tmp=PDL->nullcreate(\$x) );
+ return \$tmp->at();
+}
+EOD
+
+} # for $op
+
+pp_addpm(<<'!NO!SUBS!');
+
+=head2 nbad
+
+=for ref
+
+Returns the number of bad values in a piddle
+
+=for usage
+
+ $x = nbad($data);
+
+=for bad
+
+Accepts good and bad input piddles; output is a Perl scalar
+and therefore is always good.
+
+=head2 ngood
+
+=for ref
+
+Returns the number of good values in a piddle
+
+=for usage
+
+ $x = ngood($data);
+
+=for bad
+
+Accepts good and bad input piddles; output is a Perl scalar
+and therefore is always good.
+
+=head2 setbadat
+
+=for ref
+
+Set the value to bad at a given position.
+
+=for usage
+
+ setbadat $piddle, @position
+
+C<@position> is a coordinate list, of size equal to the
+number of dimensions in the piddle.
+This is a wrapper around L<set|PDL::Core/set> and is
+probably mainly useful in test scripts!
+
+=for example
+
+ pdl> $x = sequence 3,4
+ pdl> $x->setbadat 2,1
+ pdl> p $x
+ [
+ [ 0 1 2]
+ [ 3 4 BAD]
+ [ 6 7 8]
+ [ 9 10 11]
+ ]
+
+=for bad
+
+This method can be called on piddles that have bad values.
+The remainder of the arguments should be Perl scalars indicating
+the position to set as bad. The ouptut piddle will have bad values
+and will have its badflag turned on.
+
+=cut
+
+*setbadat = \&PDL::setbadat;
+sub PDL::setbadat {
+ barf 'Usage: setbadat($pdl, $x, $y, ...)' if $#_<1;
+ my $self = shift;
+ PDL::Core::set_c ($self, [@_], $self->badvalue);
+ $self->badflag(1);
+ return $self;
+}
+
+!NO!SUBS!
+
+# NOTE: the Code section uses SETBAD
+#
+# have removed inplace stuff because:
+# $a->inplace->setbadif( $a % 2 )
+# actually sets the badflag in a for ($a % 2) - this is
+# done inplace, and the flag cleared. Hence the setbadif()
+# call is NOT done inplace.
+#
+# Don't want to play around with inplace-type code to
+# try and fix this (doubt will be easy)
+#
+my %setbadif_extra = ( );
+if ( 0 ) {
+ ## ie if fix inplace issues
+ $setbadif_extra{Inplace} = [ 'a' ];
+ $setbadif_extra{CopyBadStatusCode} =
+ 'if ( a == b && $ISPDLSTATEGOOD(a) )
+ PDL->propogate_badflag( b, 1 ); /* propogate badflag if inplace */
+ $SETPDLSTATEBAD(b); /* always make sure the output is "bad" */
+ ';
+} else {
+ # always make sure the output is "bad"
+ $setbadif_extra{CopyBadStatusCode} =
+ '$SETPDLSTATEBAD(b);';
+}
+
+# note: have made the mask be an integer
+pp_def('setbadif' . <<'=cut',
+
+=head2 setbadif
+
+=for sig
+
+ Signature: (a(); int mask(); [o]b())
+
+=for ref
+
+Set elements bad based on the supplied mask, otherwise
+copy across the data.
+
+=for example
+
+ pdl> $a = sequence(5,5)
+ pdl> $a = $a->setbadif( $a % 2 )
+ pdl> p "a badflag: ", $a->badflag, "\n"
+ a badflag: 1
+ pdl> p "a is\n$a"
+ [
+ [ 0 BAD 2 BAD 4]
+ [BAD 6 BAD 8 BAD]
+ [ 10 BAD 12 BAD 14]
+ [BAD 16 BAD 18 BAD]
+ [ 20 BAD 22 BAD 24]
+ ]
+
+Unfortunately, this routine can I<not> be run inplace, since the
+current implementation can not handle the same piddle used as
+C<a> and C<mask> (eg C<< $a->inplace->setbadif($a%2) >> fails).
+Even more unfortunate: we can't catch this error and tell you.
+
+=for bad
+
+The output always has its bad flag set, even if it does not contain
+any bad values (use L<check_badflag|/check_badflag> to check
+whether there are any bad values in the output).
+The input piddle can have bad values: any bad values in the input piddles
+are copied across to the output piddle.
+
+Also see L<setvaltobad|/setvaltobad> and L<setnantobad|/setnantobad>.
+
+=cut
+
+ HandleBad => 1,
+ %setbadif_extra,
+ Code =>
+ 'if ( $mask() ) {
+ $SETBAD(b());
+ } else {
+ $b() = $a();
+ }',
+ BadCode =>
+ '/* if the bad value == 0 then all points are going to be selected ... */
+ if ( $ISBAD(mask()) || $mask() ) {
+ $SETBAD(b());
+ } else {
+ $b() = $a();
+ }',
+); # pp_def: setbadif
+
+# this is useful because $a->setbadif( $a == 23 )
+# is common and that can't be done inplace
+#
+# this doesn't need a BadCode section
+
+if ($^O =~ /MSWin/) {
+pp_addhdr('
+#if defined _MSC_VER && _MSC_VER < 1400
+#pragma optimize("", off)
+#endif
+
+');
+}
+
+pp_def('setvaltobad' . <<'=cut',
+
+=head2 setvaltobad
+
+=for sig
+
+ Signature: (a(); [o]b(); double value)
+
+=for ref
+
+Set bad all those elements which equal the supplied value.
+
+=for example
+
+ $a = sequence(10) % 3;
+ $a->inplace->setvaltobad( 0 );
+ print "$a\n";
+ [BAD 1 2 BAD 1 2 BAD 1 2 BAD]
+
+This is a simpler version of L<setbadif|/setbadif>, but this
+function can be done inplace. See L<setnantobad|/setnantobad>
+if you want to convert NaN/Inf to the bad value.
+
+=for bad
+
+The output always has its bad flag set, even if it does not contain
+any bad values (use L<check_badflag|/check_badflag> to check
+whether there are any bad values in the output).
+Any bad values in the input piddles are copied across to the output piddle.
+
+=cut
+
+ HandleBad => 1,
+ Inplace => 1,
+ CopyBadStatusCode => q{
+ if ( a == b && $ISPDLSTATEGOOD(a) )
+ PDL->propogate_badflag( b, 1 ); /* propogate badflag if inplace */
+ $SETPDLSTATEBAD(b); /* always make sure the output is "bad" */
+ },
+ Code => q[
+ #if defined _MSC_VER && _MSC_VER < 1400
+ $GENERIC(a) dummy1 = ($GENERIC(a)) $COMP(value);
+ if ( $a() == dummy1 ) {
+ #else
+ if ( $a() == ($GENERIC(a)) $COMP(value) ) {
+ #endif
+ $SETBAD(b());
+ } else {
+ $b() = $a();
+ }
+ ],
+
+); # pp_def: setvaltobad
+
+if ($^O =~ /MSWin/) {
+pp_addhdr('
+#if defined _MSC_VER && _MSC_VER < 1400
+#pragma optimize("", on)
+#endif
+
+');
+}
+
+=head2 setnantobad, setbadtonan when using NaN for bad
+
+The behavior of these functions depend on whether C<PDL::Bad::UseNaN>
+is set to a true value. For PDL as currently distributed, this is
+typically not the case. That documentation is show first:
+
+=cut
+
+# setnantobad \ are straight copies if $PDL::Bad::UseNaN == 1
+# setbadtonan /
+#
+if ( $usenan ) {
+ pp_add_exported( '', 'setnantobad setbadtonan' );
+ my $stuff_to_add_to_the_pm = <<'!NO!SUBS!';
+
+=head2 setnantobad
+
+=for ref
+
+Sets NaN/Inf values in the input piddle bad
+(only relevant for floating-point piddles).
+Can be done inplace.
+
+As C<$PDL::Bad::UseNan == 1>, this is just a copy
+with a call to L<check_badflag()|/check_badflag> thrown in.
+
+=for usage
+
+ $b = $a->setnantobad;
+ $a->inplace->setnantobad;
+
+=for bad
+
+Supports bad values.
+
+=cut
+
+*setnantobad = \&PDL::setnantobad;
+sub PDL::setnantobad{
+ my $a = shift;
+ my $b;
+ if ( $a->is_inplace ) {
+ $a->set_inplace(0);
+ $b = $a;
+ } elsif ( $#_ > -1 ) {
+ $b = $_[0] = $a->copy; # is this correct?
+ } else {
+ $b = $a->copy;
+ }
+ # make sure bad flag is set, otherwise check_badflag() is a nop
+ $b->badflag(1); $b->check_badflag();
+ return $b;
+}
+
+=head2 setbadtonan
+
+=for ref
+
+Sets Bad values to NaN
+(only relevant for floating-point piddles).
+Can be done inplace.
+
+As C<$PDL::Bad::UseNan == 1>, this is just a copy,
+with the bad flag being cleared.
+
+=for usage
+
+ $b = $a->setbadtonan;
+ $a->inplace->setbadtonan;
+
+=for bad
+
+Supports bad values.
+
+=cut
+
+*setbadtonan = \&PDL::setbadtonan;
+sub PDL::setbadtonan{
+ my $a = shift;
+ my $b;
+ if ( $a->is_inplace ) {
+ $a->set_inplace(0);
+ $b = $a;
+ } elsif ( $#_ > -1 ) {
+ $b = $_[0] = $a->copy; # is this correct?
+ } else {
+ $b = $a->copy;
+ }
+ $b->badflag(0);
+ return $b;
+}
+
+!NO!SUBS!
+
+ # Replace the head3 directives with head2, since that's what
+ # they should be in their final result.
+ $stuff_to_add_to_the_pm =~ s/head3/head2/g;
+ pp_addpm($stuff_to_add_to_the_pm);
+
+} else {
+
+=pod
+
+On the other hand, if usenan is not true, then any number can be used
+to designate a bad value, and this must be handled with greater care.
+This is the usual case, and the documentation in that case is this:
+
+=cut
+
+ # usenan is not true, so we need to do something
+pp_def('setnantobad' . <<'=cut',
+
+=head2 setnantobad
+
+=for sig
+
+ Signature: (a(); [o]b())
+
+=for ref
+
+Sets NaN/Inf values in the input piddle bad
+(only relevant for floating-point piddles).
+Can be done inplace.
+
+=for usage
+
+ $b = $a->setnantobad;
+ $a->inplace->setnantobad;
+
+=for bad
+
+This method can process piddles with bad values: those bad values
+are propogated into the output piddle. Any value that is not finite
+is also set to bad in the output piddle. If all values from the input
+piddle are good and finite, the output piddle will B<not> have its
+bad flag set. One more caveat: if done inplace, and if the input piddle's
+bad flag is set, it will no
+
+=cut
+
+ HandleBad => 1,
+ GenericTypes => [ 'F', 'D' ],
+ Inplace => 1,
+ CopyBadStatusCode => q{
+ /* note: not quite the normal check since set b bad within Code */
+ /* we propogate the bad flag even if a was originally bad since */
+ /* there is no easy way to pass this information around */
+ if ( a == b && $ISPDLSTATEBAD(b) )
+ PDL->propogate_badflag( b, 1 ); /* propogate badflag if inplace */
+ },
+ Code => q{
+ int flag = 0;
+ threadloop %{
+ if ( ! finite($a()) ) {
+ $SETBAD(b());
+ flag = 1;
+ }
+ else {
+ $b() = $a();
+ }
+ %}
+ if ( flag ) $PDLSTATESETBAD(b);
+ },
+); # pp_def: setnantobad
+
+
+pp_def('setbadtonan' . <<'=cut',
+
+=head2 setbadtonan
+
+=for sig
+
+ Signature: (a(); [o] b();)
+
+=for ref
+
+Sets Bad values to NaN
+
+This is only relevant for floating-point piddles. The input piddle can be
+of any type, but if done inplace, the input must be floating point.
+
+=for usage
+
+ $b = $a->setbadtonan;
+ $a->inplace->setbadtonan;
+
+=for bad
+
+This method processes input piddles with bad values. The output piddles will
+not contain bad values (insofar as NaN is not Bad as far as PDL is concerned)
+and the output piddle does not have its bad flag set. As an inplace
+operation, it clears the bad flag.
+
+=cut
+
+ HandleBad => 1,
+ GenericTypes => [ 'F', 'D' ],
+ Inplace => 1,
+ CopyBadStatusCode => q{
+ /* propogate cleared badflag if inplace */
+ if ( a == b ) PDL->propogate_badflag( b, 0 );
+ /* always make sure the output is "good" */
+ $SETPDLSTATEGOOD(b);
+ },
+ Code => q{
+ if ( $ISBAD(a()) ) {
+ /* _nan_xxx set up at top of file */
+ $b() = $TFD(_nan_float,_nan_double);
+ }
+ else {
+ $b() = $a();
+ }
+ },
+); # pp_def: setbadtonan
+
+} # if: $usenan
+
+# renamed replacebad by setbadtoval
+pp_def('setbadtoval' . <<'=cut',
+
+=head2 setbadtoval
+
+=for sig
+
+ Signature: (a(); [o]b(); double newval)
+
+=for ref
+
+Replace any bad values by a (non-bad) value.
+
+Can be done inplace. Also see
+L<badmask|PDL::Math/badmask>.
+
+=for example
+
+ $a->inplace->setbadtoval(23);
+ print "a badflag: ", $a->badflag, "\n";
+ a badflag: 0
+
+=for bad
+
+The output always has its bad flag cleared.
+If the input piddle does not have its bad flag set, then
+values are copied with no replacement.
+
+=cut
+
+ HandleBad => 1,
+ Inplace => 1,
+ Code => '$b() = $a();',
+ BadCode => q{
+ $GENERIC(b) replace = ($GENERIC(b)) $COMP(newval);
+ $GENERIC(b) a_val;
+ threadloop %{
+ a_val = $a();
+ if ( $ISBADVAR(a_val,a) ) {
+ $b() = replace;
+ } else {
+ $b() = a_val;
+ }
+ %}
+ },
+ CopyBadStatusCode => q{
+ /* propogate badflag if inplace AND its changed */
+ if ( a == b && $ISPDLSTATEBAD(a) ) PDL->propogate_badflag( b, 0 );
+ /* always make sure the output is "good" */
+ $SETPDLSTATEGOOD(b);
+ },
+); # pp_def: setbadtoval
+
+pp_def('copybad'.<<'=cut',
+
+=head2 copybad
+
+=for sig
+
+ Signature: (a(); mask(); [o]b())
+
+=for ref
+
+Copies values from one piddle to another, setting them
+bad if they are bad in the supplied mask.
+
+Can be done inplace.
+
+=for example
+
+ $a = byte( [0,1,3] );
+ $mask = byte( [0,0,0] );
+ set($mask,1,$mask->badvalue);
+ $a->inplace->copybad( $mask );
+ p $a;
+ [0 BAD 3]
+
+It is equivalent to:
+
+ $c = $a + $mask * 0
+
+=for bad
+
+This handles input piddles that are bad. If either C<$a>
+or C<$mask> have bad values, those values will be marked
+as bad in the output piddle and the output piddle will have
+its bad value flag set to true.
+
+=cut
+
+ HandleBad => 1,
+ Inplace => [ 'a' ],
+ Code => '$b() = $a();',
+ BadCode => q{
+ if ( $ISBAD(mask()) ) {
+ $SETBAD(b());
+ } else {
+ $b() = $a();
+ }
+ },
+ CopyBadStatusCode => q{
+ if ( $BADFLAGCACHE() ) {
+ if ( a == b && $ISPDLSTATEGOOD(a) ) {
+ /* have inplace op AND badflag has changed */
+ PDL->propogate_badflag( b, 1 );
+ }
+ $SETPDLSTATEBAD(b);
+ }
+ },
+); # pp_def: copybad
+
+#########################################################
+
+pp_addpm({At=>'Bot'},<<'!WITHOUT!SUBS!');
+
+=head1 CHANGES
+
+The I<experimental> C<BADVAL_PER_PDL> configuration option,
+which - when set - allows per-piddle bad values, was added
+after the 2.4.2 release of PDL.
+The C<$PDL::Bad::PerPdl> variable can be
+inspected to see if this feature is available.
+
+
+=head1 CONFIGURATION
+
+The way the PDL handles the various bad value settings depends on your
+compile-time configuration settings, as held in C<perldl.conf>.
+
+=over
+
+=item C<$PDL::Config{WITH_BADVAL}>
+
+Set this configuration option to a true value if you want bad value
+support. The default setting is for this to be true.
+
+=item C<$PDL::Config{BADVAL_USENAN}>
+
+Set this configuration option to a true value if you want floating-pont
+numbers to use NaN to represent the bad value. If set to false, you can
+use any number to represent a bad value, which is generally more
+flexible. In the default configuration, this is set to a false value.
+
+=item C<$PDL::Config{BADVAL_PER_PDL}>
+
+Set this configuration option to a true value if you want each of your
+piddles to keep track of their own bad values. This means that for one
+piddle you can set the bad value to zero, while in another piddle you
+can set the bad value to NaN (or any other useful number). This is
+usually set to false.
+
+=back
+
+=head1 AUTHOR
+
+Doug Burke (djburke at cpan.org), 2000, 2001, 2003, 2006.
+
+The per-piddle bad value support is by Heiko Klein (2006).
+
+CPAN documentation fixes by David Mertens (2010, 2013).
+
+All rights reserved. There is no warranty. You are allowed to
+redistribute this software / documentation under certain conditions. For
+details, see the file COPYING in the PDL distribution. If this file is
+separated from the PDL distribution, the copyright notice should be
+included in the file.
+
+=cut
+
+!WITHOUT!SUBS!
+
+## End
diff --git a/Basic/Complex/Makefile.PL b/Basic/Complex/Makefile.PL
new file mode 100644
index 0000000..4430206
--- /dev/null
+++ b/Basic/Complex/Makefile.PL
@@ -0,0 +1,19 @@
+
+# Makefile.PL for PDL::Primitive module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+ at pack = (["complex.pd",Complex,PDL::Complex]);
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{LIBS} = ['-lm'];
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Basic/Complex/complex.pd b/Basic/Complex/complex.pd
new file mode 100644
index 0000000..c905888
--- /dev/null
+++ b/Basic/Complex/complex.pd
@@ -0,0 +1,1295 @@
+$VERSION = 0.7;
+
+# pp_setversion $VERSION; # haven't worked out why it breaks my system (CS)
+pp_beginwrap; # required for overload to work
+
+# pp_def functions go into the PDL::Complex namespace
+# to avoid clashing with PDL::FFTW funcs of the same name that go
+# into the PDL namespace
+# it should be of no effect to the user of the module but you
+# never know....
+pp_bless('PDL::Complex');
+
+pp_addpm {At => Top}, <<'EOD';
+ use PDL::Slices;
+ use PDL::Types;
+ use PDL::Bad;
+
+ use vars qw($sep $sep2);
+EOD
+
+
+pp_addpm {At => Top}, <<'EOD';
+=head1 NAME
+
+PDL::Complex - handle complex numbers
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::Complex;
+
+=head1 DESCRIPTION
+
+This module features a growing number of functions manipulating complex
+numbers. These are usually represented as a pair C<[ real imag ]> or
+C<[ angle phase ]>. If not explicitly mentioned, the functions can work
+inplace (not yet implemented!!!) and require rectangular form.
+
+While there is a procedural interface available (C<< $a/$b*$c <=> Cmul
+(Cdiv $a, $b), $c) >>), you can also opt to cast your pdl's into the
+C<PDL::Complex> datatype, which works just like your normal piddles, but
+with all the normal perl operators overloaded.
+
+The latter means that C<sin($a) + $b/$c> will be evaluated using the
+normal rules of complex numbers, while other pdl functions (like C<max>)
+just treat the piddle as a real-valued piddle with a lowest dimension of
+size 2, so C<max> will return the maximum of all real and imaginary parts,
+not the "highest" (for some definition)
+
+=head1 TIPS, TRICKS & CAVEATS
+
+=over 4
+
+=item *
+
+C<i> is a constant exported by this module, which represents
+C<-1**0.5>, i.e. the imaginary unit. it can be used to quickly and
+conviniently write complex constants like this: C<4+3*i>.
+
+=item *
+
+Use C<r2C(real-values)> to convert from real to complex, as in C<$r
+= Cpow $cplx, r2C 2>. The overloaded operators automatically do that for
+you, all the other functions, do not. So C<Croots 1, 5> will return all
+the fifths roots of 1+1*i (due to threading).
+
+=item *
+
+use C<cplx(real-valued-piddle)> to cast from normal piddles into the
+complex datatype. Use C<real(complex-valued-piddle)> to cast back. This
+requires a copy, though.
+
+=item *
+
+This module has received some testing by Vanuxem Gr�gory
+(g.vanuxem at wanadoo dot fr). Please report any other errors you
+come across!
+
+=back
+
+=head1 EXAMPLE WALK-THROUGH
+
+The complex constant five is equal to C<pdl(1,0)>:
+
+ pdl> p $x = r2C 5
+ 5 +0i
+
+Now calculate the three cubic roots of of five:
+
+ pdl> p $r = Croots $x, 3
+ [1.70998 +0i -0.854988 +1.48088i -0.854988 -1.48088i]
+
+Check that these really are the roots:
+
+ pdl> p $r ** 3
+ [5 +0i 5 -1.22465e-15i 5 -7.65714e-15i]
+
+Duh! Could be better. Now try by multiplying C<$r> three times with itself:
+
+ pdl> p $r*$r*$r
+ [5 +0i 5 -4.72647e-15i 5 -7.53694e-15i]
+
+Well... maybe C<Cpow> (which is used by the C<**> operator) isn't as
+bad as I thought. Now multiply by C<i> and negate, which is just a very
+expensive way of swapping real and imaginary parts.
+
+ pdl> p -($r*i)
+ [0 -1.70998i 1.48088 +0.854988i -1.48088 +0.854988i]
+
+Now plot the magnitude of (part of) the complex sine. First generate the
+coefficients:
+
+ pdl> $sin = i * zeroes(50)->xlinvals(2,4) + zeroes(50)->xlinvals(0,7)
+
+Now plot the imaginary part, the real part and the magnitude of the sine
+into the same diagram:
+
+ pdl> use PDL::Graphics::Gnuplot
+ pdl> gplot( with => 'lines',
+ PDL::cat(im ( sin $sin ),
+ re ( sin $sin ),
+ abs( sin $sin ) ))
+
+An ASCII version of this plot looks like this:
+
+ 30 ++-----+------+------+------+------+------+------+------+------+-----++
+ + + + + + + + + + + +
+ | $$|
+ | $ |
+ 25 ++ $$ ++
+ | *** |
+ | ** *** |
+ | $$* *|
+ 20 ++ $** ++
+ | $$$* #|
+ | $$$ * # |
+ | $$ * # |
+ 15 ++ $$$ * # ++
+ | $$$ ** # |
+ | $$$$ * # |
+ | $$$$ * # |
+ 10 ++ $$$$$ * # ++
+ | $$$$$ * # |
+ | $$$$$$$ * # |
+ 5 ++ $$$############ * # ++
+ |*****$$$### ### * # |
+ * #***** # * # |
+ | ### *** ### ** # |
+ 0 ## *** # * # ++
+ | * # * # |
+ | *** # ** # |
+ | * # * # |
+ -5 ++ ** # * # ++
+ | *** ## ** # |
+ | * #* # |
+ | **** ***## # |
+ -10 ++ **** # # ++
+ | # # |
+ | ## ## |
+ + + + + + + + ### + ### + + +
+ -15 ++-----+------+------+------+------+------+-----###-----+------+-----++
+ 0 5 10 15 20 25 30 35 40 45 50
+
+=cut
+
+my $i;
+BEGIN { $i = bless pdl 0,1 }
+sub i () { $i->copy };
+EOD
+
+for (qw(Ctan Catan re im i cplx real)) {
+ pp_add_exported '', $_;
+}
+
+pp_addhdr <<'EOH';
+
+#include <math.h>
+
+#ifndef M_PI
+# define M_PI 3.1415926535897932384626433832795029
+#endif
+#ifndef M_2PI
+# define M_2PI (2. * M_PI)
+#endif
+
+#if __GLIBC__ > 1 && (defined __USE_MISC || defined __USE_XOPEN || defined __USE_ISOC9X)
+# define CABS(r,i) hypot (r, i)
+#else
+ static double
+ CABS (double r, double i)
+ {
+ double t;
+
+ if (r < 0) r = - r;
+ if (i < 0) i = - i;
+
+ if (i > r)
+ {
+ t = r; r = i; i = t;
+ }
+
+ if (r + i == r)
+ return r;
+
+ t = i / r;
+ return r * sqrt (1 + t*t);
+ }
+#endif
+
+#if __GLIBC__ >= 2 && __GLIBC_MINOR__ >= 1 && defined __USE_GNU
+# define SINCOS(x,s,c) sincos ((x), &(s), &(c))
+#else
+# define SINCOS(x,s,c) \
+ (s) = sin (x); \
+ (c) = cos (x);
+#endif
+
+
+#define CSQRT(type,ar,ai,cr,ci) \
+ type mag = CABS ((ar), (ai)); \
+ type t; \
+ \
+ if (mag == 0) \
+ (cr) = (ci) = 0; \
+ else if ((ar) > 0) \
+ { \
+ t = sqrt (0.5 * (mag + (ar))); \
+ (cr) = t; \
+ (ci) = 0.5 * (ai) / t; \
+ } \
+ else \
+ { \
+ t = sqrt (0.5 * (mag - (ar))); \
+ \
+ if ((ai) < 0) \
+ t = -t; \
+ \
+ (cr) = 0.5 * (ai) / t; \
+ (ci) = t; \
+ }
+
+
+#define CLOG(ar,ai,cr,ci) \
+ (cr) = log (CABS ((ar), (ai))); \
+ (ci) = atan2 ((ai), (ar));
+
+EOH
+
+pp_addpm <<'EOP';
+
+=head2 cplx real-valued-pdl
+
+Cast a real-valued piddle to the complex datatype. The first dimension of
+the piddle must be of size 2. After this the usual (complex) arithmetic
+operators are applied to this pdl, rather than the normal elementwise pdl
+operators. Dataflow to the complex parent works. Use C<sever> on the result
+if you don't want this.
+
+
+=head2 complex real-valued-pdl
+
+Cast a real-valued piddle to the complex datatype I<without> dataflow
+and I<inplace>. Achieved by merely reblessing a piddle. The first dimension of
+the piddle must be of size 2.
+
+=head2 real cplx-valued-pdl
+
+Cast a complex valued pdl back to the "normal" pdl datatype. Afterwards
+the normal elementwise pdl operators are used in operations. Dataflow
+to the real parent works. Use C<sever> on the result if you don't want this.
+
+=cut
+
+use Carp;
+sub cplx($) {
+ return $_[0] if UNIVERSAL::isa($_[0],'PDL::Complex'); # NOOP if just piddle
+ croak "first dimsize must be 2" unless $_[0]->dims > 0 && $_[0]->dim(0) == 2;
+ bless $_[0]->slice('');
+}
+
+sub complex($) {
+ return $_[0] if UNIVERSAL::isa($_[0],'PDL::Complex'); # NOOP if just piddle
+ croak "first dimsize must be 2" unless $_[0]->dims > 0 && $_[0]->dim(0) == 2;
+ bless $_[0];
+}
+
+*PDL::cplx = \&cplx;
+*PDL::complex = \&complex;
+
+sub real($) {
+ return $_[0] unless UNIVERSAL::isa($_[0],'PDL::Complex'); # NOOP unless complex
+ bless $_[0]->slice(''), 'PDL';
+}
+
+EOP
+
+pp_def 'r2C',
+ Pars => 'r(); [o]c(m=2)',
+ Doc => 'convert real to complex, assuming an imaginary part of zero',
+ PMCode => << 'EOPM',
+
+*PDL::r2C = \&PDL::Complex::r2C;
+sub PDL::Complex::r2C($) {
+ return $_[0] if UNIVERSAL::isa($_[0],'PDL::Complex');
+ my $r = __PACKAGE__->initialize;
+ &PDL::Complex::_r2C_int($_[0], $r);
+ $r }
+
+EOPM
+ Code => q!
+ $c(m=>0) = $r();
+ $c(m=>1) = 0;
+ !
+;
+
+pp_def 'i2C',
+ Pars => 'r(); [o]c(m=2)',
+ Doc => 'convert imaginary to complex, assuming a real part of zero',
+ PMCode => '*PDL::i2C = \&PDL::Complex::i2C; sub PDL::Complex::i2C($) { my $r = __PACKAGE__->initialize; &PDL::Complex::_i2C_int($_[0], $r); $r }',
+ Code => q!
+ $c(m=>0) = 0;
+ $c(m=>1) = $r();
+ !
+;
+
+pp_def 'Cr2p',
+ Pars => 'r(m=2); float+ [o]p(m=2)',
+ Inplace => 1,
+ Doc => 'convert complex numbers in rectangular form to polar (mod,arg) form. Works inplace',
+ Code => q!
+ $GENERIC() x = $r(m=>0);
+ $GENERIC() y = $r(m=>1);
+ $p(m=>0) = CABS (x, y);
+ $p(m=>1) = atan2 (y, x);
+ !
+;
+
+pp_def 'Cp2r',
+ Pars => 'r(m=2); [o]p(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => 'convert complex numbers in polar (mod,arg) form to rectangular form. Works inplace',
+ Code => q!
+ $GENERIC() m = $r(m=>0);
+ $GENERIC() a = $r(m=>1);
+ double s, c;
+
+ SINCOS (a, s, c);
+ $p(m=>0) = c * m;
+ $p(m=>1) = s * m;
+ !
+;
+
+pp_def 'Cadd', # this is here for a) completeness and b) not having to mess with PDL::Ops
+ Pars => 'a(m=2); b(m=2); [o]c(m=2)',
+ Doc => undef,
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ $GENERIC() br = $b(m=>0), bi = $b(m=>1);
+ $c(m=>0) = ar + br;
+ $c(m=>1) = ai + bi;
+ ^
+;
+
+pp_def 'Csub', # this is here for a) completeness and b) not having to mess with PDL::Ops
+ Pars => 'a(m=2); b(m=2); [o]c(m=2)',
+ Doc => undef,
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ $GENERIC() br = $b(m=>0), bi = $b(m=>1);
+ $c(m=>0) = ar - br;
+ $c(m=>1) = ai - bi;
+ ^
+;
+
+pp_def 'Cmul',
+ Pars => 'a(m=2); b(m=2); [o]c(m=2)',
+ Doc => 'complex multiplication',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ $GENERIC() br = $b(m=>0), bi = $b(m=>1);
+ $c(m=>0) = ar*br - ai*bi;
+ $c(m=>1) = ar*bi + ai*br;
+ ^
+;
+
+pp_def 'Cprodover',
+ Pars => 'a(m=2,n); [o]c(m=2)',
+ Doc => 'Project via product to N-1 dimension',
+ Code => q^
+ PDL_Long iter;
+ $GENERIC() br, bi, cr, ci,tmp;
+ cr = $a(m=>0,n=>0);
+ ci = $a(m=>1,n=>0);
+ for (iter=1; iter < $SIZE(n);iter++)
+ {
+ br = $a(m=>0,n=>iter);
+ bi = $a(m=>1,n=>iter);
+ tmp = cr*bi + ci*br;
+ cr = cr*br - ci*bi;
+ ci = tmp;
+ }
+ $c(m=>0) = cr;
+ $c(m=>1) = ci;
+ ^
+;
+
+pp_def 'Cscale',
+ Pars => 'a(m=2); b(); [o]c(m=2)',
+ Doc => 'mixed complex/real multiplication',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ $c(m=>0) = ar * $b();
+ $c(m=>1) = ai * $b();
+ ^
+;
+
+pp_def 'Cdiv',
+ Pars => 'a(m=2); b(m=2); [o]c(m=2)',
+ GenericTypes => [F,D],
+ Doc => 'complex division',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ $GENERIC() br = $b(m=>0), bi = $b(m=>1);
+
+ if (fabs (br) > fabs (bi))
+ {
+ $GENERIC() tt = bi / br;
+ $GENERIC() dn = br + tt * bi;
+ $c(m=>0) = (ar + tt * ai) / dn;
+ $c(m=>1) = (ai - tt * ar) / dn;
+ }
+ else
+ {
+ $GENERIC() tt = br / bi;
+ $GENERIC() dn = br * tt + bi;
+ $c(m=>0) = (ar * tt + ai) / dn;
+ $c(m=>1) = (ai * tt - ar) / dn;
+ }
+ ^
+;
+
+pp_def 'Ccmp',
+ Pars => 'a(m=2); b(m=2); [o]c()',
+ GenericTypes => [F,D],
+ Doc => 'Complex comparison oeprator (spaceship). It orders by real first, then by imaginary. Hm, but it is mathematical nonsense! Complex numbers cannot be ordered.',
+ Code => q^
+ $GENERIC() a, b;
+
+ a = $a(m=>0), b = $b(m=>0);
+ if (a != b)
+ $c() = (a > b) * 2 - 1;
+ else
+ {
+ a = $a(m=>1), b = $b(m=>1);
+ $c() = a == b ? 0
+ : (a > b) * 2 - 1;
+ }
+ ^
+;
+
+pp_def 'Cconj',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ Doc => 'complex conjugation. Works inplace',
+ Code => q^
+ $c(m=>0) = $a(m=>0);
+ $c(m=>1) = -$a(m=>1);
+ ^
+;
+
+pp_def 'Cabs',
+ Pars => 'a(m=2); [o]c()',
+ GenericTypes => [F,D],
+ Doc => 'complex C<abs()> (also known as I<modulus>)',
+ PMCode => q^sub PDL::Complex::Cabs($) {
+ my $pdl= shift;
+ my $abs = PDL->null;
+ &PDL::Complex::_Cabs_int($pdl, $abs);
+ $abs;
+ }^,
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ $c() = CABS (ar, ai);
+ ^
+;
+
+pp_def 'Cabs2',
+ Pars => 'a(m=2); [o]c()',
+ Doc => 'complex squared C<abs()> (also known I<squared modulus>)',
+ PMCode => q^sub PDL::Complex::Cabs2($) {
+ my $pdl= shift;
+ my $abs2 = PDL->null;
+ &PDL::Complex::_Cabs2_int($pdl, $abs2);
+ $abs2;
+ }^,
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ $c() = ar*ar + ai*ai;
+ ^
+;
+
+pp_def 'Carg',
+ Pars => 'a(m=2); [o]c()',
+ GenericTypes => [F,D],
+ Doc => 'complex argument function ("angle")',
+ PMCode => q^sub PDL::Complex::Carg($) {
+ my $pdl= shift;
+ my $arg = PDL->null;
+ &PDL::Complex::_Carg_int($pdl, $arg);
+ $arg;
+ }^,
+ Code => q^
+ $c() = atan2 ($a(m=>1), $a(m=>0));
+ ^
+;
+
+pp_def 'Csin',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => ' sin (a) = 1/(2*i) * (exp (a*i) - exp (-a*i)). Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ double s, c;
+
+ SINCOS (ar, s, c);
+ $c(m=>0) = s * cosh (ai);
+ $c(m=>1) = c * sinh (ai);
+ ^
+;
+
+pp_def 'Ccos',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => ' cos (a) = 1/2 * (exp (a*i) + exp (-a*i)). Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ double s, c;
+
+ SINCOS (ar, s, c);
+ $c(m=>0) = c * cosh (ai);
+ $c(m=>1) = - s * sinh (ai);
+ ^
+;
+
+pp_addpm <<'EOD';
+
+=head2 Ctan a [not inplace]
+
+ tan (a) = -i * (exp (a*i) - exp (-a*i)) / (exp (a*i) + exp (-a*i))
+
+=cut
+
+sub Ctan($) { Csin($_[0]) / Ccos($_[0]) }
+
+
+EOD
+
+pp_def 'Cexp',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => 'exp (a) = exp (real (a)) * (cos (imag (a)) + i * sin (imag (a))). Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ $GENERIC() ex = exp (ar);
+ double s, c;
+
+ SINCOS (ai, s, c);
+ $c(m=>0) = ex * c;
+ $c(m=>1) = ex * s;
+ ^
+;
+
+pp_def 'Clog',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => 'log (a) = log (cabs (a)) + i * carg (a). Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+
+ CLOG (ar, ai, $c(m=>0), $c(m=>1));
+ ^
+;
+
+pp_def 'Cpow',
+ Pars => 'a(m=2); b(m=2); [o]c(m=2)',
+ Inplace => ['a'],
+ GenericTypes => [F,D],
+ Doc => 'complex C<pow()> (C<**>-operator)',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ $GENERIC() br = $b(m=>0), bi = $b(m=>1);
+
+ double logr, logi, x, y;
+ double s, c;
+
+ if(ar == 0 && ai == 0){
+ if(br == 0 && bi == 0) {
+ $c(m=>0) = 1;
+ $c(m=>1) = 0;
+ }
+ else {
+ $c(m=>0) = 0;
+ $c(m=>1) = 0;
+ }
+ }
+ else {
+ CLOG (ar, ai, logr, logi);
+ x = exp (logr*br - logi*bi);
+ y = logr*bi + logi*br;
+
+ SINCOS (y, s, c);
+
+ $c(m=>0) = x * c;
+ if(ai == 0 && bi == 0) $c(m=>1) = 0;
+ else $c(m=>1) = x * s;
+ }
+ ^
+;
+
+pp_def 'Csqrt',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => 'Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+
+ CSQRT ($GENERIC(), ar, ai, $c(m=>0), $c(m=>1));
+ ^
+;
+
+pp_def 'Casin',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => 'Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+
+ $GENERIC() t1 = sqrt ((ar+1)*(ar+1) + ai*ai);
+ $GENERIC() t2 = sqrt ((ar-1)*(ar-1) + ai*ai);
+ $GENERIC() alpha = (t1+t2)*0.5;
+ $GENERIC() beta = (t1-t2)*0.5;
+
+ if (alpha < 1) alpha = 1;
+ if (beta > 1) beta = 1;
+ else if (beta < -1) beta = -1;
+
+ $c(m=>0) = atan2 (beta, sqrt (1-beta*beta));
+ $c(m=>1) = - log (alpha + sqrt (alpha*alpha-1));
+ if (ai > 0 || (ai == 0 && ar < -1))
+ $c(m=>1) = - $c(m=>1);
+ ^
+;
+
+pp_def 'Cacos',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => 'Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+
+ $GENERIC() t1 = sqrt ((ar+1)*(ar+1) + ai*ai);
+ $GENERIC() t2 = sqrt ((ar-1)*(ar-1) + ai*ai);
+ $GENERIC() alpha = (t1+t2)*0.5;
+ $GENERIC() beta = (t1-t2)*0.5;
+
+ if (alpha < 1) alpha = 1;
+ if (beta > 1) beta = 1;
+ else if (beta < -1) beta = -1;
+
+ $c(m=>0) = atan2 (sqrt (1-beta*beta), beta);
+ $c(m=>1) = log (alpha + sqrt (alpha*alpha-1));
+ if (ai > 0 || (ai == 0 && ar < -1))
+ $c(m=>1) = - $c(m=>1);
+ ^
+;
+
+pp_addpm <<'EOD';
+
+=head2 Catan cplx [not inplace]
+
+Return the complex C<atan()>.
+
+=cut
+
+sub Catan($) {
+ my $z = shift;
+ Cmul Clog(Cdiv (PDL::Complex::i+$z, PDL::Complex::i-$z)), pdl(0, 0.5);
+}
+
+EOD
+
+pp_def 'Csinh',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => ' sinh (a) = (exp (a) - exp (-a)) / 2. Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ double s, c;
+
+ SINCOS (ai, s, c);
+ $c(m=>0) = sinh (ar) * c;
+ $c(m=>1) = cosh (ar) * s;
+ ^
+;
+
+pp_def 'Ccosh',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => ' cosh (a) = (exp (a) + exp (-a)) / 2. Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ double s, c;
+
+ SINCOS (ai, s, c);
+ $c(m=>0) = cosh (ar) * c;
+ $c(m=>1) = sinh (ar) * s;
+ ^
+;
+
+pp_def 'Ctanh',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => 'Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ double den;
+ double s, c;
+
+ SINCOS (2*ai, s, c);
+ den = cosh (2*ar) + c;
+
+ $c(m=>0) = sinh (2*ar) / den;
+ $c(m=>1) = s / den;
+ ^
+;
+
+pp_def 'Casinh',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => 'Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+ $GENERIC() yr = (ar-ai) * (ar+ai) + 1;
+ $GENERIC() yi = 2*ar*ai;
+
+ CSQRT ($GENERIC(), yr, yi, yr, yi)
+
+ yr += ar;
+ yi += ai;
+
+ CLOG (yr, yi, $c(m=>0), $c(m=>1));
+ ^
+;
+
+pp_def 'Cacosh',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => 'Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+
+ $GENERIC() yr = (ar-ai) * (ar+ai) - 1;
+ $GENERIC() yi = 2*ar*ai;
+
+ CSQRT ($GENERIC(), yr, yi, yr, yi)
+
+ yr += ar;
+ yi += ai;
+
+ CLOG (yr, yi, $c(m=>0), $c(m=>1));
+ ^
+;
+
+pp_def 'Catanh',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => 'Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+
+ double i2 = ai*ai;
+ double num = i2 + (1+ar) * (1+ar);
+ double den = i2 + (1-ar) * (1-ar);
+
+ $c(m=>0) = 0.25 * (log(num) - log(den));
+ $c(m=>1) = 0.5 * atan2 (2*ai, 1 - ar*ar - i2);
+ ^
+;
+
+pp_def 'Cproj',
+ Pars => 'a(m=2); [o]c(m=2)',
+ Inplace => 1,
+ GenericTypes => [F,D],
+ Doc => 'compute the projection of a complex number to the riemann sphere. Works inplace',
+ Code => q^
+ $GENERIC() ar = $a(m=>0), ai = $a(m=>1);
+
+ double den = ar*ar + ai*ai + 1;
+
+ $c(m=>0) = 2*ar / den;
+ $c(m=>1) = 2*ai / den;
+ ^
+;
+
+pp_def 'Croots',
+ Pars => 'a(m=2); [o]c(m=2,n)',
+ OtherPars => 'int n => n',
+ GenericTypes => [F,D],
+ Doc => 'Compute the C<n> roots of C<a>. C<n> must be a positive integer. The result will always be a complex type!',
+ PMCode => q^sub PDL::Complex::Croots($$) {
+ my ($pdl, $n) = @_;
+ my $r = PDL->null;
+ &PDL::Complex::_Croots_int($pdl, $r, $n);
+ bless $r;
+ }^,
+ Code => q^
+ double s, c;
+ double ar = $a(m=>0), ai = $a(m=>1),
+ n1 = 1 / (double)$COMP(n),
+ rr = pow (CABS (ar, ai), n1), /* do not optimize the sqrt out of this expr! */
+ at = atan2 (ai, ar) * n1,
+ ti = M_2PI * n1;
+
+ loop(n) %{
+ SINCOS (at, s, c);
+
+ $c(m=>0) = rr * c;
+ $c(m=>1) = rr * s;
+
+ at += ti;
+ %}
+ ^
+;
+
+pp_addpm <<'EOD';
+
+=head2 re cplx, im cplx
+
+Return the real or imaginary part of the complex number(s) given. These
+are slicing operators, so data flow works. The real and imaginary parts
+are returned as piddles (ref eq PDL).
+
+=cut
+
+sub re($) { bless $_[0]->slice("(0)"), 'PDL'; }
+sub im($) { bless $_[0]->slice("(1)"), 'PDL'; }
+
+*PDL::Complex::re = \&re;
+*PDL::Complex::im = \&im;
+
+EOD
+
+pp_def 'rCpolynomial',
+ Pars => 'coeffs(n); x(c=2,m); [o]out(c=2,m)',
+ Doc => 'evaluate the polynomial with (real) coefficients C<coeffs> at the (complex) position(s) C<x>. C<coeffs[0]> is the constant term.',
+ GenericTypes => [F,D],
+ Code => q!
+ loop(m) %{
+ double xr = 1;
+ double xi = 0;
+ double or = 0;
+ double oi = 0;
+ double Xr;
+
+ loop(n) %{
+ or += $coeffs() * xr;
+ oi += $coeffs() * xi;
+
+ Xr = xr;
+ xr = Xr * $x(c=>0) - xi * $x(c=>1);
+ xi = xi * $x(c=>0) + Xr * $x(c=>1);
+ %}
+
+ $out(c=>0) = or;
+ $out(c=>1) = oi;
+ %}
+ !
+;
+
+pp_add_isa 'PDL';
+
+pp_addpm {At => Bot}, <<'EOD';
+
+# overload must be here, so that all the functions can be seen
+
+# undocumented compatibility functions
+sub Catan2($$) { Catan Cdiv $_[1], $_[0] }
+sub atan2($$) { Catan Cdiv $_[1], $_[0] }
+
+sub _gen_biop {
+ local $_ = shift;
+ my $sub;
+ if (/(\S+)\+(\w+)/) {
+ $sub = eval 'sub { '.$2.' $_[0], ref $_[1] eq __PACKAGE__ ? $_[1] : r2C $_[1] }';
+ } elsif (/(\S+)\-(\w+)/) {
+ $sub = eval 'sub { my $b = ref $_[1] eq __PACKAGE__ ? $_[1] : r2C $_[1];
+ $_[2] ? '.$2.' $b, $_[0] : '.$2.' $_[0], $b }';
+ } else {
+ die;
+ }
+ if($1 eq "atan2" || $1 eq "<=>") { return ($1, $sub) }
+ ($1, $sub, "$1=", $sub);
+}
+
+sub _gen_unop {
+ my ($op, $func) = ($_[0] =~ /(.+)@(\w+)/);
+ *$op = \&$func if $op =~ /\w+/; # create an alias
+ ($op, eval 'sub { '.$func.' $_[0] }');
+}
+
+sub _gen_cpop {
+ ($_[0], eval 'sub { my $b = ref $_[1] eq __PACKAGE__ ? $_[1] : r2C $_[1];
+ ($_[2] ? $b <=> $_[0] : $_[0] <=> $b) '.$_[0].' 0 }');
+}
+
+sub initialize {
+ # Bless a null PDL into the supplied 1st arg package
+ # If 1st arg is a ref, get the package from it
+ bless PDL->null, ref($_[0]) ? ref($_[0]) : $_[0];
+}
+
+use overload
+ (map _gen_biop($_), qw(++Cadd --Csub *+Cmul /-Cdiv **-Cpow atan2-Catan2 <=>-Ccmp)),
+ (map _gen_unop($_), qw(sin at Csin cos at Ccos exp at Cexp abs at Cabs log at Clog sqrt at Csqrt abs at Cabs)),
+ (map _gen_cpop($_), qw(< <= == != >= >)),
+ '++' => sub { $_[0] += 1 },
+ '--' => sub { $_[0] -= 1 },
+ '""' => \&PDL::Complex::string
+;
+
+# overwrite PDL's overloading to honour subclass methods in + - * /
+{ package PDL;
+ my $warningFlag;
+ # This strange usage of BEGINs is to ensure the
+ # warning messages get disabled and enabled in the
+ # proper order. Without the BEGIN's the 'use overload'
+ # would be called first.
+ BEGIN {$warningFlag = $^W; # Temporarily disable warnings caused by
+ $^W = 0; # redefining PDL's subs
+ }
+
+
+sub cp(;@) {
+ my $foo;
+ if (ref $_[1]
+ && (ref $_[1] ne 'PDL')
+ && defined ($foo = overload::Method($_[1],'+')))
+ { &$foo($_[1], $_[0], !$_[2])}
+ else { PDL::plus (@_)}
+}
+
+sub cm(;@) {
+ my $foo;
+ if (ref $_[1]
+ && (ref $_[1] ne 'PDL')
+ && defined ($foo = overload::Method($_[1],'*')))
+ { &$foo($_[1], $_[0], !$_[2])}
+ else { PDL::mult (@_)}
+}
+
+sub cmi(;@) {
+ my $foo;
+ if (ref $_[1]
+ && (ref $_[1] ne 'PDL')
+ && defined ($foo = overload::Method($_[1],'-')))
+ { &$foo($_[1], $_[0], !$_[2])}
+ else { PDL::minus (@_)}
+}
+
+sub cd(;@) {
+ my $foo;
+ if (ref $_[1]
+ && (ref $_[1] ne 'PDL')
+ && defined ($foo = overload::Method($_[1],'/')))
+ { &$foo($_[1], $_[0], !$_[2])}
+ else { PDL::divide (@_)}
+}
+
+
+ # Used in overriding standard PDL +, -, *, / ops in the complex subclass.
+ use overload (
+ '+' => \&cp,
+ '*' => \&cm,
+ '-' => \&cmi,
+ '/' => \&cd,
+ );
+
+
+
+ BEGIN{ $^W = $warningFlag;} # Put Back Warnings
+};
+
+
+{
+
+ our $floatformat = "%4.4g"; # Default print format for long numbers
+ our $doubleformat = "%6.6g";
+
+ $PDL::Complex::_STRINGIZING = 0;
+
+ sub PDL::Complex::string {
+ my($self,$format1,$format2)=@_;
+ my @dims = $self->dims;
+ return PDL::string($self) if ($dims[0] != 2);
+
+ if($PDL::Complex::_STRINGIZING) {
+ return "ALREADY_STRINGIZING_NO_LOOPS";
+ }
+ local $PDL::Complex::_STRINGIZING = 1;
+ my $ndims = $self->getndims;
+ if($self->nelem > $PDL::toolongtoprint) {
+ return "TOO LONG TO PRINT";
+ }
+ if ($ndims==0){
+ PDL::Core::string($self,$format1);
+ }
+ return "Null" if $self->isnull;
+ return "Empty" if $self->isempty; # Empty piddle
+ local $sep = $PDL::use_commas ? ", " : " ";
+ local $sep2 = $PDL::use_commas ? ", " : "";
+ if ($ndims < 3) {
+ return str1D($self,$format1,$format2);
+ }
+ else{
+ return strND($self,$format1,$format2,0);
+ }
+ }
+
+
+ sub sum {
+ my($x) = @_;
+ my $tmp = $x->mv(0,1)->clump(0,2)->mv(1,0)->sumover;
+ return $tmp->squeeze;
+ }
+
+ sub sumover{
+ my $m = shift;
+ PDL::Ufunc::sumover($m->xchg(0,1));
+ }
+
+
+ sub strND {
+ my($self,$format1,$format2,$level)=@_;
+ my @dims = $self->dims;
+
+ if ($#dims==2) {
+ return str2D($self,$format1,$format2,$level);
+ }
+ else {
+ my $secbas = join '',map {":,"} @dims[0..$#dims-1];
+ my $ret="\n"." "x$level ."["; my $j;
+ for ($j=0; $j<$dims[$#dims]; $j++) {
+ my $sec = $secbas . "($j)";
+
+ $ret .= strND($self->slice($sec),$format1,$format2, $level+1);
+ chop $ret; $ret .= $sep2;
+ }
+ chop $ret if $PDL::use_commas;
+ $ret .= "\n" ." "x$level ."]\n";
+ return $ret;
+ }
+ }
+
+
+ # String 1D array in nice format
+ #
+ sub str1D {
+ my($self,$format1,$format2)=@_;
+ barf "Not 1D" if $self->getndims() > 2;
+ my $x = PDL::Core::listref_c($self);
+ my ($ret,$dformat,$t, $i);
+
+ my $dtype = $self->get_datatype();
+ $dformat = $PDL::Complex::floatformat if $dtype == $PDL_F;
+ $dformat = $PDL::Complex::doubleformat if $dtype == $PDL_D;
+
+ $ret = "[" if $self->getndims() > 1;
+ my $badflag = $self->badflag();
+ for($i=0; $i<=$#$x; $i++){
+ $t = $$x[$i];
+ if ( $badflag and $t eq "BAD" ) {
+ # do nothing
+ } elsif ($format1) {
+ $t = sprintf $format1,$t;
+ } else{ # Default
+ if ($dformat && length($t)>7) { # Try smaller
+ $t = sprintf $dformat,$t;
+ }
+ }
+ $ret .= $i % 2 ?
+ $i<$#$x ? $t."i$sep" : $t."i"
+ : substr($$x[$i+1],0,1) eq "-" ? "$t " : $t." +";
+ }
+ $ret.="]" if $self->getndims() > 1;
+ return $ret;
+ }
+
+
+ sub str2D {
+ my($self,$format1,$format2,$level)=@_;
+ my @dims = $self->dims();
+ barf "Not 2D" if scalar(@dims)!=3;
+ my $x = PDL::Core::listref_c($self);
+ my ($i, $f, $t, $len1, $len2, $ret);
+
+ my $dtype = $self->get_datatype();
+ my $badflag = $self->badflag();
+
+ my $findmax = 0;
+
+ if (!defined $format1 || !defined $format2 ||
+ $format1 eq '' || $format2 eq '') {
+ $len1= $len2 = 0;
+
+ if ( $badflag ) {
+ for ($i=0; $i<=$#$x; $i++) {
+ if ( $$x[$i] eq "BAD" ) {
+ $f = 3;
+ }
+ else {
+ $f = length($$x[$i]);
+ }
+ if ($i % 2) {
+ $len2 = $f if $f > $len2;
+ }
+ else {
+ $len1 = $f if $f > $len1;
+ }
+ }
+ } else {
+ for ($i=0; $i<=$#$x; $i++) {
+ $f = length($$x[$i]);
+ if ($i % 2){
+ $len2 = $f if $f > $len2;
+ }
+ else{
+ $len1 = $f if $f > $len1;
+ }
+ }
+ }
+
+ $format1 = '%'.$len1.'s';
+ $format2 = '%'.$len2.'s';
+
+ if ($len1 > 5){
+ if ($dtype == $PDL_F) {
+ $format1 = $PDL::Complex::floatformat;
+ $findmax = 1;
+ } elsif ($dtype == $PDL_D) {
+ $format1 = $PDL::Complex::doubleformat;
+ $findmax = 1;
+ } else {
+ $findmax = 0;
+ }
+ }
+ if($len2 > 5){
+ if ($dtype == $PDL_F) {
+ $format2 = $PDL::Complex::floatformat;
+ $findmax = 1;
+ } elsif ($dtype == $PDL_D) {
+ $format2 = $PDL::Complex::doubleformat;
+ $findmax = 1;
+ } else {
+ $findmax = 0 unless $findmax;
+ }
+ }
+ }
+
+ if($findmax) {
+ $len1 = $len2=0;
+
+ if ( $badflag ) {
+ for($i=0; $i<=$#$x; $i++){
+ $findmax = $i % 2;
+ if ( $$x[$i] eq 'BAD' ){
+ $f = 3;
+ }
+ else{
+ $f = $findmax ? length(sprintf $format2,$$x[$i]) :
+ length(sprintf $format1,$$x[$i]);
+ }
+ if ($findmax){
+ $len2 = $f if $f > $len2;
+ }
+ else{
+ $len1 = $f if $f > $len1;
+ }
+ }
+ } else {
+ for ($i=0; $i<=$#$x; $i++) {
+ if ($i % 2){
+ $f = length(sprintf $format2,$$x[$i]);
+ $len2 = $f if $f > $len2;
+ }
+ else{
+ $f = length(sprintf $format1,$$x[$i]);
+ $len1 = $f if $f > $len1;
+ }
+ }
+ }
+
+
+ } # if: $findmax
+
+ $ret = "\n" . ' 'x$level . "[\n";
+ {
+ my $level = $level+1;
+ $ret .= ' 'x$level .'[';
+ $len2 += 2;
+
+ for ($i=0; $i<=$#$x; $i++) {
+ $findmax = $i % 2;
+ if ($findmax){
+ if ( $badflag and $$x[$i] eq 'BAD' ){
+ #||
+ #($findmax && $$x[$i - 1 ] eq 'BAD') ||
+ #(!$findmax && $$x[$i +1 ] eq 'BAD')){
+ $f = "BAD";
+ }
+ else{
+ $f = sprintf $format2, $$x[$i];
+ if (substr($$x[$i],0,1) eq '-'){
+ $f.='i';
+ }
+ else{
+ $f =~ s/(\s*)(.*)/+$2i/;
+ }
+ }
+ $t = $len2-length($f);
+ }
+ else{
+ if ( $badflag and $$x[$i] eq 'BAD' ){
+ $f = "BAD";
+ }
+ else{
+ $f = sprintf $format1, $$x[$i];
+ $t = $len1-length($f);
+ }
+ }
+
+ $f = ' 'x$t.$f if $t>0;
+
+ $ret .= $f;
+ if (($i+1)%($dims[1]*2)) {
+ $ret.=$sep if $findmax;
+ }
+ else{ # End of output line
+ $ret.=']';
+ if ($i==$#$x) { # very last number
+ $ret.="\n";
+ }
+ else{
+ $ret.= $sep2."\n" . ' 'x$level .'[';
+ }
+ }
+ }
+ }
+ $ret .= ' 'x$level."]\n";
+ return $ret;
+ }
+
+}
+
+=head1 AUTHOR
+
+Copyright (C) 2000 Marc Lehmann <pcg at goof.com>.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation as described
+in the file COPYING in the PDL distribution.
+
+=head1 SEE ALSO
+
+perl(1), L<PDL>.
+
+=cut
+
+
+EOD
+
+pp_done;
+
diff --git a/Basic/Constants.pm b/Basic/Constants.pm
new file mode 100644
index 0000000..e883b72
--- /dev/null
+++ b/Basic/Constants.pm
@@ -0,0 +1,84 @@
+=head1 NAME
+
+PDL::Constants -- basic compile time constants for PDL
+
+=head1 DESCRIPTION
+
+This module is used to define compile time constant
+values for PDL. It uses the constant module for
+simplicity and availability. We'll need to sort
+out exactly which constants make sense but PI and
+E seem to be fundamental.
+
+=head1 SYNOPSIS
+
+ use PDL::Constants qw(PI E);
+ print 'PI is ' . PI . "\n";
+ print 'E is ' . E . "\n";
+
+=cut
+
+package PDL::Constants;
+our $VERSION = "0.02";
+$VERSION = eval $VERSION;
+
+require Exporter;
+ at ISA = qw(Exporter);
+ at EXPORT_OK = qw(PI E I J); # symbols to export
+
+use PDL::Lite;
+use PDL::Complex qw(i);
+
+=head2 PI
+
+The ratio of a circle's circumference to its diameter
+
+=cut
+
+use constant PI => 4 * atan2(1, 1);
+
+=head2 DEGRAD
+
+The The number of degrees of arc per radian (180/PI)
+
+=cut
+
+use constant DEGRAD => 180/PI;
+
+=head2 E
+
+The base of the natural logarithms or Euler's number
+
+=cut
+
+use constant E => exp(1);
+
+=head2 I
+
+The imaginary unit, C< I*I == -1 >
+
+=cut
+
+use constant I => i;
+
+=head2 J
+
+The imaginary unit for engineers, C< J*J == -1 >
+
+=cut
+
+use constant J => i;
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Chris Marshall (chm at cpan dot org).
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+
+=cut
+
+1;
diff --git a/Basic/Core/Basic.pm b/Basic/Core/Basic.pm
new file mode 100644
index 0000000..7650a21
--- /dev/null
+++ b/Basic/Core/Basic.pm
@@ -0,0 +1,776 @@
+
+=head1 NAME
+
+PDL::Basic -- Basic utility functions for PDL
+
+=head1 DESCRIPTION
+
+This module contains basic utility functions for
+creating and manipulating piddles. Most of these functions
+are simplified interfaces to the more flexible functions in
+the modules
+L<PDL::Primitive|PDL::Primitive>
+and
+L<PDL::Slices|PDL::Slices>.
+
+=head1 SYNOPSIS
+
+ use PDL::Basic;
+
+=head1 FUNCTIONS
+
+=cut
+
+package PDL::Basic;
+use PDL::Core '';
+use PDL::Types;
+use PDL::Exporter;
+use PDL::Options;
+
+ at ISA=qw/PDL::Exporter/;
+ at EXPORT_OK = qw/ ndcoords rvals axisvals allaxisvals xvals yvals zvals sec ins hist whist
+ similar_assign transpose sequence xlinvals ylinvals
+ zlinvals axislinvals/;
+%EXPORT_TAGS = (Func=>[@EXPORT_OK]);
+
+# Exportable functions
+*axisvals = \&PDL::axisvals;
+*allaxisvals = \&PDL::allaxisvals;
+*sec = \&PDL::sec;
+*ins = \&PDL::ins;
+*hist = \&PDL::hist;
+*whist = \&PDL::whist;
+*similar_assign = \&PDL::similar_assign;
+*transpose = \&PDL::transpose;
+*xlinvals = \&PDL::xlinvals;
+*ylinvals = \&PDL::ylinvals;
+*zlinvals = \&PDL::zlinvals;
+
+=head2 xvals
+
+=for ref
+
+Fills a piddle with X index values. Uses similar specifications to
+L<zeroes|zeroes> and L<new_from_specification|new_from_specification>.
+
+CAVEAT:
+
+If you use the single argument piddle form (top row
+in the usage table) the output will have the same type as the input;
+this may give surprising results if, e.g., you have a byte array with
+a dimension of size greater than 256. To force a type, use the third form.
+
+=for usage
+
+ $x = xvals($somearray);
+ $x = xvals([OPTIONAL TYPE],$nx,$ny,$nz...);
+ $x = xvals([OPTIONAL TYPE], $somarray->dims);
+
+etc. see L<zeroes|PDL::Core/zeroes>.
+
+=for example
+
+ pdl> print xvals zeroes(5,10)
+ [
+ [0 1 2 3 4]
+ [0 1 2 3 4]
+ [0 1 2 3 4]
+ [0 1 2 3 4]
+ [0 1 2 3 4]
+ [0 1 2 3 4]
+ [0 1 2 3 4]
+ [0 1 2 3 4]
+ [0 1 2 3 4]
+ [0 1 2 3 4]
+ ]
+
+=head2 yvals
+
+=for ref
+
+Fills a piddle with Y index values. See the CAVEAT for L<xvals|xvals>.
+
+=for usage
+
+ $x = yvals($somearray); yvals(inplace($somearray));
+ $x = yvals([OPTIONAL TYPE],$nx,$ny,$nz...);
+
+etc. see L<zeroes|PDL::Core/zeroes>.
+
+=for example
+
+ pdl> print yvals zeroes(5,10)
+ [
+ [0 0 0 0 0]
+ [1 1 1 1 1]
+ [2 2 2 2 2]
+ [3 3 3 3 3]
+ [4 4 4 4 4]
+ [5 5 5 5 5]
+ [6 6 6 6 6]
+ [7 7 7 7 7]
+ [8 8 8 8 8]
+ [9 9 9 9 9]
+ ]
+
+=head2 zvals
+
+=for ref
+
+Fills a piddle with Z index values. See the CAVEAT for L<xvals|xvals>.
+
+=for usage
+
+ $x = zvals($somearray); zvals(inplace($somearray));
+ $x = zvals([OPTIONAL TYPE],$nx,$ny,$nz...);
+
+etc. see L<zeroes|PDL::Core/zeroes>.
+
+=for example
+
+ pdl> print zvals zeroes(3,4,2)
+ [
+ [
+ [0 0 0]
+ [0 0 0]
+ [0 0 0]
+ [0 0 0]
+ ]
+ [
+ [1 1 1]
+ [1 1 1]
+ [1 1 1]
+ [1 1 1]
+ ]
+ ]
+
+=head2 xlinvals
+
+=for ref
+
+X axis values between endpoints (see L<xvals|/xvals>).
+
+=for usage
+
+ $a = zeroes(100,100);
+ $x = $a->xlinvals(0.5,1.5);
+ $y = $a->ylinvals(-2,-1);
+ # calculate Z for X between 0.5 and 1.5 and
+ # Y between -2 and -1.
+ $z = f($x,$y);
+
+C<xlinvals>, C<ylinvals> and C<zlinvals> return a piddle with the same shape
+as their first argument and linearly scaled values between the two other
+arguments along the given axis.
+
+=head2 ylinvals
+
+=for ref
+
+Y axis values between endpoints (see L<yvals|/yvals>).
+
+See L<xlinvals|/xlinvals> for more information.
+
+=head2 zlinvals
+
+=for ref
+
+Z axis values between endpoints (see L<zvals|/zvals>).
+
+See L<xlinvals|/xlinvals> for more information.
+
+=head2 xlogvals
+
+=for ref
+
+X axis values logarithmically spaced between endpoints (see L<xvals|/xvals>).
+
+=for usage
+
+ $a = zeroes(100,100);
+ $x = $a->xlogvals(1e-6,1e-3);
+ $y = $a->ylinvals(1e-4,1e3);
+ # calculate Z for X between 1e-6 and 1e-3 and
+ # Y between 1e-4 and 1e3.
+ $z = f($x,$y);
+
+C<xlogvals>, C<ylogvals> and C<zlogvals> return a piddle with the same shape
+as their first argument and logarithmically scaled values between the two other
+arguments along the given axis.
+
+=head2 ylogvals
+
+=for ref
+
+Y axis values logarithmically spaced between endpoints (see L<yvals|/yvals>).
+
+See L<xlogvals|/xlogvals> for more information.
+
+=head2 zlogvals
+
+=for ref
+
+Z axis values logarithmically spaced between endpoints (see L<zvals|/zvals>).
+
+See L<xlogvals|/xlogvals> for more information.
+
+=cut
+
+# Conveniently named interfaces to axisvals()
+
+sub xvals { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->xvals : PDL->xvals(@_) }
+sub yvals { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->yvals : PDL->yvals(@_) }
+sub zvals { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->zvals : PDL->zvals(@_) }
+sub PDL::xvals {
+ my $class = shift;
+ my $pdl = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
+ axisvals2($pdl,0);
+ return $pdl;
+}
+sub PDL::yvals {
+ my $class = shift;
+ my $pdl = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
+ axisvals2($pdl,1);
+ return $pdl;
+}
+sub PDL::zvals {
+ my $class = shift;
+ my $pdl = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
+ axisvals2($pdl,2);
+ return $pdl;
+}
+
+sub PDL::xlinvals {
+ my $dim = $_[0]->getdim(0);
+ barf "Must have at least two elements in dimension for xlinvals"
+ if $dim <= 1;
+ return $_[0]->xvals * (($_[2] - $_[1]) / ($dim-1)) + $_[1];
+}
+
+sub PDL::ylinvals {
+ my $dim = $_[0]->getdim(1);
+ barf "Must have at least two elements in dimension for ylinvals"
+ if $dim <= 1;
+ return $_[0]->yvals * (($_[2] - $_[1]) / ($dim-1)) + $_[1];
+}
+
+sub PDL::zlinvals {
+ my $dim = $_[0]->getdim(2);
+ barf "Must have at least two elements in dimension for zlinvals"
+ if $dim <= 1;
+ return $_[0]->zvals * (($_[2] - $_[1]) / ($dim-1)) + $_[1];
+}
+
+sub PDL::xlogvals {
+ my $dim = $_[0]->getdim(0);
+ barf "Must have at least two elements in dimension for xlogvals"
+ if $dim <= 1;
+ my ($xmin,$xmax) = @_[1,2];
+ barf "xmin and xmax must be positive"
+ if $xmin <= 0 || $xmax <= 0;
+ my ($lxmin,$lxmax) = (log($xmin), log($xmax));
+ return exp($_[0]->xvals * (($lxmax - $lxmin) / ($dim-1)) + $lxmin);
+}
+
+sub PDL::ylogvals {
+ my $dim = $_[0]->getdim(1);
+ barf "Must have at least two elements in dimension for xlogvals"
+ if $dim <= 1;
+ my ($xmin,$xmax) = @_[1,2];
+ barf "xmin and xmax must be positive"
+ if $xmin <= 0 || $xmax <= 0;
+ my ($lxmin,$lxmax) = (log($xmin), log($xmax));
+ return exp($_[0]->yvals * (($lxmax - $lxmin) / ($dim-1)) + $lxmin);
+}
+
+sub PDL::zlogvals {
+ my $dim = $_[0]->getdim(2);
+ barf "Must have at least two elements in dimension for xlogvals"
+ if $dim <= 1;
+ my ($xmin,$xmax) = @_[1,2];
+ barf "xmin and xmax must be positive"
+ if $xmin <= 0 || $xmax <= 0;
+ my ($lxmin,$lxmax) = (log($xmin), log($xmax));
+ return exp($_[0]->zvals * (($lxmax - $lxmin) / ($dim-1)) + $lxmin);
+}
+
+
+=head2 allaxisvals
+
+=for ref
+
+Synonym for L<ndcoords|ndcoords> - enumerates all coordinates in a
+PDL or dim list, adding an extra dim on the front to accomodate
+the vector coordinate index (the form expected by L<indexND|indexND>,
+L<range|range>, and L<interpND|interpND>). See L<ndcoords|ndcoords> for more detail.
+
+=for usage
+
+$indices = allaxisvals($pdl);
+$indices = allaxisvals(@dimlist);
+$indices = allaxisvals($type, at dimlist);
+
+=cut
+
+=head2 ndcoords
+
+=for ref
+
+Enumerate pixel coordinates for an N-D piddle
+
+Returns an enumerated list of coordinates suitable for use in
+L<indexND|PDL::Slices/indexND> or L<range|PDL::Slices/range>: you feed
+in a dimension list and get out a piddle whose 0th dimension runs over
+dimension index and whose 1st through Nth dimensions are the
+dimensions given in the input. If you feed in a piddle instead of a
+perl list, then the dimension list is used, as in L<xvals|xvals> etc.
+
+Unlike L<xvals|xvals> etc., if you supply a piddle input, you get
+out a piddle of the default piddle type: double. This causes less
+surprises than the previous default of keeping the data type of
+the input piddle since that rarely made sense in most usages.
+
+=for usage
+
+$indices = ndcoords($pdl);
+$indices = ndcoords(@dimlist);
+$indices = ndcoords($type, at dimlist);
+
+=for example
+
+ pdl> print ndcoords(2,3)
+
+ [
+ [
+ [0 0]
+ [1 0]
+ ]
+ [
+ [0 1]
+ [1 1]
+ ]
+ [
+ [0 2]
+ [1 2]
+ ]
+ ]
+
+ pdl> $a = zeroes(byte,2,3); # $a is a 2x3 byte piddle
+ pdl> $b = ndcoords($a); # $b inherits $a's type
+ pdl> $c = ndcoords(long,$a->dims); # $c is a long piddle, same dims as $b
+ pdl> help $b;
+ This variable is Byte D [2,2,3] P 0.01Kb
+ pdl> help $c;
+ This variable is Long D [2,2,3] P 0.05Kb
+
+
+=cut
+
+sub PDL::ndcoords {
+ my $type;
+ if(ref $_[0] eq 'PDL::Type') {
+ $type = shift;
+ }
+
+ my @dims = (ref $_[0]) ? (shift)->dims : @_;
+ my @d = @dims;
+ unshift(@d,scalar(@dims));
+ unshift(@d,$type) if defined($type);
+
+ $out = PDL->zeroes(@d);
+
+ for my $d(0..$#dims) {
+ my $a = $out->index($d)->mv($d,0);
+ $a .= xvals($a);
+ }
+
+ $out;
+}
+*ndcoords = \&PDL::ndcoords;
+*allaxisvals = \&PDL::ndcoords;
+*PDL::allaxisvals = \&PDL::ndcoords;
+
+
+=head2 hist
+
+=for ref
+
+Create histogram of a piddle
+
+=for usage
+
+ $hist = hist($data);
+ ($xvals,$hist) = hist($data);
+
+or
+
+ $hist = hist($data,$min,$max,$step);
+ ($xvals,$hist) = hist($data,[$min,$max,$step]);
+
+If C<hist> is run in list context, C<$xvals> gives the
+computed bin centres as double values.
+
+A nice idiom (with
+L<PDL::Graphics::PGPLOT|PDL::Graphics::PGPLOT>) is
+
+ bin hist $data; # Plot histogram
+
+=for example
+
+ pdl> p $y
+ [13 10 13 10 9 13 9 12 11 10 10 13 7 6 8 10 11 7 12 9 11 11 12 6 12 7]
+ pdl> $h = hist $y,0,20,1; # hist with step 1, min 0 and 20 bins
+ pdl> p $h
+ [0 0 0 0 0 0 2 3 1 3 5 4 4 4 0 0 0 0 0 0]
+
+=cut
+
+sub PDL::hist {
+
+ my $usage = "\n" . ' Usage: $hist = hist($data)' . "\n" .
+ ' $hist = hist($data,$min,$max,$step)' . "\n" .
+ ' ($xvals,$hist) = hist($data)' . "\n" .
+ ' ($xvals,$hist) = hist($data,$min,$max,$step)' . "\n" ;
+ barf($usage) if $#_<0;
+
+ my($pdl,$min,$max,$step)=@_;
+ my $xvals;
+
+ ($step, $min, $bins, $xvals) =
+ _hist_bin_calc($pdl, $min, $max, $step, wantarray());
+
+ PDL::Primitive::histogram($pdl->clump(-1),(my $hist = null),
+ $step,$min,$bins);
+
+ return wantarray() ? ($xvals,$hist) : $hist;
+}
+
+=head2 whist
+
+=for ref
+
+Create a weighted histogram of a piddle
+
+=for usage
+
+ $hist = whist($data, $wt, [$min,$max,$step]);
+ ($xvals,$hist) = whist($data, $wt, [$min,$max,$step]);
+
+If requested, C<$xvals> gives the computed bin centres
+as type double values. C<$data> and C<$wt> should have
+the same dimensionality and extents.
+
+A nice idiom (with
+L<PDL::Graphics::PGPLOT|PDL::Graphics::PGPLOT>) is
+
+ bin whist $data, $wt; # Plot histogram
+
+=for example
+
+ pdl> p $y
+ [13 10 13 10 9 13 9 12 11 10 10 13 7 6 8 10 11 7 12 9 11 11 12 6 12 7]
+ pdl> $wt = grandom($y->nelem)
+ pdl> $h = whist $y, $wt, 0, 20, 1 # hist with step 1, min 0 and 20 bins
+ pdl> p $h
+ [0 0 0 0 0 0 -0.49552342 1.7987439 0.39450696 4.0073722 -2.6255299 -2.5084501 2.6458365 4.1671676 0 0 0 0 0 0]
+
+
+=cut
+
+sub PDL::whist {
+ barf('Usage: ([$xvals],$hist) = whist($data,$wt,[$min,$max,$step])')
+ if @_ < 2;
+ my($pdl,$wt,$min,$max,$step)=@_;
+ my $xvals;
+
+ ($step, $min, $bins, $xvals) =
+ _hist_bin_calc($pdl, $min, $max, $step, wantarray());
+
+ PDL::Primitive::whistogram($pdl->clump(-1),$wt->clump(-1),
+ (my $hist = null), $step, $min, $bins);
+ return wantarray() ? ($xvals,$hist) : $hist;
+}
+
+sub _hist_bin_calc {
+ my($pdl,$min,$max,$step,$wantarray)=@_;
+ $min = $pdl->min() unless defined $min;
+ $max = $pdl->max() unless defined $max;
+ my $ntype = $pdl->get_datatype;
+ barf "empty piddle, no values to work with" if $pdl->nelem == 0;
+ unless (defined $step) {
+ my $defbins = sqrt($pdl->nelem);
+ $defbins = ($defbins>100) ? 100 : $defbins;
+ $step = ($max-$min)/$defbins;
+ }
+ barf "step is zero (or all data equal to one value)" if $step == 0;
+ my $bins = int(($max-$min)/$step+0.5);
+ print "hist with step $step, min $min and $bins bins\n"
+ if $PDL::debug;
+ # Need to use double for $xvals here
+ my $xvals = $min + $step/2 + sequence(PDL::Core::double,$bins)*$step if $wantarray;
+
+ return ( $step, $min, $bins, $xvals );
+}
+
+
+=head2 sequence
+
+=for ref
+
+Create array filled with a sequence of values
+
+=for usage
+
+ $a = sequence($b); $a = sequence [OPTIONAL TYPE], @dims;
+
+etc. see L<zeroes|PDL::Core/zeroes>.
+
+=for example
+
+ pdl> p sequence(10)
+ [0 1 2 3 4 5 6 7 8 9]
+ pdl> p sequence(3,4)
+ [
+ [ 0 1 2]
+ [ 3 4 5]
+ [ 6 7 8]
+ [ 9 10 11]
+ ]
+
+=cut
+
+sub sequence { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->sequence : PDL->sequence(@_) }
+sub PDL::sequence {
+ my $class = shift;
+ my $pdl = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
+ my $bar = $pdl->clump(-1)->inplace;
+ my $foo = $bar->xvals;
+ return $pdl;
+}
+
+=head2 rvals
+
+=for ref
+
+Fills a piddle with radial distance values from some centre.
+
+=for usage
+
+ $r = rvals $piddle,{OPTIONS};
+ $r = rvals [OPTIONAL TYPE],$nx,$ny,...{OPTIONS};
+
+=for options
+
+ Options:
+
+ Centre => [$x,$y,$z...] # Specify centre
+ Center => [$x,$y.$z...] # synonym.
+
+ Squared => 1 # return distance squared (i.e., don't take the square root)
+
+=for example
+
+ pdl> print rvals long,7,7,{Centre=>[2,2]}
+ [
+ [2 2 2 2 2 3 4]
+ [2 1 1 1 2 3 4]
+ [2 1 0 1 2 3 4]
+ [2 1 1 1 2 3 4]
+ [2 2 2 2 2 3 4]
+ [3 3 3 3 3 4 5]
+ [4 4 4 4 4 5 5]
+ ]
+
+If C<Center> is not specified, the midpoint for a given dimension of
+size C<N> is given by C< int(N/2) > so that the midpoint always falls
+on an exact pixel point in the data. For dimensions of even size,
+that means the midpoint is shifted by 1/2 pixel from the true center
+of that dimension.
+
+Also note that the calculation for C<rvals> for integer values
+does not promote the datatype so you will have wraparound when
+the value calculated for C< r**2 > is greater than the datatype
+can hold. If you need exact values, be sure to use large integer
+or floating point datatypes.
+
+For a more general metric, one can define, e.g.,
+
+ sub distance {
+ my ($a,$centre,$f) = @_;
+ my ($r) = $a->allaxisvals-$centre;
+ $f->($r);
+ }
+ sub l1 { sumover(abs($_[0])); }
+ sub euclid { use PDL::Math 'pow'; pow(sumover(pow($_[0],2)),0.5); }
+ sub linfty { maximum(abs($_[0])); }
+
+so now
+
+ distance($a, $centre, \&euclid);
+
+will emulate rvals, while C<\&l1> and C<\&linfty> will generate other
+well-known norms.
+
+=cut
+
+sub rvals { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->rvals(@_[1..$#_]) : PDL->rvals(@_) }
+sub PDL::rvals { # Return radial distance from given point and offset
+ my $class = shift;
+ my $opt = pop @_ if ref($_[$#_]) eq "HASH";
+ my %opt = defined $opt ?
+ iparse( {
+ CENTRE => undef, # needed, otherwise centre/center handling painful
+ Squared => 0,
+ }, $opt ) : ();
+ my $r = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
+
+ my @pos;
+ @pos = @{$opt{CENTRE}} if defined $opt{CENTRE};
+ my $offset;
+
+ $r .= 0.0;
+ my $tmp = $r->copy;
+ my $i;
+ for ($i=0; $i<$r->getndims; $i++) {
+ $offset = (defined $pos[$i] ? $pos[$i] : int($r->getdim($i)/2));
+ # Note careful coding for speed and min memory footprint
+ PDL::Primitive::axisvalues($tmp->xchg(0,$i));
+ $tmp -= $offset; $tmp *= $tmp;
+ $r += $tmp;
+ }
+ return $opt{Squared} ? $r : $r->inplace->sqrt;
+}
+
+=head2 axisvals
+
+=for ref
+
+Fills a piddle with index values on Nth dimension
+
+=for usage
+
+ $z = axisvals ($piddle, $nth);
+
+This is the routine, for which L<xvals|/xvals>, L<yvals|/yvals> etc
+are mere shorthands. C<axisvals> can be used to fill along any dimension,
+using a parameter.
+
+See also L<allaxisvals|allaxisvals>, which generates all axis values
+simultaneously in a form useful for L<range|range>, L<interpND|interpND>,
+L<indexND|indexND>, etc.
+
+Note the 'from specification' style (see L<zeroes|PDL::Core/zeroes>) is
+not available here, for obvious reasons.
+
+=cut
+
+sub PDL::axisvals {
+ my($this,$nth) = @_;
+ my $dummy = $this->new_or_inplace;
+ if($dummy->getndims() <= $nth) {
+ # This is 'kind of' consistency...
+ $dummy .= 0;
+ return $dummy;
+# barf("Too few dimensions given to axisvals $nth\n");
+ }
+ my $bar = $dummy->xchg(0,$nth);
+ PDL::Primitive::axisvalues($bar);
+ return $dummy;
+}
+
+# We need this version for xvals etc to work in place
+sub axisvals2 {
+ my($this,$nth) = @_;
+ my $dummy = shift;
+ if($dummy->getndims() <= $nth) {
+ # This is 'kind of' consistency...
+ $dummy .= 0;
+ return $dummy;
+# barf("Too few dimensions given to axisvals $nth\n");
+ }
+ my $bar = $dummy->xchg(0,$nth);
+ PDL::Primitive::axisvalues($bar);
+ return $dummy;
+}
+sub PDL::sec {
+ my($this, at coords) = @_;
+ my $i; my @maps;
+ while($#coords > -1) {
+ $i = int(shift @coords) ;
+ push @maps, "$i:".int(shift @coords);
+ }
+ my $tmp = PDL->null;
+ $tmp .= $this->slice(join ',', at maps);
+ return $tmp;
+}
+
+sub PDL::ins {
+ my($this,$what, at coords) = @_;
+ my $w = PDL::Core::alltopdl($PDL::name,$what);
+ my $tmp;
+ if($this->is_inplace) {
+ $this->set_inplace(0);
+ } else {
+ $this = $this->copy;
+ }
+ ($tmp = $this->slice(
+ (join ',',map {int($coords[$_]).":".
+ ((int($coords[$_])+$w->getdim($_)-1)<$this->getdim($_) ?
+ (int($coords[$_])+$w->getdim($_)-1):$this->getdim($_))
+ }
+ 0..$#coords)))
+ .= $w;
+ return $this;
+}
+
+sub PDL::similar_assign {
+ my($from,$to) = @_;
+ if((join ',',@{$from->dims}) ne (join ',',@{$to->dims})) {
+ barf "Similar_assign: dimensions [".
+ (join ',',@{$from->dims})."] and [".
+ (join ',',@{$to->dims})."] do not match!\n";
+ }
+ $to .= $from;
+}
+
+=head2 transpose
+
+=for ref
+
+transpose rows and columns.
+
+=for usage
+
+ $b = transpose($a);
+
+=for example
+
+ pdl> $a = sequence(3,2)
+ pdl> p $a
+ [
+ [0 1 2]
+ [3 4 5]
+ ]
+ pdl> p transpose( $a )
+ [
+ [0 3]
+ [1 4]
+ [2 5]
+ ]
+
+=cut
+
+sub PDL::transpose {
+ my($this) = @_;
+ if($this->getndims <= 1) {
+ if($this->getndims==0) {
+ return pdl $this->dummy(0)->dummy(0);
+ } else {
+ return pdl $this->dummy(0);
+ }
+ }
+ return $this->xchg(0,1);
+}
+
+1;
+
diff --git a/Basic/Core/Char.pm b/Basic/Core/Char.pm
new file mode 100644
index 0000000..63f5bc0
--- /dev/null
+++ b/Basic/Core/Char.pm
@@ -0,0 +1,320 @@
+package PDL::Char;
+
+ at ISA = qw (PDL);
+use overload ("\"\"" => \&PDL::Char::string);
+use strict;
+use vars ('$level', '@dims'); # Global Vars used
+
+
+=head1 NAME
+
+PDL::Char -- PDL subclass which allows reading and writing of fixed-length character strings as byte PDLs
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::Char;
+
+ my $pchar = PDL::Char->new( [['abc', 'def', 'ghi'],['jkl', 'mno', 'pqr']] );
+
+ $pchar->setstr(1,0,'foo');
+
+ print $pchar; # 'string' bound to "", perl stringify function
+ # Prints:
+ # [
+ # ['abc' 'foo' 'ghi']
+ # ['jkl' 'mno' 'pqr']
+ # ]
+
+ print $pchar->atstr(2,0);
+ # Prints:
+ # ghi
+
+=head1 DESCRIPTION
+
+This subclass of PDL allows one to manipulate PDLs of 'byte' type as if they were made of fixed
+length strings, not just numbers.
+
+This type of behavior is useful when you want to work with charactar grids. The indexing is done
+on a string level and not a character level for the 'setstr' and 'atstr' commands.
+
+This module is in particular useful for writing NetCDF files that include character data using the
+PDL::NetCDF module.
+
+=head1 FUNCTIONS
+
+=head2 new
+
+=for ref
+
+Function to create a byte PDL from a string, list of strings, list of list of strings, etc.
+
+=for usage
+
+ # create a new PDL::Char from a perl array of strings
+ $strpdl = PDL::Char->new( ['abc', 'def', 'ghij'] );
+
+ # Convert a PDL of type 'byte' to a PDL::Char
+ $strpdl1 = PDL::Char->new (sequence (byte, 4, 5)+99);
+
+=for example
+
+ $pdlchar3d = PDL::Char->new([['abc','def','ghi'],['jkl', 'mno', 'pqr']]);
+
+=cut
+
+
+sub new {
+ my $type = shift;
+ my $value = (scalar(@_)>1 ? [@_] : shift); # ref thyself
+
+ # re-bless byte PDLs as PDL::Char
+ if (ref($value) =~ /PDL/) {
+ PDL::Core::barf('Cannot convert a non-byte PDL to PDL::Char')
+ if ($value->get_datatype != $PDL::Types::PDL_B);
+ return bless $value, $type;
+ }
+
+ my $ptype = $PDL::Types::PDL_B;
+ my $self = PDL->initialize();
+ $self->set_datatype($ptype);
+ $value = 0 if !defined($value);
+ $level = 0; @dims = (); # package vars
+ my $maxlength; # max length seen for all character strings
+ my $samelen = 1; # Flag = 1 if all character strings are the same length
+
+ # 1st Pass thru the perl array structure, assume all strings the same length
+ my $str = _rcharpack($value,\$maxlength,\$samelen);
+ unless( $samelen){ # Strings weren't the same length, go thru again and null pad to
+ # the max length.
+ $str = _rcharpack2($value,$maxlength);
+ }
+ $self->setdims([reverse @dims]);
+ ${$self->get_dataref} = $str;
+ $self->upd_data();
+ return bless $self, $type;
+}
+
+# Take an N-D perl array of strings and pack it into a single string,
+# updating the $level and @dims package vars on the way.
+# Used by the 'char' constructor
+#
+# References supplied so $maxlength and $samelen are updated along the way as well.
+#
+#
+# This version (_rcharpack) is for the 1st pass thru the N-d string array.
+# It assumes that all strings are the same length, but also checks to see if they aren't
+sub _rcharpack {
+
+ my $a = shift; # Input string
+ my ($maxlenref, $samelenref) = @_; # reference to $maxlength, $samelen
+
+ my ($ret,$type);
+
+ $ret = "";
+ if (ref($a) eq "ARRAY") {
+
+ PDL::Core::barf('Array is not rectangular') if (defined($dims[$level]) and
+ $dims[$level] != scalar(@$a));
+ $dims[$level] = scalar (@$a);
+ $level++;
+
+ $type = ref($$a[0]);
+ for(@$a) {
+ PDL::Core::barf('Array is not rectangular') unless $type eq ref($_); # Equal types
+ $ret .= _rcharpack($_,$maxlenref, $samelenref);
+ }
+
+ $level--;
+
+ }elsif (ref(\$a) eq "SCALAR") {
+ my $len = length($a);
+
+ # Check for this length being different then the others:
+ $$samelenref = 0 if( defined($$maxlenref) && ($len != $$maxlenref) );
+ # Save the max length:
+ $$maxlenref = $len if( !defined($$maxlenref) || $len > $$maxlenref); # see if this is the max length seen so far
+
+ $dims[$level] = $len;
+ $ret = $a;
+
+ }else{
+ PDL::Core::barf("Don't know how to make a PDL object from passed argument");
+ }
+ return $ret;
+}
+#
+#
+# This version (_rcharpack2) is for the 2nd pass (if required) thru the N-d string array.
+# If the 1st pass thru (_rcharpack) finds that all strings were not the same length,
+# this routine will go thru and null-pad all strings to the max length seen.
+# Note: For efficiency, the error checking is not repeated here, because any errors will
+# already be detected in the 1st pass.
+#
+sub _rcharpack2 {
+
+ my $a = shift; # Input string
+ my ($maxlen) = @_; # Length to pad strings to
+
+ my ($ret,$type);
+
+ $ret = "";
+ if (ref($a) eq "ARRAY") {
+
+ # Checks not needed the second time thru (removed)
+
+ $dims[$level] = scalar (@$a);
+ $level++;
+
+ $type = ref($$a[0]);
+ for(@$a) {
+ $ret .= _rcharpack2($_,$maxlen);
+ }
+
+ $level--;
+
+ }elsif (ref(\$a) eq "SCALAR") {
+ my $len = length($a);
+
+ $dims[$level] = $maxlen;
+ $ret = $a.("\00" x ($maxlen - $len));
+ }
+ return $ret;
+}
+
+
+#
+#
+
+=head2 string
+
+=for ref
+
+Function to print a character PDL (created by 'char') in a pretty format.
+
+=for usage
+
+ $char = PDL::Char->new( [['abc', 'def', 'ghi'], ['jkl', 'mno', 'pqr']] );
+ print $char; # 'string' bound to "", perl stringify function
+ # Prints:
+ # [
+ # ['abc' 'def' 'ghi']
+ # ['jkl' 'mno' 'pqr']
+ # ]
+
+ # 'string' is overloaded to the "" operator, so:
+ # print $char;
+ # should have the same effect.
+
+=cut
+
+sub string {
+ my $self = shift;
+ my $level = shift || 0;
+
+ my $sep = $PDL::use_commas ? "," : " ";
+
+ if ($self->dims == 1) {
+ my $str = ${$self->get_dataref}; # get copy of string
+ $str =~ s/\00+$//g; # get rid of any null padding
+ return "\'". $str. "\'". $sep;
+ } else {
+ my @dims = reverse $self->dims;
+ my $ret = '';
+ $ret .= (" " x $level) . '[' . ((@dims == 2) ? ' ' : "\n");
+ for (my $i=0;$i<$dims[0];$i++) {
+ my $slicestr = ":," x (scalar(@dims)-1) . "($i)";
+ my $substr = $self->slice($slicestr);
+ $ret .= $substr->string($level+1);
+ }
+ $ret .= (" " x $level) . ']' . $sep . "\n";
+ return $ret;
+ }
+
+}
+
+
+=head2 setstr
+
+=for ref
+
+Function to set one string value in a character PDL. The input position is
+the position of the string, not a character in the string. The first dimension
+is assumed to be the length of the string.
+
+The input string will be null-padded if the string is shorter than the first
+dimension of the PDL. It will be truncated if it is longer.
+
+=for usage
+
+ $char = PDL::Char->new( [['abc', 'def', 'ghi'], ['jkl', 'mno', 'pqr']] );
+ $char->setstr(0,1, 'foobar');
+ print $char; # 'string' bound to "", perl stringify function
+ # Prints:
+ # [
+ # ['abc' 'def' 'ghi']
+ # ['foo' 'mno' 'pqr']
+ # ]
+ $char->setstr(2,1, 'f');
+ print $char; # 'string' bound to "", perl stringify function
+ # Prints:
+ # [
+ # ['abc' 'def' 'ghi']
+ # ['foo' 'mno' 'f'] -> note that this 'f' is stored "f\0\0"
+ # ]
+
+=cut
+
+sub setstr { # Sets a particular single value to a string.
+ PDL::Core::barf('Usage: setstr($pdl, $x, $y,.., $value)') if $#_<2;
+ my $self = shift;
+ my $val = pop;
+
+ my @dims = $self->dims;
+ my $n = $dims[0];
+
+ for (my $i=0;$i<$n;$i++) {
+ my $chr = ($i >= length($val)) ? 0 : unpack ("C", substr ($val, $i, 1));
+ PDL::Core::set_c ($self, [$i, @_], $chr);
+ }
+
+}
+
+=head2 atstr
+
+=for ref
+
+Function to fetch one string value from a PDL::Char type PDL, given a position within the PDL.
+The input position of the string, not a character in the string. The length of the input
+string is the implied first dimension.
+
+=for usage
+
+ $char = PDL::Char->new( [['abc', 'def', 'ghi'], ['jkl', 'mno', 'pqr']] );
+ print $char->atstr(0,1);
+ # Prints:
+ # jkl
+
+=cut
+
+sub atstr { # Fetchs a string value from a PDL::Char
+ PDL::Core::barf('Usage: atstr($pdl, $x, $y,..,)') if (@_ < 2);
+ my $self = shift;
+
+ my $str = ':,' . join (',', map {"($_)"} @_);
+ my $a = $self->slice($str);
+
+ my $val = ${$a->get_dataref}; # get the data
+ $val =~ s/\00+$//g; # get rid of any null padding
+ return $val;
+}
+
+# yuck ;) this is a cool little accessor method
+# rebless a slice into PDL; originally
+# Marc's idea used in PDL::Complex
+sub numeric {
+ my ($seq) = @_;
+ return bless $seq->slice(''), 'PDL';
+}
+
+1;
diff --git a/Basic/Core/Core.pm.PL b/Basic/Core/Core.pm.PL
new file mode 100644
index 0000000..ab1ba0e
--- /dev/null
+++ b/Basic/Core/Core.pm.PL
@@ -0,0 +1,4259 @@
+#
+# Create Core.pm
+# - needed since we allow bad pixel handling to be switched off
+# (note this now only changes the documentation, since we
+# have PDL::Bad supplying dummy functions -- eg a badvalue()
+# which always returns 0).
+#
+
+use strict;
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# check for bad value support
+use vars qw( $bvalflag $usenan $bvalPerPdl );
+require "badsupport.p";
+require 'Types.pm';
+PDL::Types->import(':All');
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+my $file;
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($Config{'osname'} eq 'VMS' or
+ $Config{'osname'} eq 'OS2'); # "case-forgiving"
+
+if ( $bvalflag ) {
+ print "Extracting $file (WITH bad value support)\n";
+} else {
+ print "Extracting $file (NO bad value support)\n";
+}
+
+# make the type dependent stuff
+my $convertfuncs = join ' ',
+ map {PDL::Types::typefld($_,'convertfunc')} PDL::Types::typesrtkeys();
+my $convertalts = join '|',
+ map {PDL::Types::typefld($_,'convertfunc')} PDL::Types::typesrtkeys();
+my $typealiases = join "\n",
+ map {"*$_ = \\&PDL::$_;"} map {PDL::Types::typefld($_,'convertfunc')}
+ PDL::Types::typesrtkeys();
+my $typearray = join ",\n",
+ map {my ($conv,$val) = (PDL::Types::typefld($_,'convertfunc'),
+ PDL::Types::typefld($_,'numval'));
+ "['$conv',$val]"} PDL::Types::typesrtkeys();
+
+open OUT,">$file" or die "Can't create $file: $!";
+chmod 0644, $file;
+
+print OUT <<"!WITH!SUBS!";
+
+# This file is automatically created by Core.pm.PL
+# Do not edit this file -- all changes will be lost
+
+# - bad value support = $bvalflag
+
+!WITH!SUBS!
+
+print OUT <<'!NO!SUBS!';
+
+=head1 NAME
+
+PDL::Core - fundamental PDL functionality and vectorization/threading
+
+=head1 DESCRIPTION
+
+Methods and functions for type conversions, PDL creation,
+type conversion, threading etc.
+
+=head1 SYNOPSIS
+
+ use PDL::Core; # Normal routines
+ use PDL::Core ':Internal'; # Hairy routines
+
+=head1 VECTORIZATION/THREADING: METHOD AND NOMENCLATURE
+
+PDL provides vectorized operations via a built-in engine.
+Vectorization is called "threading" for historical reasons.
+The threading engine implements simple rules for each operation.
+
+Each PDL object has a "shape" that is a generalized N-dimensional
+rectangle defined by a "dim list" of sizes in an arbitrary
+set of dimensions. A PDL with shape 2x3 has 6 elements and is
+said to be two-dimensional, or may be referred to as a 2x3-PDL.
+The dimensions are indexed numerically starting at 0, so a
+2x3-PDL has a dimension 0 (or "dim 0") with size 2 and a 1 dimension
+(or "dim 1") with size 3.
+
+PDL generalizes *all* mathematical operations with the notion of
+"active dims": each operator has zero or more active dims that are
+used in carrying out the operation. Simple scalar operations like
+scalar multiplication ('*') have 0 active dims. More complicated
+operators can have more active dims. For example, matrix
+multiplication ('x') has 2 active dims. Additional dims are
+automatically vectorized across -- e.g. multiplying a 2x5-PDL with a
+2x5-PDL requires 10 simple multiplication operations, and yields a
+2x5-PDL result.
+
+=head2 Threading rules
+
+In any PDL expression, the active dims appropriate for each operator
+are used starting at the 0 dim and working forward through the dim
+list of each object. All additional dims after the active dims are
+"thread dims". The thread dims do not have to agree exactly: they are
+coerced to agree according to simple rules:
+
+=over 3
+
+=item * Null PDLs match any dim list (see below).
+
+=item * Dims with sizes other than 1 must all agree in size.
+
+=item * Dims of size 1 are expanded as necessary.
+
+=item * Missing dims are expanded appropriately.
+
+=back
+
+The "size 1" rule implements "generalized scalar" operation, by
+analogy to scalar multiplication. The "missing dims" rule
+acknowledges the ambiguity between a missing dim and a dim of size 1.
+
+=head2 Null PDLs
+
+PDLs on the left-hand side of assignment can have the special value
+"Null". A null PDL has no dim list and no set size; its shape is
+determined by the computed shape of the expression being assigned to
+it. Null PDLs contain no values and can only be assigned to. When
+assigned to (e.g. via the C<.=> operator), they cease to be null PDLs.
+
+To create a null PDL, use C<PDL-E<gt>null()>.
+
+=head2 Empty PDLs
+
+PDLs can represent the empty set using "structured Empty" variables.
+An empty PDL is not a null PDL.
+
+Any dim of a PDL can be set explicitly to size 0. If so, the PDL
+contains zero values (because the total number of values is the
+product of all the sizes in the PDL's shape or dimlist).
+
+Scalar PDLs are zero-dimensional and have no entries in the dim list,
+so they cannot be empty. 1-D and higher PDLs can be empty. Empty
+PDLs are useful for set operations, and are most commonly encountered
+in the output from selection operators such as L<which|PDL::Primitive>
+and L<whichND|PDL::Primitive>. Not all empty PDLs have the same
+threading properties -- e.g. a 2x0-PDL represents a collection of
+2-vectors that happens to contain no elements, while a simple 0-PDL
+represents a collection of scalar values (that also happens to contain
+no elements).
+
+Note that 0 dims are not adjustable via the threading rules -- a dim
+with size 0 can only match a corresponding dim of size 0 or 1.
+
+=head2 Thread rules and assignments
+
+Versions of PDL through 2.4.10 have some irregularity with threading and
+assignments. Currently the threading engine performs a full expansion of
+both sides of the computed assignment operator C<.=> (which assigns values
+to a pre-existing PDL). This leads to counter-intuitive behavior in
+some cases:
+
+=over 3
+
+=item * Generalized scalars and computed assignment
+
+If the PDL on the left-hand side of C<.=> has a dim of size 1, it can be
+treated as a generalized scalar, as in:
+
+ $a = sequence(2,3);
+ $b = zeroes(1,3);
+ $b .= $a;
+
+In this case, C<$b> is automatically treated as a 2x3-PDL during the
+threading operation, but half of the values from C<$a> silently disappear.
+The output is, as Kernighan and Ritchie would say, "undefined".
+
+Further, if the value on the right of C<.=> is empty, then C<.=> becomes
+a silent no-op:
+
+ $a = zeroes(0);
+ $b = zeroes(1);
+ $b .= $a+1;
+ print $b;
+
+will print C<[0]>. In this case, "$a+1" is empty, and "$b" is a generalized
+scalar that is adjusted to be empty, so the assignment is carried out for
+zero elements (a no-op).
+
+Both of these behaviors are considered harmful and should not be relied upon:
+they may be patched away in a future version of PDL.
+
+
+=item * Empty PDLs and generalized scalars
+
+Generalized scalars (PDLs with a dim of size 1) can match any size in the
+corresponding dim, including 0. Thus,
+
+ $a = ones(2,0);
+ $b = sequence(2,1);
+ $c = $a * $b;
+ print $c;
+
+prints C<Empty[2,0]>.
+
+This behavior is counterintuitive but desirable, and will be preserved
+in future versions of PDL.
+
+=back
+
+=head1 VARIABLES
+
+These are important variables of B<global> scope and are placed
+in the PDL namespace.
+
+=head3 C<$PDL::debug>
+
+=over 4
+
+When true, PDL debugging information is printed.
+
+=back
+
+=head3 C<$PDL::verbose>
+
+=over 4
+
+When true, PDL functions provide chatty information.
+
+=back
+
+=head3 C<$PDL::use_commas>
+
+=over 4
+
+Whether to insert commas when printing pdls
+
+=back
+
+=head3 C<$PDL::floatformat>, C<$PDL::doubleformat>
+
+=over 4
+
+The default print format for floats and doubles, repectively.
+The default default values are:
+
+ $PDL::floatformat = "%7g";
+ $PDL::doubleformat = "%10.8g";
+
+
+=back
+
+=head3 C<$PDL::undefval>
+
+=over 4
+
+The value to use instead of C<undef> when creating pdls.
+
+=back
+
+=head3 C<$PDL::toolongtoprint>
+
+=over 4
+
+The maximal size pdls to print (defaults to 10000 elements)
+
+=back
+
+=head1 FUNCTIONS
+
+=cut
+
+# Core routines for PDL module
+
+package PDL::Core;
+use PDL::Types;
+
+$PDL::Core::FOO_FOO_::VERSION = '1.56';
+
+# Functions exportable in this part of the module
+
+ at EXPORT = qw( piddle pdl null barf ); # Only stuff always exported!
+
+!NO!SUBS!
+
+print OUT <<"!WITH!SUBS!";
+
+\@EXPORT_OK = qw( howbig threadids topdl nelem dims shape null
+ $convertfuncs
+ convert inplace zeroes zeros ones list listindices unpdl
+ set at flows thread_define over reshape dog cat barf type diagonal
+ dummy mslice approx flat sclr squeeze
+ get_autopthread_targ set_autopthread_targ get_autopthread_actual
+ get_autopthread_size set_autopthread_size
+ );
+
+\%EXPORT_TAGS = (
+ Func=>[qw/nelem dims shape null
+ $convertfuncs
+ convert inplace zeroes zeros ones list listindices unpdl
+ set at flows thread_define over reshape pdl piddle null dog cat barf type
+ diagonal dummy mslice approx flat sclr
+ get_autopthread_targ set_autopthread_targ get_autopthread_actual
+ get_autopthread_size set_autopthread_size
+ /],
+ Internal=>[qw/howbig threadids topdl/]
+);
+
+!WITH!SUBS!
+
+print OUT '# line ' . (__LINE__ + 2) . <<'!NO!SUBS!';
+ "Basic/Core/Core.pm.PL (i.e. PDL::Core.pm)"
+use PDL::Exporter;
+use DynaLoader;
+
+ at ISA = qw( PDL::Exporter DynaLoader );
+
+use strict;
+use vars qw($level @dims $sep $sep2 $match);
+bootstrap PDL::Core;
+
+# Important variables (place in PDL namespace)
+# (twice to eat "used only once" warning)
+
+$PDL::debug = # Debugging info
+$PDL::debug = 0;
+$PDL::verbose = # Functions provide chatty information
+$PDL::verbose = 0;
+$PDL::use_commas = 0; # Whether to insert commas when printing arrays
+$PDL::floatformat = "%7g"; # Default print format for long numbers
+$PDL::doubleformat = "%10.8g";
+$PDL::undefval = 0; # Value to use instead of undef when creating PDLs
+$PDL::toolongtoprint = 10000; # maximum pdl size to stringify for printing
+
+################ Exportable functions of the Core ######################
+
+# log10() is now defined in ops.pd
+
+*howbig = \&PDL::howbig; *unpdl = \&PDL::unpdl;
+*nelem = \&PDL::nelem; *inplace = \&PDL::inplace;
+*dims = \&PDL::dims; *list = \&PDL::list;
+*threadids = \&PDL::threadids; *listindices = \&PDL::listindices;
+*null = \&PDL::null; *set = \&PDL::set;
+*at = \&PDL::at; *flows = \&PDL::flows;
+*sclr = \&PDL::sclr; *shape = \&PDL::shape;
+!NO!SUBS!
+
+print OUT "$typealiases\n";
+
+print OUT '# line ' . (__LINE__ + 2) . <<'!NO!SUBS!';
+ "Basic/Core/Core.pm.PL (i.e. PDL::Core.pm)"
+
+*thread_define = \&PDL::thread_define;
+*convert = \&PDL::convert; *over = \&PDL::over;
+*dog = \&PDL::dog; *cat = \&PDL::cat;
+*type = \&PDL::type; *approx = \&PDL::approx;
+*diagonal = \&PDL::diagonal;
+*dummy = \&PDL::dummy;
+*mslice = \&PDL::mslice;
+*isempty = \&PDL::isempty;
+*string = \&PDL::string;
+
+
+=head2 barf
+
+=for ref
+
+Standard error reporting routine for PDL.
+
+C<barf()> is the routine PDL modules should call to report errors. This
+is because C<barf()> will report the error as coming from the correct
+line in the module user's script rather than in the PDL module.
+
+For now, barf just calls Carp::confess()
+
+Remember C<barf()> is your friend. *Use* it!
+
+=for example
+
+At the perl level:
+
+ barf("User has too low an IQ!");
+
+In C or XS code:
+
+ barf("You have made %d errors", count);
+
+Note: this is one of the few functions ALWAYS exported
+by PDL::Core
+
+=cut
+
+use Carp;
+sub barf { goto &Carp::confess }
+sub cluck { goto &Carp::cluck }
+*PDL::barf = \&barf;
+*PDL::cluck = \&cluck;
+
+########## Set Auto-PThread Based On Environment Vars ############
+PDL::set_autopthread_targ( $ENV{PDL_AUTOPTHREAD_TARG} ) if( defined ( $ENV{PDL_AUTOPTHREAD_TARG} ) );
+PDL::set_autopthread_size( $ENV{PDL_AUTOPTHREAD_SIZE} ) if( defined ( $ENV{PDL_AUTOPTHREAD_SIZE} ) );
+##################################################################
+
+=head2 pdl
+
+=for ref
+
+PDL constructor - creates new piddle from perl scalars/arrays, piddles, and strings
+
+=for usage
+
+ $a = pdl(SCALAR|ARRAY REFERENCE|ARRAY|STRING);
+
+=for example
+
+ $a = pdl [1..10]; # 1D array
+ $a = pdl ([1..10]); # 1D array
+ $a = pdl (1,2,3,4); # Ditto
+ $b = pdl [[1,2,3],[4,5,6]]; # 2D 3x2 array
+ $b = pdl "[[1,2,3],[4,5,6]]"; # Ditto (slower)
+ $b = pdl "[1 2 3; 4 5 6]"; # Ditto
+ $b = pdl q[1 2 3; 4 5 6]; # Ditto, using the q quote operator
+ $b = pdl "1 2 3; 4 5 6"; # Ditto, less obvious, but still works
+ $b = pdl 42 # 0-dimensional scalar
+ $c = pdl $a; # Make a new copy
+ $a = pdl([1,2,3],[4,5,6]); # 2D
+ $a = pdl([[1,2,3],[4,5,6]]); # 2D
+
+Note the last two are equivalent - a list is automatically
+converted to a list reference for syntactic convenience. i.e. you
+can omit the outer C<[]>
+
+You can mix and match arrays, array refs, and PDLs in your argument
+list, and C<pdl> will sort them out. You get back a PDL whose last
+(slowest running) dim runs across the top level of the list you hand
+in, and whose first (fastest running) dim runs across the deepest
+level that you supply.
+At the moment, you cannot mix and match those arguments with string
+arguments, though we can't imagine a situation in which you would
+really want to do that.
+
+The string version of pdl also allows you to use the strings C<bad>, C<inf>,
+and C<nan>, and it will insert the values that you mean (and set the bad flag
+if you use C<bad>). You can mix and match case, though you shouldn't. Here are
+some examples:
+
+ $bad = pdl q[1 2 3 bad 5 6]; # Set fourth element to the bad value
+ $bad = pdl q[1 2 3 BAD 5 6]; # ditto
+ $bad = pdl q[1 2 inf bad 5]; # now third element is IEEE infinite value
+ $bad = pdl q[nan 2 inf -inf]; # first value is IEEE nan value
+
+The default constructor uses IEEE double-precision floating point numbers. You
+can use other types, but you will get a warning if you try to use C<nan> with
+integer types (it will be replaced with the C<bad> value) and you will get a
+fatal error if you try to use C<inf>.
+
+Throwing a PDL into the mix has the same effect as throwing in a list ref:
+
+ pdl(pdl(1,2),[3,4])
+
+is the same as
+
+ pdl([1,2],[3,4]).
+
+All of the dimensions in the list are "padded-out" with undefval to
+meet the widest dim in the list, so (e.g.)
+
+ $a = pdl([[1,2,3],[2]])
+
+gives you the same answer as
+
+ $a = pdl([[1,2,3],[2,undef,undef]]);
+
+
+C<pdl()> is a functional synonym for the 'new' constructor,
+e.g.:
+
+ $x = new PDL [1..10];
+
+In order to control how undefs are handled in converting from perl lists to
+PDLs, one can set the variable C<$PDL::undefval>.
+For example:
+
+ $foo = [[1,2,undef],[undef,3,4]];
+ $PDL::undefval = -999;
+ $f = pdl $foo;
+ print $f
+ [
+ [ 1 2 -999]
+ [-999 3 4]
+ ]
+
+C<$PDL::undefval> defaults to zero.
+
+As a final note, if you include an Empty PDL in the list of objects to
+construct into a PDL, it is kept as a placeholder pane -- so if you feed
+in (say) 7 objects, you get a size of 7 in the 0th dim of the output PDL.
+The placeholder panes are completely padded out. But if you feed in only
+a single Empty PDL, you get back the Empty PDL (no padding).
+
+=cut
+
+sub pdl {PDL->pdl(@_)}
+
+sub piddle {PDL->pdl(@_)}
+
+=head2 null
+
+=for ref
+
+Returns a 'null' piddle.
+
+=for usage
+
+ $x = null;
+
+C<null()> has a special meaning to L<PDL::PP|PDL::PP>. It is used to
+flag a special kind of empty piddle, which can grow to
+appropriate dimensions to store a result (as opposed to
+storing a result in an existing piddle).
+
+=for example
+
+ pdl> sumover sequence(10,10), $ans=null;p $ans
+ [45 145 245 345 445 545 645 745 845 945]
+
+=cut
+
+sub PDL::null{
+ my $class = scalar(@_) ? shift : undef; # if this sub called with no
+ # class ( i.e. like 'null()', instead
+ # of '$obj->null' or 'CLASS->null', setup
+
+ if( defined($class) ){
+ $class = ref($class) || $class; # get the class name
+ }
+ else{
+ $class = 'PDL'; # set class to the current package name if null called
+ # with no arguments
+ }
+
+ return $class->initialize();
+}
+
+=head2 nullcreate
+
+=for ref
+
+Returns a 'null' piddle.
+
+=for usage
+
+ $x = PDL->nullcreate($arg)
+
+This is an routine used by many of the threading primitives
+(i.e. L<sumover|PDL::Ufunc/sumover>,
+L<minimum|PDL::Ufunc/minimum>, etc.) to generate a null piddle for the
+function's output that will behave properly for derived (or
+subclassed) PDL objects.
+
+For the above usage:
+If C<$arg> is a PDL, or a derived PDL, then C<$arg-E<gt>null> is returned.
+If C<$arg> is a scalar (i.e. a zero-dimensional PDL) then C<PDL-E<gt>null>
+is returned.
+
+=for example
+
+ PDL::Derived->nullcreate(10)
+ returns PDL::Derived->null.
+ PDL->nullcreate($pdlderived)
+ returns $pdlderived->null.
+
+=cut
+
+sub PDL::nullcreate{
+ my ($type,$arg) = @_;
+ return ref($arg) ? $arg->null : $type->null ;
+}
+
+=head2 nelem
+
+=for ref
+
+Return the number of elements in a piddle
+
+=for usage
+
+ $n = nelem($piddle); $n = $piddle->nelem;
+
+=for example
+
+ $mean = sum($data)/nelem($data);
+
+=head2 dims
+
+=for ref
+
+Return piddle dimensions as a perl list
+
+=for usage
+
+ @dims = $piddle->dims; @dims = dims($piddle);
+
+=for example
+
+ pdl> p @tmp = dims zeroes 10,3,22
+ 10 3 22
+
+See also L<shape|shape> which returns a piddle instead.
+
+=head2 shape
+
+=for ref
+
+Return piddle dimensions as a piddle
+
+=for usage
+
+ $shape = $piddle->shape; $shape = shape($piddle);
+
+=for example
+
+ pdl> p $shape = shape zeroes 10,3,22
+ [10 3 22]
+
+See also L<dims|dims> which returns a perl list.
+
+=head2 ndims
+
+=for ref
+
+Returns the number of dimensions in a piddle. Alias
+for L<getndims|PDL::Core/getndims>.
+
+=head2 getndims
+
+=for ref
+
+Returns the number of dimensions in a piddle
+
+=for usage
+
+ $ndims = $piddle->getndims;
+
+=for example
+
+ pdl> p zeroes(10,3,22)->getndims
+ 3
+
+=head2 dim
+
+=for ref
+
+Returns the size of the given dimension of a piddle. Alias
+for L<getdim|PDL::Core/getdim>.
+
+=head2 getdim
+
+=for ref
+
+Returns the size of the given dimension.
+
+=for usage
+
+ $dim0 = $piddle->getdim(0);
+
+=for example
+
+ pdl> p zeroes(10,3,22)->getdim(1)
+ 3
+
+Negative indices count from the end of the dims array.
+Indices beyond the end will return a size of 1. This
+reflects the idea that any pdl is equivalent to an
+infinitely dimensional array in which only a finite number of
+dimensions have a size different from one. For example, in that sense a
+3D piddle of shape [3,5,2] is equivalent to a [3,5,2,1,1,1,1,1,....]
+piddle. Accordingly,
+
+ print $a->getdim(10000);
+
+will print 1 for most practically encountered piddles.
+
+=head2 topdl
+
+=for ref
+
+alternate piddle constructor - ensures arg is a piddle
+
+=for usage
+
+ $a = topdl(SCALAR|ARRAY REFERENCE|ARRAY);
+
+The difference between L<pdl()|/pdl> and C<topdl()> is that the
+latter will just 'fall through' if the argument is
+already a piddle. It will return a reference and I<NOT>
+a new copy.
+
+This is particulary useful if you are writing a function
+which is doing some fiddling with internals and assumes
+a piddle argument (e.g. for method calls). Using C<topdl()>
+will ensure nothing breaks if passed with '2'.
+
+Note that C<topdl()> is not exported by default (see example
+below for usage).
+
+=for example
+
+ use PDL::Core ':Internal'; # use the internal routines of
+ # the Core module
+
+ $a = topdl 43; # $a is piddle with value '43'
+ $b = topdl $piddle; # fall through
+ $a = topdl (1,2,3,4); # Convert 1D array
+
+=head2 PDL::get_datatype
+
+=for ref
+
+Internal: Return the numeric value identifying the piddle datatype
+
+=for usage
+
+ $x = $piddle->get_datatype;
+
+Mainly used for internal routines.
+
+NOTE: get_datatype returns 'just a number' not any special
+type object, unlike L<type|/type>.
+
+=head2 howbig
+
+=for ref
+
+Returns the sizeof a piddle datatype in bytes.
+
+Note that C<howbig()> is not exported by default (see example
+below for usage).
+
+=for usage
+
+ use PDL::Core ':Internal'; # use the internal routines of
+ # the Core module
+
+ $size = howbig($piddle->get_datatype);
+
+Mainly used for internal routines.
+
+NOTE: NOT a method! This is because get_datatype returns
+'just a number' not any special object.
+
+=for example
+
+ pdl> p howbig(ushort([1..10])->get_datatype)
+ 2
+
+
+=head2 get_dataref
+
+=for ref
+
+Return the internal data for a piddle, as a perl SCALAR ref.
+
+Most piddles hold their internal data in a packed perl string, to take
+advantage of perl's memory management. This gives you direct access
+to the string, which is handy when you need to manipulate the binary
+data directly (e.g. for file I/O). If you modify the string, you'll
+need to call L<upd_data|upd_data> afterward, to make sure that the
+piddle points to the new location of the underlying perl variable.
+
+Calling C<get_dataref> automatically physicalizes your piddle (see
+L<make_physical|/PDL::make_physical>). You definitely
+don't want to do anything to the SV to truncate or deallocate the
+string, unless you correspondingly call L<reshape|/reshape> to make the
+PDL match its new data dimension.
+
+You definitely don't want to use get_dataref unless you know what you
+are doing (or are trying to find out): you can end up scrozzling
+memory if you shrink or eliminate the string representation of the
+variable. Here be dragons.
+
+=head2 upd_data
+
+=for ref
+
+Update the data pointer in a piddle to match its perl SV.
+
+This is useful if you've been monkeying with the packed string
+representation of the PDL, which you probably shouldn't be doing
+anyway. (see L<get_dataref|get_dataref>.)
+
+=cut
+
+sub topdl {PDL->topdl(@_)}
+
+####################### Overloaded operators #######################
+
+{ package PDL;
+ # use UNIVERSAL 'isa'; # need that later in info function
+ use Carp;
+
+ use overload (
+ "+" => \&PDL::plus, # in1, in2
+ "*" => \&PDL::mult, # in1, in2
+ "-" => \&PDL::minus, # in1, in2, swap if true
+ "/" => \&PDL::divide, # in1, in2, swap if true
+
+ "+=" => sub { PDL::plus ($_[0], $_[1], $_[0], 0); $_[0]; }, # in1, in2, out, swap if true
+ "*=" => sub { PDL::mult ($_[0], $_[1], $_[0], 0); $_[0]; }, # in1, in2, out, swap if true
+ "-=" => sub { PDL::minus ($_[0], $_[1], $_[0], 0); $_[0]; }, # in1, in2, out, swap if true
+ "/=" => sub { PDL::divide ($_[0], $_[1], $_[0], 0); $_[0]; }, # in1, in2, out, swap if true
+
+ ">" => \&PDL::gt, # in1, in2, swap if true
+ "<" => \&PDL::lt, # in1, in2, swap if true
+ "<=" => \&PDL::le, # in1, in2, swap if true
+ ">=" => \&PDL::ge, # in1, in2, swap if true
+ "==" => \&PDL::eq, # in1, in2
+ "eq" => \&PDL::eq, # in1, in2
+ "!=" => \&PDL::ne, # in1, in2
+
+ "<<" => \&PDL::shiftleft, # in1, in2, swap if true
+ ">>" => \&PDL::shiftright, # in1, in2, swap if true
+ "|" => \&PDL::or2, # in1, in2
+ "&" => \&PDL::and2, # in1, in2
+ "^" => \&PDL::xor, # in1, in2
+
+ "<<=" => sub { PDL::shiftleft ($_[0], $_[1], $_[0], 0); $_[0]; }, # in1, in2, out, swap if true
+ ">>=" => sub { PDL::shiftright($_[0], $_[1], $_[0], 0); $_[0]; }, # in1, in2, out, swap if true
+ "|=" => sub { PDL::or2 ($_[0], $_[1], $_[0], 0); $_[0]; }, # in1, in2, out, swap if true
+ "&=" => sub { PDL::and2 ($_[0], $_[1], $_[0], 0); $_[0]; }, # in1, in2, out, swap if true
+ "^=" => sub { PDL::xor ($_[0], $_[1], $_[0], 0); $_[0]; }, # in1, in2, out, swap if true
+ "**=" => sub { PDL::power ($_[0], $_[1], $_[0], 0); $_[0]; }, # in1, in2, out, swap if true
+ "%=" => sub { PDL::modulo ($_[0], $_[1], $_[0], 0); $_[0]; }, # in1, in2, out, swap if true
+
+ "sqrt" => sub { PDL::sqrt ($_[0]); },
+ "abs" => sub { PDL::abs ($_[0]); },
+ "sin" => sub { PDL::sin ($_[0]); },
+ "cos" => sub { PDL::cos ($_[0]); },
+
+ "!" => sub { PDL::not ($_[0]); },
+ "~" => sub { PDL::bitnot ($_[0]); },
+
+ "log" => sub { PDL::log ($_[0]); },
+ "exp" => sub { PDL::exp ($_[0]); },
+
+ "**" => \&PDL::power, # in1, in2, swap if true
+
+ "atan2" => \&PDL::atan2, # in1, in2, swap if true
+ "%" => \&PDL::modulo, # in1, in2, swap if true
+
+ "<=>" => \&PDL::spaceship, # in1, in2, swap if true
+
+ "=" => sub {$_[0]}, # Don't deep copy, just copy reference
+
+ ".=" => sub {
+ my @args = reverse &PDL::Core::rswap;
+ PDL::Ops::assgn(@args);
+ return $args[1];
+ },
+
+ 'x' => sub{my $foo = $_[0]->null();
+ PDL::Primitive::matmult(@_[0,1],$foo); $foo;},
+
+ 'bool' => sub { return 0 if $_[0]->isnull;
+ croak("multielement piddle in conditional expression")
+ unless $_[0]->nelem == 1;
+ $_[0]->clump(-1)->at(0); },
+ "\"\"" => \&PDL::Core::string );
+}
+
+sub rswap { if($_[2]) { return @_[1,0]; } else { return @_[0,1]; } }
+
+##################### Data type/conversion stuff ########################
+
+
+# XXX Optimize!
+
+sub PDL::dims { # Return dimensions as @list
+ my $pdl = PDL->topdl (shift);
+ my @dims = ();
+ for(0..$pdl->getndims()-1) {push @dims,($pdl->getdim($_))}
+ return @dims;
+}
+
+sub PDL::shape { # Return dimensions as a pdl
+ my $pdl = PDL->topdl (shift);
+ my @dims = ();
+ for(0..$pdl->getndims()-1) {push @dims,($pdl->getdim($_))}
+ return pdl(\@dims);
+}
+
+sub PDL::howbig {
+ my $t = shift;
+ if("PDL::Type" eq ref $t) {$t = $t->[0]}
+ PDL::howbig_c($t);
+}
+
+=head2 PDL::threadids
+
+=for ref
+
+Returns the piddle thread IDs as a perl list
+
+Note that C<threadids()> is not exported by default (see example
+below for usage).
+
+=for usage
+
+ use PDL::Core ':Internal'; # use the internal routines of
+ # the Core module
+
+ @ids = threadids $piddle;
+
+=cut
+
+sub PDL::threadids { # Return dimensions as @list
+ my $pdl = PDL->topdl (shift);
+ my @dims = ();
+ for(0..$pdl->getnthreadids()) {push @dims,($pdl->getthreadid($_))}
+ return @dims;
+}
+
+################# Creation/copying functions #######################
+
+
+sub PDL::pdl { my $x = shift; return $x->new(@_) }
+
+=head2 doflow
+
+=for ref
+
+Turn on/off dataflow
+
+=for usage
+
+ $x->doflow; doflow($x);
+
+=cut
+
+sub PDL::doflow {
+ my $this = shift;
+ $this->set_dataflow_f(1);
+ $this->set_dataflow_b(1);
+}
+
+=head2 flows
+
+=for ref
+
+Whether or not a piddle is indulging in dataflow
+
+=for usage
+
+ something if $x->flows; $hmm = flows($x);
+
+=cut
+
+sub PDL::flows {
+ my $this = shift;
+ return ($this->fflows || $this->bflows);
+}
+
+=head2 PDL::new
+
+=for ref
+
+new piddle constructor method
+
+=for usage
+
+ $x = PDL->new(SCALAR|ARRAY|ARRAY REF|STRING);
+
+=for example
+
+ $x = PDL->new(42); # new from a Perl scalar
+ $x = new PDL 42; # ditto
+ $y = PDL->new(@list_of_vals); # new from Perl list
+ $y = new PDL @list_of_vals; # ditto
+ $z = PDL->new(\@list_of_vals); # new from Perl list reference
+ $w = PDL->new("[1 2 3]"); # new from Perl string, using
+ # Matlab constructor syntax
+
+Constructs piddle from perl numbers and lists
+and strings with Matlab/Octave style constructor
+syntax.
+
+The string input is fairly versatile though not
+performance optimized. The goal is to make it
+easy to copy and paste code from PDL output and
+to offer a familiar Matlab syntax for piddle
+construction. As of May, 2010, it is a new
+feature, so feel free to report bugs or suggest
+new features. See documentation for L<pdl> for
+more examples of usage.
+
+
+=cut
+
+use Scalar::Util; # for looks_like_number test
+use Carp 'carp'; # for carping (warnings in caller's context)
+
+# This is the code that handles string arguments. It has now gotten quite large,
+# so here's the basic explanation. I want to allow expressions like 2, 1e3, +4,
+# bad, nan, inf, and more. Checking this can get tricky. This croaks when it
+# finds:
+# 1) strings of e or E that are longer than 1 character long (like eeee)
+# 2) non-supported characters or strings
+# 3) expressions that are syntactically erroneous, like '1 2 3 ]', which has an
+# extra bracket
+# 4) use of inf when the data type does not support inf (i.e. the integers)
+
+sub PDL::Core::new_pdl_from_string {
+ my ($new, $original_value, $this, $type) = @_;
+ my $value = $original_value;
+
+ # Check for input that would generate empty piddles as output:
+ my @types = PDL::Types::types;
+ return zeroes($types[$type], 1)->where(zeroes(1) < 0)
+ if ($value eq '' or $value eq '[]');
+
+ # I check for invalid characters later, but arbitrary strings of e will
+ # pass that check, so I'll check for that here, first.
+# croak("PDL::Core::new_pdl_from_string: I found consecutive copies of e but\n"
+# . " I'm not sure what you mean. You gave me $original_value")
+# if ($value =~ /ee/i);
+ croak("PDL::Core::new_pdl_from_string: found 'e' as part of a larger word in $original_value")
+ if $value =~ /e\p{IsAlpha}/ or $value =~ /\p{IsAlpha}e/;
+
+ # Only a few characters are allowed in the expression, but we want to allow
+ # expressions like 'inf' and 'bad'. As such, convert those values to internal
+ # representations that will pass the invalid-character check. We'll replace
+ # them with Perl-evalute-able strings in a little bit. Here, I represent
+ # bad => EE
+ # nan => ee
+ # inf => Ee
+ # pi => eE
+ # --( Bad )--
+ croak("PDL::Core::new_pdl_from_string: found 'bad' as part of a larger word in $original_value")
+ if $value =~ /bad\B/ or $value =~ /\Bbad/;
+ my ($has_bad) = ($value =~ s/\bbad\b/EE/gi);
+ # --( nan )--
+ my ($has_nan) = 0;
+ croak("PDL::Core::new_pdl_from_string: found 'nan' as part of a larger word in $original_value")
+ if $value =~ /\Bnan/ or $value =~ /nan\B/;
+ $has_nan++ if ($value =~ s/\bnan\b/ee/gi);
+ # Strawberry Perl compatibility:
+ croak("PDL::Core::new_pdl_from_string: found '1.#IND' as part of a larger word in $original_value")
+ if $value =~ /IND\B/i;
+ $has_nan++ if ($value =~ s/1\.\#IND/ee/gi);
+ # --( inf )--
+ my ($has_inf) = 0;
+ # Strawberry Perl compatibility:
+ croak("PDL::Core::new_pdl_from_string: found '1.#INF' as part of a larger word in $original_value")
+ if $value =~ /INF\B/i;
+ $has_inf++ if ($value =~ s/1\.\#INF/Ee/gi);
+ # Other platforms:
+ croak("PDL::Core::new_pdl_from_string: found 'inf' as part of a larger word in $original_value")
+ if $value =~ /inf\B/ or $value =~ /\Binf/;
+ $has_inf++ if ($value =~ s/\binf\b/Ee/gi);
+ # --( pi )--
+ croak("PDL::Core::new_pdl_from_string: found 'pi' as part of a larger word in $original_value")
+ if $value =~ /pi\B/ or $value =~ /\Bpi/;
+ $value =~ s/\bpi\b/eE/gi;
+
+ # Some data types do not support nan and inf, so check for and warn or croak,
+ # as appropriate:
+ if ($has_nan and not $types[$type]->usenan) {
+ carp("PDL::Core::new_pdl_from_string: no nan for type $types[$type]; converting to bad value");
+ $value =~ s/ee/EE/g;
+ $has_bad += $has_nan;
+ $has_nan = 0;
+ }
+ croak("PDL::Core::new_pdl_from_string: type $types[$type] does not support inf")
+ if ($has_inf and not $types[$type]->usenan);
+
+ # Make the white-space uniform and see if any not-allowed characters are
+ # present:
+ $value =~ s/\s+/ /g;
+ if (my ($disallowed) = ($value =~ /([^\[\]\+\-0-9;,.eE ]+)/)) {
+ croak("PDL::Core::new_pdl_from_string: found disallowed character(s) '$disallowed' in $original_value");
+ }
+
+ # Wrap the string in brackets [], so that the following works:
+ # $a = new PDL q[1 2 3];
+ # We'll have to check for dimensions of size one after we've parsed
+ # the string and built a PDL from the resulting array.
+ $value = '[' . $value . ']';
+
+ # Make sure that each closing bracket followed by an opening bracket
+ # has a comma in between them:
+ $value =~ s/\]\s*\[/],[/g;
+
+ # Semicolons indicate 'start a new row' and require special handling:
+ if ($value =~ /;/) {
+ $value =~ s/(\[[^\]]+;[^\]]+\])/[$1]/g;
+ $value =~ s/;/],[/g;
+ }
+
+ # Remove ending decimal points and insert zeroes in front of starting
+ # decimal points. This makes the white-space-to-comma replacement
+ # in the next few lines much simpler.
+ $value =~ s/(\d\.)(z|[^\d])/${1}0$2/g;
+ $value =~ s/(\A|[^\d])\./${1}0./g;
+
+ # Remove whitspace between signs and the numbers that follow them:
+ $value =~ s/([+\-])\s+/$1/g;
+
+# # make unambiguous addition/subtraction (white-space on both sides
+# # of operator) by removing white-space from both sides
+# $value =~ s/([\dEe])\s+([+\-])\s+(?=[Ee\d])/$1$2/g;
+
+ # Replace white-space separators with commas:
+ $value =~ s/([.\deE])\s+(?=[+\-eE\d])/$1,/g;
+
+ # Remove all other white space:
+ $value =~ s/\s+//g;
+
+ # Croak on operations with bad values. It might be nice to simply replace
+ # these with bad values, but that is more difficult that I like, so I'm just
+ # going to disallow that here:
+ croak("PDL::Core::new_pdl_from_string: Operations with bad values are not supported")
+ if($value =~ /EE[+\-]/ or $value =~ /[+\-]EE/);
+
+ # Check for things that will evaluate as functions and croak if found
+ if (my ($disallowed) = ($value =~ /((\D+|\A)[eE]\d+)/)) {
+ croak("PDL::Core::new_pdl_from_string: syntax error, looks like an improper exponentiation: $disallowed\n"
+ . "You originally gave me $original_value\n");
+ }
+
+ # Replace the place-holder strings with strings that will evaluate to their
+ # correct numerical values when we run the eval:
+ $value =~ s/\bEE\b/bad/g;
+ my $bad = $types[$type]->badvalue;
+ $value =~ s/\bee\b/nan/g;
+ my $inf = -pdl(0)->log;
+ $value =~ s/\bEe\b/inf/g;
+ my $nnan = $inf - $inf;
+ my $nan= $this->initialize();
+ $nan->set_datatype(6);
+ $nan->setdims([]);
+
+ # pack("d*", "nan") will work here only on perls that numify the string "nan" to a NaN.
+ # pack( "d*", (-1.0) ** 0.5 ) will hopefully work in more places, though it seems both
+ # pack("d*", "nan") and pack( "d*", (-1.0) ** 0.5 ) fail on *old* MS Compilers (MSVC++ 6.0 and earlier).
+ # sisyphus 4 Jan 2013.
+ ${$nan->get_dataref} = pack( "d*", (-1.0) ** 0.5 );
+
+ $nan->upd_data();
+ $value =~ s/\beE\b/pi/g;
+
+ my $val = eval{
+ # Install the warnings handler:
+ my $old_warn_handler = $SIG{__WARN__};
+ local $SIG{__WARN__} = sub {
+ if ($_[0] =~ /(Argument ".*" isn't numeric)/) {
+ # Send the error through die. This is *always* get caught, so keep
+ # it simple.
+ die "Incorrectly formatted input: $1\n";
+ }
+ elsif ($old_warn_handler) {
+ $old_warn_handler->(@_);
+ }
+ else {
+ warn @_;
+ }
+ };
+
+ # Let's see if we can parse it as an array-of-arrays:
+ local $_ = $value;
+ return PDL::Core::parse_basic_string ($inf, $nan, $nnan, $bad);
+ };
+
+ # Respect BADVAL_USENAN
+ require PDL::Config;
+ $has_bad += $has_inf + $has_nan if $PDL::Config{BADVAL_USENAN};
+
+ if (ref $val eq 'ARRAY') {
+ my $to_return = PDL::Core::pdl_avref($val,$this,$type);
+ # remove potentially spurious last dimension
+ $to_return = $to_return->mv(-1,1)->clump(2)
+ if $to_return->dims > 1 and $to_return->dim(-1) == 1;
+ # fix scalar values
+ $to_return->setdims([])
+ if $to_return->dims == 1 and $to_return->dim(-1) == 1;
+ # Mark bad if appropriate
+ $to_return->badflag($has_bad > 0);
+ return $to_return;
+ }
+ else {
+ my @message = ("PDL::Core::new_pdl_from_string: string input='$original_value', string output='$value'" );
+ if ($@) {
+ push @message, $@;
+ } else {
+ push @message, "Internal error: unexpected output type ->$val<- is not ARRAY ref";
+ }
+ croak join("\n ", @message);
+ }
+}
+
+sub PDL::Core::parse_basic_string {
+ # Assumes $_ holds the string of interest, and modifies that value
+ # in-place.
+
+ use warnings;
+
+ # Takes a string with proper bracketing, etc, and returns an array-of-arrays
+ # filled with numbers, suitable for use with pdl_avref. It uses recursive
+ # descent to handle the nested nature of the data. The string should have
+ # no whitespace and should be something that would evaluate into a Perl
+ # array-of-arrays (except that strings like 'inf', etc, are allowed).
+
+ my ($inf, $nan, $nnan, $bad) = @_;
+
+ # First character should be a bracket:
+ die "Internal error: input string -->$_<-- did not start with an opening bracket\n"
+ unless s/^\[//;
+
+ my @to_return;
+ # Loop until we run into our closing bracket:
+ my $sign = 1;
+ my $expects_number = 0;
+ SYMBOL: until (s/^\]//) {
+ # If we have a bracket, then go recursive:
+ if (/^\[/) {
+ die "Expected a number but found a bracket at ... ", substr ($_, 0, 10), "...\n"
+ if $expects_number;
+ push @to_return, PDL::Core::parse_basic_string(@_);
+ next SYMBOL;
+ }
+ elsif (s/^\+//) {
+ die "Expected number but found a plus sign at ... ", substr ($_, 0, 10), "...\n"
+ if $expects_number;
+ $expects_number = 1;
+ redo SYMBOL;
+ }
+ elsif (s/^\-//) {
+ die "Expected number but found a minus sign at ... ", substr ($_, 0, 10), "...\n"
+ if $expects_number;
+ $sign = -1;
+ $expects_number = 1;
+ redo SYMBOL;
+ }
+ elsif (s/^bad//i) {
+ push @to_return, $bad;
+ }
+ elsif (s/^inf//i or s/1\.\#INF//i) {
+ push @to_return, $sign * $inf;
+ }
+ elsif (s/^nan//i or s/^1\.\#IND//i) {
+ if ($sign == -1) {
+ push @to_return, $nnan;
+ } else {
+ push @to_return, $nan;
+ }
+ }
+ elsif (s/^pi//i) {
+ push @to_return, $sign * 4 * atan2(1, 1);
+ }
+ elsif (s/^e//i) {
+ push @to_return, $sign * exp(1);
+ }
+ elsif (s/^([\d+\-e.]+)//i) {
+ # Note that improper numbers are handled by the warning signal
+ # handler
+ push @to_return, $sign * $1;
+ }
+ else {
+ die "Incorrectly formatted input at:\n ", substr ($_, 0, 10), "...\n";
+ }
+ }
+ # Strip off any commas
+ continue {
+ $sign = 1;
+ $expects_number = 0;
+ s/^,//;
+ }
+
+ return \@to_return;
+}
+
+sub PDL::new {
+ # print "in PDL::new\n";
+ my $this = shift;
+ return $this->copy if ref($this);
+ my $type = ref($_[0]) eq 'PDL::Type' ? ${shift @_}[0] : $PDL_D;
+ my $value = (@_ >1 ? [@_] : shift); # ref thyself
+
+ unless(defined $value) {
+ if($PDL::debug && $PDL::undefval) {
+ print STDERR "Warning: PDL::new converted undef to $PDL::undefval ($PDL::undefval)\n";
+ }
+ $value = $PDL::undefval+0
+ }
+
+ return pdl_avref($value,$this,$type) if ref($value) eq "ARRAY";
+ my $new = $this->initialize();
+ $new->set_datatype($type);
+
+
+ if (ref(\$value) eq "SCALAR") {
+ # The string processing is extremely slow. Benchmarks indicated that it
+ # takes 10x longer to process a scalar number compared with normal Perl
+ # conversion of a string to a number. So, only use the string processing
+ # if the input looks like a real string, i.e. it doesn't look like a plain
+ # number. Note that for our purposes, looks_like_number incorrectly
+ # handles the strings 'inf' and 'nan' on Windows machines. We want to send
+ # those to the string processing, so this checks for them in a way that
+ # short-circuits the looks_like_number check.
+ if (PDL::Core::is_scalar_SvPOK($value)
+ and ($value =~ /inf/i or $value =~ /nan/i
+ or !Scalar::Util::looks_like_number($value))) {
+ # new was passed a string argument that doesn't look like a number
+ # so we can process as a Matlab-style data entry format.
+ return PDL::Core::new_pdl_from_string($new,$value,$this,$type);
+ } else {
+ $new->setdims([]);
+ ${$new->get_dataref} = pack( $pack[$new->get_datatype], $value );
+ $new->upd_data();
+ }
+ }
+ elsif (blessed($value)) { # Object
+ $new = $value->copy;
+ }
+ else {
+ barf("Can not interpret argument $value of type ".ref($value) );
+ }
+ return $new;
+}
+
+
+=head2 copy
+
+=for ref
+
+Make a physical copy of a piddle
+
+=for usage
+
+ $new = $old->copy;
+
+Since C<$new = $old> just makes a new reference, the
+C<copy> method is provided to allow real independent
+copies to be made.
+
+=cut
+
+# Inheritable copy method
+#
+# XXX Must be fixed
+# Inplace is handled by the op currently.
+
+sub PDL::copy {
+ my $value = shift;
+ barf("Argument is an ".ref($value)." not an object") unless blessed($value);
+ my $option = shift;
+ $option = "" if !defined $option;
+ if ($value->is_inplace) { # Copy protection
+ $value->set_inplace(0);
+ return $value;
+ }
+ # threadI(-1,[]) is just an identity vafftrans with threadId copying ;)
+ my $new = $value->threadI(-1,[])->sever;
+ return $new;
+}
+
+=head2 PDL::hdr_copy
+
+=for ref
+
+Return an explicit copy of the header of a PDL.
+
+hdr_copy is just a wrapper for the internal routine _hdr_copy, which
+takes the hash ref itself. That is the routine which is used to make
+copies of the header during normal operations if the hdrcpy() flag of
+a PDL is set.
+
+General-purpose deep copies are expensive in perl, so some simple
+optimization happens:
+
+If the header is a tied array or a blessed hash ref with an associated
+method called C<copy>, then that ->copy method is called. Otherwise, all
+elements of the hash are explicitly copied. References are recursively
+deep copied.
+
+This routine seems to leak memory.
+
+=cut
+
+sub PDL::hdr_copy {
+ my $pdl = shift;
+ my $hdr = $pdl->gethdr;
+ return PDL::_hdr_copy($hdr);
+}
+
+# Same as hdr_copy but takes a hash ref instead of a PDL.
+sub PDL::_hdr_copy {
+ my $hdr = shift;
+ my $tobj;
+
+ print "called _hdr_copy\n" if($PDL::debug);
+
+ unless( (ref $hdr)=~m/HASH/ ) {
+ print"returning undef\n" if($PDL::debug);
+ return undef ;
+ }
+
+ if($tobj = tied %$hdr) { #
+ print "tied..."if($PDL::debug);
+ if(UNIVERSAL::can($tobj,"copy")) {
+ my %rhdr;
+ tie(%rhdr, ref $tobj, $tobj->copy);
+ print "returning\n" if($PDL::debug);
+ return \%rhdr;
+ }
+
+ # Astro::FITS::Header is special for now -- no copy method yet
+ # but it is recognized. Once it gets a copy method this will become
+ # vestigial:
+
+ if(UNIVERSAL::isa($tobj,"Astro::FITS::Header")) {
+ print "Astro::FITS::Header..." if($PDL::debug);
+ my @cards = $tobj->cards;
+ my %rhdr;
+ tie(%rhdr,"Astro::FITS::Header", new Astro::FITS::Header(Cards=>\@cards));
+ print "returning\n" if($PDL::debug);
+ return \%rhdr;
+ }
+ }
+ elsif(UNIVERSAL::can($hdr,"copy")) {
+ print "found a copy method\n" if($PDL::debug);
+ return $hdr->copy;
+ }
+
+ # We got here if it's an unrecognized tie or if it's a vanilla hash.
+ print "Making a hash copy..." if($PDL::debug);
+
+ return PDL::_deep_hdr_copy($hdr);
+
+}
+
+#
+# Sleazy deep-copier that gets most cases
+# --CED 14-April-2003
+#
+
+sub PDL::_deep_hdr_copy {
+ my $val = shift;
+
+ if(ref $val eq 'HASH') {
+ my (%a,$key);
+ for $key(keys %$val) {
+ my $value = $val->{$key};
+ $a{$key} = (ref $value) ? PDL::_deep_hdr_copy($value) : $value;
+ }
+ return \%a;
+ }
+
+ if(ref $val eq 'ARRAY') {
+ my (@a,$z);
+ for $z(@$val) {
+ push(@a,(ref $z) ? PDL::_deep_hdr_copy($z) : $z);
+ }
+ return \@a;
+ }
+
+ if(ref $val eq 'SCALAR') {
+ my $a = $$val;
+ return \$a;
+ }
+
+ if(ref $val eq 'REF') {
+ my $a = PDL::_deep_hdr_copy($$val);
+ return \$a;
+ }
+
+ # Special case for PDLs avoids potential nasty header recursion...
+ if(UNIVERSAL::isa($val,'PDL')) {
+ my $h;
+ $val->hdrcpy(0) if($h = $val->hdrcpy); # assignment
+ my $out = $val->copy;
+ $val->hdrcpy($h) if($h);
+ return $out;
+ }
+
+ if(UNIVERSAL::can($val,'copy')) {
+ return $val->copy;
+ }
+
+ $val;
+}
+
+
+=head2 PDL::unwind
+
+=for ref
+
+Return a piddle which is the same as the argument except
+that all threadids have been removed.
+
+=for usage
+
+ $y = $x->unwind;
+
+=head2 PDL::make_physical
+
+=for ref
+
+Make sure the data portion of a piddle can be accessed from XS code.
+
+=for example
+
+ $a->make_physical;
+ $a->call_my_xs_method;
+
+Ensures that a piddle gets its own allocated copy of data. This obviously
+implies that there are certain piddles which do not have their own data.
+These are so called I<virtual> piddles that make use of the I<vaffine>
+optimisation (see L<PDL::Indexing|PDL::Indexing>).
+They do not have their own copy of
+data but instead store only access information to some (or all) of another
+piddle's data.
+
+Note: this function should not be used unless absolutely neccessary
+since otherwise memory requirements might be severly increased. Instead
+of writing your own XS code with the need to call C<make_physical> you
+might want to consider using the PDL preprocessor
+(see L<PDL::PP|PDL::PP>)
+which can be used to transparently access virtual piddles without the
+need to physicalise them (though there are exceptions).
+
+=cut
+
+sub PDL::unwind {
+ my $value = shift;
+ my $foo = $value->null();
+ $foo .= $value->unthread();
+ return $foo;
+}
+
+=head2 dummy
+
+=for ref
+
+Insert a 'dummy dimension' of given length (defaults to 1)
+
+No relation to the 'Dungeon Dimensions' in Discworld!
+
+Negative positions specify relative to last dimension,
+i.e. C<dummy(-1)> appends one dimension at end,
+C<dummy(-2)> inserts a dummy dimension in front of the
+last dim, etc.
+
+If you specify a dimension position larger than the existing
+dimension list of your PDL, the PDL gets automagically padded with extra
+dummy dimensions so that you get the dim you asked for, in the slot you
+asked for. This could cause you trouble if, for example,
+you ask for $a->dummy(5000,1) because $a will get 5,000 dimensions,
+each of rank 1.
+
+Because padding at the beginning of the dimension list moves existing
+dimensions from slot to slot, it's considered unsafe, so automagic
+padding doesn't work for large negative indices -- only for large
+positive indices.
+
+=for usage
+
+ $y = $x->dummy($position[,$dimsize]);
+
+=for example
+
+ pdl> p sequence(3)->dummy(0,3)
+ [
+ [0 0 0]
+ [1 1 1]
+ [2 2 2]
+ ]
+
+ pdl> p sequence(3)->dummy(3,2)
+ [
+ [
+ [0 1 2]
+ ]
+ [
+ [0 1 2]
+ ]
+ ]
+
+ pdl> p sequence(3)->dummy(-3,2)
+ Runtime error: PDL: For safety, <pos> < -(dims+1) forbidden in dummy. min=-2, pos=-3
+
+=cut
+
+sub PDL::dummy($$;$) {
+ my ($pdl,$dim,$size) = @_;
+ barf("Missing position argument to dummy()") unless defined $dim; # required argument
+ $dim = $pdl->getndims+1+$dim if $dim < 0;
+ $size = defined($size) ? (1 * $size) : 1; # make $size a number (sf feature # 3479009)
+
+ barf("For safety, <pos> < -(dims+1) forbidden in dummy. min="
+ . -($pdl->getndims+1).", pos=". ($dim-1-$pdl->getndims) ) if($dim<0);
+
+ my($s) = ',' x ( ($dim > $pdl->getndims) ? ($pdl->getndims) : ($dim) );
+ $s .= '*1,' x ( $dim-$pdl->getndims );
+ $s .= "*$size";
+
+ $pdl->slice($s);
+}
+
+
+## Cheesy, slow way
+# while ($dim>$pdl->getndims){
+# print STDERR "."; flush STDERR;
+# $pdl = $pdl->dummy($pdl->getndims,1);
+# }
+#
+# barf ("too high/low dimension in call to dummy, allowed min/max=0/"
+# . $_[0]->getndims)
+# if $dim>$pdl->getndims || $dim < 0;
+#
+# $_[2] = 1 if ($#_ < 2);
+# $pdl->slice((','x$dim)."*$_[2]");
+
+=head2 clump
+
+=for ref
+
+"clumps" several dimensions into one large dimension
+
+If called with one argument C<$n> clumps the first C<$n>
+dimensions into one. For example, if C<$a> has dimensions
+C<(5,3,4)> then after
+
+=for example
+
+ $b = $a->clump(2); # Clump 2 first dimensions
+
+the variable C<$b> will have dimensions C<(15,4)>
+and the element C<$b-E<gt>at(7,3)> refers to the element
+C<$a-E<gt>at(1,2,3)>.
+
+Use C<clump(-1)> to flatten a piddle. The method L<flat|PDL::Core/flat>
+is provided as a convenient alias.
+
+Clumping with a negative dimension in general leaves that many
+dimensions behind -- e.g. clump(-2) clumps all of the first few
+dimensions into a single one, leaving a 2-D piddle.
+
+If C<clump> is called with an index list with more than one element
+it is treated as a list of dimensions that should be clumped together
+into one. The resulting
+clumped dim is placed at the position of the lowest index in the list.
+This convention ensures that C<clump> does the expected thing in
+the usual cases. The following example demonstrates typical usage:
+
+ $a = sequence 2,3,3,3,5; # 5D piddle
+ $c = $a->clump(1..3); # clump all the dims 1 to 3 into one
+ print $c->info; # resulting 3D piddle has clumped dim at pos 1
+ PDL: Double D [2,27,5]
+
+=cut
+
+sub PDL::clump {
+ my $ndims = $_[0]->getndims;
+ if ($#_ < 2) {
+ return &PDL::_clump_int($_[0],$_[1]) # Truncate clumping to actual dims
+ if $_[1] > $ndims;
+ return &PDL::_clump_int(@_);
+ } else {
+ my ($this, at dims) = @_;
+ my $targd = $ndims-1;
+ my @dimmark = (0..$ndims-1);
+ barf "too many dimensions" if @dims > $ndims;
+ for my $dim (@dims) {
+ barf "dimension index $dim larger than greatest dimension"
+ if $dim > $ndims-1 ;
+ $targd = $dim if $targd > $dim;
+ barf "duplicate dimension $dim" if $dimmark[$dim]++ > $dim;
+ }
+ my $clumped = $this->thread(@dims)->unthread(0)->clump(scalar @dims);
+ $clumped = $clumped->mv(0,$targd) if $targd > 0;
+ return $clumped;
+ }
+}
+
+=head2 thread_define
+
+=for ref
+
+define functions that support threading at the perl level
+
+=for example
+
+ thread_define 'tline(a(n);b(n))', over {
+ line $_[0], $_[1]; # make line compliant with threading
+ };
+
+
+C<thread_define> provides some support for threading (see
+L<PDL::Indexing>) at the perl level. It allows you to do things for
+which you normally would have resorted to PDL::PP (see L<PDL::PP>);
+however, it is most useful to wrap existing perl functions so that the
+new routine supports PDL threading.
+
+C<thread_define> is used to define new I<threading aware>
+functions. Its first argument is a symbolic repesentation of the new
+function to be defined. The string is composed of the name of the new
+function followed by its signature (see L<PDL::Indexing> and L<PDL::PP>)
+in parentheses. The second argument is a subroutine that will be
+called with the slices of the actual runtime arguments as specified by
+its signature. Correct dimension sizes and minimal number of
+dimensions for all arguments will be checked (assuming the rules of
+PDL threading, see L<PDL::Indexing>).
+
+The actual work is done by the C<signature> class which parses the signature
+string, does runtime dimension checks and the routine C<threadover> that
+generates the loop over all appropriate slices of pdl arguments and creates
+pdls as needed.
+
+Similar to C<pp_def> and its C<OtherPars> option it is possible to
+define the new function so that it accepts normal perl args as well as
+piddles. You do this by using the C<NOtherPars> parameter in the
+signature. The number of C<NOtherPars> specified will be passed
+unaltered into the subroutine given as the second argument of
+C<thread_define>. Let's illustrate this with an example:
+
+ PDL::thread_define 'triangles(inda();indb();indc()), NOtherPars => 2',
+ PDL::over {
+ ${$_[3]} .= $_[4].join(',',map {$_->at} @_[0..2]).",-1,\n";
+ };
+
+This defines a function C<triangles> that takes 3 piddles as input
+plus 2 arguments which are passed into the routine unaltered. This routine
+is used to collect lists of indices into a perl scalar that is passed by
+reference. Each line is preceded by a prefix passed as C<$_[4]>. Here is
+typical usage:
+
+ $txt = '';
+ triangles(pdl(1,2,3),pdl(1),pdl(0),\$txt," "x10);
+ print $txt;
+
+resulting in the following output
+
+ 1,1,0,-1,
+ 2,1,0,-1,
+ 3,1,0,-1,
+
+which is used in
+L<PDL::Graphics::TriD::VRML|PDL::Graphics::TriD::VRML>
+to generate VRML output.
+
+Currently, this is probably not much more than a POP (proof of principle)
+but is hoped to be useful enough for some real life work.
+
+Check L<PDL::PP|PDL::PP> for the format of the signature. Currently, the
+C<[t]> qualifier and all type qualifiers are ignored.
+
+=cut
+
+sub PDL::over (&) { $_[0] }
+sub PDL::thread_define ($$) {
+ require PDL::PP::Signature;
+ my ($str,$sub) = @_;
+ my $others = 0;
+ if ($str =~ s/[,]*\s*NOtherPars\s*=>\s*([0-9]+)\s*[,]*//) {$others = $1}
+ barf "invalid string $str" unless $str =~ /\s*([^(]+)\((.+)\)\s*$/x;
+ my ($name,$sigstr) = ($1,$2);
+ print "defining '$name' with signature '$sigstr' and $others extra args\n"
+ if $PDL::debug;
+ my $sig = new PDL::PP::Signature($sigstr);
+ my $args = @{$sig->names}; # number of piddle arguments
+ barf "no piddle args" if $args == 0;
+ $args--;
+ # TODO: $sig->dimcheck(@_) + proper creating generation
+ my $def = "\@_[0..$args] = map {PDL::Core::topdl(\$_)} \@_[0..$args];\n".
+ '$sig->checkdims(@_);
+ PDL::threadover($others, at _,$sig->realdims,$sig->creating,$sub)';
+ my $package = caller;
+ local $^W = 0; # supress the 'not shared' warnings
+ print "defining...\nsub $name { $def }\n" if $PDL::debug;
+ eval ("package $package; sub $name { $def }");
+ barf "error defining $name: $@\n" if $@;
+}
+
+=head2 PDL::thread
+
+=for ref
+
+Use explicit threading over specified dimensions (see also L<PDL::Indexing>)
+
+=for usage
+
+ $b = $a->thread($dim,[$dim1,...])
+
+=for example
+
+ $a = zeroes 3,4,5;
+ $b = $a->thread(2,0);
+
+Same as L<PDL::thread1|/PDL::thread1>, i.e. uses thread id 1.
+
+=cut
+
+sub PDL::thread {
+ my $var = shift;
+ $var->threadI(1,\@_);
+}
+
+=head2 diagonal
+
+=for ref
+
+Returns the multidimensional diagonal over the specified dimensions.
+
+=for usage
+
+ $d = $x->diagonal(dim1, dim2,...)
+
+=for example
+
+ pdl> $a = zeroes(3,3,3);
+ pdl> ($b = $a->diagonal(0,1))++;
+ pdl> p $a
+ [
+ [
+ [1 0 0]
+ [0 1 0]
+ [0 0 1]
+ ]
+ [
+ [1 0 0]
+ [0 1 0]
+ [0 0 1]
+ ]
+ [
+ [1 0 0]
+ [0 1 0]
+ [0 0 1]
+ ]
+ ]
+
+=cut
+
+sub PDL::diagonal {
+ my $var = shift;
+ $var->diagonalI(\@_);
+}
+
+=head2 PDL::thread1
+
+=for ref
+
+Explicit threading over specified dims using thread id 1.
+
+=for usage
+
+ $xx = $x->thread1(3,1)
+
+=for example
+
+ Wibble
+
+Convenience function interfacing to
+L<PDL::Slices::threadI|PDL::Slices/threadI>.
+
+=cut
+
+sub PDL::thread1 {
+ my $var = shift;
+ $var->threadI(1,\@_);
+}
+
+=head2 PDL::thread2
+
+=for ref
+
+Explicit threading over specified dims using thread id 2.
+
+=for usage
+
+ $xx = $x->thread2(3,1)
+
+=for example
+
+ Wibble
+
+Convenience function interfacing to
+L<PDL::Slices::threadI|PDL::Slices/threadI>.
+
+=cut
+
+sub PDL::thread2 {
+ my $var = shift;
+ $var->threadI(2,\@_);
+}
+
+=head2 PDL::thread3
+
+=for ref
+
+Explicit threading over specified dims using thread id 3.
+
+=for usage
+
+ $xx = $x->thread3(3,1)
+
+=for example
+
+ Wibble
+
+Convenience function interfacing to
+L<PDL::Slices::threadI|PDL::Slices/threadI>.
+
+=cut
+
+sub PDL::thread3 {
+ my $var = shift;
+ $var->threadI(3,\@_);
+}
+
+my %info = (
+ D => {
+ Name => 'Dimension',
+ Sub => \&PDL::Core::dimstr,
+ },
+ T => {
+ Name => 'Type',
+ Sub => sub { return $_[0]->type->shortctype; },
+ },
+ S => {
+ Name => 'State',
+ Sub => sub { my $state = '';
+ $state .= 'P' if $_[0]->allocated;
+ $state .= 'V' if $_[0]->vaffine &&
+ !$_[0]->allocated; # apparently can be both?
+ $state .= '-' if $state eq ''; # lazy eval
+ $state .= 'C' if $_[0]->anychgd;
+ $state .= 'B' if $_[0]->badflag;
+ $state;
+ },
+ },
+ F => {
+ Name => 'Flow',
+ Sub => sub { my $flows = '';
+ $flows = ($_[0]->bflows ? 'b':'') .
+ '~' . ($_[0]->fflows ? 'f':'')
+ if ($_[0]->flows);
+ $flows;
+ },
+ },
+ M => {
+ Name => 'Mem',
+ Sub => sub { my ($size,$unit) = ($_[0]->allocated ?
+ $_[0]->nelem*
+ PDL::howbig($_[0]->get_datatype)/1024 : 0, 'KB');
+ if ($size > 0.01*1024) { $size /= 1024;
+ $unit = 'MB' };
+ return sprintf "%6.2f%s",$size,$unit;
+ },
+ },
+ C => {
+ Name => 'Class',
+ Sub => sub { ref $_[0] }
+ },
+ A => {
+ Name => 'Address',
+ Sub => sub { use Config;
+ my $ivdformat = $Config{ivdformat};
+ $ivdformat =~ s/"//g;
+ sprintf "%$ivdformat", $_[0]->address }
+ },
+ );
+
+my $allowed = join '',keys %info;
+
+# print the dimension information about a pdl in some appropriate form
+sub dimstr {
+ my $this = shift;
+
+ my @dims = $this->dims;
+ my @ids = $this->threadids;
+ my ($nids,$i) = ($#ids - 1,0);
+ my $dstr = 'D ['. join(',', at dims[0..($ids[0]-1)]) .']';
+ if ($nids > 0) {
+ for $i (1..$nids) {
+ $dstr .= " T$i [". join(',', at dims[$ids[$i]..$ids[$i+1]-1]) .']';
+ }
+ }
+ return $dstr;
+}
+
+=head2 sever
+
+=for ref
+
+sever any links of this piddle to parent piddles
+
+In PDL it is possible for a piddle to be just another
+view into another piddle's data. In that case we call
+this piddle a I<virtual piddle> and the original piddle owning
+the data its parent. In other languages these alternate views
+sometimes run by names such as I<alias> or I<smart reference>.
+
+Typical functions that return such piddles are C<slice>, C<xchg>,
+C<index>, etc. Sometimes, however, you would like to separate the
+I<virtual piddle> from its parent's data and just give it a life of
+its own (so that manipulation of its data doesn't change the parent).
+This is simply achieved by using C<sever>. For example,
+
+=for example
+
+ $a = $pdl->index(pdl(0,3,7))->sever;
+ $a++; # important: $pdl is not modified!
+
+In many (but not all) circumstances it acts therefore similar to
+L<copy|PDL::Core/copy>.
+However, in general performance is better with C<sever> and secondly,
+C<sever> doesn't lead to futile copying when used on piddles that
+already have their own data. On the other hand, if you really want to make
+sure to work on a copy of a piddle use L<copy|PDL::Core/copy>.
+
+ $a = zeroes(20);
+ $a->sever; # NOOP since $a is already its own boss!
+
+Again note: C<sever> I<is not> the same as L<copy|PDL::Core/copy>!
+For example,
+
+ $a = zeroes(1); # $a does not have a parent, i.e. it is not a slice etc
+ $b = $a->sever; # $b is now pointing to the same piddle as $a
+ $b++;
+ print $a;
+ [1]
+
+but
+
+ $a = zeroes(1);
+ $b = $a->copy; # $b is now pointing to a new piddle
+ $b++;
+ print $a;
+ [0]
+
+
+=head2 PDL::info
+
+=for ref
+
+Return formatted information about a piddle.
+
+=for usage
+
+ $x->info($format_string);
+
+=for example
+
+ print $x->info("Type: %T Dim: %-15D State: %S");
+
+Returns a string with info about a piddle. Takes an optional
+argument to specify the format of information a la sprintf.
+Format specifiers are in the form C<%E<lt>widthE<gt>E<lt>letterE<gt>>
+where the width is optional and the letter is one of
+
+=over 7
+
+=item T
+
+Type
+
+=item D
+
+Formatted Dimensions
+
+=item F
+
+Dataflow status
+
+=item S
+
+=cut
+
+!NO!SUBS!
+
+# Document for CPAN folks
+=pod
+
+Some internal flags (P=physical,V=Vaffine,C=changed,B=may contain bad data)
+
+=cut
+
+print OUT "=pod\n\n";
+
+if ( $bvalflag ) {
+ print OUT "Some internal flags (P=physical,V=Vaffine,C=changed,B=may\ncontain bad data)";
+} else {
+ print OUT "Some internal flags (P=physical,V=Vaffine,C=changed)";
+}
+
+print OUT "\n\n=cut\n\n";
+
+print OUT '# line ' . (__LINE__ + 2) . <<'!NO!SUBS!';
+ "Basic/Core/Core.pm.PL (i.e. PDL::Core.pm)"
+
+=item C
+
+Class of this piddle, i.e. C<ref $pdl>
+
+=item A
+
+Address of the piddle struct as a unique identifier
+
+=item M
+
+Calculated memory consumption of this piddle's data area
+
+=back
+
+=cut
+
+sub PDL::info {
+ my ($this,$str) = @_;
+ $str = "%C: %T %D" unless defined $str;
+ return ref($this)."->null"
+ if PDL::Core::dimstr($this) =~ /D \[0\]/;
+ my @hash = split /(%[-,0-9]*[.]?[0-9]*\w)/, $str;
+ my @args = ();
+ my $nstr = '';
+ for my $form (@hash) {
+ if ($form =~ s/^%([-,0-9]*[.]?[0-9]*)(\w)$/%$1s/) {
+ barf "unknown format specifier $2" unless defined $info{$2};
+ push @args, &{$info{$2}->{Sub}}($this);
+ }
+ $nstr .= $form;
+ }
+ return sprintf $nstr, @args;
+}
+
+=head2 approx
+
+=for ref
+
+test for approximately equal values (relaxed C<==>)
+
+=for example
+
+ # ok if all corresponding values in
+ # piddles are within 1e-8 of each other
+ print "ok\n" if all approx $a, $b, 1e-8;
+
+C<approx> is a relaxed form of the C<==> operator and
+often more appropriate for floating point types (C<float>
+and C<double>).
+
+Usage:
+
+=for usage
+
+ $res = approx $a, $b [, $eps]
+
+The optional parameter C<$eps> is remembered across invocations
+and initially set to 1e-6, e.g.
+
+ approx $a, $b; # last $eps used (1e-6 initially)
+ approx $a, $b, 1e-10; # 1e-10
+ approx $a, $b; # also 1e-10
+
+=cut
+
+my $approx = 1e-6; # a reasonable init value
+sub PDL::approx {
+ my ($a,$b,$eps) = @_;
+ $eps = $approx unless defined $eps; # the default eps
+ $approx = $eps; # remember last eps
+ # NOTE: ($a-$b)->abs breaks for non-piddle inputs
+ return abs($a-$b) < $eps;
+}
+
+=head2 mslice
+
+=for ref
+
+Convenience interface to L<slice|PDL::Slices/slice>,
+allowing easier inclusion of dimensions in perl code.
+
+=for usage
+
+ $a = $x->mslice(...);
+
+=for example
+
+ # below is the same as $x->slice("5:7,:,3:4:2")
+ $a = $x->mslice([5,7],X,[3,4,2]);
+
+=cut
+
+# called for colon-less args
+# preserves parens if present
+sub intpars { $_[0] =~ /\(.*\)/ ? '('.int($_[0]).')' : int $_[0] }
+
+sub PDL::mslice {
+ my($pdl) = shift;
+ return $pdl->slice(join ',',(map {
+ !ref $_ && $_ eq "X" ? ":" :
+ ref $_ eq "ARRAY" ? $#$_ > 1 && @$_[2] == 0 ?
+ "(".int(@$_[0]).")" : join ':', map {int $_} @$_ :
+ !ref $_ ? intpars $_ :
+ die "INVALID SLICE DEF $_"
+ } @_));
+}
+
+=head2 nslice_if_pdl
+
+=for ref
+
+If C<$self> is a PDL, then calls C<slice> with all but the last
+argument, otherwise $self->($_[-1]) is called where $_[-1} is the
+original argument string found during PDL::NiceSlice filtering.
+
+DEVELOPER'S NOTE: this routine is found in Core.pm.PL but would be
+better placed in Slices/slices.pd. It is likely to be moved there
+and/or changed to "slice_if_pdl" for PDL 3.0.
+
+=for usage
+
+ $a = $x->nslice_if_pdl(...,'(args)');
+
+=cut
+
+sub PDL::nslice_if_pdl {
+ my ($pdl) = shift;
+ my ($orig_args) = pop;
+
+ # warn "PDL::nslice_if_pdl called with (@_) args, originally ($orig_args)\n";
+
+ if (ref($pdl) eq 'CODE') {
+ # barf('PDL::nslice_if_pdl tried to process a sub ref, please use &$subref() syntax')
+ @_ = eval $orig_args;
+ goto &$pdl;
+ }
+
+ unshift @_, $pdl;
+ goto &PDL::slice;
+}
+
+=head2 nslice
+
+=for ref
+
+c<nslice> was an internally used interface for L<PDL::NiceSlice|PDL::NiceSlice>,
+but is now merely a springboard to L<PDL::Slice|PDL::Slice>. It is deprecated
+and likely to disappear in PDL 3.0.
+
+=cut
+sub PDL::nslice {
+ unless($PDL::nslice_warning_issued) {
+ $PDL::nslice_warning_issued = 1;
+ warn "WARNING: deprecated call to PDL::nslice detected. Use PDL::slice instead.\n (Warning will be issued only once per session)\n";
+ }
+ goto &PDL::slice;
+}
+
+sub blessed {
+ my $ref = ref(shift);
+ return $ref =~ /^(REF|SCALAR|ARRAY|HASH|CODE|GLOB||)$/ ? 0 : 1;
+}
+
+# Convert numbers to PDL if not already
+
+sub PDL::topdl {
+ return $_[0]->new(@_[1..$#_]) if($#_ > 1); # PDLify an ARRAY
+ return $_[1] if blessed($_[1]); # Fall through
+ return $_[0]->new($_[1]) if ref(\$_[1]) eq 'SCALAR' or
+ ref($_[1]) eq 'ARRAY';
+ barf("Can not convert a ".ref($_[1])." to a ".$_[0]);
+0;}
+
+# Convert everything to PDL if not blessed
+
+sub alltopdl {
+ return $_[1] if blessed($_[1]); # Fall through
+ return $_[0]->new($_[1]);
+0;}
+
+
+=head2 inplace
+
+=for ref
+
+Flag a piddle so that the next operation is done 'in place'
+
+=for usage
+
+ somefunc($x->inplace); somefunc(inplace $x);
+
+In most cases one likes to use the syntax C<$y = f($x)>, however
+in many case the operation C<f()> can be done correctly
+'in place', i.e. without making a new copy of the data for
+output. To make it easy to use this, we write C<f()> in such
+a way that it operates in-place, and use C<inplace> to hint
+that a new copy should be disabled. This also makes for
+clear syntax.
+
+Obviously this will not work for all functions, and if in
+doubt see the function's documentation. However one
+can assume this is
+true for all elemental functions (i.e. those which just
+operate array element by array element like C<log10>).
+
+=for example
+
+ pdl> $x = xvals zeroes 10;
+ pdl> log10(inplace $x)
+ pdl> p $x
+ [-inf 0 0.30103 0.47712125 0.60205999 0.69897 0.77815125 0.84509804 0.90308999 0.95424251]
+
+=cut
+
+# Flag pdl for in-place operations
+
+sub PDL::inplace {
+ my $pdl = PDL->topdl(shift); $pdl->set_inplace(1); return $pdl;
+}
+
+# Copy if not inplace
+
+
+=head2 is_inplace
+
+=for ref
+
+Test the in-place flag on a piddle
+
+=for usage
+
+ $out = ($in->is_inplace) ? $in : zeroes($in);
+ $in->set_inplace(0)
+
+Provides access to the L<inplace|/inplace> hint flag, within the perl millieu.
+That way functions you write can be inplace aware... If given an
+argument the inplace flag will be set or unset depending on the value
+at the same time. Can be used for shortcut tests that delete the
+inplace flag while testing:
+
+ $out = ($in->is_inplace(0)) ? $in : zeroes($in); # test & unset!
+
+=head2 set_inplace
+
+=for ref
+
+Set the in-place flag on a piddle
+
+=for usage
+
+ $out = ($in->is_inplace) ? $in : zeroes($in);
+ $in->set_inplace(0);
+
+Provides access to the L<inplace|/inplace> hint flag, within the perl millieu.
+Useful mainly for turning it OFF, as L<inplace|/inplace> turns it ON more
+conveniently.
+
+=head2 new_or_inplace
+
+=for usage
+
+ $a = new_or_inplace(shift());
+ $a = new_or_inplace(shift(),$preferred_type);
+
+=for ref
+
+Return back either the argument pdl or a copy of it depending on whether
+it be flagged in-place or no. Handy for building inplace-aware functions.
+
+If you specify a preferred type (must be one of the usual PDL type strings,
+a list ref containing several of them, or a string containing several of them),
+then the copy is coerced into the first preferred type listed if it is not
+already one of the preferred types.
+
+Note that if the inplace flag is set, no coersion happens even if you specify
+a preferred type.
+
+=cut
+
+sub new_or_inplace {
+ my $pdl = shift;
+ my $preferred = shift;
+ my $force = shift;
+ if($pdl->is_inplace) {
+ $pdl->set_inplace(0);
+ return $pdl;
+ } else {
+ unless(defined($preferred)) {
+ return $pdl->copy;
+ } else {
+ $preferred = join(",",@$preferred) if(ref($preferred) eq 'ARRAY');
+ my $s = "".$pdl->type;
+ if($preferred =~ m/(^|\,)$s(\,|$)/i) {
+ # Got a match - the PDL is one of the preferred types.
+ return $pdl->copy();
+ } else {
+ # No match - promote it to the first in the list.
+ $preferred =~ s/\,.*//;
+ my $out = PDL::new_from_specification('PDL',new PDL::Type($preferred),$pdl->dims);
+ $out .= $pdl;
+ return $out;
+ }
+ }
+ }
+ barf "PDL::Core::new_or_inplace - This can never happen!";
+}
+*PDL::new_or_inplace = \&new_or_inplace;
+
+# Allow specifications like zeroes(10,10) or zeroes($x)
+# or zeroes(inplace $x) or zeroes(float,4,3)
+
+=head2 PDL::new_from_specification
+
+=for ref
+
+Internal method: create piddle by specification
+
+This is the argument processing method called by L<zeroes|/zeroes>
+and some other functions
+which constructs piddles from argument lists of the form:
+
+ [type], $nx, $ny, $nz,...
+
+For C<$nx>, C<$ny>, etc. 0 and 1D piddles are allowed.
+Giving those has the same effect as if saying C<$arg-E<gt>list>,
+e.g.
+
+ 1, pdl(5,2), 4
+
+is equivalent to
+
+ 1, 5, 2, 4
+
+Note, however, that in all functions using C<new_from_specification>
+calling C<func $piddle> will probably not do what you want. So to play safe
+use (e.g. with zeroes)
+
+ $pdl = zeroes $dimpdl->list;
+
+Calling
+
+ $pdl = zeroes $dimpdl;
+
+will rather be equivalent to
+
+ $pdl = zeroes $dimpdl->dims;
+
+However,
+
+ $pdl = zeroes ushort, $dimpdl;
+
+will again do what you intended since it is interpreted
+as if you had said
+
+ $pdl = zeroes ushort, $dimpdl->list;
+
+This is unfortunate and confusing but no good solution seems
+obvious that would not break existing scripts.
+
+=cut
+
+sub PDL::new_from_specification{
+ my $class = shift;
+ my $type = ref($_[0]) eq 'PDL::Type' ? ${shift @_}[0] : $PDL_D;
+ my $nelems = 1; my @dims;
+ for (@_) {
+ if (ref $_) {
+ barf "Trying to use non-piddle as dimensions?" unless $_->isa('PDL');
+ barf "Trying to use multi-dim piddle as dimensions?"
+ if $_->getndims > 1;
+ warn "creating > 10 dim piddle (piddle arg)!"
+ if $_->nelem > 10;
+ for my $dim ($_->list) {$nelems *= $dim; push @dims, $dim}
+ } else {
+ if ($_) { # quiet warnings when $_ is the empty string
+ barf "Dimensions must be non-negative" if $_<0;
+ $nelems *= $_; push @dims, $_
+ } else {
+ $nelems *= 0; push @dims, 0;
+ }
+ }
+ }
+ my $pdl = $class->initialize();
+ $pdl->set_datatype($type);
+ $pdl->setdims([@dims]);
+ print "Dims: ",(join ',', at dims)," DLen: ",(length $ {$pdl->get_dataref}),"\n" if $PDL::debug;
+ return $pdl;
+}
+
+=head2 isnull
+
+=for ref
+
+Test whether a piddle is null
+
+=for usage
+
+ croak("Input piddle mustn't be null!")
+ if $input_piddle->isnull;
+
+This function returns 1 if the piddle is null, zero if it is not. The purpose
+of null piddles is to "tell" any PDL::PP methods to allocate new memory for
+an output piddle, but only when that PDL::PP method is called in full-arg
+form. Of course, there's no reason you couldn't commandeer the special value
+for your own purposes, for which this test function would prove most helpful.
+But in general, you shouldn't need to test for a piddle's nullness.
+
+See L</Null PDLs> for more information.
+
+=head2 isempty
+
+=for ref
+
+Test whether a piddle is empty
+
+=for usage
+
+ print "The piddle has zero dimension\n" if $pdl->isempty;
+
+This function returns 1 if the piddle has zero elements. This is
+useful in particular when using the indexing function which. In the
+case of no match to a specified criterion, the returned piddle has
+zero dimension.
+
+ pdl> $a=sequence(10)
+ pdl> $i=which($a < -1)
+ pdl> print "I found no matches!\n" if ($i->isempty);
+ I found no matches!
+
+Note that having zero elements is rather different from the concept
+of being a null piddle, see the L<PDL::FAQ|PDL::FAQ> and
+L<PDL::Indexing|PDL::Indexing>
+manpages for discussions of this.
+
+=cut
+
+sub PDL::isempty {
+ my $pdl=shift;
+ return ($pdl->nelem == 0);
+}
+
+=head2 zeroes
+
+=for ref
+
+construct a zero filled piddle from dimension list or template piddle.
+
+Various forms of usage,
+
+(i) by specification or (ii) by template piddle:
+
+=for usage
+
+ # usage type (i):
+ $a = zeroes([type], $nx, $ny, $nz,...);
+ $a = PDL->zeroes([type], $nx, $ny, $nz,...);
+ $a = $pdl->zeroes([type], $nx, $ny, $nz,...);
+ # usage type (ii):
+ $a = zeroes $b;
+ $a = $b->zeroes
+ zeroes inplace $a; # Equivalent to $a .= 0;
+ $a->inplace->zeroes; # ""
+
+=for example
+
+ pdl> $z = zeroes 4,3
+ pdl> p $z
+ [
+ [0 0 0 0]
+ [0 0 0 0]
+ [0 0 0 0]
+ ]
+ pdl> $z = zeroes ushort, 3,2 # Create ushort array
+ [ushort() etc. with no arg returns a PDL::Types token]
+
+See also L<new_from_specification|/PDL::new_from_specification>
+for details on using piddles in the dimensions list.
+
+=cut
+
+sub zeroes { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? PDL::zeroes($_[0]) : PDL->zeroes(@_) }
+sub PDL::zeroes {
+ my $class = shift;
+ my $pdl = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
+ $pdl.=0;
+ return $pdl;
+}
+
+# Create convenience aliases for zeroes
+
+=head2 zeros
+
+=for ref
+
+construct a zero filled piddle (see zeroes for usage)
+
+=cut
+
+*zeros = \&zeroes;
+*PDL::zeros = \&PDL::zeroes;
+
+=head2 ones
+
+=for ref
+
+construct a one filled piddle
+
+=for usage
+
+ $a = ones([type], $nx, $ny, $nz,...);
+ etc. (see 'zeroes')
+
+=for example
+
+ see zeroes() and add one
+
+See also L<new_from_specification|/PDL::new_from_specification>
+for details on using piddles in the dimensions list.
+
+=cut
+
+sub ones { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? PDL::ones($_[0]) : PDL->ones(@_) }
+sub PDL::ones {
+ my $class = shift;
+ my $pdl = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
+ $pdl.=1;
+ return $pdl;
+}
+
+=head2 reshape
+
+=for ref
+
+Change the shape (i.e. dimensions) of a piddle, preserving contents.
+
+=for usage
+
+ $x->reshape(NEWDIMS); reshape($x, NEWDIMS);
+
+The data elements are preserved, obviously they will wrap
+differently and get truncated if the new array is shorter.
+If the new array is longer it will be zero-padded.
+
+***Potential incompatibility with earlier versions of PDL****
+If the list of C<NEWDIMS> is empty C<reshape> will just drop
+all dimensions of size 1 (preserving the number of elements):
+
+ $a = sequence(3,4,5);
+ $b = $a(1,3);
+ $b->reshape();
+ print $b->info;
+ PDL: Double D [5]
+
+Dimensions of size 1 will also be dropped if C<reshape> is
+invoked with the argument -1:
+
+ $b = $a->reshape(-1);
+
+As opposed to C<reshape> without arguments, C<reshape(-1)>
+preserves dataflow:
+
+ $a = ones(2,1,2);
+ $b = $a(0)->reshape(-1);
+ $b++;
+ print $a;
+ [
+ [
+ [2 1]
+ ]
+ [
+ [2 1]
+ ]
+ ]
+
+Note: an explicit copy of slices is generally forced - this is the
+only way (for now) of stopping a crash if C<$x> is a slice.
+Important: Physical piddles are changed inplace!
+
+=for example
+
+ pdl> $x = sequence(10)
+ pdl> reshape $x,3,4; p $x
+ [
+ [0 1 2]
+ [3 4 5]
+ [6 7 8]
+ [9 0 0]
+ ]
+ pdl> reshape $x,5; p $x
+ [0 1 2 3 4]
+
+=cut
+
+*reshape = \&PDL::reshape;
+sub PDL::reshape{
+ if (@_ == 2 && $_[1] == -1) { # a slicing reshape that drops 1-dims
+ return $_[0]->slice(join(',',map {$_ == 1 ? '(0)' : ''} $_[0]->dims));
+ }
+ my $pdl = pdl($_[0]);
+ my $nelem = $pdl->nelem;
+ my @dims = @_[1..$#_];
+ for my $dim(@dims) { barf "reshape: invalid dim size '$dim'" if $dim < 0 }
+ @dims = grep($_ != 1, $pdl->dims) if @dims == 0; # get rid of dims of size 1
+ $pdl->setdims([@dims]);
+ $pdl->upd_data;
+ if ($pdl->nelem > $nelem) {
+ my $tmp=$pdl->clump(-1)->slice("$nelem:-1");
+ $tmp .= 0;
+ }
+ $_[0] = $pdl;
+ return $pdl;
+}
+
+=head2 squeeze
+
+=for ref
+
+eliminate all singleton dimensions (dims of size 1)
+
+=for example
+
+ $b = $a(0,0)->squeeze;
+
+Alias for C<reshape(-1)>. Removes all singleton dimensions
+and preserves dataflow. A more concise interface is
+provided by L<PDL::NiceSlice|PDL::NiceSlice> via modifiers:
+
+ use PDL::NiceSlice;
+ $b = $a(0,0;-); # same as $a(0,0)->squeeze
+
+=cut
+
+*squeeze = \&PDL::squeeze;
+sub PDL::squeeze { return $_[0]->reshape(-1) }
+
+=head2 flat
+
+=for ref
+
+flatten a piddle (alias for C<< $pdl->clump(-1) >>)
+
+=for example
+
+ $srt = $pdl->flat->qsort;
+
+Useful method to make a 1D piddle from an
+arbitrarily sized input piddle. Data flows
+back and forth as usual with slicing routines.
+Falls through if argument already E<lt>= 1D.
+
+=cut
+
+*flat = \&PDL::flat;
+sub PDL::flat { # fall through if < 2D
+ return my $dummy = $_[0]->getndims != 1 ? $_[0]->clump(-1) : $_[0];
+}
+
+=head2 convert
+
+=for ref
+
+Generic datatype conversion function
+
+=for usage
+
+ $y = convert($x, $newtypenum);
+
+=for example
+
+ $y = convert $x, long
+ $y = convert $x, ushort
+
+C<$newtype> is a type B<number>, for convenience they are
+returned by C<long()> etc when called without arguments.
+
+=cut
+
+# type to type conversion functions (with automatic conversion to pdl vars)
+
+sub PDL::convert {
+ # we don't allow inplace conversion at the moment
+ # (not sure what needs to be changed)
+ barf 'Usage: $y = convert($x, $newtypenum)'."\n" if $#_!=1;
+ my ($pdl,$type)= @_;
+ $pdl = pdl($pdl) unless ref $pdl; # Allow normal numbers
+ $type = $type->enum if ref($type) eq 'PDL::Type';
+ barf 'Usage: $y = convert($x, $newtypenum)'."\n" unless Scalar::Util::looks_like_number($type);
+ return $pdl if $pdl->get_datatype == $type;
+ # make_physical-call: temporary stopgap to work around core bug
+ my $conv = $pdl->flowconvert($type)->make_physical->sever;
+ return $conv;
+}
+
+=head2 Datatype_conversions
+
+=cut
+
+!NO!SUBS!
+
+# CPAN-only docs
+# XXX Be sure to update these when new types are added!
+=pod
+
+=for ref
+
+byte|short|ushort|long|longlong|float|double (shorthands to convert datatypes)
+
+=cut
+
+print OUT "=for ref\n\n$convertalts (shorthands to convert datatypes)\n\n=cut\n\n";
+
+print OUT '# line ' . (__LINE__ + 2) . <<'!NO!SUBS!';
+ "Basic/Core/Core.pm.PL (i.e. PDL::Core.pm)"
+
+=for usage
+
+ $y = double $x; $y = ushort [1..10];
+ # all of the above listed shorthands behave similarly
+
+When called with a piddle argument, they convert to the specific
+datatype.
+
+When called with a numeric, list, listref, or string argument they
+construct a new piddle. This is a convenience to avoid having to be
+long-winded and say C<$x = long(pdl(42))>
+
+Thus one can say:
+
+ $a = float(1,2,3,4); # 1D
+ $a = float q[1 2 3; 4 5 6]; # 2D
+ $a = float([1,2,3],[4,5,6]); # 2D
+ $a = float([[1,2,3],[4,5,6]]); # 2D
+
+Note the last three give identical results, and the last two are exactly
+equivalent - a list is automatically converted to a list reference for
+syntactic convenience. i.e. you can omit the outer C<[]>
+
+When called with no arguments, these functions return a special type token.
+This allows syntactical sugar like:
+
+ $x = ones byte, 1000,1000;
+
+This example creates a large piddle directly as byte datatype in
+order to save memory.
+
+In order to control how undefs are handled in converting from perl lists to
+PDLs, one can set the variable C<$PDL::undefval>;
+see the function L<pdl()|/pdl> for more details.
+
+=for example
+
+ pdl> p $x=sqrt float [1..10]
+ [1 1.41421 1.73205 2 2.23607 2.44949 2.64575 2.82843 3 3.16228]
+ pdl> p byte $x
+ [1 1 1 2 2 2 2 2 3 3]
+
+=cut
+
+!NO!SUBS!
+
+#!!!!!!!!!!!! CPAN-specific docs; UPDATE if the types are updated !!!!!!!!!!!#
+
+=head2 byte
+
+Convert to byte datatype
+
+=head2 short
+
+Convert to short datatype
+
+=head2 ushort
+
+Convert to ushort datatype
+
+=head2 long
+
+Convert to long datatype
+
+=head2 longlong
+
+Convert to longlong datatype
+
+=head2 float
+
+Convert to float datatype
+
+=head2 double
+
+Convert to double datatype
+
+=cut
+
+#!!!!!!!!!!!! CPAN-specific docs; UPDATE if the types are updated !!!!!!!!!!!#
+
+# generate type conversion docs for each type
+for my $type (typesrtkeys()) {
+ my $conv = typefld($type,'convertfunc');
+
+ # This produces the auto-generated docs on the user's machine of the list
+ # given above. The leading white-space is necessary to prevent CPAN from
+ # thinking it should render the next six lines as documentation on cpan.org
+ # Thus, I must remove it before printing it to the module file.
+ my $doc_string = << "!WITH!SUBS!";
+ =head2 $conv
+
+ =for ref
+
+ Convert to $conv datatype - see 'Datatype_conversions'
+
+!WITH!SUBS!
+
+ # Remove the leading white space
+ $doc_string =~ s/^ //mg;
+ print OUT $doc_string
+
+} # end for loop
+
+print OUT "\n=cut\n\nfor ( $typearray )\n";
+
+print OUT '# line ' . (__LINE__ + 2) . <<'!NO!SUBS!';
+ "Basic/Core/Core.pm.PL (i.e. PDL::Core.pm)"
+
+{
+ eval ('sub PDL::'.$_->[0]." { ".
+ 'return bless ['.$_->[1].'], "PDL::Type" unless @_;
+ convert(alltopdl(\'PDL\', (scalar(@_)>1 ? [@_] : shift)),'.$_->[1].')
+ }');
+}
+
+=head2 type
+
+=for ref
+
+return the type of a piddle as a blessed type object
+
+A convenience function for use with the piddle constructors, e.g.
+
+=for example
+
+ $b = PDL->zeroes($a->type,$a->dims,3);
+ die "must be float" unless $a->type == float;
+
+See also the discussion of the C<PDL::Type> class in L<PDL::Types>.
+Note that the C<PDL::Type> objects have overloaded comparison and
+stringify operators so that you can compare and print types:
+
+ $a = $a->float if $a->type < float;
+ $t = $a->type; print "Type is $t\";
+
+=cut
+
+sub PDL::type { return PDL::Type->new($_[0]->get_datatype); }
+
+##################### Printing ####################
+
+# New string routine
+
+$PDL::_STRINGIZING = 0;
+
+sub PDL::string {
+ my($self,$format)=@_;
+ my $to_return = eval {
+ if($PDL::_STRINGIZING) {
+ return "ALREADY_STRINGIZING_NO_LOOPS";
+ }
+ local $PDL::_STRINGIZING = 1;
+ my $ndims = $self->getndims;
+ if($self->nelem > $PDL::toolongtoprint) {
+ return "TOO LONG TO PRINT";
+ }
+ if ($ndims==0) {
+ if ( $self->badflag() and $self->isbad() ) {
+ return "BAD";
+ } else {
+ my @x = $self->at();
+ return ($format ? sprintf($format, $x[0]) : "$x[0]");
+ }
+ }
+ return "Null" if $self->isnull;
+ return "Empty[".join("x",$self->dims)."]" if $self->isempty; # Empty piddle
+ local $sep = $PDL::use_commas ? "," : " ";
+ local $sep2 = $PDL::use_commas ? "," : "";
+ if ($ndims==1) {
+ return str1D($self,$format);
+ }
+ else{
+ return strND($self,$format,0);
+ }
+ };
+ if ($@) {
+ # Remove reference to this line:
+ $@ =~ s/\s*at .* line \d+\s*\.\n*/./;
+ PDL::Core::barf("Stringizing problem: $@");
+ }
+ return $to_return;
+}
+
+############## Section/subsection functions ###################
+
+=head2 list
+
+=for ref
+
+Convert piddle to perl list
+
+=for usage
+
+ @tmp = list $x;
+
+Obviously this is grossly inefficient for the large datasets PDL is designed to
+handle. This was provided as a get out while PDL matured. It should now be mostly
+superseded by superior constructs, such as PP/threading. However it is still
+occasionally useful and is provied for backwards compatibility.
+
+=for example
+
+ for (list $x) {
+ # Do something on each value...
+ }
+
+=cut
+
+!NO!SUBS!
+
+=pod
+
+If you compile PDL with bad value support (the default), your machine's
+docs will also say this:
+
+=cut
+
+if ( $bvalflag ) {
+ print OUT <<'!NO!SUBS!';
+
+=for bad
+
+list converts any bad values into the string 'BAD'.
+
+=cut
+
+!NO!SUBS!
+}
+
+print OUT '# line ' . (__LINE__ + 2) . <<'!NO!SUBS!';
+ "Basic/Core/Core.pm.PL (i.e. PDL::Core.pm)"
+
+# No threading, just the ordinary dims.
+sub PDL::list{ # pdl -> @list
+ barf 'Usage: list($pdl)' if $#_!=0;
+ my $pdl = PDL->topdl(shift);
+ return () if nelem($pdl)==0;
+ @{listref_c($pdl)};
+}
+
+=head2 unpdl
+
+=for ref
+
+Convert piddle to nested Perl array references
+
+=for usage
+
+ $arrayref = unpdl $x;
+
+This function returns a reference to a Perl list-of-lists structure
+equivalent to the input piddle (within the limitation that while values
+of elements should be preserved, the detailed datatypes will not as
+perl itself basically has "number" data rather than byte, short, int...
+E.g., C<< sum($x - pdl( $x->unpdl )) >> should equal 0.
+
+Obviously this is grossly inefficient in memory and processing for the
+large datasets PDL is designed to handle. Sometimes, however, you really
+want to move your data back to Perl, and with proper dimensionality,
+unlike C<list>.
+
+=for example
+
+ use JSON;
+ my $json = encode_json unpdl $pdl;
+
+=cut
+
+!NO!SUBS!
+
+=pod
+
+If you compile PDL with bad value support (the default), your machine's
+docs will also say this:
+
+=cut
+
+if ( $bvalflag ) {
+ print OUT <<'!NO!SUBS!';
+
+=for bad
+
+unpdl converts any bad values into the string 'BAD'.
+
+=cut
+
+!NO!SUBS!
+}
+
+print OUT '# line ' . (__LINE__ + 2) . <<'!NO!SUBS!';
+ "Basic/Core/Core.pm.PL (i.e. PDL::Core.pm)"
+
+sub PDL::unpdl {
+ barf 'Usage: unpdl($pdl)' if $#_ != 0;
+ my $pdl = PDL->topdl(shift);
+ return [] if $pdl->nelem == 0;
+ return _unpdl_int($pdl);
+}
+
+sub _unpdl_int {
+ my $pdl = shift;
+ if ($pdl->ndims > 1) {
+ return [ map { _unpdl_int($_) } dog $pdl ];
+ } else {
+ return listref_c($pdl);
+ }
+}
+
+=head2 listindices
+
+=for ref
+
+Convert piddle indices to perl list
+
+=for usage
+
+ @tmp = listindices $x;
+
+C<@tmp> now contains the values C<0..nelem($x)>.
+
+Obviously this is grossly inefficient for the large datasets PDL is designed to
+handle. This was provided as a get out while PDL matured. It should now be mostly
+superseded by superior constructs, such as PP/threading. However it is still
+occasionally useful and is provied for backwards compatibility.
+
+=for example
+
+ for $i (listindices $x) {
+ # Do something on each value...
+ }
+
+=cut
+
+sub PDL::listindices{ # Return list of index values for 1D pdl
+ barf 'Usage: list($pdl)' if $#_!=0;
+ my $pdl = shift;
+ return () if nelem($pdl)==0;
+ barf 'Not 1D' if scalar(dims($pdl)) != 1;
+ return (0..nelem($pdl)-1);
+}
+
+=head2 set
+
+=for ref
+
+Set a single value inside a piddle
+
+=for usage
+
+ set $piddle, @position, $value
+
+C<@position> is a coordinate list, of size equal to the
+number of dimensions in the piddle. Occasionally useful,
+mainly provided for backwards compatibility as superseded
+by use of L<slice|PDL::Slices/slice> and assigment operator C<.=>.
+
+=for example
+
+ pdl> $x = sequence 3,4
+ pdl> set $x, 2,1,99
+ pdl> p $x
+ [
+ [ 0 1 2]
+ [ 3 4 99]
+ [ 6 7 8]
+ [ 9 10 11]
+ ]
+
+=cut
+
+sub PDL::set{ # Sets a particular single value
+ barf 'Usage: set($pdl, $x, $y,.., $value)' if $#_<2;
+ my $self = shift; my $value = pop @_;
+ set_c ($self, [@_], $value);
+ return $self;
+}
+
+=head2 at
+
+=for ref
+
+Returns a single value inside a piddle as perl scalar.
+
+=for usage
+
+ $z = at($piddle, @position); $z=$piddle->at(@position);
+
+C<@position> is a coordinate list, of size equal to the
+number of dimensions in the piddle. Occasionally useful
+in a general context, quite useful too inside PDL internals.
+
+=for example
+
+ pdl> $x = sequence 3,4
+ pdl> p $x->at(1,2)
+ 7
+
+=cut
+
+!NO!SUBS!
+
+=pod
+
+If you compile PDL with bad value support (the default), your machine's
+docs will also say this:
+
+=cut
+
+if ( $bvalflag ) {
+ print OUT <<'!NO!SUBS!';
+
+=for bad
+
+at converts any bad values into the string 'BAD'.
+
+=cut
+
+!NO!SUBS!
+}
+
+print OUT '# line ' . (__LINE__ + 2) . <<'!NO!SUBS!';
+ "Basic/Core/Core.pm.PL (i.e. PDL::Core.pm)"
+
+sub PDL::at { # Return value at ($x,$y,$z...)
+ barf 'Usage: at($pdl, $x, $y, ...)' if $#_<0;
+ my $self = shift;
+ at_bad_c ($self, [@_]);
+}
+
+=head2 sclr
+
+=for ref
+
+return a single value from a piddle as a scalar
+
+=for example
+
+ $val = $a(10)->sclr;
+ $val = sclr inner($a,$b);
+
+The C<sclr> method is useful to turn a piddle into a normal Perl
+scalar. Its main advantage over using C<at> for this purpose is the fact
+that you do not need to worry if the piddle is 0D, 1D or higher dimensional.
+Using C<at> you have to supply the correct number of zeroes, e.g.
+
+ $a = sequence(10);
+ $b = $a->slice('4');
+ print $b->sclr; # no problem
+ print $b->at(); # error: needs at least one zero
+
+C<sclr> is generally used when a Perl scalar is required instead
+of a one-element piddle. If the input is a multielement piddle
+the first value is returned as a Perl scalar. You can optionally
+switch on checks to ensure that the input piddle has only one element:
+
+ PDL->sclr({Check => 'warn'}); # carp if called with multi-el pdls
+ PDL->sclr({Check => 'barf'}); # croak if called with multi-el pdls
+
+are the commands to switch on warnings or raise an error if
+a multielement piddle is passed as input. Note that these options
+can only be set when C<sclr> is called as a class method (see
+example above). Use
+
+ PDL->sclr({Check=>0});
+
+to switch these checks off again (default setting);
+When called as a class method the resulting check mode is returned
+(0: no checking, 1: warn, 2: barf).
+
+=cut
+
+my $chkmode = 0; # default mode no checks
+use PDL::Options;
+sub PDL::sclr {
+ my $this = shift;
+ if (ref $this) { # instance method
+ carp "multielement piddle in 'sclr' call"
+ if ($chkmode == 1 && $this->nelem > 1);
+ croak "multielement piddle in 'sclr' call"
+ if ($chkmode == 2 && $this->nelem > 1);
+ return sclr_c($this);
+ } else { # class method
+ my $check = (iparse({Check=>0},ifhref($_[0])))[1];
+ if (lc($check) eq 'warn') {$chkmode = 1}
+ elsif (lc($check) eq 'barf') {$chkmode = 2}
+ else {$chkmode = $check != 0 ? 1 : 0}
+ return $chkmode;
+ }
+}
+
+=head2 cat
+
+=for ref
+
+concatenate piddles to N+1 dimensional piddle
+
+Takes a list of N piddles of same shape as argument,
+returns a single piddle of dimension N+1
+
+=for example
+
+ pdl> $x = cat ones(3,3),zeroes(3,3),rvals(3,3); p $x
+ [
+ [
+ [1 1 1]
+ [1 1 1]
+ [1 1 1]
+ ]
+ [
+ [0 0 0]
+ [0 0 0]
+ [0 0 0]
+ ]
+ [
+ [1 1 1]
+ [1 0 1]
+ [1 1 1]
+ ]
+ ]
+
+=cut
+
+!NO!SUBS!
+
+=pod
+
+If you compile PDL with bad value support (the default), your machine's
+docs will also say this:
+
+=cut
+
+ if ( $bvalflag ) {
+print OUT <<'!NO!SUBS!';
+
+=for bad
+
+The output piddle is set bad if any input piddles have their bad flag set.
+
+=cut
+
+!NO!SUBS!
+} # if: $bvalflag
+
+print OUT '# line ' . (__LINE__ + 2) . <<'!NO!SUBS!';
+ "Basic/Core/Core.pm.PL (i.e. PDL::Core.pm)"
+
+=pod
+
+Similar functions include L<append|PDL::Primitive/append> and
+L<glue|PDL::Primitive/glue>.
+
+=cut
+
+sub PDL::cat {
+ my $res;
+ my $old_err = $@;
+ $@ = '';
+ eval {
+ $res = $_[0]->initialize;
+ $res->set_datatype($_[0]->get_datatype);
+
+ my @resdims = $_[0]->dims;
+ for my $i(0..$#_){
+ my @d = $_[$i]->dims;
+ for my $j(0..$#d) {
+ $resdims[$j] = $d[$j] if( !defined($resdims[$j]) or $resdims[$j]==1 );
+ die "mismatched dims\n" if($d[$j] != 1 and $resdims[$j] != $d[$j]);
+ }
+ }
+ $res->setdims( [@resdims,scalar(@_) ]);
+ my ($i,$t); my $s = ":,"x at resdims;
+ for (@_) { $t = $res->slice($s."(".$i++.")"); $t .= $_}
+
+ # propogate any bad flags
+ for (@_) { if ( $_->badflag() ) { $res->badflag(1); last; } }
+ };
+ if ($@ eq '') {
+ # Restore the old error and return
+ $@ = $old_err;
+ return $res;
+ }
+
+ # If we've gotten here, then there's been an error, so check things
+ # and barf out a meaningful message.
+
+ if ($@ =~ /PDL::Ops::assgn|mismatched/
+ or $@ =~ /"badflag"/
+ or $@ =~ /"initialize"/) {
+ my (@mismatched_dims, @not_a_piddle);
+ my $i = 0;
+
+ # non-piddles and/or dimension mismatch. The first argument is
+ # ok unless we have the "initialize" error:
+ if ($@ =~ /"initialize"/) {
+ # Handle the special case that there are *no* args passed:
+ barf("Called PDL::cat without any arguments") unless @_;
+
+ while ($i < @_ and not eval{ $_[$i]->isa('PDL')}) {
+ push (@not_a_piddle, $i);
+ $i++;
+ }
+ }
+
+ # Get the dimensions of the first actual piddle in the argument
+ # list:
+ my $first_piddle_argument = $i;
+ my @dims = $_[$i]->dims if ref($_[$i]) =~ /PDL/;
+
+ # Figure out all the ways that the caller screwed up:
+ while ($i < @_) {
+ my $arg = $_[$i];
+ # Check if not a piddle
+ if (not eval{$arg->isa('PDL')}) {
+ push @not_a_piddle, $i;
+ }
+ # Check if different number of dimensions
+ elsif (@dims != $arg->ndims) {
+ push @mismatched_dims, $i;
+ }
+ # Check if size of dimensions agree
+ else {
+ DIMENSION: for (my $j = 0; $j < @dims; $j++) {
+ if ($dims[$j] != $arg->dim($j)) {
+ push @mismatched_dims, $i;
+ last DIMENSION;
+ }
+ }
+ }
+ $i++;
+ }
+
+ # Construct a message detailing the results
+ my $message = "bad arguments passed to function PDL::cat\n";
+ if (@mismatched_dims > 1) {
+ # Many dimension mismatches
+ $message .= "The dimensions of arguments "
+ . join(', ', @mismatched_dims[0 .. $#mismatched_dims-1])
+ . " and $mismatched_dims[-1] do not match the\n"
+ . " dimensions of the first piddle argument (argument $first_piddle_argument).\n";
+ }
+ elsif (@mismatched_dims) {
+ # One dimension mismatch
+ $message .= "The dimensions of argument $mismatched_dims[0] do not match the\n"
+ . " dimensions of the first piddle argument (argument $first_piddle_argument).\n";
+ }
+ if (@not_a_piddle > 1) {
+ # many non-piddles
+ $message .= "Arguments " . join(', ', @not_a_piddle[0 .. $#not_a_piddle-1])
+ . " and $not_a_piddle[-1] are not piddles.\n";
+ }
+ elsif (@not_a_piddle) {
+ # one non-piddle
+ $message .= "Argument $not_a_piddle[0] is not a piddle.\n";
+ }
+
+ # Handle the edge case that something else happened:
+ if (@not_a_piddle == 0 and @mismatched_dims == 0) {
+ barf("cat: unknown error from the internals:\n$@");
+ }
+
+ $message .= "(Argument counting starts from zero.)";
+ croak($message);
+ }
+ else {
+ croak("cat: unknown error from the internals:\n$@");
+ }
+}
+
+=head2 dog
+
+=for ref
+
+Opposite of 'cat' :). Split N dim piddle to list of N-1 dim piddles
+
+Takes a single N-dimensional piddle and splits it into a list of N-1 dimensional
+piddles. The breakup is done along the last dimension.
+Note the dataflown connection is still preserved by default,
+e.g.:
+
+=for example
+
+ pdl> $p = ones 3,3,3
+ pdl> ($a,$b,$c) = dog $p
+ pdl> $b++; p $p
+ [
+ [
+ [1 1 1]
+ [1 1 1]
+ [1 1 1]
+ ]
+ [
+ [2 2 2]
+ [2 2 2]
+ [2 2 2]
+ ]
+ [
+ [1 1 1]
+ [1 1 1]
+ [1 1 1]
+ ]
+ ]
+
+=for options
+
+ Break => 1 Break dataflow connection (new copy)
+
+=cut
+
+!NO!SUBS!
+
+=pod
+
+If you compile PDL with bad value support (the default), your machine's
+docs will also say this:
+
+=cut
+
+ if ( $bvalflag ) {
+print OUT <<'!NO!SUBS!';
+
+=for bad
+
+The output piddles are set bad if the original piddle has its bad flag set.
+
+=cut
+
+!NO!SUBS!
+} # if: $bvalflag
+
+print OUT '# line ' . (__LINE__ + 2) . <<'!NO!SUBS!';
+ "Basic/Core/Core.pm.PL (i.e. PDL::Core.pm)"
+sub PDL::dog {
+ my $opt = pop @_ if ref($_[-1]) eq 'HASH';
+ my $p = shift;
+ my @res; my $s = ":,"x($p->getndims-1);
+ for my $i (0..$p->getdim($p->getndims-1)-1) {
+ $res[$i] = $p->slice($s."(".$i.")");
+ $res[$i] = $res[$i]->copy if $$opt{Break};
+ $i++;
+ }
+ return @res;
+}
+
+###################### Misc internal routines ####################
+
+
+# Recursively pack an N-D array ref in format [[1,1,2],[2,2,3],[2,2,2]] etc
+# package vars $level and @dims must be initialised first.
+
+sub rpack {
+ my ($ptype,$a) = @_; my ($ret,$type);
+
+ $ret = "";
+ if (ref($a) eq "ARRAY") {
+
+ if (defined($dims[$level])) {
+ barf 'Array is not rectangular' unless $dims[$level] == scalar(@$a);
+ }else{
+ $dims[$level] = scalar(@$a);
+ }
+
+ $type = ref($$a[0]);
+ if ($type) {
+ $level++;
+ for(@$a) {
+ barf 'Array is not rectangular' unless $type eq ref($_); # Equal types
+ $ret .= rpack($ptype,$_);
+ }
+ $level--;
+ } else {
+ # These are leaf nodes
+ $ret = pack $ptype, map {defined($_) ? $_ : $PDL::undefval} @$a;
+ }
+ } elsif (ref($a) eq "PDL") {
+ barf 'Cannot make a new piddle from two or more piddles, try "cat"';
+ } else {
+ barf "Don't know how to make a PDL object from passed argument";
+ }
+ return $ret;
+}
+
+sub rcopyitem { # Return a deep copy of an item - recursively
+ my $x = shift;
+ my ($y, $key, $value);
+ if (ref(\$x) eq "SCALAR") {
+ return $x;
+ }elsif (ref($x) eq "SCALAR") {
+ $y = $$x; return \$y;
+ }elsif (ref($x) eq "ARRAY") {
+ $y = [];
+ for (@$x) {
+ push @$y, rcopyitem($_);
+ }
+ return $y;
+ }elsif (ref($x) eq "HASH") {
+ $y={};
+ while (($key,$value) = each %$x) {
+ $$y{$key} = rcopyitem($value);
+ }
+ return $y;
+ }elsif (blessed($x)) {
+ return $x->copy;
+ }else{
+ barf ('Deep copy of object failed - unknown component with type '.ref($x));
+ }
+0;}
+
+# N-D array stringifier
+
+sub strND {
+ my($self,$format,$level)=@_;
+# $self->make_physical();
+ my @dims = $self->dims;
+ # print "STRND, $#dims\n";
+
+ if ($#dims==1) { # Return 2D string
+ return str2D($self,$format,$level);
+ }
+ else { # Return list of (N-1)D strings
+ my $secbas = join '',map {":,"} @dims[0..$#dims-1];
+ my $ret="\n"." "x$level ."["; my $j;
+ for ($j=0; $j<$dims[$#dims]; $j++) {
+ my $sec = $secbas . "($j)";
+# print "SLICE: $sec\n";
+
+ $ret .= strND($self->slice($sec),$format, $level+1);
+ chop $ret; $ret .= $sep2;
+ }
+ chop $ret if $PDL::use_commas;
+ $ret .= "\n" ." "x$level ."]\n";
+ return $ret;
+ }
+}
+
+
+# String 1D array in nice format
+
+sub str1D {
+ my($self,$format)=@_;
+ barf "Not 1D" if $self->getndims()!=1;
+ my $x = listref_c($self);
+ my ($ret,$dformat,$t);
+ $ret = "[";
+ my $dtype = $self->get_datatype();
+ $dformat = $PDL::floatformat if $dtype == $PDL_F;
+ $dformat = $PDL::doubleformat if $dtype == $PDL_D;
+
+ my $badflag = $self->badflag();
+ for $t (@$x) {
+ if ( $badflag and $t eq "BAD" ) {
+ # do nothing
+ } elsif ($format) {
+ $t = sprintf $format,$t;
+ } else{ # Default
+ if ($dformat && length($t)>7) { # Try smaller
+ $t = sprintf $dformat,$t;
+ }
+ }
+ $ret .= $t.$sep;
+ }
+
+ chop $ret; $ret.="]";
+ return $ret;
+}
+
+# String 2D array in nice uniform format
+
+sub str2D{
+ my($self,$format,$level)=@_;
+# print "STR2D:\n"; $self->printdims();
+ my @dims = $self->dims();
+ barf "Not 2D" if scalar(@dims)!=2;
+ my $x = listref_c($self);
+ my ($i, $f, $t, $len, $ret);
+
+ my $dtype = $self->get_datatype();
+ my $badflag = $self->badflag();
+
+ my $findmax = 1;
+ if (!defined $format || $format eq "") {
+ # Format not given? - find max length of default
+ $len=0;
+
+ if ( $badflag ) {
+ for (@$x) {
+ if ( $_ eq "BAD" ) { $i = 3; }
+ else { $i = length($_); }
+ $len = $i>$len ? $i : $len;
+ }
+ } else {
+ for (@$x) {$i = length($_); $len = $i>$len ? $i : $len };
+ }
+
+ $format = "%".$len."s";
+
+ if ($len>7) { # Too long? - perhaps try smaller format
+ if ($dtype == $PDL_F) {
+ $format = $PDL::floatformat;
+ } elsif ($dtype == $PDL_D) {
+ $format = $PDL::doubleformat;
+ } else {
+ # Stick with default
+ $findmax = 0;
+ }
+ }
+ else {
+ # Default ok
+ $findmax = 0;
+ }
+ }
+
+ if($findmax) {
+ # Find max length of strings in final format
+ $len=0;
+
+ if ( $badflag ) {
+ for (@$x) {
+ if ( $_ eq "BAD" ) { $i = 3; }
+ else { $i = length(sprintf $format,$_); }
+ $len = $i>$len ? $i : $len;
+ }
+ } else {
+ for (@$x) {
+ $i = length(sprintf $format,$_); $len = $i>$len ? $i : $len;
+ }
+ }
+ } # if: $findmax
+
+ $ret = "\n" . " "x$level . "[\n";
+ {
+ my $level = $level+1;
+ $ret .= " "x$level ."[";
+ for ($i=0; $i<=$#$x; $i++) {
+
+ if ( $badflag and $$x[$i] eq "BAD" ) {
+ $f = "BAD";
+ } else {
+ $f = sprintf $format,$$x[$i];
+ }
+
+ $t = $len-length($f); $f = " "x$t .$f if $t>0;
+ $ret .= $f;
+ if (($i+1)%$dims[0]) {
+ $ret.=$sep;
+ }
+ else{ # End of output line
+ $ret.="]";
+ if ($i==$#$x) { # very last number
+ $ret.="\n";
+ }
+ else{
+ $ret.= $sep2."\n" . " "x$level ."[";
+ }
+ }
+ }
+ }
+ $ret .= " "x$level."]\n";
+ return $ret;
+}
+
+
+#
+# Sleazy hcpy saves me time typing
+#
+sub PDL::hcpy {
+ $_[0]->hdrcpy($_[1]);
+ $_[0];
+}
+
+########## Docs for functions in Core.xs ##################
+# Pod docs for functions that are imported from Core.xs and are
+# not documented elsewhere. Currently this is not a complete
+# list. There are others.
+
+=head2 gethdr
+
+=for ref
+
+Retrieve header information from a piddle
+
+=for example
+
+ $pdl=rfits('file.fits');
+ $h=$pdl->gethdr;
+ print "Number of pixels in the X-direction=$$h{NAXIS1}\n";
+
+The C<gethdr> function retrieves whatever header information is contained
+within a piddle. The header can be set with L<sethdr|/sethdr> and is always a
+hash reference or undef.
+
+C<gethdr> returns undef if the piddle has not yet had a header
+defined; compare with C<hdr> and C<fhdr>, which are guaranteed to return a
+defined value.
+
+Note that gethdr() works by B<reference>: you can modify the header
+in-place once it has been retrieved:
+
+ $a = rfits($filename);
+ $ah = $a->gethdr();
+ $ah->{FILENAME} = $filename;
+
+It is also important to realise that in most cases the header is not
+automatically copied when you copy the piddle. See L<hdrcpy|/hdrcpy>
+to enable automatic header copying.
+
+Here's another example: a wrapper around rcols that allows your piddle
+to remember the file it was read from and the columns could be easily
+written (here assuming that no regexp is needed, extensions are left
+as an exercise for the reader)
+
+ sub ext_rcols {
+ my ($file, @columns)=@_;
+ my $header={};
+ $$header{File}=$file;
+ $$header{Columns}=\@columns;
+
+ @piddles=rcols $file, @columns;
+ foreach (@piddles) { $_->sethdr($header); }
+ return @piddles;
+ }
+
+=head2 hdr
+
+=for ref
+
+Retrieve or set header information from a piddle
+
+=for example
+
+ $pdl->hdr->{CDELT1} = 1;
+
+The C<hdr> function allows convenient access to the header of a
+piddle. Unlike C<gethdr> it is guaranteed to return a defined value,
+so you can use it in a hash dereference as in the example. If the
+header does not yet exist, it gets autogenerated as an empty hash.
+
+Note that this is usually -- but not always -- What You Want. If you
+want to use a tied L<Astro::FITS::Header|Astro::FITS::Header> hash,
+for example, you should either construct it yourself and use C<sethdr>
+to put it into the piddle, or use L<fhdr|fhdr> instead. (Note that
+you should be able to write out the FITS file successfully regardless
+of whether your PDL has a tied FITS header object or a vanilla hash).
+
+=head2 fhdr
+
+=for ref
+
+Retrieve or set FITS header information from a piddle
+
+=for example
+
+ $pdl->fhdr->{CDELT1} = 1;
+
+The C<fhdr> function allows convenient access to the header of a
+piddle. Unlike C<gethdr> it is guaranteed to return a defined value,
+so you can use it in a hash dereference as in the example. If the
+header does not yet exist, it gets autogenerated as a tied
+L<Astro::FITS::Header|Astro::FITS::Header> hash.
+
+Astro::FITS::Header tied hashes are better at matching the behavior of
+FITS headers than are regular hashes. In particular, the hash keys
+are CAsE INsEnSItiVE, unlike normal hash keys. See
+L<Astro::FITS::Header> for details.
+
+If you do not have Astro::FITS::Header installed, you get back a
+normal hash instead of a tied object.
+
+=head2 sethdr
+
+=for ref
+
+Set header information of a piddle
+
+=for example
+
+ $pdl = zeroes(100,100);
+ $h = {NAXIS=>2, NAXIS1=>100, NAXIS=>100, COMMENT=>"Sample FITS-style header"};
+ # add a FILENAME field to the header
+ $$h{FILENAME} = 'file.fits';
+ $pdl->sethdr( $h );
+
+The C<sethdr> function sets the header information for a piddle.
+You must feed in a hash ref or undef, and the header field of the PDL is
+set to be a new ref to the same hash (or undefined).
+
+The hash ref requirement is a speed bump put in place since the normal
+use of headers is to store fits header information and the like. Of course,
+if you want you can hang whatever ugly old data structure you want off
+of the header, but that makes life more complex.
+
+Remember that the hash is not copied -- the header is made into a ref
+that points to the same underlying data. To get a real copy without
+making any assumptions about the underlying data structure, you
+can use one of the following:
+
+ use PDL::IO::Dumper;
+ $pdl->sethdr( deep_copy($h) );
+
+(which is slow but general), or
+
+ $pdl->sethdr( PDL::_hdr_copy($h) )
+
+(which uses the built-in sleazy deep copier), or (if you know that all
+the elements happen to be scalars):
+
+ { my %a = %$h;
+ $pdl->sethdr(\%a);
+ }
+
+which is considerably faster but just copies the top level.
+
+The C<sethdr> function must be given a hash reference or undef. For
+further information on the header, see L<gethdr|/gethdr>, L<hdr|/hdr>,
+L<fhdr|/fhdr> and L<hdrcpy|/hdrcpy>.
+
+=head2 hdrcpy
+
+=for ref
+
+switch on/off/examine automatic header copying
+
+=for example
+
+ print "hdrs will be copied" if $a->hdrcpy;
+ $a->hdrcpy(1); # switch on automatic header copying
+ $b = $a->sumover; # and $b will inherit $a's hdr
+ $a->hdrcpy(0); # and now make $a non-infectious again
+
+C<hdrcpy> without an argument just returns the current setting of the
+flag. See also "hcpy" which returns its PDL argument (and so is useful
+in method-call pipelines).
+
+Normally, the optional header of a piddle is not copied automatically
+in pdl operations. Switching on the hdrcpy flag using the C<hdrcpy>
+method will enable automatic hdr copying. Note that an actual deep
+copy gets made, which is rather processor-inefficient -- so avoid
+using header copying in tight loops!
+
+Most PDLs have the C<hdrcpy> flag cleared by default; however, some
+routines (notably L<rfits|PDL::IO::FITS/rfits()>) set it by default
+where that makes more sense.
+
+The C<hdrcpy> flag is viral: if you set it for a PDL, then derived
+PDLs will get copies of the header and will also have their C<hdrcpy>
+flags set. For example:
+
+ $a = xvals(50,50);
+ $a->hdrcpy(1);
+ $a->hdr->{FOO} = "bar";
+ $b = $a++;
+ $c = $b++;
+ print $b->hdr->{FOO}, " - ", $c->hdr->{FOO}, "\n";
+ $b->hdr->{FOO} = "baz";
+ print $a->hdr->{FOO}, " - ", $b->hdr->{FOO}, " - ", $c->hdr->{FOO}, "\n";
+
+will print:
+
+ bar - bar
+ bar - baz - bar
+
+Performing an operation in which more than one PDL has its hdrcpy flag
+causes the resulting PDL to take the header of the first PDL:
+
+ ($a,$b) = sequence(5,2)->dog;
+ $a->hdrcpy(1); $b->hdrcpy(1);
+ $a->hdr->{foo} = 'a';
+ $b->hdr->{foo} = 'b';
+ print (($a+$b)->hdr->{foo} , ($b+$a)->hdr->{foo});
+
+will print:
+
+ a b
+
+=head2 hcpy
+
+=for ref
+
+Switch on/off automatic header copying, with PDL pass-through
+
+=for example
+
+ $a = rfits('foo.fits')->hcpy(0);
+ $a = rfits('foo.fits')->hcpy(1);
+
+C<hcpy> sets or clears the hdrcpy flag of a PDL, and returns the PDL
+itself. That makes it convenient for inline use in expressions.
+
+=head2 set_autopthread_targ
+
+=for ref
+
+Set the target number of processor threads (pthreads) for multi-threaded processing.
+
+=for usage
+
+ set_autopthread_targ($num_pthreads);
+
+C<$num_pthreads> is the target number of pthreads the auto-pthread process will try to achieve.
+
+See L<PDL::ParallelCPU> for an overview of the auto-pthread process.
+
+=for example
+
+ # Example turning on auto-pthreading for a target of 2 pthreads and for functions involving
+ # PDLs with greater than 1M elements
+ set_autopthread_targ(2);
+ set_autopthread_size(1);
+
+ # Execute a pdl function, processing will split into two pthreads as long as
+ # one of the pdl-threaded dimensions is divisible by 2.
+ $a = minimum($b);
+
+ # Get the actual number of pthreads that were run.
+ $actual_pthread = get_autopthread_actual();
+
+=cut
+
+*set_autopthread_targ = \&PDL::set_autopthread_targ;
+
+
+=head2 get_autopthread_targ
+
+=for ref
+
+Get the current target number of processor threads (pthreads) for multi-threaded processing.
+
+=for usage
+
+ $num_pthreads = get_autopthread_targ();
+
+C<$num_pthreads> is the target number of pthreads the auto-pthread process will try to achieve.
+
+See L<PDL::ParallelCPU> for an overview of the auto-pthread process.
+
+
+=cut
+
+*get_autopthread_targ = \&PDL::get_autopthread_targ;
+
+=head2 get_autopthread_actual
+
+=for ref
+
+Get the actual number of pthreads executed for the last pdl processing function.
+
+=for usage
+
+ $autopthread_actual = get_autopthread_actual();
+
+C<$autopthread_actual> is the actual number of pthreads executed for the last pdl processing function.
+
+See L<PDL::ParallelCPU> for an overview of the auto-pthread process.
+
+
+=cut
+
+*get_autopthread_actual = \&PDL::get_autopthread_actual;
+
+
+=head2 set_autopthread_size
+
+=for ref
+
+Set the minimum size (in M-elements or 2^20 elements) of the largest PDL involved in a function where auto-pthreading will
+be performed. For small PDLs, it probably isn't worth starting multiple pthreads, so this function
+is used to define a minimum threshold where auto-pthreading won't be attempted.
+
+
+=for usage
+
+ set_autopthread_size($size);
+
+C<$size> is the mimumum size, in M-elements or 2^20 elements (approx 1e6 elements) for the largest PDL involved in a function.
+
+See L<PDL::ParallelCPU> for an overview of the auto-pthread process.
+
+=for example
+
+ # Example turning on auto-pthreading for a target of 2 pthreads and for functions involving
+ # PDLs with greater than 1M elements
+ set_autopthread_targ(2);
+ set_autopthread_size(1);
+
+ # Execute a pdl function, processing will split into two pthreads as long as
+ # one of the pdl-threaded dimensions is divisible by 2.
+ $a = minimum($b);
+
+ # Get the actual number of pthreads that were run.
+ $actual_pthread = get_autopthread_actual();
+
+=cut
+
+*set_autopthread_size = \&PDL::set_autopthread_size;
+
+
+=head2 get_autopthread_size
+
+=for ref
+
+Get the current autopthread_size setting.
+
+=for usage
+
+ $autopthread_size = get_autopthread_size();
+
+C<$autopthread_size> is the mimumum size limit for auto_pthreading to occur, in M-elements or 2^20 elements (approx 1e6 elements) for the largest PDL involved in a function
+
+See L<PDL::ParallelCPU> for an overview of the auto-pthread process.
+
+
+=cut
+
+*get_autopthread_size = \&PDL::get_autopthread_size;
+
+
+=head1 AUTHOR
+
+Copyright (C) Karl Glazebrook (kgb at aaoepp.aao.gov.au),
+Tuomas J. Lukka, (lukka at husc.harvard.edu) and Christian
+Soeller (c.soeller at auckland.ac.nz) 1997.
+Modified, Craig DeForest (deforest at boulder.swri.edu) 2002.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+
+#
+# Easier to implement in perl than in XS...
+# -- CED
+#
+
+sub PDL::fhdr {
+ my $pdl = shift;
+
+ return $pdl->hdr
+ if( (defined $pdl->gethdr) ||
+ !defined $Astro::FITS::Header::VERSION
+ );
+
+ # Avoid bug in 1.15 and earlier Astro::FITS::Header
+ my @hdr = ("SIMPLE = T");
+ my $hdr = new Astro::FITS::Header(Cards=>\@hdr);
+ tie my %hdr, "Astro::FITS::Header", $hdr;
+ $pdl->sethdr(\%hdr);
+ return \%hdr;
+}
+
+use Fcntl;
+
+BEGIN {
+ eval 'use File::Map 0.47 qw(:all)';
+ if ($@) {
+ carp "No File::Map found, using legacy mmap (if available)\n" if $PDL::verbose;
+ sub sys_map;
+ sub PROT_READ();
+ sub PROT_WRITE();
+ sub MAP_SHARED();
+ sub MAP_PRIVATE();
+ }
+}
+
+# Implement File::Map::sys_map bug fix. Also, might be possible
+# to implement without so many external (non-Core perl) modules.
+#
+# sub pdl_do_sys_map {
+# my (undef, $length, $protection, $flags, $fh, $offset) = @_;
+# my $utf8 = File::Map::_check_layers($fh);
+# my $fd = ($flags & MAP_ANONYMOUS) ? (-1) : fileno($fh);
+# $offset ||= 0;
+# File::Map::_mmap_impl($_[0], $length, $protection, $flags, $fd, $offset, $utf8);
+# return;
+# }
+
+sub PDL::set_data_by_file_map {
+ my ($pdl,$name,$len,$shared,$writable,$creat,$mode,$trunc) = @_;
+ my $pdl_dataref = $pdl->get_dataref();
+
+ # Assume we have no data to free for now
+ # pdl_freedata($pdl);
+
+ sysopen(my $fh, $name, ($writable && $shared ? O_RDWR : O_RDONLY) | ($creat ? O_CREAT : 0), $mode)
+ or die "Error opening file '$name'\n";
+
+ binmode $fh;
+
+ if ($trunc) {
+ truncate($fh,0) or die "set_data_by_mmap: truncate('$name',0) failed, $!";
+ truncate($fh,$len) or die "set_data_by_mmap: truncate('$name',$len) failed, $!";
+ }
+
+ if ($len) {
+
+ #eval {
+ # pdl_do_sys_map( # will croak if the mapping fails
+ if ($PDL::debug) {
+ printf STDERR
+ "set_data_by_file_map: calling sys_map(%s,%d,%d,%d,%s,%d)\n",
+ $pdl_dataref,
+ $len,
+ PROT_READ | ($writable ? PROT_WRITE : 0),
+ ($shared ? MAP_SHARED : MAP_PRIVATE),
+ $fh,
+ 0;
+ }
+
+ sys_map( # will croak if the mapping fails
+ ${$pdl_dataref},
+ $len,
+ PROT_READ | ($writable ? PROT_WRITE : 0),
+ ($shared ? MAP_SHARED : MAP_PRIVATE),
+ $fh,
+ 0
+ );
+ #};
+
+ #if ($@) {
+ #die("Error mmapping!, '$@'\n");
+ #}
+
+ $pdl->upd_data;
+
+ if ($PDL::debug) {
+ printf STDERR "set_data_by_file_map: length \${\$pdl_dataref} is %d.\n", length ${$pdl_dataref};
+ }
+ $pdl->set_state_and_add_deletedata_magic( length ${$pdl_dataref} );
+
+ } else {
+
+ # Special case: zero-length file
+ $_[0] = undef;
+ }
+
+ # PDLDEBUG_f(printf("PDL::MMap: mapped to %p\n",$pdl->data));
+ close $fh ;
+}
+
+1;# Exit with OK status
+
+!NO!SUBS!
+
diff --git a/Basic/Core/Core.xs.PL b/Basic/Core/Core.xs.PL
new file mode 100644
index 0000000..da2d010
--- /dev/null
+++ b/Basic/Core/Core.xs.PL
@@ -0,0 +1,1723 @@
+#
+# Create Core.xs
+# - needed since we allow bad pixel handling to be switched off
+#
+
+use strict;
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# check for bad value support
+use vars qw( $bvalflag $usenan $bvalPerPdl );
+require "badsupport.p";
+
+# are we big or little endian?
+require PDL::Core::Dev;
+my $isbigendian = PDL::Core::Dev::isbigendian();
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+my $file;
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($Config{'osname'} eq 'VMS' or
+ $Config{'osname'} eq 'OS2'); # "case-forgiving"
+
+if ( $bvalflag ) {
+ print "Extracting $file (WITH bad value support)\n";
+} else {
+ print "Extracting $file (NO bad value support)\n";
+}
+open OUT,">$file" or die "Can't create $file: $!";
+chmod 0644, $file;
+
+print OUT <<"!WITH!SUBS!";
+
+/*
+ Core.xs
+ - automatically generated by Core.xs.PL
+ - bad value support = $bvalflag
+*/
+!WITH!SUBS!
+
+print OUT <<'!NO!SUBS!';
+
+#ifndef WIN32
+#include <unistd.h>
+#include <sys/mman.h>
+#include <fcntl.h>
+#define USE_MMAP
+#endif
+
+#include "EXTERN.h" /* std perl include */
+#include "perl.h" /* std perl include */
+#include "XSUB.h" /* XSUB include */
+
+#if defined(CONTEXT)
+#undef CONTEXT
+#endif
+
+#define PDL_CORE /* For certain ifdefs */
+#include "pdl.h" /* Data structure declarations */
+#include "pdlcore.h" /* Core declarations */
+
+!NO!SUBS!
+
+ if ( $bvalflag ) {
+ print OUT "#include <float.h>\n" unless $usenan;
+ print OUT "#include <limits.h>\n";
+
+ } # if: $bvalflag
+
+print OUT <<'!NO!SUBS!';
+
+/* Return a integer or numeric scalar as approroate */
+
+#define setflag(reg,flagval,val) (val?(reg |= flagval):(reg &= ~flagval))
+
+#define SET_RETVAL_NV(x) x->datatype<PDL_F ? (RETVAL=newSViv( (IV)result )) : (RETVAL=newSVnv( result ))
+
+Core PDL; /* Struct holding pointers to shared C routines */
+
+#ifdef FOO
+Core *pdl__Core_get_Core() /* INTERNAL TO CORE! DONT CALL FROM OUTSIDE */
+{
+ return PDL;
+}
+#endif
+
+int pdl_debugging=0;
+int pdl_autopthread_targ = 0; /* No auto-pthreading unless set using the set_autopthread_targ */
+int pdl_autopthread_actual = 0;
+int pdl_autopthread_size = 1;
+
+#define CHECKP(p) if ((p) == NULL) croak("Out of memory")
+
+static PDL_Indx* pdl_packint( SV* sv, int *ndims ) {
+
+ SV* bar;
+ AV* array;
+ int i;
+ PDL_Indx *dims;
+
+ if (!(SvROK(sv) && SvTYPE(SvRV(sv))==SVt_PVAV)) /* Test */
+ return NULL;
+ array = (AV *) SvRV(sv); /* dereference */
+ *ndims = (int) av_len(array) + 1; /* Number of dimensions */
+ /* Array space */
+ dims = (PDL_Indx *) pdl_malloc( (*ndims) * sizeof(*dims) );
+ CHECKP(dims);
+
+ for(i=0; i<(*ndims); i++) {
+ bar = *(av_fetch( array, i, 0 )); /* Fetch */
+ dims[i] = (PDL_Indx) SvIV(bar);
+ }
+ return dims;
+}
+
+static SV* pdl_unpackint ( PDL_Indx *dims, int ndims ) {
+
+ AV* array;
+ int i;
+
+ array = newAV();
+
+ for(i=0; i<ndims; i++) /* if ndims == 0, nothing stored -> ok */
+ av_store( array, i, newSViv( (IV)dims[i] ) );
+
+ return (SV*) array;
+}
+
+/*
+ * Free the data if possible; used by mmapper
+ * Moved from pdlhash.c July 10 2006 DJB
+ */
+static void pdl_freedata (pdl *a) {
+ if(a->datasv) {
+ SvREFCNT_dec(a->datasv);
+ a->datasv=0;
+ a->data=0;
+ } else if(a->data) {
+ die("Trying to free data of untouchable (mmapped?) pdl");
+ }
+}
+
+!NO!SUBS!
+
+ if ( $bvalflag ) {
+ print OUT <<'!NO!SUBS!';
+
+#ifdef FOOFOO_PROPOGATE_BADFLAG
+
+/*
+ * this seems to cause an infinite loop in between tests 42 & 43 of
+ * t/bad.t - ie
+ *
+ * $a = sequence( byte, 2, 3 );
+ * $b = $a->slice("(1),:");
+ * my $mask = sequence( byte, 2, 3 );
+ * $mask = $mask->setbadif( ($mask % 3) == 2 );
+ * print "a,b == ", $a->badflag, ",", $b->badflag, "\n";
+ * $a->inplace->copybad( $mask ); <-- think this is the call
+ * print "a,b == ", $a->badflag, ",", $b->badflag, "\n";
+ * print "$a $b\n";
+ * ok( $b->badflag, 1 );
+ *
+ */
+
+/* used by propogate_badflag() */
+
+void propogate_badflag_children( pdl *it, int newval ) {
+ PDL_DECL_CHILDLOOP(it)
+ PDL_START_CHILDLOOP(it)
+ {
+ pdl_trans *trans = PDL_CHILDLOOP_THISCHILD(it);
+ int i;
+
+ for( i = trans->vtable->nparents;
+ i < trans->vtable->npdls;
+ i++ ) {
+
+ pdl *child = trans->pdls[i];
+
+ if ( newval ) child->state |= PDL_BADVAL;
+ else child->state &= ~PDL_BADVAL;
+
+ /* make sure we propogate to grandchildren, etc */
+ propogate_badflag_children( child, newval );
+
+ } /* for: i */
+ }
+ PDL_END_CHILDLOOP(it)
+} /* propogate_badflag_children */
+
+/* used by propogate_badflag() */
+
+void propogate_badflag_parents( pdl *it ) {
+ PDL_DECL_CHILDLOOP(it)
+ PDL_START_CHILDLOOP(it)
+ {
+ pdl_trans *trans = PDL_CHILDLOOP_THISCHILD(it);
+ int i;
+
+ for( i = 0;
+ i < trans->vtable->nparents;
+ i++ ) {
+
+ pdl *parent = trans->pdls[i];
+
+ /* only sets allowed here */
+ parent->state |= PDL_BADVAL;
+
+ /* make sure we propogate to grandparents, etc */
+ propogate_badflag_parents( parent );
+
+ } /* for: i */
+ }
+ PDL_END_CHILDLOOP(it)
+} /* propogate_badflag_parents */
+
+/*
+ * we want to change the bad flag of the children
+ * (newval = 1 means set flag, 0 means clear it).
+ * If newval == 1, then we also loop through the
+ * parents, setting their bad flag
+ *
+ * thanks to Christian Soeller for this
+ */
+
+void propogate_badflag( pdl *it, int newval ) {
+ /* only do anything if the flag has changed - do we need this check ? */
+ if ( newval ) {
+ if ( (it->state & PDL_BADVAL) == 0 ) {
+ propogate_badflag_parents( it );
+ propogate_badflag_children( it, newval );
+ }
+ } else {
+ if ( (it->state & PDL_BADVAL) > 0 ) {
+ propogate_badflag_children( it, newval );
+ }
+
+ }
+
+} /* propogate_badflag */
+
+#else /* FOOFOO_PROPOGATE_BADFLAG */
+
+/* newval = 1 means set flag, 0 means clear it */
+/* thanks to Christian Soeller for this */
+
+void propogate_badflag( pdl *it, int newval ) {
+ PDL_DECL_CHILDLOOP(it)
+ PDL_START_CHILDLOOP(it)
+ {
+ pdl_trans *trans = PDL_CHILDLOOP_THISCHILD(it);
+ int i;
+
+ for( i = trans->vtable->nparents;
+ i < trans->vtable->npdls; i++ ) {
+
+ pdl *child = trans->pdls[i];
+
+ if ( newval ) child->state |= PDL_BADVAL;
+ else child->state &= ~PDL_BADVAL;
+
+ /* make sure we propogate to grandchildren, etc */
+ propogate_badflag( child, newval );
+
+ } /* for: i */
+ }
+ PDL_END_CHILDLOOP(it)
+} /* propogate_badflag */
+
+#endif /* FOOFOO_PROPOGATE_BADFLAG */
+
+void propogate_badvalue( pdl *it ) {
+ PDL_DECL_CHILDLOOP(it)
+ PDL_START_CHILDLOOP(it)
+ {
+ pdl_trans *trans = PDL_CHILDLOOP_THISCHILD(it);
+ int i;
+
+ for( i = trans->vtable->nparents;
+ i < trans->vtable->npdls; i++ ) {
+
+ pdl *child = trans->pdls[i];
+
+ child->has_badvalue = 1;
+ child->badvalue = it->badvalue;
+
+ /* make sure we propogate to grandchildren, etc */
+ propogate_badvalue( child );
+
+ } /* for: i */
+ }
+ PDL_END_CHILDLOOP(it)
+} /* propogate_badvalue */
+
+
+/* this is horrible - the routines from bad should perhaps be here instead ? */
+double pdl_get_badvalue( int datatype ) {
+ double retval;
+ switch ( datatype ) {
+!NO!SUBS!
+
+
+use PDL::Types;
+my $ntypes = $#PDL::Types::names;
+
+my $str;
+foreach my $i ( 0 .. $ntypes ) {
+ my $type = PDL::Type->new( $i );
+ my $typesym = $type->symbol;
+
+ my $cname = $type->ctype;
+ $cname =~ s/^PDL_//;
+ my $storage = "PDL.bvals.$cname";
+
+ print OUT "\tcase $typesym: retval = $storage; break;\n";
+}
+
+print OUT <<'!NO!SUBS!';
+
+ default:
+ croak("Unknown type sent to pdl_get_badvalue\n");
+ }
+ return retval;
+} /* pdl_get_badvalue() */
+
+
+double pdl_get_pdl_badvalue( pdl *it ) {
+ double retval;
+ int datatype;
+
+!NO!SUBS!
+
+ if ($bvalPerPdl) {
+ print OUT '
+ if (it->has_badvalue) {
+ retval = it->badvalue;
+ } else {
+ datatype = it->datatype;
+ retval = pdl_get_badvalue( datatype );
+ }
+';
+ } else {
+ print OUT '
+ datatype = it->datatype;
+ retval = pdl_get_badvalue( datatype );
+';
+ }
+print OUT <<'!NO!SUBS!';
+ return retval;
+} /* pdl_get_pdl_badvalue() */
+
+
+!NO!SUBS!
+
+} # if: $bvalflag
+
+print OUT <<'!NO!SUBS!';
+
+MODULE = PDL::Core PACKAGE = PDL
+
+
+# Destroy a PDL - note if a hash do nothing, the $$x{PDL} component
+# will be destroyed anyway on a separate call
+
+void
+DESTROY(sv)
+ SV * sv;
+ PREINIT:
+ pdl *self;
+ CODE:
+ if ( !( (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV) ) ) {
+ self = SvPDLV(sv);
+ PDLDEBUG_f(printf("DESTROYING %p\n",(void*)self);)
+ if (self != NULL)
+ pdl_destroy(self);
+ }
+
+# Return the transformation object or an undef otherwise.
+
+SV *
+get_trans(self)
+ pdl *self;
+ CODE:
+ ST(0) = sv_newmortal();
+ if(self->trans) {
+ sv_setref_pv(ST(0), "PDL::Trans", (void*)(self->trans));
+ } else {
+ ST(0) = &PL_sv_undef;
+ }
+
+# This will change in the future, as can be seen from the name ;)
+# the argument passing is a real quick hack: you can pass 3 integers
+# and nothing else.
+
+MODULE = PDL::Core PACKAGE = PDL::Trans
+void
+call_trans_foomethod(trans,i1,i2,i3)
+ pdl_trans *trans
+ int i1
+ int i2
+ int i3
+ CODE:
+ PDL_TR_CHKMAGIC(trans);
+ pdl_trans_changesoon(trans,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED);
+ if(trans->vtable->foomethod == NULL) {
+ croak("This transformation doesn't have a foomethod!");
+ }
+ (trans->vtable->foomethod)(trans,i1,i2,i3);
+ pdl_trans_changed(trans,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED);
+
+MODULE = PDL::Core PACKAGE = PDL
+
+int
+iscontig(x)
+ pdl* x
+ CODE:
+ RETVAL = 1;
+ pdl_make_physvaffine( x );
+ if PDL_VAFFOK(x) {
+ int i;
+ PDL_Indx inc=1;
+ printf("vaff check...\n");
+ for (i=0;i<x->ndims;i++) {
+ if (PDL_REPRINC(x,i) != inc) {
+ RETVAL = 0;
+ break;
+ }
+ inc *= x->dims[i];
+ }
+ }
+ OUTPUT:
+ RETVAL
+
+!NO!SUBS!
+
+# access (read, if set is true then write as well; if postset true then
+# read first and write new value after that)
+# to piddle's state
+#
+
+my %flags =
+ (
+ hdrcpy => { set => 1 },
+ fflows => { FLAG => "DATAFLOW_F" },
+ bflows => { FLAG => "DATAFLOW_B" },
+ is_inplace => { FLAG => "INPLACE", postset => 1 },
+ donttouch => { FLAG => "DONTTOUCHDATA" },
+ allocated => { },
+ vaffine => { FLAG => "OPT_VAFFTRANSOK" },
+ anychgd => { FLAG => "ANYCHANGED" },
+ dimschgd => { FLAG => "PARENTDIMSCHANGED" },
+ tracedebug => { FLAG => "TRACEDEBUG", set => 1},
+ );
+
+#if ( $bvalflag ) { $flags{baddata} = { set => 1, FLAG => "BADVAL" }; }
+
+foreach my $name ( keys %flags ) {
+ my $flag = "PDL_" . ($flags{$name}{FLAG} || uc($name));
+ if ( $flags{$name}{set} ) {
+ print OUT <<"!WITH!SUBS!";
+int
+$name(x,mode=0)
+ pdl *x
+ int mode
+ CODE:
+ if (items>1)
+ { setflag(x->state,$flag,mode); }
+ RETVAL = ((x->state & $flag) > 0);
+ OUTPUT:
+ RETVAL
+
+!WITH!SUBS!
+
+} elsif ($flags{$name}{postset}) {
+
+ print OUT <<"!WITH!SUBS!";
+int
+$name(x,mode=0)
+ pdl *x
+ int mode
+ CODE:
+ RETVAL = ((x->state & $flag) > 0);
+ if (items>1)
+ { setflag(x->state,$flag,mode); }
+ OUTPUT:
+ RETVAL
+
+!WITH!SUBS!
+
+} else {
+ print OUT <<"!WITH!SUBS!";
+int
+$name(self)
+ pdl *self
+ CODE:
+ RETVAL = ((self->state & $flag) > 0);
+ OUTPUT:
+ RETVAL
+
+!WITH!SUBS!
+
+}
+
+} # foreach: keys %flags
+
+=begin windows_mmap
+
+I found this at http://mollyrocket.com/forums/viewtopic.php?p=2529&sid=973b8e0a1e639e3008d7ef05f686c6fa
+and thougt we might consider using it to make windows mmapping possible.
+
+-David Mertens
+
+ /*
+ This code was placed in the public domain by the author,
+ Sean Barrett, in November 2007. Do with it as you will.
+ (Seee the page for stb_vorbis or the mollyrocket source
+ page for a longer description of the public domain non-license).
+ */
+
+ #define WIN32_LEAN_AND_MEAN
+ #include <windows.h>
+
+ typedef struct
+ {
+ HANDLE f;
+ HANDLE m;
+ void *p;
+ } SIMPLE_UNMMAP;
+
+ // map 'filename' and return a pointer to it. fill out *length and *un if not-NULL
+ void *simple_mmap(const char *filename, int *length, SIMPLE_UNMMAP *un)
+ {
+ HANDLE f = CreateFile(filename, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
+ HANDLE m;
+ void *p;
+ if (!f) return NULL;
+ m = CreateFileMapping(f, NULL, PAGE_READONLY, 0,0, NULL);
+ if (!m) { CloseHandle(f); return NULL; }
+ p = MapViewOfFile(m, FILE_MAP_READ, 0,0,0);
+ if (!p) { CloseHandle(m); CloseHandle(f); return NULL; }
+ if (n) *n = GetFileSize(f, NULL);
+ if (un) {
+ un->f = f;
+ un->m = m;
+ un->p = p;
+ }
+ return p;
+ }
+
+ void simple_unmmap(SIMPLE_UNMMAP *un)
+ {
+ UnmapViewOfFile(un->p);
+ CloseHandle(un->m);
+ CloseHandle(un->f);
+ }
+
+=end windows_mmap
+
+=cut
+
+print OUT <<'!NO!SUBS!';
+
+void
+set_inplace(self,val)
+ pdl *self;
+ int val;
+ CODE:
+ setflag(self->state,PDL_INPLACE,val);
+
+IV
+address(self)
+ pdl *self;
+ CODE:
+ RETVAL = PTR2IV(self);
+ OUTPUT:
+ RETVAL
+
+pdl *
+pdl_hard_copy(src)
+ pdl *src;
+
+pdl *
+sever(src)
+ pdl *src;
+ CODE:
+ if(src->trans) {
+ pdl_make_physvaffine(src);
+ pdl_destroytransform(src->trans,1);
+ }
+ RETVAL=src;
+ OUTPUT:
+ RETVAL
+
+int
+set_data_by_mmap(it,fname,len,shared,writable,creat,mode,trunc)
+ pdl *it
+ char *fname
+ STRLEN len
+ int writable
+ int shared
+ int creat
+ int mode
+ int trunc
+ CODE:
+#ifdef USE_MMAP
+ int fd;
+ pdl_freedata(it);
+ fd = open(fname,(writable && shared ? O_RDWR : O_RDONLY)|
+ (creat ? O_CREAT : 0),mode);
+ if(fd < 0) {
+ croak("Error opening file");
+ }
+ if(trunc) {
+ int error = ftruncate(fd,0); /* Clear all previous data */
+
+ if(error)
+ {
+ fprintf(stderr,"Failed to set length of '%s' to %d. errno=%d",fname,(int)len,(int)error);
+ croak("set_data_by_mmap: first ftruncate failed");
+ }
+
+ error = ftruncate(fd,len); /* And make it long enough */
+
+ if(error)
+ {
+ fprintf(stderr,"Failed to set length of '%s' to %d. errno=%d",fname,(int)len,(int)error);
+ croak("set_data_by_mmap: second ftruncate failed");
+ }
+ }
+ if(len) {
+ it->data = mmap(0,len,PROT_READ | (writable ?
+ PROT_WRITE : 0),
+ (shared ? MAP_SHARED : MAP_PRIVATE),
+ fd,0);
+ if(!it->data)
+ croak("Error mmapping!");
+ } else {
+ /* Special case: zero-length file */
+ it->data = NULL;
+ }
+ PDLDEBUG_f(printf("PDL::MMap: mapped to %p\n",it->data);)
+ it->state |= PDL_DONTTOUCHDATA | PDL_ALLOCATED;
+ pdl_add_deletedata_magic(it, pdl_delete_mmapped_data, len);
+ close(fd);
+#else
+ croak("mmap not supported on this architecture");
+#endif
+ RETVAL = 1;
+OUTPUT:
+ RETVAL
+
+int
+set_state_and_add_deletedata_magic(it,len)
+ pdl *it
+ STRLEN len
+ CODE:
+ it->state |= PDL_DONTTOUCHDATA | PDL_ALLOCATED;
+ pdl_add_deletedata_magic(it, pdl_delete_mmapped_data, len);
+ RETVAL = 1;
+ OUTPUT:
+ RETVAL
+
+
+
+
+int
+set_data_by_offset(it,orig,offset)
+ pdl *it
+ pdl *orig
+ STRLEN offset
+ CODE:
+ pdl_freedata(it);
+ it->data = ((char *) orig->data) + offset;
+ it->datasv = orig->sv;
+ (void)SvREFCNT_inc(it->datasv);
+ it->state |= PDL_DONTTOUCHDATA | PDL_ALLOCATED;
+ RETVAL = 1;
+ OUTPUT:
+ RETVAL
+
+PDL_Indx
+nelem(x)
+ pdl *x
+ CODE:
+ pdl_make_physdims(x);
+ RETVAL = x->nvals;
+ OUTPUT:
+ RETVAL
+
+# Convert PDL to new datatype (called by float(), int() etc.)
+
+# SV *
+# convert(a,datatype)
+# pdl* a
+# int datatype
+# CODE:
+# pdl* b;
+# pdl_make_physical(a);
+# RETVAL = pdl_copy(a,""); /* Init value to return */
+# b = SvPDLV(RETVAL); /* Map */
+# pdl_converttype( &b, datatype, PDL_PERM );
+# PDLDEBUG_f(printf("converted %d, %d, %d, %d\n",a, b, a->datatype, b->datatype));
+
+# OUTPUT:
+# RETVAL
+
+
+# Call my howbig function
+
+int
+howbig_c(datatype)
+ int datatype
+ CODE:
+ RETVAL = pdl_howbig(datatype);
+ OUTPUT:
+ RETVAL
+
+
+int
+set_autopthread_targ(i)
+ int i;
+ CODE:
+ RETVAL = i;
+ pdl_autopthread_targ = i;
+ OUTPUT:
+ RETVAL
+
+int
+get_autopthread_targ()
+ CODE:
+ RETVAL = pdl_autopthread_targ;
+ OUTPUT:
+ RETVAL
+
+
+int
+set_autopthread_size(i)
+ int i;
+ CODE:
+ RETVAL = i;
+ pdl_autopthread_size = i;
+ OUTPUT:
+ RETVAL
+
+int
+get_autopthread_size()
+ CODE:
+ RETVAL = pdl_autopthread_size;
+ OUTPUT:
+ RETVAL
+
+int
+get_autopthread_actual()
+ CODE:
+ RETVAL = pdl_autopthread_actual;
+ OUTPUT:
+ RETVAL
+
+
+
+
+
+
+MODULE = PDL::Core PACKAGE = PDL::Core
+
+unsigned int
+is_scalar_SvPOK(arg)
+ SV* arg;
+ CODE:
+ RETVAL = SvPOK(arg);
+ OUTPUT:
+ RETVAL
+
+
+int
+set_debugging(i)
+ int i;
+ CODE:
+ RETVAL = pdl_debugging;
+ pdl_debugging = i;
+ OUTPUT:
+ RETVAL
+
+
+
+SV *
+sclr_c(it)
+ pdl* it
+ PREINIT:
+ PDL_Indx nullp = 0;
+ PDL_Indx dummyd = 1;
+ PDL_Indx dummyi = 1;
+ double result;
+ CODE:
+ /* get the first element of a piddle and return as
+ * Perl double scalar (NV)
+ */
+ pdl_make_physvaffine( it );
+ if (it->nvals < 1)
+ croak("piddle must have at least one element");
+ /* offs = PDL_REPROFFS(it); */
+ /* result = pdl_get_offs(PDL_REPRP(it),offs); */
+ result=pdl_at(PDL_REPRP(it), it->datatype, &nullp, &dummyd,
+ &dummyi, PDL_REPROFFS(it),1);
+ SET_RETVAL_NV(it) ;
+
+ OUTPUT:
+ RETVAL
+
+
+SV *
+at_c(x,position)
+ pdl* x
+ SV* position
+ PREINIT:
+ PDL_Indx * pos;
+ int npos;
+ int ipos;
+ double result;
+ CODE:
+ pdl_make_physvaffine( x );
+
+ pos = pdl_packdims( position, &npos);
+
+ if (pos == NULL || npos < x->ndims)
+ croak("Invalid position");
+
+ /* allow additional trailing indices
+ * which must be all zero, i.e. a
+ * [3,1,5] piddle is treated as an [3,1,5,1,1,1,....]
+ * infinite dim piddle
+ */
+ for (ipos=x->ndims; ipos<npos; ipos++)
+ if (pos[ipos] != 0)
+ croak("Invalid position");
+
+ result=pdl_at(PDL_REPRP(x), x->datatype, pos, x->dims,
+ (PDL_VAFFOK(x) ? x->vafftrans->incs : x->dimincs), PDL_REPROFFS(x),
+ x->ndims);
+
+ SET_RETVAL_NV(x) ;
+
+ OUTPUT:
+ RETVAL
+
+SV *
+at_bad_c(x,position)
+ pdl* x
+ SV * position
+ PREINIT:
+ PDL_Indx * pos;
+ int npos;
+ int ipos;
+ int badflag;
+ double result;
+ CODE:
+ pdl_make_physvaffine( x );
+
+ pos = pdl_packdims( position, &npos);
+
+ if (pos == NULL || npos < x->ndims)
+ croak("Invalid position");
+
+ /* allow additional trailing indices
+ * which must be all zero, i.e. a
+ * [3,1,5] piddle is treated as an [3,1,5,1,1,1,....]
+ * infinite dim piddle
+ */
+ for (ipos=x->ndims; ipos<npos; ipos++)
+ if (pos[ipos] != 0)
+ croak("Invalid position");
+
+ result=pdl_at(PDL_REPRP(x), x->datatype, pos, x->dims,
+ (PDL_VAFFOK(x) ? x->vafftrans->incs : x->dimincs), PDL_REPROFFS(x),
+ x->ndims);
+!NO!SUBS!
+
+if ( $bvalflag ) {
+ print OUT
+'
+ badflag = (x->state & PDL_BADVAL) > 0;
+
+';
+
+ # do we have to bother about NaN's?
+ if ( $usenan ) {
+ print OUT
+'
+ if ( badflag &&
+ ( ( x->datatype < 4 && ( result == pdl_get_badvalue( x->datatype ) ) ) ||
+ ( x->datatype >= 4 && ( finite(result) == 0 ) )
+ )
+ ) {
+ RETVAL = newSVpvn( "BAD", 3 );
+ } else
+';
+ } else {
+ print OUT
+'
+ if ( badflag &&
+ ( pdl_get_badvalue( x->datatype ) == result )
+ ) {
+ RETVAL = newSVpvn( "BAD", 3 );
+ } else
+';
+
+ } # if: $usenan
+} # if: $bvalflag
+
+print OUT <<'!NO!SUBS!';
+ SET_RETVAL_NV(x) ;
+
+ OUTPUT:
+ RETVAL
+
+
+void
+list_c(x)
+ pdl *x
+ PREINIT:
+ PDL_Indx *inds;
+ PDL_Indx *incs;
+ PDL_Indx offs;
+ void *data;
+ int ind;
+ int stop = 0;
+ PPCODE:
+ pdl_make_physvaffine( x );
+ inds = pdl_malloc(sizeof(PDL_Indx) * x->ndims); /* GCC -> on stack :( */
+
+ data = PDL_REPRP(x);
+ incs = (PDL_VAFFOK(x) ? x->vafftrans->incs : x->dimincs);
+ offs = PDL_REPROFFS(x);
+ EXTEND(sp,x->nvals);
+ for(ind=0; ind < x->ndims; ind++) inds[ind] = 0;
+ while(!stop) {
+ PUSHs(sv_2mortal(newSVnv(pdl_at( data, x->datatype,
+ inds, x->dims, incs, offs, x->ndims))));
+ stop = 1;
+ for(ind = 0; ind < x->ndims; ind++)
+ if(++(inds[ind]) >= x->dims[ind])
+ inds[ind] = 0;
+ else
+ {stop = 0; break;}
+ }
+
+# returns the string 'BAD' if an element is bad
+#
+
+SV *
+listref_c(x)
+ pdl *x
+ PREINIT:
+ PDL_Indx * inds;
+ PDL_Indx * incs;
+ PDL_Indx offs;
+ void *data;
+ int ind;
+ int lind;
+ int stop = 0;
+ AV *av;
+ CODE:
+
+!NO!SUBS!
+
+if ( $bvalflag ) {
+ # note:
+ # the badvalue is stored in a double, but that's what pdl_at()
+ # returns
+
+ print OUT
+'
+ SV *sv;
+ double pdl_val, pdl_badval;
+ int badflag = (x->state & PDL_BADVAL) > 0;
+
+';
+
+ # do we have to bother about NaN's?
+ if ( $usenan ) {
+ print OUT
+'
+ if ( badflag && x->datatype < 4 ) {
+ pdl_badval = pdl_get_pdl_badvalue( x );
+ }
+';
+ } else {
+ print OUT
+'
+ if ( badflag ) {
+ pdl_badval = pdl_get_pdl_badvalue( x );
+ }
+';
+
+ } # if: $usenan
+} # if: $bvalflag
+
+print OUT <<'!NO!SUBS!';
+
+ pdl_make_physvaffine( x );
+ inds = pdl_malloc(sizeof(PDL_Indx) * x->ndims); /* GCC -> on stack :( */
+ data = PDL_REPRP(x);
+ incs = (PDL_VAFFOK(x) ? x->vafftrans->incs : x->dimincs);
+ offs = PDL_REPROFFS(x);
+ av = newAV();
+ av_extend(av,x->nvals);
+ lind=0;
+ for(ind=0; ind < x->ndims; ind++) inds[ind] = 0;
+ while(!stop) {
+
+!NO!SUBS!
+
+ if ( $bvalflag ) {
+
+ my $condition;
+ if ( $usenan ) { # NOTE: dangerous use of hardwired datatype value 4!
+ $condition = '( (x->datatype < 4 && pdl_val == pdl_badval) ||
+ (x->datatype >= 4 && finite(pdl_val) == 0) )';
+ } else {
+ $condition = 'pdl_val == pdl_badval';
+ }
+
+ print OUT <<"!WITH!SUBS!";
+ pdl_val = pdl_at( data, x->datatype, inds, x->dims, incs, offs, x->ndims );
+ if ( badflag && $condition ) {
+ sv = newSVpvn( "BAD", 3 );
+ } else {
+ sv = newSVnv( pdl_val );
+ }
+ av_store( av, lind, sv );
+!WITH!SUBS!
+
+ } else {
+
+ print OUT <<'!NO!SUBS!';
+ av_store(av,lind,
+ newSVnv( pdl_at( data, x->datatype,
+ inds, x->dims, incs, offs, x->ndims ) )
+ );
+!NO!SUBS!
+
+} # bvalflag
+
+print OUT <<'!NO!SUBS!';
+
+ lind++;
+ stop = 1;
+ for(ind = 0; ind < x->ndims; ind++) {
+ if(++(inds[ind]) >= x->dims[ind]) {
+ inds[ind] = 0;
+ } else {
+ stop = 0; break;
+ }
+ }
+ }
+ RETVAL = newRV_noinc((SV *)av);
+ OUTPUT:
+ RETVAL
+
+void
+set_c(x,position,value)
+ pdl* x
+ SV* position
+ double value
+ PREINIT:
+ PDL_Indx * pos;
+ int npos;
+ int ipos;
+ CODE:
+ pdl_make_physvaffine( x );
+
+ pos = pdl_packdims( position, &npos);
+ if (pos == NULL || npos < x->ndims)
+ croak("Invalid position");
+
+ /* allow additional trailing indices
+ * which must be all zero, i.e. a
+ * [3,1,5] piddle is treated as an [3,1,5,1,1,1,....]
+ * infinite dim piddle
+ */
+ for (ipos=x->ndims; ipos<npos; ipos++)
+ if (pos[ipos] != 0)
+ croak("Invalid position");
+
+ pdl_children_changesoon( x , PDL_PARENTDATACHANGED );
+ pdl_set(PDL_REPRP(x), x->datatype, pos, x->dims,
+ (PDL_VAFFOK(x) ? x->vafftrans->incs : x->dimincs), PDL_REPROFFS(x),
+ x->ndims,value);
+ if (PDL_VAFFOK(x))
+ pdl_vaffinechanged(x, PDL_PARENTDATACHANGED);
+ else
+ pdl_changed( x , PDL_PARENTDATACHANGED , 0 );
+
+BOOT:
+
+ /* Initialize structure of pointers to core C routines */
+
+ PDL.Version = PDL_CORE_VERSION;
+ PDL.SvPDLV = SvPDLV;
+ PDL.SetSV_PDL = SetSV_PDL;
+ PDL.create = pdl_create;
+ PDL.pdlnew = pdl_external_new;
+ PDL.tmp = pdl_external_tmp;
+ PDL.destroy = pdl_destroy;
+ PDL.null = pdl_null;
+ PDL.copy = pdl_copy;
+ PDL.hard_copy = pdl_hard_copy;
+ PDL.converttype = pdl_converttype;
+ PDL.twod = pdl_twod;
+ PDL.smalloc = pdl_malloc;
+ PDL.howbig = pdl_howbig;
+ PDL.packdims = pdl_packdims;
+ PDL.unpackdims = pdl_unpackdims;
+ PDL.setdims = pdl_setdims;
+ PDL.grow = pdl_grow;
+ PDL.flushcache = NULL;
+ PDL.reallocdims = pdl_reallocdims;
+ PDL.reallocthreadids = pdl_reallocthreadids;
+ PDL.resize_defaultincs = pdl_resize_defaultincs;
+ PDL.get_threadoffsp = pdl_get_threadoffsp;
+ PDL.thread_copy = pdl_thread_copy;
+ PDL.clearthreadstruct = pdl_clearthreadstruct;
+ PDL.initthreadstruct = pdl_initthreadstruct;
+ PDL.startthreadloop = pdl_startthreadloop;
+ PDL.iterthreadloop = pdl_iterthreadloop;
+ PDL.freethreadloop = pdl_freethreadloop;
+ PDL.thread_create_parameter = pdl_thread_create_parameter;
+ PDL.add_deletedata_magic = pdl_add_deletedata_magic;
+
+ PDL.setdims_careful = pdl_setdims_careful;
+ PDL.put_offs = pdl_put_offs;
+ PDL.get_offs = pdl_get_offs;
+ PDL.get = pdl_get;
+ PDL.set_trans_childtrans = pdl_set_trans_childtrans;
+ PDL.set_trans_parenttrans = pdl_set_trans_parenttrans;
+ PDL.make_now = pdl_make_now;
+
+ PDL.get_convertedpdl = pdl_get_convertedpdl;
+
+ PDL.make_trans_mutual = pdl_make_trans_mutual;
+ PDL.trans_mallocfreeproc = pdl_trans_mallocfreeproc;
+ PDL.make_physical = pdl_make_physical;
+ PDL.make_physdims = pdl_make_physdims;
+ PDL.make_physvaffine = pdl_make_physvaffine;
+ PDL.pdl_barf = pdl_barf;
+ PDL.pdl_warn = pdl_warn;
+ PDL.allocdata = pdl_allocdata;
+ PDL.safe_indterm = pdl_safe_indterm;
+ PDL.children_changesoon = pdl_children_changesoon;
+ PDL.changed = pdl_changed;
+ PDL.vaffinechanged = pdl_vaffinechanged;
+
+ PDL.NaN_float = union_nan_float.f;
+ PDL.NaN_double = union_nan_double.d;
+
+!NO!SUBS!
+
+if ( $bvalflag ) {
+ print OUT <<'!NO!SUBS!';
+
+ PDL.propogate_badflag = propogate_badflag;
+ PDL.propogate_badvalue = propogate_badvalue;
+ PDL.get_pdl_badvalue = pdl_get_pdl_badvalue;
+!NO!SUBS!
+
+ for my $type (PDL::Types::types) {
+ my $typename = $type->ctype;
+ $typename =~ s/^PDL_//;
+ my $bval = $type->defbval;
+ my $ctype = $type->ctype;
+ if ($usenan && $type->usenan) {
+ # note: no defaults if usenan
+ print OUT "\tPDL.bvals.$typename = PDL.NaN_$type;\n"; #Core NaN value
+ } else {
+ print OUT
+ "\tPDL.bvals.$typename = PDL.bvals.default_$typename = $bval;\n";
+ }
+ }
+# PDL.bvals.Byte = PDL.bvals.default_Byte = UCHAR_MAX;
+# PDL.bvals.Short = PDL.bvals.default_Short = SHRT_MIN;
+# PDL.bvals.Ushort = PDL.bvals.default_Ushort = USHRT_MAX;
+# PDL.bvals.Long = PDL.bvals.default_Long = INT_MIN;
+
+} # if: $bvalflag
+
+print OUT <<'!NO!SUBS!';
+ /*
+ "Publish" pointer to this structure in perl variable for use
+ by other modules
+ */
+
+ sv_setiv(get_sv("PDL::SHARE",TRUE|GV_ADDMULTI), PTR2IV(&PDL));
+
+
+# make piddle belonging to 'class' and of type 'type'
+# from avref 'array_ref' which is checked for being
+# rectangular first
+
+SV*
+pdl_avref(array_ref, class, type)
+ SV* array_ref
+ char* class
+ int type
+ PREINIT:
+ AV *dims, *av;
+ int i, depth;
+ int datalevel = -1;
+ SV* psv;
+ pdl* p;
+ CODE:
+ /* make a piddle from a Perl array ref */
+
+
+ if (!SvROK(array_ref))
+ croak("pdl_avref: not a reference");
+
+
+ if (SvTYPE(SvRV(array_ref)) != SVt_PVAV)
+ croak("pdl_avref: not an array reference");
+
+ // Expand the array ref to a list, and allocate a Perl list to hold the dimlist
+ av = (AV *) SvRV(array_ref);
+ dims = (AV *) sv_2mortal( (SV *) newAV());
+
+ av_store(dims,0,newSViv((IV) av_len(av)+1));
+
+ /* even if we contain nothing depth is one */
+ depth = 1 + av_ndcheck(av,dims,0,&datalevel);
+
+ /* printf("will make type %s\n",class); */
+ /*
+ at this stage start making a piddle and populate it with
+ values from the array (which has already been checked in av_check)
+ */
+ if (strcmp(class,"PDL") == 0) {
+ p = pdl_from_array(av,dims,type,NULL); /* populate with data */
+ ST(0) = sv_newmortal();
+ SetSV_PDL(ST(0),p);
+ } else {
+ /* call class->initialize method */
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(class, 0)));
+ PUTBACK;
+ perl_call_method("initialize", G_SCALAR);
+ SPAGAIN;
+ psv = POPs;
+ PUTBACK;
+ p = SvPDLV(psv); /* and get piddle from returned object */
+ ST(0) = psv;
+ pdl_from_array(av,dims,type,p); /* populate ;) */
+ }
+
+MODULE = PDL::Core PACKAGE = PDL
+
+# pdl_null is created/imported with no PREFIX as pdl_null.
+# 'null' is supplied in Core.pm that calls 'initialize' which calls
+# the pdl_null here
+
+pdl *
+pdl_null(...)
+
+
+MODULE = PDL::Core PACKAGE = PDL::Core PREFIX = pdl_
+
+int
+pdl_pthreads_enabled()
+
+MODULE = PDL::Core PACKAGE = PDL PREFIX = pdl_
+
+int
+isnull(self)
+ pdl *self;
+ CODE:
+ RETVAL= !!(self->state & PDL_NOMYDIMS);
+ OUTPUT:
+ RETVAL
+
+pdl *
+make_physical(self)
+ pdl *self;
+ CODE:
+ pdl_make_physical(self);
+ RETVAL = self;
+ OUTPUT:
+ RETVAL
+
+pdl *
+make_physvaffine(self)
+ pdl *self;
+ CODE:
+ pdl_make_physvaffine(self);
+ RETVAL = self;
+ OUTPUT:
+ RETVAL
+
+
+pdl *
+make_physdims(self)
+ pdl *self;
+ CODE:
+ pdl_make_physdims(self);
+ RETVAL = self;
+ OUTPUT:
+ RETVAL
+
+void
+pdl_dump(x)
+ pdl *x;
+
+void
+pdl_add_threading_magic(it,nthdim,nthreads)
+ pdl *it
+ int nthdim
+ int nthreads
+
+void
+pdl_remove_threading_magic(it)
+ pdl *it
+ CODE:
+ pdl_add_threading_magic(it,-1,-1);
+
+MODULE = PDL::Core PACKAGE = PDL
+
+SV *
+initialize(class)
+ SV *class
+ PREINIT:
+ HV *bless_stash;
+ PPCODE:
+ if (SvROK(class)) { /* a reference to a class */
+ bless_stash = SvSTASH(SvRV(class));
+ } else { /* a class name */
+ bless_stash = gv_stashsv(class, 0);
+ }
+ ST(0) = sv_newmortal();
+ SetSV_PDL(ST(0),pdl_null()); /* set a null PDL to this SV * */
+ ST(0) = sv_bless(ST(0), bless_stash); /* bless appropriately */
+ XSRETURN(1);
+
+SV *
+get_dataref(self)
+ pdl *self
+ CODE:
+ if(self->state & PDL_DONTTOUCHDATA) {
+ croak("Trying to get dataref to magical (mmaped?) pdl");
+ }
+ pdl_make_physical(self); /* XXX IS THIS MEMLEAK WITHOUT MORTAL? */
+ RETVAL = (newRV(self->datasv));
+ OUTPUT:
+ RETVAL
+
+int
+get_datatype(self)
+ pdl *self
+ CODE:
+ RETVAL = self->datatype;
+ OUTPUT:
+ RETVAL
+
+int
+upd_data(self)
+ pdl *self
+ PREINIT:
+ STRLEN n_a;
+ CODE:
+ if(self->state & PDL_DONTTOUCHDATA) {
+ croak("Trying to touch dataref of magical (mmaped?) pdl");
+ }
+ self->data = SvPV((SV*)self->datasv,n_a);
+ XSRETURN(0);
+
+void
+set_dataflow_f(self,value)
+ pdl *self;
+ int value;
+ CODE:
+ if(value)
+ self->state |= PDL_DATAFLOW_F;
+ else
+ self->state &= ~PDL_DATAFLOW_F;
+
+void
+set_dataflow_b(self,value)
+ pdl *self;
+ int value;
+ CODE:
+ if(value)
+ self->state |= PDL_DATAFLOW_B;
+ else
+ self->state &= ~PDL_DATAFLOW_B;
+
+int
+getndims(x)
+ pdl *x
+ ALIAS:
+ PDL::ndims = 1
+ CODE:
+ pdl_make_physdims(x);
+ RETVAL = x->ndims;
+ OUTPUT:
+ RETVAL
+
+PDL_Indx
+getdim(x,y)
+ pdl *x
+ int y
+ ALIAS:
+ PDL::dim = 1
+ CODE:
+ pdl_make_physdims(x);
+ if (y < 0) y = x->ndims + y;
+ if (y < 0) croak("negative dim index too large");
+ if (y < x->ndims)
+ RETVAL = x->dims[y];
+ else
+ RETVAL = 1; /* return size 1 for all other dims */
+ OUTPUT:
+ RETVAL
+
+int
+getnthreadids(x)
+ pdl *x
+ CODE:
+ pdl_make_physdims(x);
+ RETVAL = x->nthreadids;
+ OUTPUT:
+ RETVAL
+
+int
+getthreadid(x,y)
+ pdl *x
+ int y
+ CODE:
+ RETVAL = x->threadids[y];
+ OUTPUT:
+ RETVAL
+
+void
+setdims(x,dims_arg)
+ pdl *x
+ SV * dims_arg
+ PREINIT:
+ PDL_Indx * dims;
+ int ndims;
+ int i;
+ CODE:
+ {
+ pdl_children_changesoon(x,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED);
+ dims = pdl_packdims(dims_arg,&ndims);
+ pdl_reallocdims(x,ndims);
+ for(i=0; i<ndims; i++) x->dims[i] = dims[i];
+ pdl_resize_defaultincs(x);
+ x->threadids[0] = ndims;
+ /* make null != dims = [0] */
+#ifndef ELIFJELFIJSEJIF
+ x->state &= ~PDL_NOMYDIMS;
+#else
+ if(ndims == 1 && dims[0] == 0) {
+ x->state |= PDL_NOMYDIMS;
+ } else {
+ x->state &= ~PDL_NOMYDIMS;
+ }
+#endif
+ pdl_changed(x,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED,0);
+ }
+
+void
+dowhenidle()
+ CODE:
+ pdl_run_delayed_magic();
+ XSRETURN(0);
+
+void
+bind(p,c)
+ pdl *p
+ SV *c
+ PROTOTYPE: $&
+ CODE:
+ pdl_add_svmagic(p,c);
+ XSRETURN(0);
+
+void
+sethdr(p,h)
+ pdl *p
+ SV *h
+ PREINIT:
+ HV* hash;
+ CODE:
+ if(p->hdrsv == NULL) {
+ p->hdrsv = &PL_sv_undef; /*(void*) newSViv(0);*/
+ }
+
+ /* Throw an error if we're not either undef or hash */
+ if ( (h != &PL_sv_undef && h != NULL) &&
+ ( !SvROK(h) || SvTYPE(SvRV(h)) != SVt_PVHV )
+ )
+ croak("Not a HASH reference");
+
+ /* Clear the old header */
+ SvREFCNT_dec(p->hdrsv);
+
+ /* Put the new header (or undef) in place */
+ if(h == &PL_sv_undef || h == NULL)
+ p->hdrsv = NULL;
+ else
+ p->hdrsv = (void*) newRV( (SV*) SvRV(h) );
+
+SV *
+hdr(p)
+ pdl *p
+ CODE:
+ pdl_make_physdims(p);
+
+ /* Make sure that in the undef case we return not */
+ /* undef but an empty hash ref. */
+
+ if((p->hdrsv==NULL) || (p->hdrsv == &PL_sv_undef)) {
+ p->hdrsv = (void*) newRV_noinc( (SV*)newHV() );
+ }
+
+ RETVAL = newRV( (SV*) SvRV((SV*)p->hdrsv) );
+
+ OUTPUT:
+ RETVAL
+
+# fhdr(p) is implemented in perl; see Core.pm.PL if you're looking for it
+# --CED 9-Feb-2003
+#
+
+SV *
+gethdr(p)
+ pdl *p
+ CODE:
+ pdl_make_physdims(p);
+
+ if((p->hdrsv==NULL) || (p->hdrsv == &PL_sv_undef)) {
+ RETVAL = &PL_sv_undef;
+ } else {
+ RETVAL = newRV( (SV*) SvRV((SV*)p->hdrsv) );
+ }
+
+ OUTPUT:
+ RETVAL
+
+void
+set_datatype(a,datatype)
+ pdl *a
+ int datatype
+ CODE:
+ pdl_make_physical(a);
+ if(a->trans)
+ pdl_destroytransform(a->trans,1);
+/* if(! (a->state && PDL_NOMYDIMS)) { */
+ pdl_converttype( &a, datatype, PDL_PERM );
+/* } */
+
+void
+threadover_n(...)
+ PREINIT:
+ int npdls;
+ CODE:
+ {
+ npdls = items - 1;
+ if(npdls <= 0)
+ croak("Usage: threadover_n(pdl[,pdl...],sub)");
+ {
+ int i,sd;
+ pdl **pdls = malloc(sizeof(pdl *) * npdls);
+ PDL_Indx *realdims = malloc(sizeof(PDL_Indx) * npdls);
+ pdl_thread pdl_thr;
+ SV *code = ST(items-1);
+ for(i=0; i<npdls; i++) {
+ pdls[i] = SvPDLV(ST(i));
+ /* XXXXXXXX Bad */
+ pdl_make_physical(pdls[i]);
+ realdims[i] = 0;
+ }
+ PDL_THR_CLRMAGIC(&pdl_thr);
+ pdl_initthreadstruct(0,pdls,realdims,realdims,npdls,NULL,&pdl_thr,NULL, 1);
+ pdl_startthreadloop(&pdl_thr,NULL,NULL);
+ sd = pdl_thr.ndims;
+ do {
+ dSP;
+ PUSHMARK(sp);
+ EXTEND(sp,items);
+ PUSHs(sv_2mortal(newSViv((sd-1))));
+ for(i=0; i<npdls; i++) {
+ PUSHs(sv_2mortal(newSVnv(
+ pdl_get_offs(pdls[i],pdl_thr.offs[i]))));
+ }
+ PUTBACK;
+ perl_call_sv(code,G_DISCARD);
+ } while( (sd = pdl_iterthreadloop(&pdl_thr,0)) );
+ pdl_freethreadloop(&pdl_thr);
+ free(pdls);
+ free(realdims);
+ }
+ }
+
+void
+threadover(...)
+ PREINIT:
+ int npdls;
+ int targs;
+ int nothers = -1;
+ CODE:
+ {
+ targs = items - 4;
+ if (items > 0) nothers = SvIV(ST(0));
+ if(targs <= 0 || nothers < 0 || nothers >= targs)
+ croak("Usage: threadover(nothers,pdl[,pdl...][,otherpars..],realdims,creating,sub)");
+ npdls = targs-nothers;
+ {
+ int i,nd1,nd2,dtype=0;
+ PDL_Indx j,nc=npdls;
+ SV* rdimslist = ST(items-3);
+ SV* cdimslist = ST(items-2);
+ SV *code = ST(items-1);
+ pdl_thread pdl_thr;
+ pdl **pdls = malloc(sizeof(pdl *) * npdls);
+ pdl **child = malloc(sizeof(pdl *) * npdls);
+ SV **csv = malloc(sizeof(SV *) * npdls);
+ SV **dims = malloc(sizeof(SV *) * npdls);
+ SV **incs = malloc(sizeof(SV *) * npdls);
+ SV **others = malloc(sizeof(SV *) * nothers);
+ PDL_Indx *creating = pdl_packint(cdimslist,&nd2);
+ PDL_Indx *realdims = pdl_packint(rdimslist,&nd1);
+ CHECKP(pdls); CHECKP(child); CHECKP(dims);
+ CHECKP(incs); CHECKP(csv);
+
+ if (nd1 != npdls || nd2 < npdls)
+ croak("threadover: need one realdim and creating flag "
+ "per pdl!");
+ for(i=0; i<npdls; i++) {
+ pdls[i] = SvPDLV(ST(i+1));
+ if (creating[i])
+ nc += realdims[i];
+ else {
+ pdl_make_physical(pdls[i]); /* is this what we want?XXX */
+ dtype = PDLMAX(dtype,pdls[i]->datatype);
+ }
+ }
+ for (i=npdls+1; i<=targs; i++)
+ others[i-npdls-1] = ST(i);
+ if (nd2 < nc)
+ croak("Not enough dimension info to create pdls");
+#ifdef DEBUG_PTHREAD
+ for (i=0;i<npdls;i++) { /* just for debugging purposes */
+ printf("pdl %d Dims: [",i);
+ for (j=0;j<realdims[i];j++)
+ printf("%d ",pdls[i]->dims[j]);
+ printf("] Incs: [");
+ for (j=0;j<realdims[i];j++)
+ printf("%d ",PDL_REPRINC(pdls[i],j));
+ printf("]\n");
+ }
+#endif
+ PDL_THR_CLRMAGIC(&pdl_thr);
+ pdl_initthreadstruct(0,pdls,realdims,creating,npdls,
+ NULL,&pdl_thr,NULL, 1);
+ for(i=0, nc=npdls; i<npdls; i++) /* create as necessary */
+ if (creating[i]) {
+ PDL_Indx *cp = creating+nc;
+ pdls[i]->datatype = dtype;
+ pdl_thread_create_parameter(&pdl_thr,i,cp,0);
+ nc += realdims[i];
+ pdl_make_physical(pdls[i]);
+ PDLDEBUG_f(pdl_dump(pdls[i]));
+ /* And make it nonnull, now that we've created it */
+ pdls[i]->state &= (~PDL_NOMYDIMS);
+ }
+ pdl_startthreadloop(&pdl_thr,NULL,NULL);
+ for(i=0; i<npdls; i++) { /* will the SV*'s be properly freed? */
+ dims[i] = newRV(pdl_unpackint(pdls[i]->dims,realdims[i]));
+ incs[i] = newRV(pdl_unpackint(PDL_VAFFOK(pdls[i]) ?
+ pdls[i]->vafftrans->incs: pdls[i]->dimincs,realdims[i]));
+ /* need to make sure we get the vaffine (grand)parent */
+ if (PDL_VAFFOK(pdls[i]))
+ pdls[i] = pdls[i]->vafftrans->from;
+ child[i]=pdl_null();
+ /* instead of pdls[i] its vaffine parent !!!XXX */
+ PDL.affine_new(pdls[i],child[i],pdl_thr.offs[i],dims[i],
+ incs[i]);
+ pdl_make_physical(child[i]); /* make sure we can get at
+ the vafftrans */
+ csv[i] = sv_newmortal();
+ SetSV_PDL(csv[i], child[i]); /* pdl* into SV* */
+ }
+ do { /* the actual threadloop */
+ pdl_trans_affine *traff;
+ dSP;
+ PUSHMARK(sp);
+ EXTEND(sp,npdls);
+ for(i=0; i<npdls; i++) {
+ /* just twiddle the offset - quick and dirty */
+ /* we must twiddle both !! */
+ traff = (pdl_trans_affine *) child[i]->trans;
+ traff->offs = pdl_thr.offs[i];
+ child[i]->vafftrans->offs = pdl_thr.offs[i];
+ child[i]->state |= PDL_PARENTDATACHANGED;
+ PUSHs(csv[i]);
+ }
+ for (i=0; i<nothers; i++)
+ PUSHs(others[i]); /* pass the OtherArgs onto the stack */
+ PUTBACK;
+ perl_call_sv(code,G_DISCARD);
+ } while (pdl_iterthreadloop(&pdl_thr,0));
+ pdl_freethreadloop(&pdl_thr);
+ free(pdls); /* should all these be done with pdl_malloc */
+ free(dims); /* in case the sub barfs ? XXXX */
+ free(child);
+ free(csv);
+ free(incs);
+ free(others);
+ }
+ }
+
+!NO!SUBS!
diff --git a/Basic/Core/Dbg.pm b/Basic/Core/Dbg.pm
new file mode 100644
index 0000000..67a65bd
--- /dev/null
+++ b/Basic/Core/Dbg.pm
@@ -0,0 +1,170 @@
+=head1 NAME
+
+PDL::Dbg - functions to support debugging of PDL scripts
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::Dbg;
+
+ $c = $a->slice("5:10,2:30")->px->diagonal(3,4);
+ PDL->px;
+
+=head1 DESCRIPTION
+
+This packages implements a couple of functions that should come in
+handy when debugging your PDL scripts. They make a lot of sense while
+you're doing rapid prototyping of new PDL code, let's say inside the
+perldl or pdl2 shell.
+
+=cut
+
+#' fool emacs
+
+package PDL::Dbg;
+
+# used by info
+$PDL::Dbg::Title = "Type Dimension Flow State Mem";
+$PDL::Dbg::Infostr = "%6T %-15D %3F %-5S %12M";
+
+package PDL;
+
+=head1 FUNCTIONS
+
+=head2 px
+
+=for ref
+
+Print info about a piddle (or all known piddles)
+
+=for example
+
+ pdl> PDL->px
+ pdl> $b += $a->clump(2)->px('clumptest')->sumover
+ pdl> $a->px('%C (%A) Type: %T') # prints nothing unless $PDL::debug
+ pdl> $PDL::debug = 1
+ pdl> $a->px('%C (%A) Type: %T')
+ PDL (52433464) Type: Double
+
+
+This function prints some information about piddles. It can be invoked
+as a class method (e.g. C<PDL-E<gt>px> ) or as an instance method (e.g.
+C<$pdl-E<gt>px($arg)>). If
+
+=over 2
+
+=item invoked as a class method
+
+it prints info about all piddles found in the current package
+(I<excluding> C<my> variables). This comes in quite handy when you are
+not quite sure which pdls you have already defined, what data they
+hold , etc. C<px> is supposed to support inheritance and prints info
+about all symbols for which an C<isa($class)> is true. An optional
+string argument is interpreted as the package name for which to print
+symbols:
+
+ pdl> PDL->px('PDL::Mypack')
+
+The default package is that of the caller.
+
+=item invoked as an instance method
+
+it prints info about that particular piddle if C<$PDL::debug> is
+true and returns the pdl object upon completion. It accepts an
+optional string argument that is simply prepended to the default info
+if it doesn't contain a C<%> character. If, however, the argument
+contains a C<%> then the string is passed to the C<info> method to
+control the format of the printed information. This can be used to
+achieve customized output from C<px>. See the documentation of
+C<PDL::info> for further details.
+
+=back
+
+The output of px will be determined by the default formatting string
+that is passed to the C<info> method (unless you pass a string
+containing C<%> to px when invoking as an instance method, see
+above). This default string is stored in C<$PDL::Dbg::Infostr> and the
+default output format can be accordingly changed by setting this
+variable. If you do this you should also change the default title
+string that the class method branch prints at the top of the listing
+to match your new format string. The default title is stored in the
+variable C<$PDL::Dbg::Title>.
+
+For historical reasons C<vars> is an alias for C<px>.
+
+=cut
+
+sub px {
+ my $arg = shift;
+ my $str="";
+
+ if (ref($arg)) {
+ return $arg unless $PDL::debug;
+ my $info = $arg->info($#_ > -1 ? ($_[0] =~ /%/ ?
+ $_[0] : "$_[0] $PDL::Dbg::Infostr") :
+ $PDL::Dbg::Infostr);
+ print "$info\n";
+ return $arg;
+ }
+
+ # we have been called as a class method
+ my $package = $#_ > -1 ? shift : caller;
+ my $classname = $arg;
+ # find the correct package
+ $package .= "::" unless $package =~ /::$/;
+ *stab = *{"main::"};
+ while ($package =~ /(\w+?::)/g){
+ *stab = $ {stab}{$1};
+ }
+ print "$classname variables in package $package\n\n";
+ my $title = "Name $PDL::Dbg::Title\n";
+ print $title;
+ print '-'x(length($title)+3)."\n";
+ my ($pdl,$npdls,$key,$val,$info) = ((),0,"","","");
+ # while (($key,$val) = each(%stab)) {
+ foreach $key ( sort { lc($a) cmp lc($b) } keys(%stab) ) {
+ $val = $stab{$key};
+ $pdl = ${"$package$key"};
+ # print info for all objects derived from this class
+ if (UNIVERSAL::isa($pdl,$classname)) {
+ $npdls++;
+ $info = $pdl->info($PDL::Dbg::Infostr);
+ printf "\$%-11s %s %s\n",$key,$info,(ref($pdl) eq $classname ? '' :
+ ref($pdl));
+ # also print classname for derived classes
+ }
+ }
+ print "no $classname objects in package $package\n"
+ unless $npdls;
+ return $arg;
+}
+
+=head2 vars
+
+=for ref
+
+Alias for C<px>
+
+=cut
+
+# make vars an alias
+# I hope this works with inheritance
+*vars = \&px;
+
+1; # return success
+
+=head1 BUGS
+
+There are probably some. Please report if you find any. Bug reports
+should be sent to the PDL mailing list perldl at jachw.hawaii.edu.
+
+=head1 AUTHOR
+
+Copyright(C) 1997 Christian Soeller (c.soeller at auckland.ac.nz).
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
diff --git a/Basic/Core/Dev.pm b/Basic/Core/Dev.pm
new file mode 100644
index 0000000..ca1e424
--- /dev/null
+++ b/Basic/Core/Dev.pm
@@ -0,0 +1,701 @@
+=head1 NAME
+
+PDL::Core::Dev - PDL development module
+
+=head1 DESCRIPTION
+
+This module encapsulates most of the stuff useful for
+PDL development and is often used from within Makefile.PL's.
+
+=head1 SYNOPSIS
+
+ use PDL::Core::Dev;
+
+=head1 FUNCTIONS
+
+=cut
+
+# Stuff used in development/install environment of PDL Makefile.PL's
+# - not part of PDL itself.
+
+package PDL::Core::Dev;
+
+use English; require Exporter;
+
+ at ISA = qw( Exporter );
+
+ at EXPORT = qw( isbigendian genpp %PDL_DATATYPES
+ PDL_INCLUDE PDL_TYPEMAP
+ PDL_AUTO_INCLUDE PDL_BOOT
+ PDL_INST_INCLUDE PDL_INST_TYPEMAP
+ pdlpp_postamble_int pdlpp_stdargs_int
+ pdlpp_postamble pdlpp_stdargs write_dummy_make
+ unsupported getcyglib trylink
+ );
+
+# Installation locations
+# beware: whereami_any now appends the /Basic or /PDL directory as appropriate
+
+# The INST are here still just in case we want to change something later.
+
+# print STDERR "executing PDL::Core::Dev from",join(',',caller),"\n";
+
+# Return library locations
+
+
+sub PDL_INCLUDE { '-I'.whereami_any().'/Core' };
+sub PDL_TYPEMAP { whereami_any().'/Core/typemap.pdl' };
+# sub PDL_INST_INCLUDE { '-I'.whereami_any().'/Core' };
+# sub PDL_INST_TYPEMAP { whereami_any().'/Core/typemap.pdl' };
+
+sub PDL_INST_INCLUDE {&PDL_INCLUDE}
+sub PDL_INST_TYPEMAP {&PDL_TYPEMAP}
+
+sub PDL_AUTO_INCLUDE {
+ my ($symname) = @_;
+ $symname ||= 'PDL';
+ return << "EOR";
+#include <pdlcore.h>
+static Core* $symname; /* Structure holds core C functions */
+static SV* CoreSV; /* Gets pointer to perl var holding core structure */
+EOR
+}
+
+sub PDL_BOOT {
+ my ($symname) = @_;
+ $symname ||= 'PDL';
+ return << "EOR";
+
+ perl_require_pv ("PDL::Core"); /* make sure PDL::Core is loaded */
+ CoreSV = perl_get_sv("PDL::SHARE",FALSE); /* SV* value */
+#ifndef aTHX_
+#define aTHX_
+#endif
+ if (CoreSV==NULL)
+ Perl_croak(aTHX_ "We require the PDL::Core module, which was not found");
+ $symname = INT2PTR(Core*,SvIV( CoreSV )); /* Core* value */
+ if ($symname->Version != PDL_CORE_VERSION)
+ Perl_croak(aTHX_ "[$symname->Version: \%d PDL_CORE_VERSION: \%d XS_VERSION: \%s] The code needs to be recompiled against the newly installed PDL", $symname->Version, PDL_CORE_VERSION, XS_VERSION);
+
+EOR
+}
+
+# whereami_any returns appended 'Basic' or 'PDL' dir as appropriate
+use Cwd qw/abs_path/;
+sub whereami_any {
+ my $dir = (&whereami(1) or &whereami_inst(1) or
+ die "Unable to determine ANY directory path to PDL::Core::Dev module\n");
+ return abs_path($dir);
+}
+
+sub whereami {
+ for $dir (@INC,qw|. .. ../.. ../../.. ../../../..|) {
+ return ($_[0] ? $dir . '/Basic' : $dir)
+ if -e "$dir/Basic/Core/Dev.pm";
+ }
+ die "Unable to determine UNINSTALLED directory path to PDL::Core::Dev module\n"
+ if !$_[0];
+ return undef;
+}
+
+sub whereami_inst {
+ for $dir (@INC,map {$_."/blib"} qw|. .. ../.. ../../.. ../../../..|) {
+ return ($_[0] ? $dir . '/PDL' : $dir)
+ if -e "$dir/PDL/Core/Dev.pm";
+ }
+ die "Unable to determine INSTALLED directory path to PDL::Core::Dev module\n"
+ if !$_[0];
+ return undef;
+}
+
+#
+# To access PDL's configuration use %PDL::Config. Makefile.PL has been set up
+# to create this variable so it is available during 'perl Makefile.PL' and
+# it can be eval-ed during 'make'
+
+unless ( %PDL::Config ) {
+
+ # look for the distribution and then the installed version
+ # (a manual version of whereami_any)
+ #
+ my $dir;
+ $dir = whereami(1);
+ if ( defined $dir ) {
+ $dir = abs_path($dir . "/Core");
+ } else {
+ # as no argument given whereami_inst will die if it fails
+ # (and it also returns a slightly different path than whereami(1)
+ # does, since it does not include "/PDL")
+ #
+ $dir = whereami_inst;
+ $dir = abs_path($dir . "/PDL");
+ }
+
+ my $dir2 = $dir;
+ $dir2 =~ s/\}/\\\}/g;
+ eval sprintf('require q{%s/Config.pm};', $dir2);
+
+ die "Unable to find PDL's configuration info\n [$@]"
+ if $@;
+}
+
+# Data types to C types mapping
+# get the map from Types.pm
+{
+# load PDL::Types only if it has not been previously loaded
+ my $loaded_types = grep (m%(PDL|Core)/Types[.]pm$%, keys %INC);
+ $@ = ''; # reset
+ eval('require "'.whereami_any().'/Core/Types.pm"') # lets dist Types.pm win
+ unless $loaded_types; # only when PDL::Types not yet loaded
+ if($@) { # if PDL::Types doesn't work try with full path (during build)
+ my $foo = $@;
+ $@="";
+ eval('require PDL::Types');
+ if($@) {
+ die "can't find PDL::Types: $foo and $@" unless $@ eq "";
+ }
+ }
+}
+PDL::Types->import();
+
+my $inc = defined $PDL::Config{MALLOCDBG}->{include} ?
+ "$PDL::Config{MALLOCDBG}->{include}" : '';
+my $libs = defined $PDL::Config{MALLOCDBG}->{libs} ?
+ "$PDL::Config{MALLOCDBG}->{libs}" : '';
+
+%PDL_DATATYPES = ();
+foreach $key (keys %PDL::Types::typehash) {
+ $PDL_DATATYPES{$PDL::Types::typehash{$key}->{'sym'}} =
+ $PDL::Types::typehash{$key}->{'ctype'};
+}
+
+# non-blocking IO configuration
+
+$O_NONBLOCK = defined $Config{'o_nonblock'} ? $Config{'o_nonblock'}
+ : 'O_NONBLOCK';
+
+=head2 isbigendian
+
+=for ref
+
+Is the machine big or little endian?
+
+=for example
+
+ print "Your machins is big endian.\n" if isbigendian();
+
+returns 1 if the machine is big endian, 0 if little endian,
+or dies if neither. It uses the C<byteorder> element of
+perl's C<%Config> array.
+
+=for usage
+
+ my $retval = isbigendian();
+
+=cut
+
+# ' emacs parsing dummy
+
+# big/little endian?
+sub isbigendian {
+ use Config;
+ my $byteorder = $Config{byteorder} ||
+ die "ERROR: Unable to find 'byteorder' in perl's Config\n";
+ return 1 if $byteorder eq "4321";
+ return 1 if $byteorder eq "87654321";
+ return 0 if $byteorder eq "1234";
+ return 0 if $byteorder eq "12345678";
+ die "ERROR: PDL does not understand your machine's byteorder ($byteorder)\n";
+}
+
+#################### PDL Generic PreProcessor ####################
+#
+# Preprocesses *.g files to *.c files allowing 'generic'
+# type code which is converted to code for each type.
+#
+# e.g. the code:
+#
+# pdl x;
+# GENERICLOOP(x.datatype)
+# generic *xx = x.data;
+# for(i=0; i<nvals; i++)
+# xx[i] = i/nvals;
+# ENDGENERICLOOP
+#
+# is converted into a giant switch statement:
+#
+# pdl x;
+# switch (x.datatype) {
+#
+# case PDL_L:
+# {
+# PDL_Long *xx = x.data;
+# for(i=0; i<nvals; i++)
+# xx[i] = i/nvals;
+# }break;
+#
+# case PDL_F:
+# {
+# PDL_Float *xx = x.data;
+#
+# .... etc. .....
+#
+# 'generic' is globally substituted for each relevant data type.
+#
+# This is used in PDL to write generic functions (taking pdl or void
+# objects) which is still efficient with perl writing the actual C
+# code for each type.
+#
+# 1st version - Karl Glazebrook 4/Aug/1996.
+#
+# Also makes the followings substitutions:
+#
+# (i) O_NONBLOCK - open flag for non-blocking I/O (5/Aug/96)
+#
+
+
+sub genpp {
+
+ $gotstart = 0; @gencode = ();
+
+ while (<>) { # Process files in @ARGV list - result to STDOUT
+
+ # Do the miscellaneous substitutions first
+
+ s/O_NONBLOCK/$O_NONBLOCK/go; # I/O
+
+ if ( /(\s*)?\bGENERICLOOP\s*\(([^\)]*)\)(\s*;)?/ ){ # Start of generic code
+ #print $MATCH, "=$1=\n";
+
+ die "Found GENERICLOOP while searching for ENDGENERICLOOP\n" if $gotstart;
+ $loopvar = $2;
+ $indent = $1;
+ print $PREMATCH;
+
+ @gencode = (); # Start saving code
+ push @gencode, $POSTMATCH;
+ $gotstart = 1;
+ next;
+ }
+
+ if ( /\bENDGENERICLOOP(\s*;)?/ ) {
+
+ die "Found ENDGENERICLOOP while searching for GENERICLOOP\n" unless $gotstart;
+
+ push @gencode, $PREMATCH;
+
+ flushgeneric(); # Output the generic code
+
+ print $POSTMATCH; # End of genric code
+ $gotstart = 0;
+ next;
+ }
+
+ if ($gotstart) {
+ push @gencode, $_;
+ }
+ else {
+ print;
+ }
+
+ } # End while
+}
+
+sub flushgeneric { # Construct the generic code switch
+
+ print $indent,"switch ($loopvar) {\n\n";
+
+ for $case (keys %PDL_DATATYPES) {
+
+ $type = $PDL_DATATYPES{$case};
+
+ print $indent,"case $case:\n"; # Start of this case
+ print $indent," {";
+
+ # Now output actual code with substutions
+
+ for (@gencode) {
+ $line = $_;
+
+ $line =~ s/\bgeneric\b/$type/g;
+
+ print " ",$line;
+ }
+
+ print "}break;\n\n"; # End of this case
+ }
+ print $indent,"default:\n";
+ print $indent,' croak ("Not a known data type code=%d",'.$loopvar.");\n";
+ print $indent,"}";
+
+}
+
+
+# Standard PDL postamble
+
+sub postamble {
+
+ if ($^O =~ /win32/i) {
+ open FI,'>./getdev.pl' or die "couldn't open getdev.pl: $!";
+ my $location = whereami_any();
+ print FI << "EOD";
+
+ require \"$location/Core/Dev.pm\";
+ PDL::Core::Dev->import(); \
+ genpp();
+ 1;
+EOD
+ close FI;
+ return q~
+
+# Rules for the generic preprocessor
+
+.SUFFIXES: .g
+.g.c:
+ $(PERL) -e "require './getdev.pl'" $< > $@
+
+.c$(OBJ_EXT):
+ $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
+
+ ~;
+} else {
+
+q~
+
+# Rules for the generic preprocessor
+
+.SUFFIXES: .g
+.g.c:
+ $(PERL) -e 'require "~.whereami_any().q~/Core/Dev.pm"; \
+ PDL::Core::Dev->import(); \
+ genpp()' $< > $@
+
+.g$(OBJ_EXT):
+ $(PERL) -e 'require "~.whereami_any().q~/Core/Dev.pm"; \
+ PDL::Core::Dev->import(); \
+ genpp()' $< > $*.c
+ $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
+
+~;}
+
+}
+
+# Expects list in format:
+# [gtest.pd, GTest, PDL::GTest], [...]
+# source, prefix,module/package
+# The idea is to support in future several packages in same dir.
+
+# This is the function internal for PDL.
+# Later on, we shall provide another for use outside PDL.
+#
+# added badsupport.p as a requisite
+sub pdlpp_postamble_int {
+ join '',map { my($src,$pref,$mod) = @$_;
+ my $w = whereami_any();
+ $w =~ s%/((PDL)|(Basic))$%%; # remove the trailing subdir
+ my $core = "$w/Basic/Core";
+ my $gen = "$w/Basic/Gen";
+
+## I diked out a "$gen/pm_to_blib" dependency (between $core/badsupport.p and
+# $core/Types.pm below), because it appears to be causing excessive recompiles.
+# I don't think that the .pm files themselves should depend on Gen/pm_to_blib,
+# so this should be OK. But perhaps the requirement had to do with the build chaing
+# itself??? If so, we'll have to put it back in, but then modify the build order
+# so that Gen is built first. CED 28-Oct-2008
+
+qq|
+
+$pref.pm: $src $core/badsupport.p $core/Types.pm
+ \$(PERL) -I$w/blib/lib -I$w/blib/arch \"-MPDL::PP qw/$mod $mod $pref/\" $src
+
+$pref.xs: $pref.pm
+ \$(TOUCH) \$@
+
+$pref.c: $pref.xs
+
+$pref\$(OBJ_EXT): $pref.c
+|
+ } (@_)
+}
+
+
+# This is the function to be used outside the PDL tree.
+sub pdlpp_postamble {
+ join '',map { my($src,$pref,$mod) = @$_;
+ my $w = whereami_any();
+ $w =~ s%/((PDL)|(Basic))$%%; # remove the trailing subdir
+qq|
+
+$pref.pm: $src
+ \$(PERL) -I$w \"-MPDL::PP qw/$mod $mod $pref/\" $src
+
+$pref.xs: $pref.pm
+ \$(TOUCH) \$@
+
+$pref.c: $pref.xs
+
+$pref\$(OBJ_EXT): $pref.c
+|
+ } (@_)
+}
+
+sub pdlpp_stdargs_int {
+ my($rec) = @_;
+ my($src,$pref,$mod) = @$rec;
+ my $w = whereami();
+ my $malloclib = exists $PDL::Config{MALLOCDBG}->{libs} ?
+ $PDL::Config{MALLOCDBG}->{libs} : '';
+ my $mallocinc = exists $PDL::Config{MALLOCDBG}->{include} ?
+ $PDL::Config{MALLOCDBG}->{include} : '';
+my $libsarg = $libs || $malloclib ? "$libs $malloclib " : ''; # for Win32
+ return (
+ %::PDL_OPTIONS,
+ 'NAME' => $mod,
+ 'VERSION_FROM' => "$w/Basic/Core/Version.pm",
+ 'TYPEMAPS' => [&PDL_TYPEMAP()],
+ 'OBJECT' => "$pref\$(OBJ_EXT)",
+ PM => {"$pref.pm" => "\$(INST_LIBDIR)/$pref.pm"},
+ MAN3PODS => {"$pref.pm" => "\$(INST_MAN3DIR)/$mod.\$(MAN3EXT)"},
+ 'INC' => &PDL_INCLUDE()." $inc $mallocinc",
+ 'LIBS' => $libsarg ? [$libsarg] : [],
+ 'clean' => {'FILES' => "$pref.xs $pref.pm $pref\$(OBJ_EXT) $pref.c"},
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+ );
+}
+
+sub pdlpp_stdargs {
+ my($rec) = @_;
+ my($src,$pref,$mod) = @$rec;
+ return (
+ %::PDL_OPTIONS,
+ 'NAME' => $mod,
+ 'TYPEMAPS' => [&PDL_INST_TYPEMAP()],
+ 'OBJECT' => "$pref\$(OBJ_EXT)",
+ PM => {"$pref.pm" => "\$(INST_LIBDIR)/$pref.pm"},
+ MAN3PODS => {"$pref.pm" => "\$(INST_MAN3DIR)/$mod.\$(MAN3EXT)"},
+ 'INC' => &PDL_INST_INCLUDE()." $inc",
+ 'LIBS' => $libs ? ["$libs "] : [],
+ 'clean' => {'FILES' => "$pref.xs $pref.pm $pref\$(OBJ_EXT) $pref.c"},
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+ );
+}
+
+
+sub unsupported {
+ my ($package,$os) = @_;
+ "No support for $package on $os platform yet. Will skip build process";
+}
+
+sub write_dummy_make {
+ require IO::File;
+ my ($msg) = @_;
+ print STDERR "writing dummy Makefile\n";
+ my $fh = new IO::File "> Makefile" or die "Can't open dummy Makefile: $!";
+
+if($^O !~ /mswin32/i) {
+ print $fh <<"EOT";
+fred:
+ \@echo \"****\"
+ \@echo \"$msg\"
+ \@echo \"****\"
+
+all: fred
+
+test: fred
+
+clean ::
+ -mv Makefile Makefile.old
+
+realclean ::
+ rm -rf Makefile Makefile.old
+
+EOT
+}
+
+else { # It's Win32
+ print $fh <<"EOT";
+fred:
+ \@echo \"****\"
+ \@echo \"$msg\"
+ \@echo \"****\"
+
+all: fred
+
+test: fred
+
+clean ::
+ -ren Makefile Makefile.old <NUL
+
+realclean ::
+ del /F /Q Makefile Makefile.old <NUL
+
+EOT
+}
+ close($fh) or die "Can't close dummy Makefile: $!";
+}
+
+sub getcyglib {
+my ($lib) = @_;
+my $lp = `gcc -print-file-name=lib$lib.a`;
+$lp =~ s|/[^/]+$||;
+$lp =~ s|^([a-z,A-Z]):|//$1|g;
+return "-L$lp -l$lib";
+}
+
+=head2 trylink
+
+=for ref
+
+a perl configure clone
+
+=for example
+
+ if (trylink 'libGL', '', 'char glBegin(); glBegin();', '-lGL') {
+ $libs = '-lGLU -lGL';
+ $have_GL = 1;
+ } else {
+ $have_GL = 0;
+ }
+ $maybe =
+ trylink 'libwhatever', $inc, $body, $libs, $cflags,
+ {MakeMaker=>1, Hide=>0, Clean=>1};
+
+Try to link some C-code making up the body of a function
+with a given set of library specifiers
+
+return 1 if successful, 0 otherwise
+
+=for usage
+
+ trylink $infomsg, $include, $progbody, $libs [,$cflags,{OPTIONS}];
+
+Takes 4 + 2 optional arguments.
+
+=over 5
+
+=item *
+
+an informational message to print (can be empty)
+
+=item *
+
+any commands to be included at the top of the generated C program
+(typically something like C<#include "mylib.h">)
+
+=item *
+
+the body of the program (in function main)
+
+=item *
+
+library flags to use for linking. Preprocessing
+by MakeMaker should be performed as needed (see options and example).
+
+=item *
+
+compilation flags. For example, something like C<-I/usr/local/lib>.
+Optional argument. Empty if omitted.
+
+=item *
+
+OPTIONS
+
+=over
+
+=item MakeMaker
+
+Preprocess library strings in the way MakeMaker does things. This is
+advisable to ensure that your code will actually work after the link
+specs have been processed by MakeMaker.
+
+=item Hide
+
+Controls if linking output etc is hidden from the user or not.
+On by default except within the build of the PDL distribution
+where the config value set in F<perldl.conf> prevails.
+
+=item Clean
+
+Remove temporary files. Enabled by default. You might want to switch
+it off during debugging.
+
+=back
+
+=back
+
+=cut
+
+
+sub trylink {
+ my $opt = ref $_[$#_] eq 'HASH' ? pop : {};
+ my ($txt,$inc,$body,$libs,$cflags) = @_;
+ $cflags ||= '';
+ require File::Spec;
+ require File::Temp;
+ my $cdir = sub { return File::Spec->catdir(@_)};
+ my $cfile = sub { return File::Spec->catfile(@_)};
+ use Config;
+
+ # check if MakeMaker should be used to preprocess the libs
+ for my $key(keys %$opt) {$opt->{lc $key} = $opt->{$key}}
+ my $mmprocess = exists $opt->{makemaker} && $opt->{makemaker};
+ my $hide = exists $opt->{hide} ? $opt->{hide} :
+ exists $PDL::Config{HIDE_TRYLINK} ? $PDL::Config{HIDE_TRYLINK} : 1;
+ my $clean = exists $opt->{clean} ? $opt->{clean} : 1;
+ if ($mmprocess) {
+ require ExtUtils::MakeMaker;
+ require ExtUtils::Liblist;
+ my $self = new ExtUtils::MakeMaker {DIR => [],'NAME' => 'NONE'};
+
+ my @libs = $self->ext($libs, 0);
+
+ print "processed LIBS: $libs[0]\n" unless $hide;
+ $libs = $libs[0]; # replace by preprocessed libs
+ }
+
+ print " Trying $txt...\n " unless $txt =~ /^\s*$/;
+
+ my $HIDE = !$hide ? '' : '>/dev/null 2>&1';
+ if($^O =~ /mswin32/i) {$HIDE = '>NUL 2>&1'}
+
+ my $tempd;
+
+ $tempd = File::Temp::tempdir(CLEANUP=>1) || die "trylink: could not make TEMPDIR";
+ ### if($^O =~ /MSWin32/i) {$tempd = File::Spec->tmpdir()}
+ ### else {
+ ### $tempd = $PDL::Config{TEMPDIR} ||
+ ### }
+
+ my ($tc,$te) = map {&$cfile($tempd,"testfile$_")} ('.c','');
+ open FILE,">$tc" or die "trylink: couldn't open testfile `$tc' for writing, $!";
+ my $prog = <<"EOF";
+$inc
+
+int main(void) {
+$body
+
+return 0;
+
+}
+
+EOF
+
+ print FILE $prog;
+ close FILE;
+ # print "test prog:\n$prog\n";
+ # make sure we can overwrite the executable. shouldn't need this,
+ # but if it fails and HIDE is on, the user will never see the error.
+ open(T, ">$te") or die( "unable to write to test executable `$te'");
+ close T;
+ print "$Config{cc} $cflags -o $te $tc $libs $HIDE ...\n" unless $hide;
+ my $success = (system("$Config{cc} $cflags -o $te $tc $libs $HIDE") == 0) &&
+ -e $te ? 1 : 0;
+ unlink "$te","$tc" if $clean;
+ print $success ? "\t\tYES\n" : "\t\tNO\n" unless $txt =~ /^\s*$/;
+ print $success ? "\t\tSUCCESS\n" : "\t\tFAILED\n"
+ if $txt =~ /^\s*$/ && !$hide;
+ return $success;
+}
+
+1; # Return OK
+
diff --git a/Basic/Core/Exporter.pm b/Basic/Core/Exporter.pm
new file mode 100644
index 0000000..59b2601
--- /dev/null
+++ b/Basic/Core/Exporter.pm
@@ -0,0 +1,84 @@
+=head1 NAME
+
+PDL::Exporter - PDL export control
+
+=head1 DESCRIPTION
+
+Implements the standard conventions for
+import of PDL modules in to the namespace
+
+Hopefully will be extended to allow fine
+control of which namespace is used.
+
+=head1 SYNOPSIS
+
+use PDL::Exporter;
+
+ use PDL::MyModule; # Import default function list ':Func'
+ use PDL::MyModule ''; # Import nothing (OO)
+ use PDL::MyModule '...'; # Same behaviour as Exporter
+
+=head1 SUMMARY
+
+C<PDL::Exporter> is a drop-in replacement for the L<Exporter|Exporter>
+module. It confers the standard PDL export conventions to your module.
+Usage is fairly straightforward and best illustrated by an example. The
+following shows typical usage near the top of a simple PDL module:
+
+
+ package PDL::MyMod;
+
+ use strict;
+
+ # For Perl 5.6:
+ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+ # For more modern Perls:
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+ require PDL::Exporter;
+
+ @ISA = qw(PDL::Exporter);
+ @EXPORT_OK = qw(inc myfunc); # these will be exported by default
+ %EXPORT_TAGS = (Func=>[@EXPORT_OK],
+ Internal => [qw/internfunc1 internfunc2/],
+ );
+
+ # ... body of your module
+
+ 1; # end of simple module
+
+
+=cut
+
+package PDL::Exporter;
+
+use Exporter;
+
+sub import {
+ my $pkg = shift;
+ return if $pkg eq 'PDL::Exporter'; # Module don't export thyself :)
+ my $callpkg = caller($Exporter::ExportLevel);
+ print "DBG: pkg=$pkg callpkg = $callpkg :@_\n" if($PDL::Exporter::Verbose);
+ push @_, ':Func' unless @_;
+ @_=() if scalar(@_)==1 and $_[0] eq '';
+ Exporter::export($pkg, $callpkg, @_);
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<Exporter|Exporter>
+
+=head1 AUTHOR
+
+Copyright (C) Karl Glazebrook (kgb at aaoepp.aao.gov.au).
+Some docs by Christian Soeller.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
diff --git a/Basic/Core/Makefile.PL b/Basic/Core/Makefile.PL
new file mode 100644
index 0000000..a6fc6bc
--- /dev/null
+++ b/Basic/Core/Makefile.PL
@@ -0,0 +1,306 @@
+
+# Makefile.PL for PDL::Core module
+my $libdir;
+
+use File::Spec;
+
+BEGIN {
+ if (defined $PDL::Config{PDL_BUILD_DIR}) {
+ print STDERR "Basic/Core/Makefile.PL: got root build dir $PDL::Config{PDL_BUILD_DIR}\n";
+ $libdir = File::Spec->catfile($PDL::Config{PDL_BUILD_DIR},'inc');
+ print STDERR "Basic/Core/Makefile.PL: adding $libdir\n";
+ }
+}
+
+use lib $libdir;
+
+use Devel::CheckLib;
+
+#require '../Core/Dev.pm';
+PDL::Core::Dev->import();
+
+use Config;
+use IO::File;
+
+## $DB::single = 1; # uncomment to have debugger stop here
+
+my $pthread_include = $Config::Config{usrinc}; # not good for win32
+my $pthread_library = '-lpthread'; # not good for MSVC
+my $pthread_define = ' -DPDL_PTHREAD ';
+
+my $macos_braindamage_define = ($ENV{'OSTYPE'} eq 'darwin') ? " -DMACOS_MZERO_BRAINDAMAGE " : "";
+
+my $malloclib = $PDL::Config{MALLOCDBG}->{libs};
+my $mallocinc = $PDL::Config{MALLOCDBG}->{include};
+
+my $fh = IO::File->new( "> mymalloc.p" )
+ or die "couldn't open mymalloc.p";
+if ( defined $PDL::Config{MALLOCDBG}->{define} ) {
+ $fh->print( "\$mymalloc = <<'EOM';\n$PDL::Config{MALLOCDBG}->{define}\nEOM\n" );
+} else {
+ $fh->print( "\$mymalloc = '';\n" );
+}
+$fh->print( "1;\n" );
+$fh->close;
+
+print "Trying to figure out POSIX threads support ...\n";
+
+# TODO: replace directory and file checks for pthread.h by Devel::CheckLib test
+if ( exists $PDL::Config{POSIX_THREADS_INC} and defined $PDL::Config{POSIX_THREADS_INC} ) {
+ $pthread_include = $PDL::Config{POSIX_THREADS_INC};
+ print "\t..setting \$pthread_include to $pthread_include\n";
+} elsif (-d $pthread_include) {
+ print "\tSaw pthread.h. Fine.\n";
+ $pthread_include = "-I$pthread_include"
+} else {
+ print "\tEhh. Didn't see include file 'pthread.h'.\n";
+ $pthread_include = '';
+}
+
+# For SGI, I had to link a new perl - cannot dlopen libpthread...
+require Config;
+
+# TODO: need to clean up per-platform logic herer
+if ( exists $PDL::Config{POSIX_THREADS_LIBS} and defined $PDL::Config{POSIX_THREADS_LIBS} ) {
+ $pthread_library = $PDL::Config{POSIX_THREADS_LIBS};
+ print "\tUsing POSIX_THREADS_LIBS from perldl.conf\n";
+} elsif ($Config::Config{libs} =~ /-lpthread/) { # wrong
+ print "\tFine, your perl was linked against pthread library.\n";
+} elsif ($^O eq 'dec_osf') {
+ if ($Config::Config{usemymalloc} eq 'n') {
+ print "\tFine pthread, works with Digital Unixs malloc\n";
+ } else {
+ #
+ print "\tPerls malloc has problems when perl is not linked with -lpthread\n";
+ $pthread_library = '';
+ }
+} elsif ($^O eq 'freebsd'){
+ if ($Config::Config{libs} =~ /-lc_r/) {
+ print "\tGood, found -lc_r on a freebsd system.\n";
+ } else {
+ print "On FreeBSD try building perl with libc_r instead of libc\n";
+ $pthread_library = '';
+ }
+ } elsif ($^O =~ /bsd$/i){
+ if ($Config::Config{ldflags} =~ /-pthread/) {
+ if ($Config::Config{usemymalloc} eq 'y') {
+ print "\tGood, usemymalloc=y, will build with pthread support\n";
+ } else {
+ print "\tGot usemymalloc=$Config::Config{usemymalloc} so not building with pthreads\n";
+ $pthread_library = '';
+ }
+ } else {
+ print "\tMissing '-pthread' from ldflags=$Config::Config{lddlflags} so not building with pthreads\n";
+ $pthread_library = '';
+ }
+ } else {
+ print "\tNope, your perl was not linked against pthread library\n";
+ if ($^O =~ /mswin/i or $^O =~ /cygwin/i) {
+ if (check_lib(LIB=>'-lpthread',header=>'pthread.h')) {
+ print "\tWe found -lpthread and pthread.h so will build anyway\n";
+ $pthread_library = '-lpthread';
+ } else {
+ $pthread_library = '';
+ }
+ } else {
+ print "\tWe'll try the default -lpthread anyway\n";
+ # $pthread_library = '';
+ }
+ }
+
+$pthread_include = $pthread_library = '' unless $pthread_include and $pthread_library;
+
+{
+ # TODO: use a Devel::CheckLib build/run test to verify working build params
+ my $conf = $PDL::Config{WITH_POSIX_THREADS};
+
+ if ((!defined($conf) or $conf)
+ and $pthread_include and $pthread_library) {
+ print "\t==> Will build PDL with POSIX thread support. Gifts to TJL :-)\n";
+ $PDL::Config{WITH_POSIX_THREADS} = 1;
+ } elsif($conf) {
+ print "\t==> I couldn't find pthread support. However, you have\n";
+ print "\t turned on the forcing option in PDL_CONFIG so I guess I gotta do it\n";
+ } else {
+ print "\t==> PDL will be built without POSIX thread support.\n";
+ print "\t==> *NOTE*: PDL threads are unrelated to perl threads (usethreads=y)!\n";
+ print "\t==> Enabling perl threads will not help!\n";
+ $pthread_define = '';
+ $PDL::Config{WITH_POSIX_THREADS} = 0;
+ }
+}
+
+# isbigendian() is in PDL::Dev
+print "\nTrying to figure out endian-ness of machine...";
+print " It is " . (PDL::Core::Dev::isbigendian() ? "big" : "little") . " endian\n";
+
+# badsupport.p is made by the top-level Makefile, but placed
+# into Basic/Core, so we clean it up here
+sub nopl { my $txt = shift; $txt =~ s/[.]PL$//; return $txt}
+
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ 'NAME' => 'PDL::Core',
+ 'VERSION_FROM' => 'Version.pm',
+ 'OBJECT' => 'Core$(OBJ_EXT) pdlcore$(OBJ_EXT) pdlapi$(OBJ_EXT) '.
+ 'pdlhash$(OBJ_EXT) pdlthread$(OBJ_EXT) '.
+ 'pdlconv$(OBJ_EXT) pdlmagic$(OBJ_EXT) pdlsections$(OBJ_EXT) ',
+ 'PM' => {
+ (map {($_,'$(INST_LIBDIR)/'.$_)} (
+ qw/Core.pm Basic.pm Version.pm Types.pm
+ Dbg.pm Exporter.pm Config.pm Char.pm/
+ )),
+ (map {($_,'$(INST_LIBDIR)/Core/'.$_)} (
+ qw/Dev.pm typemap.pdl pdl.h pdlcore.h pdlmagic.h pdlsimple.h
+ pdlthread.h ppport.h/
+ )),
+ },
+ 'PL_FILES' => {map {($_ => nopl $_)} grep {!/^Core.pm.PL|Makefile.PL$/} <*.PL>},
+ 'DEFINE' => $pthread_define.$macos_braindamage_define,
+ 'LIBS' => ["$pthread_library $malloclib"],
+ 'clean' => {'FILES' => 'pdlcore$(OBJ_EXT) pdlapi$(OBJ_EXT) '.
+ 'pdlhash$(OBJ_EXT) pdlconv$(OBJ_EXT) pdlsections$(OBJ_EXT) '.
+ 'pdlconv.c pdlsections.c pdlcore.c '.
+ 'pdl.h pdlsimple.h pdlcore.h '.
+ 'Types.pm Version.pm Core.pm Core.c Core.xs ' .
+ 'mymalloc.p badsupport.p'
+ },
+ 'INC' => "$pthread_include $mallocinc",
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
+# Extra targets to build
+
+sub make_from_PL ($) {
+ my $head = shift;
+ return "\t" .
+ '$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) ' .
+ "${head}.PL $head\n";
+}
+
+sub MY::xs_o {
+ if($Config{make} =~ /\bnmake/i) {
+ return'
+.xs$(OBJ_EXT):
+ $(PERLRUN) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c
+ $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
+'
+ }
+ else {
+ package MY;
+ my $self = shift;
+ return $self->SUPER::xs_o;
+ }
+}
+
+sub MY::processPL {
+ if($^O =~ /MSWin32/i && ($Config{make} =~ /\bdmake/i || $Config{make} =~ /\bnmake/i)) {
+ if($Config{make} =~ /\bnmake/i){return ''}
+ my($self) = shift;
+ return "" unless $self->{PL_FILES};
+ my(@m, $plfile);
+ foreach $plfile (sort keys %{$self->{PL_FILES}}) {
+ my $list = ref($self->{PL_FILES}->{$plfile})
+ ? $self->{PL_FILES}->{$plfile}
+ : [$self->{PL_FILES}->{$plfile}];
+ my $target;
+ foreach $target (@$list) {
+ push @m, "
+all :: $target
+ \$(NOECHO) \$(NOOP)
+
+$target :
+ \$(PERLRUNINST) $plfile $target
+";
+ } # close foreach
+ }
+ join "", @m;
+ }
+ else {
+ package MY;
+ my $self = shift;
+ return $self->SUPER::processPL;
+ }
+}
+
+sub MY::postamble {
+
+if($Config{make} =~ /\bdmake/i) { return
+
+PDL::Core::Dev::postamble().
+"
+
+Core.pm :: Core.pm.PL Types.pm badsupport.p\n"
+. make_from_PL('Core.pm')
+."
+
+pdl.h:: pdl.h.PL mymalloc.p Types.pm\n"
+. make_from_PL( 'pdl.h' )
+."
+
+pdlsimple.h:: pdlsimple.h.PL Types.pm\n"
+. make_from_PL( 'pdlsimple.h' )
+."
+
+pdlcore.h:: pdlcore.h.PL Types.pm\n"
+. make_from_PL( 'pdlcore.h' )
+.
+q|
+
+pdlsections.c: pdlsections.g Types.pm
+ $(PERL) -e "require './getdev.pl'" pdlsections.g > pdlsections.c
+|;
+} else { return
+PDL::Core::Dev::postamble().
+"
+# Bits of C code we generate from special perl scripts
+#
+# there must be a more elegant way of saying that
+# certain files have additional dependencies!
+
+pdlthread.c :: pdlcore.h\n"
+."
+
+pdlhash.c :: pdlcore.h\n"
+."
+
+pdlapi.c :: pdlcore.h\n"
+."
+
+pdlmagic.c :: pdlcore.h\n"
+."
+
+Core.pm :: Core.pm.PL Types.pm badsupport.p\n"
+. make_from_PL('Core.pm')
+."
+
+pdl.h:: pdl.h.PL mymalloc.p Types.pm\n"
+. make_from_PL( 'pdl.h' )
+."
+
+pdlsimple.h:: pdlsimple.h.PL Types.pm\n"
+. make_from_PL( 'pdlsimple.h' )
+."
+
+pdlconv.c:: pdlconv.c.PL Types.pm\n"
+. make_from_PL( 'pdlconv.c' )
+."
+
+pdlcore.c:: pdlcore.c.PL Types.pm\n"
+. make_from_PL( 'pdlcore.c' )
+."
+
+pdlcore.h:: pdlcore.h.PL Types.pm\n"
+. make_from_PL( 'pdlcore.h' )
+.
+
+ join( "", map { "\n$_ :: ${_}.PL badsupport.p\n" . make_from_PL($_) }
+ qw( Core.pm Core.xs pdlcore.c ) )
+.
+($^O =~ /MSWin/ ? q|
+
+pdlsections.c: pdlsections.g Types.pm
+ $(PERL) -e "require './getdev.pl'" pdlsections.g > pdlsections.c
+| : '');
+}
+}
diff --git a/Basic/Core/Types.pm.PL b/Basic/Core/Types.pm.PL
new file mode 100644
index 0000000..1abd04c
--- /dev/null
+++ b/Basic/Core/Types.pm.PL
@@ -0,0 +1,761 @@
+#
+# this script is executed directly from the top-level Makefile.PL
+# (ie before the standard "loop through the directories" behaviour
+# of the WriteMakefile() call in that file)
+#
+
+use strict;
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# Figure out the 4 byte integer type on this machine
+
+sub packtypeof_PDL_Indx {
+ if ($Config{'ivsize'} == 8) {
+ return 'q*';
+ }
+ elsif ($Config{'ivsize'} == 4 ) {
+ return 'l*';
+ }
+ else {
+ die "Types.pm.PL: packtype for ivsize==$Config{'ivsize'} not handled\n";
+ }
+}
+
+sub typeof_PDL_Indx {
+ warn "Types.pm.PL: using typedef $Config{'ivtype'} PDL_Indx\n";
+ return $Config{'ivtype'}
+}
+
+sub typeof_PDL_Long {
+ return 'int' if $Config{'intsize'}==4;
+ return 'long' if $Config{'longsize'}==4;
+ die "Can not find an integer datatype of size 4 bytes!!!\n";
+}
+
+sub typeof_PDL_i64 {
+ return $Config{i64type} or
+ die "Can not find an integer 64 bit type";
+}
+
+my $bvalflag = 0;
+for (@ARGV) {
+ if(/^BADVALS=(.*)$/)
+ {
+ $bvalflag = $1;
+ }
+}
+
+# Data types *must* be listed in order of complexity!!
+# this is critical for type conversions!!!
+#
+my @types = (
+ {
+ identifier => 'B',
+ pdlctype => 'PDL_Byte',# to be defined in pdl.h
+ realctype => 'unsigned char',
+ ppforcetype => 'byte', # for some types different from ctype
+ usenan => 0, # do we need NaN handling for this type?
+ packtype => 'C*', # the perl pack type
+ defaultbadval => 'UCHAR_MAX',
+ },
+ {
+ identifier => 'S',
+ pdlctype => 'PDL_Short',
+ realctype => 'short',
+ ppforcetype => 'short',
+ usenan => 0,
+ packtype => 's*',
+ defaultbadval => 'SHRT_MIN',
+ },
+ {
+ identifier => 'US',
+ onecharident => 'U', # only needed if different from identifier
+ pdlctype => 'PDL_Ushort',
+ realctype => 'unsigned short',
+ ppforcetype => 'ushort',
+ usenan => 0,
+ packtype => 'S*',
+ defaultbadval => 'USHRT_MAX',
+ },
+ {
+ identifier => 'L',
+ pdlctype => 'PDL_Long',
+ realctype => &typeof_PDL_Long,
+ ppforcetype => 'int',
+ usenan => 0,
+ packtype => 'l*',
+ defaultbadval => 'INT_MIN',
+ },
+
+#
+# The PDL_Indx type will be either the same as PDL_Long or, probably,
+# the same as PDL_LongLong depending on the platform. Will need to
+# determine the actual type at build time.
+
+ {
+ identifier => 'IND',
+ onecharident => 'N', # only needed if different from identifier
+ pdlctype => 'PDL_Indx',
+ realctype => &typeof_PDL_Indx,
+ ppforcetype => 'indx',
+ usenan => 0,
+ packtype => &packtypeof_PDL_Indx,
+ defaultbadval => 'LONG_MIN',
+ },
+#
+#
+# note that the I/O routines have *not* been updated to be aware of
+# such a type yet
+#
+ {
+ identifier => 'LL',
+ onecharident => 'Q', # only needed if different from identifier
+ pdlctype => 'PDL_LongLong',
+ realctype => &typeof_PDL_i64,
+ ppforcetype => 'longlong',
+ usenan => 0,
+ packtype => 'q*',
+ defaultbadval => 'LONG_MIN', # this is far from optimal
+ # but LLONG_MIN/LLONG_MAX are probably
+ # nonportable
+ # on the other hand 2^63 should be the
+ # value of of llong_max which we should be
+ # able to compute at runtime ?!
+ },
+
+ {
+ identifier => 'F',
+ pdlctype => 'PDL_Float',
+ realctype => 'float',
+ ppforcetype => 'float',
+ usenan => 1,
+ packtype => 'f*',
+ defaultbadval => '-FLT_MAX',
+ },
+ {
+ identifier => 'D',
+ pdlctype => 'PDL_Double',
+ realctype => 'double',
+ ppforcetype => 'double',
+ usenan => 1,
+ packtype => 'd*',
+ defaultbadval => '-DBL_MAX',
+ },
+ );
+
+sub checktypehas {
+ my ($key, at types) = @_;
+ for my $type (@types) {
+ die "type is not a HASH ref" unless ref $type eq 'HASH';
+ die "type hash doesn't have a key '$key'" unless exists $type->{$key};
+ }
+}
+
+sub gentypevars {
+ my @types = @_;
+ checktypehas 'identifier', @types;
+ my @ret = map {"\$PDL_$_->{identifier}"} @types;
+ return wantarray ? @ret : $ret[0];
+}
+
+sub genexports {
+ my @types = @_;
+ return join ' ', gentypevars @types;
+}
+
+sub gentypenames {
+ my @types = @_;
+ checktypehas 'identifier', @types;
+ my @ret = map {"PDL_$_->{identifier}"} @types;
+ return wantarray ? @ret : $ret[0];
+}
+
+sub genpacktypes {
+ my @types = @_;
+ checktypehas 'packtype', @types;
+ my @ret = map {"$_->{packtype}"} @types;
+ return wantarray ? @ret : $ret[0];
+}
+
+sub convertfunc {
+ my ($type) = @_;
+ return $type->{'convertfunc'} if exists $type->{'convertfunc'};
+ checktypehas 'pdlctype', $type;
+ my $cfunc = $type->{pdlctype};
+ $cfunc =~ s/PDL_//;
+ return lc $cfunc;
+}
+
+sub gentypehashentry ($$) {
+ my ($type,$num) = @_;
+ for my $field (qw/identifier pdlctype realctype ppforcetype usenan
+ defaultbadval/)
+ {checktypehas $field, $type}
+ my $newhash = {
+ ctype => $type->{pdlctype},
+ realctype => $type->{realctype},
+ ppsym => $type->{onecharident} || $type->{identifier},
+ ppforcetype => $type->{ppforcetype},
+ convertfunc => &convertfunc($type),
+ sym => &gentypenames($type),
+ numval => $num,
+ usenan => $type->{usenan},
+ ioname => &convertfunc($type), # same as the name of the
+ # convertfunc
+ defbval => $type->{defaultbadval},
+ };
+ return $newhash;
+}
+
+sub gentypehashcode {
+ my @types = @_;
+ use Data::Dumper;
+ local $Data::Dumper::Terse = 1;
+ local $Data::Dumper::Indent = 1;
+ local $Data::Dumper::Pad = "\t\t";
+ my $i = 0;
+ my $perlcode = '';
+ $perlcode .= "%PDL::Types::typehash = (\n";
+ for my $type (@types) {
+ print STDERR "making ".gentypenames($type)."...\n";
+ $perlcode .= "\t".gentypenames($type)." =>\n";
+ $perlcode .= Data::Dumper::Dumper(gentypehashentry($type, $i++));
+ $perlcode .= "\t\t,\n";
+ }
+ $perlcode .= "); # end typehash definition\n";
+ return $perlcode;
+}
+
+# List explicitly here the variables you want Configure to
+# generate. Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries. Thus you write
+# $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+my $file;
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($Config{'osname'} eq 'VMS' or
+ $Config{'osname'} eq 'OS2'); # "case-forgiving"
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file\n";
+chmod 0644, $file;
+
+# in the following we generate the type dependent
+# parts of Types.pm
+# all the required info is extracted from the @types
+# array defined above
+# the guts how this is done is encapsulated in the subroutines
+# that follow the definition of @types
+
+# set up some variables that we will use below
+my $typeexports = genexports @types;
+my $ntypesm1 = @types - 1; # number of types - 1
+my $typevars = join ', ',gentypevars @types;
+my $packtypes = join ' ', genpacktypes @types;
+my $typenames = join ' ', gentypenames @types;
+
+print OUT <<'!NO!SUBS!';
+
+### Generated from Types.pm.PL automatically - do not modify! ###
+
+package PDL::Types;
+require Exporter;
+use Carp;
+
+!NO!SUBS!
+
+print OUT qq{
+\@EXPORT = qw( $typeexports
+ \@pack \%typehash );
+};
+
+print OUT <<'!NO!SUBS!';
+
+ at EXPORT_OK = (@EXPORT, qw/types ppdefs typesrtkeys mapfld typefld/);
+%EXPORT_TAGS = (
+ All=>[@EXPORT,qw/types ppdefs typesrtkeys mapfld typefld/],
+);
+
+ at ISA = qw( Exporter );
+
+!NO!SUBS!
+
+print OUT qq{
+
+# Data types/sizes (bytes) [must be in order of complexity]
+# Enum
+( $typevars ) = (0..$ntypesm1);
+# Corresponding pack types
+\@pack= qw/$packtypes/;
+\@names= qw/$typenames/;
+
+};
+
+# generate the typehash output
+print OUT gentypehashcode @types;
+
+print OUT <<'!NO!SUBS!';
+
+# Cross-reference by common names
+%PDL::Types::typenames = ();
+for my $k(keys %PDL::Types::typehash) {
+ my $n = $PDL::Types::typehash{$k}->{'numval'};
+ $PDL::Types::typenames{$k} = $n;
+ $PDL::Types::typenames{$n} = $n;
+ $PDL::Types::typenames{$PDL::Types::typehash{$k}->{ioname}} = $n;
+ $PDL::Types::typenames{$PDL::Types::typehash{$k}->{ctype}} = $n;
+}
+
+
+=head1 NAME
+
+PDL::Types - define fundamental PDL Datatypes
+
+=head1 SYNOPSIS
+
+ use PDL::Types;
+
+ $pdl = ushort( 2.0, 3.0 );
+ print "The actual c type used to store ushort's is '" .
+ $pdl->type->realctype() . "'\n";
+ The actual c type used to store ushort's is 'unsigned short'
+
+=head1 DESCRIPTION
+
+Internal module - holds all the PDL Type info. The type info can be
+accessed easily using the C<PDL::Type> object returned by
+the L<type|PDL::Core/type> method.
+
+Skip to the end of this document to find out how to change
+the set of types supported by PDL.
+
+=head1 Support functions
+
+A number of functions are available for module writers
+to get/process type information. These are used in various
+places (e.g. C<PDL::PP>, C<PDL::Core>) to generate the
+appropriate type loops, etc.
+
+=head2 typesrtkeys
+
+return array of keys of typehash sorted in order of type complexity
+
+=cut
+
+sub typesrtkeys {
+ return sort {$typehash{$a}->{numval} <=> $typehash{$b}->{numval}}
+ keys %typehash;
+}
+
+=head2 ppdefs
+
+return array of pp symbols for all known types
+
+=cut
+
+sub ppdefs {
+ return map {$typehash{$_}->{ppsym}} typesrtkeys;
+}
+
+=head2 typefld
+
+return specified field (C<$fld>) for specified type (C<$type>)
+by querying type hash
+
+=cut
+
+sub typefld {
+ my ($type,$fld) = @_;
+ croak "unknown type $type" unless exists $typehash{$type};
+ croak "unknown field $fld in type $type"
+ unless exists $typehash{$type}->{$fld};
+ return $typehash{$type}->{$fld};
+}
+
+=head2 mapfld (in_value, in_key, out_key)
+
+Map a given source field to the corresponding target field by
+querying the type hash. This gives you a way to say, "Find the type
+whose C<$in_key> is equal to C<$value>, and return that type's value
+for C<$out_key>. For example:
+
+ # Does byte type use nan?
+ $uses_nan = PDL::Types::mapfld(byte => 'ppforcetype', 'usenan');
+ # Equivalent:
+ $uses_nan = byte->usenan;
+
+ # What is the actual C type for the value that we call 'long'?
+ $type_name = PDL::Types::mapfld(long => 'convertfunc', 'realctype');
+ # Equivalent:
+ $type_name = long->realctype;
+
+As you can see, the equivalent examples are much shorter and legible, so you
+should only use mapfld if you were given the type index (in which case the
+actual type is not immediately obvious):
+
+ $type_index = 4;
+ $type_name = PDL::Types::mapfld($type_index => numval, 'realctype');
+
+=cut
+
+sub mapfld {
+ my ($type,$src,$trg) = @_;
+ my @keys = grep {$typehash{$_}->{$src} eq $type} typesrtkeys;
+ return @keys > 0 ? $typehash{$keys[0]}->{$trg} : undef;
+}
+
+=head2 typesynonyms
+
+=for ref
+
+return type related synonym definitions to be included in pdl.h .
+This routine must be updated to include new types as required.
+Mostly the automatic updating should take care of the vital
+things.
+
+=cut
+
+sub typesynonyms {
+ my $add = join "\n",
+ map {"#define PDL_".typefld($_,'ppsym')." ".typefld($_,'sym')}
+ grep {"PDL_".typefld($_,'ppsym') ne typefld($_,'sym')} typesrtkeys;
+ print "adding...\n$add\n";
+ return "$add\n";
+}
+
+=head1 PDL::Type OBJECTS
+
+This module declares one class - C<PDL::Type> - objects of this class
+are returned by the L<type|PDL::Core/type> method of a piddle. It has
+several methods, listed below, which provide an easy way to access
+type information:
+
+Additionally, comparison and stringification are overloaded so that
+you can compare and print type objects, e.g.
+
+ $nofloat = 1 if $pdl->type < float;
+ die "must be double" if $type != double;
+
+For further examples check again the
+L<type|PDL::Core/type> method.
+
+=over 4
+
+=item enum
+
+Returns the number representing this datatype (see L<get_datatype|PDL::Core/PDL::get_datatype>).
+
+=item symbol
+
+Returns one of 'PDL_B', 'PDL_S', 'PDL_US', 'PDL_L', 'PDL_LL', 'PDL_F'
+or 'PDL_D'.
+
+=item ctype
+
+Returns the macro used to represent this type in C code (eg 'PDL_Long').
+
+=item ppsym
+
+The letter used to represent this type in PP code code (eg 'U' for L<ushort|PDL::Core/ushort>).
+
+=item realctype
+
+The actual C type used to store this type.
+
+=item shortctype
+
+The value returned by C<ctype> without the 'PDL_' prefix.
+
+=item badvalue
+
+The special numerical value used to represent bad values for this type.
+See L<badvalue routine in PDL::Bad|PDL::Bad/badvalue> for more details.
+
+=cut
+
+!NO!SUBS!
+
+=pod
+
+You happen to be reading this on CPAN, but if you were reading this on your
+own machine and your PDL did not have support for bad values, you would see
+a small paragraph saying:
+
+=cut
+
+unless ($bvalflag) {
+ print OUT << '!NO!SUBS!';
+
+=pod
+
+You do not have bad value support enabled, so this returns undef.
+
+=cut
+
+!NO!SUBS!
+
+}
+
+
+print OUT <<'!NO!SUBS!';
+
+=item orig_badvalue
+
+The default special numerical value used to represent bad values for this
+type. (You can change the value that represents bad values for each type
+during runtime.) See the
+L<orig_badvalue routine in PDL::Bad|PDL::Bad/orig_badvalue> for more details.
+
+=cut
+
+!NO!SUBS!
+
+=pod
+
+You happen to be reading this on CPAN, but if you were reading this on your
+own machine and your PDL did not have support for bad values, you would see
+a small paragraph saying:
+
+=cut
+
+unless ($bvalflag) {
+ print OUT << '!NO!SUBS!';
+
+=pod
+
+You do not have bad value support enabled, so this returns undef.
+
+=cut
+
+!NO!SUBS!
+
+}
+
+print OUT <<'!NO!SUBS!';
+
+=back
+
+=cut
+
+{
+ package PDL::Type;
+ sub new {
+ my($type,$val) = @_;
+ if("PDL::Type" eq ref $val) { return bless [@$val],$type; }
+ if(ref $val and $val->isa(PDL)) {
+ if($val->getndims != 0) {
+ PDL::Core::barf(
+ "Can't make a type out of non-scalar piddle $val!");
+ }
+ $val = $val->at;
+ }
+ PDL::Core::barf("Can't make a type out of non-scalar $val!".
+ (ref $val)."!") if ref $val;
+
+ if(length($PDL::Types::typenames{$val})) {
+ $val =~ s/^\s*//o;
+ $val =~ s/\s*$//o;
+ return bless [$PDL::Types::typenames{$val}],$type;
+ } else {
+ die("Unknown type string '$val' (should be one of ".
+ join(",",map { $PDL::Types::typehash{$_}->{ioname} } @names).
+ ")\n");
+ }
+ }
+
+sub enum { return $_[0]->[0]; }
+sub symbol { return $PDL::Types::names[ $_[0]->enum ]; }
+sub PDL::Types::types { # return all known types as type objects
+ map { new PDL::Type PDL::Types::typefld($_,'numval') }
+ PDL::Types::typesrtkeys();
+}
+
+!NO!SUBS!
+
+foreach my $name ( qw( ctype ppsym realctype ppforcetype convertfunc
+ sym numval usenan ioname defbval) ) {
+ print OUT << "EOS";
+sub $name {
+ return \$PDL::Types::typehash{\$_[0]->symbol}->{$name};
+}
+EOS
+}
+
+## add the code for returning the bad value for a particular
+## type. Up to (and including) 2.3.4, this code was actually in
+## Basic/Bad/bad.pd.
+##
+
+if ( $bvalflag ) {
+ print OUT <<'!NO!SUBS!';
+
+no strict 'refs';
+sub badvalue {
+ my ( $self, $val ) = @_;
+ my $name = "PDL::_badvalue_int" . $self->enum();
+ if ( defined $val ) { return &{$name}( $val )->sclr; }
+ else { return &{$name}()->sclr; }
+}
+
+sub orig_badvalue {
+ my $self = shift;
+ my $name = "PDL::_default_badvalue_int" . $self->enum();
+ return &{$name}()->sclr;
+}
+use strict 'refs';
+
+!NO!SUBS!
+
+} else {
+ print OUT qq{
+sub badvalue { return undef; }
+sub orig_badvalue { return undef; }
+};
+
+} # if: $bvalflag
+
+print OUT <<'!NO!SUBS!';
+
+sub shortctype { my $txt = $_[0]->ctype; $txt =~ s/PDL_//; return $txt; }
+
+# make life a bit easier
+use overload (
+ "\"\"" => sub { lc $_[0]->shortctype },
+ "eq" => sub { my($self, $other, $swap) = @_;
+ return ("$self" eq $other);
+ },
+ "cmp" => sub { my($self, $other, $swap) = @_;
+ return ($swap ? $other cmp "$self" : "$self" cmp $other);
+ },
+ "<=>" => sub { $_[2] ? $_[1]->enum <=> $_[0]->enum :
+ $_[0]->enum <=> $_[1]->enum },
+ );
+
+
+} # package: PDL::Type
+# Return
+1;
+
+__END__
+
+=head1 Adding/removing types
+
+You can change the types that PDL knows about by editing entries in
+the definition of the variable C<@types> that appears close to the
+top of the file F<Types.pm.PL> (i.e. the file from which this module
+was generated).
+
+=head2 Format of a type entry
+
+Each entry in the C<@types> array is a hash reference. Here is an example
+taken from the actual code that defines the C<ushort> type:
+
+ {
+ identifier => 'US',
+ onecharident => 'U', # only needed if different from identifier
+ pdlctype => 'PDL_Ushort',
+ realctype => 'unsigned short',
+ ppforcetype => 'ushort',
+ usenan => 0,
+ packtype => 'S*',
+ },
+
+Before we start to explain the fields please take this important
+message on board:
+I<entries must be listed in order of increasing complexity>. This
+is critical to ensure that PDL's type conversion works correctly.
+Basically, a less complex type will be converted to a more complex
+type as required.
+
+=head2 Fields in a type entry
+
+Each type entry has a number of required and optional entry.
+
+A list of all the entries:
+
+=over
+
+=item *
+
+identifier
+
+I<Required>. A short sequence of upercase letters that identifies this
+type uniquely. More than three characters is probably overkill.
+
+
+=item *
+
+onecharident
+
+I<Optional>. Only required if the C<identifier> has more than one character.
+This should be a unique uppercase character that will be used to reference
+this type in PP macro expressions of the C<TBSULFD> type. If you don't
+know what I am talking about read the PP manpage or ask on the mailing list.
+
+=item *
+
+pdlctype
+
+I<Required>. The C<typedefed> name that will be used to access this type
+from C code.
+
+=item *
+
+realctype
+
+I<Required>. The C compiler type that is used to implement this type.
+For portability reasons this one might be platform dependent.
+
+=item *
+
+ppforcetype
+
+I<Required>. The type name used in PP signatures to refer to this type.
+
+=item *
+
+usenan
+
+I<Required>. Flag that signals if this type has to deal with NaN issues.
+Generally only required for floating point types.
+
+=item *
+
+packtype
+
+I<Required>. The Perl pack type used to pack Perl values into the machine representation for this type. For details see C<perldoc -f pack>.
+
+=back
+
+Also have a look at the entries at the top of F<Types.pm.PL>.
+
+The syntax is not written into stone yet and might change as the
+concept matures.
+
+=head2 Other things you need to do
+
+You need to check modules that do I/O (generally in the F<IO>
+part of the directory tree). In the future we might add fields to
+type entries to automate this. This requires changes to those IO
+modules first though.
+
+You should also make sure that any type macros in PP files
+(i.e. C<$TBSULFD...>) are updated to reflect the new type. PDL::PP::Dump
+has a mode to check for type macros requiring updating. Do something like
+
+ find . -name \*.pd -exec perl -Mblib=. -M'PDL::PP::Dump=typecheck' {} \;
+
+from the PDL root directory I<after> updating F<Types.pm.PL> to check
+for such places.
+
+=cut
+
+!NO!SUBS!
diff --git a/Basic/Core/pdl.h.PL b/Basic/Core/pdl.h.PL
new file mode 100644
index 0000000..b53e248
--- /dev/null
+++ b/Basic/Core/pdl.h.PL
@@ -0,0 +1,429 @@
+# -*-perl-*-
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+require "pdl_hfiles.p";
+require "mymalloc.p";
+require "badsupport.p";
+
+# how many variable types (ie PDL_Byte, ...) are there?
+require 'Types.pm';
+my $ntypes = $#PDL::Types::names;
+
+
+
+# List explicitly here the variables you want Configure to
+# generate. Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries. Thus you write
+# $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+my $file;
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($Config{'osname'} eq 'VMS' or
+ $Config{'osname'} eq 'OS2'); # "case-forgiving"
+
+print "Extracting $file\n";
+open OUT,">$file" or die "Can't create $file: $!";
+chmod 0644, $file;
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+
+/*
+ * THIS FILE IS GENERATED FROM pdl.h.PL! Do NOT edit!
+ */
+
+#ifndef __PDL_H
+#define __PDL_H
+
+#define PDL_DEBUGGING 1
+
+#ifdef PDL_DEBUGGING
+extern int pdl_debugging;
+#define PDLDEBUG_f(a) if(pdl_debugging) a
+#else
+#define PDLDEBUG_f(a)
+#endif
+
+/* Auto-PThreading (i.e. multi-threading) settings for PDL functions */
+/* Target number of pthreads: Actual will be this number or less.
+ A 0 here means no pthreading */
+extern int pdl_autopthread_targ;
+/* Actual number of pthreads: This is the number of pthreads created for the last
+ operation where pthreading was used
+ A 0 here means no pthreading */
+extern int pdl_autopthread_actual;
+/* Minimum size of the larget PDL involved in pdl function to attempt pthreading (in MBytes )
+ For small PDLs, it probably isn't worth starting multiple pthreads, so this variable
+ is used to define that threshold (in M-elements, or 2^20 elements ) */
+extern int pdl_autopthread_size;
+
+typedef struct pdl pdl;
+
+$PDL_DATATYPES
+
+$mymalloc
+!GROK!THIS!
+
+# set up the badvalues structure
+# - for binary compatability, this is created whatever the
+# value of $bvalflag and $usenan
+print OUT "typedef struct badvals {\n";
+foreach my $i ( reverse(0 .. $ntypes) ) {
+ my $name = $PDL::Types::names[$i];
+ my $realctype = $PDL::Types::typehash{$name}->{realctype};
+ my $cname = $PDL::Types::typehash{$name}->{ctype};
+ $cname =~ s/^PDL_//;
+ print OUT " $realctype $cname;\n";
+ print OUT " $realctype default_$cname;\n";
+}
+print OUT "} badvals;\n";
+
+print OUT <<'!NO!SUBS!';
+
+/*
+ Define the pdl C data structure which maps onto the original PDL
+ perl data structure.
+
+ Note: in above pdl.sv is defined as a void pointer to avoid
+ having to include perl.h in C code which just needs the pdl
+ data.
+*/
+
+#define PDL_NDIMS 6 /* Number of dims[] to preallocate */
+#define PDL_NCHILDREN 8 /* Number of children ptrs to preallocate */
+
+#define PDL_NTHREADIDS 4 /* Number of different threadids/pdl to preallocate */
+
+/* Constants for pdl.state - not all combinations make sense */
+ /* data allocated for this pdl. this implies that the data
+ is up to date if !PDL_PARENTCHANGED */
+#define PDL_ALLOCATED 0x0001
+ /* Parent's data has been altered at some point without changing
+ this pdl. */
+#define PDL_PARENTDATACHANGED 0x0002
+ /* Parent's dims or incs or whatever has been altered at some
+ point without changing this pdl. */
+#define PDL_PARENTDIMSCHANGED 0x0004
+ /* The physical data representation of the parent has changed,
+ e.g. by copying from its parent to itself as COW.
+ This means that (incs) etc. should be recalculated when used.
+ "parent was allocated" */
+#define PDL_PARENTREPRCHANGED 0x0008
+
+#define PDL_ANYCHANGED (PDL_PARENTDATACHANGED|PDL_PARENTDIMSCHANGED|PDL_PARENTREPRCHANGED)
+
+ /* What kinds of dataflows do we want to track starting from
+ this PDL (B only for transformations which make it possible).
+ All children inherit an 'or' from the parents */
+#define PDL_DATAFLOW_F 0x0010
+#define PDL_DATAFLOW_B 0x0020
+
+#define PDL_DATAFLOW_ANY (PDL_DATAFLOW_F|PDL_DATAFLOW_B)
+
+ /* Was this pdl null originally? */
+#define PDL_NOMYDIMS 0x0040
+ /* This means that dims are received through "trans" */
+#define PDL_MYDIMS_TRANS 0x0080
+
+#define PDL_OPT_VAFFTRANSOK 0x0100
+
+#define PDL_OPT_ANY_OK (PDL_OPT_VAFFTRANSOK)
+
+#define PDL_HDRCPY 0x0200
+
+#define PDL_BADVAL 0x0400
+
+#define PDL_TRACEDEBUG 0x0800
+
+#define PDL_CR_SETDIMSCOND(wtrans,pdl) (((pdl)->state & PDL_MYDIMS_TRANS) \
+ && (pdl)->trans == (pdl_trans *)(wtrans))
+
+#define PDL_INPLACE 0x1000
+
+ /* Destroying this now */
+#define PDL_DESTROYING 0x2000
+
+/* You mustn't alter the data pointer nor free this
+ * piddle nor use datasv (which is nothing).
+ * This means e.g. that the piddle is mmapped from a file
+ */
+#define PDL_DONTTOUCHDATA 0x4000
+
+/**************************************************
+ *
+ * Transformation structure
+ */
+
+/* Only slice and retype to be supported in the near future.
+ when FUNCTION is supported, it must be considered how that is going
+ to be implemented in terms of COW etc.
+ */
+typedef enum pdl_transtype { PDL_SLICE, PDL_FUNCTION, PDL_RETYPE }
+ pdl_transtype;
+
+/* Transformation flags */
+#define PDL_TRANS_AFFINE 0x0001
+
+/* Transpdl flags */
+#define PDL_TPDL_VAFFINE_OK 0x01
+
+typedef struct pdl_trans pdl_trans;
+
+typedef struct pdl_transvtable {
+ pdl_transtype transtype;
+ int flags;
+ int nparents;
+ int npdls;
+ char *per_pdl_flags;
+ void (*redodims)(pdl_trans *tr); /* Only dims and internal trans
+ (makes phys) */
+ void (*readdata)(pdl_trans *tr); /* Only data, to "data" ptr */
+ void (*writebackdata)(pdl_trans *tr); /* "data" ptr to parent or granny */
+ void (*freetrans)(pdl_trans *tr); /* Free both the contents and it of
+ the trans member */
+ void (*dump)(pdl_trans *tr); /* Dump this transformation */
+ /* Find a virtual parent and make ready
+ for readdata etc. */
+ void (*findvparent)(pdl_trans *tr);
+ pdl_trans *(*copy)(pdl_trans *tr); /* Full copy */
+ void (*can_do)(pdl_trans *tr);
+ /* XXX Here should be a "writebackdims" for changed dimensions */
+ int structsize;
+ char *name; /* For debuggers, mostly */
+ void (*foomethod)(pdl_trans *tr,int i1,int i2,int i3); /* Stupid */
+} pdl_transvtable;
+
+/* All trans must start with this */
+
+/* Trans flags */
+ /* Single-valued slice i.e. only one image of each parent thing allowed.
+ This is critical in routines that both input from and output to
+ a non-single-valued pdl: updating must occur :(
+ */
+#define PDL_ITRANS_REVERSIBLE 0x0001
+ /* Whether, if a child is changed, this trans should be destroyed
+ or not */
+#define PDL_ITRANS_DO_DATAFLOW_F 0x0002
+#define PDL_ITRANS_DO_DATAFLOW_B 0x0004
+
+#define PDL_ITRANS_DO_DATAFLOW_ANY \
+ (PDL_ITRANS_DO_DATAFLOW_F|PDL_ITRANS_DO_DATAFLOW_B)
+
+#define PDL_ITRANS_FORFAMILY 0x0008
+
+#define PDL_ITRANS_ISAFFINE 0x1000
+#define PDL_ITRANS_VAFFINEVALID 0x2000
+#define PDL_ITRANS_NONMUTUAL 0x4000 /* flag for destruction */
+
+// These define struct pdl_trans and all derived structures. There are many
+// structures that defined in other parts of the code that can be referenced
+// like a pdl_trans* because all of these structures have the same pdl_trans
+// initial piece. These structures can contain multiple pdl* elements in them.
+// Thus pdl_trans itself ends with a flexible pdl*[] array, which can be used to
+// reference any number of pdl objects. As a result pdl_trans itself can NOT be
+// instantiated
+
+// vparent is the "virtual parent" which is either
+// the parent or grandparent or whatever. The trans -structure must store
+// both the relationship with our current parent and, if necessary, the
+// virtual parent.
+
+#define PDL_TRANS_START_COMMON \
+ int magicno; \
+ short flags; \
+ pdl_transvtable *vtable; \
+ void (*freeproc)(struct pdl_trans *); /* Call to free this \
+ (means whether malloced or not) */ \
+ int bvalflag; /* required for binary compatability even if WITH_BADVAL=0 */ \
+ int has_badvalue; \
+ double badvalue; \
+ int __datatype
+
+#define PDL_TRANS_START(np) \
+ PDL_TRANS_START_COMMON; \
+ /* The pdls involved in the transformation */ \
+ pdl *pdls[np]
+
+#define PDL_TRANS_START_FLEXIBLE() \
+ PDL_TRANS_START_COMMON; \
+ /* The pdls involved in the transformation */ \
+ pdl *pdls[]
+
+#ifdef PDL_DEBUGGING
+#define PDL_CHKMAGIC_GENERAL(it,this_magic,type) if((it)->magicno != this_magic) croak("INVALID " #type "MAGIC NO 0x%p %d\n",it,(int)((it)->magicno)); else (void)0
+#else
+#define PDL_CHKMAGIC_GENERAL(it,this_magic,type)
+#endif
+
+#define PDL_TR_MAGICNO 0x91827364
+#define PDL_TR_SETMAGIC(it) it->magicno = PDL_TR_MAGICNO
+#define PDL_TR_CLRMAGIC(it) it->magicno = 0x99876134
+#define PDL_TR_CHKMAGIC(it) PDL_CHKMAGIC_GENERAL(it, PDL_TR_MAGICNO, "TRANS ")
+
+
+// This is a generic parent of all the trans structures. It is a flexible array
+// (can store an arbitrary number of pdl objects). Thus this can NOT be
+// instantiated, only "child" structures can
+struct pdl_trans {
+ PDL_TRANS_START_FLEXIBLE();
+} ;
+
+typedef struct pdl_trans_affine {
+ PDL_TRANS_START(2);
+/* affine relation to parent */
+ PDL_Indx *incs; PDL_Indx offs;
+} pdl_trans_affine;
+
+/* Need to make compatible with pdl_trans_affine */
+typedef struct pdl_vaffine {
+ PDL_TRANS_START(2);
+ PDL_Indx *incs; PDL_Indx offs;
+ int ndims;
+ PDL_Indx def_incs[PDL_NDIMS];
+ pdl *from;
+} pdl_vaffine;
+
+#define PDL_VAFFOK(pdl) (pdl->state & PDL_OPT_VAFFTRANSOK)
+#define PDL_REPRINC(pdl,which) (PDL_VAFFOK(pdl) ? \
+ pdl->vafftrans->incs[which] : pdl->dimincs[which])
+
+#define PDL_REPROFFS(pdl) (PDL_VAFFOK(pdl) ? pdl->vafftrans->offs : 0)
+
+#define PDL_REPRP(pdl) (PDL_VAFFOK(pdl) ? pdl->vafftrans->from->data : pdl->data)
+
+#define PDL_REPRP_TRANS(pdl,flag) ((PDL_VAFFOK(pdl) && \
+ (flag & PDL_TPDL_VAFFINE_OK)) ? pdl->vafftrans->from->data : pdl->data)
+
+#define VAFFINE_FLAG_OK(flags,i) ((flags == NULL) ? 1 : (flags[i] & \
+ PDL_TPDL_VAFFINE_OK))
+
+typedef struct pdl_children {
+ pdl_trans *trans[PDL_NCHILDREN];
+ struct pdl_children *next;
+} pdl_children;
+
+/* Family stuff */
+
+typedef struct pdl_family_trans {
+ PDL_TRANS_START(2);
+ pdl_trans *realtrans;
+ pdl *mutateto;
+ pdl *mutatefrom;
+} pdl_family_trans;
+
+struct pdl_magic;
+
+/* We should try to keep this under 256-foo bytes at all costs */
+
+struct pdl {
+#define PDL_MAGICNO 0x24645399
+#define PDL_CHKMAGIC(it) PDL_CHKMAGIC_GENERAL(it,PDL_MAGICNO,"")
+ unsigned long magicno; /* Always stores PDL_MAGICNO as a sanity check */
+ /* This is first so most pointer accesses to wrong type are caught */
+ int state; /* What's in this pdl */
+
+ pdl_trans *trans; /* Opaque pointer to internals of transformation from
+ parent */
+
+ pdl_vaffine *vafftrans; /* pointer to vaffine transformation
+ a vafftrans is an optimization that is possible
+ for some types of trans (slice etc)
+ - unused for non-affine transformations
+ */
+
+ void* sv; /* (optional) pointer back to original sv.
+ ALWAYS check for non-null before use.
+ We cannot inc refcnt on this one or we'd
+ never get destroyed */
+
+ void *datasv; /* Pointer to SV containing data. Refcnt inced */
+ void *data; /* Null: no data alloced for this one */
+
+ /* bad value stored as double, since get_badvalue returns a double */
+ double badvalue;
+ int has_badvalue; /* required by pdlapi.c */
+
+ PDL_Indx nvals; /* How many values allocated */
+ int datatype;
+ PDL_Indx *dims; /* Array of data dimensions */
+ PDL_Indx *dimincs; /* Array of data default increments */
+ short ndims; /* Number of data dimensions */
+
+ unsigned char *threadids; /* Starting index of the thread index set n */
+ unsigned char nthreadids;
+
+ /* the progenitor, future_me and living_for members
+ are unused. They are related to one of Tuomas' ideas about
+ pervasive dataflow for PDL and the concept of families that
+ he thought up. This was never implemented and Tuomas gave up
+ on the idea (and later PDL as a whole). We keep those members
+ as a hangover for the moment but they might go at a later time
+ -- although that might result in backward compatibility problems
+ */
+
+ pdl *progenitor; /* I'm in a mutated family. make_physical_now must
+ copy me to the new generation. */
+ pdl *future_me; /* I'm the "then" pdl and this is my "now" (or more modern
+ version, anyway */
+
+ pdl_children children;
+
+#define PDL_LIVINGFOR_FAMILY_NEWPROGENITOR 0x0002
+#define PDL_LIVINGFOR_FAMILY_NEWMUTATED 0x0004
+#define PDL_LIVINGFOR_FAMILY_SRCFORMUTATION 0x0008
+ short living_for; /* perl side not referenced; delete me when */
+
+ PDL_Indx def_dims[PDL_NDIMS]; /* Preallocated space for efficiency */
+ PDL_Indx def_dimincs[PDL_NDIMS]; /* Preallocated space for efficiency */
+ unsigned char def_threadids[PDL_NTHREADIDS];
+
+ struct pdl_magic *magic;
+
+ void *hdrsv; /* "header", settable from Perl */
+};
+
+
+#define PDL_DECL_CHILDLOOP(p) \
+ int p##__i; pdl_children *p##__c;
+#define PDL_START_CHILDLOOP(p) \
+ p##__c = &p->children; \
+ do { \
+ for(p##__i=0; p##__i<PDL_NCHILDREN; p##__i++) { \
+ if(p##__c->trans[p##__i]) {
+#define PDL_CHILDLOOP_THISCHILD(p) p##__c->trans[p##__i]
+#define PDL_END_CHILDLOOP(p) \
+ } \
+ } \
+ if(!p##__c) break; \
+ if(!p##__c->next) break; \
+ p##__c=p##__c->next; \
+ } while(1);
+
+
+
+#define PDLMAX(a,b) ((a) > (b) ? (a) : (b))
+
+#define DECL_RECURSE_GUARD static int __nrec=0;
+#define START_RECURSE_GUARD __nrec++; if(__nrec > 1000) {__nrec=0; die("PDL:Internal Error: data structure recursion limit exceeded (max 1000 levels)\n\tThis could mean that you have found an infinite-recursion error in PDL, or\n\tthat you are building data structures with very long dataflow dependency\n\tchains. You may want to try using sever() to break the dependency.\n");}
+#define ABORT_RECURSE_GUARD __nrec=0;
+#define END_RECURSE_GUARD __nrec--;
+
+#define PDL_ENSURE_ALLOCATED(it) ( (void)((it->state & PDL_ALLOCATED) || ((pdl_allocdata(it)),1)) )
+#define PDL_ENSURE_VAFFTRANS(it) \
+ ( ((!it->vafftrans) || (it->vafftrans->ndims < it->ndims)) && \
+ (pdl_vafftrans_alloc(it),1) )
+
+/* __PDL_H */
+#endif
+
+!NO!SUBS!
diff --git a/Basic/Core/pdl_hfiles.p b/Basic/Core/pdl_hfiles.p
new file mode 100644
index 0000000..e0f0940
--- /dev/null
+++ b/Basic/Core/pdl_hfiles.p
@@ -0,0 +1,43 @@
+
+use Config;
+$PDL_Indx_type = $Config{'ivtype'};
+warn "Using new 64bit index support\n" if $Config{'ivsize'}==8;
+
+use lib ".";
+require 'Types.pm';
+*T = *PDL::Types::typehash; # Alias
+
+# This file defines things that are in common between
+# pdl.h and pdlsimple.h
+
+$enum = '';
+for (sort { $T{$a}{'numval'}<=>$T{$b}{'numval'} } keys %T) {
+ $enum .= $T{$_}{'sym'}.", ";
+ $typedefs .= "typedef $T{$_}{'realctype'} $T{$_}{'ctype'};\n";
+}
+chop $enum;
+chop $enum;
+
+$PDL_DATATYPES = <<"EOD";
+
+/*****************************************************************************/
+/*** This section of .h file generated automatically - don't edit manually ***/
+
+/* Data types/sizes [must be in order of complexity] */
+
+enum pdl_datatypes { $enum };
+
+/* Define the pdl data types */
+
+$typedefs
+
+/* typedef $PDL_Indx_type PDL_Indx; */
+
+
+/*****************************************************************************/
+
+EOD
+
+$PDL_DATATYPES .= "\n".PDL::Types::typesynonyms()."\n";
+
+1; # OK
diff --git a/Basic/Core/pdlapi.c b/Basic/Core/pdlapi.c
new file mode 100644
index 0000000..3a2dca4
--- /dev/null
+++ b/Basic/Core/pdlapi.c
@@ -0,0 +1,1601 @@
+
+/* pdlapi.c - functions for manipulating pdl structs */
+/* - for a while (up to + including 2.2.1) this file */
+/* created by pdlapi.c.PL [due to bad value code] */
+/* we now have dummy functions so do not need to */
+/* create the file */
+
+#define PDL_CORE /* For certain ifdefs */
+#include "pdl.h" /* Data structure declarations */
+#include "pdlcore.h" /* Core declarations */
+
+/* Uncomment the following if you have core dumps or strange
+ * behaviour - it may reveal the cause by croaking because of
+ * bad magic number.
+ */
+
+/* #define DONT_REALLY_FREE
+ */
+
+/* This define causes the affine transformations not to be
+ * optimized away so $a->slice(...) will always made physical.
+ * Uncommenting this define is not recommended at the moment
+ */
+
+/* #define DONT_OPTIMIZE
+ * #define DONT_VAFFINE
+ */
+
+extern Core PDL;
+
+void pdl__ensure_trans(pdl_trans *trans,int what) ;
+
+static int has_children(pdl *it) {
+ PDL_DECL_CHILDLOOP(it)
+ PDL_START_CHILDLOOP(it)
+ return 1;
+ PDL_END_CHILDLOOP(it)
+ return 0;
+}
+
+static int is_child_of(pdl *it,pdl_trans *trans) {
+ int i;
+ for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++) {
+ if(trans->pdls[i] == it) return 1;
+ }
+ return 0;
+}
+
+static int is_parent_of(pdl *it,pdl_trans *trans) {
+ int i;
+ for(i=0; i<trans->vtable->nparents; i++) {
+ if(trans->pdls[i] == it) return 1;
+ }
+ return 0;
+}
+
+pdl *pdl_null() {
+ PDL_Indx d[1] = {0};
+ pdl *it = pdl_new();
+ pdl_makescratchhash(it,0.0,PDL_B);
+ pdl_setdims(it,d,1);
+ it->state |= PDL_NOMYDIMS;
+ return it;
+}
+
+pdl *pdl_get_convertedpdl(pdl *old,int type) {
+ if(old->datatype != type) {
+ pdl *it;
+ it = pdl_null();
+ PDL.converttypei_new(old,it,type);
+ if(it->datatype != type) { croak("FOOBAR! HELP!\n"); }
+ return it;
+ } else {
+ return old;
+ }
+}
+
+void pdl_allocdata(pdl *it) {
+ int i;
+ PDL_Indx nvals=1;
+ SV *bar;
+ for(i=0; i<it->ndims; i++) {
+ nvals *= it->dims[i];
+ }
+ it->nvals = nvals;
+ PDLDEBUG_f(printf("pdl_allocdata %p, %d, %d\n",(void*)it, it->nvals,
+ it->datatype));
+
+ pdl_grow(it,nvals);
+ PDLDEBUG_f(pdl_dump(it));
+
+ it->state |= PDL_ALLOCATED;
+}
+
+/* Wrapper to pdl_create so that the pdl_new and pdl_tmp functions
+ can be stored in the Core struct and exported to external
+ PDL XS modules */
+pdl* pdl_external_new() {
+ return pdl_new();
+}
+pdl* pdl_external_tmp() {
+ return pdl_tmp();
+}
+/* Return a new pdl - type is PDL_PERM or PDL_TMP - the latter is auto-freed
+ * when current perl context is left
+ *
+ * pdl_new() and pdl_tmp() are macroes defined in pdlcore.h
+ * which just call this routine.
+ */
+
+
+pdl* pdl_create(int type) {
+ int i;
+ pdl* it;
+
+ if(type == PDL_TMP) {croak("PDL internal error. FIX!\n");}
+
+ it = (pdl*) malloc(sizeof(pdl));
+ if (it==NULL)
+ croak("Out of Memory\n");
+
+ it->magicno = PDL_MAGICNO;
+ it->state = 0;
+ it->datatype = 0;
+ it->trans = NULL;
+ it->vafftrans = NULL;
+ it->sv = NULL;
+ it->datasv = 0;
+ it->data = 0;
+ it->has_badvalue = 0;
+
+ it->dims = it->def_dims;
+ it->dimincs = it->def_dimincs;
+ it->ndims = 0;
+
+ it->nthreadids = 0;
+ it->threadids = it->def_threadids;
+ it->threadids[0] = 0;
+
+ for(i=0; i<PDL_NCHILDREN; i++) {it->children.trans[i]=NULL;}
+ it->children.next = NULL;
+
+ it->living_for = 0;
+ it->progenitor = 0;
+ it->future_me = 0;
+
+ it->magic = 0;
+ it->hdrsv = 0;
+
+ PDLDEBUG_f(printf("CREATE %p\n",(void*)it));
+ return it;
+}
+
+/* Explicit free. Do not use, use destroy instead, which causes this
+ to be called when the time is right */
+void pdl__free(pdl *it) {
+ pdl_children *p1,*p2;
+ PDL_CHKMAGIC(it);
+
+ /* now check if magic is still there */
+ if (pdl__ismagic(it)) {
+ PDLDEBUG_f(printf("%p is still magic\n",(void*)it));
+ PDLDEBUG_f(pdl__print_magic(it));
+ }
+
+ it->magicno = 0x42424245;
+ PDLDEBUG_f(printf("FREE %p\n",(void*)it));
+#ifndef DONT_REALLY_FREE
+ if(it->dims != it->def_dims) free((void*)it->dims);
+ if(it->dimincs != it->def_dimincs) free((void*)it->dimincs);
+ if(it->threadids != it->def_threadids) free((void*)it->threadids);
+
+ if(it->vafftrans) {
+ pdl_vafftrans_free(it);
+ }
+
+ p1 = it->children.next;
+ while(p1) {
+ p2 = p1->next;
+ free(p1);
+ p1 = p2;
+ }
+/* Free the phys representation */
+/* XXX MEMLEAK */
+/* it->vtable->freetrans(it,it->trans); */
+
+/* Call special freeing magic, if exists */
+ if(PDL_ISMAGIC(it)) {
+ pdl__call_magic(it, PDL_MAGIC_DELETEDATA);
+ pdl__magic_free(it);
+ }
+
+ if(it->datasv) {
+ SvREFCNT_dec(it->datasv);
+ it->data=0;
+ } else if(it->data) {
+ pdl_warn("Warning: special data without datasv is not freed currently!!");
+ }
+ if(it->hdrsv) {
+ SvREFCNT_dec(it->hdrsv);
+ it->hdrsv = 0;
+ }
+ free(it);
+#endif
+ PDLDEBUG_f(printf("ENDFREE %p\n",(void*)it));
+}
+
+void pdl__destroy_childtranses(pdl *it,int ensure) {
+ PDL_DECL_CHILDLOOP(it);
+ PDL_START_CHILDLOOP(it)
+ pdl_destroytransform(PDL_CHILDLOOP_THISCHILD(it),ensure);
+ PDL_END_CHILDLOOP(it)
+}
+
+/*
+
+ *Note*: the mutator/progenitor/family stuff is disabled and will
+ be ignored for the foreseeable future.
+
+ A piddle may be
+ - a parent of something - just ensure & destroy
+ - a child of something - just ensure & destroy
+ - parent of two pdls which both propagate backwards - mustn't destroy.
+ - both parent and child at same time, to something that propagates.
+ Therefore, simple rules:
+ - allowed to destroy if
+ 1. a parent with max. 1 backwards propagating transformation
+ 2. a child with no children & this is not the mutator of the family
+ (otherwise the mutator might be my child).
+
+ When the mutator or progenitor of a family is destroyed, it must check
+ whether the other is also destroyed and if it is, destroy the family.
+
+ Also, when a piddle is destroyed, it must tell its children and/or
+ parent so that
+
+ XXX Currently, will not destroy if any back-propagating children.
+
+ Family may be destroyed, if either
+ -nothing flowing out, in which case both mutated_to and
+ futureprogenitor hash = 0
+ -nothing flowing in
+
+*/
+void pdl_destroy(pdl *it) {
+ int nback=0,nback2=0,nforw=0,nundest=0,nundestp=0;
+ int nafn=0;
+ pdl_trans *curt;
+ PDL_DECL_CHILDLOOP(it);
+ PDL_CHKMAGIC(it);
+ PDLDEBUG_f(printf("Destr. %p\n",(void*)it);)
+ if(it->state & PDL_DESTROYING) {
+ PDLDEBUG_f(printf("Already Destr. %p\n",(void*)it);)
+ return;
+ }
+ it->state |= PDL_DESTROYING;
+ /* Clear the sv field so that there will be no dangling ptrs */
+ if(it->sv) {
+ sv_setiv(it->sv,0x4242);
+ it->sv = NULL;
+ }
+
+ /* the progenitor etc stuff is not really implemented
+ so we comment it out; this should not affect anything
+ -- we'll see ;)
+ Note: the memleak comment refers to the original code
+ which is now disabled!
+ */
+ /* XXXXXXXXX Shouldn't do this! BAD MEMLEAK */
+ /*
+ if(it->progenitor || it->living_for || it->future_me) {
+ PDLDEBUG_f(printf("Family, not Destr. 0x%x\n",it);)
+ goto soft_destroy;
+ }
+ */
+
+ /* 1. count the children that do flow */
+ PDL_START_CHILDLOOP(it)
+ curt = PDL_CHILDLOOP_THISCHILD(it);
+ if(PDL_CHILDLOOP_THISCHILD(it)->flags & (PDL_ITRANS_DO_DATAFLOW_F|
+ PDL_ITRANS_DO_DATAFLOW_B))
+ nforw ++;
+ if(PDL_CHILDLOOP_THISCHILD(it)->flags & PDL_ITRANS_DO_DATAFLOW_B)
+ {
+ nback ++;
+ /* Cases where more than two in relationship
+ * must always be soft-destroyed */
+ if(curt->vtable->npdls > 2) nback2++;
+ }
+ if(PDL_CHILDLOOP_THISCHILD(it)->flags & PDL_ITRANS_FORFAMILY)
+ nundest ++;
+/* pdl_make_physdims(PDL_CHILDLOOP_THISCHILD(it); */
+ if(PDL_CHILDLOOP_THISCHILD(it)->flags & PDL_ITRANS_ISAFFINE) {
+ if(!(curt->pdls[1]->state & PDL_ALLOCATED)) {
+ nafn ++;
+ }
+ }
+ PDL_END_CHILDLOOP(it)
+
+ if(it->trans && (it->trans->flags & PDL_ITRANS_FORFAMILY))
+ nundestp ++;
+
+/* XXX FIX */
+ if(nundest || nundestp) goto soft_destroy;
+
+/* First case where we may not destroy */
+ if(nback2 > 0) goto soft_destroy;
+ if(nback > 1) goto soft_destroy;
+
+/* Also not here */
+ if(it->trans && nforw) goto soft_destroy;
+
+/* Also, we do not wish to destroy if the children would be larger
+ * than the parent and are currently not allocated (e.g. lags).
+ * Because this is too much work to check, we refrain from destroying
+ * for now if there is an affine child that is not allocated
+ */
+ if(nafn) goto soft_destroy;
+ if(pdl__magic_isundestroyable(it)) {
+ PDLDEBUG_f(printf("Magic, not Destr. %p\n",(void*)it);)
+ goto soft_destroy;
+ }
+
+ pdl__destroy_childtranses(it,1);
+
+ if(it->trans) {
+ PDLDEBUG_f(printf("Destr_trans. %p %d\n",(void*)(it->trans), it->trans->flags);)
+ /* Ensure only if there are other children! */
+ /* XXX Bad: tmp! */
+ if (it->trans->flags & PDL_ITRANS_NONMUTUAL)
+ pdl_destroytransform_nonmutual(it->trans,(it->trans->vtable->npdls
+ - it->trans->vtable->nparents > 1));
+ else
+ pdl_destroytransform(it->trans,(it->trans->vtable->npdls
+ - it->trans->vtable->nparents > 1));
+ }
+
+/* Here, this is a child but has no children */
+ goto hard_destroy;
+
+
+ hard_destroy:
+#ifdef OIFSJEFLESJF
+/* Now, check for progenitor-stuff. */
+ if(it->progenitor) {
+ if(!(it->progenitor->sv)) {
+ pdl__family_destroy_if(it->progenitor);
+ } else
+ goto soft_destroy;
+ } else if(it->living_for) {
+ pdl__family_fut_destroy_if(it);
+ }
+#endif
+
+/* ... and now we drink */
+ pdl__free(it);
+ PDLDEBUG_f(printf("End destroy %p\n",(void*)it);)
+
+ return;
+
+ soft_destroy:
+ PDLDEBUG_f(printf("May have dependencies, not destr. %p, nu(%d, %d), nba(%d, %d), nforw(%d), tra(%p), nafn(%d)\n",
+ (void*)it, nundest, nundestp, nback, nback2, nforw, (void*)(it->trans), nafn);)
+ it->state &= ~PDL_DESTROYING;
+}
+
+
+/* Straight copy, no dataflow */
+pdl *pdl_hard_copy(pdl *src) {
+ int i;
+ pdl *it = pdl_null();
+ it->state = 0;
+
+ pdl_make_physical(src); /* Wasteful XXX... should be lazier */
+
+ it->datatype = src->datatype;
+
+ pdl_setdims(it,src->dims,src->ndims);
+ pdl_allocdata(it);
+
+ /* null != [0] */
+#ifdef ELIFSLEFJSEFSE
+ if(src->ndims == 1 && src->dims[0] == 0)
+#else
+ if(src->state & PDL_NOMYDIMS)
+#endif
+ it->state |= PDL_NOMYDIMS;
+
+ pdl_reallocthreadids(it,src->nthreadids);
+ for(i=0; i<src->nthreadids; i++) {
+ it->threadids[i] = src->threadids[i];
+ }
+
+ memcpy(it->data,src->data, pdl_howbig(it->datatype) * it->nvals);
+
+ return it;
+
+}
+
+/* some constants for the dump_XXX routines */
+#define PDL_FLAGS_TRANS 0
+#define PDL_FLAGS_PDL 1
+#define PDL_MAXSPACE 256 /* maximal number of prefix spaces in dump routines */
+#define PDL_MAXLIN 60
+void pdl_dump_flags_fixspace(int flags, int nspac, int type)
+{
+ int i;
+ int len, found, sz;
+
+ int pdlflagval[] = {
+ PDL_ALLOCATED,PDL_PARENTDATACHANGED,
+ PDL_PARENTDIMSCHANGED,PDL_PARENTREPRCHANGED,
+ PDL_DATAFLOW_F,PDL_DATAFLOW_B,PDL_NOMYDIMS,
+ PDL_OPT_VAFFTRANSOK,PDL_INPLACE,PDL_DESTROYING,
+ PDL_DONTTOUCHDATA, PDL_MYDIMS_TRANS, PDL_HDRCPY,
+ PDL_BADVAL, PDL_TRACEDEBUG, 0
+ };
+
+ char *pdlflagchar[] = {
+ "ALLOCATED","PARENTDATACHANGED",
+ "PARENTDIMSCHANGED","PARENTREPRCHANGED",
+ "DATAFLOW_F","DATAFLOW_B","NOMYDIMS",
+ "OPT_VAFFTRANSOK","INPLACE","DESTROYING",
+ "DONTTOUCHDATA","MYDIMS_TRANS", "HDRCPY",
+ "BADVAL", "TRACEDEBUG"
+ };
+
+ int transflagval[] = {
+ PDL_ITRANS_REVERSIBLE, PDL_ITRANS_DO_DATAFLOW_F,
+ PDL_ITRANS_DO_DATAFLOW_B, PDL_ITRANS_FORFAMILY,
+ PDL_ITRANS_ISAFFINE, PDL_ITRANS_VAFFINEVALID,
+ PDL_ITRANS_NONMUTUAL, 0
+ };
+
+ char *transflagchar[] = {
+ "REVERSIBLE", "DO_DATAFLOW_F",
+ "DO_DATAFLOW_B", "FORFAMILY",
+ "ISAFFINE", "VAFFINEVALID",
+ "NONMUTUAL"
+ };
+
+ int *flagval;
+ char **flagchar;
+ char spaces[PDL_MAXSPACE];
+ if (nspac >= PDL_MAXSPACE) {
+ printf("too many spaces requested: %d"
+ " (increase PDL_MAXSPACE in pdlapi.c), returning\n",nspac);
+ return;
+ }
+ if (type == PDL_FLAGS_PDL) {
+ flagval = pdlflagval;
+ flagchar = pdlflagchar;
+ } else {
+ flagval = transflagval;
+ flagchar = transflagchar;
+ }
+ for(i=0; i<nspac; i++) spaces[i]=' ';
+ spaces[i] = '\0';
+ sz = 0;
+
+ printf("%sState: (%d) ",spaces,flags);
+ len = 0;
+ found = 0;
+ for (i=0;flagval[i]!=0; i++)
+ if (flags & flagval[i]) {
+ printf("%s%s",found ? "|":"",flagchar[i]);
+ found = 1;
+ sz += strlen(flagchar[i]);
+ if (sz>PDL_MAXLIN) {sz=0; printf("\n %s",spaces);}
+ }
+ printf("\n");
+}
+
+/* Dump a tranformation (don't dump the pdls, just pointers to them */
+void pdl_dump_trans_fixspace (pdl_trans *it, int nspac) {
+ int i;
+ char spaces[PDL_MAXSPACE];
+ if (nspac >= PDL_MAXSPACE) {
+ printf("too many spaces requested: %d"
+ " (increase PDL_MAXSPACE in pdlapi.c), returning\n",nspac);
+ return;
+ }
+ for(i=0; i<nspac; i++) spaces[i]=' ';
+ spaces[i] = '\0';
+ printf("%sDUMPTRANS %p (%s)\n",spaces,(void*)it,it->vtable->name);
+ pdl_dump_flags_fixspace(it->flags,nspac+3,PDL_FLAGS_TRANS);
+ if(it->flags & PDL_ITRANS_ISAFFINE) {
+ pdl_trans_affine *foo = (pdl_trans_affine *)it;
+ if(it->pdls[1]->state & PDL_PARENTDIMSCHANGED) {
+ printf("%s AFFINE, BUT DIMSCHANGED\n",spaces);
+ } else {
+ printf("%s AFFINE: o:%d, i:(",spaces,foo->offs);
+ for(i=0; i<foo->pdls[1]->ndims; i++) {
+ printf("%s%d",(i?" ":""),foo->incs[i]);
+ }
+ printf(") d:(");
+ for(i=0; i<foo->pdls[1]->ndims; i++) {
+ printf("%s%d",(i?" ":""),foo->pdls[1]->dims[i]);
+ }
+ printf(")\n");
+ }
+ }
+/* if(it->vtable->dump) {it->vtable->dump(it);} */
+ printf("%s INPUTS: (",spaces);
+ for(i=0; i<it->vtable->nparents; i++)
+ printf("%s%p",(i?" ":""),(void*)(it->pdls[i]));
+ printf(") OUTPUTS: (");
+ for(;i<it->vtable->npdls; i++)
+ printf("%s%p",(i?" ":""),(void*)(it->pdls[i]));
+ printf(")\n");
+}
+
+void pdl_dump_fixspace(pdl *it,int nspac)
+{
+ PDL_DECL_CHILDLOOP(it)
+ int i;
+ char spaces[PDL_MAXSPACE];
+ if (nspac >= PDL_MAXSPACE) {
+ printf("too many spaces requested: %d"
+ " (increase PDL_MAXSPACE in pdlapi.c), returning\n",nspac);
+ return;
+ }
+ for(i=0; i<nspac; i++) spaces[i]=' ';
+ spaces[i] = '\0';
+ printf("%sDUMPING %p datatype: %d\n",spaces,(void*)it,it->datatype);
+ pdl_dump_flags_fixspace(it->state,nspac+3,PDL_FLAGS_PDL);
+ printf("%s transvtable: %p, trans: %p, sv: %p\n",spaces,
+ (void*)(it->trans?it->trans->vtable:0), (void*)(it->trans), (void*)(it->sv));
+ if(it->datasv) {
+ printf("%s Data SV: %p, Svlen: %d, data: %p, nvals: %d\n", spaces,
+ (void*)(it->datasv), (int)SvCUR((SV*)it->datasv), (void*)(it->data), it->nvals);
+ }
+ printf("%s Dims: %p (",spaces,(void*)(it->dims));
+ for(i=0; i<it->ndims; i++) {
+ printf("%s%d",(i?" ":""),it->dims[i]);
+ };
+ printf(")\n%s ThreadIds: %p (",spaces,(void*)(it->threadids));
+ for(i=0; i<it->nthreadids+1; i++) {
+ printf("%s%d",(i?" ":""),it->threadids[i]);
+ }
+ if(PDL_VAFFOK(it)) {
+ printf(")\n%s Vaffine ok: %p (parent), o:%d, i:(",
+ spaces,(void*)(it->vafftrans->from),it->vafftrans->offs);
+ for(i=0; i<it->ndims; i++) {
+ printf("%s%d",(i?" ":""),it->vafftrans->incs[i]);
+ }
+ }
+ if(it->state & PDL_ALLOCATED) {
+ printf(")\n%s First values: (",spaces);
+ for(i=0; i<it->nvals && i<10; i++) {
+ printf("%s%f",(i?" ":""),pdl_get_offs(it,i));
+ }
+ } else {
+ printf(")\n%s (not allocated",spaces);
+ }
+ printf(")\n");
+ if(it->trans) {
+ pdl_dump_trans_fixspace(it->trans,nspac+3);
+ }
+ printf("%s CHILDREN:\n",spaces);
+ PDL_START_CHILDLOOP(it)
+ pdl_dump_trans_fixspace(PDL_CHILDLOOP_THISCHILD(it),nspac+4);
+ PDL_END_CHILDLOOP(it)
+ /* XXX phys etc. also */
+}
+
+void pdl_dump (pdl *it) {
+ pdl_dump_fixspace(it,0);
+}
+
+
+/* Reallocate this PDL to have ndims dimensions. The previous dims
+ are copied. */
+
+void pdl_reallocdims(pdl *it,int ndims) {
+ int i;
+ if (it->ndims < ndims) { /* Need to realloc for more */
+ if(it->dims != it->def_dims) free(it->dims);
+ if(it->dimincs != it->def_dimincs) free(it->dimincs);
+ if (ndims>PDL_NDIMS) { /* Need to malloc */
+ it->dims = malloc(ndims*sizeof(*(it->dims)));
+ it->dimincs = malloc(ndims*sizeof(*(it->dimincs)));
+ if (it->dims==NULL || it->dimincs==NULL)
+ croak("Out of Memory\n");
+ }
+ else {
+ it->dims = it->def_dims;
+ it->dimincs = it->def_dimincs;
+ }
+ }
+ it->ndims = ndims;
+}
+
+/* Reallocate n threadids. Set the new extra ones to the end */
+/* XXX Check logic */
+void pdl_reallocthreadids(pdl *it,int n) {
+ int i;
+ unsigned char *olds; int nold;
+ if(n <= it->nthreadids) {
+ it->nthreadids = n; it->threadids[n] = it->ndims; return;
+ }
+ nold = it->nthreadids; olds = it->threadids;
+ if(n >= PDL_NTHREADIDS-1) {
+ it->threadids = malloc(sizeof(*(it->threadids))*(n+1));
+ } else {
+ /* already is default */
+ }
+ it->nthreadids = n;
+
+ if(it->threadids != olds) {
+ for(i=0; i<nold && i<n; i++)
+ it->threadids[i] = olds[i];
+ }
+ if(olds != it->def_threadids) { free(olds); }
+
+ for(i=nold; i<it->nthreadids; i++) {
+ it->threadids[i] = it->ndims;
+ }
+}
+
+/* Calculate default increments and grow the PDL data */
+
+void pdl_resize_defaultincs(pdl *it) {
+ PDL_Indx inc = 1;
+ int i=0;
+ for(i=0; i<it->ndims; i++) {
+ it->dimincs[i] = inc; inc *= it->dims[i];
+ }
+ it->nvals = inc;
+ it->state &= ~PDL_ALLOCATED; /* Need to realloc when phys */
+#ifdef DONT_OPTIMIZE
+ pdl_allocdata(it);
+#endif
+}
+
+/* Init dims & incs - if *incs is NULL ignored (but space is always same for both) */
+
+void pdl_setdims(pdl* it, PDL_Indx * dims, int ndims) {
+ int i;
+
+ pdl_reallocdims(it,ndims);
+
+ for(i=0; i<ndims; i++)
+ it->dims[i] = dims[i];
+
+ pdl_resize_defaultincs(it);
+
+ pdl_reallocthreadids(it,0); /* XXX Maybe trouble */
+}
+
+/* This is *not* careful! */
+void pdl_setdims_careful(pdl *it)
+{
+ pdl_resize_defaultincs(it);
+#ifdef DONT_OPTIMIZE
+ pdl_allocdata(it);
+#endif
+ pdl_reallocthreadids(it,0); /* XXX For now */
+}
+
+void pdl_print(pdl *it) {
+#ifdef FOO
+ int i;
+ printf("PDL %d: sv = %d, data = %d, datatype = %d, nvals = %d, ndims = %d\n",
+ (int)it, (int)(it->hash), (int)(it->data), it->datatype, it->nvals, it->ndims);
+ printf("Dims: ");
+ for(i=0; i<it->ndims; i++) {
+ printf("%d(%d) ",it->dims[i],it->dimincs[i]);
+ }
+ printf("\n");
+#endif
+}
+
+/* pdl_get is now vaffine aware */
+double pdl_get(pdl *it,PDL_Indx *inds) {
+ int i;
+ PDL_Indx *incs;
+ PDL_Indx offs=PDL_REPROFFS(it);
+ incs = PDL_VAFFOK(it) ? it->vafftrans->incs : it->dimincs;
+ for(i=0; i<it->ndims; i++)
+ offs += incs[i] * inds[i];
+ return pdl_get_offs(PDL_REPRP(it),offs);
+}
+
+double pdl_get_offs(pdl *it, PDL_Indx offs) {
+ PDL_Indx dummy1=offs+1; PDL_Indx dummy2=1;
+ return pdl_at(it->data, it->datatype, &offs, &dummy1, &dummy2, 0, 1);
+}
+
+void pdl_put_offs(pdl *it, PDL_Indx offs, double value) {
+ PDL_Indx dummy1=offs+1; PDL_Indx dummy2=1;
+ pdl_set(it->data, it->datatype, &offs, &dummy1, &dummy2, 0, 1, value);
+}
+
+
+void pdl__addchildtrans(pdl *it,pdl_trans *trans,int nth)
+{
+ int i; pdl_children *c;
+ trans->pdls[nth] = it;
+ c = &it->children;
+ do {
+ for(i=0; i<PDL_NCHILDREN; i++) {
+ if(! c->trans[i]) {
+ c->trans[i] = trans; return;
+ }
+ }
+ if(!c->next) break;
+ c=c->next;
+ } while(1) ;
+ c->next = malloc(sizeof(pdl_children));
+ c->next->trans[0] = trans;
+ for(i=1; i<PDL_NCHILDREN; i++)
+ c->next->trans[i] = 0;
+ c->next->next = 0;
+}
+
+/* Problem with this function: when transformation is destroyed,
+ * there may be several different children with the same name.
+ * Therefore, we cannot croak :(
+ */
+void pdl__removechildtrans(pdl *it,pdl_trans *trans,int nth,int all)
+{
+ int i; pdl_children *c; int flag = 0;
+ if(all) {
+ for(i=0; i<trans->vtable->nparents; i++)
+ if(trans->pdls[i] == it)
+ trans->pdls[i] = NULL;
+ } else {
+ trans->pdls[nth] = 0;
+ }
+ c = &it->children;
+ do {
+ for(i=0; i<PDL_NCHILDREN; i++) {
+ if(c->trans[i] == trans) {
+ c->trans[i] = NULL;
+ flag = 1;
+ if(!all) return;
+ /* return; Cannot return; might be many times
+ (e.g. $a+$a) */
+ }
+ }
+ c=c->next;
+ } while(c);
+ /* this might be due to a croak when performing the trans; so
+ warn only for now, otherwise we leave trans undestructed ! */
+ if(!flag)
+ pdl_warn("Child not found for pdl %d, %d\n",it, trans);
+}
+
+void pdl__removeparenttrans(pdl *it, pdl_trans *trans, int nth)
+{
+ trans->pdls[nth] = 0;
+ it->trans = 0;
+}
+
+void pdl_make_physdims(pdl *it) {
+ int i;
+ int c = (it->state & (PDL_PARENTDIMSCHANGED | PDL_PARENTREPRCHANGED)) ;
+ PDLDEBUG_f(printf("Make_physdims %p\n",(void*)it));
+ PDL_CHKMAGIC(it);
+ if(!(it->state & (PDL_PARENTDIMSCHANGED | PDL_PARENTREPRCHANGED))) {
+ PDLDEBUG_f(printf("Make_physdims_exit (NOP) %p\n",(void*)it));
+ return;
+ }
+ it->state &= ~(PDL_PARENTDIMSCHANGED | PDL_PARENTREPRCHANGED);
+ /* the fact that a PARENTXXXCHANGED flag is set seems
+ to imply that this pdl has an associated trans ? */
+ for(i=0; i<it->trans->vtable->nparents; i++) {
+ pdl_make_physdims(it->trans->pdls[i]);
+ }
+ /* doesn't this mean that all children of this trans have
+ now their dims set and accordingly all those flags should
+ be reset? Otherwise redodims will be called for them again? */
+ PDLDEBUG_f(printf("Make_physdims: calling redodims %p on %p\n",
+ (void*)(it->trans),(void*)it));
+ it->trans->vtable->redodims(it->trans);
+ /* why this one? will the old allocated data be freed correctly? */
+ if((c & PDL_PARENTDIMSCHANGED) && (it->state & PDL_ALLOCATED)) {
+ it->state &= ~PDL_ALLOCATED;
+ }
+ PDLDEBUG_f(printf("Make_physdims_exit %p\n",(void*)it));
+}
+
+void pdl_writeover(pdl *it) {
+ pdl_make_physdims(it);
+ pdl_children_changesoon(it,PDL_PARENTDATACHANGED);
+ it->state &= ~PDL_PARENTDATACHANGED;
+}
+
+/* Order is important: do childtrans first, then parentrans. */
+
+void pdl_set_trans_childtrans(pdl *it, pdl_trans *trans,int nth)
+{
+ pdl__addchildtrans(it,trans,nth);
+/* Determine if we want to do dataflow */
+ if(it->state & PDL_DATAFLOW_F)
+ trans->flags |= PDL_ITRANS_DO_DATAFLOW_F;
+ if(it->state & PDL_DATAFLOW_B)
+ trans->flags |= PDL_ITRANS_DO_DATAFLOW_B;
+}
+
+/* This is because for "+=" (a = a + b) we must check for
+ previous parent transformations and mutate if they exist
+ if no dataflow. */
+
+void pdl_set_trans_parenttrans(pdl *it, pdl_trans *trans,int nth)
+{
+ int i; int nthind;
+ if((it->trans || is_parent_of(it,trans))
+ /* && (it->state & PDL_DATAFLOW_F) */ ) {
+ /* XXX What if in several places */
+ nthind=-1;
+ for(i=0; i<trans->vtable->nparents; i++)
+ if(trans->pdls[i] == it) nthind = i;
+ croak("Sorry, families not allowed now (i.e. You cannot modify dataflowing pdl)\n");
+ /* pdl_family_create(it,trans,nthind,nth); */
+ } else {
+ it->trans = trans;
+ it->state |= PDL_PARENTDIMSCHANGED | PDL_PARENTDATACHANGED ;
+ trans->pdls[nth] = it;
+#ifdef FOOBARBAR
+ if(trans->flags & PDL_ITRANS_DO_DATAFLOW_F)
+ it->state |= PDL_DATAFLOW_F;
+ if(trans->flags & PDL_ITRANS_DO_DATAFLOW_B)
+ it->state |= PDL_DATAFLOW_B;
+#endif
+ }
+}
+
+/* Called with a filled pdl_trans struct.
+ * Sets the parent and trans fields of the piddles correctly,
+ * creating families and the like if necessary.
+ * Alternatively may just execute transformation
+ * that would require families but is not dataflown.
+ */
+void pdl_make_trans_mutual(pdl_trans *trans)
+{
+ int i;
+ int fflag=0;
+ int cfflag=0;
+ int pfflag=0;
+ PDL_TR_CHKMAGIC(trans);
+
+/* Then, set our children. This is: */
+/* First, determine whether any of our children already have
+ * a parent, and whether they need to be updated. If this is
+ * the case, we need to do some thinking. */
+
+ PDLDEBUG_f(printf("make_trans_mutual %p\n",(void*)trans));
+ for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++) {
+ if(trans->pdls[i]->trans) fflag ++;
+ if(trans->pdls[i]->state & PDL_DATAFLOW_ANY) cfflag++;
+ }
+ for(i=0; i<trans->vtable->nparents; i++)
+ if(trans->pdls[i]->state & PDL_DATAFLOW_ANY)
+ pfflag++;
+
+/* If children are flowing, croak. It's too difficult to handle
+ * properly */
+
+ if(cfflag)
+ croak("Sorry, cannot flowing families right now\n");
+
+/* Same, if children have trans yet parents are flowing */
+ if(pfflag && fflag)
+ croak("Sorry, cannot flowing families right now (2)\n");
+
+/* Now, if parents are not flowing, just execute the transformation */
+
+ if(!pfflag && !(trans->flags & PDL_ITRANS_DO_DATAFLOW_ANY)) {
+ int *wd = malloc(sizeof(int) * trans->vtable->npdls);
+
+ /* mark this transform as non mutual in case we croak during
+ ensuring it */
+ trans->flags |= PDL_ITRANS_NONMUTUAL;
+ for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++) {
+ pdl_children_changesoon(trans->pdls[i],
+ wd[i]=(trans->pdls[i]->state & PDL_NOMYDIMS ?
+ PDL_PARENTDIMSCHANGED : PDL_PARENTDATACHANGED));
+ }
+ /* mark all pdls that have been given as nulls (PDL_NOMYDIMS)
+ as getting their dims from this trans */
+ for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++) {
+ if(trans->pdls[i]->state & PDL_NOMYDIMS) {
+ trans->pdls[i]->state &= ~PDL_NOMYDIMS;
+ trans->pdls[i]->state |= PDL_MYDIMS_TRANS;
+ trans->pdls[i]->trans = trans;
+ }
+ }
+#ifdef BARBARBAR /* Not done */
+ for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++)
+ trans->pdls[i]->state |=
+ PDL_PARENTDIMSCHANGED | PDL_PARENTDATACHANGED;
+#endif
+ if(!trans->vtable) {die("INVALID TRANS: has no vtable!\n");}
+
+ /* now actually perform the transformation, i.e. call
+ transform's redodims and readdata vtable entries
+ */
+ pdl__ensure_trans(trans,PDL_PARENTDIMSCHANGED); /* XXX Why? */
+
+ /* Es ist vollbracht */
+ for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++) {
+#ifndef DONT_VAFFINE
+ if( PDL_VAFFOK(trans->pdls[i]) &&
+ (trans->vtable->per_pdl_flags[i] & PDL_TPDL_VAFFINE_OK) ) {
+ if(wd[i] & PDL_PARENTDIMSCHANGED)
+ pdl_changed(trans->pdls[i],
+ PDL_PARENTDIMSCHANGED,0);
+ pdl_vaffinechanged(
+ trans->pdls[i],PDL_PARENTDATACHANGED);
+ } else
+#endif
+ pdl_changed(trans->pdls[i],wd[i],0);
+ }
+ pdl_destroytransform_nonmutual(trans,0);
+ free(wd);
+ } else { /* do the full flowing transform */
+
+ PDLDEBUG_f(printf("make_trans_mutual flowing!\n"));
+ for(i=0; i<trans->vtable->nparents; i++)
+ pdl_set_trans_childtrans(trans->pdls[i],trans,i);
+ for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++)
+ pdl_set_trans_parenttrans(trans->pdls[i],trans,i);
+ if(!(trans->flags & PDL_ITRANS_REVERSIBLE))
+ trans->flags &= ~PDL_ITRANS_DO_DATAFLOW_B;
+ for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++) {
+ if(trans->pdls[i]->state & PDL_NOMYDIMS) {
+ trans->pdls[i]->state &= ~PDL_NOMYDIMS;
+ trans->pdls[i]->state |= PDL_MYDIMS_TRANS;
+ }
+ }
+ }
+
+#ifdef FOO
+/* If we are not flowing, we must disappear */
+ if(!(trans->flags & PDL_ITRANS_DO_DATAFLOW_ANY)) {
+ pdl_destroytransform(trans,1);
+ }
+#endif
+
+ PDLDEBUG_f(printf("make_trans_mutual_exit %p\n",(void*)trans));
+
+} /* pdl_make_trans_mutual() */
+
+
+pdl *pdl_make_now(pdl *it) {
+ return it;
+ /* the family stuff is not really implemented
+ so we'll ignore it and get rid of pdlfamily.c
+ if(it->future_me) return it->future_me;
+ if(!it->progenitor) return it;
+ return pdl_family_clone2now(it);
+ */
+}
+
+void pdl_make_physical(pdl *it) {
+ int i, vaffinepar=0;
+ DECL_RECURSE_GUARD;
+
+ PDLDEBUG_f(printf("Make_physical %p\n",(void*)it));
+ PDL_CHKMAGIC(it);
+
+ START_RECURSE_GUARD;
+ if(it->state & PDL_ALLOCATED && !(it->state & PDL_ANYCHANGED)) {
+ goto mkphys_end;
+ }
+ if(!(it->state & PDL_ANYCHANGED)) {
+ pdl_allocdata(it);
+ goto mkphys_end;
+ }
+ if(!it->trans) {
+ ABORT_RECURSE_GUARD;
+ die("PDL Not physical but doesn't have parent");
+ }
+#ifndef DONT_OPTIMIZE
+#ifndef DONT_VAFFINE
+ if(it->trans->flags & PDL_ITRANS_ISAFFINE) {
+ if(!PDL_VAFFOK(it))
+ pdl_make_physvaffine(it);
+ }
+ if(PDL_VAFFOK(it)) {
+ PDLDEBUG_f(printf("Make_phys: VAFFOK\n"));
+ pdl_readdata_vaffine(it);
+ it->state &= (~PDL_ANYCHANGED);
+ PDLDEBUG_f(pdl_dump(it));
+ goto mkphys_end;
+ }
+#endif
+#endif
+ PDL_TR_CHKMAGIC(it->trans);
+ for(i=0; i<it->trans->vtable->nparents; i++) {
+#ifndef DONT_OPTIMIZE
+#ifndef DONT_VAFFINE
+ if(it->trans->vtable->per_pdl_flags[i] &
+ PDL_TPDL_VAFFINE_OK) {
+ pdl_make_physvaffine(it->trans->pdls[i]);
+ /* check if any of the parents is a vaffine */
+ vaffinepar = vaffinepar || (it->trans->pdls[i]->data != PDL_REPRP(it->trans->pdls[i]));
+ }
+ else
+#endif
+#endif
+ pdl_make_physical(it->trans->pdls[i]);
+ }
+ /* the next one is really strange:
+ *
+ * why do we need to call redodims if !(it->state & PDL_ALLOCATED) ???
+ * this results in a) redodims called twice if make_physdims had already been
+ * called for this piddle and results in associated memory leaks!
+ * On the other hand, if I comment out !(it->state & PDL_ALLOCATED)
+ * then we get errors for cases like
+ * $in = $lut->xchg(0,1)->index($im->dummy(0));
+ * $in .= pdl -5;
+ * Currently ugly fix: detect in initthreadstruct that it has been called before
+ * and free all pdl_thread related memory before reallocating
+ * NOTE: this does not catch leaks when additional memory was allocated from with
+ * redodims!!!!!
+ *
+ * The real question is: why do we need another call to
+ * redodims if !(it->state & PDL_ALLOCATED)??????
+ * changed it so that redodims only called if
+ * (!(it->state & PDL_ALLOCATED) && vaffinepar)
+ * i.e. at least one of the parent piddles is a real vaffine
+ * CS
+ */
+ if((!(it->state & PDL_ALLOCATED) && vaffinepar) ||
+ it->state & PDL_PARENTDIMSCHANGED ||
+ it->state & PDL_PARENTREPRCHANGED) {
+ it->trans->vtable->redodims(it->trans);
+ }
+ if(!(it->state & PDL_ALLOCATED)) {
+ pdl_allocdata(it);
+ }
+ /* Make parents physical first. XXX Needs more reasonable way */
+ /* Already done
+ * for(i=0; i<it->trans->vtable->nparents; i++) {
+ * pdl_make_physical(it->trans->pdls[i]);
+ * }
+ */
+ /*
+ * We think we made them physical or physvaffine already...
+ * for(i=0; i<it->trans->vtable->npdls; i++) {
+ * if(!(it->trans->pdls[i]->state & PDL_ALLOCATED)) {
+ * croak("Trying to readdata without physicality");
+ * }
+ *}
+ */
+ it->trans->vtable->readdata(it->trans);
+ it->state &= (~PDL_ANYCHANGED) & (~PDL_OPT_ANY_OK);
+
+ mkphys_end:
+ PDLDEBUG_f(printf("Make_physical_exit %p\n",(void*)it));
+ END_RECURSE_GUARD;
+}
+
+void pdl_children_changesoon_c(pdl *it,int what)
+{
+ pdl_trans *t;
+ int i;
+ PDL_DECL_CHILDLOOP(it);
+ PDL_START_CHILDLOOP(it)
+ t = PDL_CHILDLOOP_THISCHILD(it);
+ if(!(t->flags & PDL_ITRANS_DO_DATAFLOW_F)) {
+ pdl_destroytransform(t,1);
+ } else {
+ for(i=t->vtable->nparents; i<t->vtable->npdls; i++) {
+ pdl_children_changesoon_c(t->pdls[i],what);
+ }
+ }
+ PDL_END_CHILDLOOP(it)
+}
+
+/* Change soon: if this is not writeback, separate from
+ parent.
+ If the children of this are not writeback, separate them.
+ */
+
+void pdl_children_changesoon(pdl *it, int what)
+{
+ pdl_children *c; int i;
+ if(it->trans &&
+ !(it->trans->flags & PDL_ITRANS_DO_DATAFLOW_B)) {
+ pdl_destroytransform(it->trans,1);
+ } else if(it->trans) {
+ if(!(it->trans->flags & PDL_ITRANS_REVERSIBLE)) {
+ die("PDL: Internal error: Trying to reverse irreversible trans");
+ }
+ for(i=0; i<it->trans->vtable->nparents; i++)
+ pdl_children_changesoon(it->trans->pdls[i],what);
+ return;
+ }
+ pdl_children_changesoon_c(it,what);
+}
+
+/* what should always be PARENTDATA */
+void pdl_vaffinechanged(pdl *it, int what)
+{
+ if(!PDL_VAFFOK(it)) {
+ croak("Vaffine not ok!, trying to use vaffinechanged");
+ }
+ PDLDEBUG_f(printf("pdl_vaffinechanged: writing back data, triggered by pdl %p, using parent %p\n",(void*)it,(void*)(it->vafftrans->from)));
+ pdl_changed(it->vafftrans->from,what,0);
+}
+
+/* This is inefficient: _changed writes back, which it really should not,
+ before a parent is used (?). */
+void pdl_changed(pdl *it, int what, int recursing)
+{
+ pdl_children *c; int i; int j;
+
+ PDLDEBUG_f(
+ printf("pdl_changed: entry for pdl %p, what %d, recursing: %d\n",
+ (void*)it,what,recursing);
+ if (it->state & PDL_TRACEDEBUG)
+ pdl_dump(it);
+ );
+
+/* XXX This might save time but is actually unsafe:
+ * if a -> b -> c, and c made physical and a changed again,
+ * the changedness doesn't propagate to c */
+/* if((it->state & what) == what) { return; } */
+ if(recursing) {
+ it->state |= what;
+ /* The next one is commented out since it breaks
+ PP functions with more (1) than 1 output arg
+ (i.e. more than 2 children) (2) that are called
+ with chained slices of the same parent
+ and (3) require these args to be physicalized
+ An example of this scenario (which actually
+ occurred first in actual code with complex
+ numbers) is in t/pptest.t (at the end).
+
+ Presumably the bit of code below that unsets the
+ vafftransok flag was only inserted
+ to make the 'foomethod' example work. It
+ explores changing parameters of a transformation
+ and making sure that everything flows correctly.
+
+ Based on this idea removing the statement below should
+ not break anything and fix the problem with
+ PP funcs described above (CS 190403) */
+ /* it->state &= ~PDL_OPT_VAFFTRANSOK; */
+ if(pdl__ismagic(it))
+ pdl__call_magic(it,PDL_MAGIC_MARKCHANGED);
+ }
+ if(it->trans && !recursing && (it->trans->flags & PDL_ITRANS_DO_DATAFLOW_B)) {
+ if((it->trans->flags & PDL_ITRANS_ISAFFINE) &&
+ (PDL_VAFFOK(it))) {
+ PDLDEBUG_f(printf("pdl_changed: calling writebackdata_vaffine (pdl %p)\n",(void*)it));
+ pdl_writebackdata_vaffine(it);
+ pdl_changed(it->vafftrans->from,what,0);
+ } else {
+ if(!it->trans->vtable->writebackdata) {
+ die("Internal error: got so close to reversing irrev.");
+ }
+ PDLDEBUG_f(printf("pdl_changed: calling writebackdata from vtable, triggered by pdl %p, using trans %p\n",(void*)it,(void*)(it->trans)));
+ it->trans->vtable->writebackdata(it->trans);
+ for(i=0; i<it->trans->vtable->nparents; i++) {
+ if((it->trans->vtable->per_pdl_flags[i] &
+ PDL_TPDL_VAFFINE_OK) &&
+ (it->trans->pdls[i]->trans) &&
+ (it->trans->pdls[i]->trans->flags & PDL_ITRANS_ISAFFINE) &&
+ (PDL_VAFFOK(it->trans->pdls[i]))
+ ) {
+ pdl_changed(it->trans->pdls[i]->vafftrans->from,what,0);
+ } else {
+ pdl_changed(it->trans->pdls[i],what,0);
+ }
+ }
+ }
+ } else {
+ c=&it->children;
+ do {
+ for(i=0; i<PDL_NCHILDREN; i++) {
+ if(c->trans[i]) {
+ for(j=c->trans[i]->vtable->nparents;
+ j<c->trans[i]->vtable->npdls;
+ j++) {
+ pdl_changed(c->trans[i]->pdls[j],what,1);
+ }
+ }
+ }
+ c=c->next;
+ } while(c);
+ }
+ PDLDEBUG_f(printf("pdl_changed: exiting for pdl %p\n",(void*)it));
+}
+
+/* This transformation changes soon, so make sure the children
+ * who don't flow go away
+ * XXX Should be able to specify which children. */
+void pdl_trans_changesoon(pdl_trans *trans,int what)
+{
+ int i;
+ for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++) {
+ pdl_children_changesoon_c(trans->pdls[i],what);
+ }
+}
+
+/* Changed, just propagate changes to children
+ * XXX should be able to specify which children */
+void pdl_trans_changed(pdl_trans *trans,int what)
+{
+ int i;
+ for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++) {
+ pdl_changed(trans->pdls[i],what,1);
+ }
+}
+
+/* Make sure transformation is done */
+void pdl__ensure_trans(pdl_trans *trans,int what)
+{
+ int j;
+/* Make parents physical */
+ int flag=0;
+ int par_pvaf=0;
+ flag |= what;
+
+ PDL_TR_CHKMAGIC(trans);
+
+ for(j=0; j<trans->vtable->nparents; j++) {
+#ifndef DONT_OPTIMIZE
+#ifndef DONT_VAFFINE
+ if(trans->vtable->per_pdl_flags[j] &
+ PDL_TPDL_VAFFINE_OK) {
+ par_pvaf++;
+ if(!trans->pdls[j]) {return;} /* XXX!!! */
+ pdl_make_physvaffine(trans->pdls[j]);
+ } else {
+#endif
+#endif
+ if(!trans->pdls[j]) {return;} /* XXX!!! */
+ pdl_make_physical(trans->pdls[j]);
+ }
+ }
+
+ for(; j<trans->vtable->npdls; j++) {
+ if(trans->pdls[j]->trans != trans) {
+#ifndef DONT_OPTIMIZE
+#ifndef DONT_VAFFINE
+ if(trans->vtable->per_pdl_flags[j] &
+ PDL_TPDL_VAFFINE_OK) {
+ par_pvaf++;
+ if(!trans->pdls[j]) {return;} /* XXX!!! */
+ pdl_make_physvaffine(trans->pdls[j]);
+ } else
+#endif
+#endif
+ { if(!trans->pdls[j]) {return;} /* XXX!!! */
+ PDLDEBUG_f(printf("not vaffine ok: %d\n",
+ trans->vtable->per_pdl_flags[j]));
+
+ pdl_make_physical(trans->pdls[j]);
+
+ }
+ }
+ flag |= trans->pdls[j]->state & PDL_ANYCHANGED;
+ }
+
+ if(flag & PDL_PARENTDIMSCHANGED) { /* redodims called here... */
+ trans->vtable->redodims(trans);
+ }
+ for(j=0; j<trans->vtable->npdls; j++) {
+ if(trans->pdls[j]->trans == trans)
+ PDL_ENSURE_ALLOCATED(trans->pdls[j]);
+ }
+
+ if(flag & (PDL_PARENTDATACHANGED | PDL_PARENTDIMSCHANGED)) {
+ int i;
+
+ if(par_pvaf && (trans->flags & PDL_ITRANS_ISAFFINE)) {
+ /* Attention: this assumes affine = p2child */
+ /* need to signal that redodims has already been called */
+ /* is it correct to also unset PDL_PARENTREPRCHANGED? */
+ trans->pdls[1]->state &= ~(PDL_PARENTDIMSCHANGED |
+ PDL_PARENTREPRCHANGED);
+ pdl_make_physvaffine(((pdl_trans_affine *)(trans))->pdls[1]);
+ pdl_readdata_vaffine(((pdl_trans_affine *)(trans))->pdls[1]);
+ } else {
+#ifdef DONT_VAFFINE
+ for(i=0; i<trans->vtable->npdls; i++) {
+ if(!(trans->pdls[i]->state & PDL_ALLOCATED)) {
+ croak("Trying to readdata without physicality");
+ }
+ }
+#endif
+ trans->vtable->readdata(trans);
+ }
+ }
+ for(j=trans->vtable->nparents; j<trans->vtable->npdls; j++) {
+ trans->pdls[j]->state &= ~PDL_ANYCHANGED;
+ }
+}
+
+void pdl__ensure_transdims(pdl_trans *trans)
+{
+ int j;
+ int flag=0;
+ PDL_TR_CHKMAGIC(trans);
+ for(j=0; j<trans->vtable->nparents; j++) {
+ pdl_make_physdims(trans->pdls[j]);
+ }
+ trans->vtable->redodims(trans);
+}
+
+/* There is a potential problem here, calling
+ pdl_destroy while the trans structure is not in a defined state.
+ We shall ignore this problem for now and hope it goes away ;)
+ (XXX FIX ME) */
+/* XXX Two next routines are memleaks */
+/* somehow this transform will call (implicitly) redodims twice on
+ an unvaffined pdl; leads to memleak if redodims allocates stuff
+ that is only freed in later call to freefunc */
+void pdl_destroytransform(pdl_trans *trans,int ensure)
+{
+ int j;
+ pdl *foo;
+ pdl *destbuffer[100];
+ int ndest = 0;
+
+ PDLDEBUG_f(printf("entering pdl_destroytransform %p (ensure %d)\n",
+ (void*)trans,ensure));
+ if(100 < trans->vtable->npdls) {
+ die("Huge trans");
+ }
+
+ PDL_TR_CHKMAGIC(trans);
+ if(!trans->vtable) {
+ die("ZERO VTABLE DESTTRAN 0x%p %d\n",trans,ensure);
+ }
+ if(ensure) {
+ PDLDEBUG_f(printf("pdl_destroytransform: ensure\n"));
+ pdl__ensure_trans(trans,0);
+ }
+ for(j=0; j<trans->vtable->nparents; j++) {
+ foo = trans->pdls[j];
+ if(!foo) continue;
+ PDL_CHKMAGIC(foo);
+ PDLDEBUG_f(printf("pdl_removectransform(%p): %p %d\n",
+ (void*)trans, (void*)(trans->pdls[j]), j));
+ pdl__removechildtrans(trans->pdls[j],trans,j,1);
+ if(!(foo->state & PDL_DESTROYING) && !foo->sv) {
+ destbuffer[ndest++] = foo;
+ }
+ }
+ for(; j<trans->vtable->npdls; j++) {
+ foo = trans->pdls[j];
+ PDL_CHKMAGIC(foo);
+ PDLDEBUG_f(printf("pdl_removeptransform(%p): %p %d\n",
+ (void*)trans, (void*)(trans->pdls[j]), j));
+ pdl__removeparenttrans(trans->pdls[j],trans,j);
+ if(foo->vafftrans) {
+ PDLDEBUG_f(printf("pdl_removevafft: %p\n", (void*)foo));
+ pdl_vafftrans_remove(foo);
+ }
+ if(!(foo->state & PDL_DESTROYING) && !foo->sv) {
+ destbuffer[ndest++] = foo;
+ }
+ }
+ PDL_TR_CHKMAGIC(trans);
+ if(trans->vtable->freetrans) {
+ PDLDEBUG_f(printf("call freetrans\n"));
+ trans->vtable->freetrans(trans); /* Free malloced objects */
+ }
+ PDL_TR_CLRMAGIC(trans);
+ trans->vtable = 0; /* Make sure no-one uses this */
+ if(trans->freeproc) {
+ PDLDEBUG_f(printf("call freeproc\n"));
+ trans->freeproc(trans);
+ } else {
+ PDLDEBUG_f(printf("call free\n"));
+ free(trans);
+ }
+
+ for(j=0; j<ndest; j++) {
+ pdl_destroy(destbuffer[j]);
+ }
+
+ PDLDEBUG_f(printf("leaving pdl_destroytransform %p\n", (void*)trans));
+
+}
+
+void pdl_destroytransform_nonmutual(pdl_trans *trans,int ensure)
+{
+ int i;
+
+ PDLDEBUG_f(printf("entering pdl_destroytransform_nonmutual\n"));
+
+ PDL_TR_CHKMAGIC(trans);
+ if(ensure) {
+ pdl__ensure_trans(trans,PDL_PARENTDIMSCHANGED);
+ }
+ PDL_TR_CHKMAGIC(trans);
+ for(i=trans->vtable->nparents; i<trans->vtable->npdls; i++) {
+ trans->pdls[i]->state &= ~PDL_NOMYDIMS;
+ if(trans->pdls[i]->trans == trans)
+ trans->pdls[i]->trans = 0;
+ }
+ PDL_TR_CHKMAGIC(trans);
+ if(trans->vtable->freetrans) {
+ trans->vtable->freetrans(trans);
+ }
+ PDL_TR_CLRMAGIC(trans);
+ trans->vtable = 0; /* Make sure no-one uses this */
+ if(trans->freeproc) {
+ trans->freeproc(trans);
+ } else {
+ free(trans);
+ }
+ PDLDEBUG_f(printf("leaving pdl_destroytransform_nonmutual\n"));
+}
+
+void pdl_trans_mallocfreeproc(struct pdl_trans *tr) {
+ free(tr);
+}
+
+#ifndef DONT_OPTIMIZE
+
+/* Recursive! */
+void pdl_vafftrans_remove(pdl * it)
+{
+ pdl_trans *t; int i;
+ PDL_DECL_CHILDLOOP(it);
+ PDL_START_CHILDLOOP(it)
+ t = PDL_CHILDLOOP_THISCHILD(it);
+ if(t->flags & PDL_ITRANS_ISAFFINE) {
+ for(i=t->vtable->nparents; i<t->vtable->npdls; i++)
+ pdl_vafftrans_remove(t->pdls[i]);
+ }
+ PDL_END_CHILDLOOP(it)
+ pdl_vafftrans_free(it);
+}
+
+void pdl_vafftrans_free(pdl *it)
+{
+ if(it->vafftrans && it->vafftrans->incs)
+ free(it->vafftrans->incs);
+ if(it->vafftrans)
+ free(it->vafftrans);
+ it->vafftrans=0;
+ it->state &= ~PDL_OPT_VAFFTRANSOK;
+}
+
+/* Current assumptions: only
+ * "slice" and "diagonal"-type things supported.
+ *
+ * We need to do careful testing for clump-type things.
+ */
+
+/* pdl_make_physvaffine can be called on *any* pdl -- vaffine or not --
+ it will call make_physical as needed on those
+ this function is the right one to call in any case if you want to
+ make only those physical (i.e. allocating their own data, etc) which
+ have to be and leave those vaffine with updated dims, etc, that do
+ have an appropriate transformation of which they are a child
+
+ should probably have been called make_physcareful to point out what
+ it really does
+*/
+void pdl_make_physvaffine(pdl *it)
+{
+ pdl_trans *t;
+ pdl_trans_affine *at;
+ pdl *parent;
+ pdl *current;
+ int *incsleft = 0;
+ int i,j;
+ PDL_Indx inc;
+ PDL_Indx newinc;
+ int ninced;
+ int flag;
+ int incsign;
+
+ PDLDEBUG_f(printf("Make_physvaffine %p\n",(void*)it));
+
+ pdl_make_physdims(it);
+
+ if(!it->trans) {
+ pdl_make_physical(it);
+ goto mkphys_vaff_end;
+ /* croak("Trying to make physvaffine without parent!\n"); */
+ }
+ if(!(it->trans->flags & PDL_ITRANS_ISAFFINE)) {
+ pdl_make_physical(it);
+ goto mkphys_vaff_end;
+ }
+
+ (void)PDL_ENSURE_VAFFTRANS(it);
+ incsleft = malloc(sizeof(*incsleft)*it->ndims);
+ PDLDEBUG_f(printf("vaff_malloc: got %p\n",(void*)incsleft));
+ for(i=0; i<it->ndims; i++) {
+ it->vafftrans->incs[i] = it->dimincs[i];
+ }
+
+ flag=0;
+ it->vafftrans->offs = 0;
+ t=it->trans;
+ current = it;
+ while(t && (t->flags & PDL_ITRANS_ISAFFINE)) {
+ int cur_offset = 0;
+ at = (pdl_trans_affine *)t;
+ parent = t->pdls[0];
+ /* For all dimensions of the childest piddle */
+ for(i=0; i<it->ndims; i++) {
+ int offset_left = it->vafftrans->offs;
+
+ /* inc = the increment at the current stage */
+ inc = it->vafftrans->incs[i];
+ incsign = (inc >= 0 ? 1:-1);
+ inc= abs(inc);
+ newinc = 0;
+ /* For all dimensions of the current piddle */
+ for(j=current->ndims-1; j>=0 && current->dimincs[j] != 0; j--) {
+ cur_offset = offset_left / current->dimincs[j];
+ offset_left -= cur_offset * current->dimincs[j];
+ if(incsign < 0) {
+ cur_offset = (current->dims[j]-1) - cur_offset;
+ }
+ /* If the absolute value > this so */
+ /* we have a contribution from this dimension */
+ if(inc >= current->dimincs[j]) {
+ /* We used this many of this dim */
+ ninced = inc / current->dimincs[j];
+ if(cur_offset + it->dims[i]*ninced >
+ current->dims[j]) {
+ int foo=
+ (cur_offset + it->dims[i]*ninced)*
+ current->dimincs[j];
+ int k;
+ for(k=j+1; k<current->ndims; k++) {
+ foo -= current->dimincs[k-1] *
+ current->dims[k-1];
+ if(foo<=0) break;
+ if(at->incs[k] !=
+ at->incs[k-1] *
+ current->dims[k-1]) {
+ /* XXXXX */
+ flag=1;
+ /*
+ warn("Illegal vaffine; fix loop to break: %d %d %d k=%d s=%d, (%d+%d*%d>%d) %d %d %d %d.\n",at,current,it,
+ k,incsign,cur_offset,it->dims[i],ninced,current->dims[j],current->dimincs[j],
+ at->incs[k],at->incs[k-1],current->dims[k-1]);
+ */
+ /* croak("Illegal vaffine; fix loop to break.\n"); */
+ }
+ }
+ }
+ newinc += at->incs[j]*ninced;
+ inc %= current->dimincs[j];
+ }
+ }
+ incsleft[i] = incsign*newinc;
+ }
+
+ if(flag) break;
+ for(i=0; i<it->ndims; i++) {
+ it->vafftrans->incs[i] = incsleft[i];
+ }
+ {
+ int offset_left = it->vafftrans->offs;
+ inc = it->vafftrans->offs;
+ newinc = 0;
+ for(j=current->ndims-1; j>=0 && current->dimincs[j] != 0; j--) {
+ cur_offset = offset_left / current->dimincs[j];
+ offset_left -= cur_offset * current->dimincs[j];
+ newinc += at->incs[j]*cur_offset;
+ }
+ it->vafftrans->offs = newinc;
+ it->vafftrans->offs += at->offs;
+ }
+ t = parent->trans;
+ current = parent;
+ }
+ it->vafftrans->from = current;
+ it->state |= PDL_OPT_VAFFTRANSOK;
+ pdl_make_physical(current);
+
+ mkphys_vaff_end:
+ PDLDEBUG_f(printf("vaff_malloc: %p\n",(void*)incsleft));
+ if (incsleft != NULL) free(incsleft);
+ PDLDEBUG_f(printf("Make_physvaffine_exit %p\n",(void*)it));
+
+}
+
+void pdl_vafftrans_alloc(pdl *it)
+{
+ if(!it->vafftrans) {
+ it->vafftrans = malloc(sizeof(*(it->vafftrans)));
+ it->vafftrans->incs = 0;
+ it->vafftrans->ndims = 0;
+ }
+ if(!it->vafftrans->incs || it->vafftrans->ndims < it->ndims ) {
+ if(it->vafftrans->incs) free(it->vafftrans->incs);
+ it->vafftrans->incs = malloc(sizeof(*(it->vafftrans->incs))
+ * it->ndims);
+ it->vafftrans->ndims = it->ndims;
+ }
+}
+
+#endif
diff --git a/Basic/Core/pdlconv.c.PL b/Basic/Core/pdlconv.c.PL
new file mode 100644
index 0000000..77130a5
--- /dev/null
+++ b/Basic/Core/pdlconv.c.PL
@@ -0,0 +1,351 @@
+#
+# Create pdlconv.c
+# - for many different datatypes
+
+use strict;
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+require 'Dev.pm'; PDL::Core::Dev->import;
+use vars qw( %PDL_DATATYPES );
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+my $file;
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($Config{'osname'} eq 'VMS' or
+ $Config{'osname'} eq 'OS2'); # "case-forgiving"
+
+print "Extracting $file\n";
+open OUT,">$file" or die "Can't create $file: $!";
+chmod 0644, $file;
+
+# $date = `date`; chop $date;
+
+##### HEADER ######
+
+print OUT <<"!WITH!SUBS!";
+
+/***************************************************************
+
+ pdlconv.c
+ automatically created by pdlconv.c.PL
+
+****************************************************************/
+
+!WITH!SUBS!
+
+print OUT <<'!NO!SUBS!';
+
+#define PDL_CORE /* For certain ifdefs */
+#include "pdl.h" /* Data structure declarations */
+#include "pdlcore.h" /* Core declarations */
+
+!NO!SUBS!
+
+# these 2 routines shouldn't need to be changed to handle
+# bad values, since all they do is copy data from
+# one piddle to another of the same type
+# (assuming no per-piddle bad values)
+#
+
+for(['readdata_vaffine', "*ap = *pp"],
+ ['writebackdata_vaffine', "*pp = *ap"]) {
+
+ my $name = $_->[0];
+ my $code = $_->[1];
+
+print OUT <<"!WITH!SUBS!";
+
+void pdl_${name}(pdl *a) {
+ int i,j;
+ int intype = a->datatype;
+ if(!PDL_VAFFOK(a)) {
+ die("pdl_$name without vaffine");
+ }
+ PDL_ENSURE_ALLOCATED(a);
+ switch ( intype ) {
+!WITH!SUBS!
+
+##### Generate code for each data type #####
+
+for my $in ( keys %PDL_DATATYPES ) {
+
+ my $intype = $PDL_DATATYPES{$in};
+ print OUT <<"!WITH!SUBS!";
+ case ${in}:
+ {
+ $intype *ap = ($intype *) a->data;
+ $intype *pp = ($intype *) a->vafftrans->from->data;
+ pp += a->vafftrans->offs;
+ for(i=0; i<a->nvals; i++) {
+ ${code};
+ for(j=0; j<a->ndims; j++) {
+ pp += a->vafftrans->incs[j];
+ if((j < a->ndims - 1 &&
+ (i+1) % a->dimincs[j+1]) ||
+ j == a->ndims - 1)
+ break;
+ pp -= a->vafftrans->incs[j] *
+ a->dims[j];
+ }
+ ap ++;
+ }
+ }
+ break;
+
+!WITH!SUBS!
+
+} #### End of perl loop ####
+
+# default:
+# die("pdl_$name does not recognise the datatype");
+
+print OUT <<'!NO!SUBS!';
+
+ } /* switch( intype ) */
+
+/*** free(inds); ***/
+}
+
+!NO!SUBS!
+
+} # End of outer perl loop
+
+print OUT <<'!NO!SUBS!';
+
+/* Various conversion utilities for pdl data types */
+
+/* Swap pdls */
+
+void pdl_swap(pdl** a, pdl** b) {
+ pdl* tmp;
+ tmp = *b; *b=*a; *a=tmp;
+}
+
+/* Change the type of all the data in a pdl struct, either changing the
+ original perl structure or making a temporary copy */
+
+/*
+ * it seems this does not have to be aware of bad values
+ * (at least in the current scheme)
+ */
+
+void pdl_converttype( pdl** aa, int targtype, Logical changePerl ) {
+ pdl* a=*aa; /* Point to cache */
+ int intype;
+ void* b; /* Scratch data ptr */
+ SV* bar;
+ HV* hash;
+ STRLEN nbytes;
+ int diffsize;
+ int i;
+#if (PERL_VERSION >= 5) && (PERL_SUBVERSION >= 57)
+ dXSARGS;
+#endif
+
+ PDLDEBUG_f(printf("pdl_converttype %p, %d, %d, %d\n", (void*)a, a->datatype,
+ targtype, changePerl);)
+
+ intype = a->datatype;
+ if (intype == targtype)
+ return;
+
+ diffsize = pdl_howbig(targtype) != pdl_howbig(a->datatype);
+
+ nbytes = a->nvals * pdl_howbig(targtype); /* Size of converted data */
+
+ if (changePerl) { /* Grow data */
+
+ if(a->state & PDL_DONTTOUCHDATA) {
+ croak("Trying to convert of magical (mmaped?) pdl");
+ }
+
+ if (diffsize) {
+ b = a->data; /* pointer to old data */
+ a->data = pdl_malloc(nbytes); /* Space for changed data */
+ }
+ else{
+ b = a->data; /* In place */
+ }
+
+ }else{
+
+ die("Sorry, temporary type casting is not allowed now");
+
+ b = a->data; /* Ptr to old data */
+ a = pdl_tmp(); /* Brand new scratch pdl */
+/* pdl_clone(*aa, a); */ /* Copy old pdl entries */
+ a->data = pdl_malloc(nbytes); /* Space for changed data */
+ *aa = a; /* Change passed value to new address */
+ }
+
+ /* Do the conversion as nested switch statements */
+
+ switch ( intype ) {
+!NO!SUBS!
+
+##### Generate code for each pair of data types #####
+
+for my $in ( keys %PDL_DATATYPES ) {
+
+ my $intype = $PDL_DATATYPES{$in};
+
+ print OUT <<"!WITH!SUBS!";
+ case ${in}:
+ {
+ $intype *bb = ($intype *) b;
+ i = a->nvals;
+
+ switch ( targtype ) {
+!WITH!SUBS!
+
+ for my $targ ( keys %PDL_DATATYPES ) {
+
+ next if $in eq $targ; # Skip duplicates
+ my $targtype = $PDL_DATATYPES{$targ};
+
+ print OUT <<"!WITH!SUBS!";
+ case ${targ}:
+ {
+ $targtype *aa = ($targtype *) a->data;
+ aa += i-1; bb += i-1;
+ while (i--)
+ *aa-- = ($targtype) *bb--;
+ }
+ break;
+
+!WITH!SUBS!
+
+ } # for: $targ
+
+ print OUT <<"!WITH!SUBS!";
+ default:
+ croak("Don't know how to convert datatype $in to #%d", targtype);
+ } /* switch targtype */
+ break;
+ } /* case: $in */
+
+!WITH!SUBS!
+
+} # for: $in
+
+
+#### Trailer ####
+
+print OUT <<'!NO!SUBS!';
+ default:
+ croak("Don't know how to convert datatype %d to %d", intype, targtype);
+ }
+
+ if (changePerl) { /* Tidy up */
+
+ /* Store new data */
+
+ if (diffsize) {
+ STRLEN n_a;
+ bar = a->datasv;
+ sv_setpvn( bar, (char*) a->data, nbytes );
+ a->data = (void*) SvPV(bar, n_a);
+ }
+
+ }
+
+ a->datatype = targtype;
+}
+
+
+/* Ensure 'a' and 'b' are the same data types of high enough precision,
+ using a reasonable set of rules.
+*/
+
+void pdl_coercetypes( pdl** aa, pdl** bb, Logical changePerl ) {
+
+ pdl* a = *aa; /* Double ptr passed as value of ptr may be changed to */
+ pdl* b = *bb; /* point at a temporary copy of the cached pdl */
+ Logical oneisscalar;
+ pdl *scalar,*vector;
+ int targtype;
+
+ if (a->datatype == b->datatype) /* Nothing to be done */
+ return;
+
+ /* Detect the vector & scalar case */
+
+ oneisscalar = (a->nvals==1 || b->nvals==1) && !(a->nvals==1 && b->nvals==1);
+
+ /* Rules for deciding what the target data type is */
+
+ if (oneisscalar) { /* Vector x Scalar case */
+
+ scalar = a; vector = b;
+ if (b->nvals==1) {
+ scalar = b;
+ vector = a;
+ }
+
+ if (vector->datatype >= scalar->datatype) /* Vector more complex - easy */
+
+ targtype = vector->datatype;
+
+ else { /* Scalar more complex than vector- special rules to avoid
+ overzealous promotion of vector */
+
+ if (vector->datatype == PDL_F) /* FxD is OK as F */
+ targtype = vector->datatype;
+
+ else if (vector->datatype <= PDL_L && scalar->datatype <= PDL_L)
+ targtype = vector->datatype; /* two ints is OK as input int */
+
+ else if (vector->datatype <= PDL_F && scalar->datatype==PDL_D)
+ targtype = PDL_F; /* Only promote FOOxD as far as F */
+
+ else
+ targtype = scalar->datatype;
+
+ }
+
+
+ }else{ /* Vector x Vector - easy */
+
+ targtype = a->datatype;
+ if (b->datatype > a->datatype)
+ targtype = b->datatype;
+
+ }
+
+ /* Do the conversion */
+
+ pdl_converttype(aa, targtype, changePerl);
+ pdl_converttype(bb, targtype, changePerl);
+}
+
+/* Given PDL return an allocated **ptr to 2D data thus allowing a[j][i] syntax */
+
+void ** pdl_twod( pdl* x ) {
+
+ PDL_Indx i,nx,ny;
+ int size;
+ long *p;
+ char *xx;
+
+ if (x->ndims>2)
+ croak("Data must be 1 or 2-dimensional for this routine");
+
+ xx = (char*) x->data;
+
+ nx = *(x->dims); ny = x->ndims==2 ? *(x->dims+1) : 1;
+
+ size=pdl_howbig(x->datatype);
+
+ p = (long*) pdl_malloc( ny*sizeof(long) ); /* 1D array of ptrs p[i] */
+ for (i=0;i<ny;i++)
+ p[i] = (long) &xx[i*nx*size];
+
+ return (void**) p;
+}
+
+!NO!SUBS!
diff --git a/Basic/Core/pdlcore.c.PL b/Basic/Core/pdlcore.c.PL
new file mode 100644
index 0000000..f77ac5d
--- /dev/null
+++ b/Basic/Core/pdlcore.c.PL
@@ -0,0 +1,1360 @@
+#
+# Create pdlcore.c
+# - needed for bad-value handling in whichdatatype
+#
+
+
+use strict;
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+require 'Dev.pm'; PDL::Core::Dev->import;
+use vars qw( %PDL_DATATYPES );
+
+# check for bad value support
+use vars qw( $bvalflag $usenan );
+require "badsupport.p";
+require 'Types.pm';
+PDL::Types->import(':All');
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+my $file;
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($Config{'osname'} eq 'VMS' or
+ $Config{'osname'} eq 'OS2'); # "case-forgiving"
+
+if ( $bvalflag ) {
+ print "Extracting $file (WITH bad value support)\n";
+} else {
+ print "Extracting $file (NO bad value support)\n";
+}
+open OUT,">$file" or die "Can't create $file: $!";
+chmod 0644, $file;
+
+print OUT <<"!WITH!SUBS!";
+
+/* pdlcore.c - generated automatically by pdlcore.c.PL */
+/* - bad value support = $bvalflag */
+
+!WITH!SUBS!
+ ;
+
+
+print OUT <<'!HEADER!'
+#undef FOODEB
+
+#define PDL_CORE /* For certain ifdefs */
+#include "pdl.h" /* Data structure declarations */
+#include "pdlcore.h" /* Core declarations */
+
+/*** Turn on definitions to print lots of fencepost information in the constructor ***/
+//#define DEBUG_SETAV_TYPE 1
+//#define DEBUG_KLUDGE_COPY 1
+
+/***************
+ * Paranoid check is commented out because SvPOK breaks some kinds of perl scalars.
+ * (blessed scalars like '$#$foo' get set to zero in perl 5.8.x)
+ */
+/* #define sv_undef(sv) ( (!(sv) || ((sv)==&PL_sv_undef) ) || !(SvNIOK(sv) || SvPOK(sv) || SvROK(sv)) ) */
+#define sv_undef(sv) ( (!(sv) || ((sv)==&PL_sv_undef)) || !(SvNIOK(sv) || (SvTYPE(sv)==SVt_PVMG) || SvPOK(sv) || SvROK(sv)))
+
+!HEADER!
+ ;
+
+if($Config{cc} eq 'cl') {
+ # _finite in CV++ 4.0
+ print OUT <<'FOO';
+#define finite _finite
+#include <float.h>
+FOO
+;
+}
+
+my $finite_inc;
+foreach my $inc ( qw/ math.h ieeefp.h / )
+{
+ if ( trylink ("finite: $inc", "#include <$inc>", 'finite(3.2);', '' ) ) {
+ $finite_inc = $inc;
+ last;
+ }
+}
+
+if ( defined $finite_inc )
+{
+ print OUT "#include <$finite_inc>\n";
+}
+else
+{
+ print OUT <<'!NO!SUBS!'
+
+#ifndef finite
+#ifdef isfinite
+#define finite isfinite
+#else
+#define finite(a) (((a) * 0) == (0))
+#endif
+#endif
+!NO!SUBS!
+}
+
+print OUT <<'!NO!SUBS!'
+static SV *getref_pdl(pdl *it) {
+ SV *newref;
+ if(!it->sv) {
+ SV *ref;
+ HV *stash = gv_stashpv("PDL",TRUE);
+ SV *psv = newSViv(PTR2IV(it));
+ it->sv = psv;
+ newref = newRV_noinc(it->sv);
+ (void)sv_bless(newref,stash);
+ } else {
+ newref = newRV_inc(it->sv);
+ SvAMAGIC_on(newref);
+ }
+ return newref;
+}
+
+void SetSV_PDL ( SV *sv, pdl *it ) {
+ SV *newref = getref_pdl(it); /* YUCK!!!! */
+ sv_setsv(sv,newref);
+ SvREFCNT_dec(newref);
+}
+
+
+/* Size of data type information */
+
+int pdl_howbig (int datatype) {
+ switch (datatype) {
+
+!NO!SUBS!
+ ;
+# generate the cases for the various types
+
+for my $type (typesrtkeys()) {
+ my ($sym,$ctype) = map {typefld($type,$_)} qw/sym ctype/;
+ print OUT << "!WITH!SUBS!";
+ case $sym:
+ return sizeof($ctype);
+!WITH!SUBS!
+}
+
+print OUT <<'!NO!SUBS!';
+
+ default:
+ croak("Unknown datatype code = %d",datatype);
+ }
+}
+
+/* Check minimum datatype required to represent number */
+/* Microsoft compilers do some unbelievable things - hence
+ some #ifdef's inserted by Sisyphus */
+#if defined _MSC_VER && _MSC_VER < 1400
+#define TESTTYPE(b,a) {a foo = nv; a bar = foo; foo += 0; if(nv == bar) return b;}
+#else
+#define TESTTYPE(b,a) {a foo = nv; if(nv == foo) return b;}
+#endif
+#if defined _MSC_VER && _MSC_VER < 1400
+#pragma optimize("", off)
+#endif
+int pdl_whichdatatype (double nv) {
+!NO!SUBS!
+
+# generate the cases for the various types
+
+for my $type (typesrtkeys()) {
+ my ($sym,$ctype) = map {typefld($type,$_)} qw/sym ctype/;
+ print OUT << "!WITH!SUBS!";
+ TESTTYPE($sym,$ctype)
+!WITH!SUBS!
+}
+
+print OUT <<'!NO!SUBS!';
+
+ if( !finite(nv) ) { return PDL_D; }
+
+ croak("Something's gone wrong: %lf cannot be converted by whichdatatype",
+ nv);
+}
+
+/* Check minimum, at least float, datatype required to represent number */
+
+int pdl_whichdatatype_double (double nv) {
+ TESTTYPE(PDL_F,PDL_Float)
+ TESTTYPE(PDL_D,PDL_Double)
+
+ if( !finite(nv) ) { return PDL_D; }
+
+ croak("Something's gone wrong: %lf cannot be converted by whichdatatype_double",
+ nv);
+}
+
+#if defined _MSC_VER && _MSC_VER < 1400
+#pragma optimize("", on)
+#endif
+
+/* Make a scratch data existence for a pdl */
+
+void pdl_makescratchhash(pdl *ret,double data, int datatype) {
+ STRLEN n_a;
+ HV *hash;
+ SV *dat; PDL_Indx fake[1];
+
+ /* Compress to smallest available type. This may have strange
+ results sometimes :( */
+ ret->datatype = datatype;
+ ret->data = pdl_malloc(pdl_howbig(ret->datatype)); /* Wasteful */
+
+ dat = newSVpv(ret->data,pdl_howbig(ret->datatype));
+
+ ret->data = SvPV(dat,n_a);
+ ret->datasv = dat;
+#ifdef FOO
+ /* Refcnt should be 1 already... */
+ SvREFCNT_inc(ret->datasv); /* XXX MEMLEAK */
+#endif
+
+ /* This is an important point: it makes this whole piddle mortal
+ * so destruction will happen at the right time.
+ * If there are dangling references, pdlapi.c knows not to actually
+ * destroy the C struct. */
+ sv_2mortal(getref_pdl(ret));
+
+ pdl_setdims(ret, fake, 0); /* However, there are 0 dims in scalar */
+ ret->nvals = 1;
+
+ /* NULLs should be ok because no dimensions. */
+ pdl_set(ret->data, ret->datatype, NULL, NULL, NULL, 0, 0, data);
+
+}
+
+/*
+ "Convert" a perl SV into a pdl (alright more like a mapping as
+ the data block is not actually copied in the most common case
+ of a single scalar) scalars are automatically converted to PDLs.
+*/
+
+pdl* SvPDLV ( SV* sv ) {
+
+ pdl* ret;
+ PDL_Indx fake[1];
+ SV *sv2;
+
+ if ( !SvROK(sv) ) {
+ /* The scalar is not a ref, so we can use direct conversion. */
+
+ SV *dat;
+ double data;
+ int datatype;
+
+ ret = pdl_new(); /* Scratch pdl */
+
+ /* Scratch hash for the pdl :( - slow but safest. */
+
+ /* handle undefined values */
+ if( sv_undef(sv) ) {
+ sv = get_sv("PDL::undefval",1);
+ if(SvIV(get_sv("PDL::debug",1))){
+ fprintf(stderr,"Warning: SvPDLV converted undef to $PDL::undefval (%g).\n",SvNV(sv));
+ }
+ }
+
+ /* Figure datatype to use */
+ if ( !SvIOK(sv) && SvNOK(sv) && SvNIOK(sv) ) {/* Perl Double (e.g. 2.0) */
+ data = SvNV(sv);
+
+!NO!SUBS!
+
+##########
+# If badvals and usenan are true, we default NaNs to type double.
+if ( $bvalflag and $usenan ) {
+ print OUT q{
+ /*
+ * default NaN/Infs to double
+ *
+ */
+ if ( finite(data) == 0 ) {
+ datatype = PDL_D;
+ } else {
+ datatype = pdl_whichdatatype_double(data);
+ }
+ }
+} else {
+ print OUT q{
+ datatype = pdl_whichdatatype_double(data);
+
+ }
+} # if: $bvalflag
+
+print OUT <<'!NO!SUBS!';
+ } /* end of Perl Double case for data type */
+ else { /* Perl Int (e.g. 2) */
+ data = SvNV(sv);
+ datatype = pdl_whichdatatype(data);
+ }
+
+
+ pdl_makescratchhash(ret,data,datatype);
+
+ return ret;
+
+ } /* End of scalar case */
+
+ /* If execution reaches here, then sv is NOT a scalar
+ * (i.e. it is a ref).
+ */
+
+
+
+ if(SvTYPE(SvRV(sv)) == SVt_PVHV) {
+ HV *hash = (HV*)SvRV(sv);
+ SV **svp = hv_fetch(hash,"PDL",3,0);
+ if(svp == NULL) {
+ croak("Hash given as a pdl - but not {PDL} key!");
+ }
+ if(*svp == NULL) {
+ croak("Hash given as a pdl - but not {PDL} key (*svp)!");
+ }
+
+ /* This is the magic hook which checks to see if {PDL}
+ is a code ref, and if so executes it. It should
+ return a standard piddle. This allows
+ all kinds of funky objects to be derived from PDL,
+ and allow normal PDL functions to still work so long
+ as the {PDL} code returns a standard piddle on
+ demand - KGB */
+
+ if (SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVCV) {
+ dSP;
+ int count;
+ ENTER ;
+ SAVETMPS ;
+ PUSHMARK(sp) ;
+
+ count = perl_call_sv(*svp, G_SCALAR|G_NOARGS);
+
+ SPAGAIN ;
+
+ if (count != 1)
+ croak("Execution of PDL structure failed to return one value\n") ;
+
+ sv=newSVsv(POPs);
+
+ PUTBACK ;
+ FREETMPS ;
+ LEAVE ;
+ }
+ else {
+ sv = *svp;
+ }
+
+ if(SvGMAGICAL(sv)) {
+ mg_get(sv);
+ }
+
+ if ( !SvROK(sv) ) { /* Got something from a hash but not a ref */
+ croak("Hash given as pdl - but PDL key is not a ref!");
+ }
+ }
+
+ if(SvTYPE(SvRV(sv)) == SVt_PVAV) {
+ /* This is similar to pdl_avref in Core.xs.PL -- we do the same steps here. */
+ AV *dims, *av;
+ int i, depth;
+ int datalevel = -1;
+ pdl *p;
+
+ av = (AV *)SvRV(sv);
+ dims = (AV *)sv_2mortal((SV *)newAV());
+ av_store(dims,0,newSViv( (IV) av_len(av)+1 ) );
+
+ /* Pull sizes using av_ndcheck */
+ depth = 1 + av_ndcheck(av,dims,0,&datalevel);
+
+ return pdl_from_array(av,dims,PDL_D,NULL);
+
+ } /* end of AV code */
+
+ if (SvTYPE(SvRV(sv)) != SVt_PVMG)
+ croak("Error - tried to use an unknown data structure as a PDL");
+ else if( !( sv_derived_from( sv, "PDL") ) )
+ croak("Error - tried to use an unknown Perl object type as a PDL");
+
+ sv2 = (SV*) SvRV(sv);
+
+ /* Return the pdl * pointer */
+ ret = INT2PTR(pdl *, SvIV(sv2));
+
+ /* Final check -- make sure it has the right magic number */
+ if(ret->magicno != PDL_MAGICNO) {
+ croak("Fatal error: argument is probably not a piddle, or\
+ magic no overwritten. You're in trouble, guv: %p %p %lu\n",sv2,ret,ret->magicno);
+ }
+
+ return ret;
+}
+
+/* Make a new pdl object as a copy of an old one and return - implement by
+ callback to perl method "copy" or "new" (for scalar upgrade) */
+
+SV* pdl_copy( pdl* a, char* option ) {
+
+ SV* retval;
+ char meth[20];
+
+ dSP ; int count ;
+
+ retval = newSVpv("",0); /* Create the new SV */
+
+ ENTER ; SAVETMPS ; PUSHMARK(sp) ;
+
+ /* Push arguments */
+
+#ifdef FOOBAR
+ if (sv_isobject((SV*)a->hash)) {
+#endif
+ XPUSHs(sv_2mortal(getref_pdl(a)));
+ strcpy(meth,"copy");
+ XPUSHs(sv_2mortal(newSVpv(option, 0))) ;
+#ifdef FOOBAR
+ }
+ else{
+ XPUSHs(perl_get_sv("PDL::name",FALSE)); /* Default object */
+ XPUSHs(sv_2mortal(getref_pdl(a)));
+ strcpy(meth,"new");
+ }
+#endif
+
+ PUTBACK ;
+
+ count = perl_call_method(meth, G_SCALAR); /* Call Perl */
+
+ SPAGAIN;
+
+ if (count !=1)
+ croak("Error calling perl function\n");
+
+ sv_setsv( retval, POPs ); /* Save the perl returned value */
+
+ PUTBACK ; FREETMPS ; LEAVE ;
+
+ return retval;
+}
+
+
+
+/* Pack dims array - returns dims[] (pdl_malloced) and ndims */
+
+PDL_Indx* pdl_packdims ( SV* sv, int *ndims ) {
+
+ SV* bar;
+ AV* array;
+ int i;
+ PDL_Indx *dims;
+
+ if (!(SvROK(sv) && SvTYPE(SvRV(sv))==SVt_PVAV)) /* Test */
+ return NULL;
+
+ array = (AV *) SvRV(sv); /* dereference */
+
+ *ndims = (int) av_len(array) + 1; /* Number of dimensions */
+
+ dims = (PDL_Indx *) pdl_malloc( (*ndims) * sizeof(*dims) ); /* Array space */
+ if (dims == NULL)
+ croak("Out of memory");
+
+ for(i=0; i<(*ndims); i++) {
+ bar = *(av_fetch( array, i, 0 )); /* Fetch */
+ dims[i] = (PDL_Indx) SvIV(bar);
+ }
+ return dims;
+}
+
+/* unpack dims array into PDL SV* */
+
+void pdl_unpackdims ( SV* sv, PDL_Indx *dims, int ndims ) {
+
+ AV* array;
+ HV* hash;
+ int i;
+
+ hash = (HV*) SvRV( sv );
+ array = newAV();
+ (void)hv_store(hash, "Dims", strlen("Dims"), newRV( (SV*) array), 0 );
+
+ if (ndims==0 )
+ return;
+
+ for(i=0; i<ndims; i++)
+ av_store( array, i, newSViv( (IV)dims[i] ) );
+}
+
+PDL_Indx pdl_safe_indterm( PDL_Indx dsz, PDL_Indx at, char *file, int lineno)
+{
+ if (at >= 0 && at < dsz) return at;
+ pdl_barf("access [%d] out of range [0..%d] (inclusive) at %s line %d",
+ at, dsz-1, file?file:"?", lineno);
+ return at; // This can never happen - placed to avoid a compiler warning.
+}
+
+/*
+ pdl_malloc - utility to get temporary memory space. Uses
+ a mortal *SV for this so it is automatically freed when the current
+ context is terminated without having to call free(). Naughty but
+ nice!
+*/
+
+
+void* pdl_malloc ( STRLEN nbytes ) {
+ STRLEN n_a;
+ SV* work;
+
+ work = sv_2mortal(newSVpv("", 0));
+
+ SvGROW( work, nbytes);
+
+ return (void *) SvPV(work, n_a);
+}
+
+/*********** Stuff for barfing *************/
+/*
+ This routine barfs/warns in a thread-safe manner. If we're in the main thread,
+ this calls the perl-level barf/warn. If in a worker thread, we save the
+ message to barf/warn in the main thread later
+*/
+
+static void pdl_barf_or_warn(const char* pat, int iswarn, va_list* args)
+{
+ /* If we're in a worker thread, we queue the
+ * barf/warn for later, and exit the thread ...
+ */
+ if( pdl_pthread_barf_or_warn(pat, iswarn, args) )
+ return;
+
+ /* ... otherwise we fall through and barf by calling
+ * the perl-level PDL::barf() or PDL::cluck()
+ */
+
+ { /* scope block for C89 compatibility */
+
+ SV * sv;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+
+ sv = sv_2mortal(newSV(0));
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
+ va_end(*args);
+
+ XPUSHs(sv);
+
+ PUTBACK;
+
+ if(iswarn) call_pv("PDL::cluck", G_DISCARD);
+ else call_pv("PDL::barf", G_DISCARD);
+
+ FREETMPS;
+ LEAVE;
+ } /* end C89 compatibility scope block */
+}
+
+#define GEN_PDL_BARF_OR_WARN_I_STDARG(type, iswarn) \
+ void pdl_##type(const char* pat, ...) \
+ { \
+ va_list args; \
+ va_start(args, pat); \
+ pdl_barf_or_warn(pat, iswarn, &args); \
+ }
+
+#define GEN_PDL_BARF_OR_WARN_LEGACY(type, iswarn) \
+ void pdl_##type(pat, va_alist) \
+ char *pat; \
+ va_dcl \
+ { \
+ va_list args; \
+ va_start(args); \
+ pdl_barf_or_warn(pat, iswarn, &args); \
+ }
+
+#ifdef I_STDARG
+GEN_PDL_BARF_OR_WARN_I_STDARG(barf, 0)
+GEN_PDL_BARF_OR_WARN_I_STDARG(warn, 1)
+#else
+GEN_PDL_BARF_OR_WARN_LEGACY(barf, 0)
+GEN_PDL_BARF_OR_WARN_LEGACY(warn, 1)
+#endif
+
+
+/**********************************************************************
+ *
+ * CONSTRUCTOR/INGESTION HELPERS
+ *
+ * The following routines assist with the permissive constructor,
+ * which is designed to build a PDL out of basically anything thrown at it.
+ *
+ * They are all called by pdl_avref in Core.xs, which in turn is called by the constructors
+ * in Core.pm.PL.
+ *
+ */
+
+/******************************
+ * av_ndcheck -
+ * traverse a Perl array ref recursively, following down any number of
+ * levels of references, and generate a minimal PDL dim list that can
+ * encompass them all according to permissive-constructor rules.
+ *
+ * Scalars, array refs, and PDLs may be mixed in the incoming AV.
+ *
+ * The routine works out the dimensions of a corresponding
+ * piddle (in the AV dims) in reverse notation (vs PDL conventions).
+ *
+ * It does not enforce a rectangular array, the idea being that
+ * omitted values will be set to zero in the resulting piddle,
+ * i.e. we can make piddles from 'sparse' array refs.
+ *
+ * Empty PDLs are treated like any other dimension -- i.e. their
+ * 0-length dimensions are thrown into the mix just like nonzero
+ * dimensions would be.
+ *
+ * The possible presence of empty PDLs forces us to pad out dimensions
+ * to unity explicitly in cases like
+ * [ Empty[2x0x2], 5 ]
+ * where simple parsing would yield a dimlist of
+ * [ 2,0,2,2 ]
+ * which is still Empty.
+ */
+
+PDL_Indx av_ndcheck(AV* av, AV* dims, int level, int *datalevel)
+{
+ PDL_Indx i, len, oldlen;
+ int newdepth, depth = 0;
+ int n_scalars = 0;
+ SV *el, **elp;
+ pdl *pdl; /* Stores PDL argument */
+
+ if(dims==NULL) {
+ pdl_barf("av_ndcheck - got a null dim array! This is a bug in PDL.");
+ }
+
+ /* Start with a clean slate */
+ if(level==0) {
+ av_clear(dims);
+ }
+
+ len = av_len(av); /* Loop over elements of the AV */
+ for (i=0; i<= len; i++) {
+
+ newdepth = 0; /* Each element - find depth */
+ elp = av_fetch(av,i,0);
+
+ el = elp ? *elp : 0; /* Get the ith element */
+ if (el && SvROK(el)) { /* It is a reference */
+ if (SvTYPE(SvRV(el)) == SVt_PVAV) { /* It is an array reference */
+
+ /* Recurse to find depth inside the array reference */
+ newdepth = 1 + av_ndcheck((AV *) SvRV(el), dims, level+1, datalevel);
+
+ } else if ( (pdl = SvPDLV(el)) ) {
+ /* It is a PDL - walk down its dimension list, exactly as if it
+ * were a bunch of nested array refs. We pull the ndims and dims
+ * fields out to local variables so that nulls can be treated specially.
+ */
+ int j;
+ short pndims;
+ PDL_Indx *pdims;
+ PDL_Indx pnvals;
+
+#ifdef DEBUG_SETAV_TYPE
+ printf("av_ndcheck - found a PDL....\n");
+#endif
+
+ pdl_make_physdims(pdl);
+
+ pndims = pdl->ndims;
+ pdims = pdl->dims;
+ pnvals = pdl->nvals;
+
+#ifdef DEBUG_SETAV_TYPE
+ {
+ printf("av_ndcheck: nvals is %d; ndims is %d; dims are (",pdl->nvals, pdl->ndims);
+ for(j=0;j<pdl->ndims; j++) {
+ printf("%s%d",j?", ":"",pdl->dims[j]);
+ }
+ printf("); level is %d\n",level);
+ }
+#endif
+
+ for(j=0;j<pndims;j++) {
+ int jl = pndims-j+level;
+
+ PDL_Indx siz = pdims[j];
+
+ if( av_len(dims) >= jl &&
+ av_fetch(dims,jl,0) != NULL &&
+ SvIOK(*(av_fetch(dims,jl,0)))) {
+
+ /* We have already found something that specifies this dimension -- so */
+ /* we keep the size if possible, or enlarge if necessary. */
+ oldlen=(PDL_Indx)SvIV(*(av_fetch(dims,jl,0)));
+ if(siz > oldlen) {
+ sv_setiv(*(av_fetch(dims,jl,0)),(IV)(pdims[j]));
+ }
+
+ } else {
+ /* Breaking new dimensional ground here -- if this is the first element */
+ /* in the arg list, then we can keep zero elements -- but if it is not */
+ /* the first element, we have to pad zero dims to unity (because the */
+ /* prior object had implicit size of 1 in all implicit dimensions) */
+ av_store(dims, jl, newSViv((IV)(siz?siz:(i?1:0))));
+ }
+ }
+
+ /* We have specified all the dims in this PDL. Now pad out the implicit */
+ /* dims of size unity, to wipe out any dims of size zero we have already */
+ /* marked. */
+
+ for(j=pndims+1; j <= av_len(dims); j++) {
+ SV **svp = av_fetch(dims,j,0);
+
+ if(!svp){
+ av_store(dims, j, newSViv((IV)1));
+ } else if( (int)SvIV(*svp) == 0 ) {
+ sv_setiv(*svp, (IV)1);
+ }
+ }
+
+ newdepth= pndims;
+
+ } else {
+ croak("av_ndcheck: non-array, non-PDL ref in structure\n\t(this is usually a problem with a pdl() call)");
+ }
+
+ } else {
+ /* got a scalar (not a ref) */
+ n_scalars++;
+
+ }
+
+ if (newdepth > depth)
+ depth = newdepth;
+ }
+
+ len++; // convert from funky av_len return value to real count
+
+#ifdef DEBUG_SETAV_TYPE
+ {
+ int i,dim;
+ if(dims != NULL) {
+ dim = av_len(dims) + 1;
+ } else {
+ dim =0 ;
+ }
+
+ printf("av_ndcheck: depth=%d, length is %d; derived dim list is [",depth, dim);
+ fflush(stdout);
+ for( i=0; i<dim; i++ ) {
+ SV **svp = av_fetch(dims, i, 0);
+ PDL_Indx k;
+
+ if(svp != NULL) {
+ k = SvIV (*svp);
+ } else {
+ k = -1;
+ }
+
+ printf(" %d",k);
+ }
+ printf(" ]\n");
+ }
+#endif
+
+ if (av_len(dims) >= level && av_fetch(dims, level, 0) != NULL
+ && SvIOK(*(av_fetch(dims, level, 0)))) {
+ oldlen = (PDL_Indx) SvIV(*(av_fetch(dims, level, 0)));
+
+ if (len > oldlen)
+ sv_setiv(*(av_fetch(dims, level, 0)), (IV) len);
+ }
+ else
+ av_store(dims,level,newSViv((IV) len));
+
+ /* We found at least one element -- so pad dims to unity at levels earlier than this one */
+#ifdef DEBUG_SETAV_TYPE
+ printf("n_scalars=%d\n",n_scalars);
+#endif
+
+ if(n_scalars) {
+ for(i=0;i<level;i++) {
+ SV **svp = av_fetch(dims, i, 0);
+ if(!svp) {
+ av_store(dims, i, newSViv((IV)1));
+ } else if( (PDL_Indx)SvIV(*svp) == 0) {
+ sv_setiv(*svp, (IV)1);
+ }
+ }
+
+ for(i=level+1; i <= av_len(dims); i++) {
+ SV **svp = av_fetch(dims, i, 0);
+ if(!svp) {
+ av_store(dims, i, newSViv((IV)1));
+ } else if( (PDL_Indx)SvIV(*svp) == 0) {
+ sv_setiv(*svp, (IV)1);
+ }
+ }
+ }
+
+#ifdef DEBUG_SETAV_TYPE
+ {
+ int i,dim;
+ if(dims != NULL) {
+ dim = av_len(dims) + 1;
+ } else {
+ dim =0 ;
+ }
+
+ printf("av_ndcheck: depth=%d, length is %d; derived dim list is [",depth, dim);
+ fflush(stdout);
+ for( i=0; i<dim; i++ ) {
+ SV **svp = av_fetch(dims, i, 0);
+ PDL_Indx k;
+
+ if(svp != NULL) {
+ k = SvIV (*svp);
+ } else {
+ k = -1;
+ }
+
+ printf(" %d",k);
+ }
+ printf(" ]\n");
+ }
+#endif
+
+ return depth;
+}
+
+pdl* pdl_from_array(AV* av, AV* dims, int type, pdl* p)
+{
+ int ndims, i, level=0;
+ PDL_Indx *pdims;
+ double undefval;
+
+ ndims = av_len(dims)+1;
+ pdims = (PDL_Indx *) pdl_malloc( (ndims) * sizeof(*pdims) );
+ for (i=0; i<ndims; i++) {
+ pdims[i] = SvIV(*(av_fetch(dims, ndims-1-i, 0))); /* reverse order */
+ }
+
+#ifdef DEBUG_SETAV_TYPE
+ {
+ int ii;
+ printf("pdl_from_array: dim list is: (");
+ for(ii=0; ii<ndims; ii++) {
+ printf("%s%d",ii?", ":"",pdims[ii]);
+ }
+ printf(")\n");
+ }
+#endif
+
+ if (p == NULL)
+ p = pdl_new();
+ pdl_setdims (p, pdims, ndims);
+ p->datatype = type;
+ pdl_allocdata (p);
+ pdl_make_physical(p);
+ /* this one assigns the data */
+
+ {
+ /******
+ * Copy the undefval to fill empty spots in the piddle...
+ */
+ SV *sv = get_sv("PDL::undefval",0);
+ undefval = ((!sv) || (sv==&PL_sv_undef)) ? 0 : (double)SvNV(sv);
+ }
+
+ switch (type) {
+!NO!SUBS!
+
+##########
+# Perl snippet autogenerates switch statement to distribute
+# pdl_setav calls...
+#
+ for my $type(sort keys %PDL_DATATYPES){
+ my $t2 = $PDL_DATATYPES{$type};
+ $t2 =~ s/PDL_//;
+ print OUT <<"!WITH!SUBS!";
+ case $type:
+ pdl_setav_$t2(p->data,av,pdims,ndims,level, undefval);
+ break;
+
+!WITH!SUBS!
+ }
+#
+# Back to your regularly scheduled C code emission...
+########
+ print OUT <<'!NO!SUBS!';
+ default:
+ croak("pdl_from_array: internal error: got type %d",type);
+ break;
+ }
+ p->state &= ~PDL_NOMYDIMS;
+ return p;
+}
+
+
+!NO!SUBS!
+
+######################################################################
+# these are helper functions for fast assignment from array refs
+# mainly used by pdl_avref in Core.xs which implements converting
+# array refs to piddles
+
+
+for my $in ( keys %PDL_DATATYPES ) {
+
+ (my $type = $PDL_DATATYPES{$in}) =~ s/^PDL_//;
+
+print OUT <<"!WITH!SUBS!";
+
+/*
+ * pdl_kludge_copy - copy a PDL into a part of a being-formed PDL.
+ * It is only used by pdl_setav, to handle the case where a PDL is part
+ * of the argument list. Ideally this would use the existing threadloop
+ * code but that seems too hard.
+ *
+ * kludge_copy recursively walks down the dim list of both the source and dest
+ * pdls, copying values in as we go. It differs from PP copy in that it operates
+ * on only a portion of the output pdl.
+ *
+ * (If I were Lazier I would have popped up into the perl level and used threadloops to
+ * assign to a slice of the output pdl -- but this is probably a little faster.)
+ *
+ * -CED 17-Jun-2004
+ *
+ * Arguments:
+ * poff is an integer indicating which element along the current direction is being treated (for padding accounting)
+ * pdata is a pointer into the destination PDL's data;
+ * pdims is a pointer to the destination PDL's dim list;
+ * ndims is the size of the destination PDL's dimlist;
+ * level is the conjugate dimension along which copying is happening (indexes pdims).
+ * "conjugate" means that it counts backward through the dimension array.
+ * stride is the increment in the data array corresponding to this dimension;
+ *
+ * pdl is the input PDL.
+ * plevel is the dim number for the input PDL, which works in the same sense as level.
+ * It is offset to account for the difference in dimensionality between the input and
+ * output PDLs. It is allowed to be negative (which is equivalent to the "permissive
+ * slicing" that treats missing dimensions as present and having size 1), but should
+ * not match or exceed pdl->ndims.
+ * pptr is the current offset data pointer into pdl->data.
+ *
+ * Kludge-copy works backward through the dim lists, so that padding is simpler: if undefval
+ * padding is required at any particular dimension level, the padding occupies a contiguous
+ * block of memory.
+ */
+
+PDL_Indx pdl_kludge_copy_$type(PDL_Indx poff,
+ PDL_$type* pdata,
+ PDL_Indx* pdims,
+ PDL_Indx ndims,
+ int level,
+ PDL_Indx stride,
+ pdl* pdl,
+ int plevel,
+ void* pptr,
+ double undefval
+ ) {
+ PDL_Indx i;
+ PDL_Indx undef_count = 0;
+
+#ifdef DEBUG_KLUDGE_COPY
+ printf("entering pdl_kludge_copy: level=%d, ndims=%d, plevel=%d; pdl->ndims=%d\\n",level,ndims,plevel,pdl->ndims);
+#endif
+
+ if(level > ndims ) {
+ fprintf(stderr,"pdl_kludge_copy: level=%d; ndims=%d\\n",level,ndims);
+ croak("Internal error - please submit a bug report at http://sourceforge.net/projects/pdl/:\\n pdl_kludge_copy: Assertion failed; ndims-1-level (%d) < 0!.",ndims-1-level);
+ }
+
+ if(level >= ndims - 1) {
+ /* In this case we are in as far as we can go in the destination PDL, so direct copying is in order. */
+ int pdldim = pdl->ndims - 1 - plevel;
+ PDL_Indx pdlsiz;
+ int oob = (ndims-1-level < 0);
+
+ /* Do bounds checking on the source dimension -- if we wander off the end, we
+ * are doing permissive-slicing kind of stuff; if we wander off the beginning, we
+ * are doing dimensional padding. In either case, we just iterate once.
+ */
+ if(pdldim < 0 || pdldim >= pdl->ndims) {
+ pdldim = (pdldim < 0) ? (0) : (pdl->ndims - 1);
+ pdlsiz = 1;
+ } else {
+ pdlsiz = pdl->dims[pdldim];
+ }
+
+
+#ifdef DEBUG_KLUDGE_COPY
+ fprintf(stderr," pdldim_expr=%d, pdldim=%d, pdlsiz=%d, pdims[0]=%d\\n",pdl->ndims-1-plevel,pdldim, pdlsiz,pdims[0]);
+#endif
+
+ switch(pdl->datatype) {
+
+!WITH!SUBS!
+
+ # perl loop to emit code for all the PDL types
+ #
+ foreach my $switch_type (keys %PDL::Types::typehash) {
+
+ my $ctype = $PDL::Types::typehash{$switch_type}{ctype};
+
+ print OUT <<"!WITH!SUBS!";
+
+
+ case ${switch_type}:
+#ifdef DEBUG_KLUDGE_COPY
+ if(pptr && pdata) {
+ fprintf(stderr,"*** kludge Assigning to %d (num - %g); pdlsiz=%d\\n",pdata, (double)( *((${ctype} *)pptr)),pdlsiz);
+ } else {
+ fprintf(stderr,"*** kludge Skipping assignment (null pointer in source)\\n");
+ }
+#endif
+ /* copy data (unless the source pointer is null) */
+ i=0;
+ if(pptr && pdata && pdlsiz) {
+ for(; i<pdlsiz; i++)
+ pdata[i] = (PDL_$type) ((${ctype} *)pptr)[i];
+ } else {
+ if(pdata)
+ pdata[i] = undefval;
+ }
+ /* pad out, in the innermost dimension */
+#ifdef DEBUG_KLUDGE_COPY
+ fprintf(stderr,"padding; "); fflush(stderr);
+ fprintf(stderr," ndims-1-level=%d; ndims=%d, level=%d; plevel=%d; pdl->ndims=%d; poff=%ld; oob=%d\\n", ndims-1-level,ndims, level, plevel, pdl->ndims, poff, oob);
+#endif
+ if( !oob ) {
+ for(; i< pdims[0]-poff; i++) {
+ undef_count++;
+ pdata[i] = undefval;
+ }
+#ifdef DEBUG_KLUDGE_COPY
+ fprintf(stderr," filled in row: ");
+ for(i=0;i<pdims[0] - poff; i++)
+ fprintf(stderr,"%g ",pdata[i]);
+ fprintf(stderr,"\\n");
+#endif
+ }
+
+ break;
+!WITH!SUBS!
+
+ } # end of foreach in the perl generator code
+
+ print OUT <<"!WITH!SUBS!";
+ default:
+ croak("Internal error - please submit a bug report at http://sourceforge.net/projects/pdl/:\\n pdl_kludge_copy: unknown type of %d.",pdl->datatype);
+ break;
+ }
+
+ return undef_count;
+ }
+
+ /* If we're here we're not at the bottom level yet... */
+#ifdef DEBUG_KLUDGE_COPY
+ printf("Entering PKC recursion loop. imax is %d (plevel=%d; pdl->dims[%d-1-%d] = %d)\\n",
+ ( (plevel >= 0 && (pdl->ndims - 1 - plevel >= 0) && (pdl->ndims - 1 - plevel < pdl->ndims)) ? (pdl->dims[ pdl->ndims - 1 - plevel ]) : 1 ),
+ plevel,
+ ndims,
+ plevel,
+ pdl->dims[pdl->ndims-1-plevel]
+ );
+#endif
+ for(i=0;
+ i < ( (plevel >= 0 && (pdl->ndims - 1 - plevel >= 0) && (pdl->ndims - 1 - plevel < pdl->ndims)) ? (pdl->dims[ pdl->ndims-1-plevel ]) : 1 );
+ i++) {
+
+#ifdef DEBUG_KLUDGE_COPY
+ {
+ char buf[10240];
+ char sb[1024];
+ int ii;
+ *buf=0;
+ for(ii=0;ii<ndims;ii++) {
+ sprintf(sb,"%d",pdims[ii]);
+ if(ii) strcat(buf,",");
+ strcat(buf,sb);
+ }
+ printf("pdl_kludge_copy: pushing... level=%d, i=%d, pdata=%d, pdims=(%s), ndims=%d, stride=%d, plevel=%d, pptr=%d\\n",
+ level, i, pdata, buf, ndims, stride, plevel, pptr);
+
+ printf(" (pdims[ndims-2-level] is %d)\\n",pdims[ndims-2-level]);
+ }
+#endif
+ undef_count += pdl_kludge_copy_$type(0, pdata + stride * i,
+ pdims,
+ ndims,
+ level+1,
+ stride / ((pdims[ndims-2-level]) ? (pdims[ndims-2-level]) : 1),
+ pdl,
+ plevel+1,
+ ((PDL_Byte *) pptr) + pdl->dimincs[pdl->ndims-1-plevel] * i * pdl_howbig(pdl->datatype),
+ undefval
+ );
+#ifdef DEBUG_KLUDGE_COPY
+ printf("(level=%d, back from recursion)\\n",level);
+#endif
+ } /* end of kludge_copy recursion loop */
+
+ /* pad tree to zero if there are not enough elements... */
+#ifdef DEBUG_KLUDGE_COPY
+ printf(" pdl_kludge_copy - finished recursion loop at level %d... i is %d, pdims[%d]=%d...\\n",
+ level, i, ndims - 1 - level,pdims[ndims - 1 - level]);
+#endif
+
+ if(i < pdims[ndims - 1 - level]) {
+ int cursor, target;
+
+ cursor = i * stride;
+ target = pdims[ndims-1-level]*stride;
+ undef_count += target - cursor;
+
+#ifdef DEBUG_KLUDGE_COPY
+ printf("i=%d, pdims[%d - 1 - %d]=%d, stride=%d, cursor=%d, target=%d....\\n",i,ndims,level,pdims[ndims - 1 - level],stride,cursor,target);
+ {
+ int ii;
+ printf(" pdims is:[");
+ for(ii=0; ii<ndims;ii++) {
+ printf("%s%d",(ii?", ":""),pdims[ii]);
+ }
+ printf("]\\n");
+ }
+#endif
+
+
+ for(;
+ cursor < target;
+ cursor++) {
+ pdata[cursor] = undefval;
+ }
+
+ } /* end of padding IF statement */
+
+ return undef_count;
+}
+
+/*
+ * pdl_setav_type loads a new PDL with values from a Perl AV, another PDL, or
+ * a mix of both. Heterogeneous sizes are handled by padding the new PDLs
+ * values out to size with the undefval. It is called by pdl_setav only.
+ *
+ *
+ * Recent changes to setav_$type:
+ * - Look for PDLs and deep copy them with pdl_kludge_copy just as if they were
+ * array refs.
+ * - Allow multiple depths in different elements. The max depth should have been
+ * determined by pdl_av_ndcheck (it comes in as the ndims parameter), so other
+ * depths are descended to and extra elements are filled in with zeroes.
+ * In the Best of All Possible Worlds this would be badval compliant and
+ * the extra elements would get filled in with BAD.
+ * --CED, 17-Jun-2004
+ *
+ * - Check for undef values and set the PDL element to PDL::undefval for those
+ * elements.
+ * - Keep track of how many undef values were encountered, for debugging
+ * (I am wary of action-at-a-distance)
+ *
+ * -CED, 28-Jul-2004
+ *
+ *
+ * - pdata is the data pointer from a PDL
+ * - av is the array ref (or PDL) to use to fill the data with,
+ * - pdims is the dimlist
+ * - ndims is the size of the dimlist
+ * - level is the recursion level, which is also the dimension that we are filling
+ */
+
+PDL_Indx pdl_setav_$type(PDL_$type* pdata, AV* av,
+ PDL_Indx* pdims, PDL_Long ndims, int level, double undefval)
+{
+ PDL_Indx cursz = pdims[ndims-1-level]; /* we are starting from the highest dim
+ inwards */
+ PDL_Indx len = av_len(av);
+ PDL_Indx i,stride=1;
+
+ SV *el, **elp;
+ PDL_Indx undef_count = 0;
+
+ fflush(stdout);
+
+ for (i=0;i<ndims-1-level;i++) {
+ stride *= pdims[i];
+ }
+
+#ifdef DEBUG_SETAV_TYPE
+ printf("entering pdl_setav_$type: pdata=%d\\n",pdata);
+ {
+ int i;
+ printf("ndims=%d; level=%d; ndims-1-level is %d; pdims factor is (",ndims,level,ndims-1-level);
+ for(i=0;i<ndims-1-level; i++) {
+ printf("%s%d",(i?", ":""),pdims[i]);
+ }
+ printf("); initial stride is %d\\n",stride);
+ }
+#endif
+
+ for (i=0;i<=len;i++,pdata += stride) { /* note len is actually the highest index in the array */
+
+ int foo;
+
+#ifdef DEBUG_SETAV_TYPE
+ {
+ /* Generate some debugging info */
+ char buf[10240];
+ char sb[1024];
+ int ii;
+ *buf=0;
+ for(ii=0;ii<ndims; ii++) {
+ sprintf(sb,"%d",pdims[ii]);
+ if(ii) strcat(buf,",");
+ strcat(buf,sb);
+ }
+ printf("pdl_setav_$type: level=%d, i=%d, pdata=%d, pdims=(%s), ndims=%d\\t",
+ level, i, pdata, buf, ndims);
+ }
+#endif
+
+ elp = av_fetch(av,i,0);
+ el = (elp ? *elp : 0);
+ foo = el ? SVavref(el) : 0;
+
+ if (foo) {
+
+#ifdef DEBUG_SETAV_TYPE
+ printf("found an array ref -- recursing\\n");
+#endif
+
+ undef_count += pdl_setav_$type(pdata, (AV *) SvRV(el), pdims, ndims, level+1, undefval);
+
+ } else if( el && SvROK(el) ) {
+ pdl *pdl;
+ if( (pdl = SvPDLV(el)) ) {
+
+ pdl_make_physical(pdl);
+
+
+#ifdef DEBUG_SETAV_TYPE
+ printf("source pdl has %d vals...\\n",pdl->nvals);
+#endif
+
+ { // convenience block.. recursively copy/pad each PDL.
+
+#ifdef DEBUG_SETAV_TYPE
+ {
+ /* Generate some debugging info */
+ char buf[10240];
+ char sb[1024];
+ int ii;
+ *buf=0;
+ for(ii=0;ii<ndims; ii++) {
+ sprintf(sb,"%d",pdims[ii]);
+ if(ii) strcat(buf,",");
+ strcat(buf,sb);
+ }
+
+ printf("Calling pdl_kludge_copy - pdata is %d, pdims is (%s), ndims is %d, level is %d, stride is %d, pdl->data is %d\\n",
+ pdata, buf, ndims, level, stride, pdl->data
+ );
+ }
+#endif
+ {
+ PDL_Indx pd;
+ int pddex;
+ pddex = ndims - 2 - level;
+ pd = (pddex >= 0 && pddex < ndims ? pdims[ pddex ] : 0);
+ if(!pd)
+ pd = 1;
+ undef_count += pdl_kludge_copy_$type(0, pdata,pdims,ndims, level+1, stride / pd , pdl, 0, pdl->data,undefval);
+ }
+ }
+
+ } else {
+ croak("Non-array, non-PDL element in list");
+ }
+ } else { /* SvROK(el)==0; scalar element */
+ if( sv_undef(el) ) {
+#ifdef DEBUG_SETAV_TYPE
+ printf("undefined scalar element\\n");
+#endif
+ *pdata = (PDL_$type) undefval; /* undef case */
+ undef_count++;
+
+ } else {
+#ifdef DEBUG_SETAV_TYPE
+ printf("defined scalar element %g\\n",(double)SvNV(el));
+#endif
+ *pdata = (PDL_$type) SvNV(el);
+
+ }
+ /* Pad dim if we are not deep enough */
+ if(level < ndims-1) {
+ PDL_$type *cursor = pdata;
+ PDL_$type *target = pdata + stride;
+
+#ifdef DEBUG_SETAV_TYPE
+ printf("\\tPadding: level=%d; ndims-1=%d. pdata is %d, stride is %d, target is %d\\n",level,ndims-1,pdata,stride, target);
+#endif
+ for( cursor++; cursor < target; cursor++ ) {
+ *cursor = (PDL_$type)undefval;
+ undef_count++;
+ }
+ }
+ }
+
+ } /* end of i loop */
+
+ /* in case this dim is incomplete set remaining elements to the undefval */
+
+#ifdef DEBUG_SETAV_TYPE
+ printf("\\tloop is complete. len is %d, cursz-1 is %d, stride is %d\\n",len,cursz-1, stride);
+#endif
+
+ if(len < cursz-1 ) {
+ PDL_$type *target = pdata + stride * (cursz - 1 - len);
+#ifdef DEBUG_SETAV_TYPE
+ printf("\\tpadding %d elements with the undefval...\\n",target-pdata);
+#endif
+
+ for( ;
+ pdata < target;
+ pdata++
+ ) {
+
+ *pdata = (PDL_$type) undefval;
+ undef_count++;
+ }
+ }
+
+ if(level==0 && undef_count) {
+ char debug_flag;
+ SV *sv;
+ sv = get_sv("PDL::debug",0);
+ debug_flag = (sv_undef(sv)) ? 0 : (char)SvIV(sv);
+
+ if(debug_flag) {
+ fprintf(stderr,"Warning: pdl_setav_$type converted undef to $PDL::undefval (%g) %ld time%s\\n",undefval,undef_count,undef_count==1?"":"s");
+ }
+ }
+
+ return undef_count;
+}
+
+
+!WITH!SUBS!
+
+ } # end type loop
diff --git a/Basic/Core/pdlcore.h.PL b/Basic/Core/pdlcore.h.PL
new file mode 100644
index 0000000..838bc85
--- /dev/null
+++ b/Basic/Core/pdlcore.h.PL
@@ -0,0 +1,389 @@
+# -*-perl-*-
+
+##############################
+#
+# Be sure to increment $pdl_core_version (about 20 lines below this note)
+# if you change any prototypes or modify the Core structure!
+#
+##############################
+
+use strict;
+use Config;
+use File::Basename qw(&basename &dirname);
+
+require 'Dev.pm'; PDL::Core::Dev->import;
+use vars qw( %PDL_DATATYPES );
+
+# version 2 is for versions after PDL 2.1.1
+# version 4 has pdl_hard_copy included in the Core structure.
+# version 6 is introduced after 2.4.2, due to the experimental
+# per-piddle bad values code (the BADVAL_PER_PDL option)
+# version 7 introduced for some changes to function prototypes
+# for pthreading (i.e. multi-threading) capabilities
+# version 8 for beginning support for >2GiB piddles
+# version 9 for STRLEN/Size_t/Off_t for mmap delete magic
+# version 10 for 64bit index support (PDL index datatype)
+#
+use vars qw( $pdl_core_version );
+$pdl_core_version = 10;
+
+# List explicitly here the variables you want Configure to
+# generate. Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries. Thus you write
+# $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+my $file;
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($Config{'osname'} eq 'VMS' or
+ $Config{'osname'} eq 'OS2'); # "case-forgiving"
+
+print "Extracting $file\n";
+open OUT,">$file" or die "Can't create $file: $!";
+chmod 0644, $file;
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+
+print OUT <<'!NO!SUBS!';
+/*
+ * THIS FILE IS GENERATED FROM pdlcore.h.PL! Do NOT edit!
+ */
+
+#ifndef __PDLCORE_H
+#define __PDLCORE_H
+
+#include "EXTERN.h" /* std perl include */
+#include "perl.h" /* std perl include */
+#include "XSUB.h" /* for the win32 perlCAPI crap */
+#include "ppport.h" /* include this AFTER XSUB.h */
+
+#if defined(CONTEXT) && defined(__osf__)
+#undef CONTEXT
+#endif
+
+#include "pdl.h"
+#include "pdlthread.h"
+/* the next one causes trouble in c++ compiles - exclude for now */
+#ifndef __cplusplus
+#include "pdlmagic.h"
+#endif
+
+!NO!SUBS!
+
+print OUT "#define PDL_CORE_VERSION $pdl_core_version\n";
+
+print OUT <<'!NO!SUBS!' if ($^O =~ /MSWin/);
+
+#define finite _finite
+#include <float.h>
+
+!NO!SUBS!
+
+print OUT <<'!NO!SUBS!';
+
+#define PDL_TMP 0 /* Flags */
+#define PDL_PERM 1
+
+#define BIGGESTOF(a,b) ( a->nvals>b->nvals ? a->nvals : b->nvals )
+#define SVavref(x) (SvROK(x) && SvTYPE(SvRV(x))==SVt_PVAV)
+
+/* Create portable NaN's with the NaN_float and NaN_double macros.
+ * The end values are 7f to turn off sign bit to avoid printing "-NaN".
+ * This produces QNaN's or quiet nan's on architectures that support it.
+ *
+ * The below uses IEEE-754, so it should be portable. Also note the symmetry
+ * which makes the bigendian vs little-endian issue moot. If platforms should
+ * arise which require further consideration, use the pdl function,
+ * PDL::Core::Dev::isbigendian() which returns a boolean value (a false value
+ * garantees little-endian), and #ifdef's for exotic architectures. You'll be
+ * hard pressed to find an architecture that doesn't support ieee-754 but does
+ * support NaN. See http://en.wikipedia.org/wiki/NaN to understand why
+ * this works. */
+static const union {unsigned char c[4]; float f;}
+ union_nan_float = {{0x7f, 0xff, 0xff, 0x7f}};
+static const union {unsigned char c[8]; double d;}
+ union_nan_double = {{0x7f, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x7f}};
+
+/* Use our own barf and our own warn.
+ * We defer barf (and warn) handling until after multi-threaded (i.e pthreading)
+ * processing is finished.
+ * This is needed because segfaults happen when perl's croak is called
+ * during one of the spawned pthreads for PDL processing.
+ */
+#define barf PDL->pdl_barf
+#undef warn
+#define warn PDL->pdl_warn
+
+
+typedef int Logical;
+
+/*************** Function prototypes *********************/
+
+
+/* pdlcore.c */
+
+int pdl_howbig (int datatype); /* Size of data type (bytes) */
+pdl* SvPDLV ( SV* sv ); /* Map SV* to pdl struct */
+void SetSV_PDL( SV *sv, pdl *it ); /* Outputting a pdl from.. */
+SV* pdl_copy( pdl* a, char* option ); /* call copy method */
+PDL_Indx * pdl_packdims ( SV* sv, int*ndims ); /* Pack dims[] into SV aref */
+void pdl_unpackdims ( SV* sv, PDL_Indx *dims, /* Unpack */
+ int ndims );
+void* pdl_malloc ( STRLEN nbytes ); /* malloc memory - auto free()*/
+
+void pdl_makescratchhash(pdl *ret,double data, int datatype);
+PDL_Indx pdl_safe_indterm(PDL_Indx dsz, PDL_Indx at, char *file, int lineno);
+void pdl_barf(const char* pat,...); /* General croaking utility */
+void pdl_warn(const char* pat,...); /* General warn utility */
+PDL_Indx av_ndcheck(AV* av, AV* dims, int level, int *datalevel);
+pdl* pdl_from_array(AV* av, AV* dims, int type, pdl* p);
+
+!NO!SUBS!
+
+for my $in ( keys %PDL_DATATYPES ) {
+
+ (my $type = $PDL_DATATYPES{$in}) =~ s/^PDL_//;
+ print OUT <<"!WITH!SUBS!";
+PDL_Indx pdl_setav_$type(PDL_$type* pdata, AV* av,
+ PDL_Indx* pdims, PDL_Long ndims, int level, double undefval);
+!WITH!SUBS!
+}
+
+print OUT <<'!NO!SUBS!';
+
+/* pdlapi.c */
+
+void pdl_vaffinechanged(pdl *it, int what);
+void pdl_trans_mallocfreeproc(struct pdl_trans *tr);
+void pdl_make_trans_mutual(pdl_trans *trans);
+void pdl_destroytransform_nonmutual(pdl_trans *trans,int ensure);
+
+void pdl_vafftrans_free(pdl *it);
+void pdl_vafftrans_remove(pdl * it);
+void pdl_make_physvaffine(pdl *it);
+void pdl_vafftrans_alloc(pdl *it);
+
+pdl *pdl_null();
+pdl *pdl_get_convertedpdl(pdl *pdl,int type);
+
+void pdl_destroytransform(pdl_trans *trans,int ensure);
+pdl *pdl_make_now(pdl *it);
+
+pdl *pdl_hard_copy(pdl *src);
+
+#define pdl_new() pdl_create(PDL_PERM)
+#define pdl_tmp() pdl_create(PDL_TMP)
+pdl* pdl_external_new();
+pdl* pdl_external_tmp();
+pdl* pdl_create(int type);
+void pdl_destroy(pdl *it);
+void pdl_setdims(pdl* it, PDL_Indx* dims, int ndims);
+void pdl_reallocdims ( pdl *it,int ndims ); /* reallocate dims and incs */
+void pdl_reallocthreadids ( pdl *it,int ndims ); /* reallocate threadids */
+void pdl_resize_defaultincs ( pdl *it ); /* Make incs out of dims */
+void pdl_unpackarray ( HV* hash, char *key, PDL_Indx *dims, int ndims );
+void pdl_print(pdl *it);
+void pdl_dump(pdl *it);
+void pdl_allocdata(pdl *it);
+
+PDL_Indx *pdl_get_threadoffsp(pdl_thread *thread); /* For pthreading */
+void pdl_thread_copy(pdl_thread *from,pdl_thread *to);
+void pdl_clearthreadstruct(pdl_thread *it);
+void pdl_initthreadstruct(int nobl,pdl **pdls,PDL_Indx *realdims,PDL_Indx *creating,int npdls,
+ pdl_errorinfo *info,pdl_thread *thread,char *flags, int noPthreadFlag );
+int pdl_startthreadloop(pdl_thread *thread,void (*func)(pdl_trans *),pdl_trans *);
+int pdl_iterthreadloop(pdl_thread *thread,int which);
+void pdl_freethreadloop(pdl_thread *thread);
+void pdl_thread_create_parameter(pdl_thread *thread,int j,PDL_Indx *dims,
+ int temp);
+void pdl_croak_param(pdl_errorinfo *info,int paramIndex, char *pat, ...);
+
+void pdl_setdims_careful(pdl *pdl);
+void pdl_put_offs(pdl *pdl,PDL_Indx offs, double val);
+double pdl_get_offs(pdl *pdl,PDL_Indx offs);
+double pdl_get(pdl *pdl,PDL_Indx *inds);
+void pdl_set_trans(pdl *it, pdl *parent, pdl_transvtable *vtable);
+
+void pdl_make_physical(pdl *it);
+void pdl_make_physdims(pdl *it);
+
+void pdl_children_changesoon(pdl *it, int what);
+void pdl_changed(pdl *it, int what, int recursing);
+void pdl_separatefromparent(pdl *it);
+
+void pdl_trans_changesoon(pdl_trans *trans,int what);
+void pdl_trans_changed(pdl_trans *trans,int what);
+
+void pdl_set_trans_childtrans(pdl *it, pdl_trans *trans,int nth);
+void pdl_set_trans_parenttrans(pdl *it, pdl_trans *trans,int nth);
+
+/* pdlhash.c */
+
+pdl* pdl_getcache( HV* hash ); /* Retrieve address of $$x{PDL} */
+pdl* pdl_fillcache( HV* hash, SV* ref); /* Fill/create $$x{PDL} cache */
+void pdl_fillcache_partial( HV *hash, pdl *thepdl ) ;
+SV* pdl_getKey( HV* hash, char* key ); /* Get $$x{Key} SV* with deref */
+void pdl_flushcache( pdl *thepdl ); /* flush cache */
+
+/* pdlfamily.c */ /* DOES NOT APPEAR TO EXIST ANY MORE!!! */
+
+void pdl_family_create(pdl *from,pdl_trans *trans,int ind1,int ind2);
+pdl *pdl_family_clone2now(pdl *from); /* Use pdl_make_now instead */
+
+
+/* pdlconv.c */
+
+void pdl_writebackdata_vaffine(pdl *it);
+void pdl_readdata_vaffine(pdl *it);
+
+void pdl_swap(pdl** a, pdl** b); /* Swap two pdl ptrs */
+void pdl_converttype( pdl** a, int targtype, /* Change type of a pdl */
+ Logical changePerl );
+void pdl_coercetypes( pdl** a, pdl **b, Logical changePerl ); /* Two types to same */
+void pdl_grow ( pdl* a, PDL_Indx newsize); /* Change pdl 'Data' size */
+void pdl_retype( pdl* a, int newtype); /* Change pdl 'Datatype' value */
+void** pdl_twod( pdl* x ); /* Return 2D pointer to data array */
+
+/* pdlsections.c */
+
+PDL_Indx pdl_get_offset(PDL_Indx* pos, PDL_Indx* dims, PDL_Indx *incs, PDL_Indx offset, int ndims); /* Offset of pixel x,y,z... */
+PDL_Indx pdl_validate_section( PDL_Indx* sec, PDL_Indx* dims, /* Check section */
+ int ndims );
+void pdl_row_plusplus ( PDL_Indx* pos, PDL_Indx* dims, /* Move down one row */
+ int ndims );
+void pdl_subsection( char *y, char*x, int datatype, /* Take subsection */
+ PDL_Indx* sec, PDL_Indx* dims, PDL_Indx *incs, PDL_Indx offset, int* ndims);
+void pdl_insertin( char*y, PDL_Indx* ydims, int nydims, /* Insert pdl in pdl */
+ char*x, PDL_Indx* xdims, int nxdims,
+ int datatype, PDL_Indx* pos);
+double pdl_at( void* x, int datatype, PDL_Indx* pos, PDL_Indx* dims, /* Value at x,y,z,... */
+ PDL_Indx *incs, PDL_Indx offset, int ndims);
+void pdl_set( void* x, int datatype, PDL_Indx* pos, PDL_Indx* dims, /* Set value at x,y,z... */
+ PDL_Indx *incs, PDL_Indx offs, int ndims, double value);
+void pdl_axisvals( pdl* a, int axis ); /* Fill with axis values */
+
+/* Structure to hold pointers core PDL routines so as to be used by many modules */
+
+struct Core {
+ I32 Version;
+ pdl* (*SvPDLV) ( SV* );
+ void (*SetSV_PDL) ( SV *sv, pdl *it );
+#if defined(PDL_clean_namespace) || defined(PDL_OLD_API)
+ pdl* (*new) ( ); /* make it work with gimp-perl */
+#else
+ pdl* (*pdlnew) ( ); /* renamed because of C++ clash */
+#endif
+ pdl* (*tmp) ( );
+ pdl* (*create) (int type);
+ void (*destroy) (pdl *it);
+ pdl* (*null) ();
+ SV* (*copy) ( pdl*, char* );
+ pdl* (*hard_copy) ( pdl* );
+ void (*converttype) ( pdl**, int, Logical );
+ void** (*twod) ( pdl* );
+ void* (*smalloc) ( STRLEN );
+ int (*howbig) ( int );
+ PDL_Indx* (*packdims) ( SV* sv, int *ndims ); /* Pack dims[] into SV aref */
+ void (*setdims) ( pdl* it, PDL_Indx* dims, int ndims );
+ void (*unpackdims) ( SV* sv, PDL_Indx *dims, /* Unpack */
+ int ndims );
+ void (*grow) ( pdl* a, PDL_Indx newsize); /* Change pdl 'Data' size */
+ void (*flushcache)( pdl *thepdl ); /* flush cache */
+ void (*reallocdims) ( pdl *it,int ndims ); /* reallocate dims and incs */
+ void (*reallocthreadids) ( pdl *it,int ndims );
+ void (*resize_defaultincs) ( pdl *it ); /* Make incs out of dims */
+
+void (*thread_copy)(pdl_thread *from,pdl_thread *to);
+void (*clearthreadstruct)(pdl_thread *it);
+void (*initthreadstruct)(int nobl,pdl **pdls,PDL_Indx *realdims,PDL_Indx *creating,int npdls,
+ pdl_errorinfo *info,pdl_thread *thread,char *flags, int noPthreadFlag );
+int (*startthreadloop)(pdl_thread *thread,void (*func)(pdl_trans *),pdl_trans *);
+PDL_Indx *(*get_threadoffsp)(pdl_thread *thread); /* For pthreading */
+int (*iterthreadloop)(pdl_thread *thread,int which);
+void (*freethreadloop)(pdl_thread *thread);
+void (*thread_create_parameter)(pdl_thread *thread,int j,PDL_Indx *dims,
+ int temp);
+void (*add_deletedata_magic) (pdl *it,void (*func)(pdl *, Size_t param), Size_t param); /* Automagic destructor */
+ /* This needs to be fixed to work correctly for File::Map implementation */
+
+/* XXX NOT YET IMPLEMENTED */
+void (*setdims_careful)(pdl *pdl);
+void (*put_offs)(pdl *pdl,PDL_Indx offs, double val);
+double (*get_offs)(pdl *pdl,PDL_Indx offs);
+double (*get)(pdl *pdl,PDL_Indx *inds);
+void (*set_trans_childtrans)(pdl *it, pdl_trans *trans,int nth);
+void (*set_trans_parenttrans)(pdl *it, pdl_trans *trans,int nth);
+pdl *(*make_now)(pdl *it);
+
+pdl *(*get_convertedpdl)(pdl *pdl,int type);
+
+void (*make_trans_mutual)(pdl_trans *trans);
+
+/* Affine trans. THESE ARE SET IN ONE OF THE OTHER Basic MODULES
+ and not in Core.xs ! */
+void (*readdata_affine)(pdl_trans *tr);
+void (*writebackdata_affine)(pdl_trans *tr);
+void (*affine_new)(pdl *par,pdl *child,PDL_Indx offs,SV *dims,SV *incs);
+
+/* Converttype. Similar */
+void (*converttypei_new)(pdl *par,pdl *child,int type);
+
+void (*trans_mallocfreeproc)(struct pdl_trans *tr);
+
+void (*make_physical)(pdl *it);
+void (*make_physdims)(pdl *it);
+void (*pdl_barf) (const char* pat,...);
+void (*pdl_warn) (const char* pat,...);
+
+void (*make_physvaffine)(pdl *it);
+void (*allocdata) (pdl *it);
+PDL_Indx (*safe_indterm)(PDL_Indx dsz, PDL_Indx at, char *file, int lineno);
+
+float NaN_float;
+double NaN_double;
+
+!NO!SUBS!
+
+# set up the qsort routines
+
+ # fortunately it looks like Types.pm.PL is processed before this
+ # file
+ require "Types.pm"; # ie PDL::Types
+
+for (keys %PDL::Types::typehash) {
+ my $ctype = $PDL::Types::typehash{$_}{ctype};
+ my $ppsym = $PDL::Types::typehash{$_}{ppsym};
+
+ print OUT "void (*qsort_${ppsym}) (${ctype} *xx, PDL_Indx a, PDL_Indx b );\n";
+ print OUT "void (*qsort_ind_${ppsym}) (${ctype} *xx, PDL_Indx *ix, PDL_Indx a, PDL_Indx b );\n";
+}
+
+# storage space for bad values
+
+print OUT <<'!NO!SUBS!';
+
+ badvals bvals; /* store the default bad values */
+ void (*propogate_badflag) (pdl *it, int newval ); /* defined in bad.pd */
+ void (*propogate_badvalue) (pdl *it);
+ void (*children_changesoon)(pdl *it, int what);
+ void (*changed)(pdl *it, int what, int recursing);
+ void (*vaffinechanged)(pdl *it, int what);
+ double (*get_pdl_badvalue)(pdl *it);
+};
+
+typedef struct Core Core;
+
+Core *pdl__Core_get_Core(); /* INTERNAL TO CORE! DON'T CALL FROM OUTSIDE */
+
+/* __PDLCORE_H */
+#endif
+
+!NO!SUBS!
+
diff --git a/Basic/Core/pdlhash.c b/Basic/Core/pdlhash.c
new file mode 100644
index 0000000..4975a09
--- /dev/null
+++ b/Basic/Core/pdlhash.c
@@ -0,0 +1,87 @@
+
+/* pdlhash.c - functions for manipulating pdl hashes */
+
+
+#define PDL_CORE /* For certain ifdefs */
+#include "pdl.h" /* Data structure declarations */
+#include "pdlcore.h" /* Core declarations */
+
+/*
+ * DJB July 10 2006
+ * moved from pdlhash.c into Core.xs since it only seems to
+ * be used there (and is not defined in any .h file so
+ * should not be used by code outside Core/)
+ *
+ * Free the data if possible; used by mmapper
+void pdl_freedata (pdl *a) {
+ if(a->datasv) {
+ SvREFCNT_dec(a->datasv);
+ a->datasv=0;
+ a->data=0;
+ } else if(a->data) {
+ die("Trying to free data of untouchable (mmapped?) pdl");
+ }
+}
+*/
+
+/* Utility to change the size of the data compt of a pdl */
+
+void pdl_grow (pdl* a, PDL_Indx newsize) {
+
+ SV* foo;
+ HV* hash;
+ STRLEN nbytes;
+ STRLEN ncurr;
+ STRLEN len;
+
+ if(a->state & PDL_DONTTOUCHDATA) {
+ die("Trying to touch data of an untouchable (mmapped?) pdl");
+ }
+
+ if(a->datasv == NULL)
+ a->datasv = newSVpv("",0);
+
+ foo = a->datasv;
+
+ nbytes = ((STRLEN) newsize) * pdl_howbig(a->datatype);
+ ncurr = SvCUR( foo );
+ if (ncurr == nbytes)
+ return; /* Nothing to be done */
+
+/* We don't want to do this: if someone is resizing it
+ * but wanting to preserve data.. */
+#ifdef FEOIJFOESIJFOJE
+ if (ncurr>nbytes) /* Nuke back to zero */
+ sv_setpvn(foo,"",0);
+#endif
+ if(nbytes > (1024*1024*1024)) {
+ SV *sv = get_sv("PDL::BIGPDL",0);
+ if(sv == NULL || !(SvTRUE(sv)))
+ die("Probably false alloc of over 1Gb PDL! (set $PDL::BIGPDL = 1 to enable)");
+ fflush(stdout);
+ }
+
+ {
+ void *p;
+ p = SvGROW ( foo, nbytes ); SvCUR_set( foo, nbytes );
+ }
+ a->data = (void *) SvPV( foo, len ); a->nvals = newsize;
+}
+
+/* unpack dims array into Hash */
+
+void pdl_unpackarray ( HV* hash, char *key, PDL_Indx *dims, int ndims ) {
+
+ AV* array;
+ int i;
+
+ array = newAV();
+ (void)hv_store(hash, key, strlen(key), newRV( (SV*) array), 0 );
+
+ if (ndims==0 )
+ return;
+
+ for(i=0; i<ndims; i++)
+ av_store( array, i, newSViv( (IV)dims[i] ) );
+}
+
diff --git a/Basic/Core/pdlmagic.c b/Basic/Core/pdlmagic.c
new file mode 100644
index 0000000..1de7a1d
--- /dev/null
+++ b/Basic/Core/pdlmagic.c
@@ -0,0 +1,541 @@
+#define PDL_CORE /* For certain ifdefs */
+#ifndef WIN32
+#define USE_MMAP
+#else
+#undef USE_MMAP
+#endif
+
+#include "pdlcore.h"
+
+#ifdef USE_MMAP
+#include <sys/mman.h>
+#endif
+
+/* Variable storing our the pthread ID for the main PDL thread.
+ * This is used to tell if we are in the main pthread, or in one of
+ * the pthreads spawned for PDL processing
+ * This is only used when compiled with pthreads.
+ */
+#ifdef PDL_PTHREAD
+static pthread_t pdl_main_pthreadID;
+static int done_pdl_main_pthreadID_init = 0;
+
+/* deferred error messages are stored here. We can only barf/warn from the main
+ * thread, so worker threads complain here and the complaints are printed out
+ * altogether later
+ */
+static char* pdl_pthread_barf_msgs = NULL;
+static int pdl_pthread_barf_msgs_len = 0;
+static char* pdl_pthread_warn_msgs = NULL;
+static int pdl_pthread_warn_msgs_len = 0;
+
+#endif
+
+
+/* Singly linked list */
+/* Note that this zeroes ->next!) */
+
+void pdl__magic_add(pdl *it,pdl_magic *mag)
+{
+ pdl_magic **foo = &(it->magic);
+ while(*foo) {
+ foo = &((*foo)->next);
+ }
+ (*foo) = mag;
+ mag->next = NULL;
+}
+
+void pdl__magic_rm(pdl *it,pdl_magic *mag)
+{
+ pdl_magic **foo = &(it->magic);
+ int found = 0;
+ while(*foo) {
+ if(*foo == mag) {
+ *foo = (*foo)->next;
+ found = 1;
+ }
+ else{
+ foo = &((*foo)->next);
+ }
+ }
+ if( !found ){
+ die("PDL:Magic not found: Internal error\n");
+ }
+ return;
+}
+
+void pdl__magic_free(pdl *it)
+{
+ if (pdl__ismagic(it) && !pdl__magic_isundestroyable(it)) {
+ pdl_magic *foo = it->magic;
+ while(foo) {
+ pdl_magic *next = foo->next;
+ free(foo);
+ foo = next;
+ }
+ }
+}
+
+/* Test for undestroyability */
+
+int pdl__magic_isundestroyable(pdl *it)
+{
+ pdl_magic **foo = &(it->magic);
+ while(*foo) {
+ if((*foo)->what & PDL_MAGIC_UNDESTROYABLE) {return 1;}
+ foo = &((*foo)->next);
+ }
+ return 0;
+}
+
+/* Call magics */
+
+void *pdl__call_magic(pdl *it,int which)
+{
+ void *ret = NULL;
+ pdl_magic **foo = &(it->magic);
+ while(*foo) {
+ if((*foo)->what & which) {
+ if((*foo)->what & PDL_MAGIC_DELAYED)
+ pdl_add_delayed_magic(*foo);
+ else
+ ret = (void *)((*foo)->vtable->cast(*foo));
+ /* Cast spell */
+ }
+ foo = &((*foo)->next);
+ }
+ return ret;
+}
+
+/* XXX FINDS ONLY FIRST */
+pdl_magic *pdl__find_magic(pdl *it, int which)
+{
+ pdl_magic **foo = &(it->magic);
+ while(*foo) {
+ if((*foo)->what & which) {
+ return *foo;
+ }
+ foo = &((*foo)->next);
+ }
+ return NULL;
+}
+
+pdl_magic *pdl__print_magic(pdl *it)
+{
+ pdl_magic **foo = &(it->magic);
+ while(*foo) {
+ printf("Magic %p\ttype: ",(void*)(*foo));
+ if((*foo)->what & PDL_MAGIC_MARKCHANGED)
+ printf("PDL_MAGIC_MARKCHANGED");
+ else if ((*foo)->what & PDL_MAGIC_MUTATEDPARENT)
+ printf("PDL_MAGIC_MUTATEDPARENT");
+ else if ((*foo)->what & PDL_MAGIC_THREADING)
+ printf("PDL_MAGIC_THREADING");
+ else
+ printf("UNKNOWN");
+ if ((*foo)->what & (PDL_MAGIC_DELAYED|PDL_MAGIC_UNDESTROYABLE))
+ {
+ printf(" qualifier(s): ");
+ if ((*foo)->what & PDL_MAGIC_DELAYED)
+ printf(" PDL_MAGIC_DELAYED");
+ if ((*foo)->what & PDL_MAGIC_UNDESTROYABLE)
+ printf(" PDL_MAGIC_UNDESTROYABLE");
+ }
+ printf("\n");
+ foo = &((*foo)->next);
+ }
+ return NULL;
+}
+
+
+int pdl__ismagic(pdl *it)
+{
+ return (it->magic != 0);
+}
+
+static pdl_magic **delayed=NULL;
+static int ndelayed = 0;
+void pdl_add_delayed_magic(pdl_magic *mag) {
+ delayed = realloc(delayed,sizeof(*delayed)*++ndelayed);
+ delayed[ndelayed-1] = mag;
+}
+void pdl_run_delayed_magic() {
+ int i;
+ pdl_magic **oldd = delayed; /* In case someone makes new delayed stuff */
+ int nold = ndelayed;
+ delayed = NULL;
+ ndelayed = 0;
+ for(i=0; i<nold; i++) {
+ oldd[i]->vtable->cast(oldd[i]);
+ }
+ free(oldd);
+}
+
+/****************
+ *
+ * ->bind - magic
+ */
+
+void *svmagic_cast(pdl_magic *mag)
+{
+ pdl_magic_perlfunc *magp = (pdl_magic_perlfunc *)mag;
+ dSP;
+ PUSHMARK(sp);
+ perl_call_sv(magp->sv, G_DISCARD | G_NOARGS);
+ return NULL;
+}
+
+static pdl_magic_vtable svmagic_vtable = {
+ svmagic_cast,
+ NULL
+};
+
+pdl_magic *pdl_add_svmagic(pdl *it,SV *func)
+{
+ AV *av;
+ pdl_magic_perlfunc *ptr = malloc(sizeof(pdl_magic_perlfunc));
+ ptr->what = PDL_MAGIC_MARKCHANGED | PDL_MAGIC_DELAYED;
+ ptr->vtable = &svmagic_vtable;
+ ptr->sv = newSVsv(func);
+ ptr->pdl = it;
+ ptr->next = NULL;
+ pdl__magic_add(it,(pdl_magic *)ptr);
+ if(it->state & PDL_ANYCHANGED)
+ pdl_add_delayed_magic((pdl_magic *)ptr);
+/* In order to have our SV destroyed in time for the interpreter, */
+/* XXX Work this out not to memleak */
+ av = perl_get_av("PDL::disposable_svmagics",TRUE);
+ av_push(av,ptr->sv);
+ return (pdl_magic *)ptr;
+}
+
+
+/****************
+ *
+ * ->bind - magic
+ */
+
+pdl_trans *pdl_find_mutatedtrans(pdl *it)
+{
+ if(!it->magic) return 0;
+ return pdl__call_magic(it,PDL_MAGIC_MUTATEDPARENT);
+}
+
+static void *fammutmagic_cast(pdl_magic *mag)
+{
+ pdl_magic_fammut *magp = (pdl_magic_fammut *)mag;
+ return magp->ftr;
+}
+
+struct pdl_magic_vtable familymutmagic_vtable = {
+ fammutmagic_cast,
+ NULL
+};
+
+pdl_magic *pdl_add_fammutmagic(pdl *it,pdl_trans *ft)
+{
+ pdl_magic_fammut *ptr = malloc(sizeof(pdl_magic_fammut));
+ ptr->what = PDL_MAGIC_MUTATEDPARENT;
+ ptr->vtable = &familymutmagic_vtable;
+ ptr->ftr = ft;
+ ptr->pdl = it;
+ ptr->next = NULL;
+ pdl__magic_add(it,(pdl_magic *)ptr);
+ return (pdl_magic *)ptr;
+}
+
+#ifdef PDL_PTHREAD
+
+/**************
+ *
+ * pthreads
+ *
+ */
+
+#define TVERB 0
+
+typedef struct ptarg {
+ pdl_magic_pthread *mag;
+ void (*func)(pdl_trans *);
+ pdl_trans *t;
+ int no;
+} ptarg;
+
+int pdl_pthreads_enabled(void) {return 1;}
+
+
+static void *pthread_perform(void *vp) {
+ struct ptarg *p = (ptarg *)vp;
+ /* if(TVERB) printf("STARTING THREAD %d (%d)\n",p->no, pthread_self()); */
+ if(TVERB) printf("STARTING THREAD number %d\n",p->no);
+ pthread_setspecific(p->mag->key,(void *)&(p->no));
+ (p->func)(p->t);
+ /* if(TVERB) printf("ENDING THREAD %d (%d)\n",p->no, pthread_self()); */
+ if(TVERB) printf("ENDING THREAD number %d\n",p->no);
+ return NULL;
+}
+
+int pdl_magic_thread_nthreads(pdl *it,int *nthdim) {
+ pdl_magic_pthread *ptr = (pdl_magic_pthread *)pdl__find_magic(it, PDL_MAGIC_THREADING);
+ if(!ptr) return 0;
+ *nthdim = ptr->nthdim;
+ return ptr->nthreads;
+}
+
+int pdl_magic_get_thread(pdl *it) { /* XXX -> only one thread can handle pdl at once */
+ pdl_magic_pthread *ptr;
+ int *p;
+ ptr = (pdl_magic_pthread *)pdl__find_magic(it, PDL_MAGIC_THREADING);
+ if(!ptr) {die("Invalid pdl_magic_get_thread!");}
+ p = (int*)pthread_getspecific(ptr->key);
+ if(!p) {
+ die("Invalid pdl_magic_get_thread specific!!!!");
+ }
+ return *p;
+}
+
+void pdl_magic_thread_cast(pdl *it,void (*func)(pdl_trans *),pdl_trans *t, pdl_thread *thread) {
+ pdl_magic_pthread *ptr; pthread_t *tp; ptarg *tparg;
+ int i;
+ int clearMagic = 0; /* Flag = 1 if we are temporarily creating pthreading magic in the
+ supplied pdl. */
+ SV * barf_msg; /* Deferred barf message. Using a perl SV here so it's memory can be freeed by perl
+ after it is sent to croak */
+ SV * warn_msg; /* Similar deferred warn message. */
+
+ ptr = (pdl_magic_pthread *)pdl__find_magic(it, PDL_MAGIC_THREADING);
+ if(!ptr) {
+ /* Magic doesn't exist, create it
+ Probably was deleted before the transformation performed, due to
+ pdl lazy evaluation.
+ */
+
+ pdl_add_threading_magic(it, thread->mag_nth, thread->mag_nthr);
+ clearMagic = 1; /* Set flag to delete magic later */
+
+ /* Try to get magic again */
+ ptr = (pdl_magic_pthread *)pdl__find_magic(it, PDL_MAGIC_THREADING);
+
+ if(!ptr) {die("Invalid pdl_magic_thread_cast!");}
+
+ }
+
+ tp = malloc(sizeof(pthread_t) * thread->mag_nthr);
+ tparg = malloc(sizeof(*tparg) * thread->mag_nthr);
+ pthread_key_create(&(ptr->key),NULL);
+
+ if(TVERB) printf("CREATING THREADS, ME: TBD, key: %ld\n", (unsigned long)(ptr->key));
+
+ /* Get the pthread ID of this main thread we are in.
+ * Any barf, warn, etc calls in the spawned pthreads can use this
+ * to tell if its a spawned pthread
+ */
+ pdl_main_pthreadID = pthread_self(); /* should do inside pthread_once() */
+ done_pdl_main_pthreadID_init = 1;
+
+ for(i=0; i<thread->mag_nthr; i++) {
+ tparg[i].mag = ptr;
+ tparg[i].func = func;
+ tparg[i].t = t;
+ tparg[i].no = i;
+ if (pthread_create(tp+i, NULL, pthread_perform, tparg+i)) {
+ die("Unable to create pthreads!");
+ }
+ }
+
+ if(TVERB) printf("JOINING THREADS, ME: TBD, key: %ld\n", (unsigned long)(ptr->key));
+
+ for(i=0; i<thread->mag_nthr; i++) {
+ pthread_join(tp[i], NULL);
+ }
+
+ if(TVERB) printf("FINISHED THREADS, ME: TBD, key: %ld\n", (unsigned long)(ptr->key));
+
+ pthread_key_delete((ptr->key));
+
+ /* Remove pthread magic if we created in this function */
+ if( clearMagic ){
+ pdl_add_threading_magic(it, -1, -1);
+ }
+
+ /* Clean up memory allocated */
+ free(tp);
+ free(tparg);
+
+ // handle any errors that may have occured in the worker threads I reset the
+ // length before actually barfing/warning because barf() may not come back.
+ // In that case, I'll have len==0, but an unfreed pointer. This memory will
+ // be reclaimed the next time we barf/warn something (since I'm using
+ // realloc). If we never barf/warn again, we'll hold onto this memory until
+ // the interpreter exits. This is a one-time penalty, though so it's fine
+#define handle_deferred_errors(type) \
+ do{ \
+ if(pdl_pthread_##type##_msgs_len != 0) \
+ { \
+ pdl_pthread_##type##_msgs_len = 0; \
+ pdl_##type ("%s", pdl_pthread_##type##_msgs); \
+ free(pdl_pthread_##type##_msgs); \
+ pdl_pthread_##type##_msgs = NULL; \
+ } \
+ } while(0)
+
+ handle_deferred_errors(warn);
+ handle_deferred_errors(barf);
+}
+
+/* Function to remove threading magic (added by pdl_add_threading_magic) */
+void pdl_rm_threading_magic(pdl *it)
+{
+ pdl_magic_pthread *ptr = (pdl_magic_pthread *)pdl__find_magic(it, PDL_MAGIC_THREADING);
+
+ /* Don't do anything if threading magic not found */
+ if( !ptr) return;
+
+ /* Remove magic */
+ pdl__magic_rm(it, (pdl_magic *) ptr);
+
+ /* Free magic */
+ free( ptr );
+}
+
+/* Function to add threading magic (i.e. identify which PDL dimension should
+ be pthreaded and how many pthreads to create
+ Note: If nthdim and nthreads = -1 then any pthreading magic is removed */
+void pdl_add_threading_magic(pdl *it,int nthdim,int nthreads)
+{
+ pdl_magic_pthread *ptr;
+
+ /* Remove threading magic if called with parms -1, -1 */
+ if( (nthdim == -1) && ( nthreads == -1 ) ){
+ pdl_rm_threading_magic(it);
+ return;
+ }
+
+ ptr = malloc(sizeof(pdl_magic_pthread));
+ ptr->what = PDL_MAGIC_THREADING;
+ ptr->vtable = NULL;
+ ptr->next = NULL;
+ ptr->nthdim = nthdim;
+ ptr->nthreads = nthreads;
+ pdl__magic_add(it,(pdl_magic *)ptr);
+}
+
+// Barf/warn function for deferred barf message handling during pthreading We
+// can't barf/warn during ptheading, because perl-level code isn't
+// threadsafe. This routine does nothing if we're in the main thread (allowing
+// the caller to barf normally, since there are not threading issues then). If
+// we're in a worker thread, this routine stores the message for main-thread
+// reporting later
+int pdl_pthread_barf_or_warn(const char* pat, int iswarn, va_list *args)
+{
+ char** msgs;
+ int* len;
+
+ /* Don't do anything if we are in the main pthread */
+ if( !done_pdl_main_pthreadID_init || pthread_equal( pdl_main_pthreadID, pthread_self() ) )
+ return 0;
+
+ if(iswarn)
+ {
+ msgs = &pdl_pthread_warn_msgs;
+ len = &pdl_pthread_warn_msgs_len;
+ }
+ else
+ {
+ msgs = &pdl_pthread_barf_msgs;
+ len = &pdl_pthread_barf_msgs_len;
+ }
+
+ // add the new complaint to the list
+ {
+ static pthread_mutex_t mutex = PTHREAD_MUTEX_INITIALIZER;
+ pthread_mutex_lock( &mutex );
+ {
+ // In the chunk I'm adding I need to store the actual data and a trailing
+ // newline.
+ int extralen = vsnprintf(NULL, 0, pat, *args) + 1;
+
+ // 1 more for the trailing '\0'. (For windows, we first #undef realloc
+ // so that the system realloc function is used instead of the PerlMem_realloc
+ // macro. This currently works fine, though could conceivably require some
+ // tweaking in the future if it's found to cause any problem.)
+#ifdef WIN32
+#undef realloc
+#endif
+ *msgs = realloc(*msgs, *len + extralen + 1);
+ vsnprintf( *msgs + *len, extralen + 1, pat, *args);
+
+ // update the length-so-far. This does NOT include the trailing '\0'
+ *len += extralen;
+
+ // add the newline to the end
+ (*msgs)[*len-1] = '\n';
+ (*msgs)[*len ] = '\0';
+ }
+ pthread_mutex_unlock( &mutex );
+ }
+
+ if(iswarn)
+ {
+ /* Return 1, indicating we have handled the warn messages */
+ return(1);
+ }
+
+ /* Exit the current pthread. Since this was a barf call, and we should be halting execution */
+ pthread_exit(NULL);
+ return 0;
+}
+
+
+#else
+/* Dummy versions */
+void pdl_add_threading_magic(pdl *it,int nthdim,int nthreads) {}
+int pdl_magic_get_thread(pdl *it) {return 0;}
+void pdl_magic_thread_cast(pdl *it,void (*func)(pdl_trans *),pdl_trans *t, pdl_thread *thread) {}
+int pdl_magic_thread_nthreads(pdl *it,int *nthdim) {return 0;}
+int pdl_pthreads_enabled() {return 0;}
+int pdl_pthread_barf_or_warn(const char* pat, int iswarn, va_list *args){ return 0;}
+#endif
+
+/***************************
+ *
+ * Delete magic
+ *
+ */
+
+
+void pdl_delete_mmapped_data(pdl *p, Size_t param)
+{
+ if(!p) {return;}
+ if(!p->data) {return;}
+#ifdef USE_MMAP
+ munmap(p->data, param);
+#else
+ /* croak("internal error: trying to delete mmaped data on unsupported platform"); */
+#endif
+ p->data = 0;
+}
+
+static void *delete_mmapped_cast(pdl_magic *mag)
+{
+ pdl_magic_deletedata *magp = (pdl_magic_deletedata *)mag;
+ magp->func(magp->pdl, magp->param);
+ return NULL;
+}
+
+struct pdl_magic_vtable deletedatamagic_vtable = {
+ delete_mmapped_cast,
+ NULL
+};
+
+void pdl_add_deletedata_magic(pdl *it, void (*func)(pdl *, Size_t param), Size_t param)
+{
+ pdl_magic_deletedata *ptr = malloc(sizeof(pdl_magic_deletedata));
+ ptr->what = PDL_MAGIC_DELETEDATA;
+ ptr->vtable = &deletedatamagic_vtable;
+ ptr->pdl = it;
+ ptr->func = func;
+ ptr->param = param;
+ pdl__magic_add(it, (pdl_magic *)ptr);
+}
+
diff --git a/Basic/Core/pdlmagic.h b/Basic/Core/pdlmagic.h
new file mode 100644
index 0000000..0ed6419
--- /dev/null
+++ b/Basic/Core/pdlmagic.h
@@ -0,0 +1,140 @@
+#ifndef _pdlmagic_H_
+#define _pdlmagic_H_
+
+#define PDL_ISMAGIC(it) ((it)->magic != 0)
+
+/* Magic stuff */
+
+struct pdl_magic;
+
+/* If no copy, not copied with the pdl */
+typedef struct pdl_magic_vtable {
+ void *(*cast)(struct pdl_magic *); /* Cast the spell */
+ struct pdl_magic *(*copy)(struct pdl_magic *);
+/* void *(*cast_tr)(struct pdl_magic *,XXX);
+ * int (*nth_tr)(struct pdl_magic *,XXX);
+ */
+} pdl_magic_vtable;
+
+#define PDL_MAGIC_MARKCHANGED 0x0001
+#define PDL_MAGIC_MUTATEDPARENT 0x0002
+#define PDL_MAGIC_THREADING 0x0004
+#define PDL_MAGIC_DELETEDATA 0x0008
+
+#define PDL_MAGIC_UNDESTROYABLE 0x4000 /* Someone is referring to this */
+ /* when magic removed, call pdl_destroy */
+#define PDL_MAGIC_DELAYED 0x8000
+
+#define PDL_MAGICSTART \
+ int what; /* when is this magic to be called */ \
+ pdl_magic_vtable *vtable; \
+ struct pdl_magic *next; \
+ pdl *pdl
+
+#define PDL_TRMAGICSTART \
+ int what; /* when is this magic to be called */ \
+ pdl_magic_vtable *vtable; \
+ struct pdl_magic *next; \
+ pdl_trans *tr
+
+typedef struct pdl_magic {
+ PDL_MAGICSTART;
+} pdl_magic;
+
+typedef struct pdl_magic_perlfunc {
+ PDL_MAGICSTART;
+ SV *sv; /* sub{} or subname (perl_call_sv) */
+} pdl_magic_perlfunc;
+
+typedef struct pdl_magic_fammut {
+ PDL_MAGICSTART;
+ pdl_trans *ftr;
+} pdl_magic_fammut;
+
+typedef struct pdl_magic_changetrans {
+ PDL_MAGICSTART;
+ pdl_trans *tr;
+} pdl_magic_changetrans;
+
+typedef struct pdl_magic_deletedata {
+ PDL_MAGICSTART;
+ void (*func)(pdl *p, Size_t param);
+ Size_t param;
+} pdl_magic_deletedata;
+
+/* #define PDL_PTHREAD */
+/* Defined by MakeMaker */
+#ifdef PDL_PTHREAD
+
+/* This is a workaround to a perl CORE "feature" where they define a
+ * macro PTHREAD_CREATE_JOINABLE with the same name as POSIX threads
+ * which works as long as the implementation of POSIX threads also
+ * uses macros. As is, the use of the same name space breaks for
+ * win32 pthreads where the identifiers are enums and not #defines
+ */
+#ifdef PTHREAD_CREATE_JOINABLE
+#undef PTHREAD_CREATE_JOINABLE
+#endif
+
+#include <pthread.h>
+
+typedef struct pdl_magic_pthread {
+ PDL_MAGICSTART;
+ int nthdim;
+ int nthreads;
+ pthread_key_t key;
+} pdl_magic_pthread;
+#endif
+
+/* - tr magics */
+
+typedef struct pdl_trmagic {
+ PDL_TRMAGICSTART;
+} pdl_trmagic;
+
+typedef struct pdl_trmagic_family {
+ PDL_TRMAGICSTART;
+ pdl *fprog,*tprog;
+ pdl *fmut,*tmut;
+} pdl_trmagic_family;
+
+/* __ = Don't call from outside pdl if you don't know what you're doing */
+
+void pdl__magic_add(pdl *,pdl_magic *);
+void pdl__magic_rm(pdl *,pdl_magic *);
+void pdl__magic_free(pdl *);
+
+int pdl__magic_isundestroyable(pdl *);
+
+void *pdl__call_magic(pdl *,int which);
+int pdl__ismagic(pdl *);
+
+pdl_magic *pdl__print_magic(pdl *it);
+
+pdl_magic *pdl_add_svmagic(pdl *,SV *);
+
+/* A kind of "dowhenidle" system */
+
+void pdl_add_delayed_magic(pdl_magic *);
+void pdl_run_delayed_magic();
+
+pdl_trans *pdl_find_mutatedtrans(pdl *it);
+
+/* Threading magic */
+
+/* Deferred barfing and warning when pthreading */
+int pdl_pthread_barf_or_warn(const char* pat, int iswarn, va_list *args);
+
+void pdl_add_threading_magic(pdl *,int nthdim,int nthreads);
+
+int pdl_magic_thread_nthreads(pdl *,int *nthdim);
+int pdl_magic_get_thread(pdl *); /* XXX -> only one thread can handle pdl at once */
+
+void pdl_magic_thread_cast(pdl *,void (*func)(pdl_trans *),pdl_trans *t, pdl_thread *thread);
+int pdl_pthreads_enabled(void);
+
+/* Delete data magic */
+void pdl_delete_mmapped_data(pdl *p, Size_t param) ;
+void pdl_add_deletedata_magic(pdl *it,void (*func)(pdl *, Size_t param), Size_t param);
+
+#endif /* _pdlmagic_H_ */
diff --git a/Basic/Core/pdlsections.g b/Basic/Core/pdlsections.g
new file mode 100644
index 0000000..ae20a86
--- /dev/null
+++ b/Basic/Core/pdlsections.g
@@ -0,0 +1,264 @@
+
+
+/***************************************************************
+
+ pdlsections.c
+
+****************************************************************/
+
+#define PDL_CORE /* For certain ifdefs */
+#include "pdl.h" /* Data structure declarations */
+#include "pdlcore.h" /* Core declarations */
+
+
+
+/*
+ Code for subsection handling - extraction/insertion. Works
+ for arbitrary dimensionality of data.
+*/
+
+
+/* Compute offset of (x,y,z,...) position in row-major list */
+
+PDL_Indx pdl_get_offset(PDL_Indx* pos, PDL_Indx* dims, PDL_Indx *incs, PDL_Indx offset, int ndims) {
+ int i;
+ PDL_Indx result;
+ result = offset;
+ for (i=0; i<ndims; i++) {
+ result = result + (pos[i]+((pos[i]<0)?dims[i]:0))*incs[i];
+ }
+ return result;
+}
+
+/* Check validity of section - return number of elements in it */
+
+PDL_Indx pdl_validate_section( PDL_Indx* sec, PDL_Indx* dims, int ndims ){
+
+ PDL_Indx i,start,end,count;
+
+ count=1;
+
+ for(i=0;i<ndims;i++){
+
+ if (dims[i]<=0 || ndims==0) /* Never happens :-) */
+ croak("PDL object has a dimension <=0 !");
+
+ start = sec[2*i];
+ end = sec[2*i+1];
+
+ if (start<0 || end<0 || start>end || end>=dims[i])
+ croak("Invalid subsection specified");
+
+ count = count * (end-start+1);
+ }
+ return count;
+}
+
+/* Increrement a position pointer array by one row */
+
+void pdl_row_plusplus ( PDL_Indx* pos, PDL_Indx* dims, int ndims ) {
+
+ int i, noescape;
+
+ i=1; noescape=1;
+
+ while(noescape) {
+
+ (pos[i])++;
+
+ if (pos[i]==dims[i]) { /* Carry */
+ if (i>=(ndims)-1) {
+ noescape = 0; /* Exit */
+ }else{
+ pos[i]=0;
+ i++;
+ }
+ }else{
+ noescape = 0; /* Exit */
+ }
+ }
+}
+
+/* Take the N-dimensional subsection of an N-dimensional array */
+
+#ifdef FOOBAR
+
+void pdl_subsection( char *y, char*x, int datatype, PDL_Indx* sec,
+ PDL_Indx* dims, PDL_Indx *incs, PDL_Indx offs, int* ndims) {
+
+
+ /* Note dims, ndims are altered and returned to reflect the new section */
+
+ PDL_Indx *start,*end;
+ int i,n1,n2,nrow,count,dsize;
+ PDL_Indx n1,n2,nrow,count;
+
+ /* Seperate section into start and end arrays - KISS! */
+
+ start = (PDL_Indx *) pdl_malloc( (*ndims)*sizeof(PDL_Indx) );
+ end = (PDL_Indx *) pdl_malloc( (*ndims)*sizeof(PDL_Indx) );
+
+ if (start == NULL || end == NULL)
+ croak("Out of memory");
+
+ for(i=0;i<*ndims;i++){
+ start[i] = sec[2*i];
+ end[i] = sec[2*i+1];
+ }
+
+ n1 = pdl_get_offset(start, dims, incs, offs, *ndims); /* Start pos */
+ n2 = pdl_get_offset(end, dims, incs, offs, *ndims); /* End pos */
+
+ dsize = pdl_howbig(datatype); /* Size of item */
+
+ nrow = end[0]-start[0]+1; /* Size of a row chunk */
+ count = 0; /* Transfer count */
+
+ while(n1<=n2) {
+
+ memcpy( y+count*dsize, x+n1*dsize, nrow*dsize ); /* Copy row */
+ count += nrow;
+ if (*ndims<2)
+ break;
+ pdl_row_plusplus( start, dims, *ndims ); /* Incr start[] one row */
+ n1 = pdl_get_offset(start, dims, incs, offs, *ndims); /* New pos */
+
+ }
+
+ /* Calculate new dimensions */
+
+ for(i=0;i<*ndims;i++)
+ dims[i] = sec[2*i+1]-sec[2*i]+1;
+
+ /* Remove trailing degenerate unary dimensions */
+
+ while( (*ndims)>1 && dims[(*ndims)-1] == 1 )
+ (*ndims)--;
+
+ /* Remove leading degenerate unary dimensions */
+
+ while( (*ndims)>1 && *dims == 1 ) {
+ for(i=0;i<(*ndims)-1;i++)
+ dims[i]=dims[i+1]; /* Shuffle down */
+ (*ndims)--;
+ }
+}
+
+/* Insert one N-dimensional array in another */
+
+void pdl_insertin( char*y, PDL_Indx* ydims, int nydims,
+ char*x, PDL_Indx* xdims, int nxdims,
+ int datatype, PDL_Indx* pos) {
+
+ /* Note inserts x[] in y[] */
+
+ int i,dsize;
+ PDL_Indx nyvals,nxvals,n1,n2,nrow,ntran;
+
+ nyvals = 1; nxvals = 1;
+
+ for(i=0; i<nydims; i++) { /* Check position */
+
+ nyvals *= ydims[i]; /* Compute total elements */
+
+ if(pos[i]<0 || pos[i]>=ydims[i])
+ croak("Position out of range");
+ }
+
+ nxvals = 1;
+ for(i=0; i<nxdims; i++) /* Compute total elements */
+ nxvals *= xdims[i];
+
+
+ n1 = pdl_get_offset(pos, ydims, yincs, offset, nydims); /* Start pos in Y */
+ n2 = 0; /* Start pos in X */
+
+ nrow = xdims[0]; /* Size of a row chunk */
+ ntran = nrow; /* Amount to transfer per row */
+ if (pos[0]+nrow-1 > ydims[0]) /* Edge overflow */
+ ntran = ydims[0]-pos[0];
+
+ dsize = pdl_howbig(datatype);
+
+ while(n2<nxvals) { /* Copy those bytes... */
+
+ memcpy( y+n1*dsize, x+n2*dsize, ntran*dsize );
+
+ if (nydims<2)
+ break;
+ pdl_row_plusplus( pos, ydims, nydims); /* Incr pos[] one row */
+
+ n1 = pdl_get_offset( pos, ydims, incs, nydims); /* New pos in Z */
+
+ if (n1>=nyvals) /* Off Y image */
+ break;
+
+ n2 += nrow; /* New pos in X */
+
+ }
+
+}
+
+#endif
+
+
+/* Return value at position (x,y,z...) */
+
+double pdl_at( void* x, int datatype, PDL_Indx* pos, PDL_Indx* dims,
+ PDL_Indx* incs, PDL_Indx offset, int ndims) {
+
+ int i;
+ PDL_Indx ioff;
+ double result;
+
+ for(i=0; i<ndims; i++) { /* Check */
+
+ /* leave pdl_get_offset to handle -ve offsets (i.e. from end of
+ dimension), so elements of pos[] won't be changed */
+
+ if(pos[i]<-dims[i] || pos[i]>=dims[i])
+ croak("Position out of range");
+ }
+
+ ioff = pdl_get_offset(pos, dims, incs, offset, ndims);
+
+ GENERICLOOP (datatype)
+
+ generic *xx = (generic *) x;
+ result = (double)xx[ioff];
+
+ ENDGENERICLOOP
+
+#ifdef MACOS_MZERO_BRAINDAMAGE
+ if(!result)
+ result=0;
+#endif
+
+ return result;
+}
+
+/* Set value at position (x,y,z...) */
+
+void pdl_set( void* x, int datatype, PDL_Indx* pos, PDL_Indx* dims, PDL_Indx* incs, PDL_Indx offs, int ndims, double value){
+
+ int i;
+ PDL_Indx ioff;
+
+ for(i=0; i<ndims; i++) { /* Check */
+
+ if(pos[i]<-dims[i] || pos[i]>=dims[i])
+ croak("Position out of range");
+ }
+
+ ioff = pdl_get_offset(pos, dims, incs, offs, ndims);
+
+ GENERICLOOP (datatype)
+
+ generic *xx = (generic *) x;
+ xx[ioff] = value;
+
+ ENDGENERICLOOP
+}
+
+
+
diff --git a/Basic/Core/pdlsimple.h.PL b/Basic/Core/pdlsimple.h.PL
new file mode 100644
index 0000000..9557d2e
--- /dev/null
+++ b/Basic/Core/pdlsimple.h.PL
@@ -0,0 +1,59 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+require "pdl_hfiles.p";
+
+# List explicitly here the variables you want Configure to
+# generate. Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries. Thus you write
+# $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+my $file;
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($Config{'osname'} eq 'VMS' or
+ $Config{'osname'} eq 'OS2'); # "case-forgiving"
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+
+#ifndef __PDL_H
+
+/* These are kept automaticallu in sync with pdl.h during perl build */
+
+$PDL_DATATYPES
+
+#endif
+
+/*
+ Define a simple pdl C data structure which maps onto passed
+ piddles for passing with callext().
+
+ Note it is up to the user at the perl level to get the datatype
+ right. Anything more sophisticated probably ought to go through
+ PP anyway (which is fairly trivial).
+*/
+
+struct pdlsimple {
+ int datatype; /* whether byte/int/float etc. */
+ void *data; /* Generic pointer to the data block */
+ PDL_Indx nvals; /* Number of data values */
+ PDL_Indx *dims; /* Array of data dimensions */
+ PDL_Long ndims; /* Number of data dimensions */
+};
+
+typedef struct pdlsimple pdlsimple;
+
+!GROK!THIS!
diff --git a/Basic/Core/pdltest.c b/Basic/Core/pdltest.c
new file mode 100644
index 0000000..b5c8d4a
--- /dev/null
+++ b/Basic/Core/pdltest.c
@@ -0,0 +1,49 @@
+
+/* A small test program for the new create / delete routines */
+
+int main() {
+ pdl *bar;
+ pdl *foo = pdl_create(PDL_PERM);
+ int inds[2] = {1,1};
+ pdl_dump(foo);
+
+ pdl_reallocdims(foo,2);
+ foo->dims[0] = 5;
+ foo->dims[1] = 6;
+ pdl_reallocphysdata(foo);
+
+ pdl_dump(foo);
+
+ bar = pdl_createtrans(foo, pdl_affine_rectslice_transvtable);
+ pdl_dump(bar);
+ pdl_trans_affine_rectslice *trans =
+ ((pdl_trans_affine_rectslice *)(foo->trans));
+
+ trans->starts[0] = 1;
+ trans->ends[0] = 3;
+
+ trans->starts[1] = 2;
+ trans->ends[1] = 4;
+ trans->steps[1] = 2;
+
+ pdl_transchanged(bar);
+
+ pdl_dump(bar);
+
+ pdl_make_physical_affine(bar);
+
+ pdl_dump(bar);
+
+ pdl_make_physical(bar);
+
+ pdl_dump(bar);
+
+ pdl_set(bar,2.0,inds);
+ pdl_changed(bar);
+
+ pdl_dump(foo);
+
+ pdl_make_physical_affine(foo);
+}
+
+
diff --git a/Basic/Core/pdlthread.c b/Basic/Core/pdlthread.c
new file mode 100644
index 0000000..e3e299a
--- /dev/null
+++ b/Basic/Core/pdlthread.c
@@ -0,0 +1,708 @@
+/* XXX NOTE THAT IT IS NOT SAFE TO USE ->pdls MEMBER OUTSIDE
+ INITTHREADSTRUCT! */
+
+#define PDL_CORE /* For certain ifdefs */
+#include "pdl.h" /* Data structure declarations */
+#include "pdlcore.h" /* Core declarations */
+
+
+#define MAX2(a,b) if((b)>(a)) a=b;
+
+/*
+ * We used to use our own copy of strndup but there were
+ * compiler warnings about redefining the symbol, so I have
+ * changed to using the Perl C API - see 'perldoc perlapi'
+ * and 'perldoc perlcapi' - and created the copy_int/pdl_array
+ * routines . The returned arrays should be released using
+ * Perl's Safefree call.
+ *
+ * DJB 2007 March 18. Previous version is v1.6 of pdlthread.c
+ */
+static PDL_Indx *copy_int_array (PDL_Indx *from, int size) {
+ int *to;
+ Newx (to, size, int);
+ return (PDL_Indx *) CopyD (from, to, size, int);
+}
+
+static pdl **copy_pdl_array (pdl **from, int size) {
+ pdl **to;
+ Newx (to, size, pdl*);
+ return (pdl **) CopyD (from, to, size, pdl*);
+}
+
+static void print_iarr(PDL_Indx *iarr, int n) {
+ int i;
+ printf("(");
+ for (i=0;i<n;i++)
+ // printf("%s%d",(i?" ":""),iarr[i]);
+ printf("%s%lld",(i?" ":""),iarr[i]); // hardwire for test, get from %Config
+ printf(")");
+}
+
+#define psp printf("%s",spaces)
+void dump_thread(pdl_thread *thread) {
+ int i;
+ char spaces[] = " ";
+ printf("DUMPTHREAD %p \n",(void*)thread);
+ if (0&& thread->einfo) {
+ psp; printf("Funcname: %s\n",thread->einfo->funcname);
+ psp; printf("Paramaters: ");
+ for (i=0;i<thread->einfo->nparamnames;i++)
+ printf("%s ",thread->einfo->paramnames[i]);
+ printf("\n");
+ }
+ psp; printf("Flags: %d, Ndims: %d, Nimplicit: %d, Npdls: %d, Nextra: %d\n",
+ thread->gflags,thread->ndims,thread->nimpl,thread->npdls,thread->nextra);
+
+ psp; printf("Dims: "); print_iarr(thread->dims,thread->ndims); printf("\n");
+ psp; printf("Inds: "); print_iarr(thread->inds,thread->ndims); printf("\n");
+ psp; printf("Offs: "); print_iarr(thread->offs,thread->npdls); printf("\n");
+ psp; printf("Incs: "); print_iarr(thread->incs,thread->ndims); printf("\n");
+ psp; printf("Realdims: "); print_iarr(thread->realdims,thread->npdls); printf("\n");
+ psp; printf("Pdls: (");
+ for (i=0;i<thread->npdls;i++)
+ printf("%s%p",(i?" ":""),(void*)(thread->pdls[i]));
+ printf(")\n");
+ psp; printf("Per pdl flags: (");
+ for (i=0;i<thread->npdls;i++)
+ printf("%s%d",(i?" ":""),thread->flags[i]);
+ printf(")\n");
+}
+
+
+/* Function to get the pthread-specific offset
+ Input: thread structure
+ Outputs: Pointer to pthread-specific offset array (returned by function)
+*/
+PDL_Indx *pdl_get_threadoffsp(pdl_thread *thread )
+{
+ if(thread->gflags & PDL_THREAD_MAGICKED) {
+ int thr = pdl_magic_get_thread(thread->pdls[thread->mag_nthpdl]);
+ return thread->offs + thr * thread->npdls;
+ }
+/* The non-multithreaded case: return just the usual offsets */
+ return thread->offs;
+}
+
+
+
+/* Function to get the pthread-specific offset, indexes and pthread number for the supplied thread structure
+ Input: thread structure
+ Outputs: Pointer to pthread-specific offset array (returned by function)
+ Pointer to pthread-specific index array (ind Pointer supplied and modified by function)
+ Pthread index for the current pthread ( nthr supplied and modified by function)
+
+*/
+PDL_Indx* pdl_get_threadoffsp_int(pdl_thread *thread, int *nthr, PDL_Indx **inds)
+{
+ if(thread->gflags & PDL_THREAD_MAGICKED) {
+ int thr = pdl_magic_get_thread(thread->pdls[thread->mag_nthpdl]);
+ *nthr = thr;
+ *inds = thread->inds + thr * thread->ndims;
+ return thread->offs + thr * thread->npdls;
+ }
+ *nthr = 0;
+/* The non-multithreaded case: return just the usual offsets */
+ *inds = thread->inds;
+ return thread->offs;
+}
+
+void pdl_thread_copy(pdl_thread *from,pdl_thread *to) {
+#ifdef PDL_THREAD_DEBUG
+ to->magicno = from->magicno;
+#endif
+ to->gflags = from->gflags;
+ to->einfo = from->einfo;
+ to->ndims = from->ndims;
+ to->nimpl = from->nimpl;
+ to->npdls = from->npdls;
+
+ to->inds = copy_int_array(from->inds,to->ndims);
+ to->dims = copy_int_array(from->dims,to->ndims);
+ to->offs = copy_int_array(from->offs,to->npdls);
+ to->incs = copy_int_array(from->incs,to->npdls*to->ndims);
+ to->realdims = from->realdims;
+ to->flags = savepvn(from->flags,to->npdls);
+ to->pdls = copy_pdl_array(from->pdls,to->npdls); /* XX MEMLEAK */
+
+ to->mag_nthpdl = from->mag_nth;
+ to->mag_nthpdl = from->mag_nthpdl;
+}
+
+void pdl_freethreadloop(pdl_thread *thread) {
+ PDLDEBUG_f(printf("Freethreadloop(%p, %p %p %p %p %p %p)\n",
+ (void*)thread,
+ (void*)(thread->inds), (void*)(thread->dims), (void*)(thread->offs),
+ (void*)(thread->incs), (void*)(thread->flags), (void*)(thread->pdls));)
+ if(!thread->inds) {return;}
+ Safefree(thread->inds);
+ Safefree(thread->dims);
+ Safefree(thread->offs);
+ Safefree(thread->incs);
+ Safefree(thread->flags);
+ Safefree(thread->pdls);
+ pdl_clearthreadstruct(thread);
+}
+
+void pdl_clearthreadstruct(pdl_thread *it) {
+ PDLDEBUG_f(printf("Clearthreadloop(%p)\n", (void*)it);)
+ it->einfo = 0;it->inds = 0;it->dims = 0;
+ it->ndims = it->nimpl = it->npdls = 0; it->offs = 0;
+ it->pdls = 0;it->incs = 0; it->realdims=0; it->flags=0;
+ it->gflags=0; /* unsets PDL_THREAD_INITIALIZED among others */
+#ifdef PDL_THREAD_DEBUG
+ PDL_THR_CLRMAGIC(it);
+#endif
+}
+
+
+/* Function to auto-add pthreading magic (i.e. hints for multiple processor threads )
+ to the pdls, based on the target number of pthreads and the pdl-threaded dimensions
+ .
+ Number of pthreads is limited to a even division of the size of the threaded dimension.
+ (e.g. if threaded dim of size 10 and the target number of pthreads is 2, 10/2 = 5 even,
+ so the two pthreads will be created to process.
+ However if thread dim is size 9 and target number of pthreads is 2, 9 can't be divided
+ by 2, so no extra pthreads will be created.
+ )
+ noPthreadFlag is a flag indicating that the pdl thread that called this function is not multiple
+ processor threading safe, so no pthreading magic will be added
+*/
+void pdl_autopthreadmagic( pdl **pdls, int npdls, PDL_Indx* realdims, PDL_Indx* creating, int noPthreadFlag ){
+
+ int j, nthrd, totalDims, *nthreadedDims, **threadedDims;
+ PDL_Indx **threadedDimSizes;
+ PDL_Indx largest_nvals = 0; /* The largest PDL size for all the pdls involvled */
+
+ int t; /* Thread index for each pdl */
+ int tdimStart; /* Start of the threaded dims for each pdl */
+ int k; /* threadedDims array index for each pdl */
+ int nthreadDim; /* Number of thread dims for the current pdl */
+
+ int maxPthreadPDL; /* PDL that has the max (or right at the target) num pthreads */
+ int maxPthreadDim; /* Threaded dim number that has the max num pthreads */
+ int maxPthread = 0; /* Maximum achievable pthread */
+
+ int target_pthread = pdl_autopthread_targ;
+ pdl_autopthread_actual = 0; /* Initialize the global variable indicating actual number of pthreads */
+
+ /* Don't do anything if auto_pthreading is turned off (i.e. equal zero) */
+ if( !target_pthread ) return;
+
+ /* Remove any existing threading magic */
+ for(j=0; j<npdls; j++) {
+ if(creating[j]) continue;
+
+ /* Remove thread magic, if there is some set for this pdl */
+ if( pdls[j]->magic &&
+ (pdl_magic_thread_nthreads(pdls[j],&nthrd))) {
+ pdl_add_threading_magic(pdls[j], -1, -1);
+ }
+ }
+
+ if( noPthreadFlag ) return; /* Don't go further if the current pdl function isn't thread-safe */
+
+
+ /* Find the largest nvals */
+ for(j=0; j<npdls; j++) {
+ if(creating[j]) continue;
+ if( pdls[j]->nvals > largest_nvals ){
+ largest_nvals = pdls[j]->nvals;
+ }
+ }
+
+ /* See if the largest nvals is above the auto_pthread threadshold */
+ largest_nvals = largest_nvals>>20; /* Convert to MBytes */
+
+ /* Don't do anything if we are lower than the threshold */
+ if( largest_nvals < pdl_autopthread_size )
+ return;
+
+
+ /* Build int arrays of threaded dim numbers and sizes for each pdl */
+ nthreadedDims = (int*) malloc(sizeof(int) * (npdls));
+ threadedDims = (int**) malloc(sizeof(int *) * (npdls));
+ threadedDimSizes = (PDL_Indx**) malloc(sizeof(PDL_Indx *) * (npdls));
+
+
+ /* Find total number of dims and allocate */
+ totalDims = 0;
+ for(j=0; j<npdls; j++) {
+ if(creating[j]) continue;
+ threadedDims[j] = (int*) malloc(sizeof(int) * pdls[j]->ndims);
+ threadedDimSizes[j] = (PDL_Indx*) malloc(sizeof(PDL_Indx) * pdls[j]->ndims);
+ }
+
+
+
+ for(j=0; j<npdls; j++) {
+ if(creating[j]) continue;
+ tdimStart = realdims[j];
+ nthreadDim = 0;
+ for( k=0, t = tdimStart; t < pdls[j]->ndims; t++, k++ ){
+ threadedDimSizes[j][k] = pdls[j]->dims[t];
+ threadedDims[j][k] = t;
+ nthreadDim++;
+ }
+ nthreadedDims[j] = nthreadDim;
+
+
+ }
+
+ /* Go thru each theaded dim and see how many pthreads we can create closest
+ to the maximum target pthreads */
+ for(j=0; j<npdls; j++) {
+ if(creating[j]) continue;
+ for( k=0; k < nthreadedDims[j]; k++){
+ int pthreadActual = target_pthread +1;
+ int remainder = 1;
+ /* Go from the target pthread to 1, untill we get an even division of the dimension size */
+ while( (pthreadActual > 0) && (remainder > 0) ){
+ pthreadActual--;
+ remainder = threadedDimSizes[j][k] % pthreadActual;
+ }
+
+ if( pthreadActual > maxPthread ){ /* Record this dim if it is the max */
+ maxPthread = pthreadActual;
+ maxPthreadPDL = j;
+ maxPthreadDim = threadedDims[j][k];
+ }
+
+ /* Don't go any further if target pthread achieved */
+ if( pthreadActual == target_pthread ) break;
+ }
+ /* Don't go any further if target pthread achieved */
+ if( maxPthread == target_pthread ) break;
+ }
+
+
+
+
+
+ /*
+ for(j=0; j<npdls; j++) {
+ if(creating[j]) continue;
+ printf("PDL %d:\n", j);
+ for( k=0; k < nthreadedDims[j]; k++){
+ printf("Thread dim %d, Dim No %d, Size %d\n", k, threadedDims[j][k],
+ threadedDimSizes[j][k]);
+ }
+ }
+ printf("\n");
+
+ printf("Target Pthread = %d\n", target_pthread);
+ printf("maxPthread = %d, maxPthreadPDL = %d, maxPthreadDim = %d\n", maxPthread, maxPthreadPDL, maxPthreadDim);
+ */
+
+
+ /* Add threading magic */
+ if( maxPthread > 1 ){
+ pdl_add_threading_magic(pdls[maxPthreadPDL], maxPthreadDim, maxPthread);
+ pdl_autopthread_actual = maxPthread; /* Set the global variable indicating actual number of pthreads */
+
+ }
+
+ /* Free the stuff we allocated */
+ for(j=0; j<npdls; j++) {
+ if(creating[j]) continue;
+ free(threadedDims[j]);
+ free(threadedDimSizes[j]);
+ }
+ free(nthreadedDims);
+ free(threadedDims);
+ free(threadedDimSizes);
+
+}
+
+
+
+/* The assumptions this function makes:
+ * pdls is dynamic and may go away -> copied
+ * realdims is static and is NOT copied and NOT freed!!!
+ * creating is only used inside this routine.
+ * errorinfo is assumed static.
+ * usevaffine is assumed static. (uses if exists)
+ *
+ * Only the first thread-magicked pdl is taken into account.
+ *
+ * noPthreadFlag is a flag to indicate the pdl thread is not pthreading safe
+ * (i.e. don't attempt to create multiple posix threads to execute)
+ */
+void pdl_initthreadstruct(int nobl,
+ pdl **pdls,PDL_Indx *realdims,PDL_Indx *creating,int npdls,
+ pdl_errorinfo *info,pdl_thread *thread, char *flags, int noPthreadFlag ) {
+ int i; int j;
+ int ndims=0; int nth;
+ int mx;
+ int nids;
+ int nimpl;
+ int nthid;
+
+ int mydim;
+
+ int *nthreadids;
+ int nthr = 0; int nthrd;
+
+ PDLDEBUG_f(printf("Initthreadloop(%p)\n", (void*)thread);)
+#ifdef PDL_THREAD_DEBUG
+ /* the following is a fix for a problem in the current core logic
+ * see comments in pdl_make_physical in pdlapi.c
+ * the if clause detects if this thread has previously been initialized
+ * if yes free the stuff that was allocated in the last run
+ * just returning is not! good enough (I tried it)
+ * CS
+ */
+ if (thread->magicno == PDL_THR_MAGICNO &&
+ thread->gflags & PDL_THREAD_INITIALIZED) {
+ PDLDEBUG_f(printf("REINITIALIZING already initialized thread\n");)
+ PDLDEBUG_f(dump_thread(thread);)
+ /* return; */ /* try again, should (!?) work */
+
+ if (thread->inds) Safefree(thread->inds);
+ if (thread->dims) Safefree(thread->dims);
+ if (thread->offs) Safefree(thread->offs);
+ if (thread->incs) Safefree(thread->incs);
+ if (thread->flags) Safefree(thread->flags);
+ if (thread->pdls) Safefree(thread->pdls);
+
+ PDLDEBUG_f(pdl_warn("trying to reinitialize already initialized "
+ "thread (mem-leak!); freeing...");)
+ }
+ PDL_THR_SETMAGIC(thread);
+#endif
+ thread->gflags = 0;
+
+ thread->npdls = npdls;
+ thread->pdls = copy_pdl_array(pdls,npdls);
+ thread->realdims = realdims;
+ thread->ndims = 0;
+
+ thread->mag_nth = -1;
+ thread->mag_nthpdl = -1;
+ thread->mag_nthr = -1;
+
+ nids=0;
+ mx=0;
+/* Find the max. number of threadids */
+ for(j=0; j<npdls; j++) {
+ if(creating[j]) continue;
+ MAX2(nids,pdls[j]->nthreadids);
+ MAX2(mx,pdls[j]->threadids[0] - realdims[j]);
+ }
+ nthreadids = pdl_malloc(sizeof(int)*nids);
+ ndims += mx; nimpl = mx; thread->nimpl = nimpl;
+
+
+ //printf("In pdl_initthreadstruct for func %s\n", info->funcname);
+ pdl_autopthreadmagic(pdls, npdls, realdims, creating, noPthreadFlag);
+
+
+ for(j=0; j<npdls; j++) {
+ if(creating[j]) continue;
+ /* Check for magical piddles (parallelized) */
+ if((!nthr) &&
+ pdls[j]->magic &&
+ (nthr = pdl_magic_thread_nthreads(pdls[j],&nthrd))) {
+ thread->mag_nthpdl = j;
+ thread->mag_nth = nthrd - realdims[j];
+ thread->mag_nthr = nthr;
+ if(thread->mag_nth < 0) {
+ pdl_croak_param(info,j,"Cannot magick non-threaded dims \n\t");
+ }
+ }
+
+ for(i=0; i<nids; i++) {
+ mx=0; if(pdls[j]->nthreadids <= nids) {
+ MAX2(mx,
+ pdls[j]->threadids[i+1]
+ - pdls[j]->threadids[i]);
+ }
+ ndims += mx;
+ nthreadids[i] = mx;
+ }
+ }
+
+ if(nthr) {
+ thread->gflags |= PDL_THREAD_MAGICKED;
+ }
+
+ if(ndims < nobl) { /* If too few, add enough implicit dims */
+ thread->nextra = nobl - ndims;
+ ndims += thread->nextra;
+ } else {
+ thread->nextra = 0;
+ }
+
+ thread->ndims = ndims;
+ thread->nimpl = nimpl;
+
+ Newx(thread->inds, thread->ndims * (nthr>0 ? nthr : 1), PDL_Indx); /* Create space for pthread-specific inds (i.e. copy for each pthread)*/
+ if(thread->inds == NULL) croak("Failed to allocate memory for thread->inds in pdlthread.c");
+
+ Newx(thread->dims, thread->ndims, PDL_Indx);
+ if(thread->dims == NULL) croak("Failed to allocate memory for thread->dims in pdlthread.c");
+
+ Newx(thread->offs, thread->npdls * (nthr>0 ? nthr : 1), PDL_Indx); /* Create space for pthread-specific offs */
+ if(thread->offs == NULL) croak("Failed to allocate memory for thread->offs in pdlthread.c");
+
+ Newx(thread->incs, thread->ndims * npdls, PDL_Indx);
+ if(thread->incs == NULL) croak("Failed to allocate memory for thread->incs in pdlthread.c");
+
+ Newx(thread->flags, npdls, char);
+ if(thread->flags == NULL) croak("Failed to allocate memory for thread->flags in pdlthread.c");
+
+ nth=0; /* Index to dimensions */
+
+ /* populate the per_pdl_flags */
+
+ for (i=0;i<npdls; i++) {
+ thread->offs[i] = 0; /* initialize offsets */
+ thread->flags[i] = 0;
+ if (PDL_VAFFOK(pdls[i]) && VAFFINE_FLAG_OK(flags,i))
+ thread->flags[i] |= PDL_THREAD_VAFFINE_OK;
+ }
+ flags = thread->flags; /* shortcut for the remainder */
+
+/* Make implicit inds */
+
+ for(i=0; i<nimpl; i++) {
+ thread->dims[nth] = 1;
+ for(j=0; j<thread->npdls; j++) {
+ thread->incs[nth*npdls+j] = 0;
+ if(creating[j]) continue;
+ if(thread->pdls[j]->threadids[0]-
+ thread->realdims[j] <= i)
+ continue;
+ if(pdls[j]->dims[i+realdims[j]] != 1) {
+ if(thread->dims[nth] != 1) {
+ if(thread->dims[nth] !=
+ pdls[j]->dims[i+realdims[j]]) {
+ pdl_croak_param(info,j,"Mismatched implicit thread dimension %d: should be %d, is %d\n\t",
+ i,
+ thread->dims[nth],
+ pdls[j]->dims[i+thread->realdims[j]]);
+ }
+ } else {
+ thread->dims[nth] =
+ pdls[j]->dims[i+realdims[j]];
+ }
+ thread->incs[nth*npdls+j] =
+ PDL_TREPRINC(pdls[j],flags[j],i+realdims[j]);
+ }
+ }
+ nth++;
+ }
+
+/* Go through everything again and make the real things */
+
+ for(nthid=0; nthid<nids; nthid++) {
+ for(i=0; i<nthreadids[nthid]; i++) {
+ thread->dims[nth] = 1;
+ for(j=0; j<thread->npdls; j++) {
+ thread->incs[nth*npdls+j] = 0;
+ if(creating[j]) continue;
+ if(thread->pdls[j]->nthreadids < nthid)
+ continue;
+ if(thread->pdls[j]->threadids[nthid+1]-
+ thread->pdls[j]->threadids[nthid]
+ <= i) continue;
+ mydim = i+thread->pdls[j]->threadids[nthid];
+ if(pdls[j]->dims[mydim]
+ != 1) {
+ if(thread->dims[nth] != 1) {
+ if(thread->dims[nth] !=
+ pdls[j]->dims[mydim]) {
+ pdl_croak_param(info,j,"Mismatched Implicit thread dimension %d: should be %d, is %d",
+ i,
+ thread->dims[nth],
+ pdls[j]->dims[i+thread->realdims[j]]);
+ }
+ } else {
+ thread->dims[nth] =
+ pdls[j]->dims[mydim];
+ }
+ thread->incs[nth*npdls+j] =
+ PDL_TREPRINC(pdls[j],flags[j],mydim);
+ }
+ }
+ nth++;
+ }
+ }
+
+
+/* Make sure that we have the obligatory number of threaddims */
+
+ for(; nth<ndims; nth++) {
+ thread->dims[nth]=1;
+ for(j=0; j<npdls; j++)
+ thread->incs[nth*npdls+j] = 0;
+ }
+/* If threading, make the true offsets and dims.. */
+
+ if(nthr > 0) {
+ int n1 = thread->dims[thread->mag_nth] / nthr;
+ int n2 = thread->dims[thread->mag_nth] % nthr;
+ if(n2) {
+ die("Cannot magick-thread with non-divisible n!");
+ }
+ thread->dims[thread->mag_nth] = n1;
+ }
+ thread->gflags |= PDL_THREAD_INITIALIZED;
+ PDLDEBUG_f(dump_thread(thread);)
+}
+
+void pdl_thread_create_parameter(pdl_thread *thread,int j,PDL_Indx *dims,
+ int temp)
+{
+ int i;
+ int td = temp ? 0 : thread->nimpl;
+
+ if(!temp && thread->nimpl != thread->ndims - thread->nextra) {
+ pdl_croak_param(thread->einfo,j,
+ "Trying to create parameter while explicitly threading.\
+See the manual for why this is impossible");
+ }
+ pdl_reallocdims(thread->pdls[j], thread->realdims[j] + td);
+ for(i=0; i<thread->realdims[j]; i++)
+ thread->pdls[j]->dims[i] = dims[i];
+ if (!temp)
+ for(i=0; i<thread->nimpl; i++)
+ thread->pdls[j]->dims[i+thread->realdims[j]] =
+ thread->dims[i] *
+ ((i == thread->mag_nth && thread->mag_nthr > 0) ?
+ thread->mag_nthr : 1);
+ thread->pdls[j]->threadids[0] = td + thread->realdims[j];
+ pdl_resize_defaultincs(thread->pdls[j]);
+ for(i=0; i<thread->nimpl; i++) {
+ thread->incs[thread->npdls*i + j] =
+ temp ? 0 :
+ PDL_REPRINC(thread->pdls[j],i+thread->realdims[j]);
+ }
+}
+
+int pdl_startthreadloop(pdl_thread *thread,void (*func)(pdl_trans *),
+ pdl_trans *t) {
+ int i,j;
+ PDL_Indx *offsp; int nthr;
+ PDL_Indx *inds;
+ if( (thread->gflags & (PDL_THREAD_MAGICKED | PDL_THREAD_MAGICK_BUSY))
+ == PDL_THREAD_MAGICKED ) {
+
+ /* If no function supplied (i.e. being called from PDL::thread_over), don't run in parallel */
+ if(!func) {
+ thread->gflags &= ~PDL_THREAD_MAGICKED; /* Cancel thread_magicked */
+ }
+ else{
+
+
+ thread->gflags |= PDL_THREAD_MAGICK_BUSY;
+ /* Do the threadloop magically (i.e. in parallel) */
+ pdl_magic_thread_cast(thread->pdls[thread->mag_nthpdl],
+ func,t, thread);
+ thread->gflags &= ~PDL_THREAD_MAGICK_BUSY;
+ return 1; /* DON'T DO THREADLOOP AGAIN */
+ }
+ }
+ offsp = pdl_get_threadoffsp_int(thread,&nthr, &inds);
+ for(i=0; i<thread->ndims; i++)
+ inds[i] = 0;
+ for(j=0; j<thread->npdls; j++)
+ offsp[j] = PDL_TREPROFFS(thread->pdls[j],thread->flags[j]) +
+ (!nthr?0:
+ nthr * thread->dims[thread->mag_nth] *
+ thread->incs[thread->mag_nth*thread->npdls + j]);
+ return 0;
+}
+
+/* This will have to be macroized */
+int pdl_iterthreadloop(pdl_thread *thread,int nth) {
+ int i,j;
+ int stop = 0;
+ int stopdim;
+ PDL_Indx *offsp; int nthr;
+ PDL_Indx *inds;
+ offsp = pdl_get_threadoffsp_int(thread,&nthr, &inds);
+ for(j=0; j<thread->npdls; j++)
+ offsp[j] = PDL_TREPROFFS(thread->pdls[j],thread->flags[j]);
+ for(i=nth; i<thread->ndims; i++) {
+ inds[i] ++;
+ if( inds[i] >= thread->dims[i])
+ inds[i] = 0;
+ else
+ { stopdim = i; stop = 1; break; }
+ }
+ if(stop) goto calc_offs;
+ return 0;
+calc_offs:
+
+ for(j=0; j<thread->npdls; j++) {
+ offsp[j] = PDL_TREPROFFS(thread->pdls[j],thread->flags[j]) +
+ (!nthr?0:
+ nthr * thread->dims[thread->mag_nth] *
+ thread->incs[thread->mag_nth*thread->npdls + j]);
+ ;
+ for(i=nth; i<thread->ndims; i++) {
+ offsp[j] += thread->incs[i*thread->npdls+j] *
+ inds[i];
+ }
+ }
+ return stopdim+1;
+}
+
+void pdl_croak_param(pdl_errorinfo *info,int paramIndex, char *pat, ...)
+{
+ // I barf a string such as "PDL: function(a,b,c): Parameter 'b' errormessage"
+
+ char message [4096] = {'\0'};
+ int i;
+ va_list args;
+
+#define msgptr_advance() \
+do { \
+ int N = strlen(msgptr); \
+ msgptr += N; \
+ remaining -= N; \
+} while(0)
+
+
+ char* msgptr = message;
+ int remaining = sizeof(message);
+
+ if(info)
+ {
+ if(paramIndex < 0 || paramIndex >= info->nparamnames)
+ {
+ strcat(msgptr, "ERROR: UNKNOWN PARAMETER");
+ msgptr_advance();
+ }
+ else
+ {
+ snprintf(msgptr, remaining, "PDL: %s(", info->funcname);
+ msgptr_advance();
+
+ for(i=0; i<info->nparamnames; i++)
+ {
+ snprintf(msgptr, remaining, "%s", info->paramnames[i]);
+ msgptr_advance();
+
+ if(i < info->nparamnames-1)
+ {
+ snprintf(msgptr, remaining, ",");
+ msgptr_advance();
+ }
+ }
+
+ snprintf(msgptr, remaining, "): Parameter '%s':\n",
+ info->paramnames[paramIndex]);
+ msgptr_advance();
+ }
+ }
+
+ va_start(args,pat);
+
+ vsnprintf(msgptr, remaining, pat, args);
+
+ va_end(args);
+
+ pdl_barf(message);
+}
diff --git a/Basic/Core/pdlthread.h b/Basic/Core/pdlthread.h
new file mode 100644
index 0000000..582e1a6
--- /dev/null
+++ b/Basic/Core/pdlthread.h
@@ -0,0 +1,84 @@
+
+#ifndef __PDLTHREAD_H
+#define __PDLTHREAD_H
+
+
+typedef struct pdl_errorinfo {
+ char *funcname;
+ char **paramnames;
+ int nparamnames;
+} pdl_errorinfo;
+
+
+/* comment out unless debugging
+ Note that full recompile will be needed since this switch
+ changes the pdl_thread struct
+*/
+#define PDL_THREAD_DEBUG
+
+#define PDL_THREAD_MAGICKED 0x0001
+#define PDL_THREAD_MAGICK_BUSY 0x0002
+#define PDL_THREAD_INITIALIZED 0x0004
+
+#ifdef PDL_THREAD_DEBUG
+#define PDL_THR_MAGICNO 0x92314764
+#define PDL_THR_SETMAGIC(it) it->magicno = PDL_THR_MAGICNO
+#define PDL_THR_CLRMAGIC(it) (it)->magicno = 0x99876134
+#else
+#define PDL_THR_CLRMAGIC(it) (void)0
+#endif
+
+/* XXX To avoid mallocs, these should also have "default" values */
+typedef struct pdl_thread {
+ pdl_errorinfo *einfo;
+#ifdef PDL_THREAD_DEBUG
+ int magicno;
+#endif
+ int gflags; /* Flags about this struct */
+ int ndims; /* Number of dimensions threaded over */
+ int nimpl; /* Number of these that are implicit */
+ int npdls; /* Number of pdls involved */
+ int nextra;
+ PDL_Indx *inds; /* Indices for each of the dimensions */
+ PDL_Indx *dims; /* Dimensions of each dimension */
+ PDL_Indx *offs; /* Offsets for each of the pdls */
+ PDL_Indx *incs; /* npdls * ndims array of increments. Fast because
+ of constant indices for first loops */
+ PDL_Indx *realdims; /* realdims for each pdl (e.g., specified by PP signature) */
+ pdl **pdls;
+ char *flags; /* per pdl flags */
+ int mag_nth; /* magicked thread dim */
+ int mag_nthpdl; /* magicked piddle */
+ int mag_nthr; /* number of threads */
+} pdl_thread;
+
+
+/* Thread per pdl flags */
+#define PDL_THREAD_VAFFINE_OK 0x01
+
+#define PDL_TVAFFOK(flag) (flag & PDL_THREAD_VAFFINE_OK)
+#define PDL_TREPRINC(pdl,flag,which) (PDL_TVAFFOK(flag) ? \
+ pdl->vafftrans->incs[which] : pdl->dimincs[which])
+
+#define PDL_TREPROFFS(pdl,flag) (PDL_TVAFFOK(flag) ? pdl->vafftrans->offs : 0)
+
+
+/* No extra vars; not sure about the NULL arg, means no per pdl args */
+#define PDL_THREADINIT(thread,pdls,realdims,creating,npdls,info) \
+ PDL->initthreadstruct(0,pdls,realdims,creating,npdls,info,&thread;\
+ NULL)
+
+#define PDL_THREAD_DECLS(thread)
+
+#define PDL_THREADCREATEPAR(thread,ind,dims,temp) \
+ PDL->thread_create_parameter(&thread,ind,dims,temp)
+#define PDL_THREADSTART(thread) PDL->startthreadloop(&thread)
+
+#define PDL_THREADITER(thread,ptrs) PDL->iterthreadloop(&thread,0,NULL)
+
+#define PDL_THREAD_INITP(thread,which,ptr) /* Nothing */
+#define PDL_THREAD_P(thread,which,ptr) ((ptr)+(thread).offs[ind])
+#define PDL_THREAD_UPDP(thread,which,ptr) /* Nothing */
+
+/* __PDLTHREAD_H */
+#endif
diff --git a/Basic/Core/ppport.h b/Basic/Core/ppport.h
new file mode 100644
index 0000000..b204b76
--- /dev/null
+++ b/Basic/Core/ppport.h
@@ -0,0 +1,6437 @@
+#if 0
+<<'SKIP';
+#endif
+/*
+----------------------------------------------------------------------
+
+ ppport.h -- Perl/Pollution/Portability Version 3.14
+
+ Automatically created by Devel::PPPort running under perl 5.010000.
+
+ Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
+ includes in parts/inc/ instead.
+
+ Use 'perldoc ppport.h' to view the documentation below.
+
+----------------------------------------------------------------------
+
+SKIP
+
+=pod
+
+=head1 NAME
+
+ppport.h - Perl/Pollution/Portability version 3.14
+
+=head1 SYNOPSIS
+
+ perl ppport.h [options] [source files]
+
+ Searches current directory for files if no [source files] are given
+
+ --help show short help
+
+ --version show version
+
+ --patch=file write one patch file with changes
+ --copy=suffix write changed copies with suffix
+ --diff=program use diff program and options
+
+ --compat-version=version provide compatibility with Perl version
+ --cplusplus accept C++ comments
+
+ --quiet don't output anything except fatal errors
+ --nodiag don't show diagnostics
+ --nohints don't show hints
+ --nochanges don't suggest changes
+ --nofilter don't filter input files
+
+ --strip strip all script and doc functionality from
+ ppport.h
+
+ --list-provided list provided API
+ --list-unsupported list unsupported API
+ --api-info=name show Perl API portability information
+
+=head1 COMPATIBILITY
+
+This version of F<ppport.h> is designed to support operation with Perl
+installations back to 5.003, and has been tested up to 5.10.0.
+
+=head1 OPTIONS
+
+=head2 --help
+
+Display a brief usage summary.
+
+=head2 --version
+
+Display the version of F<ppport.h>.
+
+=head2 --patch=I<file>
+
+If this option is given, a single patch file will be created if
+any changes are suggested. This requires a working diff program
+to be installed on your system.
+
+=head2 --copy=I<suffix>
+
+If this option is given, a copy of each file will be saved with
+the given suffix that contains the suggested changes. This does
+not require any external programs. Note that this does not
+automagially add a dot between the original filename and the
+suffix. If you want the dot, you have to include it in the option
+argument.
+
+If neither C<--patch> or C<--copy> are given, the default is to
+simply print the diffs for each file. This requires either
+C<Text::Diff> or a C<diff> program to be installed.
+
+=head2 --diff=I<program>
+
+Manually set the diff program and options to use. The default
+is to use C<Text::Diff>, when installed, and output unified
+context diffs.
+
+=head2 --compat-version=I<version>
+
+Tell F<ppport.h> to check for compatibility with the given
+Perl version. The default is to check for compatibility with Perl
+version 5.003. You can use this option to reduce the output
+of F<ppport.h> if you intend to be backward compatible only
+down to a certain Perl version.
+
+=head2 --cplusplus
+
+Usually, F<ppport.h> will detect C++ style comments and
+replace them with C style comments for portability reasons.
+Using this option instructs F<ppport.h> to leave C++
+comments untouched.
+
+=head2 --quiet
+
+Be quiet. Don't print anything except fatal errors.
+
+=head2 --nodiag
+
+Don't output any diagnostic messages. Only portability
+alerts will be printed.
+
+=head2 --nohints
+
+Don't output any hints. Hints often contain useful portability
+notes. Warnings will still be displayed.
+
+=head2 --nochanges
+
+Don't suggest any changes. Only give diagnostic output and hints
+unless these are also deactivated.
+
+=head2 --nofilter
+
+Don't filter the list of input files. By default, files not looking
+like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
+
+=head2 --strip
+
+Strip all script and documentation functionality from F<ppport.h>.
+This reduces the size of F<ppport.h> dramatically and may be useful
+if you want to include F<ppport.h> in smaller modules without
+increasing their distribution size too much.
+
+The stripped F<ppport.h> will have a C<--unstrip> option that allows
+you to undo the stripping, but only if an appropriate C<Devel::PPPort>
+module is installed.
+
+=head2 --list-provided
+
+Lists the API elements for which compatibility is provided by
+F<ppport.h>. Also lists if it must be explicitly requested,
+if it has dependencies, and if there are hints or warnings for it.
+
+=head2 --list-unsupported
+
+Lists the API elements that are known not to be supported by
+F<ppport.h> and below which version of Perl they probably
+won't be available or work.
+
+=head2 --api-info=I<name>
+
+Show portability information for API elements matching I<name>.
+If I<name> is surrounded by slashes, it is interpreted as a regular
+expression.
+
+=head1 DESCRIPTION
+
+In order for a Perl extension (XS) module to be as portable as possible
+across differing versions of Perl itself, certain steps need to be taken.
+
+=over 4
+
+=item *
+
+Including this header is the first major one. This alone will give you
+access to a large part of the Perl API that hasn't been available in
+earlier Perl releases. Use
+
+ perl ppport.h --list-provided
+
+to see which API elements are provided by ppport.h.
+
+=item *
+
+You should avoid using deprecated parts of the API. For example, using
+global Perl variables without the C<PL_> prefix is deprecated. Also,
+some API functions used to have a C<perl_> prefix. Using this form is
+also deprecated. You can safely use the supported API, as F<ppport.h>
+will provide wrappers for older Perl versions.
+
+=item *
+
+If you use one of a few functions or variables that were not present in
+earlier versions of Perl, and that can't be provided using a macro, you
+have to explicitly request support for these functions by adding one or
+more C<#define>s in your source code before the inclusion of F<ppport.h>.
+
+These functions or variables will be marked C<explicit> in the list shown
+by C<--list-provided>.
+
+Depending on whether you module has a single or multiple files that
+use such functions or variables, you want either C<static> or global
+variants.
+
+For a C<static> function or variable (used only in a single source
+file), use:
+
+ #define NEED_function
+ #define NEED_variable
+
+For a global function or variable (used in multiple source files),
+use:
+
+ #define NEED_function_GLOBAL
+ #define NEED_variable_GLOBAL
+
+Note that you mustn't have more than one global request for the
+same function or variable in your project.
+
+ Function / Variable Static Request Global Request
+ -----------------------------------------------------------------------------------------
+ PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
+ eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
+ grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
+ grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
+ grok_number() NEED_grok_number NEED_grok_number_GLOBAL
+ grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
+ grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
+ load_module() NEED_load_module NEED_load_module_GLOBAL
+ my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
+ my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
+ my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
+ newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
+ newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
+ newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
+ newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
+ sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
+ sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
+ sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
+ sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
+ sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
+ sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
+ sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
+ vload_module() NEED_vload_module NEED_vload_module_GLOBAL
+ vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
+ warner() NEED_warner NEED_warner_GLOBAL
+
+To avoid namespace conflicts, you can change the namespace of the
+explicitly exported functions / variables using the C<DPPP_NAMESPACE>
+macro. Just C<#define> the macro before including C<ppport.h>:
+
+ #define DPPP_NAMESPACE MyOwnNamespace_
+ #include "ppport.h"
+
+The default namespace is C<DPPP_>.
+
+=back
+
+The good thing is that most of the above can be checked by running
+F<ppport.h> on your source code. See the next section for
+details.
+
+=head1 EXAMPLES
+
+To verify whether F<ppport.h> is needed for your module, whether you
+should make any changes to your code, and whether any special defines
+should be used, F<ppport.h> can be run as a Perl script to check your
+source code. Simply say:
+
+ perl ppport.h
+
+The result will usually be a list of patches suggesting changes
+that should at least be acceptable, if not necessarily the most
+efficient solution, or a fix for all possible problems.
+
+If you know that your XS module uses features only available in
+newer Perl releases, if you're aware that it uses C++ comments,
+and if you want all suggestions as a single patch file, you could
+use something like this:
+
+ perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
+
+If you only want your code to be scanned without any suggestions
+for changes, use:
+
+ perl ppport.h --nochanges
+
+You can specify a different C<diff> program or options, using
+the C<--diff> option:
+
+ perl ppport.h --diff='diff -C 10'
+
+This would output context diffs with 10 lines of context.
+
+If you want to create patched copies of your files instead, use:
+
+ perl ppport.h --copy=.new
+
+To display portability information for the C<newSVpvn> function,
+use:
+
+ perl ppport.h --api-info=newSVpvn
+
+Since the argument to C<--api-info> can be a regular expression,
+you can use
+
+ perl ppport.h --api-info=/_nomg$/
+
+to display portability information for all C<_nomg> functions or
+
+ perl ppport.h --api-info=/./
+
+to display information for all known API elements.
+
+=head1 BUGS
+
+If this version of F<ppport.h> is causing failure during
+the compilation of this module, please check if newer versions
+of either this module or C<Devel::PPPort> are available on CPAN
+before sending a bug report.
+
+If F<ppport.h> was generated using the latest version of
+C<Devel::PPPort> and is causing failure of this module, please
+file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
+
+Please include the following information:
+
+=over 4
+
+=item 1.
+
+The complete output from running "perl -V"
+
+=item 2.
+
+This file.
+
+=item 3.
+
+The name and version of the module you were trying to build.
+
+=item 4.
+
+A full log of the build that failed.
+
+=item 5.
+
+Any other information that you think could be relevant.
+
+=back
+
+For the latest version of this code, please get the C<Devel::PPPort>
+module from CPAN.
+
+=head1 COPYRIGHT
+
+Version 3.x, Copyright (c) 2004-2008, Marcus Holland-Moritz.
+
+Version 2.x, Copyright (C) 2001, Paul Marquess.
+
+Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+See L<Devel::PPPort>.
+
+=cut
+
+use strict;
+
+# Disable broken TRIE-optimization
+BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
+
+my $VERSION = 3.14;
+
+my %opt = (
+ quiet => 0,
+ diag => 1,
+ hints => 1,
+ changes => 1,
+ cplusplus => 0,
+ filter => 1,
+ strip => 0,
+ version => 0,
+);
+
+my($ppport) = $0 =~ /([\w.]+)$/;
+my $LF = '(?:\r\n|[\r\n])'; # line feed
+my $HS = "[ \t]"; # horizontal whitespace
+
+# Never use C comments in this file!
+my $ccs = '/'.'*';
+my $cce = '*'.'/';
+my $rccs = quotemeta $ccs;
+my $rcce = quotemeta $cce;
+
+eval {
+ require Getopt::Long;
+ Getopt::Long::GetOptions(\%opt, qw(
+ help quiet diag! filter! hints! changes! cplusplus strip version
+ patch=s copy=s diff=s compat-version=s
+ list-provided list-unsupported api-info=s
+ )) or usage();
+};
+
+if ($@ and grep /^-/, @ARGV) {
+ usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
+ die "Getopt::Long not found. Please don't use any options.\n";
+}
+
+if ($opt{version}) {
+ print "This is $0 $VERSION.\n";
+ exit 0;
+}
+
+usage() if $opt{help};
+strip() if $opt{strip};
+
+if (exists $opt{'compat-version'}) {
+ my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
+ if ($@) {
+ die "Invalid version number format: '$opt{'compat-version'}'\n";
+ }
+ die "Only Perl 5 is supported\n" if $r != 5;
+ die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
+ $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
+}
+else {
+ $opt{'compat-version'} = 5;
+}
+
+my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
+ ? ( $1 => {
+ ($2 ? ( base => $2 ) : ()),
+ ($3 ? ( todo => $3 ) : ()),
+ (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
+ (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
+ (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
+ } )
+ : die "invalid spec: $_" } qw(
+AvFILLp|5.004050||p
+AvFILL|||
+CLASS|||n
+CX_CURPAD_SAVE|||
+CX_CURPAD_SV|||
+CopFILEAV|5.006000||p
+CopFILEGV_set|5.006000||p
+CopFILEGV|5.006000||p
+CopFILESV|5.006000||p
+CopFILE_set|5.006000||p
+CopFILE|5.006000||p
+CopSTASHPV_set|5.006000||p
+CopSTASHPV|5.006000||p
+CopSTASH_eq|5.006000||p
+CopSTASH_set|5.006000||p
+CopSTASH|5.006000||p
+CopyD|5.009002||p
+Copy|||
+CvPADLIST|||
+CvSTASH|||
+CvWEAKOUTSIDE|||
+DEFSV|5.004050||p
+END_EXTERN_C|5.005000||p
+ENTER|||
+ERRSV|5.004050||p
+EXTEND|||
+EXTERN_C|5.005000||p
+F0convert|||n
+FREETMPS|||
+GIMME_V||5.004000|n
+GIMME|||n
+GROK_NUMERIC_RADIX|5.007002||p
+G_ARRAY|||
+G_DISCARD|||
+G_EVAL|||
+G_NOARGS|||
+G_SCALAR|||
+G_VOID||5.004000|
+GetVars|||
+GvSV|||
+Gv_AMupdate|||
+HEf_SVKEY||5.004000|
+HeHASH||5.004000|
+HeKEY||5.004000|
+HeKLEN||5.004000|
+HePV||5.004000|
+HeSVKEY_force||5.004000|
+HeSVKEY_set||5.004000|
+HeSVKEY||5.004000|
+HeUTF8||5.011000|
+HeVAL||5.004000|
+HvNAME|||
+INT2PTR|5.006000||p
+IN_LOCALE_COMPILETIME|5.007002||p
+IN_LOCALE_RUNTIME|5.007002||p
+IN_LOCALE|5.007002||p
+IN_PERL_COMPILETIME|5.008001||p
+IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
+IS_NUMBER_INFINITY|5.007002||p
+IS_NUMBER_IN_UV|5.007002||p
+IS_NUMBER_NAN|5.007003||p
+IS_NUMBER_NEG|5.007002||p
+IS_NUMBER_NOT_INT|5.007002||p
+IVSIZE|5.006000||p
+IVTYPE|5.006000||p
+IVdf|5.006000||p
+LEAVE|||
+LVRET|||
+MARK|||
+MULTICALL||5.011000|
+MY_CXT_CLONE|5.009002||p
+MY_CXT_INIT|5.007003||p
+MY_CXT|5.007003||p
+MoveD|5.009002||p
+Move|||
+NOOP|5.005000||p
+NUM2PTR|5.006000||p
+NVTYPE|5.006000||p
+NVef|5.006001||p
+NVff|5.006001||p
+NVgf|5.006001||p
+Newxc|5.009003||p
+Newxz|5.009003||p
+Newx|5.009003||p
+Nullav|||
+Nullch|||
+Nullcv|||
+Nullhv|||
+Nullsv|||
+ORIGMARK|||
+PAD_BASE_SV|||
+PAD_CLONE_VARS|||
+PAD_COMPNAME_FLAGS|||
+PAD_COMPNAME_GEN_set|||
+PAD_COMPNAME_GEN|||
+PAD_COMPNAME_OURSTASH|||
+PAD_COMPNAME_PV|||
+PAD_COMPNAME_TYPE|||
+PAD_RESTORE_LOCAL|||
+PAD_SAVE_LOCAL|||
+PAD_SAVE_SETNULLPAD|||
+PAD_SETSV|||
+PAD_SET_CUR_NOSAVE|||
+PAD_SET_CUR|||
+PAD_SVl|||
+PAD_SV|||
+PERL_ABS|5.008001||p
+PERL_BCDVERSION|5.011000||p
+PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
+PERL_HASH|5.004000||p
+PERL_INT_MAX|5.004000||p
+PERL_INT_MIN|5.004000||p
+PERL_LONG_MAX|5.004000||p
+PERL_LONG_MIN|5.004000||p
+PERL_MAGIC_arylen|5.007002||p
+PERL_MAGIC_backref|5.007002||p
+PERL_MAGIC_bm|5.007002||p
+PERL_MAGIC_collxfrm|5.007002||p
+PERL_MAGIC_dbfile|5.007002||p
+PERL_MAGIC_dbline|5.007002||p
+PERL_MAGIC_defelem|5.007002||p
+PERL_MAGIC_envelem|5.007002||p
+PERL_MAGIC_env|5.007002||p
+PERL_MAGIC_ext|5.007002||p
+PERL_MAGIC_fm|5.007002||p
+PERL_MAGIC_glob|5.011000||p
+PERL_MAGIC_isaelem|5.007002||p
+PERL_MAGIC_isa|5.007002||p
+PERL_MAGIC_mutex|5.011000||p
+PERL_MAGIC_nkeys|5.007002||p
+PERL_MAGIC_overload_elem|5.007002||p
+PERL_MAGIC_overload_table|5.007002||p
+PERL_MAGIC_overload|5.007002||p
+PERL_MAGIC_pos|5.007002||p
+PERL_MAGIC_qr|5.007002||p
+PERL_MAGIC_regdata|5.007002||p
+PERL_MAGIC_regdatum|5.007002||p
+PERL_MAGIC_regex_global|5.007002||p
+PERL_MAGIC_shared_scalar|5.007003||p
+PERL_MAGIC_shared|5.007003||p
+PERL_MAGIC_sigelem|5.007002||p
+PERL_MAGIC_sig|5.007002||p
+PERL_MAGIC_substr|5.007002||p
+PERL_MAGIC_sv|5.007002||p
+PERL_MAGIC_taint|5.007002||p
+PERL_MAGIC_tiedelem|5.007002||p
+PERL_MAGIC_tiedscalar|5.007002||p
+PERL_MAGIC_tied|5.007002||p
+PERL_MAGIC_utf8|5.008001||p
+PERL_MAGIC_uvar_elem|5.007003||p
+PERL_MAGIC_uvar|5.007002||p
+PERL_MAGIC_vec|5.007002||p
+PERL_MAGIC_vstring|5.008001||p
+PERL_QUAD_MAX|5.004000||p
+PERL_QUAD_MIN|5.004000||p
+PERL_REVISION|5.006000||p
+PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
+PERL_SCAN_DISALLOW_PREFIX|5.007003||p
+PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
+PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
+PERL_SHORT_MAX|5.004000||p
+PERL_SHORT_MIN|5.004000||p
+PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
+PERL_SUBVERSION|5.006000||p
+PERL_UCHAR_MAX|5.004000||p
+PERL_UCHAR_MIN|5.004000||p
+PERL_UINT_MAX|5.004000||p
+PERL_UINT_MIN|5.004000||p
+PERL_ULONG_MAX|5.004000||p
+PERL_ULONG_MIN|5.004000||p
+PERL_UNUSED_ARG|5.009003||p
+PERL_UNUSED_CONTEXT|5.009004||p
+PERL_UNUSED_DECL|5.007002||p
+PERL_UNUSED_VAR|5.007002||p
+PERL_UQUAD_MAX|5.004000||p
+PERL_UQUAD_MIN|5.004000||p
+PERL_USE_GCC_BRACE_GROUPS|5.009004||p
+PERL_USHORT_MAX|5.004000||p
+PERL_USHORT_MIN|5.004000||p
+PERL_VERSION|5.006000||p
+PL_DBsignal|5.005000||p
+PL_DBsingle|||pn
+PL_DBsub|||pn
+PL_DBtrace|||pn
+PL_Sv|5.005000||p
+PL_compiling|5.004050||p
+PL_copline|5.011000||p
+PL_curcop|5.004050||p
+PL_curstash|5.004050||p
+PL_debstash|5.004050||p
+PL_defgv|5.004050||p
+PL_diehook|5.004050||p
+PL_dirty|5.004050||p
+PL_dowarn|||pn
+PL_errgv|5.004050||p
+PL_expect|5.011000||p
+PL_hexdigit|5.005000||p
+PL_hints|5.005000||p
+PL_last_in_gv|||n
+PL_laststatval|5.005000||p
+PL_modglobal||5.005000|n
+PL_na|5.004050||pn
+PL_no_modify|5.006000||p
+PL_ofs_sv|||n
+PL_perl_destruct_level|5.004050||p
+PL_perldb|5.004050||p
+PL_ppaddr|5.006000||p
+PL_rsfp_filters|5.004050||p
+PL_rsfp|5.004050||p
+PL_rs|||n
+PL_signals|5.008001||p
+PL_stack_base|5.004050||p
+PL_stack_sp|5.004050||p
+PL_statcache|5.005000||p
+PL_stdingv|5.004050||p
+PL_sv_arenaroot|5.004050||p
+PL_sv_no|5.004050||pn
+PL_sv_undef|5.004050||pn
+PL_sv_yes|5.004050||pn
+PL_tainted|5.004050||p
+PL_tainting|5.004050||p
+POP_MULTICALL||5.011000|
+POPi|||n
+POPl|||n
+POPn|||n
+POPpbytex||5.007001|n
+POPpx||5.005030|n
+POPp|||n
+POPs|||n
+PTR2IV|5.006000||p
+PTR2NV|5.006000||p
+PTR2UV|5.006000||p
+PTR2ul|5.007001||p
+PTRV|5.006000||p
+PUSHMARK|||
+PUSH_MULTICALL||5.011000|
+PUSHi|||
+PUSHmortal|5.009002||p
+PUSHn|||
+PUSHp|||
+PUSHs|||
+PUSHu|5.004000||p
+PUTBACK|||
+PerlIO_clearerr||5.007003|
+PerlIO_close||5.007003|
+PerlIO_context_layers||5.009004|
+PerlIO_eof||5.007003|
+PerlIO_error||5.007003|
+PerlIO_fileno||5.007003|
+PerlIO_fill||5.007003|
+PerlIO_flush||5.007003|
+PerlIO_get_base||5.007003|
+PerlIO_get_bufsiz||5.007003|
+PerlIO_get_cnt||5.007003|
+PerlIO_get_ptr||5.007003|
+PerlIO_read||5.007003|
+PerlIO_seek||5.007003|
+PerlIO_set_cnt||5.007003|
+PerlIO_set_ptrcnt||5.007003|
+PerlIO_setlinebuf||5.007003|
+PerlIO_stderr||5.007003|
+PerlIO_stdin||5.007003|
+PerlIO_stdout||5.007003|
+PerlIO_tell||5.007003|
+PerlIO_unread||5.007003|
+PerlIO_write||5.007003|
+Perl_signbit||5.009005|n
+PoisonFree|5.009004||p
+PoisonNew|5.009004||p
+PoisonWith|5.009004||p
+Poison|5.008000||p
+RETVAL|||n
+Renewc|||
+Renew|||
+SAVECLEARSV|||
+SAVECOMPPAD|||
+SAVEPADSV|||
+SAVETMPS|||
+SAVE_DEFSV|5.004050||p
+SPAGAIN|||
+SP|||
+START_EXTERN_C|5.005000||p
+START_MY_CXT|5.007003||p
+STMT_END|||p
+STMT_START|||p
+STR_WITH_LEN|5.009003||p
+ST|||
+SV_CONST_RETURN|5.009003||p
+SV_COW_DROP_PV|5.008001||p
+SV_COW_SHARED_HASH_KEYS|5.009005||p
+SV_GMAGIC|5.007002||p
+SV_HAS_TRAILING_NUL|5.009004||p
+SV_IMMEDIATE_UNREF|5.007001||p
+SV_MUTABLE_RETURN|5.009003||p
+SV_NOSTEAL|5.009002||p
+SV_SMAGIC|5.009003||p
+SV_UTF8_NO_ENCODING|5.008001||p
+SVf_UTF8|5.006000||p
+SVf|5.006000||p
+SVt_IV|||
+SVt_NV|||
+SVt_PVAV|||
+SVt_PVCV|||
+SVt_PVHV|||
+SVt_PVMG|||
+SVt_PV|||
+Safefree|||
+Slab_Alloc|||
+Slab_Free|||
+Slab_to_rw|||
+StructCopy|||
+SvCUR_set|||
+SvCUR|||
+SvEND|||
+SvGAMAGIC||5.006001|
+SvGETMAGIC|5.004050||p
+SvGROW|||
+SvIOK_UV||5.006000|
+SvIOK_notUV||5.006000|
+SvIOK_off|||
+SvIOK_only_UV||5.006000|
+SvIOK_only|||
+SvIOK_on|||
+SvIOKp|||
+SvIOK|||
+SvIVX|||
+SvIV_nomg|5.009001||p
+SvIV_set|||
+SvIVx|||
+SvIV|||
+SvIsCOW_shared_hash||5.008003|
+SvIsCOW||5.008003|
+SvLEN_set|||
+SvLEN|||
+SvLOCK||5.007003|
+SvMAGIC_set|5.009003||p
+SvNIOK_off|||
+SvNIOKp|||
+SvNIOK|||
+SvNOK_off|||
+SvNOK_only|||
+SvNOK_on|||
+SvNOKp|||
+SvNOK|||
+SvNVX|||
+SvNV_set|||
+SvNVx|||
+SvNV|||
+SvOK|||
+SvOOK|||
+SvPOK_off|||
+SvPOK_only_UTF8||5.006000|
+SvPOK_only|||
+SvPOK_on|||
+SvPOKp|||
+SvPOK|||
+SvPVX_const|5.009003||p
+SvPVX_mutable|5.009003||p
+SvPVX|||
+SvPV_const|5.009003||p
+SvPV_flags_const_nolen|5.009003||p
+SvPV_flags_const|5.009003||p
+SvPV_flags_mutable|5.009003||p
+SvPV_flags|5.007002||p
+SvPV_force_flags_mutable|5.009003||p
+SvPV_force_flags_nolen|5.009003||p
+SvPV_force_flags|5.007002||p
+SvPV_force_mutable|5.009003||p
+SvPV_force_nolen|5.009003||p
+SvPV_force_nomg_nolen|5.009003||p
+SvPV_force_nomg|5.007002||p
+SvPV_force|||p
+SvPV_mutable|5.009003||p
+SvPV_nolen_const|5.009003||p
+SvPV_nolen|5.006000||p
+SvPV_nomg_const_nolen|5.009003||p
+SvPV_nomg_const|5.009003||p
+SvPV_nomg|5.007002||p
+SvPV_set|||
+SvPVbyte_force||5.009002|
+SvPVbyte_nolen||5.006000|
+SvPVbytex_force||5.006000|
+SvPVbytex||5.006000|
+SvPVbyte|5.006000||p
+SvPVutf8_force||5.006000|
+SvPVutf8_nolen||5.006000|
+SvPVutf8x_force||5.006000|
+SvPVutf8x||5.006000|
+SvPVutf8||5.006000|
+SvPVx|||
+SvPV|||
+SvREFCNT_dec|||
+SvREFCNT_inc_NN|5.009004||p
+SvREFCNT_inc_simple_NN|5.009004||p
+SvREFCNT_inc_simple_void_NN|5.009004||p
+SvREFCNT_inc_simple_void|5.009004||p
+SvREFCNT_inc_simple|5.009004||p
+SvREFCNT_inc_void_NN|5.009004||p
+SvREFCNT_inc_void|5.009004||p
+SvREFCNT_inc|||p
+SvREFCNT|||
+SvROK_off|||
+SvROK_on|||
+SvROK|||
+SvRV_set|5.009003||p
+SvRV|||
+SvRXOK||5.009005|
+SvRX||5.009005|
+SvSETMAGIC|||
+SvSHARED_HASH|5.009003||p
+SvSHARE||5.007003|
+SvSTASH_set|5.009003||p
+SvSTASH|||
+SvSetMagicSV_nosteal||5.004000|
+SvSetMagicSV||5.004000|
+SvSetSV_nosteal||5.004000|
+SvSetSV|||
+SvTAINTED_off||5.004000|
+SvTAINTED_on||5.004000|
+SvTAINTED||5.004000|
+SvTAINT|||
+SvTRUE|||
+SvTYPE|||
+SvUNLOCK||5.007003|
+SvUOK|5.007001|5.006000|p
+SvUPGRADE|||
+SvUTF8_off||5.006000|
+SvUTF8_on||5.006000|
+SvUTF8||5.006000|
+SvUVXx|5.004000||p
+SvUVX|5.004000||p
+SvUV_nomg|5.009001||p
+SvUV_set|5.009003||p
+SvUVx|5.004000||p
+SvUV|5.004000||p
+SvVOK||5.008001|
+SvVSTRING_mg|5.009004||p
+THIS|||n
+UNDERBAR|5.009002||p
+UTF8_MAXBYTES|5.009002||p
+UVSIZE|5.006000||p
+UVTYPE|5.006000||p
+UVXf|5.007001||p
+UVof|5.006000||p
+UVuf|5.006000||p
+UVxf|5.006000||p
+WARN_ALL|5.006000||p
+WARN_AMBIGUOUS|5.006000||p
+WARN_ASSERTIONS|5.011000||p
+WARN_BAREWORD|5.006000||p
+WARN_CLOSED|5.006000||p
+WARN_CLOSURE|5.006000||p
+WARN_DEBUGGING|5.006000||p
+WARN_DEPRECATED|5.006000||p
+WARN_DIGIT|5.006000||p
+WARN_EXEC|5.006000||p
+WARN_EXITING|5.006000||p
+WARN_GLOB|5.006000||p
+WARN_INPLACE|5.006000||p
+WARN_INTERNAL|5.006000||p
+WARN_IO|5.006000||p
+WARN_LAYER|5.008000||p
+WARN_MALLOC|5.006000||p
+WARN_MISC|5.006000||p
+WARN_NEWLINE|5.006000||p
+WARN_NUMERIC|5.006000||p
+WARN_ONCE|5.006000||p
+WARN_OVERFLOW|5.006000||p
+WARN_PACK|5.006000||p
+WARN_PARENTHESIS|5.006000||p
+WARN_PIPE|5.006000||p
+WARN_PORTABLE|5.006000||p
+WARN_PRECEDENCE|5.006000||p
+WARN_PRINTF|5.006000||p
+WARN_PROTOTYPE|5.006000||p
+WARN_QW|5.006000||p
+WARN_RECURSION|5.006000||p
+WARN_REDEFINE|5.006000||p
+WARN_REGEXP|5.006000||p
+WARN_RESERVED|5.006000||p
+WARN_SEMICOLON|5.006000||p
+WARN_SEVERE|5.006000||p
+WARN_SIGNAL|5.006000||p
+WARN_SUBSTR|5.006000||p
+WARN_SYNTAX|5.006000||p
+WARN_TAINT|5.006000||p
+WARN_THREADS|5.008000||p
+WARN_UNINITIALIZED|5.006000||p
+WARN_UNOPENED|5.006000||p
+WARN_UNPACK|5.006000||p
+WARN_UNTIE|5.006000||p
+WARN_UTF8|5.006000||p
+WARN_VOID|5.006000||p
+XCPT_CATCH|5.009002||p
+XCPT_RETHROW|5.009002||p
+XCPT_TRY_END|5.009002||p
+XCPT_TRY_START|5.009002||p
+XPUSHi|||
+XPUSHmortal|5.009002||p
+XPUSHn|||
+XPUSHp|||
+XPUSHs|||
+XPUSHu|5.004000||p
+XSRETURN_EMPTY|||
+XSRETURN_IV|||
+XSRETURN_NO|||
+XSRETURN_NV|||
+XSRETURN_PV|||
+XSRETURN_UNDEF|||
+XSRETURN_UV|5.008001||p
+XSRETURN_YES|||
+XSRETURN|||p
+XST_mIV|||
+XST_mNO|||
+XST_mNV|||
+XST_mPV|||
+XST_mUNDEF|||
+XST_mUV|5.008001||p
+XST_mYES|||
+XS_VERSION_BOOTCHECK|||
+XS_VERSION|||
+XSprePUSH|5.006000||p
+XS|||
+ZeroD|5.009002||p
+Zero|||
+_aMY_CXT|5.007003||p
+_pMY_CXT|5.007003||p
+aMY_CXT_|5.007003||p
+aMY_CXT|5.007003||p
+aTHXR_|5.011000||p
+aTHXR|5.011000||p
+aTHX_|5.006000||p
+aTHX|5.006000||p
+add_data|||n
+addmad|||
+allocmy|||
+amagic_call|||
+amagic_cmp_locale|||
+amagic_cmp|||
+amagic_i_ncmp|||
+amagic_ncmp|||
+any_dup|||
+ao|||
+append_elem|||
+append_list|||
+append_madprops|||
+apply_attrs_my|||
+apply_attrs_string||5.006001|
+apply_attrs|||
+apply|||
+atfork_lock||5.007003|n
+atfork_unlock||5.007003|n
+av_arylen_p||5.009003|
+av_clear|||
+av_create_and_push||5.009005|
+av_create_and_unshift_one||5.009005|
+av_delete||5.006000|
+av_exists||5.006000|
+av_extend|||
+av_fake|||
+av_fetch|||
+av_fill|||
+av_iter_p||5.011000|
+av_len|||
+av_make|||
+av_pop|||
+av_push|||
+av_reify|||
+av_shift|||
+av_store|||
+av_undef|||
+av_unshift|||
+ax|||n
+bad_type|||
+bind_match|||
+block_end|||
+block_gimme||5.004000|
+block_start|||
+boolSV|5.004000||p
+boot_core_PerlIO|||
+boot_core_UNIVERSAL|||
+boot_core_mro|||
+boot_core_xsutils|||
+bytes_from_utf8||5.007001|
+bytes_to_uni|||n
+bytes_to_utf8||5.006001|
+call_argv|5.006000||p
+call_atexit||5.006000|
+call_list||5.004000|
+call_method|5.006000||p
+call_pv|5.006000||p
+call_sv|5.006000||p
+calloc||5.007002|n
+cando|||
+cast_i32||5.006000|
+cast_iv||5.006000|
+cast_ulong||5.006000|
+cast_uv||5.006000|
+check_type_and_open|||
+check_uni|||
+checkcomma|||
+checkposixcc|||
+ckWARN|5.006000||p
+ck_anoncode|||
+ck_bitop|||
+ck_concat|||
+ck_defined|||
+ck_delete|||
+ck_die|||
+ck_each|||
+ck_eof|||
+ck_eval|||
+ck_exec|||
+ck_exists|||
+ck_exit|||
+ck_ftst|||
+ck_fun|||
+ck_glob|||
+ck_grep|||
+ck_index|||
+ck_join|||
+ck_lengthconst|||
+ck_lfun|||
+ck_listiob|||
+ck_match|||
+ck_method|||
+ck_null|||
+ck_open|||
+ck_readline|||
+ck_repeat|||
+ck_require|||
+ck_retarget|||
+ck_return|||
+ck_rfun|||
+ck_rvconst|||
+ck_sassign|||
+ck_select|||
+ck_shift|||
+ck_sort|||
+ck_spair|||
+ck_split|||
+ck_subr|||
+ck_substr|||
+ck_svconst|||
+ck_trunc|||
+ck_unpack|||
+ckwarn_d||5.009003|
+ckwarn||5.009003|
+cl_and|||n
+cl_anything|||n
+cl_init_zero|||n
+cl_init|||n
+cl_is_anything|||n
+cl_or|||n
+clear_placeholders|||
+closest_cop|||
+convert|||
+cop_free|||
+cr_textfilter|||
+create_eval_scope|||
+croak_nocontext|||vn
+croak|||v
+csighandler||5.009003|n
+curmad|||
+custom_op_desc||5.007003|
+custom_op_name||5.007003|
+cv_ckproto_len|||
+cv_ckproto|||
+cv_clone|||
+cv_const_sv||5.004000|
+cv_dump|||
+cv_undef|||
+cx_dump||5.005000|
+cx_dup|||
+cxinc|||
+dAXMARK|5.009003||p
+dAX|5.007002||p
+dITEMS|5.007002||p
+dMARK|||
+dMULTICALL||5.009003|
+dMY_CXT_SV|5.007003||p
+dMY_CXT|5.007003||p
+dNOOP|5.006000||p
+dORIGMARK|||
+dSP|||
+dTHR|5.004050||p
+dTHXR|5.011000||p
+dTHXa|5.006000||p
+dTHXoa|5.006000||p
+dTHX|5.006000||p
+dUNDERBAR|5.009002||p
+dVAR|5.009003||p
+dXCPT|5.009002||p
+dXSARGS|||
+dXSI32|||
+dXSTARG|5.006000||p
+deb_curcv|||
+deb_nocontext|||vn
+deb_stack_all|||
+deb_stack_n|||
+debop||5.005000|
+debprofdump||5.005000|
+debprof|||
+debstackptrs||5.007003|
+debstack||5.007003|
+debug_start_match|||
+deb||5.007003|v
+del_sv|||
+delete_eval_scope|||
+delimcpy||5.004000|
+deprecate_old|||
+deprecate|||
+despatch_signals||5.007001|
+destroy_matcher|||
+die_nocontext|||vn
+die_where|||
+die|||v
+dirp_dup|||
+div128|||
+djSP|||
+do_aexec5|||
+do_aexec|||
+do_aspawn|||
+do_binmode||5.004050|
+do_chomp|||
+do_chop|||
+do_close|||
+do_dump_pad|||
+do_eof|||
+do_exec3|||
+do_execfree|||
+do_exec|||
+do_gv_dump||5.006000|
+do_gvgv_dump||5.006000|
+do_hv_dump||5.006000|
+do_ipcctl|||
+do_ipcget|||
+do_join|||
+do_kv|||
+do_magic_dump||5.006000|
+do_msgrcv|||
+do_msgsnd|||
+do_oddball|||
+do_op_dump||5.006000|
+do_op_xmldump|||
+do_open9||5.006000|
+do_openn||5.007001|
+do_open||5.004000|
+do_pmop_dump||5.006000|
+do_pmop_xmldump|||
+do_print|||
+do_readline|||
+do_seek|||
+do_semop|||
+do_shmio|||
+do_smartmatch|||
+do_spawn_nowait|||
+do_spawn|||
+do_sprintf|||
+do_sv_dump||5.006000|
+do_sysseek|||
+do_tell|||
+do_trans_complex_utf8|||
+do_trans_complex|||
+do_trans_count_utf8|||
+do_trans_count|||
+do_trans_simple_utf8|||
+do_trans_simple|||
+do_trans|||
+do_vecget|||
+do_vecset|||
+do_vop|||
+docatch|||
+doeval|||
+dofile|||
+dofindlabel|||
+doform|||
+doing_taint||5.008001|n
+dooneliner|||
+doopen_pm|||
+doparseform|||
+dopoptoeval|||
+dopoptogiven|||
+dopoptolabel|||
+dopoptoloop|||
+dopoptosub_at|||
+dopoptowhen|||
+doref||5.009003|
+dounwind|||
+dowantarray|||
+dump_all||5.006000|
+dump_eval||5.006000|
+dump_exec_pos|||
+dump_fds|||
+dump_form||5.006000|
+dump_indent||5.006000|v
+dump_mstats|||
+dump_packsubs||5.006000|
+dump_sub||5.006000|
+dump_sv_child|||
+dump_trie_interim_list|||
+dump_trie_interim_table|||
+dump_trie|||
+dump_vindent||5.006000|
+dumpuntil|||
+dup_attrlist|||
+emulate_cop_io|||
+eval_pv|5.006000||p
+eval_sv|5.006000||p
+exec_failed|||
+expect_number|||
+fbm_compile||5.005000|
+fbm_instr||5.005000|
+fd_on_nosuid_fs|||
+feature_is_enabled|||
+filter_add|||
+filter_del|||
+filter_gets|||
+filter_read|||
+find_and_forget_pmops|||
+find_array_subscript|||
+find_beginning|||
+find_byclass|||
+find_hash_subscript|||
+find_in_my_stash|||
+find_runcv||5.008001|
+find_rundefsvoffset||5.009002|
+find_script|||
+find_uninit_var|||
+first_symbol|||n
+fold_constants|||
+forbid_setid|||
+force_ident|||
+force_list|||
+force_next|||
+force_version|||
+force_word|||
+forget_pmop|||
+form_nocontext|||vn
+form||5.004000|v
+fp_dup|||
+fprintf_nocontext|||vn
+free_global_struct|||
+free_tied_hv_pool|||
+free_tmps|||
+gen_constant_list|||
+get_arena|||
+get_aux_mg|||
+get_av|5.006000||p
+get_context||5.006000|n
+get_cvn_flags||5.009005|
+get_cv|5.006000||p
+get_db_sub|||
+get_debug_opts|||
+get_hash_seed|||
+get_hv|5.006000||p
+get_mstats|||
+get_no_modify|||
+get_num|||
+get_op_descs||5.005000|
+get_op_names||5.005000|
+get_opargs|||
+get_ppaddr||5.006000|
+get_re_arg|||
+get_sv|5.006000||p
+get_vtbl||5.005030|
+getcwd_sv||5.007002|
+getenv_len|||
+glob_2number|||
+glob_2pv|||
+glob_assign_glob|||
+glob_assign_ref|||
+gp_dup|||
+gp_free|||
+gp_ref|||
+grok_bin|5.007003||p
+grok_hex|5.007003||p
+grok_number|5.007002||p
+grok_numeric_radix|5.007002||p
+grok_oct|5.007003||p
+group_end|||
+gv_AVadd|||
+gv_HVadd|||
+gv_IOadd|||
+gv_SVadd|||
+gv_autoload4||5.004000|
+gv_check|||
+gv_const_sv||5.009003|
+gv_dump||5.006000|
+gv_efullname3||5.004000|
+gv_efullname4||5.006001|
+gv_efullname|||
+gv_ename|||
+gv_fetchfile_flags||5.009005|
+gv_fetchfile|||
+gv_fetchmeth_autoload||5.007003|
+gv_fetchmethod_autoload||5.004000|
+gv_fetchmethod|||
+gv_fetchmeth|||
+gv_fetchpvn_flags||5.009002|
+gv_fetchpv|||
+gv_fetchsv||5.009002|
+gv_fullname3||5.004000|
+gv_fullname4||5.006001|
+gv_fullname|||
+gv_get_super_pkg|||
+gv_handler||5.007001|
+gv_init_sv|||
+gv_init|||
+gv_name_set||5.009004|
+gv_stashpvn|5.004000||p
+gv_stashpvs||5.009003|
+gv_stashpv|||
+gv_stashsv|||
+he_dup|||
+hek_dup|||
+hfreeentries|||
+hsplit|||
+hv_assert||5.011000|
+hv_auxinit|||n
+hv_backreferences_p|||
+hv_clear_placeholders||5.009001|
+hv_clear|||
+hv_common_key_len||5.010000|
+hv_common||5.010000|
+hv_copy_hints_hv|||
+hv_delayfree_ent||5.004000|
+hv_delete_common|||
+hv_delete_ent||5.004000|
+hv_delete|||
+hv_eiter_p||5.009003|
+hv_eiter_set||5.009003|
+hv_exists_ent||5.004000|
+hv_exists|||
+hv_fetch_ent||5.004000|
+hv_fetchs|5.009003||p
+hv_fetch|||
+hv_free_ent||5.004000|
+hv_iterinit|||
+hv_iterkeysv||5.004000|
+hv_iterkey|||
+hv_iternext_flags||5.008000|
+hv_iternextsv|||
+hv_iternext|||
+hv_iterval|||
+hv_kill_backrefs|||
+hv_ksplit||5.004000|
+hv_magic_check|||n
+hv_magic|||
+hv_name_set||5.009003|
+hv_notallowed|||
+hv_placeholders_get||5.009003|
+hv_placeholders_p||5.009003|
+hv_placeholders_set||5.009003|
+hv_riter_p||5.009003|
+hv_riter_set||5.009003|
+hv_scalar||5.009001|
+hv_store_ent||5.004000|
+hv_store_flags||5.008000|
+hv_stores|5.009004||p
+hv_store|||
+hv_undef|||
+ibcmp_locale||5.004000|
+ibcmp_utf8||5.007003|
+ibcmp|||
+incline|||
+incpush_if_exists|||
+incpush|||
+ingroup|||
+init_argv_symbols|||
+init_debugger|||
+init_global_struct|||
+init_i18nl10n||5.006000|
+init_i18nl14n||5.006000|
+init_ids|||
+init_interp|||
+init_main_stash|||
+init_perllib|||
+init_postdump_symbols|||
+init_predump_symbols|||
+init_stacks||5.005000|
+init_tm||5.007002|
+instr|||
+intro_my|||
+intuit_method|||
+intuit_more|||
+invert|||
+io_close|||
+isALNUM|||
+isALPHA|||
+isDIGIT|||
+isLOWER|||
+isSPACE|||
+isUPPER|||
+is_an_int|||
+is_gv_magical_sv|||
+is_gv_magical|||
+is_handle_constructor|||n
+is_list_assignment|||
+is_lvalue_sub||5.007001|
+is_uni_alnum_lc||5.006000|
+is_uni_alnumc_lc||5.006000|
+is_uni_alnumc||5.006000|
+is_uni_alnum||5.006000|
+is_uni_alpha_lc||5.006000|
+is_uni_alpha||5.006000|
+is_uni_ascii_lc||5.006000|
+is_uni_ascii||5.006000|
+is_uni_cntrl_lc||5.006000|
+is_uni_cntrl||5.006000|
+is_uni_digit_lc||5.006000|
+is_uni_digit||5.006000|
+is_uni_graph_lc||5.006000|
+is_uni_graph||5.006000|
+is_uni_idfirst_lc||5.006000|
+is_uni_idfirst||5.006000|
+is_uni_lower_lc||5.006000|
+is_uni_lower||5.006000|
+is_uni_print_lc||5.006000|
+is_uni_print||5.006000|
+is_uni_punct_lc||5.006000|
+is_uni_punct||5.006000|
+is_uni_space_lc||5.006000|
+is_uni_space||5.006000|
+is_uni_upper_lc||5.006000|
+is_uni_upper||5.006000|
+is_uni_xdigit_lc||5.006000|
+is_uni_xdigit||5.006000|
+is_utf8_alnumc||5.006000|
+is_utf8_alnum||5.006000|
+is_utf8_alpha||5.006000|
+is_utf8_ascii||5.006000|
+is_utf8_char_slow|||n
+is_utf8_char||5.006000|
+is_utf8_cntrl||5.006000|
+is_utf8_common|||
+is_utf8_digit||5.006000|
+is_utf8_graph||5.006000|
+is_utf8_idcont||5.008000|
+is_utf8_idfirst||5.006000|
+is_utf8_lower||5.006000|
+is_utf8_mark||5.006000|
+is_utf8_print||5.006000|
+is_utf8_punct||5.006000|
+is_utf8_space||5.006000|
+is_utf8_string_loclen||5.009003|
+is_utf8_string_loc||5.008001|
+is_utf8_string||5.006001|
+is_utf8_upper||5.006000|
+is_utf8_xdigit||5.006000|
+isa_lookup|||
+items|||n
+ix|||n
+jmaybe|||
+join_exact|||
+keyword|||
+leave_scope|||
+lex_end|||
+lex_start|||
+linklist|||
+listkids|||
+list|||
+load_module_nocontext|||vn
+load_module|5.006000||pv
+localize|||
+looks_like_bool|||
+looks_like_number|||
+lop|||
+mPUSHi|5.009002||p
+mPUSHn|5.009002||p
+mPUSHp|5.009002||p
+mPUSHs|5.011000||p
+mPUSHu|5.009002||p
+mXPUSHi|5.009002||p
+mXPUSHn|5.009002||p
+mXPUSHp|5.009002||p
+mXPUSHs|5.011000||p
+mXPUSHu|5.009002||p
+mad_free|||
+madlex|||
+madparse|||
+magic_clear_all_env|||
+magic_clearenv|||
+magic_clearhint|||
+magic_clearpack|||
+magic_clearsig|||
+magic_dump||5.006000|
+magic_existspack|||
+magic_freearylen_p|||
+magic_freeovrld|||
+magic_getarylen|||
+magic_getdefelem|||
+magic_getnkeys|||
+magic_getpack|||
+magic_getpos|||
+magic_getsig|||
+magic_getsubstr|||
+magic_gettaint|||
+magic_getuvar|||
+magic_getvec|||
+magic_get|||
+magic_killbackrefs|||
+magic_len|||
+magic_methcall|||
+magic_methpack|||
+magic_nextpack|||
+magic_regdata_cnt|||
+magic_regdatum_get|||
+magic_regdatum_set|||
+magic_scalarpack|||
+magic_set_all_env|||
+magic_setamagic|||
+magic_setarylen|||
+magic_setcollxfrm|||
+magic_setdbline|||
+magic_setdefelem|||
+magic_setenv|||
+magic_sethint|||
+magic_setisa|||
+magic_setmglob|||
+magic_setnkeys|||
+magic_setpack|||
+magic_setpos|||
+magic_setregexp|||
+magic_setsig|||
+magic_setsubstr|||
+magic_settaint|||
+magic_setutf8|||
+magic_setuvar|||
+magic_setvec|||
+magic_set|||
+magic_sizepack|||
+magic_wipepack|||
+magicname|||
+make_matcher|||
+make_trie_failtable|||
+make_trie|||
+malloced_size|||n
+malloc||5.007002|n
+markstack_grow|||
+matcher_matches_sv|||
+measure_struct|||
+memEQ|5.004000||p
+memNE|5.004000||p
+mem_collxfrm|||
+mess_alloc|||
+mess_nocontext|||vn
+mess||5.006000|v
+method_common|||
+mfree||5.007002|n
+mg_clear|||
+mg_copy|||
+mg_dup|||
+mg_find|||
+mg_free|||
+mg_get|||
+mg_length||5.005000|
+mg_localize|||
+mg_magical|||
+mg_set|||
+mg_size||5.005000|
+mini_mktime||5.007002|
+missingterm|||
+mode_from_discipline|||
+modkids|||
+mod|||
+more_bodies|||
+more_sv|||
+moreswitches|||
+mro_get_linear_isa_c3|||
+mro_get_linear_isa_dfs|||
+mro_get_linear_isa||5.009005|
+mro_isa_changed_in|||
+mro_meta_dup|||
+mro_meta_init|||
+mro_method_changed_in||5.009005|
+mul128|||
+mulexp10|||n
+my_atof2||5.007002|
+my_atof||5.006000|
+my_attrs|||
+my_bcopy|||n
+my_betoh16|||n
+my_betoh32|||n
+my_betoh64|||n
+my_betohi|||n
+my_betohl|||n
+my_betohs|||n
+my_bzero|||n
+my_chsize|||
+my_clearenv|||
+my_cxt_index|||
+my_cxt_init|||
+my_dirfd||5.009005|
+my_exit_jump|||
+my_exit|||
+my_failure_exit||5.004000|
+my_fflush_all||5.006000|
+my_fork||5.007003|n
+my_htobe16|||n
+my_htobe32|||n
+my_htobe64|||n
+my_htobei|||n
+my_htobel|||n
+my_htobes|||n
+my_htole16|||n
+my_htole32|||n
+my_htole64|||n
+my_htolei|||n
+my_htolel|||n
+my_htoles|||n
+my_htonl|||
+my_kid|||
+my_letoh16|||n
+my_letoh32|||n
+my_letoh64|||n
+my_letohi|||n
+my_letohl|||n
+my_letohs|||n
+my_lstat|||
+my_memcmp||5.004000|n
+my_memset|||n
+my_ntohl|||
+my_pclose||5.004000|
+my_popen_list||5.007001|
+my_popen||5.004000|
+my_setenv|||
+my_snprintf|5.009004||pvn
+my_socketpair||5.007003|n
+my_sprintf||5.009003|vn
+my_stat|||
+my_strftime||5.007002|
+my_strlcat|5.009004||pn
+my_strlcpy|5.009004||pn
+my_swabn|||n
+my_swap|||
+my_unexec|||
+my_vsnprintf||5.009004|n
+my|||
+need_utf8|||n
+newANONATTRSUB||5.006000|
+newANONHASH|||
+newANONLIST|||
+newANONSUB|||
+newASSIGNOP|||
+newATTRSUB||5.006000|
+newAVREF|||
+newAV|||
+newBINOP|||
+newCONDOP|||
+newCONSTSUB|5.004050||p
+newCVREF|||
+newDEFSVOP|||
+newFORM|||
+newFOROP|||
+newGIVENOP||5.009003|
+newGIVWHENOP|||
+newGP|||
+newGVOP|||
+newGVREF|||
+newGVgen|||
+newHVREF|||
+newHVhv||5.005000|
+newHV|||
+newIO|||
+newLISTOP|||
+newLOGOP|||
+newLOOPEX|||
+newLOOPOP|||
+newMADPROP|||
+newMADsv|||
+newMYSUB|||
+newNULLLIST|||
+newOP|||
+newPADOP|||
+newPMOP|||
+newPROG|||
+newPVOP|||
+newRANGE|||
+newRV_inc|5.004000||p
+newRV_noinc|5.004000||p
+newRV|||
+newSLICEOP|||
+newSTATEOP|||
+newSUB|||
+newSVOP|||
+newSVREF|||
+newSV_type||5.009005|
+newSVhek||5.009003|
+newSViv|||
+newSVnv|||
+newSVpvf_nocontext|||vn
+newSVpvf||5.004000|v
+newSVpvn_flags|5.011000||p
+newSVpvn_share|5.007001||p
+newSVpvn_utf8|5.011000||p
+newSVpvn|5.004050||p
+newSVpvs_flags|5.011000||p
+newSVpvs_share||5.009003|
+newSVpvs|5.009003||p
+newSVpv|||
+newSVrv|||
+newSVsv|||
+newSVuv|5.006000||p
+newSV|||
+newTOKEN|||
+newUNOP|||
+newWHENOP||5.009003|
+newWHILEOP||5.009003|
+newXS_flags||5.009004|
+newXSproto||5.006000|
+newXS||5.006000|
+new_collate||5.006000|
+new_constant|||
+new_ctype||5.006000|
+new_he|||
+new_logop|||
+new_numeric||5.006000|
+new_stackinfo||5.005000|
+new_version||5.009000|
+new_warnings_bitfield|||
+next_symbol|||
+nextargv|||
+nextchar|||
+ninstr|||
+no_bareword_allowed|||
+no_fh_allowed|||
+no_op|||
+not_a_number|||
+nothreadhook||5.008000|
+nuke_stacks|||
+num_overflow|||n
+offer_nice_chunk|||
+oopsAV|||
+oopsCV|||
+oopsHV|||
+op_clear|||
+op_const_sv|||
+op_dump||5.006000|
+op_free|||
+op_getmad_weak|||
+op_getmad|||
+op_null||5.007002|
+op_refcnt_dec|||
+op_refcnt_inc|||
+op_refcnt_lock||5.009002|
+op_refcnt_unlock||5.009002|
+op_xmldump|||
+open_script|||
+pMY_CXT_|5.007003||p
+pMY_CXT|5.007003||p
+pTHX_|5.006000||p
+pTHX|5.006000||p
+packWARN|5.007003||p
+pack_cat||5.007003|
+pack_rec|||
+package|||
+packlist||5.008001|
+pad_add_anon|||
+pad_add_name|||
+pad_alloc|||
+pad_block_start|||
+pad_check_dup|||
+pad_compname_type|||
+pad_findlex|||
+pad_findmy|||
+pad_fixup_inner_anons|||
+pad_free|||
+pad_leavemy|||
+pad_new|||
+pad_peg|||n
+pad_push|||
+pad_reset|||
+pad_setsv|||
+pad_sv||5.011000|
+pad_swipe|||
+pad_tidy|||
+pad_undef|||
+parse_body|||
+parse_unicode_opts|||
+parser_dup|||
+parser_free|||
+path_is_absolute|||n
+peep|||
+pending_Slabs_to_ro|||
+perl_alloc_using|||n
+perl_alloc|||n
+perl_clone_using|||n
+perl_clone|||n
+perl_construct|||n
+perl_destruct||5.007003|n
+perl_free|||n
+perl_parse||5.006000|n
+perl_run|||n
+pidgone|||
+pm_description|||
+pmflag|||
+pmop_dump||5.006000|
+pmop_xmldump|||
+pmruntime|||
+pmtrans|||
+pop_scope|||
+pregcomp||5.009005|
+pregexec|||
+pregfree2||5.011000|
+pregfree|||
+prepend_elem|||
+prepend_madprops|||
+printbuf|||
+printf_nocontext|||vn
+process_special_blocks|||
+ptr_table_clear||5.009005|
+ptr_table_fetch||5.009005|
+ptr_table_find|||n
+ptr_table_free||5.009005|
+ptr_table_new||5.009005|
+ptr_table_split||5.009005|
+ptr_table_store||5.009005|
+push_scope|||
+put_byte|||
+pv_display||5.006000|
+pv_escape||5.009004|
+pv_pretty||5.009004|
+pv_uni_display||5.007003|
+qerror|||
+qsortsvu|||
+re_compile||5.009005|
+re_croak2|||
+re_dup_guts|||
+re_intuit_start||5.009005|
+re_intuit_string||5.006000|
+readpipe_override|||
+realloc||5.007002|n
+reentrant_free|||
+reentrant_init|||
+reentrant_retry|||vn
+reentrant_size|||
+ref_array_or_hash|||
+refcounted_he_chain_2hv|||
+refcounted_he_fetch|||
+refcounted_he_free|||
+refcounted_he_new|||
+refcounted_he_value|||
+refkids|||
+refto|||
+ref||5.011000|
+reg_check_named_buff_matched|||
+reg_named_buff_all||5.009005|
+reg_named_buff_exists||5.009005|
+reg_named_buff_fetch||5.009005|
+reg_named_buff_firstkey||5.009005|
+reg_named_buff_iter|||
+reg_named_buff_nextkey||5.009005|
+reg_named_buff_scalar||5.009005|
+reg_named_buff|||
+reg_namedseq|||
+reg_node|||
+reg_numbered_buff_fetch|||
+reg_numbered_buff_length|||
+reg_numbered_buff_store|||
+reg_qr_package|||
+reg_recode|||
+reg_scan_name|||
+reg_skipcomment|||
+reg_stringify||5.009005|
+reg_temp_copy|||
+reganode|||
+regatom|||
+regbranch|||
+regclass_swash||5.009004|
+regclass|||
+regcppop|||
+regcppush|||
+regcurly|||n
+regdump_extflags|||
+regdump||5.005000|
+regdupe_internal|||
+regexec_flags||5.005000|
+regfree_internal||5.009005|
+reghop3|||n
+reghop4|||n
+reghopmaybe3|||n
+reginclass|||
+reginitcolors||5.006000|
+reginsert|||
+regmatch|||
+regnext||5.005000|
+regpiece|||
+regpposixcc|||
+regprop|||
+regrepeat|||
+regtail_study|||
+regtail|||
+regtry|||
+reguni|||
+regwhite|||n
+reg|||
+repeatcpy|||
+report_evil_fh|||
+report_uninit|||
+require_pv||5.006000|
+require_tie_mod|||
+restore_magic|||
+rninstr|||
+rsignal_restore|||
+rsignal_save|||
+rsignal_state||5.004000|
+rsignal||5.004000|
+run_body|||
+run_user_filter|||
+runops_debug||5.005000|
+runops_standard||5.005000|
+rvpv_dup|||
+rxres_free|||
+rxres_restore|||
+rxres_save|||
+safesyscalloc||5.006000|n
+safesysfree||5.006000|n
+safesysmalloc||5.006000|n
+safesysrealloc||5.006000|n
+same_dirent|||
+save_I16||5.004000|
+save_I32|||
+save_I8||5.006000|
+save_aelem||5.004050|
+save_alloc||5.006000|
+save_aptr|||
+save_ary|||
+save_bool||5.008001|
+save_clearsv|||
+save_delete|||
+save_destructor_x||5.006000|
+save_destructor||5.006000|
+save_freeop|||
+save_freepv|||
+save_freesv|||
+save_generic_pvref||5.006001|
+save_generic_svref||5.005030|
+save_gp||5.004000|
+save_hash|||
+save_hek_flags|||n
+save_helem||5.004050|
+save_hptr|||
+save_int|||
+save_item|||
+save_iv||5.005000|
+save_lines|||
+save_list|||
+save_long|||
+save_magic|||
+save_mortalizesv||5.007001|
+save_nogv|||
+save_op|||
+save_padsv||5.007001|
+save_pptr|||
+save_re_context||5.006000|
+save_scalar_at|||
+save_scalar|||
+save_set_svflags||5.009000|
+save_shared_pvref||5.007003|
+save_sptr|||
+save_svref|||
+save_vptr||5.006000|
+savepvn|||
+savepvs||5.009003|
+savepv|||
+savesharedpvn||5.009005|
+savesharedpv||5.007003|
+savestack_grow_cnt||5.008001|
+savestack_grow|||
+savesvpv||5.009002|
+sawparens|||
+scalar_mod_type|||n
+scalarboolean|||
+scalarkids|||
+scalarseq|||
+scalarvoid|||
+scalar|||
+scan_bin||5.006000|
+scan_commit|||
+scan_const|||
+scan_formline|||
+scan_heredoc|||
+scan_hex|||
+scan_ident|||
+scan_inputsymbol|||
+scan_num||5.007001|
+scan_oct|||
+scan_pat|||
+scan_str|||
+scan_subst|||
+scan_trans|||
+scan_version||5.009001|
+scan_vstring||5.009005|
+scan_word|||
+scope|||
+screaminstr||5.005000|
+seed||5.008001|
+sequence_num|||
+sequence_tail|||
+sequence|||
+set_context||5.006000|n
+set_numeric_local||5.006000|
+set_numeric_radix||5.006000|
+set_numeric_standard||5.006000|
+setdefout|||
+setenv_getix|||
+share_hek_flags|||
+share_hek||5.004000|
+si_dup|||
+sighandler|||n
+simplify_sort|||
+skipspace0|||
+skipspace1|||
+skipspace2|||
+skipspace|||
+softref2xv|||
+sortcv_stacked|||
+sortcv_xsub|||
+sortcv|||
+sortsv_flags||5.009003|
+sortsv||5.007003|
+space_join_names_mortal|||
+ss_dup|||
+stack_grow|||
+start_force|||
+start_glob|||
+start_subparse||5.004000|
+stashpv_hvname_match||5.011000|
+stdize_locale|||
+strEQ|||
+strGE|||
+strGT|||
+strLE|||
+strLT|||
+strNE|||
+str_to_version||5.006000|
+strip_return|||
+strnEQ|||
+strnNE|||
+study_chunk|||
+sub_crush_depth|||
+sublex_done|||
+sublex_push|||
+sublex_start|||
+sv_2bool|||
+sv_2cv|||
+sv_2io|||
+sv_2iuv_common|||
+sv_2iuv_non_preserve|||
+sv_2iv_flags||5.009001|
+sv_2iv|||
+sv_2mortal|||
+sv_2num|||
+sv_2nv|||
+sv_2pv_flags|5.007002||p
+sv_2pv_nolen|5.006000||p
+sv_2pvbyte_nolen|5.006000||p
+sv_2pvbyte|5.006000||p
+sv_2pvutf8_nolen||5.006000|
+sv_2pvutf8||5.006000|
+sv_2pv|||
+sv_2uv_flags||5.009001|
+sv_2uv|5.004000||p
+sv_add_arena|||
+sv_add_backref|||
+sv_backoff|||
+sv_bless|||
+sv_cat_decode||5.008001|
+sv_catpv_mg|5.004050||p
+sv_catpvf_mg_nocontext|||pvn
+sv_catpvf_mg|5.006000|5.004000|pv
+sv_catpvf_nocontext|||vn
+sv_catpvf||5.004000|v
+sv_catpvn_flags||5.007002|
+sv_catpvn_mg|5.004050||p
+sv_catpvn_nomg|5.007002||p
+sv_catpvn|||
+sv_catpvs|5.009003||p
+sv_catpv|||
+sv_catsv_flags||5.007002|
+sv_catsv_mg|5.004050||p
+sv_catsv_nomg|5.007002||p
+sv_catsv|||
+sv_catxmlpvn|||
+sv_catxmlsv|||
+sv_chop|||
+sv_clean_all|||
+sv_clean_objs|||
+sv_clear|||
+sv_cmp_locale||5.004000|
+sv_cmp|||
+sv_collxfrm|||
+sv_compile_2op||5.008001|
+sv_copypv||5.007003|
+sv_dec|||
+sv_del_backref|||
+sv_derived_from||5.004000|
+sv_destroyable||5.010000|
+sv_does||5.009004|
+sv_dump|||
+sv_dup|||
+sv_eq|||
+sv_exp_grow|||
+sv_force_normal_flags||5.007001|
+sv_force_normal||5.006000|
+sv_free2|||
+sv_free_arenas|||
+sv_free|||
+sv_gets||5.004000|
+sv_grow|||
+sv_i_ncmp|||
+sv_inc|||
+sv_insert|||
+sv_isa|||
+sv_isobject|||
+sv_iv||5.005000|
+sv_kill_backrefs|||
+sv_len_utf8||5.006000|
+sv_len|||
+sv_magic_portable|5.011000|5.004000|p
+sv_magicext||5.007003|
+sv_magic|||
+sv_mortalcopy|||
+sv_ncmp|||
+sv_newmortal|||
+sv_newref|||
+sv_nolocking||5.007003|
+sv_nosharing||5.007003|
+sv_nounlocking|||
+sv_nv||5.005000|
+sv_peek||5.005000|
+sv_pos_b2u_midway|||
+sv_pos_b2u||5.006000|
+sv_pos_u2b_cached|||
+sv_pos_u2b_forwards|||n
+sv_pos_u2b_midway|||n
+sv_pos_u2b||5.006000|
+sv_pvbyten_force||5.006000|
+sv_pvbyten||5.006000|
+sv_pvbyte||5.006000|
+sv_pvn_force_flags|5.007002||p
+sv_pvn_force|||
+sv_pvn_nomg|5.007003|5.005000|p
+sv_pvn||5.005000|
+sv_pvutf8n_force||5.006000|
+sv_pvutf8n||5.006000|
+sv_pvutf8||5.006000|
+sv_pv||5.006000|
+sv_recode_to_utf8||5.007003|
+sv_reftype|||
+sv_release_COW|||
+sv_replace|||
+sv_report_used|||
+sv_reset|||
+sv_rvweaken||5.006000|
+sv_setiv_mg|5.004050||p
+sv_setiv|||
+sv_setnv_mg|5.006000||p
+sv_setnv|||
+sv_setpv_mg|5.004050||p
+sv_setpvf_mg_nocontext|||pvn
+sv_setpvf_mg|5.006000|5.004000|pv
+sv_setpvf_nocontext|||vn
+sv_setpvf||5.004000|v
+sv_setpviv_mg||5.008001|
+sv_setpviv||5.008001|
+sv_setpvn_mg|5.004050||p
+sv_setpvn|||
+sv_setpvs|5.009004||p
+sv_setpv|||
+sv_setref_iv|||
+sv_setref_nv|||
+sv_setref_pvn|||
+sv_setref_pv|||
+sv_setref_uv||5.007001|
+sv_setsv_cow|||
+sv_setsv_flags||5.007002|
+sv_setsv_mg|5.004050||p
+sv_setsv_nomg|5.007002||p
+sv_setsv|||
+sv_setuv_mg|5.004050||p
+sv_setuv|5.004000||p
+sv_tainted||5.004000|
+sv_taint||5.004000|
+sv_true||5.005000|
+sv_unglob|||
+sv_uni_display||5.007003|
+sv_unmagic|||
+sv_unref_flags||5.007001|
+sv_unref|||
+sv_untaint||5.004000|
+sv_upgrade|||
+sv_usepvn_flags||5.009004|
+sv_usepvn_mg|5.004050||p
+sv_usepvn|||
+sv_utf8_decode||5.006000|
+sv_utf8_downgrade||5.006000|
+sv_utf8_encode||5.006000|
+sv_utf8_upgrade_flags||5.007002|
+sv_utf8_upgrade||5.007001|
+sv_uv|5.005000||p
+sv_vcatpvf_mg|5.006000|5.004000|p
+sv_vcatpvfn||5.004000|
+sv_vcatpvf|5.006000|5.004000|p
+sv_vsetpvf_mg|5.006000|5.004000|p
+sv_vsetpvfn||5.004000|
+sv_vsetpvf|5.006000|5.004000|p
+sv_xmlpeek|||
+svtype|||
+swallow_bom|||
+swap_match_buff|||
+swash_fetch||5.007002|
+swash_get|||
+swash_init||5.006000|
+sys_init3||5.010000|n
+sys_init||5.010000|n
+sys_intern_clear|||
+sys_intern_dup|||
+sys_intern_init|||
+sys_term||5.010000|n
+taint_env|||
+taint_proper|||
+tmps_grow||5.006000|
+toLOWER|||
+toUPPER|||
+to_byte_substr|||
+to_uni_fold||5.007003|
+to_uni_lower_lc||5.006000|
+to_uni_lower||5.007003|
+to_uni_title_lc||5.006000|
+to_uni_title||5.007003|
+to_uni_upper_lc||5.006000|
+to_uni_upper||5.007003|
+to_utf8_case||5.007003|
+to_utf8_fold||5.007003|
+to_utf8_lower||5.007003|
+to_utf8_substr|||
+to_utf8_title||5.007003|
+to_utf8_upper||5.007003|
+token_free|||
+token_getmad|||
+tokenize_use|||
+tokeq|||
+tokereport|||
+too_few_arguments|||
+too_many_arguments|||
+uiv_2buf|||n
+unlnk|||
+unpack_rec|||
+unpack_str||5.007003|
+unpackstring||5.008001|
+unshare_hek_or_pvn|||
+unshare_hek|||
+unsharepvn||5.004000|
+unwind_handler_stack|||
+update_debugger_info|||
+upg_version||5.009005|
+usage|||
+utf16_to_utf8_reversed||5.006001|
+utf16_to_utf8||5.006001|
+utf8_distance||5.006000|
+utf8_hop||5.006000|
+utf8_length||5.007001|
+utf8_mg_pos_cache_update|||
+utf8_to_bytes||5.006001|
+utf8_to_uvchr||5.007001|
+utf8_to_uvuni||5.007001|
+utf8n_to_uvchr|||
+utf8n_to_uvuni||5.007001|
+utilize|||
+uvchr_to_utf8_flags||5.007003|
+uvchr_to_utf8|||
+uvuni_to_utf8_flags||5.007003|
+uvuni_to_utf8||5.007001|
+validate_suid|||
+varname|||
+vcmp||5.009000|
+vcroak||5.006000|
+vdeb||5.007003|
+vdie_common|||
+vdie_croak_common|||
+vdie|||
+vform||5.006000|
+visit|||
+vivify_defelem|||
+vivify_ref|||
+vload_module|5.006000||p
+vmess||5.006000|
+vnewSVpvf|5.006000|5.004000|p
+vnormal||5.009002|
+vnumify||5.009000|
+vstringify||5.009000|
+vverify||5.009003|
+vwarner||5.006000|
+vwarn||5.006000|
+wait4pid|||
+warn_nocontext|||vn
+warner_nocontext|||vn
+warner|5.006000|5.004000|pv
+warn|||v
+watch|||
+whichsig|||
+write_no_mem|||
+write_to_stderr|||
+xmldump_all|||
+xmldump_attr|||
+xmldump_eval|||
+xmldump_form|||
+xmldump_indent|||v
+xmldump_packsubs|||
+xmldump_sub|||
+xmldump_vindent|||
+yyerror|||
+yylex|||
+yyparse|||
+yywarn|||
+);
+
+if (exists $opt{'list-unsupported'}) {
+ my $f;
+ for $f (sort { lc $a cmp lc $b } keys %API) {
+ next unless $API{$f}{todo};
+ print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
+ }
+ exit 0;
+}
+
+# Scan for possible replacement candidates
+
+my(%replace, %need, %hints, %warnings, %depends);
+my $replace = 0;
+my($hint, $define, $function);
+
+sub find_api
+{
+ my $code = shift;
+ $code =~ s{
+ / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
+ | "[^"\\]*(?:\\.[^"\\]*)*"
+ | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
+ grep { exists $API{$_} } $code =~ /(\w+)/mg;
+}
+
+while (<DATA>) {
+ if ($hint) {
+ my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
+ if (m{^\s*\*\s(.*?)\s*$}) {
+ for (@{$hint->[1]}) {
+ $h->{$_} ||= ''; # suppress warning with older perls
+ $h->{$_} .= "$1\n";
+ }
+ }
+ else { undef $hint }
+ }
+
+ $hint = [$1, [split /,?\s+/, $2]]
+ if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
+
+ if ($define) {
+ if ($define->[1] =~ /\\$/) {
+ $define->[1] .= $_;
+ }
+ else {
+ if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
+ my @n = find_api($define->[1]);
+ push @{$depends{$define->[0]}}, @n if @n
+ }
+ undef $define;
+ }
+ }
+
+ $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
+
+ if ($function) {
+ if (/^}/) {
+ if (exists $API{$function->[0]}) {
+ my @n = find_api($function->[1]);
+ push @{$depends{$function->[0]}}, @n if @n
+ }
+ undef $function;
+ }
+ else {
+ $function->[1] .= $_;
+ }
+ }
+
+ $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
+
+ $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
+ $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
+ $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
+ $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
+
+ if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
+ push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
+ }
+
+ $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
+}
+
+for (values %depends) {
+ my %s;
+ $_ = [sort grep !$s{$_}++, @$_];
+}
+
+if (exists $opt{'api-info'}) {
+ my $f;
+ my $count = 0;
+ my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
+ for $f (sort { lc $a cmp lc $b } keys %API) {
+ next unless $f =~ /$match/;
+ print "\n=== $f ===\n\n";
+ my $info = 0;
+ if ($API{$f}{base} || $API{$f}{todo}) {
+ my $base = format_version($API{$f}{base} || $API{$f}{todo});
+ print "Supported at least starting from perl-$base.\n";
+ $info++;
+ }
+ if ($API{$f}{provided}) {
+ my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
+ print "Support by $ppport provided back to perl-$todo.\n";
+ print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
+ print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
+ print "\n$hints{$f}" if exists $hints{$f};
+ print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
+ $info++;
+ }
+ print "No portability information available.\n" unless $info;
+ $count++;
+ }
+ $count or print "Found no API matching '$opt{'api-info'}'.";
+ print "\n";
+ exit 0;
+}
+
+if (exists $opt{'list-provided'}) {
+ my $f;
+ for $f (sort { lc $a cmp lc $b } keys %API) {
+ next unless $API{$f}{provided};
+ my @flags;
+ push @flags, 'explicit' if exists $need{$f};
+ push @flags, 'depend' if exists $depends{$f};
+ push @flags, 'hint' if exists $hints{$f};
+ push @flags, 'warning' if exists $warnings{$f};
+ my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
+ print "$f$flags\n";
+ }
+ exit 0;
+}
+
+my @files;
+my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
+my $srcext = join '|', map { quotemeta $_ } @srcext;
+
+if (@ARGV) {
+ my %seen;
+ for (@ARGV) {
+ if (-e) {
+ if (-f) {
+ push @files, $_ unless $seen{$_}++;
+ }
+ else { warn "'$_' is not a file.\n" }
+ }
+ else {
+ my @new = grep { -f } glob $_
+ or warn "'$_' does not exist.\n";
+ push @files, grep { !$seen{$_}++ } @new;
+ }
+ }
+}
+else {
+ eval {
+ require File::Find;
+ File::Find::find(sub {
+ $File::Find::name =~ /($srcext)$/i
+ and push @files, $File::Find::name;
+ }, '.');
+ };
+ if ($@) {
+ @files = map { glob "*$_" } @srcext;
+ }
+}
+
+if (!@ARGV || $opt{filter}) {
+ my(@in, @out);
+ my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
+ for (@files) {
+ my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
+ push @{ $out ? \@out : \@in }, $_;
+ }
+ if (@ARGV && @out) {
+ warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
+ }
+ @files = @in;
+}
+
+die "No input files given!\n" unless @files;
+
+my(%files, %global, %revreplace);
+%revreplace = reverse %replace;
+my $filename;
+my $patch_opened = 0;
+
+for $filename (@files) {
+ unless (open IN, "<$filename") {
+ warn "Unable to read from $filename: $!\n";
+ next;
+ }
+
+ info("Scanning $filename ...");
+
+ my $c = do { local $/; <IN> };
+ close IN;
+
+ my %file = (orig => $c, changes => 0);
+
+ # Temporarily remove C/XS comments and strings from the code
+ my @ccom;
+
+ $c =~ s{
+ ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
+ | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
+ | ( ^$HS*\#[^\r\n]*
+ | "[^"\\]*(?:\\.[^"\\]*)*"
+ | '[^'\\]*(?:\\.[^'\\]*)*'
+ | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
+ }{ defined $2 and push @ccom, $2;
+ defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
+
+ $file{ccom} = \@ccom;
+ $file{code} = $c;
+ $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
+
+ my $func;
+
+ for $func (keys %API) {
+ my $match = $func;
+ $match .= "|$revreplace{$func}" if exists $revreplace{$func};
+ if ($c =~ /\b(?:Perl_)?($match)\b/) {
+ $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
+ $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
+ if (exists $API{$func}{provided}) {
+ $file{uses_provided}{$func}++;
+ if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
+ $file{uses}{$func}++;
+ my @deps = rec_depend($func);
+ if (@deps) {
+ $file{uses_deps}{$func} = \@deps;
+ for (@deps) {
+ $file{uses}{$_} = 0 unless exists $file{uses}{$_};
+ }
+ }
+ for ($func, @deps) {
+ $file{needs}{$_} = 'static' if exists $need{$_};
+ }
+ }
+ }
+ if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
+ if ($c =~ /\b$func\b/) {
+ $file{uses_todo}{$func}++;
+ }
+ }
+ }
+ }
+
+ while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
+ if (exists $need{$2}) {
+ $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
+ }
+ else { warning("Possibly wrong #define $1 in $filename") }
+ }
+
+ for (qw(uses needs uses_todo needed_global needed_static)) {
+ for $func (keys %{$file{$_}}) {
+ push @{$global{$_}{$func}}, $filename;
+ }
+ }
+
+ $files{$filename} = \%file;
+}
+
+# Globally resolve NEED_'s
+my $need;
+for $need (keys %{$global{needs}}) {
+ if (@{$global{needs}{$need}} > 1) {
+ my @targets = @{$global{needs}{$need}};
+ my @t = grep $files{$_}{needed_global}{$need}, @targets;
+ @targets = @t if @t;
+ @t = grep /\.xs$/i, @targets;
+ @targets = @t if @t;
+ my $target = shift @targets;
+ $files{$target}{needs}{$need} = 'global';
+ for (@{$global{needs}{$need}}) {
+ $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
+ }
+ }
+}
+
+for $filename (@files) {
+ exists $files{$filename} or next;
+
+ info("=== Analyzing $filename ===");
+
+ my %file = %{$files{$filename}};
+ my $func;
+ my $c = $file{code};
+ my $warnings = 0;
+
+ for $func (sort keys %{$file{uses_Perl}}) {
+ if ($API{$func}{varargs}) {
+ unless ($API{$func}{nothxarg}) {
+ my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
+ { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
+ if ($changes) {
+ warning("Doesn't pass interpreter argument aTHX to Perl_$func");
+ $file{changes} += $changes;
+ }
+ }
+ }
+ else {
+ warning("Uses Perl_$func instead of $func");
+ $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
+ {$func$1(}g);
+ }
+ }
+
+ for $func (sort keys %{$file{uses_replace}}) {
+ warning("Uses $func instead of $replace{$func}");
+ $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
+ }
+
+ for $func (sort keys %{$file{uses_provided}}) {
+ if ($file{uses}{$func}) {
+ if (exists $file{uses_deps}{$func}) {
+ diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
+ }
+ else {
+ diag("Uses $func");
+ }
+ }
+ $warnings += hint($func);
+ }
+
+ unless ($opt{quiet}) {
+ for $func (sort keys %{$file{uses_todo}}) {
+ print "*** WARNING: Uses $func, which may not be portable below perl ",
+ format_version($API{$func}{todo}), ", even with '$ppport'\n";
+ $warnings++;
+ }
+ }
+
+ for $func (sort keys %{$file{needed_static}}) {
+ my $message = '';
+ if (not exists $file{uses}{$func}) {
+ $message = "No need to define NEED_$func if $func is never used";
+ }
+ elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
+ $message = "No need to define NEED_$func when already needed globally";
+ }
+ if ($message) {
+ diag($message);
+ $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
+ }
+ }
+
+ for $func (sort keys %{$file{needed_global}}) {
+ my $message = '';
+ if (not exists $global{uses}{$func}) {
+ $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
+ }
+ elsif (exists $file{needs}{$func}) {
+ if ($file{needs}{$func} eq 'extern') {
+ $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
+ }
+ elsif ($file{needs}{$func} eq 'static') {
+ $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
+ }
+ }
+ if ($message) {
+ diag($message);
+ $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
+ }
+ }
+
+ $file{needs_inc_ppport} = keys %{$file{uses}};
+
+ if ($file{needs_inc_ppport}) {
+ my $pp = '';
+
+ for $func (sort keys %{$file{needs}}) {
+ my $type = $file{needs}{$func};
+ next if $type eq 'extern';
+ my $suffix = $type eq 'global' ? '_GLOBAL' : '';
+ unless (exists $file{"needed_$type"}{$func}) {
+ if ($type eq 'global') {
+ diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
+ }
+ else {
+ diag("File needs $func, adding static request");
+ }
+ $pp .= "#define NEED_$func$suffix\n";
+ }
+ }
+
+ if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
+ $pp = '';
+ $file{changes}++;
+ }
+
+ unless ($file{has_inc_ppport}) {
+ diag("Needs to include '$ppport'");
+ $pp .= qq(#include "$ppport"\n)
+ }
+
+ if ($pp) {
+ $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
+ || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
+ || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
+ || ($c =~ s/^/$pp/);
+ }
+ }
+ else {
+ if ($file{has_inc_ppport}) {
+ diag("No need to include '$ppport'");
+ $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
+ }
+ }
+
+ # put back in our C comments
+ my $ix;
+ my $cppc = 0;
+ my @ccom = @{$file{ccom}};
+ for $ix (0 .. $#ccom) {
+ if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
+ $cppc++;
+ $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
+ }
+ else {
+ $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
+ }
+ }
+
+ if ($cppc) {
+ my $s = $cppc != 1 ? 's' : '';
+ warning("Uses $cppc C++ style comment$s, which is not portable");
+ }
+
+ my $s = $warnings != 1 ? 's' : '';
+ my $warn = $warnings ? " ($warnings warning$s)" : '';
+ info("Analysis completed$warn");
+
+ if ($file{changes}) {
+ if (exists $opt{copy}) {
+ my $newfile = "$filename$opt{copy}";
+ if (-e $newfile) {
+ error("'$newfile' already exists, refusing to write copy of '$filename'");
+ }
+ else {
+ local *F;
+ if (open F, ">$newfile") {
+ info("Writing copy of '$filename' with changes to '$newfile'");
+ print F $c;
+ close F;
+ }
+ else {
+ error("Cannot open '$newfile' for writing: $!");
+ }
+ }
+ }
+ elsif (exists $opt{patch} || $opt{changes}) {
+ if (exists $opt{patch}) {
+ unless ($patch_opened) {
+ if (open PATCH, ">$opt{patch}") {
+ $patch_opened = 1;
+ }
+ else {
+ error("Cannot open '$opt{patch}' for writing: $!");
+ delete $opt{patch};
+ $opt{changes} = 1;
+ goto fallback;
+ }
+ }
+ mydiff(\*PATCH, $filename, $c);
+ }
+ else {
+fallback:
+ info("Suggested changes:");
+ mydiff(\*STDOUT, $filename, $c);
+ }
+ }
+ else {
+ my $s = $file{changes} == 1 ? '' : 's';
+ info("$file{changes} potentially required change$s detected");
+ }
+ }
+ else {
+ info("Looks good");
+ }
+}
+
+close PATCH if $patch_opened;
+
+exit 0;
+
+
+sub try_use { eval "use @_;"; return $@ eq '' }
+
+sub mydiff
+{
+ local *F = shift;
+ my($file, $str) = @_;
+ my $diff;
+
+ if (exists $opt{diff}) {
+ $diff = run_diff($opt{diff}, $file, $str);
+ }
+
+ if (!defined $diff and try_use('Text::Diff')) {
+ $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
+ $diff = <<HEADER . $diff;
+--- $file
++++ $file.patched
+HEADER
+ }
+
+ if (!defined $diff) {
+ $diff = run_diff('diff -u', $file, $str);
+ }
+
+ if (!defined $diff) {
+ $diff = run_diff('diff', $file, $str);
+ }
+
+ if (!defined $diff) {
+ error("Cannot generate a diff. Please install Text::Diff or use --copy.");
+ return;
+ }
+
+ print F $diff;
+}
+
+sub run_diff
+{
+ my($prog, $file, $str) = @_;
+ my $tmp = 'dppptemp';
+ my $suf = 'aaa';
+ my $diff = '';
+ local *F;
+
+ while (-e "$tmp.$suf") { $suf++ }
+ $tmp = "$tmp.$suf";
+
+ if (open F, ">$tmp") {
+ print F $str;
+ close F;
+
+ if (open F, "$prog $file $tmp |") {
+ while (<F>) {
+ s/\Q$tmp\E/$file.patched/;
+ $diff .= $_;
+ }
+ close F;
+ unlink $tmp;
+ return $diff;
+ }
+
+ unlink $tmp;
+ }
+ else {
+ error("Cannot open '$tmp' for writing: $!");
+ }
+
+ return undef;
+}
+
+sub rec_depend
+{
+ my($func, $seen) = @_;
+ return () unless exists $depends{$func};
+ $seen = {%{$seen||{}}};
+ return () if $seen->{$func}++;
+ my %s;
+ grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
+}
+
+sub parse_version
+{
+ my $ver = shift;
+
+ if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
+ return ($1, $2, $3);
+ }
+ elsif ($ver !~ /^\d+\.[\d_]+$/) {
+ die "cannot parse version '$ver'\n";
+ }
+
+ $ver =~ s/_//g;
+ $ver =~ s/$/000000/;
+
+ my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
+
+ $v = int $v;
+ $s = int $s;
+
+ if ($r < 5 || ($r == 5 && $v < 6)) {
+ if ($s % 10) {
+ die "cannot parse version '$ver'\n";
+ }
+ }
+
+ return ($r, $v, $s);
+}
+
+sub format_version
+{
+ my $ver = shift;
+
+ $ver =~ s/$/000000/;
+ my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
+
+ $v = int $v;
+ $s = int $s;
+
+ if ($r < 5 || ($r == 5 && $v < 6)) {
+ if ($s % 10) {
+ die "invalid version '$ver'\n";
+ }
+ $s /= 10;
+
+ $ver = sprintf "%d.%03d", $r, $v;
+ $s > 0 and $ver .= sprintf "_%02d", $s;
+
+ return $ver;
+ }
+
+ return sprintf "%d.%d.%d", $r, $v, $s;
+}
+
+sub info
+{
+ $opt{quiet} and return;
+ print @_, "\n";
+}
+
+sub diag
+{
+ $opt{quiet} and return;
+ $opt{diag} and print @_, "\n";
+}
+
+sub warning
+{
+ $opt{quiet} and return;
+ print "*** ", @_, "\n";
+}
+
+sub error
+{
+ print "*** ERROR: ", @_, "\n";
+}
+
+my %given_hints;
+my %given_warnings;
+sub hint
+{
+ $opt{quiet} and return;
+ my $func = shift;
+ my $rv = 0;
+ if (exists $warnings{$func} && !$given_warnings{$func}++) {
+ my $warn = $warnings{$func};
+ $warn =~ s!^!*** !mg;
+ print "*** WARNING: $func\n", $warn;
+ $rv++;
+ }
+ if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
+ my $hint = $hints{$func};
+ $hint =~ s/^/ /mg;
+ print " --- hint for $func ---\n", $hint;
+ }
+ $rv;
+}
+
+sub usage
+{
+ my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
+ my %M = ( 'I' => '*' );
+ $usage =~ s/^\s*perl\s+\S+/$^X $0/;
+ $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
+
+ print <<ENDUSAGE;
+
+Usage: $usage
+
+See perldoc $0 for details.
+
+ENDUSAGE
+
+ exit 2;
+}
+
+sub strip
+{
+ my $self = do { local(@ARGV,$/)=($0); <> };
+ my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
+ $copy =~ s/^(?=\S+)/ /gms;
+ $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
+ $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
+if (\@ARGV && \$ARGV[0] eq '--unstrip') {
+ eval { require Devel::PPPort };
+ \$@ and die "Cannot require Devel::PPPort, please install.\\n";
+ if (\$Devel::PPPort::VERSION < $VERSION) {
+ die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
+ . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
+ . "Please install a newer version, or --unstrip will not work.\\n";
+ }
+ Devel::PPPort::WriteFile(\$0);
+ exit 0;
+}
+print <<END;
+
+Sorry, but this is a stripped version of \$0.
+
+To be able to use its original script and doc functionality,
+please try to regenerate this file using:
+
+ \$^X \$0 --unstrip
+
+END
+/ms;
+ my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
+ $c =~ s{
+ / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
+ | ( "[^"\\]*(?:\\.[^"\\]*)*"
+ | '[^'\\]*(?:\\.[^'\\]*)*' )
+ | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
+ $c =~ s!\s+$!!mg;
+ $c =~ s!^$LF!!mg;
+ $c =~ s!^\s*#\s*!#!mg;
+ $c =~ s!^\s+!!mg;
+
+ open OUT, ">$0" or die "cannot strip $0: $!\n";
+ print OUT "$pl$c\n";
+
+ exit 0;
+}
+
+__DATA__
+*/
+
+#ifndef _P_P_PORTABILITY_H_
+#define _P_P_PORTABILITY_H_
+
+#ifndef DPPP_NAMESPACE
+# define DPPP_NAMESPACE DPPP_
+#endif
+
+#define DPPP_CAT2(x,y) CAT2(x,y)
+#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
+
+#ifndef PERL_REVISION
+# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
+# define PERL_PATCHLEVEL_H_IMPLICIT
+# include <patchlevel.h>
+# endif
+# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
+# include <could_not_find_Perl_patchlevel.h>
+# endif
+# ifndef PERL_REVISION
+# define PERL_REVISION (5)
+ /* Replace: 1 */
+# define PERL_VERSION PATCHLEVEL
+# define PERL_SUBVERSION SUBVERSION
+ /* Replace PERL_PATCHLEVEL with PERL_VERSION */
+ /* Replace: 0 */
+# endif
+#endif
+
+#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
+#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
+
+/* It is very unlikely that anyone will try to use this with Perl 6
+ (or greater), but who knows.
+ */
+#if PERL_REVISION != 5
+# error ppport.h only works with Perl version 5
+#endif /* PERL_REVISION != 5 */
+
+#ifdef I_LIMITS
+# include <limits.h>
+#endif
+
+#ifndef PERL_UCHAR_MIN
+# define PERL_UCHAR_MIN ((unsigned char)0)
+#endif
+
+#ifndef PERL_UCHAR_MAX
+# ifdef UCHAR_MAX
+# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
+# else
+# ifdef MAXUCHAR
+# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
+# else
+# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
+# endif
+# endif
+#endif
+
+#ifndef PERL_USHORT_MIN
+# define PERL_USHORT_MIN ((unsigned short)0)
+#endif
+
+#ifndef PERL_USHORT_MAX
+# ifdef USHORT_MAX
+# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
+# else
+# ifdef MAXUSHORT
+# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
+# else
+# ifdef USHRT_MAX
+# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
+# else
+# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
+# endif
+# endif
+# endif
+#endif
+
+#ifndef PERL_SHORT_MAX
+# ifdef SHORT_MAX
+# define PERL_SHORT_MAX ((short)SHORT_MAX)
+# else
+# ifdef MAXSHORT /* Often used in <values.h> */
+# define PERL_SHORT_MAX ((short)MAXSHORT)
+# else
+# ifdef SHRT_MAX
+# define PERL_SHORT_MAX ((short)SHRT_MAX)
+# else
+# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
+# endif
+# endif
+# endif
+#endif
+
+#ifndef PERL_SHORT_MIN
+# ifdef SHORT_MIN
+# define PERL_SHORT_MIN ((short)SHORT_MIN)
+# else
+# ifdef MINSHORT
+# define PERL_SHORT_MIN ((short)MINSHORT)
+# else
+# ifdef SHRT_MIN
+# define PERL_SHORT_MIN ((short)SHRT_MIN)
+# else
+# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
+# endif
+# endif
+# endif
+#endif
+
+#ifndef PERL_UINT_MAX
+# ifdef UINT_MAX
+# define PERL_UINT_MAX ((unsigned int)UINT_MAX)
+# else
+# ifdef MAXUINT
+# define PERL_UINT_MAX ((unsigned int)MAXUINT)
+# else
+# define PERL_UINT_MAX (~(unsigned int)0)
+# endif
+# endif
+#endif
+
+#ifndef PERL_UINT_MIN
+# define PERL_UINT_MIN ((unsigned int)0)
+#endif
+
+#ifndef PERL_INT_MAX
+# ifdef INT_MAX
+# define PERL_INT_MAX ((int)INT_MAX)
+# else
+# ifdef MAXINT /* Often used in <values.h> */
+# define PERL_INT_MAX ((int)MAXINT)
+# else
+# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
+# endif
+# endif
+#endif
+
+#ifndef PERL_INT_MIN
+# ifdef INT_MIN
+# define PERL_INT_MIN ((int)INT_MIN)
+# else
+# ifdef MININT
+# define PERL_INT_MIN ((int)MININT)
+# else
+# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
+# endif
+# endif
+#endif
+
+#ifndef PERL_ULONG_MAX
+# ifdef ULONG_MAX
+# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
+# else
+# ifdef MAXULONG
+# define PERL_ULONG_MAX ((unsigned long)MAXULONG)
+# else
+# define PERL_ULONG_MAX (~(unsigned long)0)
+# endif
+# endif
+#endif
+
+#ifndef PERL_ULONG_MIN
+# define PERL_ULONG_MIN ((unsigned long)0L)
+#endif
+
+#ifndef PERL_LONG_MAX
+# ifdef LONG_MAX
+# define PERL_LONG_MAX ((long)LONG_MAX)
+# else
+# ifdef MAXLONG
+# define PERL_LONG_MAX ((long)MAXLONG)
+# else
+# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
+# endif
+# endif
+#endif
+
+#ifndef PERL_LONG_MIN
+# ifdef LONG_MIN
+# define PERL_LONG_MIN ((long)LONG_MIN)
+# else
+# ifdef MINLONG
+# define PERL_LONG_MIN ((long)MINLONG)
+# else
+# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
+# endif
+# endif
+#endif
+
+#if defined(HAS_QUAD) && (defined(convex) || defined(uts))
+# ifndef PERL_UQUAD_MAX
+# ifdef ULONGLONG_MAX
+# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
+# else
+# ifdef MAXULONGLONG
+# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
+# else
+# define PERL_UQUAD_MAX (~(unsigned long long)0)
+# endif
+# endif
+# endif
+
+# ifndef PERL_UQUAD_MIN
+# define PERL_UQUAD_MIN ((unsigned long long)0L)
+# endif
+
+# ifndef PERL_QUAD_MAX
+# ifdef LONGLONG_MAX
+# define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
+# else
+# ifdef MAXLONGLONG
+# define PERL_QUAD_MAX ((long long)MAXLONGLONG)
+# else
+# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
+# endif
+# endif
+# endif
+
+# ifndef PERL_QUAD_MIN
+# ifdef LONGLONG_MIN
+# define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
+# else
+# ifdef MINLONGLONG
+# define PERL_QUAD_MIN ((long long)MINLONGLONG)
+# else
+# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
+# endif
+# endif
+# endif
+#endif
+
+/* This is based on code from 5.003 perl.h */
+#ifdef HAS_QUAD
+# ifdef cray
+#ifndef IVTYPE
+# define IVTYPE int
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_INT_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_INT_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_UINT_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_UINT_MAX
+#endif
+
+# ifdef INTSIZE
+#ifndef IVSIZE
+# define IVSIZE INTSIZE
+#endif
+
+# endif
+# else
+# if defined(convex) || defined(uts)
+#ifndef IVTYPE
+# define IVTYPE long long
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_QUAD_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_QUAD_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_UQUAD_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_UQUAD_MAX
+#endif
+
+# ifdef LONGLONGSIZE
+#ifndef IVSIZE
+# define IVSIZE LONGLONGSIZE
+#endif
+
+# endif
+# else
+#ifndef IVTYPE
+# define IVTYPE long
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_LONG_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_LONG_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_ULONG_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_ULONG_MAX
+#endif
+
+# ifdef LONGSIZE
+#ifndef IVSIZE
+# define IVSIZE LONGSIZE
+#endif
+
+# endif
+# endif
+# endif
+#ifndef IVSIZE
+# define IVSIZE 8
+#endif
+
+#ifndef PERL_QUAD_MIN
+# define PERL_QUAD_MIN IV_MIN
+#endif
+
+#ifndef PERL_QUAD_MAX
+# define PERL_QUAD_MAX IV_MAX
+#endif
+
+#ifndef PERL_UQUAD_MIN
+# define PERL_UQUAD_MIN UV_MIN
+#endif
+
+#ifndef PERL_UQUAD_MAX
+# define PERL_UQUAD_MAX UV_MAX
+#endif
+
+#else
+#ifndef IVTYPE
+# define IVTYPE long
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_LONG_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_LONG_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_ULONG_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_ULONG_MAX
+#endif
+
+#endif
+
+#ifndef IVSIZE
+# ifdef LONGSIZE
+# define IVSIZE LONGSIZE
+# else
+# define IVSIZE 4 /* A bold guess, but the best we can make. */
+# endif
+#endif
+#ifndef UVTYPE
+# define UVTYPE unsigned IVTYPE
+#endif
+
+#ifndef UVSIZE
+# define UVSIZE IVSIZE
+#endif
+#ifndef sv_setuv
+# define sv_setuv(sv, uv) \
+ STMT_START { \
+ UV TeMpUv = uv; \
+ if (TeMpUv <= IV_MAX) \
+ sv_setiv(sv, TeMpUv); \
+ else \
+ sv_setnv(sv, (double)TeMpUv); \
+ } STMT_END
+#endif
+#ifndef newSVuv
+# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
+#endif
+#ifndef sv_2uv
+# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
+#endif
+
+#ifndef SvUVX
+# define SvUVX(sv) ((UV)SvIVX(sv))
+#endif
+
+#ifndef SvUVXx
+# define SvUVXx(sv) SvUVX(sv)
+#endif
+
+#ifndef SvUV
+# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
+#endif
+
+#ifndef SvUVx
+# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
+#endif
+
+/* Hint: sv_uv
+ * Always use the SvUVx() macro instead of sv_uv().
+ */
+#ifndef sv_uv
+# define sv_uv(sv) SvUVx(sv)
+#endif
+
+#if !defined(SvUOK) && defined(SvIOK_UV)
+# define SvUOK(sv) SvIOK_UV(sv)
+#endif
+#ifndef XST_mUV
+# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
+#endif
+
+#ifndef XSRETURN_UV
+# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
+#endif
+#ifndef PUSHu
+# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
+#endif
+
+#ifndef XPUSHu
+# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
+#endif
+
+#ifdef HAS_MEMCMP
+#ifndef memNE
+# define memNE(s1,s2,l) (memcmp(s1,s2,l))
+#endif
+
+#ifndef memEQ
+# define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
+#endif
+
+#else
+#ifndef memNE
+# define memNE(s1,s2,l) (bcmp(s1,s2,l))
+#endif
+
+#ifndef memEQ
+# define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
+#endif
+
+#endif
+#ifndef MoveD
+# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
+#endif
+
+#ifndef CopyD
+# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+#endif
+
+#ifdef HAS_MEMSET
+#ifndef ZeroD
+# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
+#endif
+
+#else
+#ifndef ZeroD
+# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
+#endif
+
+#endif
+#ifndef PoisonWith
+# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
+#endif
+
+#ifndef PoisonNew
+# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
+#endif
+
+#ifndef PoisonFree
+# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
+#endif
+
+#ifndef Poison
+# define Poison(d,n,t) PoisonFree(d,n,t)
+#endif
+#ifndef Newx
+# define Newx(v,n,t) New(0,v,n,t)
+#endif
+
+#ifndef Newxc
+# define Newxc(v,n,t,c) Newc(0,v,n,t,c)
+#endif
+
+#ifndef Newxz
+# define Newxz(v,n,t) Newz(0,v,n,t)
+#endif
+
+#ifndef PERL_UNUSED_DECL
+# ifdef HASATTRIBUTE
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
+# else
+# define PERL_UNUSED_DECL
+# endif
+#endif
+
+#ifndef PERL_UNUSED_ARG
+# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
+# include <note.h>
+# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
+# else
+# define PERL_UNUSED_ARG(x) ((void)x)
+# endif
+#endif
+
+#ifndef PERL_UNUSED_VAR
+# define PERL_UNUSED_VAR(x) ((void)x)
+#endif
+
+#ifndef PERL_UNUSED_CONTEXT
+# ifdef USE_ITHREADS
+# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
+# else
+# define PERL_UNUSED_CONTEXT
+# endif
+#endif
+#ifndef NOOP
+# define NOOP /*EMPTY*/(void)0
+#endif
+
+#ifndef dNOOP
+# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
+#endif
+
+#ifndef NVTYPE
+# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
+# define NVTYPE long double
+# else
+# define NVTYPE double
+# endif
+typedef NVTYPE NV;
+#endif
+
+#ifndef INT2PTR
+
+# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
+# define PTRV UV
+# define INT2PTR(any,d) (any)(d)
+# else
+# if PTRSIZE == LONGSIZE
+# define PTRV unsigned long
+# else
+# define PTRV unsigned
+# endif
+# define INT2PTR(any,d) (any)(PTRV)(d)
+# endif
+
+# define NUM2PTR(any,d) (any)(PTRV)(d)
+# define PTR2IV(p) INT2PTR(IV,p)
+# define PTR2UV(p) INT2PTR(UV,p)
+# define PTR2NV(p) NUM2PTR(NV,p)
+
+# if PTRSIZE == LONGSIZE
+# define PTR2ul(p) (unsigned long)(p)
+# else
+# define PTR2ul(p) INT2PTR(unsigned long,p)
+# endif
+
+#endif /* !INT2PTR */
+
+#undef START_EXTERN_C
+#undef END_EXTERN_C
+#undef EXTERN_C
+#ifdef __cplusplus
+# define START_EXTERN_C extern "C" {
+# define END_EXTERN_C }
+# define EXTERN_C extern "C"
+#else
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C extern
+#endif
+
+#if defined(PERL_GCC_PEDANTIC)
+# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# endif
+#endif
+
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
+# ifndef PERL_USE_GCC_BRACE_GROUPS
+# define PERL_USE_GCC_BRACE_GROUPS
+# endif
+#endif
+
+#undef STMT_START
+#undef STMT_END
+#ifdef PERL_USE_GCC_BRACE_GROUPS
+# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
+# define STMT_END )
+#else
+# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
+# define STMT_START if (1)
+# define STMT_END else (void)0
+# else
+# define STMT_START do
+# define STMT_END while (0)
+# endif
+#endif
+#ifndef boolSV
+# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
+#endif
+
+/* DEFSV appears first in 5.004_56 */
+#ifndef DEFSV
+# define DEFSV GvSV(PL_defgv)
+#endif
+
+#ifndef SAVE_DEFSV
+# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
+#endif
+
+/* Older perls (<=5.003) lack AvFILLp */
+#ifndef AvFILLp
+# define AvFILLp AvFILL
+#endif
+#ifndef ERRSV
+# define ERRSV get_sv("@",FALSE)
+#endif
+
+/* Hint: gv_stashpvn
+ * This function's backport doesn't support the length parameter, but
+ * rather ignores it. Portability can only be ensured if the length
+ * parameter is used for speed reasons, but the length can always be
+ * correctly computed from the string argument.
+ */
+#ifndef gv_stashpvn
+# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
+#endif
+
+/* Replace: 1 */
+#ifndef get_cv
+# define get_cv perl_get_cv
+#endif
+
+#ifndef get_sv
+# define get_sv perl_get_sv
+#endif
+
+#ifndef get_av
+# define get_av perl_get_av
+#endif
+
+#ifndef get_hv
+# define get_hv perl_get_hv
+#endif
+
+/* Replace: 0 */
+#ifndef dUNDERBAR
+# define dUNDERBAR dNOOP
+#endif
+
+#ifndef UNDERBAR
+# define UNDERBAR DEFSV
+#endif
+#ifndef dAX
+# define dAX I32 ax = MARK - PL_stack_base + 1
+#endif
+
+#ifndef dITEMS
+# define dITEMS I32 items = SP - MARK
+#endif
+#ifndef dXSTARG
+# define dXSTARG SV * targ = sv_newmortal()
+#endif
+#ifndef dAXMARK
+# define dAXMARK I32 ax = POPMARK; \
+ register SV ** const mark = PL_stack_base + ax++
+#endif
+#ifndef XSprePUSH
+# define XSprePUSH (sp = PL_stack_base + ax - 1)
+#endif
+
+#if (PERL_BCDVERSION < 0x5005000)
+# undef XSRETURN
+# define XSRETURN(off) \
+ STMT_START { \
+ PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
+ return; \
+ } STMT_END
+#endif
+#ifndef PERL_ABS
+# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
+#endif
+#ifndef dVAR
+# define dVAR dNOOP
+#endif
+#ifndef SVf
+# define SVf "_"
+#endif
+#ifndef UTF8_MAXBYTES
+# define UTF8_MAXBYTES UTF8_MAXLEN
+#endif
+#ifndef PERL_HASH
+# define PERL_HASH(hash,str,len) \
+ STMT_START { \
+ const char *s_PeRlHaSh = str; \
+ I32 i_PeRlHaSh = len; \
+ U32 hash_PeRlHaSh = 0; \
+ while (i_PeRlHaSh--) \
+ hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
+ (hash) = hash_PeRlHaSh; \
+ } STMT_END
+#endif
+
+#ifndef PERL_SIGNALS_UNSAFE_FLAG
+
+#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
+
+#if (PERL_BCDVERSION < 0x5008000)
+# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
+#else
+# define D_PPP_PERL_SIGNALS_INIT 0
+#endif
+
+#if defined(NEED_PL_signals)
+static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
+#elif defined(NEED_PL_signals_GLOBAL)
+U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
+#else
+extern U32 DPPP_(my_PL_signals);
+#endif
+#define PL_signals DPPP_(my_PL_signals)
+
+#endif
+
+/* Hint: PL_ppaddr
+ * Calling an op via PL_ppaddr requires passing a context argument
+ * for threaded builds. Since the context argument is different for
+ * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
+ * automatically be defined as the correct argument.
+ */
+
+#if (PERL_BCDVERSION <= 0x5005005)
+/* Replace: 1 */
+# define PL_ppaddr ppaddr
+# define PL_no_modify no_modify
+/* Replace: 0 */
+#endif
+
+#if (PERL_BCDVERSION <= 0x5004005)
+/* Replace: 1 */
+# define PL_DBsignal DBsignal
+# define PL_DBsingle DBsingle
+# define PL_DBsub DBsub
+# define PL_DBtrace DBtrace
+# define PL_Sv Sv
+# define PL_compiling compiling
+# define PL_copline copline
+# define PL_curcop curcop
+# define PL_curstash curstash
+# define PL_debstash debstash
+# define PL_defgv defgv
+# define PL_diehook diehook
+# define PL_dirty dirty
+# define PL_dowarn dowarn
+# define PL_errgv errgv
+# define PL_expect expect
+# define PL_hexdigit hexdigit
+# define PL_hints hints
+# define PL_laststatval laststatval
+# define PL_na na
+# define PL_perl_destruct_level perl_destruct_level
+# define PL_perldb perldb
+# define PL_rsfp_filters rsfp_filters
+# define PL_rsfp rsfp
+# define PL_stack_base stack_base
+# define PL_stack_sp stack_sp
+# define PL_statcache statcache
+# define PL_stdingv stdingv
+# define PL_sv_arenaroot sv_arenaroot
+# define PL_sv_no sv_no
+# define PL_sv_undef sv_undef
+# define PL_sv_yes sv_yes
+# define PL_tainted tainted
+# define PL_tainting tainting
+/* Replace: 0 */
+#endif
+
+/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters
+ * Do not use this variable. It is internal to the perl parser
+ * and may change or even be removed in the future. Note that
+ * as of perl 5.9.5 you cannot assign to this variable anymore.
+ */
+
+/* TODO: cannot assign to these vars; is it worth fixing? */
+#if (PERL_BCDVERSION >= 0x5009005)
+# define PL_expect (PL_parser ? PL_parser->expect : 0)
+# define PL_copline (PL_parser ? PL_parser->copline : 0)
+# define PL_rsfp (PL_parser ? PL_parser->rsfp : (PerlIO *) 0)
+# define PL_rsfp_filters (PL_parser ? PL_parser->rsfp_filters : (AV *) 0)
+#endif
+#ifndef dTHR
+# define dTHR dNOOP
+#endif
+#ifndef dTHX
+# define dTHX dNOOP
+#endif
+
+#ifndef dTHXa
+# define dTHXa(x) dNOOP
+#endif
+#ifndef pTHX
+# define pTHX void
+#endif
+
+#ifndef pTHX_
+# define pTHX_
+#endif
+
+#ifndef aTHX
+# define aTHX
+#endif
+
+#ifndef aTHX_
+# define aTHX_
+#endif
+
+#if (PERL_BCDVERSION < 0x5006000)
+# ifdef USE_THREADS
+# define aTHXR thr
+# define aTHXR_ thr,
+# else
+# define aTHXR
+# define aTHXR_
+# endif
+# define dTHXR dTHR
+#else
+# define aTHXR aTHX
+# define aTHXR_ aTHX_
+# define dTHXR dTHX
+#endif
+#ifndef dTHXoa
+# define dTHXoa(x) dTHXa(x)
+#endif
+#ifndef mPUSHs
+# define mPUSHs(s) PUSHs(sv_2mortal(s))
+#endif
+
+#ifndef PUSHmortal
+# define PUSHmortal PUSHs(sv_newmortal())
+#endif
+
+#ifndef mPUSHp
+# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
+#endif
+
+#ifndef mPUSHn
+# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
+#endif
+
+#ifndef mPUSHi
+# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
+#endif
+
+#ifndef mPUSHu
+# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
+#endif
+#ifndef mXPUSHs
+# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
+#endif
+
+#ifndef XPUSHmortal
+# define XPUSHmortal XPUSHs(sv_newmortal())
+#endif
+
+#ifndef mXPUSHp
+# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
+#endif
+
+#ifndef mXPUSHn
+# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
+#endif
+
+#ifndef mXPUSHi
+# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
+#endif
+
+#ifndef mXPUSHu
+# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
+#endif
+
+/* Replace: 1 */
+#ifndef call_sv
+# define call_sv perl_call_sv
+#endif
+
+#ifndef call_pv
+# define call_pv perl_call_pv
+#endif
+
+#ifndef call_argv
+# define call_argv perl_call_argv
+#endif
+
+#ifndef call_method
+# define call_method perl_call_method
+#endif
+#ifndef eval_sv
+# define eval_sv perl_eval_sv
+#endif
+#ifndef PERL_LOADMOD_DENY
+# define PERL_LOADMOD_DENY 0x1
+#endif
+
+#ifndef PERL_LOADMOD_NOIMPORT
+# define PERL_LOADMOD_NOIMPORT 0x2
+#endif
+
+#ifndef PERL_LOADMOD_IMPORT_OPS
+# define PERL_LOADMOD_IMPORT_OPS 0x4
+#endif
+
+/* Replace: 0 */
+
+/* Replace perl_eval_pv with eval_pv */
+
+#ifndef eval_pv
+#if defined(NEED_eval_pv)
+static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
+static
+#else
+extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
+#endif
+
+#ifdef eval_pv
+# undef eval_pv
+#endif
+#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
+#define Perl_eval_pv DPPP_(my_eval_pv)
+
+#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
+
+SV*
+DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
+{
+ dSP;
+ SV* sv = newSVpv(p, 0);
+
+ PUSHMARK(sp);
+ eval_sv(sv, G_SCALAR);
+ SvREFCNT_dec(sv);
+
+ SPAGAIN;
+ sv = POPs;
+ PUTBACK;
+
+ if (croak_on_error && SvTRUE(GvSV(errgv)))
+ croak(SvPVx(GvSV(errgv), na));
+
+ return sv;
+}
+
+#endif
+#endif
+
+#ifndef vload_module
+#if defined(NEED_vload_module)
+static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
+static
+#else
+extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
+#endif
+
+#ifdef vload_module
+# undef vload_module
+#endif
+#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
+#define Perl_vload_module DPPP_(my_vload_module)
+
+#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
+
+void
+DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
+{
+ dTHR;
+ dVAR;
+ OP *veop, *imop;
+
+ OP * const modname = newSVOP(OP_CONST, 0, name);
+ /* 5.005 has a somewhat hacky force_normal that doesn't croak on
+ SvREADONLY() if PL_compling is true. Current perls take care in
+ ck_require() to correctly turn off SvREADONLY before calling
+ force_normal_flags(). This seems a better fix than fudging PL_compling
+ */
+ SvREADONLY_off(((SVOP*)modname)->op_sv);
+ modname->op_private |= OPpCONST_BARE;
+ if (ver) {
+ veop = newSVOP(OP_CONST, 0, ver);
+ }
+ else
+ veop = NULL;
+ if (flags & PERL_LOADMOD_NOIMPORT) {
+ imop = sawparens(newNULLLIST());
+ }
+ else if (flags & PERL_LOADMOD_IMPORT_OPS) {
+ imop = va_arg(*args, OP*);
+ }
+ else {
+ SV *sv;
+ imop = NULL;
+ sv = va_arg(*args, SV*);
+ while (sv) {
+ imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
+ sv = va_arg(*args, SV*);
+ }
+ }
+ {
+ const line_t ocopline = PL_copline;
+ COP * const ocurcop = PL_curcop;
+ const int oexpect = PL_expect;
+
+#if (PERL_BCDVERSION >= 0x5004000)
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
+ veop, modname, imop);
+#else
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
+ modname, imop);
+#endif
+ PL_expect = oexpect;
+ PL_copline = ocopline;
+ PL_curcop = ocurcop;
+ }
+}
+
+#endif
+#endif
+
+#ifndef load_module
+#if defined(NEED_load_module)
+static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
+static
+#else
+extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
+#endif
+
+#ifdef load_module
+# undef load_module
+#endif
+#define load_module DPPP_(my_load_module)
+#define Perl_load_module DPPP_(my_load_module)
+
+#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
+
+void
+DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
+{
+ va_list args;
+ va_start(args, ver);
+ vload_module(flags, name, ver, &args);
+ va_end(args);
+}
+
+#endif
+#endif
+#ifndef newRV_inc
+# define newRV_inc(sv) newRV(sv) /* Replace */
+#endif
+
+#ifndef newRV_noinc
+#if defined(NEED_newRV_noinc)
+static SV * DPPP_(my_newRV_noinc)(SV *sv);
+static
+#else
+extern SV * DPPP_(my_newRV_noinc)(SV *sv);
+#endif
+
+#ifdef newRV_noinc
+# undef newRV_noinc
+#endif
+#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
+#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
+
+#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
+SV *
+DPPP_(my_newRV_noinc)(SV *sv)
+{
+ SV *rv = (SV *)newRV(sv);
+ SvREFCNT_dec(sv);
+ return rv;
+}
+#endif
+#endif
+
+/* Hint: newCONSTSUB
+ * Returns a CV* as of perl-5.7.1. This return value is not supported
+ * by Devel::PPPort.
+ */
+
+/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
+#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
+#if defined(NEED_newCONSTSUB)
+static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
+static
+#else
+extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
+#endif
+
+#ifdef newCONSTSUB
+# undef newCONSTSUB
+#endif
+#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
+#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
+
+#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
+
+void
+DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
+{
+ U32 oldhints = PL_hints;
+ HV *old_cop_stash = PL_curcop->cop_stash;
+ HV *old_curstash = PL_curstash;
+ line_t oldline = PL_curcop->cop_line;
+ PL_curcop->cop_line = PL_copline;
+
+ PL_hints &= ~HINT_BLOCK_SCOPE;
+ if (stash)
+ PL_curstash = PL_curcop->cop_stash = stash;
+
+ newSUB(
+
+#if (PERL_BCDVERSION < 0x5003022)
+ start_subparse(),
+#elif (PERL_BCDVERSION == 0x5003022)
+ start_subparse(0),
+#else /* 5.003_23 onwards */
+ start_subparse(FALSE, 0),
+#endif
+
+ newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
+ newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
+ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
+ );
+
+ PL_hints = oldhints;
+ PL_curcop->cop_stash = old_cop_stash;
+ PL_curstash = old_curstash;
+ PL_curcop->cop_line = oldline;
+}
+#endif
+#endif
+
+/*
+ * Boilerplate macros for initializing and accessing interpreter-local
+ * data from C. All statics in extensions should be reworked to use
+ * this, if you want to make the extension thread-safe. See ext/re/re.xs
+ * for an example of the use of these macros.
+ *
+ * Code that uses these macros is responsible for the following:
+ * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
+ * 2. Declare a typedef named my_cxt_t that is a structure that contains
+ * all the data that needs to be interpreter-local.
+ * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
+ * 4. Use the MY_CXT_INIT macro such that it is called exactly once
+ * (typically put in the BOOT: section).
+ * 5. Use the members of the my_cxt_t structure everywhere as
+ * MY_CXT.member.
+ * 6. Use the dMY_CXT macro (a declaration) in all the functions that
+ * access MY_CXT.
+ */
+
+#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
+ defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
+
+#ifndef START_MY_CXT
+
+/* This must appear in all extensions that define a my_cxt_t structure,
+ * right after the definition (i.e. at file scope). The non-threads
+ * case below uses it to declare the data as static. */
+#define START_MY_CXT
+
+#if (PERL_BCDVERSION < 0x5004068)
+/* Fetches the SV that keeps the per-interpreter data. */
+#define dMY_CXT_SV \
+ SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
+#else /* >= perl5.004_68 */
+#define dMY_CXT_SV \
+ SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
+ sizeof(MY_CXT_KEY)-1, TRUE)
+#endif /* < perl5.004_68 */
+
+/* This declaration should be used within all functions that use the
+ * interpreter-local data. */
+#define dMY_CXT \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
+
+/* Creates and zeroes the per-interpreter data.
+ * (We allocate my_cxtp in a Perl SV so that it will be released when
+ * the interpreter goes away.) */
+#define MY_CXT_INIT \
+ dMY_CXT_SV; \
+ /* newSV() allocates one more than needed */ \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Zero(my_cxtp, 1, my_cxt_t); \
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+
+/* This macro must be used to access members of the my_cxt_t structure.
+ * e.g. MYCXT.some_data */
+#define MY_CXT (*my_cxtp)
+
+/* Judicious use of these macros can reduce the number of times dMY_CXT
+ * is used. Use is similar to pTHX, aTHX etc. */
+#define pMY_CXT my_cxt_t *my_cxtp
+#define pMY_CXT_ pMY_CXT,
+#define _pMY_CXT ,pMY_CXT
+#define aMY_CXT my_cxtp
+#define aMY_CXT_ aMY_CXT,
+#define _aMY_CXT ,aMY_CXT
+
+#endif /* START_MY_CXT */
+
+#ifndef MY_CXT_CLONE
+/* Clones the per-interpreter data. */
+#define MY_CXT_CLONE \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+#endif
+
+#else /* single interpreter */
+
+#ifndef START_MY_CXT
+
+#define START_MY_CXT static my_cxt_t my_cxt;
+#define dMY_CXT_SV dNOOP
+#define dMY_CXT dNOOP
+#define MY_CXT_INIT NOOP
+#define MY_CXT my_cxt
+
+#define pMY_CXT void
+#define pMY_CXT_
+#define _pMY_CXT
+#define aMY_CXT
+#define aMY_CXT_
+#define _aMY_CXT
+
+#endif /* START_MY_CXT */
+
+#ifndef MY_CXT_CLONE
+#define MY_CXT_CLONE NOOP
+#endif
+
+#endif
+
+#ifndef IVdf
+# if IVSIZE == LONGSIZE
+# define IVdf "ld"
+# define UVuf "lu"
+# define UVof "lo"
+# define UVxf "lx"
+# define UVXf "lX"
+# else
+# if IVSIZE == INTSIZE
+# define IVdf "d"
+# define UVuf "u"
+# define UVof "o"
+# define UVxf "x"
+# define UVXf "X"
+# endif
+# endif
+#endif
+
+#ifndef NVef
+# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
+ defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
+ /* Not very likely, but let's try anyway. */
+# define NVef PERL_PRIeldbl
+# define NVff PERL_PRIfldbl
+# define NVgf PERL_PRIgldbl
+# else
+# define NVef "e"
+# define NVff "f"
+# define NVgf "g"
+# endif
+#endif
+
+#ifndef SvREFCNT_inc
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc(sv) \
+ ({ \
+ SV * const _sv = (SV*)(sv); \
+ if (_sv) \
+ (SvREFCNT(_sv))++; \
+ _sv; \
+ })
+# else
+# define SvREFCNT_inc(sv) \
+ ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
+# endif
+#endif
+
+#ifndef SvREFCNT_inc_simple
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc_simple(sv) \
+ ({ \
+ if (sv) \
+ (SvREFCNT(sv))++; \
+ (SV *)(sv); \
+ })
+# else
+# define SvREFCNT_inc_simple(sv) \
+ ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
+# endif
+#endif
+
+#ifndef SvREFCNT_inc_NN
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc_NN(sv) \
+ ({ \
+ SV * const _sv = (SV*)(sv); \
+ SvREFCNT(_sv)++; \
+ _sv; \
+ })
+# else
+# define SvREFCNT_inc_NN(sv) \
+ (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
+# endif
+#endif
+
+#ifndef SvREFCNT_inc_void
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc_void(sv) \
+ ({ \
+ SV * const _sv = (SV*)(sv); \
+ if (_sv) \
+ (void)(SvREFCNT(_sv)++); \
+ })
+# else
+# define SvREFCNT_inc_void(sv) \
+ (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
+# endif
+#endif
+#ifndef SvREFCNT_inc_simple_void
+# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
+#endif
+
+#ifndef SvREFCNT_inc_simple_NN
+# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
+#endif
+
+#ifndef SvREFCNT_inc_void_NN
+# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
+#endif
+
+#ifndef SvREFCNT_inc_simple_void_NN
+# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
+#endif
+#ifndef newSVpvn
+# define newSVpvn(data,len) ((data) \
+ ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
+ : newSV(0))
+#endif
+#ifndef newSVpvn_utf8
+# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
+#endif
+#ifndef SVf_UTF8
+# define SVf_UTF8 0
+#endif
+
+#ifndef newSVpvn_flags
+
+#if defined(NEED_newSVpvn_flags)
+static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char * s, STRLEN len, U32 flags);
+static
+#else
+extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char * s, STRLEN len, U32 flags);
+#endif
+
+#ifdef newSVpvn_flags
+# undef newSVpvn_flags
+#endif
+#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
+#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
+
+#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
+
+SV *
+DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
+{
+ SV *sv = newSVpvn(s, len);
+ SvFLAGS(sv) |= (flags & SVf_UTF8);
+ return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
+}
+
+#endif
+
+#endif
+
+/* Backwards compatibility stuff... :-( */
+#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
+# define NEED_sv_2pv_flags
+#endif
+#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
+# define NEED_sv_2pv_flags_GLOBAL
+#endif
+
+/* Hint: sv_2pv_nolen
+ * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
+ */
+#ifndef sv_2pv_nolen
+# define sv_2pv_nolen(sv) SvPV_nolen(sv)
+#endif
+
+#ifdef SvPVbyte
+
+/* Hint: SvPVbyte
+ * Does not work in perl-5.6.1, ppport.h implements a version
+ * borrowed from perl-5.7.3.
+ */
+
+#if (PERL_BCDVERSION < 0x5007000)
+
+#if defined(NEED_sv_2pvbyte)
+static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV * sv, STRLEN * lp);
+static
+#else
+extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV * sv, STRLEN * lp);
+#endif
+
+#ifdef sv_2pvbyte
+# undef sv_2pvbyte
+#endif
+#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
+#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
+
+#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
+
+char *
+DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
+{
+ sv_utf8_downgrade(sv,0);
+ return SvPV(sv,*lp);
+}
+
+#endif
+
+/* Hint: sv_2pvbyte
+ * Use the SvPVbyte() macro instead of sv_2pvbyte().
+ */
+
+#undef SvPVbyte
+
+#define SvPVbyte(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
+
+#endif
+
+#else
+
+# define SvPVbyte SvPV
+# define sv_2pvbyte sv_2pv
+
+#endif
+#ifndef sv_2pvbyte_nolen
+# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
+#endif
+
+/* Hint: sv_pvn
+ * Always use the SvPV() macro instead of sv_pvn().
+ */
+
+/* Hint: sv_pvn_force
+ * Always use the SvPV_force() macro instead of sv_pvn_force().
+ */
+
+/* If these are undefined, they're not handled by the core anyway */
+#ifndef SV_IMMEDIATE_UNREF
+# define SV_IMMEDIATE_UNREF 0
+#endif
+
+#ifndef SV_GMAGIC
+# define SV_GMAGIC 0
+#endif
+
+#ifndef SV_COW_DROP_PV
+# define SV_COW_DROP_PV 0
+#endif
+
+#ifndef SV_UTF8_NO_ENCODING
+# define SV_UTF8_NO_ENCODING 0
+#endif
+
+#ifndef SV_NOSTEAL
+# define SV_NOSTEAL 0
+#endif
+
+#ifndef SV_CONST_RETURN
+# define SV_CONST_RETURN 0
+#endif
+
+#ifndef SV_MUTABLE_RETURN
+# define SV_MUTABLE_RETURN 0
+#endif
+
+#ifndef SV_SMAGIC
+# define SV_SMAGIC 0
+#endif
+
+#ifndef SV_HAS_TRAILING_NUL
+# define SV_HAS_TRAILING_NUL 0
+#endif
+
+#ifndef SV_COW_SHARED_HASH_KEYS
+# define SV_COW_SHARED_HASH_KEYS 0
+#endif
+
+#if (PERL_BCDVERSION < 0x5007002)
+
+#if defined(NEED_sv_2pv_flags)
+static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags);
+static
+#else
+extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags);
+#endif
+
+#ifdef sv_2pv_flags
+# undef sv_2pv_flags
+#endif
+#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
+#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
+
+#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
+
+char *
+DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
+{
+ STRLEN n_a = (STRLEN) flags;
+ return sv_2pv(sv, lp ? lp : &n_a);
+}
+
+#endif
+
+#if defined(NEED_sv_pvn_force_flags)
+static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags);
+static
+#else
+extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags);
+#endif
+
+#ifdef sv_pvn_force_flags
+# undef sv_pvn_force_flags
+#endif
+#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
+#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
+
+#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
+
+char *
+DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
+{
+ STRLEN n_a = (STRLEN) flags;
+ return sv_pvn_force(sv, lp ? lp : &n_a);
+}
+
+#endif
+
+#endif
+
+#if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
+# define DPPP_SVPV_NOLEN_LP_ARG &PL_na
+#else
+# define DPPP_SVPV_NOLEN_LP_ARG 0
+#endif
+#ifndef SvPV_const
+# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_mutable
+# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
+#endif
+#ifndef SvPV_flags
+# define SvPV_flags(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
+#endif
+#ifndef SvPV_flags_const
+# define SvPV_flags_const(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
+ (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
+#endif
+#ifndef SvPV_flags_const_nolen
+# define SvPV_flags_const_nolen(sv, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX_const(sv) : \
+ (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
+#endif
+#ifndef SvPV_flags_mutable
+# define SvPV_flags_mutable(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
+ sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
+#endif
+#ifndef SvPV_force
+# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_force_nolen
+# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_force_mutable
+# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_force_nomg
+# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
+#endif
+
+#ifndef SvPV_force_nomg_nolen
+# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
+#endif
+#ifndef SvPV_force_flags
+# define SvPV_force_flags(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
+#endif
+#ifndef SvPV_force_flags_nolen
+# define SvPV_force_flags_nolen(sv, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
+#endif
+#ifndef SvPV_force_flags_mutable
+# define SvPV_force_flags_mutable(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
+ : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
+#endif
+#ifndef SvPV_nolen
+# define SvPV_nolen(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
+#endif
+#ifndef SvPV_nolen_const
+# define SvPV_nolen_const(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
+#endif
+#ifndef SvPV_nomg
+# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
+#endif
+
+#ifndef SvPV_nomg_const
+# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
+#endif
+
+#ifndef SvPV_nomg_const_nolen
+# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
+#endif
+#ifndef SvMAGIC_set
+# define SvMAGIC_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
+ (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
+#endif
+
+#if (PERL_BCDVERSION < 0x5009003)
+#ifndef SvPVX_const
+# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
+#endif
+
+#ifndef SvPVX_mutable
+# define SvPVX_mutable(sv) (0 + SvPVX(sv))
+#endif
+#ifndef SvRV_set
+# define SvRV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
+ (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
+#endif
+
+#else
+#ifndef SvPVX_const
+# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
+#endif
+
+#ifndef SvPVX_mutable
+# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
+#endif
+#ifndef SvRV_set
+# define SvRV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
+ ((sv)->sv_u.svu_rv = (val)); } STMT_END
+#endif
+
+#endif
+#ifndef SvSTASH_set
+# define SvSTASH_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
+ (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
+#endif
+
+#if (PERL_BCDVERSION < 0x5004000)
+#ifndef SvUV_set
+# define SvUV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
+ (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
+#endif
+
+#else
+#ifndef SvUV_set
+# define SvUV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
+ (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
+#endif
+
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
+#if defined(NEED_vnewSVpvf)
+static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
+static
+#else
+extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
+#endif
+
+#ifdef vnewSVpvf
+# undef vnewSVpvf
+#endif
+#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
+#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
+
+#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
+
+SV *
+DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
+{
+ register SV *sv = newSV(0);
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
+ return sv;
+}
+
+#endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
+# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
+# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
+#if defined(NEED_sv_catpvf_mg)
+static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
+static
+#else
+extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
+#endif
+
+#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
+
+#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
+
+void
+DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+
+#ifdef PERL_IMPLICIT_CONTEXT
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
+#if defined(NEED_sv_catpvf_mg_nocontext)
+static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
+static
+#else
+extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
+#endif
+
+#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+
+#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
+
+void
+DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+#endif
+
+/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
+#ifndef sv_catpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
+# else
+# define sv_catpvf_mg Perl_sv_catpvf_mg
+# endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
+# define sv_vcatpvf_mg(sv, pat, args) \
+ STMT_START { \
+ sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
+ SvSETMAGIC(sv); \
+ } STMT_END
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
+#if defined(NEED_sv_setpvf_mg)
+static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
+static
+#else
+extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
+#endif
+
+#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
+
+#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
+
+void
+DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+
+#ifdef PERL_IMPLICIT_CONTEXT
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
+#if defined(NEED_sv_setpvf_mg_nocontext)
+static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
+static
+#else
+extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
+#endif
+
+#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+
+#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
+
+void
+DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+#endif
+
+/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
+#ifndef sv_setpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
+# else
+# define sv_setpvf_mg Perl_sv_setpvf_mg
+# endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
+# define sv_vsetpvf_mg(sv, pat, args) \
+ STMT_START { \
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
+ SvSETMAGIC(sv); \
+ } STMT_END
+#endif
+
+#ifndef newSVpvn_share
+
+#if defined(NEED_newSVpvn_share)
+static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+static
+#else
+extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+#endif
+
+#ifdef newSVpvn_share
+# undef newSVpvn_share
+#endif
+#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
+#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
+
+#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
+
+SV *
+DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
+{
+ SV *sv;
+ if (len < 0)
+ len = -len;
+ if (!hash)
+ PERL_HASH(hash, (char*) src, len);
+ sv = newSVpvn((char *) src, len);
+ sv_upgrade(sv, SVt_PVIV);
+ SvIVX(sv) = hash;
+ SvREADONLY_on(sv);
+ SvPOK_on(sv);
+ return sv;
+}
+
+#endif
+
+#endif
+#ifndef SvSHARED_HASH
+# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
+#endif
+#ifndef WARN_ALL
+# define WARN_ALL 0
+#endif
+
+#ifndef WARN_CLOSURE
+# define WARN_CLOSURE 1
+#endif
+
+#ifndef WARN_DEPRECATED
+# define WARN_DEPRECATED 2
+#endif
+
+#ifndef WARN_EXITING
+# define WARN_EXITING 3
+#endif
+
+#ifndef WARN_GLOB
+# define WARN_GLOB 4
+#endif
+
+#ifndef WARN_IO
+# define WARN_IO 5
+#endif
+
+#ifndef WARN_CLOSED
+# define WARN_CLOSED 6
+#endif
+
+#ifndef WARN_EXEC
+# define WARN_EXEC 7
+#endif
+
+#ifndef WARN_LAYER
+# define WARN_LAYER 8
+#endif
+
+#ifndef WARN_NEWLINE
+# define WARN_NEWLINE 9
+#endif
+
+#ifndef WARN_PIPE
+# define WARN_PIPE 10
+#endif
+
+#ifndef WARN_UNOPENED
+# define WARN_UNOPENED 11
+#endif
+
+#ifndef WARN_MISC
+# define WARN_MISC 12
+#endif
+
+#ifndef WARN_NUMERIC
+# define WARN_NUMERIC 13
+#endif
+
+#ifndef WARN_ONCE
+# define WARN_ONCE 14
+#endif
+
+#ifndef WARN_OVERFLOW
+# define WARN_OVERFLOW 15
+#endif
+
+#ifndef WARN_PACK
+# define WARN_PACK 16
+#endif
+
+#ifndef WARN_PORTABLE
+# define WARN_PORTABLE 17
+#endif
+
+#ifndef WARN_RECURSION
+# define WARN_RECURSION 18
+#endif
+
+#ifndef WARN_REDEFINE
+# define WARN_REDEFINE 19
+#endif
+
+#ifndef WARN_REGEXP
+# define WARN_REGEXP 20
+#endif
+
+#ifndef WARN_SEVERE
+# define WARN_SEVERE 21
+#endif
+
+#ifndef WARN_DEBUGGING
+# define WARN_DEBUGGING 22
+#endif
+
+#ifndef WARN_INPLACE
+# define WARN_INPLACE 23
+#endif
+
+#ifndef WARN_INTERNAL
+# define WARN_INTERNAL 24
+#endif
+
+#ifndef WARN_MALLOC
+# define WARN_MALLOC 25
+#endif
+
+#ifndef WARN_SIGNAL
+# define WARN_SIGNAL 26
+#endif
+
+#ifndef WARN_SUBSTR
+# define WARN_SUBSTR 27
+#endif
+
+#ifndef WARN_SYNTAX
+# define WARN_SYNTAX 28
+#endif
+
+#ifndef WARN_AMBIGUOUS
+# define WARN_AMBIGUOUS 29
+#endif
+
+#ifndef WARN_BAREWORD
+# define WARN_BAREWORD 30
+#endif
+
+#ifndef WARN_DIGIT
+# define WARN_DIGIT 31
+#endif
+
+#ifndef WARN_PARENTHESIS
+# define WARN_PARENTHESIS 32
+#endif
+
+#ifndef WARN_PRECEDENCE
+# define WARN_PRECEDENCE 33
+#endif
+
+#ifndef WARN_PRINTF
+# define WARN_PRINTF 34
+#endif
+
+#ifndef WARN_PROTOTYPE
+# define WARN_PROTOTYPE 35
+#endif
+
+#ifndef WARN_QW
+# define WARN_QW 36
+#endif
+
+#ifndef WARN_RESERVED
+# define WARN_RESERVED 37
+#endif
+
+#ifndef WARN_SEMICOLON
+# define WARN_SEMICOLON 38
+#endif
+
+#ifndef WARN_TAINT
+# define WARN_TAINT 39
+#endif
+
+#ifndef WARN_THREADS
+# define WARN_THREADS 40
+#endif
+
+#ifndef WARN_UNINITIALIZED
+# define WARN_UNINITIALIZED 41
+#endif
+
+#ifndef WARN_UNPACK
+# define WARN_UNPACK 42
+#endif
+
+#ifndef WARN_UNTIE
+# define WARN_UNTIE 43
+#endif
+
+#ifndef WARN_UTF8
+# define WARN_UTF8 44
+#endif
+
+#ifndef WARN_VOID
+# define WARN_VOID 45
+#endif
+
+#ifndef WARN_ASSERTIONS
+# define WARN_ASSERTIONS 46
+#endif
+#ifndef packWARN
+# define packWARN(a) (a)
+#endif
+
+#ifndef ckWARN
+# ifdef G_WARN_ON
+# define ckWARN(a) (PL_dowarn & G_WARN_ON)
+# else
+# define ckWARN(a) PL_dowarn
+# endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
+#if defined(NEED_warner)
+static void DPPP_(my_warner)(U32 err, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
+#endif
+
+#define Perl_warner DPPP_(my_warner)
+
+#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
+
+void
+DPPP_(my_warner)(U32 err, const char *pat, ...)
+{
+ SV *sv;
+ va_list args;
+
+ PERL_UNUSED_ARG(err);
+
+ va_start(args, pat);
+ sv = vnewSVpvf(pat, &args);
+ va_end(args);
+ sv_2mortal(sv);
+ warn("%s", SvPV_nolen(sv));
+}
+
+#define warner Perl_warner
+
+#define Perl_warner_nocontext Perl_warner
+
+#endif
+#endif
+
+/* concatenating with "" ensures that only literal strings are accepted as argument
+ * note that STR_WITH_LEN() can't be used as argument to macros or functions that
+ * under some configurations might be macros
+ */
+#ifndef STR_WITH_LEN
+# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
+#endif
+#ifndef newSVpvs
+# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
+#endif
+
+#ifndef newSVpvs_flags
+# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
+#endif
+
+#ifndef sv_catpvs
+# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
+#endif
+
+#ifndef sv_setpvs
+# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
+#endif
+
+#ifndef hv_fetchs
+# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
+#endif
+
+#ifndef hv_stores
+# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
+#endif
+#ifndef SvGETMAGIC
+# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
+#endif
+#ifndef PERL_MAGIC_sv
+# define PERL_MAGIC_sv '\0'
+#endif
+
+#ifndef PERL_MAGIC_overload
+# define PERL_MAGIC_overload 'A'
+#endif
+
+#ifndef PERL_MAGIC_overload_elem
+# define PERL_MAGIC_overload_elem 'a'
+#endif
+
+#ifndef PERL_MAGIC_overload_table
+# define PERL_MAGIC_overload_table 'c'
+#endif
+
+#ifndef PERL_MAGIC_bm
+# define PERL_MAGIC_bm 'B'
+#endif
+
+#ifndef PERL_MAGIC_regdata
+# define PERL_MAGIC_regdata 'D'
+#endif
+
+#ifndef PERL_MAGIC_regdatum
+# define PERL_MAGIC_regdatum 'd'
+#endif
+
+#ifndef PERL_MAGIC_env
+# define PERL_MAGIC_env 'E'
+#endif
+
+#ifndef PERL_MAGIC_envelem
+# define PERL_MAGIC_envelem 'e'
+#endif
+
+#ifndef PERL_MAGIC_fm
+# define PERL_MAGIC_fm 'f'
+#endif
+
+#ifndef PERL_MAGIC_regex_global
+# define PERL_MAGIC_regex_global 'g'
+#endif
+
+#ifndef PERL_MAGIC_isa
+# define PERL_MAGIC_isa 'I'
+#endif
+
+#ifndef PERL_MAGIC_isaelem
+# define PERL_MAGIC_isaelem 'i'
+#endif
+
+#ifndef PERL_MAGIC_nkeys
+# define PERL_MAGIC_nkeys 'k'
+#endif
+
+#ifndef PERL_MAGIC_dbfile
+# define PERL_MAGIC_dbfile 'L'
+#endif
+
+#ifndef PERL_MAGIC_dbline
+# define PERL_MAGIC_dbline 'l'
+#endif
+
+#ifndef PERL_MAGIC_mutex
+# define PERL_MAGIC_mutex 'm'
+#endif
+
+#ifndef PERL_MAGIC_shared
+# define PERL_MAGIC_shared 'N'
+#endif
+
+#ifndef PERL_MAGIC_shared_scalar
+# define PERL_MAGIC_shared_scalar 'n'
+#endif
+
+#ifndef PERL_MAGIC_collxfrm
+# define PERL_MAGIC_collxfrm 'o'
+#endif
+
+#ifndef PERL_MAGIC_tied
+# define PERL_MAGIC_tied 'P'
+#endif
+
+#ifndef PERL_MAGIC_tiedelem
+# define PERL_MAGIC_tiedelem 'p'
+#endif
+
+#ifndef PERL_MAGIC_tiedscalar
+# define PERL_MAGIC_tiedscalar 'q'
+#endif
+
+#ifndef PERL_MAGIC_qr
+# define PERL_MAGIC_qr 'r'
+#endif
+
+#ifndef PERL_MAGIC_sig
+# define PERL_MAGIC_sig 'S'
+#endif
+
+#ifndef PERL_MAGIC_sigelem
+# define PERL_MAGIC_sigelem 's'
+#endif
+
+#ifndef PERL_MAGIC_taint
+# define PERL_MAGIC_taint 't'
+#endif
+
+#ifndef PERL_MAGIC_uvar
+# define PERL_MAGIC_uvar 'U'
+#endif
+
+#ifndef PERL_MAGIC_uvar_elem
+# define PERL_MAGIC_uvar_elem 'u'
+#endif
+
+#ifndef PERL_MAGIC_vstring
+# define PERL_MAGIC_vstring 'V'
+#endif
+
+#ifndef PERL_MAGIC_vec
+# define PERL_MAGIC_vec 'v'
+#endif
+
+#ifndef PERL_MAGIC_utf8
+# define PERL_MAGIC_utf8 'w'
+#endif
+
+#ifndef PERL_MAGIC_substr
+# define PERL_MAGIC_substr 'x'
+#endif
+
+#ifndef PERL_MAGIC_defelem
+# define PERL_MAGIC_defelem 'y'
+#endif
+
+#ifndef PERL_MAGIC_glob
+# define PERL_MAGIC_glob '*'
+#endif
+
+#ifndef PERL_MAGIC_arylen
+# define PERL_MAGIC_arylen '#'
+#endif
+
+#ifndef PERL_MAGIC_pos
+# define PERL_MAGIC_pos '.'
+#endif
+
+#ifndef PERL_MAGIC_backref
+# define PERL_MAGIC_backref '<'
+#endif
+
+#ifndef PERL_MAGIC_ext
+# define PERL_MAGIC_ext '~'
+#endif
+
+/* That's the best we can do... */
+#ifndef sv_catpvn_nomg
+# define sv_catpvn_nomg sv_catpvn
+#endif
+
+#ifndef sv_catsv_nomg
+# define sv_catsv_nomg sv_catsv
+#endif
+
+#ifndef sv_setsv_nomg
+# define sv_setsv_nomg sv_setsv
+#endif
+
+#ifndef sv_pvn_nomg
+# define sv_pvn_nomg sv_pvn
+#endif
+
+#ifndef SvIV_nomg
+# define SvIV_nomg SvIV
+#endif
+
+#ifndef SvUV_nomg
+# define SvUV_nomg SvUV
+#endif
+
+#ifndef sv_catpv_mg
+# define sv_catpv_mg(sv, ptr) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_catpv(TeMpSv,ptr); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_catpvn_mg
+# define sv_catpvn_mg(sv, ptr, len) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_catpvn(TeMpSv,ptr,len); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_catsv_mg
+# define sv_catsv_mg(dsv, ssv) \
+ STMT_START { \
+ SV *TeMpSv = dsv; \
+ sv_catsv(TeMpSv,ssv); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setiv_mg
+# define sv_setiv_mg(sv, i) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setiv(TeMpSv,i); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setnv_mg
+# define sv_setnv_mg(sv, num) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setnv(TeMpSv,num); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setpv_mg
+# define sv_setpv_mg(sv, ptr) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setpv(TeMpSv,ptr); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setpvn_mg
+# define sv_setpvn_mg(sv, ptr, len) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setpvn(TeMpSv,ptr,len); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setsv_mg
+# define sv_setsv_mg(dsv, ssv) \
+ STMT_START { \
+ SV *TeMpSv = dsv; \
+ sv_setsv(TeMpSv,ssv); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_setuv_mg
+# define sv_setuv_mg(sv, i) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setuv(TeMpSv,i); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+
+#ifndef sv_usepvn_mg
+# define sv_usepvn_mg(sv, ptr, len) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_usepvn(TeMpSv,ptr,len); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
+#endif
+#ifndef SvVSTRING_mg
+# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
+#endif
+
+/* Hint: sv_magic_portable
+ * This is a compatibility function that is only available with
+ * Devel::PPPort. It is NOT in the perl core.
+ * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
+ * it is being passed a name pointer with namlen == 0. In that
+ * case, perl 5.8.0 and later store the pointer, not a copy of it.
+ * The compatibility can be provided back to perl 5.004. With
+ * earlier versions, the code will not compile.
+ */
+
+#if (PERL_BCDVERSION < 0x5004000)
+
+ /* code that uses sv_magic_portable will not compile */
+
+#elif (PERL_BCDVERSION < 0x5008000)
+
+# define sv_magic_portable(sv, obj, how, name, namlen) \
+ STMT_START { \
+ SV *SvMp_sv = (sv); \
+ char *SvMp_name = (char *) (name); \
+ I32 SvMp_namlen = (namlen); \
+ if (SvMp_name && SvMp_namlen == 0) \
+ { \
+ MAGIC *mg; \
+ sv_magic(SvMp_sv, obj, how, 0, 0); \
+ mg = SvMAGIC(SvMp_sv); \
+ mg->mg_len = -42; /* XXX: this is the tricky part */ \
+ mg->mg_ptr = SvMp_name; \
+ } \
+ else \
+ { \
+ sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
+ } \
+ } STMT_END
+
+#else
+
+# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
+
+#endif
+
+#ifdef USE_ITHREADS
+#ifndef CopFILE
+# define CopFILE(c) ((c)->cop_file)
+#endif
+
+#ifndef CopFILEGV
+# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
+#endif
+
+#ifndef CopFILE_set
+# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
+#endif
+
+#ifndef CopFILESV
+# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
+#endif
+
+#ifndef CopFILEAV
+# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
+#endif
+
+#ifndef CopSTASHPV
+# define CopSTASHPV(c) ((c)->cop_stashpv)
+#endif
+
+#ifndef CopSTASHPV_set
+# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
+#endif
+
+#ifndef CopSTASH
+# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
+#endif
+
+#ifndef CopSTASH_set
+# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
+#endif
+
+#ifndef CopSTASH_eq
+# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
+ || (CopSTASHPV(c) && HvNAME(hv) \
+ && strEQ(CopSTASHPV(c), HvNAME(hv)))))
+#endif
+
+#else
+#ifndef CopFILEGV
+# define CopFILEGV(c) ((c)->cop_filegv)
+#endif
+
+#ifndef CopFILEGV_set
+# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
+#endif
+
+#ifndef CopFILE_set
+# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
+#endif
+
+#ifndef CopFILESV
+# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
+#endif
+
+#ifndef CopFILEAV
+# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
+#endif
+
+#ifndef CopFILE
+# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
+#endif
+
+#ifndef CopSTASH
+# define CopSTASH(c) ((c)->cop_stash)
+#endif
+
+#ifndef CopSTASH_set
+# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
+#endif
+
+#ifndef CopSTASHPV
+# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
+#endif
+
+#ifndef CopSTASHPV_set
+# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
+#endif
+
+#ifndef CopSTASH_eq
+# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
+#endif
+
+#endif /* USE_ITHREADS */
+#ifndef IN_PERL_COMPILETIME
+# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
+#endif
+
+#ifndef IN_LOCALE_RUNTIME
+# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
+#endif
+
+#ifndef IN_LOCALE_COMPILETIME
+# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
+#endif
+
+#ifndef IN_LOCALE
+# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
+#endif
+#ifndef IS_NUMBER_IN_UV
+# define IS_NUMBER_IN_UV 0x01
+#endif
+
+#ifndef IS_NUMBER_GREATER_THAN_UV_MAX
+# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
+#endif
+
+#ifndef IS_NUMBER_NOT_INT
+# define IS_NUMBER_NOT_INT 0x04
+#endif
+
+#ifndef IS_NUMBER_NEG
+# define IS_NUMBER_NEG 0x08
+#endif
+
+#ifndef IS_NUMBER_INFINITY
+# define IS_NUMBER_INFINITY 0x10
+#endif
+
+#ifndef IS_NUMBER_NAN
+# define IS_NUMBER_NAN 0x20
+#endif
+#ifndef GROK_NUMERIC_RADIX
+# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
+#endif
+#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
+# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
+#endif
+
+#ifndef PERL_SCAN_SILENT_ILLDIGIT
+# define PERL_SCAN_SILENT_ILLDIGIT 0x04
+#endif
+
+#ifndef PERL_SCAN_ALLOW_UNDERSCORES
+# define PERL_SCAN_ALLOW_UNDERSCORES 0x01
+#endif
+
+#ifndef PERL_SCAN_DISALLOW_PREFIX
+# define PERL_SCAN_DISALLOW_PREFIX 0x02
+#endif
+
+#ifndef grok_numeric_radix
+#if defined(NEED_grok_numeric_radix)
+static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+static
+#else
+extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+#endif
+
+#ifdef grok_numeric_radix
+# undef grok_numeric_radix
+#endif
+#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
+#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
+
+#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
+bool
+DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
+{
+#ifdef USE_LOCALE_NUMERIC
+#ifdef PL_numeric_radix_sv
+ if (PL_numeric_radix_sv && IN_LOCALE) {
+ STRLEN len;
+ char* radix = SvPV(PL_numeric_radix_sv, len);
+ if (*sp + len <= send && memEQ(*sp, radix, len)) {
+ *sp += len;
+ return TRUE;
+ }
+ }
+#else
+ /* older perls don't have PL_numeric_radix_sv so the radix
+ * must manually be requested from locale.h
+ */
+#include <locale.h>
+ dTHR; /* needed for older threaded perls */
+ struct lconv *lc = localeconv();
+ char *radix = lc->decimal_point;
+ if (radix && IN_LOCALE) {
+ STRLEN len = strlen(radix);
+ if (*sp + len <= send && memEQ(*sp, radix, len)) {
+ *sp += len;
+ return TRUE;
+ }
+ }
+#endif
+#endif /* USE_LOCALE_NUMERIC */
+ /* always try "." if numeric radix didn't match because
+ * we may have data from different locales mixed */
+ if (*sp < send && **sp == '.') {
+ ++*sp;
+ return TRUE;
+ }
+ return FALSE;
+}
+#endif
+#endif
+
+#ifndef grok_number
+#if defined(NEED_grok_number)
+static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+static
+#else
+extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+#endif
+
+#ifdef grok_number
+# undef grok_number
+#endif
+#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
+#define Perl_grok_number DPPP_(my_grok_number)
+
+#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
+int
+DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
+{
+ const char *s = pv;
+ const char *send = pv + len;
+ const UV max_div_10 = UV_MAX / 10;
+ const char max_mod_10 = UV_MAX % 10;
+ int numtype = 0;
+ int sawinf = 0;
+ int sawnan = 0;
+
+ while (s < send && isSPACE(*s))
+ s++;
+ if (s == send) {
+ return 0;
+ } else if (*s == '-') {
+ s++;
+ numtype = IS_NUMBER_NEG;
+ }
+ else if (*s == '+')
+ s++;
+
+ if (s == send)
+ return 0;
+
+ /* next must be digit or the radix separator or beginning of infinity */
+ if (isDIGIT(*s)) {
+ /* UVs are at least 32 bits, so the first 9 decimal digits cannot
+ overflow. */
+ UV value = *s - '0';
+ /* This construction seems to be more optimiser friendly.
+ (without it gcc does the isDIGIT test and the *s - '0' separately)
+ With it gcc on arm is managing 6 instructions (6 cycles) per digit.
+ In theory the optimiser could deduce how far to unroll the loop
+ before checking for overflow. */
+ if (++s < send) {
+ int digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ digit = *s - '0';
+ if (digit >= 0 && digit <= 9) {
+ value = value * 10 + digit;
+ if (++s < send) {
+ /* Now got 9 digits, so need to check
+ each time for overflow. */
+ digit = *s - '0';
+ while (digit >= 0 && digit <= 9
+ && (value < max_div_10
+ || (value == max_div_10
+ && digit <= max_mod_10))) {
+ value = value * 10 + digit;
+ if (++s < send)
+ digit = *s - '0';
+ else
+ break;
+ }
+ if (digit >= 0 && digit <= 9
+ && (s < send)) {
+ /* value overflowed.
+ skip the remaining digits, don't
+ worry about setting *valuep. */
+ do {
+ s++;
+ } while (s < send && isDIGIT(*s));
+ numtype |=
+ IS_NUMBER_GREATER_THAN_UV_MAX;
+ goto skip_value;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ numtype |= IS_NUMBER_IN_UV;
+ if (valuep)
+ *valuep = value;
+
+ skip_value:
+ if (GROK_NUMERIC_RADIX(&s, send)) {
+ numtype |= IS_NUMBER_NOT_INT;
+ while (s < send && isDIGIT(*s)) /* optional digits after the radix */
+ s++;
+ }
+ }
+ else if (GROK_NUMERIC_RADIX(&s, send)) {
+ numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
+ /* no digits before the radix means we need digits after it */
+ if (s < send && isDIGIT(*s)) {
+ do {
+ s++;
+ } while (s < send && isDIGIT(*s));
+ if (valuep) {
+ /* integer approximation is valid - it's 0. */
+ *valuep = 0;
+ }
+ }
+ else
+ return 0;
+ } else if (*s == 'I' || *s == 'i') {
+ s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+ s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
+ s++; if (s < send && (*s == 'I' || *s == 'i')) {
+ s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+ s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
+ s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
+ s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
+ s++;
+ }
+ sawinf = 1;
+ } else if (*s == 'N' || *s == 'n') {
+ /* XXX TODO: There are signaling NaNs and quiet NaNs. */
+ s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
+ s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
+ s++;
+ sawnan = 1;
+ } else
+ return 0;
+
+ if (sawinf) {
+ numtype &= IS_NUMBER_NEG; /* Keep track of sign */
+ numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
+ } else if (sawnan) {
+ numtype &= IS_NUMBER_NEG; /* Keep track of sign */
+ numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
+ } else if (s < send) {
+ /* we can have an optional exponent part */
+ if (*s == 'e' || *s == 'E') {
+ /* The only flag we keep is sign. Blow away any "it's UV" */
+ numtype &= IS_NUMBER_NEG;
+ numtype |= IS_NUMBER_NOT_INT;
+ s++;
+ if (s < send && (*s == '-' || *s == '+'))
+ s++;
+ if (s < send && isDIGIT(*s)) {
+ do {
+ s++;
+ } while (s < send && isDIGIT(*s));
+ }
+ else
+ return 0;
+ }
+ }
+ while (s < send && isSPACE(*s))
+ s++;
+ if (s >= send)
+ return numtype;
+ if (len == 10 && memEQ(pv, "0 but true", 10)) {
+ if (valuep)
+ *valuep = 0;
+ return IS_NUMBER_IN_UV;
+ }
+ return 0;
+}
+#endif
+#endif
+
+/*
+ * The grok_* routines have been modified to use warn() instead of
+ * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
+ * which is why the stack variable has been renamed to 'xdigit'.
+ */
+
+#ifndef grok_bin
+#if defined(NEED_grok_bin)
+static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+static
+#else
+extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+#endif
+
+#ifdef grok_bin
+# undef grok_bin
+#endif
+#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
+#define Perl_grok_bin DPPP_(my_grok_bin)
+
+#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
+UV
+DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
+{
+ const char *s = start;
+ STRLEN len = *len_p;
+ UV value = 0;
+ NV value_nv = 0;
+
+ const UV max_div_2 = UV_MAX / 2;
+ bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+ bool overflowed = FALSE;
+
+ if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
+ /* strip off leading b or 0b.
+ for compatibility silently suffer "b" and "0b" as valid binary
+ numbers. */
+ if (len >= 1) {
+ if (s[0] == 'b') {
+ s++;
+ len--;
+ }
+ else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
+ s+=2;
+ len-=2;
+ }
+ }
+ }
+
+ for (; len-- && *s; s++) {
+ char bit = *s;
+ if (bit == '0' || bit == '1') {
+ /* Write it in this wonky order with a goto to attempt to get the
+ compiler to make the common case integer-only loop pretty tight.
+ With gcc seems to be much straighter code than old scan_bin. */
+ redo:
+ if (!overflowed) {
+ if (value <= max_div_2) {
+ value = (value << 1) | (bit - '0');
+ continue;
+ }
+ /* Bah. We're just overflowed. */
+ warn("Integer overflow in binary number");
+ overflowed = TRUE;
+ value_nv = (NV) value;
+ }
+ value_nv *= 2.0;
+ /* If an NV has not enough bits in its mantissa to
+ * represent a UV this summing of small low-order numbers
+ * is a waste of time (because the NV cannot preserve
+ * the low-order bits anyway): we could just remember when
+ * did we overflow and in the end just multiply value_nv by the
+ * right amount. */
+ value_nv += (NV)(bit - '0');
+ continue;
+ }
+ if (bit == '_' && len && allow_underscores && (bit = s[1])
+ && (bit == '0' || bit == '1'))
+ {
+ --len;
+ ++s;
+ goto redo;
+ }
+ if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
+ warn("Illegal binary digit '%c' ignored", *s);
+ break;
+ }
+
+ if ( ( overflowed && value_nv > 4294967295.0)
+#if UVSIZE > 4
+ || (!overflowed && value > 0xffffffff )
+#endif
+ ) {
+ warn("Binary number > 0b11111111111111111111111111111111 non-portable");
+ }
+ *len_p = s - start;
+ if (!overflowed) {
+ *flags = 0;
+ return value;
+ }
+ *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
+ if (result)
+ *result = value_nv;
+ return UV_MAX;
+}
+#endif
+#endif
+
+#ifndef grok_hex
+#if defined(NEED_grok_hex)
+static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+static
+#else
+extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+#endif
+
+#ifdef grok_hex
+# undef grok_hex
+#endif
+#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
+#define Perl_grok_hex DPPP_(my_grok_hex)
+
+#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
+UV
+DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
+{
+ const char *s = start;
+ STRLEN len = *len_p;
+ UV value = 0;
+ NV value_nv = 0;
+
+ const UV max_div_16 = UV_MAX / 16;
+ bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+ bool overflowed = FALSE;
+ const char *xdigit;
+
+ if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
+ /* strip off leading x or 0x.
+ for compatibility silently suffer "x" and "0x" as valid hex numbers.
+ */
+ if (len >= 1) {
+ if (s[0] == 'x') {
+ s++;
+ len--;
+ }
+ else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
+ s+=2;
+ len-=2;
+ }
+ }
+ }
+
+ for (; len-- && *s; s++) {
+ xdigit = strchr((char *) PL_hexdigit, *s);
+ if (xdigit) {
+ /* Write it in this wonky order with a goto to attempt to get the
+ compiler to make the common case integer-only loop pretty tight.
+ With gcc seems to be much straighter code than old scan_hex. */
+ redo:
+ if (!overflowed) {
+ if (value <= max_div_16) {
+ value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
+ continue;
+ }
+ warn("Integer overflow in hexadecimal number");
+ overflowed = TRUE;
+ value_nv = (NV) value;
+ }
+ value_nv *= 16.0;
+ /* If an NV has not enough bits in its mantissa to
+ * represent a UV this summing of small low-order numbers
+ * is a waste of time (because the NV cannot preserve
+ * the low-order bits anyway): we could just remember when
+ * did we overflow and in the end just multiply value_nv by the
+ * right amount of 16-tuples. */
+ value_nv += (NV)((xdigit - PL_hexdigit) & 15);
+ continue;
+ }
+ if (*s == '_' && len && allow_underscores && s[1]
+ && (xdigit = strchr((char *) PL_hexdigit, s[1])))
+ {
+ --len;
+ ++s;
+ goto redo;
+ }
+ if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
+ warn("Illegal hexadecimal digit '%c' ignored", *s);
+ break;
+ }
+
+ if ( ( overflowed && value_nv > 4294967295.0)
+#if UVSIZE > 4
+ || (!overflowed && value > 0xffffffff )
+#endif
+ ) {
+ warn("Hexadecimal number > 0xffffffff non-portable");
+ }
+ *len_p = s - start;
+ if (!overflowed) {
+ *flags = 0;
+ return value;
+ }
+ *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
+ if (result)
+ *result = value_nv;
+ return UV_MAX;
+}
+#endif
+#endif
+
+#ifndef grok_oct
+#if defined(NEED_grok_oct)
+static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+static
+#else
+extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+#endif
+
+#ifdef grok_oct
+# undef grok_oct
+#endif
+#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
+#define Perl_grok_oct DPPP_(my_grok_oct)
+
+#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
+UV
+DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
+{
+ const char *s = start;
+ STRLEN len = *len_p;
+ UV value = 0;
+ NV value_nv = 0;
+
+ const UV max_div_8 = UV_MAX / 8;
+ bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+ bool overflowed = FALSE;
+
+ for (; len-- && *s; s++) {
+ /* gcc 2.95 optimiser not smart enough to figure that this subtraction
+ out front allows slicker code. */
+ int digit = *s - '0';
+ if (digit >= 0 && digit <= 7) {
+ /* Write it in this wonky order with a goto to attempt to get the
+ compiler to make the common case integer-only loop pretty tight.
+ */
+ redo:
+ if (!overflowed) {
+ if (value <= max_div_8) {
+ value = (value << 3) | digit;
+ continue;
+ }
+ /* Bah. We're just overflowed. */
+ warn("Integer overflow in octal number");
+ overflowed = TRUE;
+ value_nv = (NV) value;
+ }
+ value_nv *= 8.0;
+ /* If an NV has not enough bits in its mantissa to
+ * represent a UV this summing of small low-order numbers
+ * is a waste of time (because the NV cannot preserve
+ * the low-order bits anyway): we could just remember when
+ * did we overflow and in the end just multiply value_nv by the
+ * right amount of 8-tuples. */
+ value_nv += (NV)digit;
+ continue;
+ }
+ if (digit == ('_' - '0') && len && allow_underscores
+ && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
+ {
+ --len;
+ ++s;
+ goto redo;
+ }
+ /* Allow \octal to work the DWIM way (that is, stop scanning
+ * as soon as non-octal characters are seen, complain only iff
+ * someone seems to want to use the digits eight and nine). */
+ if (digit == 8 || digit == 9) {
+ if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
+ warn("Illegal octal digit '%c' ignored", *s);
+ }
+ break;
+ }
+
+ if ( ( overflowed && value_nv > 4294967295.0)
+#if UVSIZE > 4
+ || (!overflowed && value > 0xffffffff )
+#endif
+ ) {
+ warn("Octal number > 037777777777 non-portable");
+ }
+ *len_p = s - start;
+ if (!overflowed) {
+ *flags = 0;
+ return value;
+ }
+ *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
+ if (result)
+ *result = value_nv;
+ return UV_MAX;
+}
+#endif
+#endif
+
+#if !defined(my_snprintf)
+#if defined(NEED_my_snprintf)
+static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
+static
+#else
+extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
+#endif
+
+#define my_snprintf DPPP_(my_my_snprintf)
+#define Perl_my_snprintf DPPP_(my_my_snprintf)
+
+#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
+
+int
+DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
+{
+ dTHX;
+ int retval;
+ va_list ap;
+ va_start(ap, format);
+#ifdef HAS_VSNPRINTF
+ retval = vsnprintf(buffer, len, format, ap);
+#else
+ retval = vsprintf(buffer, format, ap);
+#endif
+ va_end(ap);
+ if (retval >= (int)len)
+ Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
+ return retval;
+}
+
+#endif
+#endif
+
+#ifdef NO_XSLOCKS
+# ifdef dJMPENV
+# define dXCPT dJMPENV; int rEtV = 0
+# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
+# define XCPT_TRY_END JMPENV_POP;
+# define XCPT_CATCH if (rEtV != 0)
+# define XCPT_RETHROW JMPENV_JUMP(rEtV)
+# else
+# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
+# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
+# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
+# define XCPT_CATCH if (rEtV != 0)
+# define XCPT_RETHROW Siglongjmp(top_env, rEtV)
+# endif
+#endif
+
+#if !defined(my_strlcat)
+#if defined(NEED_my_strlcat)
+static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
+static
+#else
+extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
+#endif
+
+#define my_strlcat DPPP_(my_my_strlcat)
+#define Perl_my_strlcat DPPP_(my_my_strlcat)
+
+#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
+
+Size_t
+DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
+{
+ Size_t used, length, copy;
+
+ used = strlen(dst);
+ length = strlen(src);
+ if (size > 0 && used < size - 1) {
+ copy = (length >= size - used) ? size - used - 1 : length;
+ memcpy(dst + used, src, copy);
+ dst[used + copy] = '\0';
+ }
+ return used + length;
+}
+#endif
+#endif
+
+#if !defined(my_strlcpy)
+#if defined(NEED_my_strlcpy)
+static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
+static
+#else
+extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
+#endif
+
+#define my_strlcpy DPPP_(my_my_strlcpy)
+#define Perl_my_strlcpy DPPP_(my_my_strlcpy)
+
+#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
+
+Size_t
+DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
+{
+ Size_t length, copy;
+
+ length = strlen(src);
+ if (size > 0) {
+ copy = (length >= size) ? size - 1 : length;
+ memcpy(dst, src, copy);
+ dst[copy] = '\0';
+ }
+ return length;
+}
+
+#endif
+#endif
+
+#endif /* _P_P_PORTABILITY_H_ */
+
+/* End of File ppport.h */
diff --git a/Basic/Core/typemap b/Basic/Core/typemap
new file mode 100644
index 0000000..a74f1ae
--- /dev/null
+++ b/Basic/Core/typemap
@@ -0,0 +1,26 @@
+TYPEMAP
+pdl* T_PDL
+pdl * T_PDL
+pdl_trans * T_PDLTRANS
+pdl_trans* T_PDLTRANS
+Logical T_IV
+PDL_Indx T_IV
+
+INPUT
+
+T_PDL
+ $var = SvPDLV($arg)
+T_PDLTRANS
+ if(sv_isa($arg,\"PDL::Trans\"))
+ $var = INT2PTR(pdl_trans *,SvIV(SvRV($arg)));
+ else
+ croak(\"$var is not of type PDL::Trans\")
+
+
+OUTPUT
+
+T_PDL
+ SetSV_PDL($arg,$var);
+T_PDLTRANS
+ sv_setref_pv($arg, \"PDL::Trans\", (void*)$var);
+
diff --git a/Basic/Core/typemap.pdl b/Basic/Core/typemap.pdl
new file mode 100644
index 0000000..47e080d
--- /dev/null
+++ b/Basic/Core/typemap.pdl
@@ -0,0 +1,26 @@
+TYPEMAP
+pdl* T_PDL
+pdl * T_PDL
+pdl_trans * T_PDLTRANS
+pdl_trans* T_PDLTRANS
+Logical T_IV
+PDL_Indx T_IV
+float T_NV
+
+INPUT
+
+T_PDL
+ $var = PDL->SvPDLV($arg)
+T_PDLTRANS
+ if(sv_isa($arg,\"PDL::Trans\"))
+ $var = INT2PTR(pdl_trans *,SvIV(SvRV($arg)));
+ else
+ croak(\"$var is not of type PDL::Trans\")
+
+
+OUTPUT
+
+T_PDL
+ PDL->SetSV_PDL($arg,$var);
+T_PDLTRANS
+ sv_setref_pv($arg, \"PDL::Trans\", (void*)$var);
diff --git a/Basic/Gen/Inline/MakePdlppInstallable.pm b/Basic/Gen/Inline/MakePdlppInstallable.pm
new file mode 100644
index 0000000..aa55973
--- /dev/null
+++ b/Basic/Gen/Inline/MakePdlppInstallable.pm
@@ -0,0 +1,76 @@
+package Inline::MakePdlppInstallable;
+
+# just a dummy package
+
+package # have to break this up so the
+ # CPAN indexer doesn't barf
+ Inline;
+
+#==============================================================================
+# override the original Inline::install method
+# to allow Inline::Pdlpp code to be installed
+#
+# this is a hack !
+#
+# we put the modified function into its own little file
+# to keep the runtime impact at a minimum
+#
+# use as follows in modules containing inlined PDL::PP code:
+#
+# use Inline::MakePdlppInstallable;
+# use Inline Pdlpp => ....
+#
+# hopefully Inline will establishe a proper mechanism soon
+# to allow installation of non-C modules -- at least Brian Ingerson
+# promised to put it on the TODO list
+#==============================================================================
+
+# copied verbatim from Inline 0.43 apart from language_id check below
+sub install {
+ my ($module, $DIRECTORY);
+ my $o = shift;
+
+ # print STDERR "in redefined Inline::install\n";
+ croak M64_install_not_c($o->{API}{language_id})
+ unless uc($o->{API}{language_id}) eq 'C' ||
+ uc($o->{API}{language_id}) eq 'PDLPP'; # also allow Pdlpp !
+ croak M36_usage_install_main()
+ if ($o->{API}{pkg} eq 'main');
+ croak M37_usage_install_auto()
+ if $o->{CONFIG}{AUTONAME};
+ croak M38_usage_install_name()
+ unless $o->{CONFIG}{NAME};
+ croak M39_usage_install_version()
+ unless $o->{CONFIG}{VERSION};
+ croak M40_usage_install_badname($o->{CONFIG}{NAME}, $o->{API}{pkg})
+ unless $o->{CONFIG}{NAME} eq $o->{API}{pkg};
+# $o->{CONFIG}{NAME} =~ /^$o->{API}{pkg}::\w(\w|::)+$/
+# );
+
+ my ($mod_name, $mod_ver, $ext_name, $ext_ver) =
+ ($o->{API}{pkg}, $ARGV[0], @{$o->{CONFIG}}{qw(NAME VERSION)});
+ croak M41_usage_install_version_mismatch($mod_name, $mod_ver,
+ $ext_name, $ext_ver)
+ unless ($mod_ver eq $ext_ver);
+ $o->{INLINE}{INST_ARCHLIB} = $ARGV[1];
+
+ $o->{API}{version} = $o->{CONFIG}{VERSION};
+ $o->{API}{module} = $o->{CONFIG}{NAME};
+ my @modparts = split(/::/,$o->{API}{module});
+ $o->{API}{modfname} = $modparts[-1];
+ $o->{API}{modpname} = join('/', at modparts);
+ $o->{API}{suffix} = $o->{INLINE}{ILSM_suffix};
+ $o->{API}{build_dir} = ( $o->{INLINE}{DIRECTORY} . '/build/' .
+ $o->{API}{modpname}
+ );
+ $o->{API}{directory} = $o->{INLINE}{DIRECTORY};
+ my $cwd = Cwd::cwd();
+ $o->{API}{install_lib} = "$cwd/$o->{INLINE}{INST_ARCHLIB}";
+ $o->{API}{location} = "$o->{API}{install_lib}/auto/" .
+ "$o->{API}{modpname}/$o->{API}{modfname}.$o->{INLINE}{ILSM_suffix}";
+ unshift @::INC, $o->{API}{install_lib};
+ $o->{INLINE}{object_ready} = 0;
+}
+
+
+1;
diff --git a/Basic/Gen/Inline/Makefile.PL b/Basic/Gen/Inline/Makefile.PL
new file mode 100644
index 0000000..5ba9b5e
--- /dev/null
+++ b/Basic/Gen/Inline/Makefile.PL
@@ -0,0 +1,8 @@
+use strict;
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ NAME => 'Inline',
+ VERSION_FROM => 'Pdlpp.pm',
+ PREREQ_PM => {'Inline' => 0.43},
+ PM => { map {($_ => '$(INST_LIBDIR)/Inline/'.$_)} <*.pm> },
+);
diff --git a/Basic/Gen/Inline/Pdlpp.pm b/Basic/Gen/Inline/Pdlpp.pm
new file mode 100644
index 0000000..cd5db6a
--- /dev/null
+++ b/Basic/Gen/Inline/Pdlpp.pm
@@ -0,0 +1,779 @@
+package Inline::Pdlpp;
+
+use strict;
+require Inline;
+
+use Config;
+use Data::Dumper;
+use Carp;
+use Cwd qw(cwd abs_path);
+require PDL::Core::Dev;
+
+$Inline::Pdlpp::VERSION = '0.2';
+ at Inline::Pdlpp::ISA = qw(Inline);
+
+#==============================================================================
+# Register this module as an Inline language support module
+#==============================================================================
+sub register {
+ return {
+ language => 'Pdlpp',
+ aliases => ['pdlpp','PDLPP'],
+ type => 'compiled',
+ suffix => $Config{dlext},
+ };
+}
+
+#==============================================================================
+# Validate the Pdlpp config options
+#==============================================================================
+sub usage_validate {
+ my $key = shift;
+ return <<END;
+The value of config option '$key' must be a string or an array ref
+
+END
+}
+
+sub validate {
+ my $o = shift;
+
+ $o->{ILSM} ||= {};
+ $o->{ILSM}{XS} ||= {};
+ # having internal on shouldn't matter
+ $o->{ILSM}{INTERNAL} = 1 unless defined $o->{ILSM}{INTERNAL};
+ $o->{ILSM}{MAKEFILE} ||= {};
+ if (not $o->UNTAINT) {
+ my $w = abs_path(PDL::Core::Dev::whereami_any());
+ $o->{ILSM}{MAKEFILE}{INC} = "-I$w/Core";
+ }
+ $o->{ILSM}{AUTO_INCLUDE} ||= '';
+ $o->{ILSM}{PPFLAGS} ||= '';
+ while (@_) {
+ my ($key, $value) = (shift, shift);
+ if ($key eq 'MAKE' or
+ $key eq 'INTERNAL' or
+ $key eq 'BLESS' or
+ $key eq 'NOISY'
+ ) {
+ $o->{ILSM}{$key} = $value;
+ next;
+ }
+ if ($key eq 'CC' or
+ $key eq 'LD') {
+ $o->{ILSM}{MAKEFILE}{$key} = $value;
+ next;
+ }
+ if ($key eq 'LIBS') {
+ $o->add_list($o->{ILSM}{MAKEFILE}, $key, $value, []);
+ next;
+ }
+ if ($key eq 'INC' or
+ $key eq 'MYEXTLIB' or
+ $key eq 'OPTIMIZE' or
+ $key eq 'CCFLAGS' or
+ $key eq 'LDDLFLAGS') {
+ $o->add_string($o->{ILSM}{MAKEFILE}, $key, $value, '');
+ next;
+ }
+ if ($key eq 'TYPEMAPS') {
+ croak "TYPEMAPS file '$value' not found"
+ unless -f $value;
+ my ($path, $file) = ($value =~ m|^(.*)[/\\](.*)$|) ?
+ ($1, $2) : ('.', $value);
+ $value = abs_path($path) . '/' . $file;
+ $o->add_list($o->{ILSM}{MAKEFILE}, $key, $value, []);
+ next;
+ }
+ if ($key eq 'AUTO_INCLUDE' or
+ $key eq 'PPFLAGS') {
+ $o->add_text($o->{ILSM}, $key, $value, '');
+ next;
+ }
+ if ($key eq 'BOOT') {
+ $o->add_text($o->{ILSM}{XS}, $key, $value, '');
+ next;
+ }
+ my $class = ref $o; # handles subclasses correctly.
+ croak "'$key' is not a valid config option for $class\n";
+ }
+}
+
+sub add_list {
+ my $o = shift;
+ my ($ref, $key, $value, $default) = @_;
+ $value = [$value] unless ref $value eq 'ARRAY';
+ for (@$value) {
+ if (defined $_) {
+ push @{$ref->{$key}}, $_;
+ }
+ else {
+ $ref->{$key} = $default;
+ }
+ }
+}
+
+sub add_string {
+ my $o = shift;
+ my ($ref, $key, $value, $default) = @_;
+ $value = [$value] unless ref $value;
+ croak usage_validate($key) unless ref($value) eq 'ARRAY';
+ for (@$value) {
+ if (defined $_) {
+ $ref->{$key} .= ' ' . $_;
+ }
+ else {
+ $ref->{$key} = $default;
+ }
+ }
+}
+
+sub add_text {
+ my $o = shift;
+ my ($ref, $key, $value, $default) = @_;
+ $value = [$value] unless ref $value;
+ croak usage_validate($key) unless ref($value) eq 'ARRAY';
+ for (@$value) {
+ if (defined $_) {
+ chomp;
+ $ref->{$key} .= $_ . "\n";
+ }
+ else {
+ $ref->{$key} = $default;
+ }
+ }
+}
+
+#==============================================================================
+# Parse and compile C code
+#==============================================================================
+sub build {
+ my $o = shift;
+ # $o->parse; # no parsing in pdlpp
+ $o->get_maps; # get the typemaps
+ $o->write_PD;
+ # $o->write_Inline_headers; # shouldn't need this one either
+ $o->write_Makefile_PL;
+ $o->compile;
+}
+
+#==============================================================================
+# Return a small report about the C code..
+#==============================================================================
+sub info {
+ my $o = shift;
+
+# return <<END;
+#No information is currently generated when using inline pdlpp.
+#
+#END
+
+ my $txt = <<END;
+The following PP code was generated (caution, can be long)...
+
+*** start PP file ****
+
+END
+
+ return $txt . $o->pd_generate . "\n*** end PP file ****\n";
+}
+
+sub config {
+ my $o = shift;
+}
+
+#==============================================================================
+# Write the PDL::PP code into a PD file
+#==============================================================================
+sub write_PD {
+ my $o = shift;
+ my $modfname = $o->{API}{modfname};
+ my $module = $o->{API}{module};
+ $o->mkpath($o->{API}{build_dir});
+ open PD, "> $o->{API}{build_dir}/$modfname.pd"
+ or croak $!;
+ print PD $o->pd_generate;
+ close PD;
+}
+
+#==============================================================================
+# Generate the PDL::PP code (piece together a few snippets)
+#==============================================================================
+sub pd_generate {
+ my $o = shift;
+ return join "\n", ($o->pd_includes,
+ $o->pd_code,
+ $o->pd_boot,
+ $o->pd_bless,
+ $o->pd_done,
+ );
+}
+
+sub pd_includes {
+ my $o = shift;
+ return << "END";
+pp_addhdr << 'EOH';
+$o->{ILSM}{AUTO_INCLUDE}
+EOH
+
+END
+}
+
+sub pd_code {
+ my $o = shift;
+ return $o->{API}{code};
+}
+
+sub pd_boot {
+ my $o = shift;
+ if (defined $o->{ILSM}{XS}{BOOT} and
+ $o->{ILSM}{XS}{BOOT}) {
+ return <<END;
+pp_add_boot << 'EOB';
+$o->{ILSM}{XS}{BOOT}
+EOB
+
+END
+ }
+ return '';
+}
+
+
+sub pd_bless {
+ my $o = shift;
+ if (defined $o->{ILSM}{XS}{BLESS} and
+ $o->{ILSM}{XS}{BLESS}) {
+ return <<END;
+pp_bless $o->{ILSM}{XS}{BLESS};
+END
+ }
+ return '';
+}
+
+
+sub pd_done {
+ return <<END;
+pp_done();
+END
+}
+
+sub get_maps {
+ my $o = shift;
+
+ my $typemap = '';
+ $typemap = "$Config::Config{installprivlib}/ExtUtils/typemap"
+ if -f "$Config::Config{installprivlib}/ExtUtils/typemap";
+ $typemap = "$Config::Config{privlibexp}/ExtUtils/typemap"
+ if (not $typemap and -f "$Config::Config{privlibexp}/ExtUtils/typemap");
+ warn "Can't find the default system typemap file"
+ if (not $typemap and $^W);
+
+ unshift(@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}, $typemap) if $typemap;
+
+ if (not $o->UNTAINT) {
+ require FindBin;
+ if (-f "$FindBin::Bin/typemap") {
+ push @{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}, "$FindBin::Bin/typemap";
+ }
+ }
+
+ my $w = abs_path(PDL::Core::Dev::whereami_any());
+ push @{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}, "$w/Core/typemap.pdl";
+}
+
+#==============================================================================
+# Generate the Makefile.PL
+#==============================================================================
+sub write_Makefile_PL {
+ my $o = shift;
+ $o->{ILSM}{xsubppargs} = '';
+ for (@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}) {
+ $o->{ILSM}{xsubppargs} .= "-typemap $_ ";
+ }
+
+ my %options = (
+ VERSION => $o->{API}{version} || '0.00',
+ %{$o->{ILSM}{MAKEFILE}},
+ NAME => $o->{API}{module},
+ );
+
+ open MF, "> $o->{API}{build_dir}/Makefile.PL"
+ or croak;
+
+ print MF <<END;
+use ExtUtils::MakeMaker;
+my %options = %\{
+END
+
+ local $Data::Dumper::Terse = 1;
+ local $Data::Dumper::Indent = 1;
+ print MF Data::Dumper::Dumper(\ %options);
+
+ print MF <<END;
+\};
+WriteMakefile(\%options);
+
+# Remove the Makefile dependency. Causes problems on a few systems.
+sub MY::makefile { '' }
+END
+ close MF;
+}
+
+#==============================================================================
+# Run the build process.
+#==============================================================================
+sub compile {
+ my ($o, $perl, $make, $cmd, $cwd);
+ $o = shift;
+ $o->compile_pd; # generate the xs file
+ my ($module, $modpname, $modfname, $build_dir, $install_lib) =
+ @{$o->{API}}{qw(module modpname modfname build_dir install_lib)};
+
+ -f ($perl = $Config::Config{perlpath})
+ or croak "Can't locate your perl binary";
+ $make = $o->{ILSM}{MAKE} || $Config::Config{make}
+ or croak "Can't locate your make binary";
+ $cwd = &cwd;
+ ($cwd) = $cwd =~ /(.*)/ if $o->UNTAINT;
+ my $noisy = $o->{ILSM}{NOISY} || $o->{CONFIG}{BUILD_NOISY} ? '| tee' : '';
+ my $suffix1 = '> out.Makefile_PL 2>&1';
+ my $suffix2 = '> out.make 2>&1';
+ my $suffix3 = '> out.make_install 2>&1';
+
+ if($^O =~ /mswin/i && $noisy){
+ $noisy = ''; # no 'tee' on MS Windows.
+ ($suffix1, $suffix2, $suffix3) = ('', '', '');
+ }
+
+ for $cmd ("$perl Makefile.PL $noisy $suffix1",
+ \ &fix_make, # Fix Makefile problems
+ "$make $noisy $suffix2",
+ "$make pure_install $noisy $suffix3",
+ ) {
+ if (ref $cmd) {
+ $o->$cmd();
+ }
+ else {
+ ($cmd) = $cmd =~ /(.*)/ if $o->UNTAINT;
+ chdir $build_dir;
+ system($cmd) and do {
+# $o->error_copy;
+ chdir $cwd; # back to original dir
+ croak <<END;
+
+A problem was encountered while attempting to compile and install your Inline
+$o->{API}{language} code. The command that failed was:
+ $cmd
+
+The build directory was:
+$build_dir
+
+To debug the problem, cd to the build directory, and inspect the output files.
+
+END
+ };
+ chdir $cwd;
+ }
+ }
+
+ if ($o->{API}{cleanup}) {
+ $o->rmpath($o->{API}{directory} . '/build/', $modpname);
+ unlink "$install_lib/auto/$modpname/.packlist";
+ unlink "$install_lib/auto/$modpname/$modfname.bs";
+ unlink "$install_lib/auto/$modpname/$modfname.exp"; #MSWin32 VC++
+ unlink "$install_lib/auto/$modpname/$modfname.lib"; #MSWin32 VC++
+ }
+}
+
+# compile the pd file into xs using PDL::PP
+sub compile_pd {
+ my $o = shift;
+ my ($perl,$inc,$cwd);
+ my ($modfname,$module,$pkg,$bdir) =
+ @{$o->{API}}{qw(modfname module pkg build_dir)};
+
+ -f ($perl = $Config::Config{perlpath})
+ or croak "Can't locate your perl binary";
+
+ if ($o->{ILSM}{INTERNAL}) {
+ my $w = abs_path(PDL::Core::Dev::whereami_any());
+ $w =~ s%/((PDL)|(Basic))$%%; # remove the trailing subdir
+ $w .= '/blib/lib' unless $w =~ m|/blib/lib|;
+ $inc = "-I$w"; # make sure we find the PP stuff
+ } else { $inc = '' }
+
+ my $ppflags = $o->{ILSM}{PPFLAGS};
+ my $cmd = << "EOC";
+$perl $ppflags $inc "-MPDL::PP qw[$module NONE $modfname $pkg]" $modfname.pd > out.pdlpp 2>&1
+EOC
+ # print STDERR "executing\n\t$cmd...\n";
+ $cwd = &cwd;
+ chdir $bdir;
+ system($cmd) and do {
+ chdir $cwd; # back to original dir
+ croak <<END;
+
+A problem was encountered while attempting to compile and install your Inline
+$o->{API}{language} code. The command that failed was:
+ $cmd
+
+The build directory was:
+$bdir
+
+To debug the problem, cd to the build directory, and inspect the output files.
+
+END
+ };
+ chdir $cwd;
+}
+
+#==============================================================================
+# This routine fixes problems with the MakeMaker Makefile.
+#==============================================================================
+my %fixes = (
+ INSTALLSITEARCH => 'install_lib',
+ INSTALLDIRS => 'installdirs',
+ XSUBPPARGS => 'xsubppargs',
+ INSTALLSITELIB => 'install_lib',
+ );
+
+sub fix_make {
+ use strict;
+ my (@lines, $fix);
+ my $o = shift;
+
+ $o->{ILSM}{install_lib} = $o->{API}{install_lib};
+ $o->{ILSM}{installdirs} = 'site';
+
+ open(MAKEFILE, "< $o->{API}{build_dir}/Makefile")
+ or croak "Can't open Makefile for input: $!\n";
+ @lines = <MAKEFILE>;
+ close MAKEFILE;
+
+ open(MAKEFILE, "> $o->{API}{build_dir}/Makefile")
+ or croak "Can't open Makefile for output: $!\n";
+ for (@lines) {
+ if (/^(\w+)\s*=\s*\S+.*$/ and
+ $fix = $fixes{$1}
+ ) {
+ print MAKEFILE "$1 = $o->{ILSM}{$fix}\n"
+ }
+ else {
+ print MAKEFILE;
+ }
+ }
+ close MAKEFILE;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+ Inline::Pdlpp - Write PDL Subroutines inline with PDL::PP
+
+=head1 DESCRIPTION
+
+C<Inline::Pdlpp> is a module that allows you to write PDL subroutines
+in the PDL::PP style. The big benefit compared to plain C<PDL::PP> is
+that you can write these definitions inline in any old perl script
+(without the normal hassle of creating Makefiles, building, etc).
+Since version 0.30 the Inline module supports multiple programming
+languages and each language has its own support module. This document
+describes how to use Inline with PDL::PP (or rather, it will once
+these docs are complete C<;)>.
+
+For more information on Inline in general, see L<Inline>.
+
+Some example scripts demonstrating C<Inline::Pdlpp> usage can be
+found in the F<Example/InlinePdlpp> directory.
+
+
+C<Inline::Pdlpp> is mostly a shameless rip-off of C<Inline::C>.
+Most Kudos goes to Brian I.
+
+=head1 Usage
+
+You never actually use C<Inline::Pdlpp> directly. It is just a support module
+for using C<Inline.pm> with C<PDL::PP>. So the usage is always:
+
+ use Inline Pdlpp => ...;
+
+or
+
+ bind Inline Pdlpp => ...;
+
+=head1 Examples
+
+Pending availability of full docs a few quick examples
+that illustrate typical usage.
+
+=head2 A simple example
+
+ # example script inlpp.pl
+ use PDL; # must be called before (!) 'use Inline Pdlpp' calls
+
+ use Inline Pdlpp; # the actual code is in the __Pdlpp__ block below
+
+ $a = sequence 10;
+ print $a->inc,"\n";
+ print $a->inc->dummy(1,10)->tcumul,"\n";
+
+ __DATA__
+
+ __Pdlpp__
+
+ pp_def('inc',
+ Pars => 'i();[o] o()',
+ Code => '$o() = $i() + 1;',
+ );
+
+ pp_def('tcumul',
+ Pars => 'in(n);[o] mul()',
+ Code => '$mul() = 1;
+ loop(n) %{
+ $mul() *= $in();
+ %}',
+ );
+ # end example script
+
+If you call this script it should generate output similar to this:
+
+ prompt> perl inlpp.pl
+ Inline running PDL::PP version 2.2...
+ [1 2 3 4 5 6 7 8 9 10]
+ [3628800 3628800 3628800 3628800 3628800 3628800 3628800 3628800 3628800 3628800]
+
+Usage of C<Inline::Pdlpp> in general is similar to C<Inline::C>.
+In the absence of full docs for C<Inline::Pdlpp> you might want to compare
+L<Inline::C>.
+
+=head2 Code that uses external libraries, etc
+
+The script below is somewhat more complicated in that it uses code
+from an external library (here from Numerical Recipes). All the
+relevant information regarding include files, libraries and boot
+code is specified in a config call to C<Inline>. For more experienced
+Perl hackers it might be helpful to know that the format is
+similar to that used with L<ExtUtils::MakeMaker|ExtUtils::MakeMaker>. The
+keywords are largely equivalent to those used with C<Inline::C>. Please
+see below for further details on the usage of C<INC>,
+C<LIBS>, C<AUTO_INCLUDE> and C<BOOT>.
+
+ use PDL; # this must be called before (!) 'use Inline Pdlpp' calls
+
+ use Inline Pdlpp => Config =>
+ INC => "-I$ENV{HOME}/include",
+ LIBS => "-L$ENV{HOME}/lib -lnr -lm",
+ # code to be included in the generated XS
+ AUTO_INCLUDE => <<'EOINC',
+ #include <math.h>
+ #include "nr.h" /* for poidev */
+ #include "nrutil.h" /* for err_handler */
+
+ static void nr_barf(char *err_txt)
+ {
+ fprintf(stderr,"Now calling croak...\n");
+ croak("NR runtime error: %s",err_txt);
+ }
+ EOINC
+ # install our error handler when loading the Inline::Pdlpp code
+ BOOT => 'set_nr_err_handler(nr_barf);';
+
+ use Inline Pdlpp; # the actual code is in the __Pdlpp__ block below
+
+ $a = zeroes(10) + 30;;
+ print $a->poidev(5),"\n";
+
+ __DATA__
+
+ __Pdlpp__
+
+ pp_def('poidev',
+ Pars => 'xm(); [o] pd()',
+ GenericTypes => [L,F,D],
+ OtherPars => 'long idum',
+ Code => '$pd() = poidev((float) $xm(), &$COMP(idum));',
+ );
+
+
+=head1 Pdlpp Configuration Options
+
+For information on how to specify Inline configuration options, see
+L<Inline>. This section describes each of the configuration options
+available for Pdlpp. Most of the options correspond either to MakeMaker or
+XS options of the same name. See L<ExtUtils::MakeMaker> and L<perlxs>.
+
+=head2 AUTO_INCLUDE
+
+Specifies extra statements to automatically included. They will be
+added onto the defaults. A newline char will be automatically added.
+Does essentially the same as a call to C<pp_addhdr>. For short
+bits of code C<AUTO_INCLUDE> is probably syntactically nicer.
+
+ use Inline Pdlpp => Config => AUTO_INCLUDE => '#include "yourheader.h"';
+
+=head2 BLESS
+
+Same as C<pp_bless> command. Specifies the package (i.e. class)
+to which your new I<pp_def>ed methods will be added. Defaults
+to C<PDL> if omitted.
+
+ use Inline Pdlpp => Config => BLESS => 'PDL::Complex';
+
+=head2 BOOT
+
+Specifies C code to be executed in the XS BOOT section. Corresponds to
+the XS parameter. Does the same as the C<pp_add_boot> command. Often used
+to execute code only once at load time of the module, e.g. a library
+initialization call.
+
+=head2 CC
+
+Specify which compiler to use.
+
+=head2 CCFLAGS
+
+Specify extra compiler flags.
+
+=head2 INC
+
+Specifies an include path to use. Corresponds to the MakeMaker parameter.
+
+ use Inline Pdlpp => Config => INC => '-I/inc/path';
+
+=head2 LD
+
+Specify which linker to use.
+
+=head2 LDDLFLAGS
+
+Specify which linker flags to use.
+
+NOTE: These flags will completely override the existing flags, instead
+of just adding to them. So if you need to use those too, you must
+respecify them here.
+
+=head2 LIBS
+
+Specifies external libraries that should be linked into your
+code. Corresponds to the MakeMaker parameter.
+
+ use Inline Pdlpp => Config => LIBS => '-lyourlib';
+
+or
+
+ use Inline Pdlpp => Config => LIBS => '-L/your/path -lyourlib';
+
+=head2 MAKE
+
+Specify the name of the 'make' utility to use.
+
+=head2 MYEXTLIB
+
+Specifies a user compiled object that should be linked in. Corresponds
+to the MakeMaker parameter.
+
+ use Inline Pdlpp => Config => MYEXTLIB => '/your/path/yourmodule.so';
+
+=head2 OPTIMIZE
+
+This controls the MakeMaker OPTIMIZE setting. By setting this value to
+'-g', you can turn on debugging support for your Inline
+extensions. This will allow you to be able to set breakpoints in your
+C code using a debugger like gdb.
+
+=head2 TYPEMAPS
+
+Specifies extra typemap files to use. Corresponds to the MakeMaker parameter.
+
+ use Inline Pdlpp => Config => TYPEMAPS => '/your/path/typemap';
+
+=head2 NOISY
+
+Show the output of any compilations going on behind the scenes. Uses
+C<tee> which must be available on your computer. Default is off.
+
+=head1 BUGS
+
+=head2 C<do>ing inline scripts
+
+Beware that there is a problem when you use
+the __DATA__ keyword style of Inline definition and
+want to C<do> your script containing inlined code. For example
+
+ # myscript.pl contains inlined code
+ # in the __DATA__ section
+ perl -e 'do "myscript.pl";'
+ One or more DATA sections were not processed by Inline.
+
+According to Brian Ingerson (of Inline fame) the workaround is
+to include an C<Inline-E<gt>init> call in your script, e.g.
+
+ use PDL;
+ use Inline Pdlpp;
+ Inline->init;
+
+ # perl code
+
+ __DATA__
+ __Pdlpp__
+
+ # pp code
+
+=head2 C<PDL::NiceSlice> and C<Inline::Pdlpp>
+
+There is currently an undesired interaction between
+L<PDL::NiceSlice|PDL::NiceSlice> and C<Inline::Pdlpp>.
+Since PP code generally contains expressions
+of the type C<$var()> (to access piddles, etc)
+L<PDL::NiceSlice|PDL::NiceSlice> recognizes those incorrectly as
+slice expressions and does its substitutions. For the moment
+(until hopefully the parser can deal with that) it is best to
+explicitly switch L<PDL::NiceSlice|PDL::NiceSlice> off before
+the section of inlined Pdlpp code. For example:
+
+ use PDL::NiceSlice;
+ use Inline::Pdlpp;
+
+ $a = sequence 10;
+ $a(0:3)++;
+ $a->inc;
+
+ no PDL::NiceSlice;
+
+ __DATA__
+
+ __C__
+
+ ppdef (...); # your full pp definition here
+
+=head1 ACKNOWLEDGEMENTS
+
+Brian Ingerson for creating the Inline infrastructure.
+
+=head1 AUTHOR
+
+Christian Soeller <soellermail at excite.com>
+
+=head1 SEE ALSO
+
+L<PDL>
+
+L<PDL::PP>
+
+L<Inline>
+
+L<Inline::C>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2001. Christian Soeller. All rights reserved.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as PDL itself.
+
+See http://pdl.perl.org
+
+=cut
diff --git a/Basic/Gen/Makefile.PL b/Basic/Gen/Makefile.PL
new file mode 100644
index 0000000..bcdd7c1
--- /dev/null
+++ b/Basic/Gen/Makefile.PL
@@ -0,0 +1,82 @@
+BEGIN{if ($^O =~ /MSWin/) {
+ print "getting dosglob...\n";
+ require File::DosGlob;
+ File::DosGlob->import('glob');}
+}
+
+ at pms = map {($_ => '$(INST_LIBDIR)/'.$_)}
+ (<*.pm>, <PP/*.pm>, 'PP/Dump.pm');
+push @pms, ('pptemplate.pod' => '$(INST_LIBDIR)/pptemplate.pod')
+ if $] >= 5.006;
+
+use ExtUtils::MakeMaker;
+WriteMakefile(NAME => "PDL::PP",
+ PM => {@pms},
+ 'EXE_FILES' => ['pptemplate'],
+ clean => {FILES => "PP/Dump.pm PP/Dump.pm.tmp pptemplate pptemplate.pod"},
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
+sub MY::postamble {
+ my $text =
+'PP/Dump.pm: PP/dump.pp
+ $(PERL) PP/dump.pp > PP/Dump.pm.tmp
+'.($^O =~ /win32/i ? ' move PP\Dump.pm.tmp PP\Dump.pm' :
+' mv PP/Dump.pm.tmp PP/Dump.pm')."\n";
+
+ if ( $] >= 5.006 ) {
+ $text .= << "EOPS" ;
+
+pptemplate.pod: pptemplate
+\t\$(PERLRUN) -MPod::Select -e "podselect('pptemplate');" > pptemplate.pod
+
+EOPS
+
+ }
+ $text;
+}
+
+#EU::MM's processPL() is continually broken on Win32 ... hence:
+sub MY::processPL {
+ ## Fix appears to be necessary on all MM platforms now, to avoid circular references :-( -- CED 9-July-2008
+ if(1) { ## if($^O =~ /MSWin32/i && ($Config{make} =~ /\bdmake/i || $Config{make} =~ /\bnmake/i)) {
+ my($self) = shift;
+ return "" unless $self->{PL_FILES};
+ my(@m, $plfile);
+ foreach $plfile (sort keys %{$self->{PL_FILES}}) {
+ my $list = ref($self->{PL_FILES}->{$plfile})
+ ? $self->{PL_FILES}->{$plfile}
+ : [$self->{PL_FILES}->{$plfile}];
+ my $target;
+ if($Config{make} =~ /\bdmake/i) {
+ foreach $target (@$list) {
+ push @m, "
+all :: $target
+ \$(NOECHO) \$(NOOP)
+
+$target :
+ \$(PERLRUNINST) $plfile $target
+";
+ } # close foreach
+ }
+ else {
+ foreach $target (@$list) {
+ push @m, "
+all :: $target
+ \$(NOECHO) \$(NOOP)
+
+$target ::
+ \$(PERLRUNINST) $plfile $target
+";
+ } # close foreach
+ }
+ }
+ join "", @m;
+ }
+ else {
+ package MY;
+ my $self = shift;
+ return $self->SUPER::processPL;
+ }
+}
+
diff --git a/Basic/Gen/PP.pm b/Basic/Gen/PP.pm
new file mode 100644
index 0000000..ed00d1b
--- /dev/null
+++ b/Basic/Gen/PP.pm
@@ -0,0 +1,3590 @@
+#####################################################################
+#####################################################################
+##
+##
+## Here starts the actual thing.
+##
+## This is way too messy and uncommented. Still. :(
+#
+# DJB August 24 2006
+# begin cleaning up the code so that it all runs under use strict
+# DJB August 31 2006
+# moved to use objects for the rule table (ie defvar) in the
+# hope it's more declarative (since the addition of "::" to
+# a statement makes it so much-more meaningful :-)
+#
+
+# How to convert from the old deftbl format to the new, object-based,
+# system:
+#
+# What used to be, in $PDL::PP::deftbl
+# [["Name1"], ["Name2"], $ref_to_sub]]
+# is now
+# PDL::PP::Rule->new("Name1", "Name2", $ref_to_sub)
+# where Name1 represents the target of the rule, Name2 the condition,
+# and the subroutine reference is the routine called when the rule is
+# applied.
+#
+# If their is no condition, the argument can be left out of the call
+# (unless there is a doc string), so
+# [["Name1"], [], $ref_to_sub]]
+# becomes
+# PDL::PP::Rule->new("Name1", $ref_to_sub)
+#
+# The target and conditions can also be an array reference, so
+# [["Name1"], ["Name2","Name3"], $ref_to_sub]]
+# [["Name1","Name2"], ["Name3"], $ref_to_sub]]
+# [["Name1","Name2"], ["Name3","Name4"], $ref_to_sub]]
+# become, respectively
+# PDL::PP::Rule->new("Name1", ["Name2","Name3"], $ref_to_sub)
+# PDL::PP::Rule->new(["Name1","Name2"], "Name3", $ref_to_sub)
+# PDL::PP::Rule->new(["Name1","Name2"], ["Name3","Name4], $ref_to_sub)
+#
+# If the old rule had a document string, this is placed between
+# the condition and the subroutine reference. To make processing
+# simpler, if a doc string exists then the condition must also
+# be supplied, even if it is just [] (ie no condition).
+#
+# There are specialized rules for common situations. The rules for the
+# target, condition, and doc arguments hold from the base class (ie
+# whether scalar or array values are used, ...)
+#
+# Return a constant:
+#
+# PDL::PP::Rule::Returns->new($targets [,$conditions [,$doc]], $value)
+# is used to return a constant. So
+# [["Name1"], [], sub { "foo" }]
+# becomes
+# PDL::PP::Rule::Returns->new("Name1", "foo")
+#
+# This class is specialized since there are some common return values:
+# PDL::PP::Rule::Returns::Zero->new($targets [,$conditions [,$doc]])
+# PDL::PP::Rule::Returns::One->new($targets [,$conditions [,$doc]])
+# PDL::PP::Rule::Returns::EmptyString->new($targets [,$conditions [,$doc]])
+# PDL::PP::Rule::Returns::NULL->new($targets [,$conditions [,$doc]])
+# which return 0, 1, "", and "NULL" respectively
+#
+# The InsertName class exists to allow you to return something like
+# "foo<routine name>bar"
+# The old rules
+# [["Foo"], ["Name"], sub { return "_pdl_$_[0]_bar"; }]
+# [["Foo"], ["Name","Arg2"], sub { return "_pdl_$_[0]_bar"; }]
+# become
+# PDL::PP::Rule::InsertName->new("Foo", '_pdl_${name}_bar')
+# PDL::PP::Rule::InsertName->new("Foo", "Arg2", '_pdl_${name}_bar')
+# Note that the Name argument is automatically used as a condition, so
+# it does not need to be supplied, and the return value should be
+# given as a single-quoted string and use the $name variable
+#
+# The Substitute rule replaces dollar-signed macros ($P(), $ISBAD(), ect)
+# with the low-level C code to perform the macro.
+#
+# The Substitute class replaces the dosubst rule. The old rule
+# [["NewXSCoerceMustSubs"], ["NewXSCoerceMustSub1","NewXSSymTab","Name"],
+# \&dosubst]
+# becomes
+# PDL::PP::Rule::Substitute("NewXSCoerceMustSubs", "NewXSCoerceMustSub1")
+#
+# PDL::PP::Rule::Substitute->new($target,$condition)
+# $target and $condition must be scalars.
+#
+# Implicit conditions are NewXSSymTab and Name
+#
+# The Substitute:Usual class replaces the dousualsubsts rule. The old rule
+# [["CacheBadFlagInit"], ["CacheBadFlagInitNS","NewXSSymTab","Name"],
+# \&dousualsubsts],
+# becomes
+# PDL::PP::Rule::Substitute::Usual->new("CacheBadFlagInit", "CacheBadFlagInitNS")
+#
+# PDL::PP::Rule::Substitute::Usual->new($target, $condition)
+# $target and $condition must be scalars.
+#
+# Implicit conditions are NewXSSymTab and Name
+#
+# The MakeComp rule replaces the subst_makecomp routine. The old rule
+# [["MakeCompiledRepr"], ["MakeComp","CompNames","CompObjs"],
+# sub {subst_makecomp("COMP", at _)}]
+# becomes
+# PDL::PP::Rule::MakeComp->new("MakeCompiledRepr", ["MakeComp","CompNames","CompObjs"],
+# "COMP")
+# PDL::PP::Rule::MakeComp->new($target,$conditions,$symbol)
+# $target and $symbol must be scalars.
+#
+
+# Notes:
+# InsertName could become a subclass of Insert since there are
+# a few rules that just insert conditions into a text string.
+#
+# Substitute, Substitute::Usual, MakeComp classes feel a bit
+# ugly. See next point. Also the get_std_childparent method is
+# a bit of a hack.
+#
+# DJB thinks that the code fragments themselves could be objects
+# since they should 'know' what needs doing to them (eg the
+# substitutions). Not sure whether it would really clarify things.
+#
+# To do:
+# wrap_vfn could propbably be moved into a class.
+#
+# move the PDL::PP::Rule and subclasses into their own file?
+#
+
+package PDL::PP::Rule;
+
+use strict;
+
+use Carp;
+our @CARP_NOT;
+
+use overload ("\"\"" => \&PDL::PP::Rule::stringify);
+sub stringify {
+ my $self = shift;
+
+ my $str = ref $self;
+ if ("PDL::PP::Rule" eq $str) {
+ $str = "Rule";
+ } else {
+ $str =~ s/PDL::PP::Rule:://;
+ }
+ $str = "($str) ";
+ $str .= exists $self->{doc} ?
+ $self->{doc} : join(",", @{$self->{targets}});
+ return $str;
+}
+
+# Takes two args: the calling object and the message, but we only care
+# about the message:
+sub report ($$) { print $_[1] if $::PP_VERBOSE; }
+
+# Very limited error checking.
+# Allow scalars for targets and conditions to be optional
+#
+# At present you have to have a conditions argument if you supply
+# a doc string
+#
+# It seems strange to make the subroutine reference an optional
+# argument but this is being used to transition to a slightly-different
+# object design
+#
+sub new {
+ my $class = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ my $usage = "Usage: PDL::PP::Rule->new(\$targets[,\$conditions[,\$doc],] [,\$ref])\n";
+
+ # handle arguments
+ my $nargs = $#_;
+ die $usage if $nargs < 0 or $nargs > 3;
+
+ my $targets = shift;
+ $targets = [$targets] unless ref $targets eq "ARRAY";
+ $self->{targets} = $targets;
+
+ if ($#_ != -1) {
+ if (ref $_[-1] eq "CODE") {
+ $self->{ref} = pop;
+ }
+
+ my ($conditions,$doc) = @_;
+
+ if (defined $conditions) {
+ $conditions = [$conditions] unless ref $conditions eq "ARRAY";
+ } else {
+ $conditions = [];
+ }
+ $self->{conditions} = $conditions;
+ $self->{doc} = $doc if defined $doc;
+ }
+
+ return $self;
+}
+
+# $rule->check_if_targets_exist($pars);
+#
+# Returns 1 if any of the targets exist in $pars, 0 otherwise.
+# A return value of 1 means that the rule should not be applied.
+#
+# Not 100% happy with use of report here. Needs re-thinking.
+#
+sub check_if_targets_exist {
+ my $self = shift;
+ my $pars = shift;
+
+ my $targets = $self->{targets};
+
+ foreach my $target (@$targets) {
+ if (exists $pars->{$target}) {
+ $self->report("--skipping since TARGET $target exists\n");
+ return 1;
+ }
+ }
+ return 0;
+}
+
+# $rule->check_if_conditions_exist($pars);
+#
+# Returns 1 if all of the required conditions exist in $pars, 0 otherwise.
+# A return value of 0 means that the rule should not be applied.
+#
+# Not 100% happy with use of report here. Needs re-thinking.
+#
+sub check_if_conditions_exist {
+ my $self = shift;
+ my $pars = shift;
+
+ my $conditions = $self->{conditions};
+
+ foreach my $condition (@$conditions) {
+
+ # skip if not a required condition
+ next if substr($condition,0,1) eq "_";
+
+ unless (exists $pars->{$condition}) {
+ $self->report("--skipping since CONDITION $condition does not exist\n");
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+# $rule->is_valid($pars);
+#
+# Returns 1 if the rule should be applied (ie no targets already
+# exist in $pars and all the required conditions exist in $pars),
+# otherwise 0.
+#
+sub is_valid {
+ my $self = shift;
+ my $pars = shift;
+
+ return 0 if $self->check_if_targets_exist($pars);
+ return 0 unless $self->check_if_conditions_exist($pars);
+ return 1;
+}
+
+# my @args = $self->extract_args($pars);
+#
+# If this method is called we assume that
+# $self->check_if_conditions_exist($pars)
+# returns 1.
+#
+sub extract_args {
+ my $self = shift;
+ my $pars = shift;
+
+ my $conditions = $self->{conditions};
+
+ my @args;
+ foreach (@$conditions) {
+ # make a copy of each condition so that any changes to it are not
+ # also made to the original array!
+ my $condition = $_;
+ # Remove any possible underscores (which indicate optional conditions):
+ $condition =~ s/^_//;
+
+ # Note: This will *not* create $pars->{$condition} if it did not already
+ # exist:
+ push @args, $pars->{$condition};
+ }
+
+ return @args;
+}
+
+# Apply the rule using the supplied $pars hash reference.
+#
+sub apply {
+ my $self = shift;
+ my $pars = shift;
+
+ carp "Unable to apply rule $self as there is no subroutine reference!"
+ unless exists $self->{ref};
+
+ my $targets = $self->{targets};
+ my $conditions = $self->{conditions};
+ my $ref = $self->{ref};
+
+ $self->report("Applying: $self\n");
+
+ # Is the rule valid?
+ #
+ return unless $self->is_valid($pars);
+
+ # Create the argument array for the routine.
+ #
+ my @args = $self->extract_args($pars);
+
+ # Run this rule's subroutine:
+ my @retval = $self->{ref}(@args);
+
+ # Check for any inconsistencies:
+ confess "Internal error: rule '$self' returned " . (1+$#retval)
+ . " items and expected " . (1+$#$targets)
+ unless $#retval == $#$targets;
+
+ $self->report("--setting:");
+ foreach my $target (@$targets) {
+ $self->report(" $target");
+ confess "Cannot have multiple meanings for target $target!"
+ if exists $pars->{$target};
+ my $result = shift @retval;
+
+ # The following test suggests that things could/should be
+ # improved in the code generation.
+ #
+ if (defined $result and $result eq 'DO NOT SET!!') {
+ $self->report (" is 'DO NOT SET!!'");
+ } else {
+ $pars->{$target} = $result;
+ }
+ }
+ $self->report("\n");
+}
+
+
+package PDL::PP::Rule::Croak;
+
+# Croaks if all of the input variables are defined. Use this to identify
+# incompatible arguments.
+our @ISA = qw(PDL::PP::Rule);
+use Carp;
+our @CARP_NOT;
+
+
+sub new {
+ croak('Usage: PDL::PP::Ruel::Croak->new(["incompatible", "arguments"], "Croaking message")')
+ unless @_ == 3;
+
+ my $class = shift;
+ my $self = $class->SUPER::new([], @_);
+ return bless $self, $class;
+}
+
+sub apply {
+ my ($self, $pars) = @_;
+ croak($self->{doc}) if $self->is_valid($pars);
+}
+
+package PDL::PP::Rule::Returns;
+
+use strict;
+
+use Carp;
+our @CARP_NOT;
+
+##use PDL::PP::Rule;
+our @ISA = qw (PDL::PP::Rule);
+
+# This class does not treat return values of "DO NOT SET!!"
+# as special.
+#
+sub new {
+ my $class = shift;
+
+ my $value = pop;
+
+ my @args = @_;
+ my $self = $class->SUPER::new(@args);
+ bless $self, $class;
+ $self->{"returns.value"} = $value;
+
+ my $targets = $self->{targets};
+ croak "There can only be 1 target for a $self, not " . (1+$#$targets) . "!"
+ unless $#$targets == 0;
+
+ return $self;
+}
+
+sub apply {
+ my $self = shift;
+ my $pars = shift;
+
+ carp "Unable to apply rule $self as there is no return value!"
+ unless exists $self->{"returns.value"};
+
+ my $target = $self->{targets}->[0];
+
+ $self->report("Applying: $self\n");
+
+ # Is the rule valid?
+ #
+ return unless $self->is_valid($pars);
+
+ # Set the value
+ #
+ $self->report ("--setting: $target\n");
+ $pars->{$target} = $self->{"returns.value"};
+}
+
+package PDL::PP::Rule::Returns::Zero;
+
+use strict;
+
+##use PDL::PP::Rule::Returns;
+our @ISA = qw (PDL::PP::Rule::Returns);
+
+sub new {
+ my $class = shift;
+ my @args = @_;
+ my $self = $class->SUPER::new(@args,0);
+ bless $self, $class;
+ return $self;
+}
+
+package PDL::PP::Rule::Returns::One;
+
+use strict;
+
+##use PDL::PP::Rule::Returns;
+our @ISA = qw (PDL::PP::Rule::Returns);
+
+sub new {
+ my $class = shift;
+ my @args = @_;
+ my $self = $class->SUPER::new(@args,1);
+ bless $self, $class;
+ return $self;
+}
+
+package PDL::PP::Rule::Returns::EmptyString;
+
+use strict;
+
+##use PDL::PP::Rule::Returns;
+our @ISA = qw (PDL::PP::Rule::Returns);
+
+sub new {
+ my $class = shift;
+ my @args = @_;
+ my $self = $class->SUPER::new(@args,"");
+ bless $self, $class;
+ return $self;
+}
+
+package PDL::PP::Rule::Returns::NULL;
+
+use strict;
+
+##use PDL::PP::Rule::Returns;
+our @ISA = qw (PDL::PP::Rule::Returns);
+
+sub new {
+ my $class = shift;
+ my @args = @_;
+ my $self = $class->SUPER::new(@args,"NULL");
+ bless $self, $class;
+ return $self;
+}
+
+package PDL::PP::Rule::InsertName;
+
+use strict;
+
+use Carp;
+our @CARP_NOT;
+
+##use PDL::PP::Rule;
+our @ISA = qw (PDL::PP::Rule);
+
+# This class does not treat return values of "DO NOT SET!!"
+# as special.
+#
+sub new {
+ my $class = shift;
+
+ my $value = pop;
+
+ my @args = @_;
+ my $self = $class->SUPER::new(@args);
+ bless $self, $class;
+ $self->{"insertname.value"} = $value;
+
+ # Generate a defaul doc string
+ unless (exists $self->{doc}) {
+ $self->{doc} = 'Sets ' . $self->{targets}->[0]
+ . ' to "' . $value . '"';
+ }
+
+ my $targets = $self->{targets};
+ croak "There can only be 1 target for a $self, not " . (1+$#$targets) . "!"
+ unless $#$targets == 0;
+
+ # we add "Name" as the first condition
+ #
+ my $conditions = $self->{conditions};
+ unshift @$conditions, "Name";
+
+ return $self;
+}
+
+sub apply {
+ my $self = shift;
+ my $pars = shift;
+
+ carp "Unable to apply rule $self as there is no return value!"
+ unless exists $self->{"insertname.value"};
+
+ $self->report("Applying: $self\n");
+
+ # Is the rule valid?
+ #
+ return unless $self->is_valid($pars);
+
+ # Set the value
+ #
+ my $target = $self->{targets}->[0];
+ my $name = $pars->{Name};
+ $self->report ("--setting: $target (name=$name)\n");
+ $pars->{$target} = eval "return \"" . $self->{"insertname.value"} . "\";";
+}
+
+# Poor name. This is the old "dosubst" routine
+#
+# PDL::PP::Rule->new("NewXSCoerceMustSubs", ["NewXSCoerceMustSub1","NewXSSymTab","Name"],
+# \&dosubst),
+#
+# PDL::PP::Rule::Substitute->new($target,$condition)
+# $target and $condition must be scalars.
+#
+# Implicit conditions are NewXSSymTab and Name
+#
+package PDL::PP::Rule::Substitute;
+
+use strict;
+
+use Carp;
+our @CARP_NOT;
+
+##use PDL::PP::Rule;
+our @ISA = qw (PDL::PP::Rule);
+
+# Probably want this directly in the apply routine but leave as is for now
+#
+sub dosubst_private {
+ my ($src,$symtab,$name) = @_;
+ my $ret = (ref $src ? $src->[0] : $src);
+ my %syms = (
+ ((ref $src) ? %{$src->[1]} : ()),
+ PRIV => sub {return "".$symtab->get_symname('_PDL_ThisTrans').
+ "->$_[0]"},
+ CROAK => sub {return "PDL->pdl_barf(\"Error in $name:\" $_[0])"},
+ NAME => sub {return $name},
+ MODULE => sub {return $::PDLMOD},
+
+ SETPDLSTATEBAD => sub { return "$_[0]\->state |= PDL_BADVAL"; },
+ SETPDLSTATEGOOD => sub { return "$_[0]\->state &= ~PDL_BADVAL"; },
+ ISPDLSTATEBAD => sub { return "(($_[0]\->state & PDL_BADVAL) > 0)"; },
+ ISPDLSTATEGOOD => sub { return "(($_[0]\->state & PDL_BADVAL) == 0)"; },
+ BADFLAGCACHE => sub { return "badflag_cache"; },
+
+ SETREVERSIBLE => sub {
+ return "if($_[0]) \$PRIV(flags) |= PDL_ITRANS_REVERSIBLE;\n" .
+ " else \$PRIV(flags) &= ~PDL_ITRANS_REVERSIBLE;\n"
+ },
+ );
+ while(
+ $ret =~ s/\$(\w+)\(([^()]*)\)/
+ (defined $syms{$1} or
+ confess("$1 not defined in '$ret'!")) and
+ (&{$syms{$1}}($2))/ge
+ ) {};
+ $ret;
+}
+
+sub new {
+ my $class = shift;
+
+ die "Usage: PDL::PP::Rule::Substitute->new(\$target,\$condition);"
+ unless $#_ == 1;
+
+ my $target = shift;
+ my $condition = shift;
+
+ die "\$target must be a scalar for PDL::PP::Rule->Substitute" if ref $target;
+ die "\$condition must be a scalar for PDL::PP::Rule->Substitute" if ref $condition;
+
+ my $self = $class->SUPER::new($target, [$condition, "NewXSSymTab", "Name"],
+ \&dosubst_private);
+ bless $self, $class;
+
+ return $self;
+}
+
+# Poor name. This is the old "dousualsubsts" routine
+#
+# PDL::PP::Rule->new("CacheBadFlagInit", ["CacheBadFlagInitNS","NewXSSymTab","Name"],
+# \&dousualsubsts),
+#
+# PDL::PP::Rule::Substitute::Usual->new($target, $condition)
+# $target and $condition must be scalars.
+#
+# Implicit conditions are NewXSSymTab and Name
+#
+# Need to think about @std_childparent as it is also used by
+# other bits of code. At the moment provide a class method
+# to access the array but there has to be better ways of
+# doing this.
+#
+package PDL::PP::Rule::Substitute::Usual;
+
+use strict;
+
+use Carp;
+our @CARP_NOT;
+
+##use PDL::PP::Rule;
+our @ISA = qw (PDL::PP::Rule::Substitute);
+
+# This is a copy of the main one for now. Need a better solution.
+#
+my @std_childparent = (
+ CHILD => sub {return '$PRIV(pdls[1]->'.(join ',', at _).")"},
+ PARENT => sub {return '$PRIV(pdls[0]->'.(join ',', at _).")"},
+ CHILD_P => sub {return '$PRIV(pdls[1]->'.(join ',', at _).")"},
+ PARENT_P => sub {return '$PRIV(pdls[0]->'.(join ',', at _).")"},
+ CHILD_PTR => sub {return '$PRIV(pdls[1])'},
+ PARENT_PTR => sub {return '$PRIV(pdls[0])'},
+ COMP => sub {return '$PRIV('.(join ',', at _).")"}
+);
+
+sub get_std_childparent { return @std_childparent; }
+
+sub new {
+ my $class = shift;
+
+ my @args = @_;
+ my $self = $class->SUPER::new(@args);
+ bless $self, $class;
+
+ return $self;
+}
+
+# We modify the arguments from the conditions to include the
+# extra information
+#
+# We simplify the base-class version since we assume that all
+# conditions are required here.
+#
+sub extract_args {
+ my $self = shift;
+ my $pars = shift;
+
+ # The conditions are [<code>, NewXSSymTab, Name]
+ #
+ my $code = $pars->{$self->{conditions}[0]};
+ my $symtab = $pars->{$self->{conditions}[1]};
+ my $name = $pars->{$self->{conditions}[2]};
+
+ return ([$code,{@std_childparent}],$symtab,$name);
+}
+
+# Poor name. This is the old "subst_makecomp" routine
+#
+# PDL::PP::Rule->new("MakeCompiledRepr", ["MakeComp","CompNames","CompObjs"],
+# sub {subst_makecomp("COMP", at _)}),
+#
+# PDL::PP::Rule::MakeComp->new($target,$conditions,$symbol)
+# $target and $symbol must be scalars.
+#
+package PDL::PP::Rule::MakeComp;
+
+use strict;
+
+use Carp;
+our @CARP_NOT;
+
+##use PDL::PP::Rule;
+our @ISA = qw (PDL::PP::Rule);
+
+# This is a copy of the main one for now. Need a better solution.
+#
+my @std_redodims = (
+ SETNDIMS => sub {return "PDL->reallocdims(__it,$_[0])"},
+ SETDIMS => sub {return "PDL->setdims_careful(__it)"},
+ SETDELTATHREADIDS => sub {return '
+ {int __ind; PDL->reallocthreadids($CHILD_PTR(),
+ $PARENT(nthreadids));
+ for(__ind=0; __ind<$PARENT(nthreadids)+1; __ind++) {
+ $CHILD(threadids[__ind]) =
+ $PARENT(threadids[__ind]) + ('.$_[0].');
+ }
+ }
+ '});
+
+##sub get_std_redodims { return @std_redodims; }
+
+# Probably want this directly in the apply routine but leave as is for now
+#
+sub subst_makecomp_private {
+ my($which,$mc,$cn,$co) = @_;
+ return [$mc,{
+# @::std_childparent,
+ PDL::PP::Rule::Substitute::Usual::get_std_childparent(),
+ ($cn ?
+ (('DO'.$which.'DIMS') => sub {return join '',
+ map{$$co{$_}->need_malloc ?
+ $$co{$_}->get_malloc('$PRIV('.$_.')') :
+ ()} @$cn}) :
+ ()
+ ),
+ ($which eq "PRIV" ?
+ @std_redodims : ()),
+ },
+ ];
+}
+
+sub new {
+ my $class = shift;
+
+ die "Usage: PDL::PP::Rule::MakeComp->new(\$target,\$conditions,\$symbol);"
+ unless $#_ == 2;
+
+ my $target = shift;
+ my $condition = shift;
+ my $symbol = shift;
+
+ die "\$target must be a scalar for PDL::PP::Rule->MakeComp" if ref $target;
+ die "\$symbol must be a scalar for PDL::PP::Rule->MakeComp" if ref $symbol;
+
+ my $self = $class->SUPER::new($target, $condition,
+ \&subst_makecomp_private);
+ bless $self, $class;
+ $self->{"makecomp.value"} = $symbol;
+
+ return $self;
+}
+
+# We modify the arguments from the conditions to include the
+# extra information
+#
+# We simplify the base-class version since we assume that all
+# conditions are required here.
+#
+sub extract_args {
+ my $self = shift;
+ my $pars = shift;
+
+ # The conditions are [<symbol>, conditions...]
+ # - could use slicing here
+ #
+ my @args = ($self->{"makecomp.value"});
+ foreach my $condition (@{$self->{conditions}}) {
+ push @args, $pars->{$condition};
+ }
+ return @args;
+}
+
+package PDL::PP;
+
+use strict;
+
+our $VERSION = "2.2";
+$VERSION = eval $VERSION;
+
+use PDL::Types ':All';
+use Config;
+use FileHandle;
+use Exporter;
+
+use Data::Dumper;
+
+our @ISA = qw(Exporter);
+
+ at PDL::PP::EXPORT = qw/pp_addhdr pp_addpm pp_bless pp_def pp_done pp_add_boot
+ pp_add_exported pp_addxs pp_add_isa pp_export_nothing
+ pp_core_importList pp_beginwrap pp_setversion
+ pp_addbegin pp_boundscheck pp_line_numbers
+ pp_deprecate_module/;
+
+$PP::boundscheck = 1;
+$::PP_VERBOSE = 0;
+
+$PDL::PP::done = 0; # pp_done has not been called yet
+
+END {
+ pp_done() unless $PDL::PP::done; # make sure we call this
+}
+
+use Carp;
+our @CARP_NOT;
+
+# check for bad value support
+use PDL::Config;
+my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
+
+my $ntypes = $#PDL::Types::names;
+
+sub nopm { $::PDLPACK eq 'NONE' } # flag that we don't want to generate a PM
+
+sub import {
+ my ($mod,$modname, $packname, $prefix, $callpack) = @_;
+ # Allow for users to not specify the packname
+ ($packname, $prefix, $callpack) = ($modname, $packname, $prefix)
+ if ($packname =~ m|/|);
+
+ $::PDLMOD=$modname; $::PDLPACK=$packname; $::PDLPREF=$prefix;
+ $::CALLPACK = defined $callpack ? $callpack : $::PDLMOD;
+ $::PDLOBJ = "PDL"; # define pp-funcs in this package
+ $::PDLXS="";
+ $::PDLBEGIN="";
+ $::PDLPMROUT="";
+ for ('Top','Bot','Middle') { $::PDLPM{$_}="" }
+ @::PDLPMISA=('PDL::Exporter', 'DynaLoader');
+ @::PDL_IFBEGINWRAP = ('','');
+ $::PDLVERSIONSET = '';
+ $::PDLMODVERSION = undef;
+ $::DOCUMENTED = 0;
+ $::PDLCOREIMPORT = ""; #import list from core, defaults to everything, i.e. use Core
+ # could be set to () for importing nothing from core. or qw/ barf / for
+ # importing barf only.
+ @_=("PDL::PP");
+ goto &Exporter::import;
+}
+
+
+# query/set boundschecking
+# if on the generated XS code will have optional boundschecking
+# that can be turned on/off at runtime(!) using
+# __PACKAGE__::set_boundscheck(arg); # arg should be 0/1
+# if off code is speed optimized and no runtime boundschecking
+# can be performed
+# ON by default
+sub pp_boundscheck {
+ my $ret = $PP::boundscheck;
+ $PP::boundscheck = $_[0] if $#_ > -1;
+ return $ret;
+}
+
+sub pp_beginwrap {
+ @::PDL_IFBEGINWRAP = ('BEGIN {','}');
+}
+
+sub pp_setversion {
+ my ($ver) = @_;
+ $::PDLMODVERSION = '$VERSION';
+ $::PDLVERSIONSET = "\$$::PDLPACK\::VERSION = $ver;";
+}
+
+sub pp_addhdr {
+ my ($hdr) = @_;
+ $::PDLXSC .= $hdr;
+}
+
+sub pp_addpm {
+ my $pm = shift;
+ my $pos;
+ if (ref $pm) {
+ my $opt = $pm;
+ $pm = shift;
+ croak "unknown option" unless defined $opt->{At} &&
+ $opt->{At} =~ /^(Top|Bot|Middle)$/;
+ $pos = $opt->{At};
+ } else {
+ $pos = 'Middle';
+ }
+ $::PDLPM{$pos} .= "$pm\n\n";
+}
+
+sub pp_add_exported {
+ # my ($this,$exp) = @_;
+ my $exp = join ' ', @_; # get rid of this silly $this argument
+ $::PDLPMROUT .= $exp." ";
+}
+
+sub pp_addbegin {
+ my ($cmd) = @_;
+ if ($cmd =~ /^\s*BOOT\s*$/) {
+ pp_beginwrap;
+ } else {
+ $::PDLBEGIN .= $cmd."\n";
+ }
+}
+
+# Sub to call to export nothing (i.e. for building OO package/object)
+sub pp_export_nothing {
+ $::PDLPMROUT = ' ';
+}
+
+sub pp_add_isa {
+ push @::PDLPMISA, at _;
+}
+
+sub pp_add_boot {
+ my ($boot) = @_;
+ $::PDLXSBOOT .= $boot." ";
+}
+
+sub pp_bless{
+ my($new_package)=@_;
+ $::PDLOBJ = $new_package;
+}
+
+# sub to call to set the import list from core on the 'Use Core' line in the .pm file.
+# set to '()' to not import anything from Core, or 'qw/ barf /' to import barf.
+sub pp_core_importList{
+ $::PDLCOREIMPORT = $_[0];
+}
+
+sub printxs {
+ shift;
+ $::PDLXS .= join'', at _;
+}
+
+sub pp_addxs {
+ PDL::PP->printxs("\nMODULE = $::PDLMOD PACKAGE = $::CALLPACK\n\n",
+ @_,
+ "\nMODULE = $::PDLMOD PACKAGE = $::PDLOBJ\n\n");
+}
+
+# inserts #line directives into source text. Use like this:
+# ...
+# FirstKey => ...,
+# Code => pp_line_numbers (__LINE__, $a . $b . $c),
+# OtherKey => ...
+
+sub pp_line_numbers ($$) {
+ my ($line, $string) = @_;
+ # The line needs to be incremented by one for the bookkeeping to work
+ $line++;
+ # Get the source filename using caller()
+ my (undef, $filename) = caller;
+ # Escape backslashes:
+ $filename =~ s/\\/\\\\/g;
+ my @to_return = "#line $line \"$filename\"";
+
+ # Look for threadloops and loops and add # line directives
+ foreach (split (/(\n)/, $string)) {
+ # Always add the current line.
+ push @to_return, $_;
+
+ # If we need to add a # line directive, do so before incrementing
+ push (@to_return, "\n#line $line \"$filename\"") if (/%\{/ or /%}/);
+
+ $line++ if /\n/;
+ }
+
+ return join('', @to_return);
+}
+
+sub printxsc {
+ shift;
+ $::PDLXSC .= join '', at _;
+}
+
+sub pp_done {
+ return if $PDL::PP::done; # do only once!
+ $PDL::PP::done = 1;
+ $::FUNCSPOD = $::DOCUMENTED ? "\n\n=head1 FUNCTIONS\n\n\n\n=cut\n\n\n"
+ : '';
+ print "DONE!\n" if $::PP_VERBOSE;
+ print "Inline running PDL::PP version $PDL::PP::VERSION...\n" if nopm();
+ (my $fh = FileHandle->new(">$::PDLPREF.xs")) or die "Couldn't open xs file\n";
+
+$fh->print(qq%
+/*
+ * THIS FILE WAS GENERATED BY PDL::PP! Do not modify!
+ */
+
+#define PDL_COMMENT(comment)
+PDL_COMMENT("This preprocessor symbol is used to add commentary in the PDL ")
+PDL_COMMENT("autogenerated code. Normally, one would use typical C-style ")
+PDL_COMMENT("multiline comments (i.e. /* comment */). However, because such ")
+PDL_COMMENT("comments do not nest, it's not possible for PDL::PP users to ")
+PDL_COMMENT("comment-out sections of code using multiline comments, as is ")
+PDL_COMMENT("often the practice when debugging, for example. So, when you ")
+PDL_COMMENT("see something like this: ")
+PDL_COMMENT(" ")
+ PDL_COMMENT("Memory access")
+PDL_COMMENT(" ")
+PDL_COMMENT("just think of it as a C multiline comment like: ")
+PDL_COMMENT(" ")
+PDL_COMMENT(" /* Memory access */ ")
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "pdl.h"
+#include "pdlcore.h"
+static Core* PDL; PDL_COMMENT("Structure hold core C functions")
+static int __pdl_debugging = 0;
+static int __pdl_boundscheck = 0;
+static SV* CoreSV; PDL_COMMENT("Gets pointer to perl var holding core structure")
+
+#if ! $PP::boundscheck
+# define PP_INDTERM(max, at) at
+#else
+# define PP_INDTERM(max, at) (__pdl_boundscheck? PDL->safe_indterm(max,at, __FILE__, __LINE__) : at)
+#endif
+
+$::PDLXSC
+
+MODULE = $::PDLMOD PACKAGE = $::PDLMOD
+
+PROTOTYPES: ENABLE
+
+int
+set_debugging(i)
+ int i;
+ CODE:
+ RETVAL = __pdl_debugging;
+ __pdl_debugging = i;
+ OUTPUT:
+ RETVAL
+
+int
+set_boundscheck(i)
+ int i;
+ CODE:
+ if (! $PP::boundscheck)
+ warn("Bounds checking is disabled for $::PDLMOD");
+ RETVAL = __pdl_boundscheck;
+ __pdl_boundscheck = i;
+ OUTPUT:
+ RETVAL
+
+
+MODULE = $::PDLMOD PACKAGE = $::PDLOBJ
+
+$::PDLXS
+
+BOOT:
+
+ PDL_COMMENT("Get pointer to structure of core shared C routines")
+ PDL_COMMENT("make sure PDL::Core is loaded")
+ perl_require_pv("PDL::Core");
+ CoreSV = perl_get_sv("PDL::SHARE",FALSE); PDL_COMMENT("SV* value")
+#ifndef aTHX_
+#define aTHX_
+#endif
+ if (CoreSV==NULL)
+ Perl_croak(aTHX_ "Can't load PDL::Core module");
+ PDL = INT2PTR(Core*, SvIV( CoreSV )); PDL_COMMENT("Core* value")
+ if (PDL->Version != PDL_CORE_VERSION)
+ Perl_croak(aTHX_ "[PDL->Version: \%d PDL_CORE_VERSION: \%d XS_VERSION: \%s] $::PDLMOD needs to be recompiled against the newly installed PDL", PDL->Version, PDL_CORE_VERSION, XS_VERSION);
+ $::PDLXSBOOT
+%);
+
+unless (nopm) {
+ $::PDLPMISA = "'".join("','",@::PDLPMISA)."'";
+ $::PDLBEGIN = "BEGIN {\n$::PDLBEGIN\n}"
+ unless $::PDLBEGIN =~ /^\s*$/;
+ ($fh = FileHandle->new(">$::PDLPREF.pm")) or die "Couldn't open pm file\n";
+
+ $fh->print(qq%
+#
+# GENERATED WITH PDL::PP! Don't modify!
+#
+package $::PDLPACK;
+
+\@EXPORT_OK = qw( $::PDLPMROUT);
+\%EXPORT_TAGS = (Func=>[\@EXPORT_OK]);
+
+use PDL::Core$::PDLCOREIMPORT;
+use PDL::Exporter;
+use DynaLoader;
+
+
+$::PDL_IFBEGINWRAP[0]
+ $::PDLVERSIONSET
+ \@ISA = ( $::PDLPMISA );
+ push \@PDL::Core::PP, __PACKAGE__;
+ bootstrap $::PDLMOD $::PDLMODVERSION;
+$::PDL_IFBEGINWRAP[-1]
+
+$::PDLBEGIN
+
+$::PDLPM{Top}
+
+$::FUNCSPOD
+
+$::PDLPM{Middle};
+
+$::PDLPM{Bot}
+
+# Exit with OK status
+
+1;
+
+ %); # end of print
+ } # unless (nopm) {...
+} # end pp_done
+
+sub pp_def {
+ my($name,%obj) = @_;
+
+ print "*** Entering pp_def for $name\n" if $::PP_VERBOSE;
+
+ # See if the 'name' is multiline, in which case we extract the
+ # name and add the FullDoc field
+ if ($name =~ /\n/) {
+ my $fulldoc = $name;
+ # See if the very first thing is a word. That is going to be the
+ # name of the function under consideration
+ if ($fulldoc =~ s/^(\w+)//) {
+ $name = $1;
+ }
+ elsif ($fulldoc =~ /=head2 (\w+)/) {
+ $name = $1;
+ }
+ else {
+ croak('Unable to extract name');
+ }
+ $obj{FullDoc} = $fulldoc;
+ }
+
+ $obj{Name} = $name;
+ translate(\%obj,$PDL::PP::deftbl);
+
+ print "Output of translate for $name:\n" . Dumper(\%obj) . "\n"
+ if exists $obj{Dump} and $obj{Dump} and $::PP_VERBOSE;
+
+ croak("ERROR: No FreeFunc for pp_def=$name!\n")
+ unless exists $obj{FreeFunc}; # and $obj{FreeFunc};
+
+ PDL::PP->printxsc(join "\n\n", at obj{'StructDecl','RedoDimsFunc',
+ 'CopyFunc',
+ 'ReadDataFunc','WriteBackDataFunc',
+ 'FreeFunc',
+ 'FooFunc',
+ 'VTableDef','NewXSInPrelude',
+ }
+ );
+ PDL::PP->printxs($obj{NewXSCode});
+ pp_add_boot($obj{XSBootCode} . $obj{BootSetNewXS});
+ PDL::PP->pp_add_exported($name);
+ PDL::PP::pp_addpm("\n".$obj{PdlDoc}."\n") if $obj{PdlDoc};
+ PDL::PP::pp_addpm($obj{PMCode});
+ PDL::PP::pp_addpm($obj{PMFunc}."\n");
+
+ print "*** Leaving pp_def for $name\n" if $::PP_VERBOSE;
+}
+
+# marks this module as deprecated. This handles the user warnings, and adds a
+# notice into the documentation. Can take a {infavor => "newmodule"} option
+sub pp_deprecate_module
+{
+ my $options;
+ if( ref $_[0] eq 'HASH' ) { $options = shift; }
+ else { $options = { @_ }; }
+
+ my $infavor;
+
+ if( $options && ref $options eq 'HASH' && $options->{infavor} )
+ {
+ $infavor = $options->{infavor};
+ }
+
+ my $mod = $::PDLMOD;
+ my $envvar = 'PDL_SUPPRESS_DEPRECATION_WARNING__' . uc $mod;
+ $envvar =~ s/::/_/g;
+
+ my $warning_main =
+ "$mod is deprecated.";
+ $warning_main .=
+ " Please use $infavor instead." if $infavor;
+
+ my $warning_suppression_runtime =
+ "This module will be removed in the future; please update your code.\n" .
+ "Set the environment variable $envvar\n" .
+ "to suppress this warning\n";
+
+ my $warning_suppression_pod =
+ "A warning will be generated at runtime upon a C<use> of this module\n" .
+ "This warning can be suppressed by setting the $envvar\n" .
+ "environment variable\n";
+
+ my $deprecation_notice = <<EOF ;
+XXX=head1 DEPRECATION NOTICE
+
+$warning_main
+$warning_suppression_pod
+
+XXX=cut
+
+EOF
+ $deprecation_notice =~ s/^XXX=/=/gms;
+ pp_addpm( {At => 'Top'}, $deprecation_notice );
+
+ pp_addpm {At => 'Top'}, <<EOF;
+warn \"$warning_main\n$warning_suppression_runtime\" unless \$ENV{$envvar};
+EOF
+
+
+}
+
+# Worst memleaks: not freeing things at redodims or
+# final free time (thread, dimmed things).
+
+use Carp;
+$SIG{__DIE__} = sub {print Carp::longmess(@_); die;}
+ if $::PP_VERBOSE; # seems to give us trouble with 5.6.1
+
+use PDL::PP::Signature;
+use PDL::PP::Dims;
+use PDL::PP::CType;
+use PDL::PP::XS;
+use PDL::PP::SymTab;
+use PDL::PP::PDLCode;
+
+$|=1;
+
+#
+# This is ripped from xsubpp to ease the parsing of the typemap.
+#
+our $proto_re = "[" . quotemeta('\$%&*@;[]') . "]" ;
+
+sub ValidProtoString ($)
+{
+ my($string) = @_ ;
+
+ if ( $string =~ /^$proto_re+$/ ) {
+ return $string ;
+ }
+
+ return 0 ;
+}
+
+sub C_string ($)
+{
+ my($string) = @_ ;
+
+ $string =~ s[\\][\\\\]g ;
+ $string ;
+}
+
+sub TrimWhitespace
+{
+ $_[0] =~ s/^\s+|\s+$//go ;
+}
+sub TidyType
+{
+ local ($_) = @_ ;
+
+ # rationalise any '*' by joining them into bunches and removing whitespace
+ s#\s*(\*+)\s*#$1#g;
+ s#(\*+)# $1 #g ;
+
+ # change multiple whitespace into a single space
+ s/\s+/ /g ;
+
+ # trim leading & trailing whitespace
+ TrimWhitespace($_) ;
+
+ $_ ;
+}
+
+
+
+#------------------------------------------------------------------------------
+# Typemap handling in PP.
+#
+# This subroutine does limited input typemap conversion.
+# Given a variable name (to set), its type, and the source
+# for the variable, returns the correct input typemap entry.
+# Original version: D. Hunt 4/13/00 - Current version J. Brinchmann (06/05/05)
+#
+# This is an extended typemap handler from the one earlier written by
+# Doug Hunt. It should work exactly as the older version, but with extensions.
+# Instead of handling a few special cases explicitly we now use Perl's
+# built-in typemap handling using code taken straight from xsubpp.
+#
+# I have infact kept the old part of the code here because I belive any
+# subsequent hackers might find it very helpful to refer to this code to
+# understand what the following does. So here goes:
+#
+# ------------ OLD TYPEMAP PARSING: ------------------------
+#
+# # Note that I now just look at the basetype. I don't
+# # test whether it is a pointer to the base type or not.
+# # This is done because it is simpler and I know that the otherpars
+# # belong to a restricted set of types. I know a char will really
+# # be a char *, for example. I also know that an SV will be an SV *.
+# # yes, but how about catching syntax errors in OtherPars (CS)?
+# # shouldn't we really parse the perl typemap (we can steal the code
+# # from xsubpp)?
+#
+# my $OLD_PARSING=0;
+# if ($OLD_PARSING) {
+# my %typemap = (char => "(char *)SvPV($arg,PL_na)",
+# short => "(short)SvIV($arg)",
+# int => "(int)SvIV($arg)",
+# long => "(long)SvIV($arg)",
+# double => "(double)SvNV($arg)",
+# float => "(float)SvNV($arg)",
+# SV => "$arg",
+# );
+# my $basetype = $type->{Base};
+# $basetype =~ s/\s+//g; # get rid of whitespace
+#
+# die "Cannot find $basetype in my (small) typemap" unless exists($typemap{$basetype});
+# return ($typemap{$basetype});
+# }
+#
+#--------- END OF THE OLD CODE ---------------
+#
+# The code loads the typemap from the Perl typemap using the loading logic of
+# xsubpp. Do note that I made the assumption that
+# $Config{}installprivlib}/ExtUtils was the right root directory for the search.
+# This could break on some systems?
+#
+# Also I do _not_ parse the Typemap argument from ExtUtils::MakeMaker because I don't
+# know how to catch it here! This would be good to fix! It does look for a file
+# called typemap in the current directory however.
+#
+# The parsing of the typemap is mechanical and taken straight from xsubpp and
+# the resulting hash lookup is then used to convert the input type to the
+# necessary outputs (as seen in the old code above)
+#
+# JB 06/05/05
+#
+sub typemap {
+ my $oname = shift;
+ my $type = shift;
+ my $arg = shift;
+
+ #
+ # Modification to parse Perl's typemap here.
+ #
+ # The default search path for the typemap taken from xsubpp. It seems it is
+ # necessary to prepend the installprivlib/ExtUtils directory to find the typemap.
+ # It is not clear to me how this is to be done.
+ #
+ my ($typemap, $mode, $junk, $current, %input_expr,
+ %proto_letter, %output_expr, %type_kind);
+
+ # according to MM_Unix 'privlibexp' is the right directory
+ # seems to work even on OS X (where installprivlib breaks things)
+ # if this does not work portably we should split out the typemap finding code
+ # and make it as complex as necessary + save the typemap location
+ # in the PDL::Config hash
+ my $_rootdir = $Config{privlibexp}.'/ExtUtils/';
+# print "_rootdir set to '$_rootdir'\n";
+
+ # First the system typemaps..
+ my @tm = ($_rootdir.'../../../../lib/ExtUtils/typemap',
+ $_rootdir.'../../../lib/ExtUtils/typemap',
+ $_rootdir.'../../lib/ExtUtils/typemap',
+ $_rootdir.'../../../typemap',
+ $_rootdir.'../../typemap', $_rootdir.'../typemap',
+ $_rootdir.'typemap');
+ # Finally tag onto the end, the current directory typemap. Ideally we should here pick
+ # up the TYPEMAPS flag from ExtUtils::MakeMaker, but a) I don't know how and b)
+ # it is only a slight inconvenience hopefully!
+ #
+ # Note that the OUTPUT typemap is unlikely to be of use here, but I have kept
+ # the source code from xsubpp for tidiness.
+ push @tm, 'typemap';
+ my $foundtm = 0;
+ foreach $typemap (@tm) {
+ next unless -f $typemap ;
+ # skip directories, binary files etc.
+ warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
+ unless -T $typemap ;
+ $foundtm = 1;
+ open(TYPEMAP, $typemap)
+ or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
+ $mode = 'Typemap';
+ $junk = "" ;
+ $current = \$junk;
+ while (<TYPEMAP>) {
+ next if /^\s*#/;
+ my $line_no = $. + 1;
+ if (/^INPUT\s*$/) { $mode = 'Input'; $current = \$junk; next; }
+ if (/^OUTPUT\s*$/) { $mode = 'Output'; $current = \$junk; next; }
+ if (/^TYPEMAP\s*$/) { $mode = 'Typemap'; $current = \$junk; next; }
+ if ($mode eq 'Typemap') {
+ chomp;
+ my $line = $_ ;
+ TrimWhitespace($_) ;
+ # skip blank lines and comment lines
+ next if /^$/ or /^#/ ;
+ my($t_type,$kind, $proto) = /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or
+ warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
+ $t_type = TidyType($t_type) ;
+ $type_kind{$t_type} = $kind ;
+ # prototype defaults to '$'
+ $proto = "\$" unless $proto ;
+ warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n")
+ unless ValidProtoString($proto) ;
+ $proto_letter{$t_type} = C_string($proto) ;
+ }
+ elsif (/^\s/) {
+ $$current .= $_;
+ }
+ elsif ($mode eq 'Input') {
+ s/\s+$//;
+ $input_expr{$_} = '';
+ $current = \$input_expr{$_};
+ }
+ else {
+ s/\s+$//;
+ $output_expr{$_} = '';
+ $current = \$output_expr{$_};
+ }
+ }
+ close(TYPEMAP);
+ }
+ carp "**CRITICAL** PP found no typemap in $_rootdir/typemap; this will cause problems..."
+ unless $foundtm;
+
+ #
+ # Do checks...
+ #
+ # First reconstruct the type declaration to look up in type_kind
+ my $full_type=TidyType($type->get_decl('')); # Skip the variable name
+ die "The type =$full_type= does not have a typemap entry!\n" unless exists($type_kind{$full_type});
+ my $typemap_kind = $type_kind{$full_type};
+ # Look up the conversion from the INPUT typemap. Note that we need to do some
+ # massaging of this.
+ my $input = $input_expr{$typemap_kind};
+ # Remove all before =:
+ $input =~ s/^(.*?)=\s*//; # This should not be very expensive
+ # Replace $arg with $arg
+ $input =~ s/\$arg/$arg/;
+ # And type with $full_type
+ $input =~ s/\$type/$full_type/;
+
+ return ($input);
+}
+
+
+sub identity2priv {
+ return '
+ int i;
+ $SETNDIMS($PARENT(ndims));
+ for(i=0; i<$CHILD(ndims); i++) {
+ $CHILD(dims[i]) = $PARENT(dims[i]);
+ }
+ $SETDIMS();
+ $SETDELTATHREADIDS(0);
+ ';
+}
+
+sub pdimexpr2priv {
+ my($pdimexpr,$hdr,$dimcheck) = @_;
+ $pdimexpr =~ s/\$CDIM\b/i/g;
+ return '
+ int i,cor;
+ '.$dimcheck.'
+ $SETNDIMS($PARENT(ndims));
+ $DOPRIVDIMS();
+ $PRIV(offs) = 0;
+ for(i=0; i<$CHILD(ndims); i++) {
+ cor = '.$pdimexpr.';
+ $CHILD(dims[i]) = $PARENT(dims[cor]);
+ $PRIV(incs[i]) = $PARENT(dimincs[cor]);
+
+ }
+ $SETDIMS();
+ $SETDELTATHREADIDS(0);
+ ';
+}
+
+# something to do with copying values between parent and children
+#
+# we can NOT assume that PARENT and CHILD have the same type,
+# hence the version for bad code
+#
+# NOTE: we use the same code for 'good' and 'bad' cases - it's
+# just that when we use it for 'bad' data, we have to change the
+# definition of the EQUIVCPOFFS macro - see the Code rule
+#
+sub equivcpoffscode {
+ return
+ 'PDL_Indx i;
+ for(i=0; i<$CHILD_P(nvals); i++) {
+ $EQUIVCPOFFS(i,i);
+ }';
+
+} # sub: equivcpoffscode()
+
+# Pars -> ParNames, Parobjs
+#
+# XXX
+# - the need for BadFlag is due to hacked get_xsdatapdecl()
+# in PP/PdlParObj and because the PdlParObjs are created by
+# PDL::PP::Signature (Doug Burke 07/08/00)
+sub Pars_nft {
+ my($str,$badflag) = @_;
+ my $sig = PDL::PP::Signature->new($str,$badflag);
+ return ($sig->names,$sig->objs,1);
+}
+
+# ParNames,Parobjs -> DimObjs
+sub ParObjs_DimObjs {
+ my($pnames,$pobjs) = @_;
+ my ($dimobjs) = PDL::PP::PdlDimsObj->new();
+ for(@$pnames) {
+ $pobjs->{$_}->add_inds($dimobjs);
+ }
+ return ($dimobjs);
+}
+
+# Eliminate whitespace entries
+sub nospacesplit {map {/^\s*$/?():$_} split $_[0],$_[1]}
+
+sub OtherPars_nft {
+ my($otherpars,$dimobjs) = @_;
+ my(@names,%types,$type);
+ # support 'int ndim => n;' syntax
+ for (nospacesplit ';',$otherpars) {
+ if (/^\s*([^=]+)\s*=>\s*(\S+)\s*$/) {
+ my ($ctype,$dim) = ($1,$2);
+ $ctype =~ s/(\S+)\s+$/$1/; # get rid of trailing ws
+ print "OtherPars: setting dim '$dim' from '$ctype'\n" if $::PP_VERBOSE;
+ $type = C::Type->new(undef,$ctype);
+ croak "can't set unknown dimension"
+ unless defined($dimobjs->{$dim});
+ $dimobjs->{$dim}->set_from($type);
+ } elsif(/^\s*pdl\s+\*\s*(\w+)$/) {
+ # It is a piddle -> make it a controlling one.
+ die("Not supported yet");
+ } else {
+ $type = C::Type->new(undef,$_);
+ }
+ my $name = $type->protoname;
+ push @names,$name;
+ $types{$name} = $type;
+ }
+ return (\@names,\%types);
+}
+
+sub NXArgs {
+ my($parnames,$parobjs,$onames,$oobjs) = @_;
+ my $pdltype = C::Type->new(undef,"pdl *__foo__");
+ my $nxargs = [
+ ( map {[$_,$pdltype]} @$parnames ),
+ ( map {[$_,$oobjs->{$_}]} @$onames )
+ ];
+ return $nxargs;
+}
+
+# XXX
+# - the need for BadFlag is due to hacked get_xsdatapdecl()
+# in PP/PdlParObj and because the PdlParObjs are created by
+# PDL::PP::Signature (Doug Burke 07/08/00)
+sub NewParentChildPars {
+ my($p2child,$name,$badflag) = @_;
+ return (Pars_nft("PARENT(); [oca]CHILD();",$badflag),0,"${name}_NN");
+}
+
+# XXX
+# - the need for BadFlag is due to hacked get_xsdatapdecl()
+# in PP/PdlParObj and because the PdlParObjs are created by
+# PDL::PP::Signature (Doug Burke 07/08/00)
+#
+# however, it looks like this isn't being used anymore,
+# so commenting out.
+#
+#sub ParentChildPars {
+# my($p2child,$name,$badflag) = @_;
+# return (Pars_nft("PARENT(); [oca]CHILD();",$badflag),0,"${name}_XX",
+# "
+# *$name = \\&PDL::$name;
+# sub PDL::$name {
+# my \$this = shift;
+# my \$foo=\$this->null;
+# PDL::${name}_XX(\$this,\$foo,\@_);
+# \$foo
+# }
+# ");
+#}
+
+sub mkstruct {
+ my($pnames,$pobjs,$comp,$priv,$name) = @_;
+ my $npdls = $#$pnames+1;
+ my $decl = qq{typedef struct $name {
+ PDL_TRANS_START($npdls);
+ $priv
+ $comp
+ char __ddone; PDL_COMMENT("Dims done")
+ } $name;};
+ return $decl;
+}
+
+sub def_vtable {
+ my($vname,$sname,$rdname,$rfname,$wfname,$cpfname,$ffname,
+ $pnames,$pobjs,$affine_ok,$foofname) = @_;
+ my $nparents = 0 + grep {! $pobjs->{$_}->{FlagW}} @$pnames;
+ my $aff = ($affine_ok ? "PDL_TPDL_VAFFINE_OK" : 0);
+ my $npdls = scalar @$pnames;
+ my $join_flags = join",",map {$pobjs->{$pnames->[$_]}->{FlagPhys} ?
+ 0 : $aff} 0..$npdls-1;
+ if($Config{cc} eq 'cl') {
+ $join_flags = '""' if $join_flags eq '';
+ }
+ return "static char ${vname}_flags[] =
+ { ". $join_flags . "};
+ pdl_transvtable $vname = {
+ 0,0, $nparents, $npdls, ${vname}_flags,
+ $rdname, $rfname, $wfname,
+ $ffname,NULL,NULL,$cpfname,NULL,
+ sizeof($sname),\"$vname\",
+ $foofname
+ };";
+}
+
+sub sort_pnobjs {
+ my($pnames,$pobjs) = @_;
+ my (@nn);
+ for(@$pnames) { push ( @nn, $_ ) unless $pobjs->{$_}{FlagW}; }
+ for(@$pnames) { push ( @nn, $_ ) if $pobjs->{$_}{FlagW}; }
+ my $no = 0;
+ for(@nn) { $pobjs->{$_}{Number} = $no++; }
+ return (\@nn,$pobjs);
+}
+
+# XXX __privtrans explicit :(
+sub wrap_vfn {
+ my($code,$hdrinfo,$rout,$p2child,$name) = @_;
+ my $type = ($name eq "copy" ? "pdl_trans *" : "void");
+ my $sname = $hdrinfo->{StructName};
+ my $oargs = ($name eq "foo" ? ",int i1,int i2,int i3" : "");
+
+# print "$rout\_$name: $p2child\n";
+ my $p2decl = '';
+ # Put p2child in simple boolean context rather than strict numerical equality
+ if ( $p2child ) {
+ $p2decl =
+ "pdl *__it = ((pdl_trans_affine *)(__tr))->pdls[1]; pdl *__parent = __tr->pdls[0];";
+ if ( $name eq "redodims" ) {
+ $p2decl .= '
+ if (__parent->hdrsv && (__parent->state & PDL_HDRCPY)) {
+ PDL_COMMENT("call the perl routine _hdr_copy.")
+ int count;
+
+ dSP;
+ ENTER ;
+ SAVETMPS ;
+ PUSHMARK(SP) ;
+ XPUSHs( sv_mortalcopy((SV*)__parent->hdrsv) );
+ PUTBACK ;
+ count = call_pv("PDL::_hdr_copy",G_SCALAR);
+ SPAGAIN ;
+ if(count != 1)
+ croak("PDL::_hdr_copy didn\'t return a single value - please report this bug (B).");
+
+ { PDL_COMMENT("convenience block for tmp var")
+ SV *tmp = (SV *) POPs ;
+ __it->hdrsv = (void*) tmp;
+ if(tmp != &PL_sv_undef )
+ (void)SvREFCNT_inc(tmp);
+ }
+
+ __it->state |= PDL_HDRCPY;
+
+ FREETMPS ;
+ LEAVE ;
+ }
+ ';
+ }
+ } # if: $p2child == 1
+
+ qq|$type $rout(pdl_trans *__tr $oargs) {
+ int __dim;
+ $sname *__privtrans = ($sname *) __tr;
+ $p2decl
+ {
+ $code
+ }
+ }
+ |;
+
+} # sub: wrap_vfn()
+
+sub makesettrans {
+ my($pnames,$pobjs,$symtab) = @_;
+ my $trans = $symtab->get_symname('_PDL_ThisTrans');
+ my $no=0;
+ return (join '',map {
+ "$trans->pdls[".($no++)."] = $_;\n"
+ } @$pnames).
+ "PDL->make_trans_mutual((pdl_trans *)$trans);\n";
+}
+
+sub CopyOtherPars {
+ my($onames,$otypes,$symtab) = @_; my $repr;
+ my $sname = $symtab->get_symname('_PDL_ThisTrans');
+ for(@$onames) {
+ $repr .= $otypes->{$_}->get_copy("$_","$sname->$_");
+ }
+ return $repr;
+}
+
+sub mkxscat {
+ my($glb,$xs_c_headers,$hdr, at bits) = @_;
+ my($boot,$prelude,$str);
+ if($glb) {
+ $prelude = join '' => ($xs_c_headers->[0], @bits, $xs_c_headers->[1]);
+ $boot = $xs_c_headers->[3];
+ $str = "$hdr\n";
+ } else {
+ my $xscode = join '' => @bits;
+ $str = "$hdr CODE:\n { $xscode XSRETURN(0);\n}\n\n";
+ }
+ $str =~ s/(\s*\n)+/\n/g;
+ ($str,$boot,$prelude)
+}
+
+sub mkVarArgsxscat {
+ my($glb,$xs_c_headers,$hdr, at bits) = @_;
+ my($boot,$prelude,$str);
+ if($glb) {
+ $prelude = join '' => ($xs_c_headers->[0], @bits, $xs_c_headers->[1]);
+ $boot = $xs_c_headers->[3];
+ $str = "$hdr\n";
+ } else {
+ my $xscode = join '' => @bits;
+ $str = "$hdr \n { $xscode \n}\n\n";
+ }
+ $str =~ s/(\s*\n)+/\n/g;
+ ($str,$boot,$prelude)
+}
+
+
+sub MakeNows {
+ my($pnames, $symtab) = @_;
+ my $str = "\n";
+ for(@$pnames) { $str .= "$_ = PDL->make_now($_);\n"; }
+ return $str;
+}
+
+sub Sym2Loc { return $_[0]->decl_locals(); }
+
+sub MkPrivStructInit {
+ my( $symtab, $vtable, $affflag, $nopdlthread ) = @_;
+ my $sname = $symtab->get_symname('_PDL_ThisTrans');
+
+ my $ci = ' ';
+ return
+ "\n${ci}$sname = malloc(sizeof(*$sname));\n" .
+ ($nopdlthread ? "" : "${ci}PDL_THR_CLRMAGIC(&$sname->__pdlthread);\n") .
+ "${ci}PDL_TR_SETMAGIC($sname);\n" .
+ "${ci}$sname->flags = $affflag;\n" .
+ "${ci}$sname->__ddone = 0;\n" .
+ "${ci}$sname->vtable = &$vtable;\n" .
+ "${ci}$sname->freeproc = PDL->trans_mallocfreeproc;\n";
+
+} # sub: MkPrivStructInit()
+
+sub MkDefSyms {
+ return SymTab->new(
+ _PDL_ThisTrans => ["__privtrans",C::Type->new(undef,"$_[0] *foo")],
+ );
+}
+
+sub AddArgsyms {
+ my($symtab,$args) = @_;
+ $symtab->add_params(
+ map {($_->[0],$_->[0])} @$args
+ );
+ return $symtab;
+}
+
+sub indent($$) {
+ my ($text,$ind) = @_;
+ $text =~ s/^(.*)$/$ind$1/mg;
+ return $text;
+}
+
+# This subroutine generates the XS code needed to call the perl 'initialize'
+# routine in order to create new output PDLs
+sub callPerlInit {
+ my $names = shift; # names of variables to initialize
+ my $ci = shift; # current indenting
+ my $callcopy = $#_ > -1 ? shift : 0;
+ my $ret = '';
+
+ foreach my $name (@$names) {
+ unless ($callcopy) { $ret .= << "EOC"}
+
+if (strcmp(objname,"PDL") == 0) { PDL_COMMENT("shortcut if just PDL")
+ $name\_SV = sv_newmortal();
+ $name = PDL->null();
+ PDL->SetSV_PDL($name\_SV,$name);
+ if (bless_stash) $name\_SV = sv_bless($name\_SV, bless_stash);
+} else {
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(objname, 0)));
+ PUTBACK;
+ perl_call_method(\"initialize\", G_SCALAR);
+ SPAGAIN;
+ $name\_SV = POPs;
+ PUTBACK;
+ $name = PDL->SvPDLV($name\_SV);
+}
+
+EOC
+
+ else { $ret .= << "EOD" }
+
+if (strcmp(objname,"PDL") == 0) { PDL_COMMENT("shortcut if just PDL")
+ $name\_SV = sv_newmortal();
+ $name = PDL->null();
+ PDL->SetSV_PDL($name\_SV,$name);
+ if (bless_stash) $name\_SV = sv_bless($name\_SV, bless_stash);
+} else {
+ /* XXX should these commented lines be removed? See also a 8 lines down */
+ /* warn("possibly relying on deprecated automatic copy call in derived class\n")
+ warn("please modify your initialize method to avoid future problems\n");
+ */
+ PUSHMARK(SP);
+ XPUSHs(parent);
+ PUTBACK;
+ perl_call_method(\"copy\", G_SCALAR);
+ /* perl_call_method(\"initialize\", G_SCALAR); */
+ SPAGAIN;
+ $name\_SV = POPs;
+ PUTBACK;
+ $name = PDL->SvPDLV($name\_SV);
+}
+EOD
+
+ } # doreach: $name
+
+ return indent($ret,$ci);
+
+} #sub callPerlInit()
+
+# This subroutine is called when no 'otherpars' exist.
+# This writes an XS header which handles variable argument lists,
+# thus avoiding the perl layer in calling the routine. D. Hunt 4/11/00
+#
+# The use of 'DO NOT SET!!' looks ugly.
+#
+# Removing useless use of hasp2child in this function. DCM Sept 12, 2011
+sub VarArgsXSHdr {
+ my($name,$xsargs,$parobjs,$optypes,#$hasp2child,
+ $pmcode,$hdrcode,$inplacecode,$globalnew,$callcopy) = @_;
+
+ # Don't do var args processing if the user has pre-defined pmcode
+ return 'DO NOT SET!!' if ($pmcode);
+
+ # don't generate a HDR if globalnew is set
+ # globalnew implies internal usage, not XS
+ return undef if $globalnew;
+
+ my $ci = ' '; # current indenting
+ my $pars = join "\n",map {$ci.$_->[1]->get_decl($_->[0]).";"} @$xsargs;
+
+ my @args = map { $_->[0] } @$xsargs;
+ my %out = map { $_ => exists($$parobjs{$_})
+ && exists($$parobjs{$_}{FlagOut})
+ && !exists($$parobjs{$_}{FlagCreateAlways})}
+ @args;
+ my %outca = map { $_ => exists($$parobjs{$_})
+ && exists($$parobjs{$_}{FlagOut})
+ && exists($$parobjs{$_}{FlagCreateAlways})}
+ @args;
+ my %tmp = map { $_ => exists($$parobjs{$_}) && exists($$parobjs{$_}{FlagTemp}) } @args;
+ my %other = map { $_ => exists($$optypes{$_}) } @args;
+
+ # remember, othervars *are* input vars
+ my $nout = (grep { $_ } values %out);
+ my $noutca = (grep { $_ } values %outca);
+ my $nother = (grep { $_ } values %other);
+ my $ntmp = (grep { $_ } values %tmp);
+ my $ntot = @args;
+ my $nmaxonstack = $ntot - $noutca;
+ my $nin = $ntot - ($nout + $noutca + $ntmp);
+ my $ninout = $nin + $nout;
+ my $nallout = $nout + $noutca;
+ my $usageargs = join (",", @args);
+
+ $ci = ' '; # Current indenting
+
+ # Generate declarations for SV * variables corresponding to pdl * output variables.
+ # These are used in creating output and temp variables. One variable (ex: SV * outvar1_SV;)
+ # is needed for each output and output create always argument
+ my $svdecls = join ("\n", map { "${ci}SV *${_}_SV;" } grep { $out{$_} || $outca{$_} || $tmp{$_} } @args);
+
+ my @create = (); # The names of variables which need to be created by calling
+ # the 'initialize' perl routine from the correct package.
+
+ $ci = ' '; # Current indenting
+
+ # clause for reading in all variables
+ my $clause1 = ''; my $cnt = 0;
+ foreach my $i ( 0 .. $#args ) {
+ my $x = $args[$i];
+ if ($other{$x}) { # other par
+ $clause1 .= "$ci$x = " . typemap($x, $$optypes{$x}, "ST($cnt)") . ";\n";
+ $cnt++;
+ } elsif ($outca{$x}) {
+ push (@create, $x);
+ } else {
+ $clause1 .= "$ci$x = PDL->SvPDLV(ST($cnt));\n";
+ $cnt++;
+ }
+ }
+
+ # Add code for creating output variables via call to 'initialize' perl routine
+ $clause1 .= callPerlInit (\@create, $ci, $callcopy);
+ @create = ();
+
+ # clause for reading in input and output vars and creating temps
+ my $clause2;
+ # skip this clause if there are no temps
+ if ($nmaxonstack == $ninout) {
+ $clause2 = '';
+ } else {
+ $clause2 = "\n else if (items == $ninout) { PDL_COMMENT(\"all but temps on stack, read in output, create temps\")" .
+ " nreturn = $noutca;\n";
+
+ $cnt = 0;
+ foreach my $i ( 0 .. $#args ) {
+ my $x = $args[$i];
+ if ($other{$x}) {
+ $clause2 .= "$ci$x = " . typemap($x, $$optypes{$x}, "ST($cnt)") . ";\n";
+ $cnt++;
+ } elsif ($tmp{$x} || $outca{$x}) {
+ # a temporary or always create variable
+ push (@create, $x);
+ } else { # an input or output variable
+ $clause2 .= "$ci$x = PDL->SvPDLV(ST($cnt));\n";
+ $cnt++;
+ }
+ }
+
+ # Add code for creating output variables via call to 'initialize' perl routine
+ $clause2 .= callPerlInit (\@create, $ci, $callcopy);
+ $clause2 .= "}\n";
+ @create = ();
+
+ }
+
+ # clause for reading in input and creating output and temp vars
+ my $clause3 = '';
+ $cnt = 0;
+ foreach my $i ( 0 .. $#args ) {
+ my $x = $args[$i];
+ if ($other{$x}) {
+ $clause3 .= "$ci$x = " . typemap($x, $$optypes{$x}, "ST($cnt)") . ";\n";
+ $cnt++;
+ } elsif ($out{$x} || $tmp{$x} || $outca{$x}) {
+ push (@create, $x);
+ } else {
+ $clause3 .= "$ci$x = PDL->SvPDLV(ST($cnt));\n";
+ $cnt++;
+ }
+ }
+
+ # Add code for creating output variables via call to 'initialize' perl routine
+ $clause3 .= callPerlInit (\@create, $ci, $callcopy); @create = ();
+
+ return<<END;
+
+void
+$name(...)
+ PREINIT:
+ char *objname = "PDL"; /* XXX maybe that class should actually depend on the value set
+ by pp_bless ? (CS) */
+ HV *bless_stash = 0;
+ SV *parent = 0;
+ int nreturn;
+$svdecls
+$pars
+
+ PPCODE:
+
+{
+ PDL_COMMENT("Check if you can get a package name for this input value. ")
+ PDL_COMMENT("It can be either a PDL (SVt_PVMG) or a hash which is a ")
+ PDL_COMMENT("derived PDL subclass (SVt_PVHV) ")
+
+ if (SvROK(ST(0)) && ((SvTYPE(SvRV(ST(0))) == SVt_PVMG) || (SvTYPE(SvRV(ST(0))) == SVt_PVHV))) {
+ parent = ST(0);
+ if (sv_isobject(parent))
+ objname = HvNAME((bless_stash = SvSTASH(SvRV(ST(0))))); PDL_COMMENT("The package to bless output vars into is taken from the first input var")
+ }
+ if (items == $nmaxonstack) { PDL_COMMENT("all variables on stack, read in output and temp vars")
+ nreturn = $noutca;
+$clause1
+ }
+$clause2
+ else if (items == $nin) { PDL_COMMENT("only input variables on stack, create outputs and temps")
+ nreturn = $nallout;
+$clause3
+ }
+
+ else {
+ croak (\"Usage: PDL::$name($usageargs) (you may leave temporaries or output variables out of list)\");
+ }
+}
+{
+$hdrcode
+$inplacecode
+}
+END
+
+} # sub: VarArgsXSHdr()
+
+# This subroutine produces the code which returns output variables
+# or leaves them as modified input variables. D. Hunt 4/10/00
+sub VarArgsXSReturn {
+ my($xsargs, $parobjs, $globalnew ) = @_;
+
+ # don't generate a HDR if globalnew is set
+ # globalnew implies internal usage, not XS
+ return undef if $globalnew;
+
+ # names of output variables (in calling order)
+ my @outs;
+
+ # beware of existance tests like this: $$parobjs{$arg->[0]}{FlagOut} !
+ # this will cause $$parobjs{$arg->[0]} to spring into existance even if $$parobjs{$arg->[0]}{FlagOut}
+ # does not exist!!
+ foreach my $arg (@$xsargs) {
+ my $x = $arg->[0];
+ push (@outs, $x) if (exists ($$parobjs{$x}) and exists ($$parobjs{$x}{FlagOut}));
+ }
+
+ my $ci = ' '; # Current indenting
+
+ my $clause1 = '';
+ foreach my $i ( 0 .. $#outs ) {
+ $clause1 .= "${ci}ST($i) = $outs[$i]_SV;\n";
+ }
+
+return <<"END"
+if (nreturn) {
+ if (nreturn - items > 0) EXTEND (SP, nreturn - items);
+$clause1
+ XSRETURN(nreturn);
+} else {
+ XSRETURN(0);
+}
+END
+
+} # sub: VarArgsXSReturn()
+
+
+sub XSCHdrs {
+ my($name,$pars,$gname) = @_;
+ # Hmmm, do we need $shortpars at all?
+ #my $shortpars = join ',',map {$_->[0]} @$pars;
+ my $longpars = join ",",map {$_->[1]->get_decl($_->[0])} @$pars;
+ return ["void $name($longpars) {","}","",
+ "PDL->$gname = $name;"];
+}
+
+# abstract the access to the bad value status
+# - means we can easily change the representation without too
+# many changes
+#
+# it's also used in one place in PP/PDLCode.pm
+# -- there it's hard-coded
+#
+sub set_badflag { return '$PRIV(bvalflag) = 1;' . "\n"; }
+sub clear_badflag { return '$PRIV(bvalflag) = 0;' . "\n"; }
+sub get_badflag { return '$PRIV(bvalflag)'; }
+
+sub get_badflag_priv { return '$PRIV(bvalflag)'; }
+
+sub set_badstate {
+ my $pdl = shift;
+ return "\$SETPDLSTATEBAD($pdl)";
+}
+
+sub clear_badstate {
+ my $pdl = shift;
+ return "\$SETPDLSTATEGOOD($pdl)";
+}
+
+sub get_badstate {
+ my $pdl = shift;
+ return "\$ISPDLSTATEBAD($pdl)";
+}
+
+# checks the input piddles to see if the routine
+# is being any data containing bad values
+#
+# if FindBadStatusCode is set, use it,
+# otherwise create the code automatically.
+#
+# - in the automatic code creation,
+# if $badflag is 0, rather than being undefined, then
+# we issue a warning if any piddles contain bad values
+# (and set the bvalflag to 0)
+#
+# XXX it looks like output piddles are included in the
+# check. I *think* this is just wasted code, but I'm
+# not sure.
+#
+sub findbadstatus {
+ my ( $badflag, $badcode, $xsargs, $parobjs, $optypes, $symtab, $name ) = @_;
+ return '' unless $bvalflag;
+
+ return $badcode if defined $badcode;
+
+ my $sname = $symtab->get_symname('_PDL_ThisTrans');
+
+ my @args = map { $_->[0] } @$xsargs;
+ my %out = map {
+ $_ =>
+ exists($$parobjs{$_}) && exists($$parobjs{$_}{FlagOut})
+ && !exists($$parobjs{$_}{FlagCreateAlways})
+ } @args;
+ my %outca = map {
+ $_ =>
+ exists($$parobjs{$_}) && exists($$parobjs{$_}{FlagOut})
+ && exists($$parobjs{$_}{FlagCreateAlways})
+ } @args;
+ my %tmp = map {
+ $_ =>
+ exists($$parobjs{$_}) && exists($$parobjs{$_}{FlagTemp})
+ } @args;
+ my %other = map { $_ => exists($$optypes{$_}) } @args;
+
+ my $clear_bad = clear_badflag();
+ my $set_bad = set_badflag();
+ my $get_bad = get_badflag();
+
+ my $str = $clear_bad;
+
+ # set the badflag_cache variable if any input piddle has the bad flag set
+ #
+ my $add = 0;
+ my $badflag_str = " \$BADFLAGCACHE() = ";
+ foreach my $i ( 0 .. $#args ) {
+ my $x = $args[$i];
+ unless ( $other{$x} or $out{$x} or $tmp{$x} or $outca{$x}) {
+ if ($add) { $badflag_str .= " || "; }
+ else { $add = 1; }
+ $badflag_str .= get_badstate($args[$i]);
+ }
+ }
+
+ # It is possible, at present, for $add to be 0. I think this is when
+ # the routine has no input piddles, such as fibonacci in primitive.pd,
+ # but there may be other cases. These routines could/should (?)
+ # be marked as NoBadCode to avoid this, or maybe the code here made
+ # smarter. Left as is for now as do not want to add instability into
+ # the 2.4.3 release if I can help it - DJB 23 Jul 2006
+ #
+ if ($add != 0) {
+ $str .= $badflag_str . ";\n if (\$BADFLAGCACHE()) ${set_bad}\n";
+ } else {
+ print "\nNOTE: $name has no input bad piddles.\n\n" if $::PP_VERBOSE;
+ }
+
+ if ( defined($badflag) and $badflag == 0 ) {
+ $str .=
+" if ( $get_bad ) {
+ printf(\"WARNING: $name does not handle bad values.\\n\");
+ $clear_bad
+ }\n";
+ print "\nNOTE: $name does not handle bad values.\n\n" if $::PP_VERBOSE;
+ } # if: $badflag
+
+ return $str;
+
+} # sub: findbadstatus
+
+
+# copies over the bad value state to the output piddles
+#
+# if CopyBadStatusCode is set, use it,
+# otherwise create the code automatically.
+#
+# note: this is executed before the trans_mutual call
+# is made, since the state may be changed by the
+# Code section
+#
+sub copybadstatus {
+ my ( $badflag, $badcode, $xsargs, $parobjs, $symtab ) = @_;
+## return '' unless $bvalflag or $badflag == 0;
+ return '' unless $bvalflag;
+
+ if (defined $badcode) {
+ # realised in 2.4.3 testing that use of $PRIV at this stage is
+ # dangerous since it may have been freed. So I introduced the
+ # $BFLACACHE variable which stores the $PRIV(bvalflag) value
+ # for use here.
+ # For now make the substitution automatic but it will likely become an
+ # error to use $PRIV(bvalflag) here.
+ #
+ if ($badcode =~ m/\$PRIV(bvalflag)/) {
+ $badcode =~ s/\$PRIV(bvalflag)/\$BADFLAGCACHE()/;
+ print "\nPDL::PP WARNING: copybadstatus contains '\$PRIV(bvalflag)'; replace with \$BADFLAGCACHE()\n\n";
+ }
+ return $badcode;
+ }
+
+ # names of output variables (in calling order)
+ my @outs;
+
+ # beware of existance tests like this: $$parobjs{$arg->[0]}{FlagOut} !
+ # this will cause $$parobjs{$arg->[0]} to spring into existance even if $$parobjs{$arg->[0]}{FlagOut}
+ # does not exist!!
+ foreach my $arg (@$xsargs) {
+ my $x = $arg->[0];
+ push (@outs, $x) if (exists ($$parobjs{$x}) and exists ($$parobjs{$x}{FlagOut}));
+ }
+
+ my $sname = $symtab->get_symname('_PDL_ThisTrans');
+ my $str = '';
+
+# It appears that some code in Bad.xs sets the cache value but then
+# this bit of code never gets called. Is this an efficiency issue (ie
+# should we try and optimise away those ocurrences) or does it perform
+# some purpose?
+#
+ $str = "if (\$BADFLAGCACHE()) {\n";
+ foreach my $arg ( @outs ) {
+ $str .= " " . set_badstate($arg) . ";\n";
+ }
+ $str .= "}\n";
+
+ return $str;
+
+} # sub: copybadstatus()
+
+# insert code, after the autogenerated xs argument processing code
+# produced by VarArgsXSHdr and AFTER any in HdrCode
+# - this code flags the routine as working inplace,
+#
+# Inplace can be supplied several values
+# => 1
+# assumes fn has an inout and output piddle (eg 'a(); [o] b();')
+#
+# => [ 'a' ]
+# assumes several input piddles in sig, so 'a' labels which
+# one is to be marked inplace
+#
+# => [ 'a', 'b' ]
+# input piddle is a(), output pidle is 'b'
+#
+sub InplaceCode {
+ my ( $ppname, $xsargs, $parobjs, $arg ) = @_;
+ return '' unless defined $arg;
+
+ # find input and output piddles
+ my ( @in, @out );
+ foreach my $arg (@$xsargs) {
+ my $name = $arg->[0];
+ if ( exists $$parobjs{$name} ) {
+ if ( exists $$parobjs{$name}{FlagOut} ) {
+ push @out, $name;
+ } elsif ( ! exists $$parobjs{$name}{FlagTemp} ) {
+ push @in, $name;
+ }
+ }
+ }
+
+ # handle different values of arg
+ my ( $in, $out );
+
+ # default vals - only set if we have one input/output piddle
+ $in = $in[0] if $#in == 0;
+ $out = $out[0] if $#out == 0;
+
+ if ( ref($arg) eq "ARRAY" ) {
+ my $narg = $#$arg;
+ if ( $narg > -1 ) {
+ $in = $$arg[0];
+ $out = $$arg[1] if $narg > 0;
+ }
+ } elsif ( ref($arg) eq "" ) {
+ return '' unless $arg;
+ # use default values
+ } else {
+ die "ERROR: Inplace rule [$ppname] must be sent either an array ref or a scalar.\n";
+ }
+
+ die "ERROR: Inplace [$ppname] does not know name of input piddle\n"
+ unless defined $in;
+ die "ERROR: Inplace [$ppname] does not know name of output piddle\n"
+ unless defined $out;
+
+ my $instate = $in . "->state";
+ return
+ qq{\tif ( $instate & PDL_INPLACE && ($out != $in)) {
+ $instate &= ~PDL_INPLACE; PDL_COMMENT("unset")
+ $out = $in; PDL_COMMENT("discard output value, leak ?")
+ PDL->SetSV_PDL(${out}_SV,${out});
+ }},
+
+} # sub: InplaceCode
+
+# If there is an EquivCPOffsCOde and:
+# no bad-value support ==> use that
+# bad value support ==> write a bit of code that does
+# if ( $PRIV(bvalflag) ) { bad-EquivCPOffsCode }
+# else { good-EquivCPOffsCode }
+#
+# Note: since EquivCPOffsCOde doesn't (or I haven't seen any that
+# do) use 'loop %{' or 'threadloop %{', we can't rely on
+# PDLCode to automatically write code like above, hence the
+# explicit definition here.
+#
+# Note: I *assume* that bad-Equiv..Code == good-Equiv..Code *EXCEPT*
+# that we re-define the meaning of the $EQUIVCPOFFS macro to
+# check for bad values when copying things over.
+# This means having to write less code.
+#
+# Since PARENT & CHILD need NOT be the same type we cannot just copy
+# values from one to the other - we have to check for the presence
+# of bad values, hence the expansion for the $bad code
+#
+# Some operators (notably range) also have an out-of-range flag; they use
+# the macro EQUIVCPTRUNC instead of EQUIVCPOFFS.
+# $EQUIVCPTRUNC does the same as EQUIVCPOFFS but accepts a child-out-of-bounds
+# flag. If the out-of-bounds flag is set, the forward code puts BAD/0 into
+# the child, and reverse code refrains from copying.
+# --CED 27-Jan-2003
+#
+# sent [EquivCPOffsCode,BadFlag]
+
+#
+# NOTE: EQUIVCPOFFS and EQUIVCPTRUNC both suffer from the macro-block
+# wart of C preprocessing. They look like statements but sometimes
+# process into blocks, so if/then/else constructs can get broken.
+# Either (1) use blocks for if/then/else, or (2) get excited and
+# use the "do {BLOCK} while(0)" block-to-statement conversion construct
+# in the substitution. I'm too Lazy. --CED 27-Jan-2003
+#
+sub CodefromEquivCPOffsCode {
+ my $good = shift;
+ my $bflag = shift;
+
+ my $bad = $good;
+
+ # parse 'good' code
+ $good =~ s/\$EQUIVCPOFFS\(([^()]+),([^()]+)\)/\$PP(CHILD)[$1] = \$PP(PARENT)[$2]/g;
+ $good =~ s/\$EQUIVCPTRUNC\(([^()]+),([^()]+),([^()]+)\)/\$PP(CHILD)[$1] = ($3) ? 0 : \$PP(PARENT)[$2]/g;
+
+ my $str = $good;
+
+ if ( defined $bflag and $bflag ) {
+ # parse 'bad' code
+ $bad =~ s/\$EQUIVCPOFFS\(([^()]+),([^()]+)\)/if( \$PPISBAD(PARENT,[$2]) ) { \$PPSETBAD(CHILD,[$1]); } else { \$PP(CHILD)[$1] = \$PP(PARENT)[$2]; }/g;
+ $bad =~ s/\$EQUIVCPTRUNC\(([^()]+),([^()]+),([^()]+)\)/ if( ($3) || \$PPISBAD(PARENT,[$2]) ) { \$PPSETBAD(CHILD,[$1]); } else {\$PP(CHILD)[$1] = \$PP(PARENT)[$2]; }/g;
+
+ $str = 'if( $PRIV(bvalflag) ) { ' . $bad . ' } else { ' . $good . '}';
+ }
+
+ return $str;
+
+} # sub: CodefromEquivCPOffsCode
+
+# this just reverses PARENT & CHILD in the expansion of
+# the $EQUIVCPOFFS macro (ie compared to CodefromEquivCPOffsCode)
+#
+sub BackCodefromEquivCPOffsCode {
+ my $good = shift;
+ my $bflag = shift;
+
+ my $bad = $good;
+
+ # parse 'good' code
+ $good =~ s/\$EQUIVCPOFFS\(([^()]+),([^()]+)\)/\$PP(PARENT)[$2] = \$PP(CHILD)[$1]/g;
+ $good =~ s/\$EQUIVCPTRUNC\(([^()]+),([^()]+),([^()]+)\)/if(!($3)) \$PP(PARENT)[$2] = \$PP(CHILD)[$1] /g;
+
+ my $str = $good;
+
+ if ( defined $bflag and $bflag ) {
+ # parse 'bad' code
+ $bad =~ s/\$EQUIVCPOFFS\(([^()]+),([^()]+)\)/if( \$PPISBAD(CHILD,[$1]) ) { \$PPSETBAD(PARENT,[$2]); } else { \$PP(PARENT)[$2] = \$PP(CHILD)[$1]; }/g;
+ $bad =~ s/\$EQUIVCPTRUNC\(([^()]+),([^()]+),([^()]+)\)/if(!($3)) { if( \$PPISBAD(CHILD,[$1]) ) { \$PPSETBAD(PARENT,[$2]); } else { \$PP(PARENT)[$2] = \$PP(CHILD)[$1]; } } /g;
+
+ $str = 'if ( $PRIV(bvalflag) ) { ' . $bad . ' } else { ' . $good . '}';
+ }
+
+ return $str;
+
+} # sub: BackCodefromEquivCPOffsCode
+
+sub GenDocs {
+ my ($name,$pars,$otherpars,$doc,$baddoc) = @_;
+
+ # Allow explcit non-doc using Doc=>undef
+
+ return '' if $doc eq '' && (!defined $doc) && $doc==undef;
+ return '' if $doc =~ /^\s*internal\s*$/i;
+
+ # remove any 'bad' documentation if we're not compiling support
+ $baddoc = undef unless $bvalflag;
+
+ # If the doc string is one line let's have to for the
+ # reference card information as well
+ my @splitRes; # temp split variable to get rid of
+ # 'implicit split to @_ is deprecated' messages
+ $doc = "=for ref\n\n".$doc if( scalar(@splitRes = split("\n", $doc)) <= 1);
+
+ $::DOCUMENTED++;
+ $pars = "P(); C()" unless $pars;
+ # Strip leading whitespace and trailing semicolons and whitespace
+ $pars =~ s/^\s*(.+[^;])[;\s]*$/$1/;
+ $otherpars =~ s/^\s*(.+[^;])[;\s]*$/$1/ if $otherpars;
+ my $sig = "$pars".( $otherpars ? "; $otherpars" : "");
+
+ $doc =~ s/\n(=cut\s*\n)+(\s*\n)*$/\n/m; # Strip extra =cut's
+ if ( defined $baddoc ) {
+ # Strip leading newlines and any =cut markings
+ $baddoc =~ s/\n(=cut\s*\n)+(\s*\n)*$/\n/m;
+ $baddoc =~ s/^\n+//;
+ $baddoc = "=for bad\n\n$baddoc";
+ }
+
+ my $baddoc_function_pod = <<"EOD" ;
+
+XXX=head2 $name
+
+XXX=for sig
+
+ Signature: ($sig)
+
+$doc
+
+$baddoc
+
+XXX=cut
+
+EOD
+
+ $baddoc_function_pod =~ s/^XXX=/=/gms;
+ return $baddoc_function_pod;
+}
+
+sub ToIsReversible {
+ my($rev) = @_;
+ if($rev eq "1") {
+ '$SETREVERSIBLE(1)'
+ } else {
+ $rev
+ }
+}
+
+sub make_newcoerce {
+ my($ftypes) = @_;
+ join '',map {
+ "$_->datatype = $ftypes->{$_}; "
+ } (keys %$ftypes);
+}
+
+# Assuming that, if HASP2Child is true, we only have
+# PARENT; CHILD parameters, so we can just take the
+# datatype to be that of PARENT (which is set up by
+# find_datatype()). Little bit complicated because
+# we need to set CHILD's datatype under certain
+# circumstances
+#
+sub coerce_types {
+ my($parnames,$parobjs,$ignore,$newstab,$hasp2child) = @_;
+
+ # assume [oca]CHILD();, although there might be an ignore
+ if ( $hasp2child ) {
+ my $child = $$parnames[1];
+ return "" if $ignore->{$child};
+
+ die "ERROR: expected $child to be [oca]\n"
+ unless $parobjs->{$child}{FlagCreateAlways};
+
+ return "$child\->datatype = \$PRIV(__datatype);\n$child\->has_badvalue = \$PRIV(has_badvalue);\n$child\->badvalue = \$PRIV(badvalue);\n" if $hasp2child;
+ }
+
+ my $str = "";
+ foreach ( @$parnames ) {
+ next if $ignore->{$_};
+
+ my $po = $parobjs->{$_};
+
+ my $dtype;
+ if ( $po->{FlagTyped} ) {
+ $dtype = $po->cenum();
+ $dtype = "PDLMAX($dtype,\$PRIV(__datatype))"
+ if $po->{FlagTplus};
+ } else {
+ $dtype = "\$PRIV(__datatype)";
+ }
+
+ if ( $po->{FlagCreateAlways} ) {
+ $str .= "$_->datatype = $dtype; ";
+ } else {
+ $str .=
+ "if( ($_->state & PDL_NOMYDIMS) && $_->trans == NULL ) {
+ $_->datatype = $dtype;
+ } else "
+ if $po->{FlagCreat};
+ $str .= "if($dtype != $_->datatype) {
+ $_ = PDL->get_convertedpdl($_,$dtype);
+ }";
+ }
+ } # foreach: @$parnames
+
+ return $str;
+} # sub: coerce_types()
+
+# First, finds the greatest datatype, then, if not supported, takes
+# the largest type supported by the function.
+# Not yet optimal.
+#
+# Assuming that, if HASP2Child is true, we only have
+# PARENT; CHILD parameters, so we can just take the
+# datatype to be that of PARENT (see also coerce_types())
+#
+sub find_datatype {
+ my($parnames,$parobjs,$ignore,$newstab,$gentypes,$hasp2child) = @_;
+
+ my $dtype = "\$PRIV(__datatype)";
+
+ # TODO XXX
+ # the check can probably be removed, but left in since I don't know
+ # what I'm doing (DJB)
+ die "ERROR: gentypes != $ntypes with p2child\n"
+ if $hasp2child and $#$gentypes != $ntypes;
+
+ return "$dtype = $$parnames[0]\->datatype;\n\$PRIV(has_badvalue) = $$parnames[0]\->has_badvalue;\n\$PRIV(badvalue) = $$parnames[0]\->badvalue;\n"
+ if $hasp2child;
+
+ my $str = "$dtype = 0;";
+ foreach ( @$parnames ) {
+ my $po = $parobjs->{$_};
+ next if $ignore->{$_} or $po->{FlagTyped} or $po->{FlagCreateAlways};
+
+ $str .= "if(";
+ $str .= "!(($_->state & PDL_NOMYDIMS) &&
+ $_->trans == NULL) && "
+ if $po->{FlagCreat};
+ $str .= "$dtype < $_->datatype) {
+ $dtype = $_->datatype;
+ }\n";
+ } # foreach: @$parnames
+
+ $str .= join '', map { "if($dtype == PDL_$_) {}\nelse " }(@$gentypes);
+
+ return $str .= "$dtype = PDL_$gentypes->[-1];\n";
+} # sub: find_datatype()
+
+sub NT2Decls_p {&NT2Decls__({ToPtrs=>1}, at _);}
+
+sub NT2Copies_p {&NT2Copies__({ToPtrs=>1}, at _);}
+
+sub NT2Free_p {&NT2Free__({ToPtrs=>1}, at _);}
+
+sub NT2Decls {&NT2Decls__({}, at _);}
+
+sub NT2Decls__ {
+ my($opts,$onames,$otypes) = @_;
+ my $decl;
+ my $dopts = {};
+ $dopts->{VarArrays2Ptrs} = 1 if $opts->{ToPtrs};
+ for(@$onames) {
+ $decl .= $otypes->{$_}->get_decl($_,$dopts).";";
+ }
+ return $decl;
+}
+
+sub NT2Copies__ {
+ my($opts,$onames,$otypes,$copyname) = @_;
+ my $decl;
+ my $dopts = {};
+ $dopts->{VarArrays2Ptrs} = 1 if $opts->{ToPtrs};
+ for(@$onames) {
+ $decl .= $otypes->{$_}->get_copy("\$PRIV($_)","$copyname->$_",
+ $dopts).";";
+ }
+ return $decl;
+}
+
+sub NT2Free__ {
+ my($opts,$onames,$otypes) = @_;
+ my $decl;
+ my $dopts = {};
+ $dopts->{VarArrays2Ptrs} = 1 if $opts->{ToPtrs};
+ for(@$onames) {
+ $decl .= $otypes->{$_}->get_free("\$PRIV($_)",
+ $dopts).";";
+ }
+ return $decl;
+}
+
+# The undef is just so that PrivIsInc gets set. Is this really
+# needed (well, it is since the rule fails if there aren't 2
+# return values; what I meant is what does PrivIsInc do for
+# us?)
+#
+sub make_incsizes {
+ my($parnames,$parobjs,$dimobjs,$havethreading) = @_;
+ my $str = ($havethreading?"pdl_thread __pdlthread; ":"").
+ (join '',map {$parobjs->{$_}->get_incdecls} @$parnames).
+ (join '',map {$_->get_decldim} values %$dimobjs);
+ return ($str,undef);
+}
+
+sub make_incsize_copy {
+ my($parnames,$parobjs,$dimobjs,$copyname,$havethreading) = @_;
+ ($havethreading?
+ "PDL->thread_copy(&(\$PRIV(__pdlthread)),&($copyname->__pdlthread));"
+ : "").
+ (join '',map {$parobjs->{$_}->get_incdecl_copy(sub{"\$PRIV($_[0])"},
+ sub{"$copyname->$_[0]"})} @$parnames).
+ (join '',map {$_->get_copydim(sub{"\$PRIV($_[0])"},
+ sub{"$copyname->$_[0]"})} values %$dimobjs);
+
+}
+
+sub make_incsize_free {
+ my($parnames,$parobjs,$dimobjs,$havethreading) = @_;
+ $havethreading ?
+ 'PDL->freethreadloop(&($PRIV(__pdlthread)));'
+ : ''
+}
+
+sub make_parnames {
+ my($pnames,$pobjs,$dobjs) = @_;
+ my @pdls = map {$pobjs->{$_}} @$pnames;
+ my $npdls = $#pdls+1;
+ my $join__parnames = join ",",map {qq|"$_"|} @$pnames;
+ my $join__realdims = join ",",map {$#{$_->{IndObjs}}+1} @pdls;
+ if($Config{cc} eq 'cl') {
+ $join__parnames = '""' if $join__parnames eq '';
+ $join__realdims = '0' if $join__realdims eq '';
+ }
+ return("static char *__parnames[] = {". $join__parnames ."};
+ static PDL_Indx __realdims[] = {". $join__realdims . "};
+ static char __funcname[] = \"\$MODULE()::\$NAME()\";
+ static pdl_errorinfo __einfo = {
+ __funcname, __parnames, $npdls
+ };
+ ");
+}
+
+##############################
+#
+# hdrcheck -- examine the various PDLs that form the output PDL,
+# and copy headers as necessary. The last header found with the hdrcpy
+# bit set is used. This used to do just a simple ref copy but now
+# it uses the perl routine PDL::_hdr_copy to do the dirty work. That
+# routine makes a deep copy of the header. Copies of the deep copy
+# are distributed to all the names of the piddle that are not the source
+# of the header. I believe that is the Right Thing to do but I could be
+# wrong.
+#
+# It's hard to read this sort of macro stuff so here's the flow:
+# - Check the hdrcpy flag. If it's set, then check the header
+# to see if it exists. If it doees, we need to call the
+# perl-land PDL::_hdr_copy routine. There are some shenanigans
+# to keep the return value from evaporating before we've had a
+# chance to do our bit with it.
+# - For each output argument in the function signature, try to put
+# a reference to the new header into that argument's header slot.
+# (For functions with multiple outputs, this produces multiple linked
+# headers -- that could be Wrong; fixing it would require making
+# yet more explicit copies!)
+# - Remortalize the return value from PDL::_hdr_copy, so that we don't
+# leak memory.
+#
+# --CED 12-Apr-2003
+#
+
+sub hdrcheck {
+ my ($pnames,$pobjs) = @_;
+
+ my $nn = $#$pnames;
+ my @names = map { "\$PRIV(pdls[$_])" } 0..$nn;
+
+ # from make_redodims_thread() we know that __creating[] == 0 unless
+ # ...{FlagCreat} is true
+ #
+ my $str = "
+{ PDL_COMMENT(\"convenience block\")
+ void *hdrp = NULL;
+ char propagate_hdrcpy = 0;
+ SV *hdr_copy = NULL;
+";
+
+ # Find a header among the possible names
+ foreach ( 0 .. $nn ) {
+ my $aux = $pobjs->{$pnames->[$_]}{FlagCreat} ? "!__creating[$_] && \n" : "";
+ $str .= <<"HdRCHECK1"
+ if(!hdrp &&
+ $aux $names[$_]\->hdrsv &&
+ ($names[$_]\->state & PDL_HDRCPY)
+ ) {
+ hdrp = $names[$_]\->hdrsv;
+ propagate_hdrcpy = (($names[$_]\->state & PDL_HDRCPY) != 0);
+ }
+HdRCHECK1
+ ;
+ }
+
+ $str .= << 'DeePcOPY'
+if (hdrp) {
+ if(hdrp == &PL_sv_undef)
+ hdr_copy = &PL_sv_undef;
+ else { PDL_COMMENT("Call the perl routine _hdr_copy...")
+ int count;
+ PDL_COMMENT("Call the perl routine PDL::_hdr_copy(hdrp)")
+ dSP;
+ ENTER ;
+ SAVETMPS ;
+ PUSHMARK(SP) ;
+ XPUSHs( hdrp );
+ PUTBACK ;
+ count = call_pv("PDL::_hdr_copy",G_SCALAR);
+ SPAGAIN ;
+ if(count != 1)
+ croak("PDL::_hdr_copy didn't return a single value - please report this bug (A).");
+
+ hdr_copy = (SV *)POPs;
+
+ if(hdr_copy && hdr_copy != &PL_sv_undef) {
+ (void)SvREFCNT_inc(hdr_copy); PDL_COMMENT("Keep hdr_copy from vanishing during FREETMPS")
+ }
+
+ FREETMPS ;
+ LEAVE ;
+
+
+ } PDL_COMMENT("end of callback block")
+
+DeePcOPY
+ ;
+# if(hdrp) block is still open -- now reassign all the aliases...
+
+ # Found the header -- now copy it into all the right places.
+ foreach ( 0 .. $nn ) {
+ $str .= <<"HdRCHECK2"
+ if ( $names[$_]\->hdrsv != hdrp ){
+ if( $names[$_]\->hdrsv && $names[$_]\->hdrsv != &PL_sv_undef)
+ (void)SvREFCNT_dec( $names[$_]\->hdrsv );
+ if( hdr_copy != &PL_sv_undef )
+ (void)SvREFCNT_inc(hdr_copy);
+ $names[$_]\->hdrsv = hdr_copy;
+ }
+ if(propagate_hdrcpy)
+ $names[$_]\->state |= PDL_HDRCPY;
+HdRCHECK2
+
+ # QUESTION: what is the following line doing?
+ #
+ if ( $pobjs->{$pnames->[$_]}{FlagCreat} );
+ }
+
+ $str .= '
+ if(hdr_copy != &PL_sv_undef)
+ SvREFCNT_dec(hdr_copy); PDL_COMMENT("make hdr_copy mortal again")
+ } PDL_COMMENT("end of if(hdrp) block")
+ } PDL_COMMENT("end of conv. block")
+';
+ return $str;
+
+} # sub: hdrcheck()
+
+sub make_redodims_thread {
+ #my($pnames,$pobjs,$dobjs,$dpars,$pcode ) = @_;
+ my($pnames,$pobjs,$dobjs,$dpars,$pcode, $noPthreadFlag) = @_;
+ my $str; my $npdls = @$pnames;
+
+ $noPthreadFlag = 0 unless( defined $noPthreadFlag ); # assume we can pthread, unless indicated otherwise
+
+ my $nn = $#$pnames;
+ my @privname = map { "\$PRIV(pdls[$_])" } ( 0 .. $nn );
+ $str .= $npdls ? "PDL_Indx __creating[$npdls];\n" : "PDL_Indx __creating[1];\n";
+ $str .= join '',map {$_->get_initdim."\n"} values %$dobjs;
+
+ # if FlagCreat is NOT true, then we set __creating[] to 0
+ # and we can use this knowledge below, and in hdrcheck()
+ # and in PP/PdlParObj (get_xsnormdimchecks())
+ #
+ foreach ( 0 .. $nn ) {
+ $str .= "__creating[$_] = ";
+ if ( $pobjs->{$pnames->[$_]}{FlagCreat} ) {
+ $str .= "PDL_CR_SETDIMSCOND(__privtrans,$privname[$_]);\n";
+ } else {
+ $str .= "0;\n";
+ }
+ } # foreach: 0 .. $nn
+
+##############################
+#
+# These tests don't appear to do anything useful,
+# and they cause trouble with null PDLs ...
+# so I've commented them out.
+# --CED 4-Nov-2003 (re: bug 779312)
+#
+# foreach ( 0 .. $nn ) {
+# my $po = $pobjs->{$pnames->[$_]};
+# $str .= "if(";
+# $str .= "(!__creating[$_]) && " if $po->{FlagCreat};
+# $str .= "($privname[$_]\->state & PDL_NOMYDIMS) && $privname[$_]\->trans == 0)\n" .
+# " \$CROAK(\"CANNOT CREATE PARAMETER $po->{Name}\");\n";
+# }
+
+ $str .= " {\n$pcode\n}\n";
+ $str .= " {\n " . make_parnames($pnames,$pobjs,$dobjs) . "
+ PDL->initthreadstruct(2,\$PRIV(pdls),
+ __realdims,__creating,$npdls,
+ &__einfo,&(\$PRIV(__pdlthread)),
+ \$PRIV(vtable->per_pdl_flags),
+ $noPthreadFlag );
+ }\n";
+ $str .= join '',map {$pobjs->{$_}->get_xsnormdimchecks()} @$pnames;
+ $str .= hdrcheck($pnames,$pobjs);
+ $str .= join '',map {$pobjs->{$pnames->[$_]}->
+ get_incsets($privname[$_])} 0..$nn;
+ return $str;
+
+} # sub: make_redodims_thread()
+
+sub XSHdr {
+ my($xsname,$nxargs) = @_;
+ return XS::mkproto($xsname,$nxargs);
+}
+
+###########################################################
+# Name : extract_signature_from_fulldoc
+# Usage : $sig = extract_signature_from_fulldoc($fulldoc)
+# Purpose : pull out the signature from the fulldoc string
+# Returns : whatever is in parentheses in the signature, or undef
+# Parameters : $fulldoc
+# Throws : never
+# Notes : the signature must have the following form:
+# :
+# : =for sig
+# : <blank>
+# : Signature: (<signature can
+# : be multiline>)
+# : <blank>
+# :
+# : The two spaces before "Signature" are required, as are
+# : the parentheses.
+sub extract_signature_from_fulldoc {
+ my $fulldoc = shift;
+ if ($fulldoc =~ /=for sig\n\n Signature: \(([^\n]*)\n/g) {
+ # Extract the signature and remove the final parenthesis
+ my $sig = $1;
+ $sig .= $1 while $fulldoc =~ /\G\h+([^\n]*)\n/g;
+ $sig =~ s/\)\s*$//;
+ return $sig;
+ }
+ return;
+}
+
+
+# Build the valid-types regex and valid Pars argument only once. These are
+# also used in PDL::PP::PdlParObj, which is why they are globally available.
+use PDL::PP::PdlParObj;
+my $pars_re = $PDL::PP::PdlParObj::pars_re;
+
+###########################################################
+# Name : build_pars_from_fulldoc
+# Usage : $pars = build_pars_from_fulldoc($fulldoc)
+# Purpose : extract the Pars from the signature from the fulldoc string,
+# : the part of the signature that specifies the piddles
+# Returns : a string appropriate for the Pars key
+# Parameters : $fulldoc
+# Throws : if there is no signature
+# : if there is no extractable Pars section
+# : if some PDL arguments come after the OtherPars arguments start
+# Notes : This is meant to be used directly in a Rule. Therefore, it
+# : is only called if the Pars key does not yet exist, so if it
+# : is not possible to extract the Pars section, it dies.
+sub build_pars_from_fulldoc {
+ my $fulldoc = shift;
+
+ # Get the signature or die
+ my $sig = extract_signature_from_fulldoc($fulldoc)
+ or confess('No Pars specified and none could be extracted from FullDoc');
+
+ # Everything is semicolon-delimited
+ my @args = split /\s*;\s*/, $sig;
+ my @pars;
+ my $switched_to_other_pars = 0;
+ for my $arg (@args) {
+ confess('All PDL args must come before other pars in FullDoc signature')
+ if $switched_to_other_pars and $arg =~ $pars_re;
+ if ($arg =~ $pars_re) {
+ push @pars, $arg;
+ }
+ else {
+ $switched_to_other_pars = 1;
+ }
+ }
+
+ # Make sure there's something there
+ confess('FullDoc signature contains no PDL arguments') if @pars == 0;
+
+ # All done!
+ return join('; ', @pars);
+}
+
+###########################################################
+# Name : build_otherpars_from_fulldoc
+# Usage : $otherpars = build_otherpars_from_fulldoc($fulldoc)
+# Purpose : extract the OtherPars from the signature from the fulldoc
+# : string, the part of the signature that specifies non-piddle
+# : arguments
+# Returns : a string appropriate for the OtherPars key
+# Parameters : $fulldoc
+# Throws : if some OtherPars arguments come before the last PDL argument
+# Notes : This is meant to be used directly in a Rule. Therefore, it
+# : is only called if the OtherPars key does not yet exist.
+sub build_otherpars_from_fulldoc {
+ my $fulldoc = shift;
+
+ # Get the signature or do not set
+ my $sig = extract_signature_from_fulldoc($fulldoc)
+ or return 'DO NOT SET!!';
+
+ # Everything is semicolon-delimited
+ my @args = split /\s*;\s*/, $sig;
+ my @otherpars;
+ for my $arg (@args) {
+ confess('All PDL args must come before other pars in FullDoc signature')
+ if @otherpars > 0 and $arg =~ $pars_re;
+ if ($arg !~ $pars_re) {
+ push @otherpars, $arg;
+ }
+ }
+
+ # All done!
+ return 'DO NOT SET!!'if @otherpars == 0;
+ return join('; ', @otherpars);
+}
+
+# Set up the rules for translating the pp_def contents.
+#
+$PDL::PP::deftbl =
+ [
+ # used as a flag for many of the routines
+ # ie should we bother with bad values for this routine?
+ # 1 - yes,
+ # 0 - no, maybe issue a warning
+ # undef - we're not compiling with bad value support
+ #
+ PDL::PP::Rule->new("BadFlag", "_HandleBad",
+ "Sets BadFlag based upon HandleBad key and PDL's ability to handle bad values",
+ sub { return (defined $_[0]) ? ($bvalflag and $_[0]) : undef; }),
+
+ ####################
+ # FullDoc Handling #
+ ####################
+
+ # Error processing: does FullDoc contain BadDoc, yet BadDoc specified?
+ PDL::PP::Rule::Croak->new(['FullDoc', 'BadDoc'],
+ 'Cannot have both FullDoc and BadDoc defined'),
+ PDL::PP::Rule::Croak->new(['FullDoc', 'Doc'],
+ 'Cannot have both FullDoc and Doc defined'),
+ # Note: no error processing on Pars; it's OK for the docs to gloss over
+ # the details.
+
+ # Add the Pars section based on the signature of the FullDoc if the Pars
+ # section doesn't already exist
+ PDL::PP::Rule->new('Pars', 'FullDoc',
+ 'Sets the Pars from the FullDoc if Pars is not explicitly specified',
+ \&build_pars_from_fulldoc
+ ),
+ PDL::PP::Rule->new('OtherPars', 'FullDoc',
+ 'Sets the OtherPars from the FullDoc if OtherPars is not explicitly specified',
+ \&build_otherpars_from_fulldoc
+ ),
+
+ ################################
+ # Other Documentation Handling #
+ ################################
+
+ # no docs by default
+ PDL::PP::Rule::Returns->new("Doc", [], 'Sets the default doc string',
+ "\n=for ref\n\ninfo not available\n"),
+
+ # try and automate the docs
+ # could be really clever and include the sig to see about
+ # input/output params, for instance
+
+ PDL::PP::Rule->new("BadDoc", ["BadFlag","Name","_CopyBadStatusCode"],
+ 'Sets the default documentation for handling of bad values',
+ sub {
+ return undef unless $bvalflag;
+ my ( $bf, $name, $code ) = @_;
+ my $str;
+ if ( not defined($bf) ) {
+ $str = "$name does not process bad values.\n";
+ } elsif ( $bf ) {
+ $str = "$name processes bad values.\n";
+ } else {
+ $str = "$name ignores the bad-value flag of the input piddles.\n";
+ }
+ if ( not defined($code) ) {
+ $str .= "It will set the bad-value flag of all output piddles if " .
+ "the flag is set for any of the input piddles.\n";
+ } elsif ( $code eq '' ) {
+ $str .= "The output piddles will NOT have their bad-value flag set.\n";
+ } else {
+ $str .= "The state of the bad-value flag of the output piddles is unknown.\n";
+ }
+ }
+ ),
+
+ # Default: no otherpars
+ PDL::PP::Rule::Returns::EmptyString->new("OtherPars"),
+
+ # the docs
+ PDL::PP::Rule->new("PdlDoc", "FullDoc", sub {
+ my $fulldoc = shift;
+
+ # Remove bad documentation if bad values are not supported
+ $fulldoc =~ s/=for bad\n\n.*?\n\n//s unless $bvalflag;
+
+ # Append a final cut if it doesn't exist due to heredoc shinanigans
+ $fulldoc .= "\n\n=cut\n" unless $fulldoc =~ /\n=cut\n*$/;
+
+ # Make sure the =head1 FUNCTIONS section gets added
+ $::DOCUMENTED++;
+
+ return $fulldoc;
+ }
+ ),
+ PDL::PP::Rule->new("PdlDoc", ["Name","_Pars","OtherPars","Doc","_BadDoc"], \&GenDocs),
+
+ ##################
+ # Done with Docs #
+ ##################
+
+ # Notes
+ # Suffix 'NS' means, "Needs Substitution". In other words, the string
+ # associated with a key that has the suffix "NS" must be run through a
+ # Substitute or Substitute::Usual
+
+# some defaults
+#
+ PDL::PP::Rule::Returns->new("CopyName", [],
+ 'Sets the CopyName key to the default: __copy', "__copy"),
+
+ PDL::PP::Rule->new("DefaultFlowCodeNS", "_DefaultFlow",
+ 'Sets the code to handle dataflow flags, if applicable',
+ sub { $_[0] ?
+ '$PRIV(flags) |= PDL_ITRANS_DO_DATAFLOW_F | PDL_ITRANS_DO_DATAFLOW_B;'
+ : 'PDL_COMMENT("No flow")'}),
+
+# Question: where is ppdefs defined?
+# Answer: Core/Types.pm
+#
+ PDL::PP::Rule->new("GenericTypes", [],
+ 'Sets GenericTypes flag to all types known to PDL::Types',
+ sub {[ppdefs]}),
+
+ PDL::PP::Rule->new("ExtraGenericLoops", "FTypes",
+ 'Makes ExtraGenericLoops identical to FTypes if the latter exists and the former does not',
+ sub {return $_[0]}),
+ PDL::PP::Rule::Returns->new("ExtraGenericLoops", [],
+ 'Sets ExtraGenericLoops to an empty hash if it does not already exist', {}),
+
+ PDL::PP::Rule::InsertName->new("StructName", 'pdl_${name}_struct'),
+ PDL::PP::Rule::InsertName->new("VTableName", 'pdl_${name}_vtable'),
+
+ PDL::PP::Rule->new("FHdrInfo", ["Name","StructName"],
+ sub { return { Name => $_[0], StructName => $_[1], }; }),
+
+# Treat exchanges as affines. Affines assumed to be parent->child.
+# Exchanges may, if the want, handle threadids as well.
+# Same number of dimensions is assumed, though.
+#
+ PDL::PP::Rule->new("AffinePriv", "XCHGOnly", sub { return @_; }),
+ PDL::PP::Rule::Returns->new("Priv", "AffinePriv", 'PDL_Indx incs[$CHILD(ndims)];PDL_Indx offs; '),
+ PDL::PP::Rule::Returns->new("IsAffineFlag", "AffinePriv", "PDL_ITRANS_ISAFFINE"),
+
+ PDL::PP::Rule->new("RedoDims", ["EquivPDimExpr","FHdrInfo","_EquivDimCheck"],
+ \&pdimexpr2priv),
+ PDL::PP::Rule->new("RedoDims", ["Identity","FHdrInfo"],
+ \&identity2priv),
+
+ # NOTE: we use the same bit of code for all-good and bad data -
+ # see the Code rule
+#
+ PDL::PP::Rule->new("EquivCPOffsCode", "Identity",
+ "something to do with dataflow between CHILD & PARENT, I think.",
+ \&equivcpoffscode),
+
+ PDL::PP::Rule->new("Code", ["EquivCPOffsCode","BadFlag"],
+ "create Code from EquivCPOffsCode",
+ \&CodefromEquivCPOffsCode),
+
+ PDL::PP::Rule->new("BackCode", ["EquivCPOffsCode","BadFlag"],
+ "create BackCode from EquivCPOffsCode",
+ \&BackCodefromEquivCPOffsCode),
+
+ PDL::PP::Rule::Returns::Zero->new("Affine_Ok", "EquivCPOffsCode"),
+ PDL::PP::Rule::Returns::One->new("Affine_Ok"),
+
+ PDL::PP::Rule::Returns::NULL->new("ReadDataFuncName", "AffinePriv"),
+ PDL::PP::Rule::Returns::NULL->new("WriteBackDataFuncName", "AffinePriv"),
+
+ PDL::PP::Rule::InsertName->new("ReadDataFuncName", 'pdl_${name}_readdata'),
+ PDL::PP::Rule::InsertName->new("CopyFuncName", 'pdl_${name}_copy'),
+ PDL::PP::Rule::InsertName->new("FreeFuncName", 'pdl_${name}_free'),
+ PDL::PP::Rule::InsertName->new("RedoDimsFuncName", 'pdl_${name}_redodims'),
+
+ # There used to be a BootStruct rule which just became copied to the XSBootCode
+ # rule, so it has been removed.
+ #
+ PDL::PP::Rule->new("XSBootCode", ["AffinePriv","VTableName"],
+ sub {return " $_[1].readdata = PDL->readdata_affine;\n" .
+ " $_[1].writebackdata = PDL->writebackdata_affine;\n"}),
+
+# Parameters in the form 'parent and child(this)'.
+# The names are PARENT and CHILD.
+#
+# P2Child implicitly means "no data type changes".
+
+ PDL::PP::Rule->new(["USParNames","USParObjs","FOOFOONoConversion","HaveThreading","NewXSName"],
+ ["P2Child","Name","BadFlag"],
+ \&NewParentChildPars),
+
+ PDL::PP::Rule::InsertName->new("NewXSName", '_${name}_int'),
+
+ PDL::PP::Rule::Returns->new("EquivPThreadIdExpr", "P2Child",
+ '$CTID-$PARENT(ndims)+$CHILD(ndims)'),
+
+ PDL::PP::Rule::Returns::One->new("HaveThreading"),
+
+# Parameters in the 'a(x,y); [o]b(y)' format, with
+# fixed nos of real, unthreaded-over dims.
+#
+# XXX
+# - the need for BadFlag is due to hacked get_xsdatapdecl()
+# in PP/PdlParObj and because the PdlParObjs are created by
+# PDL::PP::Signature (Doug Burke 07/08/00)
+
+ PDL::PP::Rule->new(["USParNames","USParObjs","DimmedPars"], ["Pars","BadFlag"], \&Pars_nft),
+ PDL::PP::Rule->new("DimObjs", ["USParNames","USParObjs"], \&ParObjs_DimObjs),
+
+ # Set CallCopy flag for simple functions (2-arg with 0-dim signatures)
+ # This will copy the $object->copy method, instead of initialize
+ # for PDL-subclassed objects
+ #
+ PDL::PP::Rule->new("CallCopy", ["DimObjs", "USParNames", "USParObjs", "Name", "_P2Child"],
+ sub {
+ my ($dimObj, $USParNames, $USParObjs, $Name, $hasp2c) = @_;
+ return 0 if $hasp2c;
+ my $noDimmedArgs = scalar(keys %$dimObj);
+ my $noArgs = scalar(@$USParNames);
+ if( $noDimmedArgs == 0 and $noArgs == 2 ){
+ # Check for 2-arg functgion with 0-dim signatures
+ # Check to see if output arg is _not_ explicitly typed:
+ my $arg2 = $USParNames->[1];
+ my $ParObj = $USParObjs->{$arg2};
+ if( $ParObj->ctype('generic') eq 'generic'){
+ # print "Calling Copy for function '$Name'\n";
+ return 1;
+ }
+ }
+ return 0;
+ }),
+
+# "Other pars", the parameters which are usually not pdls.
+
+ PDL::PP::Rule->new(["OtherParNames","OtherParTypes"], ["OtherPars","DimObjs"], \&OtherPars_nft),
+
+ PDL::PP::Rule->new(["ParNames","ParObjs"], ["USParNames","USParObjs"], \&sort_pnobjs),
+
+ PDL::PP::Rule->new("DefSyms", "StructName", \&MkDefSyms),
+ PDL::PP::Rule->new("NewXSArgs", ["USParNames","USParObjs","OtherParNames","OtherParTypes"],
+ \&NXArgs),
+
+ PDL::PP::Rule::Returns->new("PMCode", undef),
+
+ PDL::PP::Rule->new("NewXSSymTab", ["DefSyms","NewXSArgs"], \&AddArgsyms),
+
+ PDL::PP::Rule->new("InplaceCode", ["Name","NewXSArgs","USParObjs","_Inplace"],
+ 'Insert code (just after HdrCode) to ensure the routine can be done inplace',
+ \&InplaceCode),
+
+ PDL::PP::Rule::Returns::EmptyString->new("HdrCode", [],
+ 'Code that will be inserted at the end of the autogenerated xs argument processing code VargArgsXSHdr'),
+
+
+ # Create header for variable argument list. Used if no 'other pars' specified.
+ # D. Hunt 4/11/00
+ # make sure it is not used when the GlobalNew flag is set ; CS 4/15/00
+ PDL::PP::Rule->new("VarArgsXSHdr",
+ ["Name","NewXSArgs","USParObjs","OtherParTypes",
+ "PMCode","HdrCode","InplaceCode","_GlobalNew","_CallCopy"],
+ 'XS code to process arguments on stack based on supplied Pars argument to pp_def; GlobalNew has implications how/if this is done',
+ \&VarArgsXSHdr),
+
+ ## Added new line for returning (or not returning) variables. D. Hunt 4/7/00
+ # make sure it is not used when the GlobalNew flag is set ; CS 4/15/00
+ #
+ PDL::PP::Rule->new("VarArgsXSReturn",
+ ["NewXSArgs","USParObjs","_GlobalNew"],
+ "Generate XS trailer for returning output variables",
+ \&VarArgsXSReturn),
+
+ PDL::PP::Rule->new("NewXSHdr", ["NewXSName","NewXSArgs"], \&XSHdr),
+ PDL::PP::Rule->new("NewXSCHdrs", ["NewXSName","NewXSArgs","GlobalNew"], \&XSCHdrs),
+ PDL::PP::Rule->new("NewXSLocals", "NewXSSymTab", \&Sym2Loc),
+
+ PDL::PP::Rule::Returns::Zero->new("IsAffineFlag"),
+ PDL::PP::Rule::Returns::Zero->new("NoPdlThread"),
+
+# hmm, need to check on conditional check here (or rather, other bits of code prob need
+# to include it too; see Ops.xs, PDL::assgn)
+##
+## sub { return (defined $_[0]) ? "int \$BADFLAGCACHE() = 0;" : ""; } ],
+##
+## why have I got a "_HandleBad" condition here? it isn't used in the routine
+## and isn't required to fire the rule. Or should we actually check the value of
+## HandleBad (ie to optimize for code that explicitly doesn't handle bad code)?
+## TO DO: Check assgn in ops for this? Not obvious, or at least we need other
+## bits of code work with us (eg the checking of $BADFLAGCACHE in some other
+## rule)
+##
+## PDL::PP::Rule->new("CacheBadFlagInitNS", "_HandleBad",
+## sub { return $bvalflag ? "\n int \$BADFLAGCACHE() = 0;\n" : ""; }),
+ PDL::PP::Rule->new("CacheBadFlagInitNS",
+ sub { return $bvalflag ? "\n int \$BADFLAGCACHE() = 0;\n" : ""; }),
+# The next rule, if done in place of the above, causes Ops.xs to fail to compile
+# PDL::PP::Rule->new("CacheBadFlagInitNS", "BadFlag",
+# sub { return $_[0] ? "\n int \$BADFLAGCACHE() = 0;\n" : ""; }),
+ PDL::PP::Rule::Substitute::Usual->new("CacheBadFlagInit", "CacheBadFlagInitNS"),
+
+ # need special cases for
+ # a) bad values
+ # b) bad values + GlobalNew
+ # c) bad values + PMCode
+ # - perhaps I should have separate rules (but b and c produce the
+ # same output...)
+ #
+ PDL::PP::Rule->new("NewXSStructInit0",
+ ["NewXSSymTab","VTableName","IsAffineFlag","NoPdlThread"],
+ "Rule to create and initialise the private trans structure",
+ \&MkPrivStructInit),
+
+ PDL::PP::Rule->new("NewXSMakeNow", ["ParNames","NewXSSymTab"], \&MakeNows),
+ PDL::PP::Rule->new("IgnoreTypesOf", "FTypes", sub {return {map {($_,1)} keys %{$_[0]}}}),
+ PDL::PP::Rule::Returns->new("IgnoreTypesOf", {}),
+
+ PDL::PP::Rule->new("NewXSCoerceMustNS", "FTypes", \&make_newcoerce),
+ PDL::PP::Rule::Substitute::Usual->new("NewXSCoerceMust", "NewXSCoerceMustNS"),
+
+ PDL::PP::Rule::Substitute::Usual->new("DefaultFlowCode", "DefaultFlowCodeNS"),
+
+ PDL::PP::Rule->new("NewXSFindDatatypeNS",
+ ["ParNames","ParObjs","IgnoreTypesOf","NewXSSymTab","GenericTypes","_P2Child"],
+ \&find_datatype),
+ PDL::PP::Rule::Substitute::Usual->new("NewXSFindDatatype", "NewXSFindDatatypeNS"),
+
+ PDL::PP::Rule::Returns::EmptyString->new("NewXSTypeCoerce", "NoConversion"),
+
+ PDL::PP::Rule->new("NewXSTypeCoerceNS",
+ ["ParNames","ParObjs","IgnoreTypesOf","NewXSSymTab","_P2Child"],
+ \&coerce_types),
+ PDL::PP::Rule::Substitute::Usual->new("NewXSTypeCoerce", "NewXSTypeCoerceNS"),
+
+ PDL::PP::Rule::Returns::EmptyString->new("NewXSStructInit1", ["ParNames","NewXSSymTab"]),
+
+ PDL::PP::Rule->new("NewXSSetTrans", ["ParNames","ParObjs","NewXSSymTab"], \&makesettrans),
+
+ PDL::PP::Rule->new("ParsedCode",
+ ["Code","_BadCode","ParNames","ParObjs","DimObjs","GenericTypes",
+ "ExtraGenericLoops","HaveThreading","Name"],
+ sub { return PDL::PP::Code->new(@_); }),
+ PDL::PP::Rule->new("ParsedBackCode",
+ ["BackCode","_BadBackCode","ParNames","ParObjs","DimObjs","GenericTypes",
+ "ExtraGenericLoops","HaveThreading","Name"],
+ sub { return PDL::PP::Code->new(@_, undef, undef, 'BackCode2'); }),
+
+# Compiled representations i.e. what the xsub function leaves
+# in the trans structure. By default, copies of the parameters
+# but in many cases (e.g. slice) a benefit can be obtained
+# by parsing the string in that function.
+
+# If the user wishes to specify his own code and compiled representation,
+# The next two definitions allow this.
+# Because of substitutions that will be there,
+# makecompiledrepr et al are array refs, 0th element = string,
+# 1th element = hashref of translated names
+# This makes the objects: type + ...
+#
+ PDL::PP::Rule->new(["CompNames","CompObjs"], "Comp", \&OtherPars_nft),
+ PDL::PP::Rule->new("CompiledRepr", ["CompNames","CompObjs"], \&NT2Decls_p),
+ PDL::PP::Rule::MakeComp->new("MakeCompiledRepr", ["MakeComp","CompNames","CompObjs"],
+ "COMP"),
+
+ PDL::PP::Rule->new("CompCopyCode", ["CompNames","CompObjs","CopyName"], \&NT2Copies_p),
+ PDL::PP::Rule->new("CompFreeCode", ["CompNames","CompObjs"], \&NT2Free_p),
+
+# This is the default
+#
+ PDL::PP::Rule->new("MakeCompiledRepr",
+ ["OtherParNames","OtherParTypes","NewXSSymTab"],
+ \&CopyOtherPars),
+ PDL::PP::Rule->new("CompiledRepr",
+ ["OtherParNames","OtherParTypes"],
+ \&NT2Decls),
+ PDL::PP::Rule->new("CompCopyCode",
+ ["OtherParNames","OtherParTypes","CopyName"],
+ \&NT2Copies_p),
+ PDL::PP::Rule->new("CompFreeCode", ["OtherParNames","OtherParTypes"], \&NT2Free_p),
+
+# Threads
+#
+ PDL::PP::Rule->new(["Priv","PrivIsInc"],
+ ["ParNames","ParObjs","DimObjs","HaveThreading"],
+ \&make_incsizes),
+ PDL::PP::Rule->new("PrivCopyCode",
+ ["ParNames","ParObjs","DimObjs","CopyName","HaveThreading"],
+ \&make_incsize_copy),
+ PDL::PP::Rule->new("PrivFreeCode",
+ ["ParNames","ParObjs","DimObjs","HaveThreading"],
+ "Frees the thread",
+ \&make_incsize_free),
+
+ PDL::PP::Rule::Returns->new("RedoDimsCode", [],
+ 'Code that can be inserted to set the size of output piddles dynamically based on input piddles; is parsed',
+ 'PDL_COMMENT("none")'),
+ PDL::PP::Rule->new("RedoDimsParsedCode",
+ ["RedoDimsCode","_BadRedoDimsCode","ParNames","ParObjs","DimObjs",
+ "GenericTypes","ExtraGenericLoops","HaveThreading","Name"],
+ 'makes the parsed representation from the supplied RedoDimsCode',
+ sub {
+ return 'PDL_COMMENT("no RedoDimsCode")'
+ if $_[0] =~ m|^/[*] none [*]/$|;
+ PDL::PP::Code->new(@_,1); }),
+ PDL::PP::Rule->new("RedoDims",
+ ["ParNames","ParObjs","DimObjs","DimmedPars","RedoDimsParsedCode", '_NoPthread'],
+ 'makes the redodims function from the various bits and pieces',
+ \&make_redodims_thread),
+
+ PDL::PP::Rule::Returns::EmptyString->new("Priv"),
+
+ PDL::PP::Rule->new(["PrivNames","PrivObjs"], "Priv", \&OtherPars_nft),
+ PDL::PP::Rule->new("PrivateRepr", ["PrivNames","PrivObjs"], \&NT2Decls_p),
+ PDL::PP::Rule->new("PrivCopyCode", ["PrivNames","PrivObjs","CopyName"], \&NT2Copies_p),
+
+# avoid clash with freecode above?
+#
+ PDL::PP::Rule->new("NTPrivFreeCode", ["PrivNames","PrivObjs"], \&NT2Free_p),
+
+ PDL::PP::Rule->new("IsReversibleCodeNS", "Reversible", \&ToIsReversible),
+ PDL::PP::Rule::Substitute::Usual->new("IsReversibleCode", "IsReversibleCodeNS"),
+
+ # Needs cleaning up. NewXSStructInit2DJB has been added to make use
+ # of the PDL::PP::Rule::Substitute class.
+ #
+ PDL::PP::Rule::Substitute->new("NewXSStructInit2DJB", "MakeCompiledRepr"),
+ PDL::PP::Rule->new("NewXSStructInit2", "NewXSStructInit2DJB",
+ sub { return "{".$_[0]."}"; }),
+
+ PDL::PP::Rule->new("CopyCodeNS",
+ ["PrivCopyCode","CompCopyCode","StructName","NoPdlThread"],
+ sub {
+ return
+ "$_[2] *__copy = malloc(sizeof($_[2]));\n" .
+ ($_[3] ? "" : "PDL_THR_CLRMAGIC(&__copy->__pdlthread);") .
+" PDL_TR_CLRMAGIC(__copy);
+ __copy->has_badvalue = \$PRIV(has_badvalue);
+ __copy->badvalue = \$PRIV(badvalue);
+ __copy->flags = \$PRIV(flags);
+ __copy->vtable = \$PRIV(vtable);
+ __copy->__datatype = \$PRIV(__datatype);
+ __copy->freeproc = NULL;
+ __copy->__ddone = \$PRIV(__ddone);
+ {int i;
+ for(i=0; i<__copy->vtable->npdls; i++)
+ __copy->pdls[i] = \$PRIV(pdls[i]);
+ }
+ $_[1]
+ if(__copy->__ddone) {
+ $_[0]
+ }
+ return (pdl_trans*)__copy;"; }),
+
+ PDL::PP::Rule->new("FreeCodeNS",
+ ["PrivFreeCode","CompFreeCode","NTPrivFreeCode"],
+ sub {
+ return "
+ PDL_TR_CLRMAGIC(__privtrans);
+ $_[1]
+ if(__privtrans->__ddone) {
+ $_[0]
+ $_[2]
+ }
+ "; }),
+
+ PDL::PP::Rule::Substitute::Usual->new("CopyCode", "CopyCodeNS"),
+ PDL::PP::Rule::Substitute::Usual->new("FreeCode", "FreeCodeNS"),
+ PDL::PP::Rule::Substitute::Usual->new("FooCodeSub", "FooCode"),
+
+ PDL::PP::Rule::Returns::EmptyString->new("NewXSCoerceMust"),
+
+ PDL::PP::Rule::MakeComp->new("NewXSCoerceMustSub1", "NewXSCoerceMust", "FOO"),
+ PDL::PP::Rule::Substitute->new("NewXSCoerceMustSub1d", "NewXSCoerceMustSub1"),
+
+ PDL::PP::Rule->new("NewXSClearThread", "HaveThreading",
+ sub {$_[0] ? "__privtrans->__pdlthread.inds = 0;" : ""}),
+
+ PDL::PP::Rule->new("NewXSFindBadStatusNS",
+ ["BadFlag","_FindBadStatusCode","NewXSArgs","USParObjs","OtherParTypes","NewXSSymTab","Name"],
+ "Rule to find the bad value status of the input piddles",
+ \&findbadstatus),
+
+ # this can be removed once the default bad values are stored in a C structure
+ # (rather than as a perl array in PDL::Types)
+ # which it now is, hence the comments (DJB 07/10/00)
+ # - left around in case we move to per-piddle bad values
+ # - NOTE: now we have the experimental per-piddle bad values I need to remember
+ # what I was doing here
+# [[NewXSCopyBadValues], [BadFlag,NewXSSymTab],
+# "copybadvalues",
+# "Rule to copy the default bad values into the trnas structure"],
+
+ PDL::PP::Rule->new("NewXSCopyBadStatusNS",
+ ["BadFlag","_CopyBadStatusCode","NewXSArgs","USParObjs","NewXSSymTab"],
+ "Rule to copy the bad value status to the output piddles",
+ \©badstatus),
+
+ # expand macros in ...BadStatusCode
+ #
+ PDL::PP::Rule::Substitute::Usual->new("NewXSFindBadStatus", "NewXSFindBadStatusNS"),
+ PDL::PP::Rule::Substitute::Usual->new("NewXSCopyBadStatus", "NewXSCopyBadStatusNS"),
+
+ # Generates XS code with variable argument list. If this rule succeeds, the next rule
+ # will not be executed. D. Hunt 4/11/00
+ #
+ PDL::PP::Rule->new(["NewXSCode","BootSetNewXS","NewXSInPrelude"],
+ ["_GlobalNew","_NewXSCHdrs","VarArgsXSHdr","NewXSLocals",
+ "CacheBadFlagInit",
+ "NewXSStructInit0",
+ "NewXSFindBadStatus",
+ # NewXSCopyBadValues,
+ # NewXSMakeNow, # this is unnecessary since families never got implemented
+ "NewXSFindDatatype","NewXSTypeCoerce",
+ "NewXSStructInit1",
+ "NewXSStructInit2",
+ "NewXSCoerceMustSub1d","_IsReversibleCode","DefaultFlowCode",
+ "NewXSClearThread",
+ "NewXSSetTrans",
+ "NewXSCopyBadStatus",
+ "VarArgsXSReturn"
+ ],
+ "Rule to print out XS code when variable argument list XS processing is enabled",
+ \&mkVarArgsxscat),
+
+ # This rule will fail if the preceding rule succeeds
+ # D. Hunt 4/11/00
+ #
+ PDL::PP::Rule->new(["NewXSCode","BootSetNewXS","NewXSInPrelude"],
+ ["_GlobalNew","_NewXSCHdrs","NewXSHdr","NewXSLocals",
+ "CacheBadFlagInit",
+ "NewXSStructInit0",
+ "NewXSFindBadStatus",
+ # NewXSCopyBadValues,
+ # NewXSMakeNow, # this is unnecessary since families never got implemented
+ "NewXSFindDatatype","NewXSTypeCoerce",
+ "NewXSStructInit1",
+ "NewXSStructInit2",
+ "NewXSCoerceMustSub1d","_IsReversibleCode","DefaultFlowCode",
+ "NewXSClearThread",
+ "NewXSSetTrans",
+ "NewXSCopyBadStatus"
+ ],
+ "Rule to print out XS code when variable argument list XS processing is disabled",
+ \&mkxscat),
+
+ PDL::PP::Rule->new("StructDecl",
+ ["ParNames","ParObjs","CompiledRepr","PrivateRepr","StructName"],
+ \&mkstruct),
+
+ # The RedoDimsSub rule is a bit weird since it takes in the RedoDims target
+ # twice (directly and via RedoDims-PostComp). Can this be cleaned up?
+ #
+ PDL::PP::Rule->new("RedoDims-PreComp", "RedoDims",
+ sub { return $_[0] . ' $PRIV(__ddone) = 1;'; }),
+ PDL::PP::Rule::MakeComp->new("RedoDims-PostComp",
+ ["RedoDims-PreComp", "PrivNames", "PrivObjs"], "PRIV"),
+ PDL::PP::Rule->new("RedoDimsSub",
+ ["RedoDims", "RedoDims-PostComp", "_DimObjs"],
+ sub {
+ my $redodims = $_[0];
+ my $result = $_[1];
+ my $dimobjs = $_[2];
+
+ $result->[1]{"SIZE"} = sub {
+ croak "can't get SIZE of undefined dimension (RedoDims=$redodims)."
+ unless defined $dimobjs->{$redodims};
+ return $dimobjs->{$redodims}->get_size();
+ };
+ return $result;
+ }),
+ PDL::PP::Rule::Substitute->new("RedoDimsSubd", "RedoDimsSub"),
+ PDL::PP::Rule->new("RedoDimsFunc",
+ ["RedoDimsSubd","FHdrInfo","RedoDimsFuncName","_P2Child"],
+ sub {wrap_vfn(@_,"redodims")}),
+
+ PDL::PP::Rule::MakeComp->new("ReadDataSub", "ParsedCode", "FOO"),
+ PDL::PP::Rule::Substitute->new("ReadDataSubd", "ReadDataSub"),
+ PDL::PP::Rule->new("ReadDataFunc",
+ ["ReadDataSubd","FHdrInfo","ReadDataFuncName","_P2Child"],
+ sub {wrap_vfn(@_,"readdata")}),
+
+ PDL::PP::Rule::MakeComp->new("WriteBackDataSub", "ParsedBackCode", "FOO"),
+ PDL::PP::Rule::Substitute->new("WriteBackDataSubd", "WriteBackDataSub"),
+
+ PDL::PP::Rule::InsertName->new("WriteBackDataFuncName", "BackCode", 'pdl_${name}_writebackdata'),
+ PDL::PP::Rule::Returns::NULL->new("WriteBackDataFuncName", "Code"),
+
+ PDL::PP::Rule->new("WriteBackDataFunc",
+ ["WriteBackDataSubd","FHdrInfo","WriteBackDataFuncName","_P2Child"],
+ sub {wrap_vfn(@_,"writebackdata")}),,
+
+ PDL::PP::Rule->new("CopyFunc",
+ ["CopyCode","FHdrInfo","CopyFuncName","_P2Child"],
+ sub {wrap_vfn(@_,"copy")}),
+ PDL::PP::Rule->new("FreeFunc",
+ ["FreeCode","FHdrInfo","FreeFuncName","_P2Child"],
+ sub {wrap_vfn(@_,"free")}),
+
+ PDL::PP::Rule::Returns->new("FoofName", "FooCodeSub", "foomethod"),
+ PDL::PP::Rule->new("FooFunc", ["FooCodeSub","FHdrInfo","FoofName","_P2Child"],
+ sub {wrap_vfn(@_,"foo")}),
+
+ PDL::PP::Rule::Returns::NULL->new("FoofName"),
+
+ PDL::PP::Rule->new("VTableDef",
+ ["VTableName","StructName","RedoDimsFuncName","ReadDataFuncName",
+ "WriteBackDataFuncName","CopyFuncName","FreeFuncName",
+ "ParNames","ParObjs","Affine_Ok","FoofName"],
+ \&def_vtable),
+
+ # Maybe accomplish this with an InsertName rule?
+ PDL::PP::Rule->new('PMFunc', 'Name',
+ 'Sets PMFunc to default symbol table manipulations',
+ sub {
+ my ($name) = @_;
+ $::PDL_IFBEGINWRAP[0].'*'.$name.' = \&'.$::PDLOBJ.
+ '::'.$name.";\n".$::PDL_IFBEGINWRAP[1]
+ }
+ ),
+
+];
+
+sub printtrans {
+ my($bar) = @_;
+ for (qw/StructDecl RedoDimsFunc ReadDataFunc WriteBackFunc
+ VTableDef NewXSCode/) {
+ print "\n\n================================================
+ $_
+=========================================\n",$bar->{$_},"\n" if $::PP_VERBOSE;
+ }
+}
+
+sub translate {
+ my ($pars,$tbl) = @_;
+
+ foreach my $rule (@$tbl) {
+ $rule->apply($pars);
+ }
+
+# print Dumper($pars);
+ print "GOING OUT!\n" if $::PP_VERBOSE;
+ return $pars;
+} # sub: translate()
+
+## End
+#
diff --git a/Basic/Gen/PP/CType.pm b/Basic/Gen/PP/CType.pm
new file mode 100644
index 0000000..c602ecb
--- /dev/null
+++ b/Basic/Gen/PP/CType.pm
@@ -0,0 +1,182 @@
+# Represent any C type.
+# Type contains the size of arrays, which is either constant
+# or resolved (into an object) from resolveobj.
+
+package C::Type;
+use Carp;
+
+# new C::Type(resolveobj,str)
+
+sub new {
+ my $this = bless {},shift;
+ $this->{Resolve} = shift;
+ if(@_) {
+ $this->parsefrom(shift);
+ }
+ return $this;
+}
+
+sub stripptrs {
+ my($this,$str) = @_;
+ if($str =~ /^\s*\w+\s*$/) {
+ $str =~ s/\s//g;
+ $this->{ProtoName} = $str;
+ return [];
+ } else {
+# Now, recall the different C syntaxes. First priority is a pointer:
+ my $decl;
+ if($str =~ /^\s*\*(.*)$/) {
+ $decl = $this->stripptrs($1);
+ unshift @$decl,"PTR";
+ } elsif($str =~ /^\s*\(.*\)\s*$/) {
+# XXX Should try to see if a funccall.
+ return $this->stripptrs($1);
+ } elsif($str =~ /^(.*)\[([^]]+)\]\s*$/) {
+ my $siz = $2;
+ print "ARR($str): ($siz)\n" if $::PP_VERBOSE;
+ $decl = $this->stripptrs($1);
+ unshift @$decl,"ARR($siz)";
+ print "ARR($str): ($siz)\n" if $::PP_VERBOSE;
+ } else {
+ die("Invalid C type '$str'");
+ }
+ return $decl;
+ }
+}
+
+# XXX Correct to *real* parsing. This is only a subset.
+sub parsefrom {
+ my($this,$str) = @_;
+# First, take the words in the beginning
+ $str =~ /^\s*((?:\w+\b\s*)+)([^[].*)$/;
+ my $base = $1; my $decl = $2;
+ my $foo = $this->stripptrs($decl);
+ $this->{Base} = $base;
+ $this->{Chain} = $foo;
+}
+
+sub get_decl {
+ my($this,$name,$opts) = @_;
+ for(@{$this->{Chain}}) {
+ if($_ eq "PTR") {$name = "*$name"}
+ elsif($_ =~/^ARR\((.*)\)$/) {
+ if($opts->{VarArrays2Ptrs}) {
+ $name = "*$name";
+ } else {
+ $name = "($name)[$1]";
+ }
+ }
+ else { confess("Invalid decl") }
+ }
+ return "$this->{Base} $name";
+}
+
+# Useful when parsing argument decls
+sub protoname { return shift->{ProtoName} }
+
+sub get_copy {
+ my($this,$from,$to) = @_;
+ my ($prev,$close);
+ if($#{$this->{Chain}} >= 0) {
+ # strdup loses portability :(
+ return "($to) = malloc(strlen($from)+1); strcpy($to,$from);"
+ if $this->{Base} =~ /^\s*char\s*$/;
+ return "($to) = newSVsv($from);"
+ if $this->{Base} =~ /^\s*SV\s*$/;
+ my $code = $this->get_malloc($to,$from);
+ my ($deref0,$deref1) = ($from,$to);
+ for(@{$this->{Chain}}) {
+ if($_ eq "PTR") {confess("Cannot alloc pointer, must be array");}
+ elsif($_ =~/^ARR\((.*)\)$/) {
+ $no++;
+ $prev .= "
+ if(!$deref0) {$deref1=0;}
+ else {int __malloc_ind_$no;
+ for(__malloc_ind_$no = 0;
+ __malloc_ind_$no < $1;
+ __malloc_ind_$no ++) {";
+ $deref0 = $deref0."[__malloc_ind_$no]";
+ $deref1 = $deref1."[__malloc_ind_$no]";
+ $close .= "}}";
+ } else { confess("Invalid decl $_") }
+ }
+ $code .= "$prev $deref1 = $deref0; $close";
+ return $code;
+ }
+ return "($to) = ($from);";
+}
+
+sub get_free {
+ my($this,$from) = @_;
+ my ($prev,$close);
+ if($#{$this->{Chain}} >= 0) {
+ return "free($from);"
+ if $this->{Base} =~ /^\s*char\s*$/;
+ return "SvREFCNT_dec($from);"
+ if $this->{Base} =~ /^\s*SV\s*$/;
+ my @mallocs;
+ my $str = "{";
+ my $deref = "$from";
+ my $prev = undef;
+ my $close = undef;
+ my $no = 0;
+ for(@{$this->{Chain}}) {
+ $no++;
+ if($no > 1) {croak("Can only free one layer!\n");}
+# if($_ eq "PTR") {confess("Cannot free pointer, must be array ;) (FIX CType.pm)");}
+ return "free($from);\n ";
+ }
+ } else {
+ "";
+ }
+}
+
+sub need_malloc {
+ my($this) = @_;
+ return scalar grep /(ARR|PTR)/,(@{$this->{Chain}})
+}
+
+# Just returns with the array string.
+sub get_malloc {
+ my($this,$assignto) = @_;
+ my $str = "{";
+ my $deref = "$assignto";
+ my $prev = undef;
+ my $close = undef;
+ my $no = 0;
+ for(@{$this->{Chain}}) {
+ if($_ eq "PTR") {confess("Cannot alloc pointer, must be array");}
+ elsif($_ =~/^ARR\((.*)\)$/) {
+ $str .= "$prev $assignto =
+ malloc(sizeof(* $assignto) * $1);
+ ";
+ $no++;
+ $prev = "{int __malloc_ind_$no;
+ for(__malloc_ind_$no = 0;
+ __malloc_ind_$no < $1;
+ __malloc_ind_$no ++) {";
+ $deref = $deref."[__malloc_ind_$no]";
+ $close .= "}}";
+ } else { confess("Invalid decl $_") }
+ }
+ $str .= "}";
+ return $str;
+}
+
+sub getvar {
+}
+
+# Determine if everything constant and can just declare
+sub need_alloc {
+}
+
+sub alloccode {
+}
+
+sub copycode {
+}
+
+sub freecode {
+}
+
+1;
diff --git a/Basic/Gen/PP/Dims.pm b/Basic/Gen/PP/Dims.pm
new file mode 100644
index 0000000..15324a0
--- /dev/null
+++ b/Basic/Gen/PP/Dims.pm
@@ -0,0 +1,82 @@
+##############################################
+package PDL::PP::PdlDimsObj; # Hold more dims
+use Carp;
+
+sub new {
+ my($type) = @_;
+ bless {},$type;
+}
+
+sub get_indobj_make {
+ my($this,$expr) = @_;
+ $expr =~ /^([a-zA-Z0-9]+)(?:=([0-9]+))?$/ or confess "Invalid index expr '$expr'\n";
+ my $name = $1; my $val = $2;
+ my $indobj;
+ if(defined $this->{$name}) {
+ $indobj = $this->{$name};
+ } else {
+ $indobj = PDL::PP::Ind->new($name);
+ $this->{$name}=$indobj;
+ }
+ if(defined $val) { $indobj->add_value($val); }
+ return $indobj;
+}
+
+#####################################################################
+#
+# Encapsulate one index.
+
+package PDL::PP::Ind;
+use Carp;
+
+sub new {
+ my($type,$name) = @_;
+ my $this = bless {Name => $name},$type;
+ return $this;
+}
+
+# set the value of an index, also used by perl level threading
+sub add_value {
+ my($this,$val) = @_;
+ croak("index values for $this->{Name} must be positive")
+ unless $val > 0;
+ if(defined $this->{Value}) {
+ if ($this->{Value} == -1 || $this->{Value} == 1)
+ { $this->{Value} = $val }
+ elsif($val != 1 && $val != $this->{Value}) {
+ croak("For index $this->{Name} conflicting values $this->{Value} and $val given\n");
+ }
+ } else {
+ $this->{Value} = $val;
+ }
+}
+
+# This index will take its size value from outside parameter ...
+sub set_from { my($this,$otherpar) = @_;
+ $this->{From} = $otherpar;
+}
+
+sub name {return (shift)->{Name}}
+
+sub get_decldim { my($this) = @_;
+ return "PDL_Indx __$this->{Name}_size;";
+}
+
+sub get_initdim { my($this) = @_;
+ my $init = '-1';
+ $init = "\$COMP(".$this->{From}->{ProtoName}.")"
+ if $this->{From};
+ $init = $this->{Value} if defined $this->{Value};
+ "\$PRIV(__$this->{Name}_size) = $init;"
+}
+
+sub get_copydim { my($this,$fromsub,$tosub) = @_;
+ my($iname) = "__$this->{Name}_size";
+ &$tosub($iname) ."=". &$fromsub($iname) .";" ;
+}
+
+sub get_size { my($this) = @_;
+ "\$PRIV(__$this->{Name}_size)"
+}
+
+1;
diff --git a/Basic/Gen/PP/PDLCode.pm b/Basic/Gen/PP/PDLCode.pm
new file mode 100644
index 0000000..6c990da
--- /dev/null
+++ b/Basic/Gen/PP/PDLCode.pm
@@ -0,0 +1,1325 @@
+# This file provides a class that parses the Code -member
+# of the PDL::PP code.
+#
+# This is what makes the nice loops go around etc.
+#
+
+package PDL::PP::Code;
+use Carp;
+our @CARP_NOT;
+
+use strict;
+
+# check for bad value support
+#
+use PDL::Config;
+#use vars qw ( $bvalflag $usenan );
+my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
+my $usenan = $PDL::Config{BADVAL_USENAN} || 0;
+
+sub get_pdls {my($this) = @_; return ($this->{ParNames},$this->{ParObjs});}
+
+# we define the method separate_code() at the end of this
+# file, so that it can call the constructors from the classes
+# defined in this file. ugly...
+
+# Do the appropriate substitutions in the code.
+sub new {
+ my($type,$code,$badcode,$parnames,$parobjs,$indobjs,$generictypes,
+ $extrageneric,$havethreading,$name,
+ $dont_add_thrloop, $nogeneric_loop, $backcode ) = @_;
+
+ die "Error: missing name argument to PDL::PP::Code->new call!\n"
+ unless defined $name;
+
+ # simple way of handling bad code check
+ $badcode = undef unless $bvalflag;
+ my $handlebad = defined($badcode);
+
+ # last three arguments may not be supplied
+ # (in fact, the nogeneric_loop argument may never be supplied now?)
+ #
+ # "backcode" is a flag to the PDL::PP::Threadloop class indicating thre threadloop
+ # is for writeback code (typically used for writeback of data from child to parent PDL
+
+ $dont_add_thrloop = 0 unless defined $dont_add_thrloop;
+ $nogeneric_loop = 0 unless defined $nogeneric_loop;
+
+
+ # C++ style comments
+ #
+ # This regexp isn't perfect because it doesn't cope with
+ # literal string constants.
+ #
+ $code =~ s,//.*?\n,,g;
+
+ if ($::PP_VERBOSE) {
+ print "Processing code for $name\n";
+ print "DONT_ADD_THRLOOP!\n" if $dont_add_thrloop;
+ print "EXTRAGEN: {" .
+ join(" ",
+ map { "$_=>" . $$extrageneric{$_}} keys %$extrageneric)
+ . "}\n";
+ print "ParNAMES: ",(join ',',@$parnames),"\n";
+ print "GENTYPES: ", @$generictypes, "\n";
+ print "HandleBad: $handlebad\n";
+ }
+ my $this = bless {
+ IndObjs => $indobjs,
+ ParNames => $parnames,
+ ParObjs => $parobjs,
+ Gencurtype => [], # stack to hold GenType in generic loops
+ types => 0, # hack for PDL::PP::Types/GenericLoop
+ pars => {}, # hack for PDL::PP::NaNSupport/GenericLoop
+ Generictypes => $generictypes, # so that MacroAccess can check it
+ Name => $name,
+ }, $type;
+
+ my $inccode = join '',map {$_->get_incregisters();} (values %{$this->{ParObjs}});
+
+ # First, separate the code into an array of C fragments (strings),
+ # variable references (strings starting with $) and
+ # loops (array references, 1. item = variable.
+ #
+ my ( $threadloops, $coderef, $sizeprivs ) =
+ $this->separate_code( "{$inccode\n$code\n}" );
+
+ # Now, if there is no explicit threadlooping in the code,
+ # enclose everything into it.
+ if(!$threadloops && !$dont_add_thrloop && $havethreading) {
+ print "Adding threadloop...\n" if $::PP_VERBOSE;
+ my $nc = $coderef;
+ if( !$backcode ){ # Normal readbackdata threadloop
+ $coderef = PDL::PP::ThreadLoop->new();
+ }
+ else{ # writebackcode threadloop
+ $coderef = PDL::PP::BackCodeThreadLoop->new();
+ }
+ push @{$coderef},$nc;
+ }
+
+ # repeat for the bad code, then stick good and bad into
+ # a BadSwitch object which creates the necessary
+ # 'if (bad) { badcode } else { goodcode }' code
+ #
+ # NOTE: amalgamate sizeprivs from good and bad code
+ #
+ if ( $handlebad ) {
+ print "Processing 'bad' code...\n" if $::PP_VERBOSE;
+ my ( $bad_threadloops, $bad_coderef, $bad_sizeprivs ) =
+ $this->separate_code( "{$inccode\n$badcode\n}" );
+
+ if(!$bad_threadloops && !$dont_add_thrloop && $havethreading) {
+ print "Adding 'bad' threadloop...\n" if $::PP_VERBOSE;
+ my $nc = $bad_coderef;
+ if( !$backcode ){ # Normal readbackdata threadloop
+ $bad_coderef = PDL::PP::ThreadLoop->new();
+ }
+ else{ # writebackcode threadloop
+ $bad_coderef = PDL::PP::BackCodeThreadLoop->new();
+ }
+ push @{$bad_coderef},$nc;
+ }
+
+ my $good_coderef = $coderef;
+ $coderef = PDL::PP::BadSwitch->new( $good_coderef, $bad_coderef );
+
+ # amalgamate sizeprivs from Code/BadCode segments
+ # (sizeprivs is a simple hash, with each element
+ # containing a string - see PDL::PP::Loop)
+ while ( my ( $bad_key, $bad_str ) = each %$bad_sizeprivs ) {
+ my $str = $$sizeprivs{$bad_key};
+ if ( defined $str ) {
+ die "ERROR: sizeprivs problem in PP/PDLCode.pm (BadVal stuff)\n"
+ unless $str eq $bad_str;
+ }
+ $$sizeprivs{$bad_key} = $bad_str; # copy over
+ }
+
+ } # if: $handlebad
+
+ print "SIZEPRIVSX: ",(join ',',%$sizeprivs),"\n" if $::PP_VERBOSE;
+
+ # Enclose it all in a genericloop.
+ unless ($nogeneric_loop) {
+ # XXX Make genericloop understand denied pointers;...
+ my $nc = $coderef;
+ $coderef = PDL::PP::GenericLoop->new($generictypes,"",
+ [grep {!$extrageneric->{$_}} @$parnames],'$PRIV(__datatype)');
+ push @{$coderef},$nc;
+ }
+
+ # Do we have extra generic loops?
+ # If we do, first reverse the hash:
+ my %glh;
+ for(keys %$extrageneric) {
+ push @{$glh{$extrageneric->{$_}}},$_;
+ }
+ my $no = 0;
+ for(keys %glh) {
+ my $nc = $coderef;
+ $coderef = PDL::PP::GenericLoop->new($generictypes,$no++,
+ $glh{$_},$_);
+ push @$coderef,$nc;
+ }
+
+ # Then, in this form, put it together what we want the code to actually do.
+ print "SIZEPRIVS: ",(join ',',%$sizeprivs),"\n" if $::PP_VERBOSE;
+ $this->{Code} = "{".(join '',values %$sizeprivs).
+ $coderef->get_str($this,[])
+ ."}";
+ $this->{Code};
+
+} # new()
+
+# This sub determines the index name for this index.
+# For example, a(x,y) and x0 becomes [x,x0]
+sub make_loopind { my($this,$ind) = @_;
+ my $orig = $ind;
+ while(!$this->{IndObjs}{$ind}) {
+ if(!((chop $ind) =~ /[0-9]/)) {
+ confess("Index not found for $_ ($ind)!\n");
+ }
+ }
+ return [$ind,$orig];
+}
+
+
+#####################################################################
+#
+# Encapsulate the parsing code objects
+#
+# All objects have two methods:
+# new - constructor
+# get_str - get the string to be put into the xsub.
+
+###########################
+#
+# Encapsulate a block
+
+package PDL::PP::Block;
+
+sub new { my($type) = @_; bless [],$type; }
+
+sub myoffs { return 0; }
+sub myprelude {}
+sub myitem {return "";}
+sub mypostlude {}
+
+sub get_str {
+ my ($this,$parent,$context) = @_;
+ my $str = $this->myprelude($parent,$context);
+ $str .= $this->get_str_int($parent,$context);
+ $str .= $this->mypostlude($parent,$context);
+ return $str;
+}
+
+sub get_str_int {
+ my ( $this, $parent, $context ) = @_;
+
+ my $nth=0;
+ my $str = "";
+ MYLOOP: while(1) {
+ my $it = $this->myitem($parent,$nth);
+ last MYLOOP if $nth and !$it;
+ $str .= $it;
+ $str .= (join '',map {ref $_ ? $_->get_str($parent,$context) : $_}
+ @{$this}[$this->myoffs()..$#{$this}]);
+ $nth++;
+ }
+ return $str;
+} # get_str_int()
+
+###########################
+#
+# Deal with bad code
+# - ie create something like
+# if ( badflag ) { badcode } else { goodcode }
+#
+package PDL::PP::BadSwitch;
+ at PDL::PP::BadSwitch::ISA = "PDL::PP::Block";
+
+sub new {
+ my($type,$good,$bad) = @_;
+ return bless [$good,$bad], $type;
+}
+
+sub get_str {
+ my ($this,$parent,$context) = @_;
+
+ my $good = $this->[0];
+ my $bad = $this->[1];
+
+ my $str = "if ( \$PRIV(bvalflag) ) { PDL_COMMENT(\"** do 'bad' Code **\")\n";
+ $str .= $bad->get_str($parent,$context);
+ $str .= "} else { PDL_COMMENT(\"** else do 'good' Code **\")\n";
+ $str .= $good->get_str($parent,$context);
+ $str .= "}\n";
+
+ return $str;
+}
+
+###########################
+#
+# Encapsulate a loop
+
+package PDL::PP::Loop;
+ at PDL::PP::Loop::ISA = "PDL::PP::Block";
+
+sub new { my($type,$args,$sizeprivs,$parent) = @_;
+ my $this = bless [$args],$type;
+ for(@{$this->[0]}) {
+ print "SIZP $sizeprivs, $_\n" if $::PP_VERBOSE;
+ my $i = $parent->make_loopind($_);
+ $sizeprivs->{$i->[0]} =
+ "register PDL_Indx __$i->[0]_size = \$PRIV(__$i->[0]_size);\n";
+ print "SP :",(join ',',%$sizeprivs),"\n" if $::PP_VERBOSE;
+ }
+ return $this;
+}
+
+sub myoffs { return 1; }
+sub myprelude { my($this,$parent,$context) = @_;
+ my $text = ""; my $i;
+ push @$context, map {
+ $i = $parent->make_loopind($_);
+# Used to be $PRIV(.._size) but now we have it in a register.
+ $text .= "{PDL_COMMENT(\"Open $_\") register PDL_Indx $_;
+ for($_=0; $_<(__$i->[0]_size); $_++) {";
+ $i;
+ } @{$this->[0]};
+ return $text;
+}
+sub mypostlude { my($this,$parent,$context) = @_;
+ splice @$context, - ($#{$this->[0]}+1);
+ return join '',map {"}} PDL_COMMENT(\"Close $_\")"} @{$this->[0]};
+}
+
+###########################
+#
+# Encapsulate a generic type loop
+#
+# we use the value of $parent->{types} [set by a PDL::PP::Types object]
+# to determine whether to define/undefine the THISISxxx macros
+# (makes the xs code easier to read)
+#
+package PDL::PP::GenericLoop;
+ at PDL::PP::GenericLoop::ISA = "PDL::PP::Block";
+
+# Types: BSULFD
+use PDL::Types ':All';
+sub new {
+ my($type,$types,$name,$varnames,$whattype) = @_;
+ bless [(PDL::PP::get_generictyperecs($types)),$name,$varnames,
+ $whattype],$type;
+}
+
+sub myoffs {4}
+
+sub myprelude {
+ my($this,$parent,$context) = @_;
+ push @{$parent->{Gencurtype}},'PDL_undef'; # so that $GENERIC can get at it
+
+ # horrible hack for PDL::PP::NaNSupport
+ if ( $this->[1] ne "" ) {
+ my ( @test ) = keys %{$parent->{pars}};
+ die "ERROR: need to rethink NaNSupport in GenericLoop\n"
+ if $#test != -1;
+ $parent->{pars} = {};
+ }
+
+ my $thisis_loop = '';
+ if ( $parent->{types} ) {
+ $thisis_loop = join '',
+ map {
+ "#undef THISIS$this->[1]_$_\n#define THISIS$this->[1]_$_(a)\n"
+ }
+ (ppdefs);
+ }
+
+ return <<WARNING_EATER;
+PDL_COMMENT("Start generic loop")
+$thisis_loop
+ switch($this->[3]) { case -42: PDL_COMMENT("Warning eater") {(void)1;
+WARNING_EATER
+}
+
+sub myitem {
+ my($this,$parent,$nth) = @_;
+# print "GENERICITEM\n";
+ my $item = $this->[0]->[$nth];
+ if(!$item) {return "";}
+ $parent->{Gencurtype}->[-1] = $item->[1];
+
+ # horrible hack for PDL::PP::NaNSupport
+ if ( $this->[1] ne "" ) {
+ foreach my $parname ( @{$this->[2]} ) {
+ $parent->{pars}{$parname} = $item->[1];
+ }
+ }
+
+ my $thisis_loop = '';
+ if ( $parent->{types} ) {
+ $thisis_loop = (
+ join '',
+ map {
+ "#undef THISIS$this->[1]_$_\n#define THISIS$this->[1]_$_(a)\n";
+ }
+ (ppdefs)
+ ) .
+ "#undef THISIS$this->[1]_$item->[3]\n" .
+ "#define THISIS$this->[1]_$item->[3](a) a\n";
+ }
+
+ return "\t} break; case $item->[0]: {\n".
+ $thisis_loop .
+ (join '',map{
+ # print "DAPAT: '$_'\n";
+ $parent->{ParObjs}{$_}->get_xsdatapdecl($item->[1]);
+ } (@{$this->[2]})) ;
+}
+
+sub mypostlude {
+ my($this,$parent,$context) = @_;
+ pop @{$parent->{Gencurtype}}; # and clean up the Gentype stack
+
+ # horrible hack for PDL::PP::NaNSupport
+ if ( $this->[1] ne "" ) { $parent->{pars} = {}; }
+
+ return "\tbreak;}
+ default:barf(\"PP INTERNAL ERROR! PLEASE MAKE A BUG REPORT\\n\");}\n";
+}
+
+
+###########################
+#
+# Encapsulate a threadloop.
+# There are several different
+
+package PDL::PP::ThreadLoop;
+sub new {
+ return PDL::PP::ComplexThreadLoop->new(@_);
+}
+
+package PDL::PP::SimpleThreadLoop;
+use Carp;
+ at PDL::PP::SimpleThreadLoop::ISA = "PDL::PP::Block";
+our @CARP_NOT;
+
+sub new { my($type) = @_; bless [],$type; }
+sub myoffs { return 0; }
+sub myprelude {my($this,$parent,$context) = @_;
+ my $no;
+ my ($ord,$pdls) = $parent->get_pdls();
+' PDL_COMMENT("THREADLOOPBEGIN")
+ if(PDL->startthreadloop(&($PRIV(__pdlthread)),$PRIV(vtable)->readdata,
+ __privtrans))) return;
+ do {
+ '.(join '',map {"${_}_datap += \$PRIV(__pdlthread).offs[".(0+$no++)."];\n"}
+ @$ord).'
+';
+}
+
+sub mypostlude {my($this,$parent,$context) = @_;
+ my $no;
+ my ($ord,$pdls) = $parent->get_pdls();
+' PDL_COMMENT("THREADLOOPEND")
+ '.(join '',map {"${_}_datap -= \$PRIV(__pdlthread).offs[".(0+$no++)."];\n"}
+ @$ord).'
+ } while(PDL->iterthreadloop(&$PRIV(__pdlthread),0));
+ '
+}
+
+####
+#
+# This relies on PP.pm making sure that initthreadloop always sets
+# up the two first dimensions even when they are not necessary.
+#
+package PDL::PP::ComplexThreadLoop;
+use Carp;
+ at PDL::PP::ComplexThreadLoop::ISA = "PDL::PP::Block";
+our @CARP_NOT;
+
+
+sub new {
+ my $type = shift;
+ bless [],$type;
+}
+sub myoffs { return 0; }
+sub myprelude {
+ my($this,$parent,$context, $backcode) = @_;
+
+ # Set appropriate function from the vtable to supply to threadthreadloop.
+ # Function name from the vtable is readdata for normal code
+ # function name for backcode is writebackdata
+ my $funcName = "readdata";
+ $funcName = "writebackdata" if( $backcode );
+
+
+ my $no; my $no2=-1; my $no3=-1;
+ my ($ord,$pdls) = $parent->get_pdls();
+
+' PDL_COMMENT("THREADLOOPBEGIN")
+ if(PDL->startthreadloop(&($PRIV(__pdlthread)),$PRIV(vtable)->'.$funcName.',
+ __tr)) return;
+ do { register PDL_Indx __tind1=0,__tind2=0;
+ register PDL_Indx __tnpdls = $PRIV(__pdlthread).npdls;
+ register PDL_Indx __tdims1 = $PRIV(__pdlthread.dims[1]);
+ register PDL_Indx __tdims0 = $PRIV(__pdlthread.dims[0]);
+ register PDL_Indx *__offsp = PDL->get_threadoffsp(&$PRIV(__pdlthread));
+ '.(join '',map {$no2++;
+ "register PDL_Indx __tinc0_".($no2)." = \$PRIV(__pdlthread).incs[$no2];"}
+ @$ord).
+ (join '',map {$no3++;
+ "register PDL_Indx __tinc1_".($no3)." = \$PRIV(__pdlthread).incs[__tnpdls+$no3];"}
+ @$ord).
+ (join '',map {"${_}_datap += __offsp[".(0+$no++)."];\n"}
+ @$ord).'
+ for(__tind2=0; __tind2<__tdims1 ; __tind2++) {
+ for(__tind1=0; __tind1<__tdims0 ; __tind1++) {
+ PDL_COMMENT("This is the tightest threadloop. Make sure inside is optimal.")
+';
+}
+
+# Should possibly fold out thread.dims[0] and [1].
+sub mypostlude {my($this,$parent,$context) = @_;
+ my $no; my $no0; my $no1; my $no2; my $no3; my $no4; my $no5;
+ my ($ord,$pdls) = $parent->get_pdls();
+' PDL_COMMENT("THREADLOOPEND")
+ '.(join '',map {"${_}_datap += __tinc0_".(0+$no0++).";\n"}
+ @$ord).'
+ } '
+ .(join '',map {"${_}_datap += __tinc1_".(0+$no1++)."
+ - __tinc0_".(0+$no2++)." *
+ __tdims0;\n"}
+ @$ord).'
+ } '.
+ (join '',map {"${_}_datap -= __tinc1_".(0+$no3++)." *
+ __tdims1;"}
+ @$ord).'
+ '.(join '',map {"${_}_datap -= __offsp[".(0+$no++)."];\n"}
+ @$ord).'
+ } while(PDL->iterthreadloop(&$PRIV(__pdlthread),2));
+ '
+}
+
+# Simple subclass of ComplexThreadLoop to implement writeback code
+#
+#
+package PDL::PP::BackCodeThreadLoop;
+use Carp;
+ at PDL::PP::BackCodeThreadLoop::ISA = "PDL::PP::ComplexThreadLoop";
+our @CARP_NOT;
+
+sub myprelude {
+ my($this,$parent,$context, $backcode) = @_;
+
+ # Set backcode flag if not defined. This will make the parent
+ # myprelude emit proper writeback code
+ $backcode = 1 unless defined($backcode);
+
+ $this->SUPER::myprelude($parent, $context, $backcode);
+}
+
+
+###########################
+#
+# Encapsulate a types() switch
+#
+# horrible hack:
+# set $parent->{types} if we create this object so that
+# PDL::PP::GenericLoop knows to define the THISIS ... macros
+#
+package PDL::PP::Types;
+use Carp;
+use PDL::Types ':All';
+ at PDL::PP::Types::ISA = "PDL::PP::Block";
+our @CARP_NOT;
+
+sub new {
+ my($type,$ts,$parent) = @_;
+ my $types = join '', ppdefs; # BSUL....
+ $ts =~ /[$types]+/ or confess "Invalid type access with '$ts'!";
+ $parent->{types} = 1; # hack for PDL::PP::GenericLoop
+ bless [$ts],$type; }
+sub myoffs { return 1; }
+sub myprelude {
+ my($this,$parent,$context) = @_;
+ return "\n#if ". (join '||',map {"(THISIS_$_(1)+0)"} split '',$this->[0])."\n";
+}
+
+sub mypostlude {my($this,$parent,$context) = @_;
+ "\n#endif\n"
+}
+
+
+###########################
+#
+# Encapsulate an access
+
+package PDL::PP::Access;
+use Carp;
+our @CARP_NOT;
+
+sub new { my($type,$str,$parent) = @_;
+ $str =~ /^\$([a-zA-Z_]\w*)\s*\(([^)]*)\)/ or
+ confess ("Access wrong: '$str'\n");
+ my($pdl,$inds) = ($1,$2);
+ if($pdl =~ /^T/) {new PDL::PP::MacroAccess($pdl,$inds,
+ $parent->{Generictypes},$parent->{Name});}
+ elsif($pdl =~ /^P$/) {new PDL::PP::PointerAccess($pdl,$inds);}
+ elsif($pdl =~ /^PP$/) {new PDL::PP::PhysPointerAccess($pdl,$inds);}
+ elsif($pdl =~ /^SIZE$/) {new PDL::PP::SizeAccess($pdl,$inds);}
+ elsif($pdl =~ /^RESIZE$/) {new PDL::PP::ReSizeAccess($pdl,$inds);}
+ elsif($pdl =~ /^GENERIC$/) {new PDL::PP::GentypeAccess($pdl,$inds);}
+ elsif($pdl =~ /^PDL$/) {new PDL::PP::PdlAccess($pdl,$inds);}
+ elsif(!defined $parent->{ParObjs}{$pdl}) {new PDL::PP::OtherAccess($pdl,$inds);}
+ else {
+ bless [$pdl,$inds],$type;
+ }
+}
+
+sub get_str { my($this,$parent,$context) = @_;
+# print "AC: $this->[0]\n";
+ $parent->{ParObjs}{$this->[0]}->do_access($this->[1],$context)
+ if defined($parent->{ParObjs}{$this->[0]});
+}
+
+###########################
+#
+# Just some other substituted thing.
+
+package PDL::PP::OtherAccess;
+sub new { my($type,$pdl,$inds) = @_; bless [$pdl,$inds],$type; }
+sub get_str {my($this) = @_;return "\$$this->[0]($this->[1])"}
+
+
+###########################
+#
+# used by BadAccess code to know when to use NaN support
+# - the output depends on the value of the
+# BADVAL_USENAN option in perldl.conf
+# == 1 then we use NaN's
+# 0 PDL.bvals.Float/Double
+#
+# note the *horrible hack* for piddles whose type have been
+# specified using the FType option - see GenericLoop.
+# There MUST be a better way than this...
+#
+package PDL::PP::NaNSupport;
+use PDL::Types ':All'; # typefld et al.
+
+# need to be lower-case because of FlagTyped stuff
+#
+# need to be able to handle signatures with fixed types
+# which means parameters like 'int mask()',
+# which means the hack to add 'int' to %use_nan
+#
+my %use_nan =
+ map {(typefld($_,'convertfunc') => typefld($_,'usenan')*$usenan)} typesrtkeys;
+$use_nan{int} = 0;
+
+# original try
+##my %use_nan =
+## map {(typefld($_,'convertfunc') => typefld($_,'usenan')*$usenan)} typesrtkeys;
+
+# Was the following, before new Type "interface"
+# ( byte => 0, short => 0, ushort => 0, long => 0,
+# int => 0, longlong => 0, # necessary for fixed-type piddles (or something)
+# float => $usenan,
+# double => $usenan
+# );
+
+my %set_nan =
+ (
+ float => 'PDL->bvals.Float', PDL_Float => 'PDL->bvals.Float',
+ double => 'PDL->bvals.Double', PDL_Double => 'PDL->bvals.Double',
+ );
+
+sub use_nan ($) {
+ my $type = shift;
+
+ $type =~ s/^PDL_//;
+ $type = lc $type;
+ die "ERROR: Unknown type [$type] used in a 'Bad' macro."
+ unless exists $use_nan{$type};
+ return $use_nan{$type};
+}
+
+sub convert ($$$$$) {
+ my ( $parent, $name, $lhs, $rhs, $opcode ) = @_;
+
+ my $type = $parent->{Gencurtype}[-1];
+ die "ERROR: unable to find type info for $opcode access"
+ unless defined $type;
+
+ # note: gentype may not be sensible because the
+ # actual piddle could have a 'fixed' type
+ die "ERROR: unable to find piddle $name in parent!"
+ unless exists $parent->{ParObjs}{$name};
+ my $pobj = $parent->{ParObjs}{$name};
+
+ # based on code from from PdlParObj::ctype()
+ # - want to handle FlagTplus case
+ # - may not be correct
+ # - extended to include hack to GenericLoop
+ #
+ if ( exists $parent->{pars}{$name} ) {
+ $type = $parent->{pars}{$name};
+ print "#DBG: hacked <$name> to type <$type>\n" if $::PP_VERBOSE;
+ } elsif ( exists $pobj->{FlagTyped} and $pobj->{FlagTyped} ) {
+ $type = $pobj->{Type};
+
+ # this should use Dev.pm - fortunately only worried about double/float here
+ # XXX - do I really know what I'm doing ?
+ if ( $pobj->{FlagTplus} ) {
+ my $gtype = $parent->{Gencurtype}[-1];
+ if ( $gtype eq "PDL_Double" ) {
+ $type = $gtype if $type ne "double";
+ } elsif ( $gtype eq "PDL_Float" ) {
+ $type = $gtype if $type !~ /^(float|double)$/; # note: ignore doubles
+ }
+ }
+ }
+
+ if ( use_nan($type) ) {
+ if ( $opcode eq "SETBAD" ) {
+# $rhs = "(0.0/0.0)";
+ $rhs = $set_nan{$type};
+ } else {
+ $rhs = "0";
+ $lhs = "finite($lhs)";
+ }
+ }
+
+ return ( $lhs, $rhs );
+}
+
+###########################
+#
+# Encapsulate a check on whether a value is good or bad
+# handles both checking (good/bad) and setting (bad)
+#
+# Integer types (BSUL) + floating point when no NaN (FD)
+# $ISBAD($a(n)) -> $a(n) == a_badval
+# $ISGOOD($a()) $a() != a_badval
+# $SETBAD($a()) $a() = a_badval
+#
+# floating point with NaN
+# $ISBAD($a(n)) -> finite($a(n)) == 0
+# $ISGOOD($a()) finite($a()) != 0
+# $SETBAD($a()) $a() = PDL->bvals.Float (or .Double)
+#
+# I've also got it so that the $ on the pdl name is not
+# necessary - so $ISBAD(a(n)) is also accepted, so as to reduce the
+# amount of line noise. This is actually done by the regexp
+# in the separate_code() sub at the end of the file.
+#
+# note:
+# we also expand out $a(n) etc as well here
+#
+# To do:
+# need to allow use of F,D without NaN
+#
+
+package PDL::PP::BadAccess;
+use Carp;
+our @CARP_NOT;
+
+sub new {
+ my ( $type, $opcode, $pdl_name, $inds, $parent ) = @_;
+
+ # trying to avoid auto creation of hash elements
+ my $check = $parent->{ParObjs};
+ die "\nIt looks like you have tried a \$${opcode}() macro on an\n" .
+ " unknown piddle <$pdl_name($inds)>\n"
+ unless exists($check->{$pdl_name}) and defined($check->{$pdl_name});
+
+ return bless [$opcode, $pdl_name, $inds], $type;
+}
+
+our %ops = ( ISBAD => '==', ISGOOD => '!=', SETBAD => '=' );
+
+sub get_str {
+ my($this,$parent,$context) = @_;
+
+ my $opcode = $this->[0];
+ my $name = $this->[1];
+ my $inds = $this->[2];
+
+ print "PDL::PP::BadAccess sent [$opcode] [$name] [$inds]\n" if $::PP_VERBOSE;
+
+ my $op = $ops{$opcode};
+ die "ERROR: unknown check <$opcode> sent to PDL::PP::BadAccess\n"
+ unless defined $op;
+
+ my $obj = $parent->{ParObjs}{$name};
+ die "ERROR: something screwy in PDL::PP::BadAccess (PP/PDLCode.pm)\n"
+ unless defined( $obj );
+
+ my $lhs = $obj->do_access($inds,$context);
+ my $rhs = "${name}_badval";
+
+ ( $lhs, $rhs ) =
+ PDL::PP::NaNSupport::convert( $parent, $name, $lhs, $rhs, $opcode );
+
+ print "DBG: [$lhs $op $rhs]\n" if $::PP_VERBOSE;
+ return "$lhs $op $rhs";
+}
+
+
+###########################
+#
+# Encapsulate a check on whether a value is good or bad
+# handles both checking (good/bad) and setting (bad)
+#
+# Integer types (BSUL) + floating point when no NaN (FD)
+# $ISBADVAR(foo,a) -> foo == a_badval
+# $ISGOODVAR(foo,a) foo != a_badval
+# $SETBADVAR(foo,a) foo = a_badval
+#
+# floating point with NaN
+# $ISBADVAR(foo,a) -> finite(foo) == 0
+# $ISGOODVAR(foo,a) finite(foo) != 0
+# $SETBADVAR(foo,a) foo = PDL->bvals.Float (or .Double)
+#
+
+package PDL::PP::BadVarAccess;
+use Carp;
+our @CARP_NOT;
+
+sub new {
+ my ( $type, $opcode, $var_name, $pdl_name, $parent ) = @_;
+
+ # trying to avoid auto creation of hash elements
+ my $check = $parent->{ParObjs};
+ die "\nIt looks like you have tried a \$${opcode}() macro on an\n" .
+ " unknown piddle <$pdl_name>\n"
+ unless exists($check->{$pdl_name}) and defined($check->{$pdl_name});
+
+ bless [$opcode, $var_name, $pdl_name], $type;
+}
+
+our %ops = ( ISBAD => '==', ISGOOD => '!=', SETBAD => '=' );
+
+sub get_str {
+ my($this,$parent,$context) = @_;
+
+ my $opcode = $this->[0];
+ my $var_name = $this->[1];
+ my $pdl_name = $this->[2];
+
+ print "PDL::PP::BadVarAccess sent [$opcode] [$var_name] [$pdl_name]\n" if $::PP_VERBOSE;
+
+ my $op = $ops{$opcode};
+ die "ERROR: unknown check <$opcode> sent to PDL::PP::BadVarAccess\n"
+ unless defined $op;
+
+ my $obj = $parent->{ParObjs}{$pdl_name};
+ die "ERROR: something screwy in PDL::PP::BadVarAccess (PP/PDLCode.pm)\n"
+ unless defined( $obj );
+
+ my $lhs = $var_name;
+ my $rhs = "${pdl_name}_badval";
+
+ ( $lhs, $rhs ) =
+ PDL::PP::NaNSupport::convert( $parent, $pdl_name, $lhs, $rhs, $opcode );
+
+ print "DBG: [$lhs $op $rhs]\n" if $::PP_VERBOSE;
+ return "$lhs $op $rhs";
+}
+
+
+###########################
+#
+# Encapsulate a check on whether a value is good or bad using PP
+# handles both checking (good/bad) and setting (bad)
+
+# this is only an initial attempt - it will, almost certainly,
+# need more work as more code is converted to handle bad values
+#
+# currently it can only handle cases like
+# $PPISBAD(PARENT,[i]) -> PARENT_physdatap[i] == PARENT_badval
+# etc
+#
+# if we use NaN's, then
+# $PPISBAD(PARENT,[i]) -> finite(PARENT_physdatap[i]) == 0
+# $PPISGOOD(PARENT,[i]) -> finite(PARENT_physdatap[i]) != 0
+# $PPSETBAD(PARENT,[i]) -> PARENT_physdatap[i] = PDL->bvals.Float (or .Double)
+#
+
+package PDL::PP::PPBadAccess;
+use Carp;
+our @CARP_NOT;
+
+sub new {
+ my ( $type, $opcode, $pdl_name, $inds, $parent ) = @_;
+
+ $opcode =~ s/^PP//;
+ bless [$opcode, $pdl_name, $inds], $type;
+}
+
+# PP is stripped in new()
+our %ops = ( ISBAD => '==', ISGOOD => '!=', SETBAD => '=' );
+
+sub get_str {
+ my($this,$parent,$context) = @_;
+
+ my $opcode = $this->[0];
+ my $name = $this->[1];
+ my $inds = $this->[2];
+
+ print "PDL::PP::PPBadAccess sent [$opcode] [$name] [$inds]\n" if $::PP_VERBOSE;
+
+ my $op = $ops{$opcode};
+ die "\nERROR: unknown check <$opcode> sent to PDL::PP::PPBadAccess\n"
+ unless defined $op;
+
+ my $obj = $parent->{ParObjs}{$name};
+ die "\nERROR: ParObjs does not seem to exist for <$name> = problem in PDL::PP::PPBadAccess\n"
+ unless defined $obj;
+
+ my $lhs = $obj->do_physpointeraccess() . "$inds";
+ my $rhs = "${name}_badval";
+
+ ( $lhs, $rhs ) =
+ PDL::PP::NaNSupport::convert( $parent, $name, $lhs, $rhs, $opcode );
+
+ print "DBG: [$lhs $op $rhs]\n" if $::PP_VERBOSE;
+ return "$lhs $op $rhs";
+}
+
+
+###########################
+#
+# Encapsulate a check on whether the state flag of a piddle
+# is set/change this state
+#
+# $PDLSTATEISBAD(a) -> ($PDL(a)->state & PDL_BADVAL) > 0
+# $PDLSTATEISGOOD(a) -> ($PDL(a)->state & PDL_BADVAL) == 0
+#
+# $PDLSTATESETBAD(a) -> ($PDL(a)->state |= PDL_BADVAL)
+# $PDLSTATESETGOOD(a) -> ($PDL(a)->state &= ~PDL_BADVAL)
+#
+
+package PDL::PP::PDLStateBadAccess;
+use Carp;
+our @CARP_NOT;
+
+sub new {
+ my ( $type, $op, $val, $pdl_name, $parent ) = @_;
+
+ # $op is one of: IS SET
+ # $val is one of: GOOD BAD
+
+ # trying to avoid auto creation of hash elements
+ my $check = $parent->{ParObjs};
+ die "\nIt looks like you have tried a \$PDLSTATE${op}${val}() macro on an\n" .
+ " unknown piddle <$pdl_name>\n"
+ unless exists($check->{$pdl_name}) and defined($check->{$pdl_name});
+
+ bless [$op, $val, $pdl_name], $type;
+}
+
+our %ops = (
+ IS => { GOOD => '== 0', BAD => '> 0' },
+ SET => { GOOD => '&= ~', BAD => '|= ' },
+ );
+
+sub get_str {
+ my($this,$parent,$context) = @_;
+
+ my $op = $this->[0];
+ my $val = $this->[1];
+ my $name = $this->[2];
+
+ print "PDL::PP::PDLStateBadAccess sent [$op] [$val] [$name]\n" if $::PP_VERBOSE;
+
+ my $opcode = $ops{$op}{$val};
+ my $type = $op . $val;
+ die "ERROR: unknown check <$type> sent to PDL::PP::PDLStateBadAccess\n"
+ unless defined $opcode;
+
+ my $obj = $parent->{ParObjs}{$name};
+ die "\nERROR: ParObjs does not seem to exist for <$name> = problem in PDL::PP::PDLStateBadAccess\n"
+ unless defined $obj;
+
+ my $state = $obj->do_pdlaccess() . "->state";
+
+ my $str;
+ if ( $op eq 'IS' ) {
+ $str = "($state & PDL_BADVAL) $opcode";
+ } elsif ( $op eq 'SET' ) {
+ $str = "$state ${opcode}PDL_BADVAL";
+ }
+
+ print "DBG: [$str]\n" if $::PP_VERBOSE;
+ return $str;
+}
+
+
+###########################
+#
+# Encapsulate a Pointeraccess
+
+package PDL::PP::PointerAccess;
+use Carp;
+our @CARP_NOT;
+
+sub new { my($type,$pdl,$inds) = @_; bless [$inds],$type; }
+
+sub get_str {my($this,$parent,$context) = @_;
+ croak ("can't access undefined pdl ".$this->[0])
+ unless defined($parent->{ParObjs}{$this->[0]});
+# $parent->{ParObjs}{$this->[0]}->{FlagPaccess} = 1;
+ $parent->{ParObjs}{$this->[0]}->{FlagPhys} = 1;
+ $parent->{ParObjs}{$this->[0]}->do_pointeraccess();
+}
+
+
+###########################
+#
+# Encapsulate a PhysPointeraccess
+
+package PDL::PP::PhysPointerAccess;
+use Carp;
+our @CARP_NOT;
+
+sub new { my($type,$pdl,$inds) = @_; bless [$inds],$type; }
+
+sub get_str {my($this,$parent,$context) = @_;
+ $parent->{ParObjs}{$this->[0]}->do_physpointeraccess()
+ if defined($parent->{ParObjs}{$this->[0]});
+}
+
+###########################
+#
+# Encapsulate a PDLaccess
+
+package PDL::PP::PdlAccess;
+use Carp;
+our @CARP_NOT;
+
+sub new { my($type,$pdl,$inds) = @_; bless [$inds],$type; }
+
+sub get_str {my($this,$parent,$context) = @_;
+ croak ("can't access undefined pdl ".$this->[0])
+ unless defined($parent->{ParObjs}{$this->[0]});
+ $parent->{ParObjs}{$this->[0]}->do_pdlaccess();
+}
+
+###########################
+#
+# Encapsulate a macroaccess
+
+package PDL::PP::MacroAccess;
+use Carp;
+use PDL::Types ':All';
+my $types = join '',ppdefs;
+our @CARP_NOT;
+
+sub new { my($type,$pdl,$inds,$gentypes,$name) = @_;
+ $pdl =~ /^\s*T([A-Z]+)\s*$/ or confess("Macroaccess wrong: $pdl\n");
+ my @ilst = split '',$1;
+ for my $gt (@$gentypes) {
+ warn "$name has no Macro for generic type $gt (has $pdl)\n"
+ unless grep {$gt eq $_} @ilst }
+ for my $mtype (@ilst) {
+ warn "Macro for unsupported generic type identifier $mtype".
+ " (probably harmless)\n"
+ unless grep {$mtype eq $_} @$gentypes;
+ }
+ return bless [$pdl,$inds,$name],
+ $type; }
+
+sub get_str {my($this,$parent,$context) = @_;
+ my ($pdl,$inds,$name) = @{$this};
+ $pdl =~ /^\s*T([A-Z]+)\s*$/
+ or confess("Macroaccess wrong in $name (allowed types $types): was '$pdl'\n");
+ my @lst = split ',',$inds;
+ my @ilst = split '',$1;
+ if($#lst != $#ilst) {confess("Macroaccess: different nos of args $pdl $inds\n");}
+ croak "generic type access outside a generic loop in $name"
+ unless defined $parent->{Gencurtype}->[-1];
+ my $type = mapfld $parent->{Gencurtype}->[-1], 'ctype' => 'ppsym';
+ # print "Type access: $type\n";
+ croak "unknown Type in $name (generic type currently $parent->{Gencurtype}->[-1]"
+ unless defined $type;
+ for (0..$#lst) {
+ return "$lst[$_]" if $ilst[$_] =~ /$type/;
+ }
+}
+
+
+###########################
+#
+# Encapsulate a SizeAccess
+
+package PDL::PP::SizeAccess;
+use Carp;
+our @CARP_NOT;
+
+sub new { my($type,$pdl,$inds) = @_; bless [$inds],$type; }
+
+sub get_str {my($this,$parent,$context) = @_;
+ croak "can't get SIZE of undefined dimension $this->[0]"
+ unless defined($parent->{IndObjs}{$this->[0]});
+ $parent->{IndObjs}{$this->[0]}->get_size();
+}
+
+###########################
+#
+# Encapsulate a ReSizeAccess
+
+package PDL::PP::ReSizeAccess;
+use Carp;
+our @CARP_NOT;
+
+sub new { my($type,$pdl,$inds) = @_; bless [$inds],$type; }
+
+sub get_str {my($this,$parent,$context) = @_;
+ $this->[0] =~ /^([^,]+),([^,]+)$/ or
+ croak "Can't interpret resize str $this->[0]";
+ croak "can't RESIZE undefined dimension $1"
+ unless defined($parent->{IndObjs}{$1});
+
+ my $s = $parent->{IndObjs}{$1}->get_size();
+
+# XXX NOTE: All piddles must be output piddles, there must not be
+# a loop over this var (at all!) etc. Should check for these,
+# this is why not yet documented.
+# FURTHER NOTE: RESIZE DOESN'T COPY DATA PROPERLY!
+
+ my($ord,$pdls) = $parent->get_pdls();
+ my @p;
+
+ for(@$ord) {
+ push @p, $_
+ if $pdls->{$_}->has_dim($1);
+ }
+ print "RESIZEACC: $1 $2, (",(join ',', at p),")\n";
+ warn "RESIZE USED: DO YOU KNOW WHAT YOU ARE DOING???\n";
+
+ return "$s = $2; ".(join '',map {$pdls->{$_}->do_resize($1,$2)} @p);
+}
+
+
+###########################
+#
+# Encapsulate a GentypeAccess
+
+package PDL::PP::GentypeAccess;
+use Carp;
+our @CARP_NOT;
+
+sub new { my($type,$pdl,$inds) = @_; bless [$inds],$type; }
+
+sub get_str {my($this,$parent,$context) = @_;
+ croak "generic type access outside a generic loop"
+ unless defined $parent->{Gencurtype}->[-1];
+ my $type = $parent->{Gencurtype}->[-1];
+ if ($this->[0]) {
+ croak "not a defined name"
+ unless defined($parent->{ParObjs}{$this->[0]});
+ $type = $parent->{ParObjs}{$this->[0]}->ctype($type);
+ }
+ return $type;
+}
+
+########################
+#
+# Type coercion
+#
+# Now, if TYPES:F given and double arguments, will coerce.
+
+package PDL::PP::TypeConv;
+
+# make the typetable from info in PDL::Types
+use PDL::Types ':All';
+my @typetable = map {[$typehash{$_}->{ppsym},
+ $typehash{$_}->{ctype},
+ $typehash{$_}->{numval},
+ ]} typesrtkeys;
+
+sub print_xscoerce { my($this) = @_;
+ $this->printxs("\t__priv->datatype=PDL_B;\n");
+# First, go through all the types, selecting the most general.
+ for(@{$this->{PdlOrder}}) {
+ $this->printxs($this->{Pdls}{$_}->get_xsdatatypetest());
+ }
+# See which types we are allowed to use.
+ $this->printxs("\tif(0) {}\n");
+ for(@{$this->get_generictypes()}) {
+ $this->printxs("\telse if(__priv->datatype <= $_->[2]) __priv->datatype = $_->[2];\n");
+ }
+ $this->{Types} =~ /F/ and (
+ $this->printxs("\telse if(__priv->datatype == PDL_D) {__priv->datatype = PDL_F; PDL_COMMENT(\"Cast double to float\")}\n"));
+ $this->printxs(qq[\telse {croak("Too high type \%d given!\\n",__priv->datatype);}]);
+# Then, coerce everything to this type.
+ for(@{$this->{PdlOrder}}) {
+ $this->printxs($this->{Pdls}{$_}->get_xscoerce());
+ }
+}
+# XXX Should use PDL::Core::Dev;
+
+no strict 'vars';
+
+# STATIC!
+sub PDL::PP::get_generictyperecs { my($types) = @_;
+ my $foo;
+ return [map {$foo = $_;
+ ( grep {/$foo->[0]/} (@$types) ) ?
+ [mapfld($_->[0],'ppsym'=>'sym'),$_->[1],$_->[2],$_->[0]]
+ : ()
+ }
+ @typetable];
+}
+
+sub xxx_get_generictypes { my($this) = @_;
+ return [map {
+ $this->{Types} =~ /$_->[0]/ ? [mapfld($_->[0],'ppsym'=>'sym'),$_->[1],$_->[2],$_->[0]] : ()
+ }
+ @typetable];
+}
+
+
+package PDL::PP::Code;
+
+# my ( $threadloops, $coderef, $sizeprivs ) = $this->separate_code( $code );
+#
+# umm, can't call classes defined later on in code ...
+# hence moved to end of file
+# (rather ugly...)
+#
+# XXX The above statement is almost certainly false. This module is parsed
+# before separate_code is ever called, so all of the class definitions
+# should exist. -- David Mertens, Dec 2 2011
+#
+# separates the code into an array of C fragments (strings),
+# variable references (strings starting with $) and
+# loops (array references, 1. item = variable.
+#
+sub separate_code {
+ ## $DB::single=1;
+ my ( $this, $code ) = @_;
+
+ # First check for standard code errors:
+ catch_code_errors($code);
+
+ my $coderef = new PDL::PP::Block;
+
+ my @stack = ($coderef);
+ my $threadloops = 0;
+ my $sizeprivs = {};
+
+ local $_ = $code;
+## print "Code to parse = [$_]\n" if $::PP_VERBOSE;
+ while($_) {
+ # Parse next statement
+
+ # I'm not convinced that having the checks twice is a good thing,
+ # since it makes it easy (for me at least) to forget to update one
+ # of them
+
+ s/^(.*?) # First, some noise is allowed. This may be bad.
+ ( \$(ISBAD|ISGOOD|SETBAD)\s*\(\s*\$?[a-zA-Z_]\w*\s*\([^)]*\)\s*\) # $ISBAD($a(..)), ditto for ISGOOD and SETBAD
+ |\$PP(ISBAD|ISGOOD|SETBAD)\s*\(\s*[a-zA-Z_]\w*\s*,\s*[^)]*\s*\) # $PPISBAD(CHILD,[1]) etc
+### |\$STATE(IS|SET)(BAD|GOOD)\s*\(\s*[^)]*\s*\) # $STATEISBAD(a) etc
+ |\$PDLSTATE(IS|SET)(BAD|GOOD)\s*\(\s*[^)]*\s*\) # $PDLSTATEISBAD(a) etc
+ |\$[a-zA-Z_]\w*\s*\([^)]*\) # $a(...): access
+ |\bloop\s*\([^)]+\)\s*%\{ # loop(..) %{
+ |\btypes\s*\([^)]+\)\s*%\{ # types(..) %{
+ |\bthreadloop\s*%\{ # threadloop %{
+ |%} # %}
+ |$)//xs
+ or confess("Invalid program $_");
+ my $control = $2;
+ # Store the user code.
+ # Some day we shall parse everything.
+ push @{$stack[-1]},$1;
+
+ if ( $control =~ /^\$STATE/ ) { print "\nDBG: - got [$control]\n\n"; }
+
+ # Then, our control.
+ if($control) {
+ if($control =~ /^loop\s*\(([^)]+)\)\s*%\{/) {
+ my $ob = new PDL::PP::Loop([split ',',$1],
+ $sizeprivs,$this);
+ print "SIZEPRIVSXX: $sizeprivs,",(join ',',%$sizeprivs),"\n" if $::PP_VERBOSE;
+ push @{$stack[-1]},$ob;
+ push @stack,$ob;
+ } elsif($control =~ /^types\s*\(([^)]+)\)\s*%\{/) {
+ my $ob = new PDL::PP::Types($1,$this);
+ push @{$stack[-1]},$ob;
+ push @stack,$ob;
+ } elsif($control =~ /^threadloop\s*%\{/) {
+ my $ob = new PDL::PP::ThreadLoop();
+ push @{$stack[-1]},$ob;
+ push @stack,$ob;
+ $threadloops ++;
+ } elsif($control =~ /^\$PP(ISBAD|ISGOOD|SETBAD)\s*\(\s*([a-zA-Z_]\w*)\s*,\s*([^)]*)\s*\)/) {
+ push @{$stack[-1]},new PDL::PP::PPBadAccess($1,$2,$3,$this);
+ } elsif($control =~ /^\$(ISBAD|ISGOOD|SETBAD)VAR\s*\(\s*([^)]*)\s*,\s*([^)]*)\s*\)/) {
+ push @{$stack[-1]},new PDL::PP::BadVarAccess($1,$2,$3,$this);
+ } elsif($control =~ /^\$(ISBAD|ISGOOD|SETBAD)\s*\(\s*\$?([a-zA-Z_]\w*)\s*\(([^)]*)\)\s*\)/) {
+ push @{$stack[-1]},new PDL::PP::BadAccess($1,$2,$3,$this);
+ # } elsif($control =~ /^\$STATE(IS|SET)(BAD|GOOD)\s*\(\s*([^)]*)\s*\)/) {
+ # push @{$stack[-1]},new PDL::PP::StateBadAccess($1,$2,$3,$this);
+ } elsif($control =~ /^\$PDLSTATE(IS|SET)(BAD|GOOD)\s*\(\s*([^)]*)\s*\)/) {
+ push @{$stack[-1]},new PDL::PP::PDLStateBadAccess($1,$2,$3,$this);
+ } elsif($control =~ /^\$[a-zA-Z_]\w*\s*\([^)]*\)/) {
+ push @{$stack[-1]},new PDL::PP::Access($control,$this);
+ } elsif($control =~ /^%}/) {
+ pop @stack;
+ } else {
+ confess("Invalid control: $control\n");
+ }
+ } else {
+ print("No \$2!\n") if $::PP_VERBOSE;
+ }
+ } # while: $_
+
+ return ( $threadloops, $coderef, $sizeprivs );
+
+} # sub: separate_code()
+
+# This is essentially a collection of regexes that look for standard code
+# errors and croaks with an explanation if they are found.
+sub catch_code_errors {
+ my $code_string = shift;
+
+ # Look for constructs like
+ # loop %{
+ # which is invalid - you need to specify the dimension over which it
+ # should loop
+ report_error('Expected dimension name after "loop" and before "%{"', $1)
+ if $code_string =~ /(.*\bloop\s*%\{)/s;
+
+}
+
+# Report an error as precisely as possible. If they have #line directives
+# in the code string, use that in the reporting; otherwise, use standard
+# Carp mechanisms
+my $line_re = qr/#\s*line\s+(\d+)\s+"([^"]*)"/;
+sub report_error {
+ my ($message, $code) = @_;
+
+ # Just croak if they didn't supply a #line directive:
+ croak($message) if $code !~ $line_re;
+
+ # Find the line at which the error occurred:
+ my $line = 0;
+ my $filename;
+ LINE: foreach (split /\n/, $code) {
+ $line++;
+ if (/$line_re/) {
+ $line = $1;
+ $filename = $2;
+ }
+ }
+
+ die "$message at $filename line $line\n";
+}
+
+# return true
+1;
diff --git a/Basic/Gen/PP/PdlParObj.pm b/Basic/Gen/PP/PdlParObj.pm
new file mode 100644
index 0000000..e03da3b
--- /dev/null
+++ b/Basic/Gen/PP/PdlParObj.pm
@@ -0,0 +1,469 @@
+##############################################
+
+##############################################
+
+package PDL::PP::PdlParObj;
+
+use Carp;
+use PDL::Types;
+
+# check for bad value support
+#
+use PDL::Config;
+my $usenan = $PDL::Config{BADVAL_USENAN} || 0;
+
+our %Typemap = ();
+use PDL::Types ':All';
+
+# build a typemap for our translation purposes
+# again from info in PDL::Types
+for my $typ (typesrtkeys) {
+ $Typemap{typefld($typ,'ppforcetype')} = {
+ Ctype => typefld($typ,'ctype'),
+ Cenum => typefld($typ,'sym'),
+ Val => typefld($typ,'numval'),
+ };
+}
+
+# Try to load Text::Balanced
+my $hasTB = 0;
+eval q{
+ use Text::Balanced;
+ $hasTB = 1;
+};
+
+# split regex $re separated arglist
+# but ignore bracket-protected bits
+# (i.e. text that is within matched brackets)
+# fallback to simple split if we can't find Text::Balanced
+my $prebrackreg = qr/^([^\(\{\[]*)/;
+sub splitprotected ($$) {
+ my ($re,$txt) = @_;
+ return split $re, $txt unless $hasTB;
+ return () if !defined $txt || $txt =~ /^\s*$/;
+ my ($got,$pre) = (1,'');
+ my @chunks = ('');
+ my $ct = 0; # infinite loop protection
+ while ($got && $txt =~ /[({\[]/ && $ct++ < 1000) {
+ # print "iteration $ct\n";
+ ($got,$txt,$pre) =
+ Text::Balanced::extract_bracketed($txt,'{}()[]',$prebrackreg);
+ my @partialargs = split $re, $pre, -1;
+ $chunks[-1] .= shift @partialargs if @partialargs;
+ push @chunks, @partialargs;
+ $chunks[-1] .= $got;
+ }
+ confess "possible infinite parse loop, splitting '$txt' "
+ if $ct >= 1000;
+ my @partialargs = split $re, $txt, -1;
+ $chunks[-1] .= shift @partialargs if @partialargs;
+ push @chunks, @partialargs if @partialargs;
+ # print STDERR "args found: $#chunks\n";
+ # print STDERR "splitprotected $txt on $re: [",join('|', at chunks),"]\n";
+ return @chunks;
+}
+
+# null != [0]
+# - in Core.
+
+#{package PDL;
+# sub isnull {
+# my $this = shift;
+# return ($this->getndims==1 && $this->getdim(0)==0) ? 1:0 }
+#}
+
+1;
+
+#__DATA__
+
+# need for $badflag is due to hacked get_xsdatapdecl()
+# - this should disappear when (if?) things are done sensibly
+#
+my $typeregex = join '|', map {typefld($_,'ppforcetype')} typesrtkeys;
+our $pars_re = qr/^
+ \s*((?:$typeregex)[+]*|)\s* # $1: first option
+ (?:
+ \[([^]]*)\] # $2: The initial [option] part
+ )?\s*
+ (\w+) # $3: The name
+ \(([^)]*)\) # $4: The indices
+/x;
+sub new {
+ my($type,$string,$number,$badflag) = @_;
+ $badflag ||= 0;
+ my $this = bless {Number => $number, BadFlag => $badflag},$type;
+ # Parse the parameter string. Note that the regexes for this match were
+ # originally defined here, but were moved to PDL::PP for FullDoc parsing.
+ $string =~ $pars_re
+ or confess "Invalid pdl def $string (regex $typeregex)\n";
+ my($opt1,$opt2,$name,$inds) = ($1,$2,$3,$4);
+ map {$_ = '' unless defined($_)} ($opt1,$opt2,$inds); # shut up -w
+ print "PDL: '$opt1', '$opt2', '$name', '$inds'\n"
+ if $::PP_VERBOSE;
+# Set my internal variables
+ $this->{Name} = $name;
+ $this->{Flags} = [(split ',',$opt2),($opt1?$opt1:())];
+ for(@{$this->{Flags}}) {
+ /^io$/ and $this->{FlagW}=1 or
+ /^nc$/ and $this->{FlagNCreat}=1 or
+ /^o$/ and $this->{FlagOut}=1 and $this->{FlagCreat}=1 and $this->{FlagW}=1 or
+ /^oca$/ and $this->{FlagOut}=1 and $this->{FlagCreat}=1 and $this->{FlagW}=1
+ and $this->{FlagCreateAlways}=1 or
+ /^t$/ and $this->{FlagTemp}=1 and $this->{FlagCreat}=1 and $this->{FlagW}=1 or
+ /^phys$/ and $this->{FlagPhys} = 1 or
+ /^((?:$typeregex)[+]*)$/ and $this->{Type} = $1 and $this->{FlagTyped} = 1 or
+ confess("Invalid flag $_ given for $string\n");
+ }
+# if($this->{FlagPhys}) {
+# # warn("Warning: physical flag not implemented yet");
+# }
+ if ($this->{FlagTyped} && $this->{Type} =~ s/[+]$// ) {
+ $this->{FlagTplus} = 1;
+ }
+ if($this->{FlagNCreat}) {
+ delete $this->{FlagCreat};
+ delete $this->{FlagCreateAlways};
+ }
+ my @inds = map{
+ s/\s//g; # Remove spaces
+ $_;
+ } split ',', $inds;
+ $this->{RawInds} = [@inds];
+ return $this;
+}
+
+sub name {return (shift)->{Name}}
+
+sub add_inds {
+ my($this,$dimsobj) = @_;
+ $this->{IndObjs} = [map {$dimsobj->get_indobj_make($_)}
+ @{$this->{RawInds}}];
+ my %indcount;
+ $this->{IndCounts} = [
+ map {
+ 0+($indcount{$_->name}++);
+ } @{$this->{IndObjs}}
+ ];
+ $this->{IndTotCounts} = [
+ map {
+ ($indcount{$_->name});
+ } @{$this->{IndObjs}}
+ ];
+}
+
+
+# do the dimension checking for perl level threading
+# assumes that IndObjs have been created
+sub perldimcheck {
+ my ($this,$pdl) = @_;
+ croak ("can't create ".$this->name) if $pdl->isnull &&
+ !$this->{FlagCreat};
+ return 1 if $pdl->isnull;
+ my $rdims = @{$this->{RawInds}};
+ croak ("not enough dimensions for ".$this->name)
+ if ($pdl->threadids)[0] < $rdims;
+ my @dims = $pdl->dims;
+ my ($i,$ind) = (0,undef);
+ for $ind (@{$this->{IndObjs}}) {
+ $ind->add_value($dims[$i++]);
+ }
+ return 0; # not creating
+}
+
+sub finalcheck {
+ my ($this,$pdl) = @_;
+ return [] if $pdl->isnull;
+ my @corr = ();
+ my @dims = $pdl->dims;
+ my ($i,$ind) = (0,undef);
+ for $ind (@{$this->{IndObjs}}) {
+ push @corr,[$i-1,$ind->{Value},$dims[$i-1]] if $dims[$i++] != $ind->{Value};
+ }
+ return [@corr];
+}
+
+# get index sizes for a parameter that has to be created
+sub getcreatedims {
+ my $this = shift;
+ return map
+ { croak "can't create: index size ".$_->name." not initialised"
+ if !defined($_->{Value}) || $_->{Value} < 1;
+ $_->{Value} } @{$this->{IndObjs}};
+}
+
+
+# find the value for a given PDL type
+sub typeval {
+ my $ctype = shift;
+ my @match = grep {$Typemap{$_}->{Ctype} =~ /^$ctype$/} keys(%Typemap);
+ if ($#match < 0) {
+ use Data::Dumper;
+ print Dumper \%Typemap;
+ croak "unknown PDL type '$ctype'" ;
+ }
+ return $Typemap{$match[0]}->{Val};
+}
+
+# return the PDL type for this pdl
+sub ctype {
+ my ($this,$generic) = @_;
+ return $generic unless $this->{FlagTyped};
+ croak "ctype: unknownn type"
+ unless defined($Typemap{$this->{Type}});
+ my $type = $Typemap{$this->{Type}}->{Ctype};
+ if ($this->{FlagTplus}) {
+ $type = $Typemap{$this->{Type}}->{Val} >
+ PDL::PP::PdlParObj::typeval($generic) ?
+ $Typemap{$this->{Type}}->{Ctype} : $generic;
+ }
+ return $type;
+}
+
+# return the enum type for a parobj; it'd better be typed
+sub cenum {
+ my $this = shift;
+ croak "cenum: unknown type [" . $this->{Type} . "]"
+ unless defined($PDL::PP::PdlParObj::Typemap{$this->{Type}});
+ return $PDL::PP::PdlParObj::Typemap{$this->{Type}}->{Cenum};
+}
+
+sub get_nname{ my($this) = @_;
+ "(\$PRIV(pdls[$this->{Number}]))";
+}
+
+sub get_nnflag { my($this) = @_;
+ "(\$PRIV(vtable->per_pdl_flags[$this->{Number}]))";
+}
+
+
+# XXX There might be weird backprop-of-changed stuff for [phys].
+#
+# Have changed code to assume that, if(!$this->{FlagCreat})
+# then __creating[] will == 0
+# -- see make_redodims_thread() in ../PP.pm
+#
+sub get_xsnormdimchecks {
+ my($this) = @_;
+ my $pdl = $this->get_nname;
+ my $iref = $this->{IndObjs};
+ my $ninds = 0+scalar(@$iref);
+
+ my $str = "";
+ $str .= "if(!__creating[$this->{Number}]) {\n" if $this->{FlagCreat};
+
+ # Dimensional Promotion when number of dims is less than required:
+ # Previous warning message now commented out,
+ # which means we only need include the code if $ninds > 0
+ #
+ if ( $ninds > 0 ) {
+ $str .= " if(($pdl)->ndims < $ninds) {\n" .
+ join('', map {
+ my $size = $iref->[$_-1]->get_size();
+ " if (($pdl)->ndims < $_ && $size <= 1) $size = 1;\n"
+ } (1..$ninds))
+# XXX why is this here, commented, and not removed? If re-inserted, be sure to use PDL_COMMENT
+## ." /* \$CROAK(\"Too few dimensions for argument \'$this->{Name}\'\\n\"); */\n"
+ . " }\n";
+ }
+
+ # Now, the real check.
+ my $no = 0;
+ for( @$iref ) {
+ my $siz = $_->get_size();
+ my $dim = "($pdl)->dims[$no]";
+ my $ndims = "($pdl)->ndims";
+ $str .= " if($siz == -1 || ($ndims > $no && $siz == 1)) {\n" .
+ " $siz = $dim;\n" .
+ " } else if($ndims > $no && $siz != $dim) {\n" .
+# XXX should these lines simply be removed? If re-inserted, be sure to use PDL_COMMENT
+# " if($dim == 1) {\n" .
+# " /* Do nothing */ /* XXX Careful, increment? */" .
+# " } else {\n" .
+ " if($dim != 1) {\n" .
+ " \$CROAK(\"Wrong dims\\n\");\n" .
+ " }\n }\n";
+ $no++;
+ }
+
+ $str .= "PDL->make_physical(($pdl));\n" if $this->{FlagPhys};
+
+ if ( $this->{FlagCreat} ) {
+ $str .= "} else {\n";
+
+ # We are creating this pdl.
+ $str .= " PDL_Indx dims[".($ninds+1)."]; PDL_COMMENT(\"Use ninds+1 to avoid smart (stupid) compilers\")";
+ $str .= join "",
+ (map {"dims[$_] = ".$iref->[$_]->get_size().";"} 0 .. $#$iref);
+ my $istemp = $this->{FlagTemp} ? 1 : 0;
+ $str .="\n PDL->thread_create_parameter(&\$PRIV(__pdlthread),$this->{Number},dims,$istemp);\n";
+ $str .= "}";
+ }
+ return $str;
+
+} # sub: get_xsnormdimchecks()
+
+sub get_incname {
+ my($this,$ind) = @_;
+ if($this->{IndTotCounts}[$ind] > 1) {
+ "__inc_".$this->{Name}."_".($this->{IndObjs}[$ind]->name).$this->{IndCounts}[$ind];
+ } else {
+ "__inc_".$this->{Name}."_".($this->{IndObjs}[$ind]->name);
+ }
+}
+
+sub get_incdecls {
+ my($this) = @_;
+ if(scalar(@{$this->{IndObjs}}) == 0) {return "";}
+ (join '',map {
+ "PDL_Indx ".($this->get_incname($_)).";";
+ } (0..$#{$this->{IndObjs}}) ) . ";"
+}
+
+sub get_incregisters {
+ my($this) = @_;
+ if(scalar(@{$this->{IndObjs}}) == 0) {return "";}
+ (join '',map {
+ "register PDL_Indx ".($this->get_incname($_))." = \$PRIV(".
+ ($this->get_incname($_)).");\n";
+ } (0..$#{$this->{IndObjs}}) )
+}
+
+sub get_incdecl_copy {
+ my($this,$fromsub,$tosub) = @_;
+ join '',map {
+ my $iname = $this->get_incname($_);
+ &$fromsub($iname)."=".&$tosub($iname).";";
+ } (0..$#{$this->{IndObjs}})
+}
+
+sub get_incsets {
+ my($this,$str) = @_;
+ my $no=0;
+ (join '',map {
+ "if($str->ndims <= $_ || $str->dims[$_] <= 1)
+ \$PRIV(".($this->get_incname($_)).") = 0; else
+ \$PRIV(".($this->get_incname($_)).
+ ") = ".($this->{FlagPhys}?
+ "$str->dimincs[$_];" :
+ "PDL_REPRINC($str,$_);");
+ } (0..$#{$this->{IndObjs}}) )
+}
+
+# Print an access part.
+sub do_access {
+ my($this,$inds,$context) = @_;
+ my $pdl = $this->{Name};
+# Parse substitutions into hash
+ my %subst = map
+ {/^\s*(\w+)\s*=>\s*(\S*)\s*$/ or confess "Invalid subst $_\n"; ($1,$2)}
+ splitprotected ',',$inds;
+# Generate the text
+ my $text;
+ $text = "(${pdl}_datap)"."[";
+ $text .= join '+','0',map {
+ $this->do_indterm($pdl,$_,\%subst,$context);
+ } (0..$#{$this->{IndObjs}});
+ $text .= "]";
+# If not all substitutions made, the user probably made a spelling
+# error. Barf.
+ if(scalar(keys %subst) != 0) {
+ confess("Substitutions left: ".(join ',',keys %subst)."\n");
+ }
+ return "$text PDL_COMMENT(\"ACCESS($access)\") ";
+}
+
+sub has_dim {
+ my($this,$ind) = @_;
+ my $h = 0;
+ for(@{$this->{IndObjs}}) {
+ $h++ if $_->name eq $ind;
+ }
+ return $h;
+}
+
+sub do_resize {
+ my($this,$ind,$size) = @_;
+ my @c;my $index = 0;
+ for(@{$this->{IndObjs}}) {
+ push @c,$index if $_->name eq $ind; $index ++;
+ }
+ my $pdl = $this->get_nname;
+ return (join '',map {"$pdl->dims[$_] = $size;\n"} @c).
+ "PDL->resize_defaultincs($pdl);PDL->allocdata($pdl);".
+ $this->get_xsdatapdecl(undef,1);
+}
+
+sub do_pdlaccess {
+ my($this) = @_;
+ return '$PRIV(pdls['.$this->{Number}.'])';
+
+}
+
+sub do_pointeraccess {
+ my($this) = @_;
+ return $this->{Name}."_datap";
+}
+
+sub do_physpointeraccess {
+ my($this) = @_;
+ return $this->{Name}."_physdatap";
+}
+
+sub do_indterm { my($this,$pdl,$ind,$subst,$context) = @_;
+# Get informed
+ my $indname = $this->{IndObjs}[$ind]->name;
+ my $indno = $this->{IndCounts}[$ind];
+ my $indtot = $this->{IndTotCounts}[$ind];
+# See if substitutions
+ my $substname = ($indtot>1 ? $indname.$indno : $indname);
+ my $incname = $indname.($indtot>1 ? $indno : "");
+ my $index;
+ if(defined $subst->{$substname}) {$index = delete $subst->{$substname};}
+ else {
+# No => get the one from the nearest context.
+ for(reverse @$context) {
+ if($_->[0] eq $indname) {$index = $_->[1]; last;}
+ }
+ }
+ if(!defined $index) {confess "Access Index not found: $pdl, $ind, $indname
+ On stack:".(join ' ',map {"($_->[0],$_->[1])"} @$context)."\n" ;}
+# return "\$PRIV(".($this->get_incname($ind))."*". $index .")";
+# Now we have them in register variables -> no PRIV
+ return ("(".($this->get_incname($ind))."*".
+ "PP_INDTERM(".$this->{IndObjs}[$ind]->get_size().", $index))");
+}
+
+# XXX hacked to create a variable containing the bad value for
+# this piddle.
+# This is a HACK (Doug Burke 07/08/00)
+# XXX
+#
+sub get_xsdatapdecl {
+ my($this,$genlooptype,$asgnonly) = @_;
+ my $type;
+ my $pdl = $this->get_nname;
+ my $flag = $this->get_nnflag;
+ my $name = $this->{Name};
+ $type = $this->ctype($genlooptype) if defined $genlooptype;
+ my $declini = ($asgnonly ? "" : "\t$type *");
+ my $cast = ($type ? "($type *)" : "");
+# ThreadLoop does this for us.
+# return "$declini ${name}_datap = ($cast((${_})->data)) + (${_})->offs;\n";
+
+ my $str = "$declini ${name}_datap = ($cast(PDL_REPRP_TRANS($pdl,$flag)));\n" .
+ "$declini ${name}_physdatap = ($cast($pdl->data));\n";
+
+ # assuming we always need this
+ # - may not be true - eg if $asgnonly ??
+ # - not needed for floating point types when using NaN as bad values
+ if ( $this->{BadFlag} and $type and
+ ( $usenan == 0 or $type !~ /^PDL_(Float|Double)$/ ) ) {
+ my $cname = $type; $cname =~ s/^PDL_//;
+# $str .= "\t$type ${name}_badval = PDL->bvals.$cname;\n";
+ $str .= "\t$type ${name}_badval = ($type) PDL->get_pdl_badvalue($pdl);\n";
+ }
+
+ return "$str\n";
+}
+
+1;
diff --git a/Basic/Gen/PP/Signature.pm b/Basic/Gen/PP/Signature.pm
new file mode 100644
index 0000000..e287f4c
--- /dev/null
+++ b/Basic/Gen/PP/Signature.pm
@@ -0,0 +1,142 @@
+=head1 NAME
+
+PDL::PP::Signature - Internal module to handle signatures
+
+=head1 DESCRIPTION
+
+Internal module to handle signatures
+
+=head1 SYNOPSIS
+
+ use PDL::PP::Signature;
+
+
+=cut
+
+package PDL::PP::Signature;
+use PDL::PP::PdlParObj;
+use PDL::PP::Dims;
+use Carp;
+use SelfLoader;
+
+ at ISA = qw/ SelfLoader /;
+
+# we pass on $bvalflag to the PdlParObj's created by parse
+# (a hack for PdlParObj::get_xsdatapdecl() which should
+# disappear when (if?) things are done sensibly)
+#
+sub new {
+ my ($type,$str,$bvalflag) = @_;
+ $bvalflag ||= 0;
+ my ($namep,$objp) = parse($str,$bvalflag);
+ return bless {Names => $namep, Objects => $objp},$type;
+}
+
+*with = \&new;
+
+1;
+
+=head1 AUTHOR
+
+Copyright (C) Tuomas J. Lukka 1997 (lukka at husc.harvard.edu) and by Christian
+Soeller (c.soeller at auckland.ac.nz).
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
+
+__DATA__
+
+# Eliminate whitespace entries
+sub nospacesplit {map {/^\s*$/?():$_} split $_[0],$_[1]}
+
+
+sub names {
+ my $this = shift;
+ return $this->{Names};
+}
+
+sub objs {
+ my $this = shift;
+ return $this->{Objects};
+}
+
+# Pars -> ParNames, Parobjs
+sub parse {
+ my($str,$bvalflag) = @_;
+ my @entries = nospacesplit ';',$str;
+ my $number = 0;
+ my %objs; my @names; my $obj;
+ for (@entries) {
+ $obj = PDL::PP::PdlParObj->new($_,"PDL_UNDEF_NUMBER",$bvalflag);
+ push @names,$obj->name;
+ $objs{$obj->name} = $obj;
+ }
+ return (\@names,\%objs,1);
+}
+
+
+sub realdims {
+ my $this = shift;
+ my @rds = map { scalar @{$this->{Objects}->{$_}->{RawInds}}}
+ @{$this->{Names}};
+# print "Realdims are ".join(',', at rds)."\n";
+ return \@rds;
+}
+
+sub creating {
+ my $this = shift;
+# my @creat = map { $this->{Objects}->{$_}->{FlagCreat} ? 1:0 }
+# @{$this->{Names}};
+# print "Creating is ".join(',', at creat)."\n";
+ croak "you must perform a checkdims before calling creating"
+ unless defined $this->{Create};
+ return $this->{Create};
+}
+
+sub getinds {
+ my $this = shift;
+ $this->{Dims} = new PDL::PP::PdlDimsObj;
+ for (@{$this->{Names}}) {
+ $this->{Objects}->{$_}->add_inds($this->{Dims});
+ }
+}
+
+sub resetinds {
+ my $this = shift;
+ for (keys %{$this->{Dims}}) {$this->{Dims}->{$_}->{Value} = undef;}
+}
+sub checkdims {
+ my $this = shift;
+ $this->getinds; # we have to recreate to keep defaults currently
+ my $n = @{$this->{Names}};
+ croak "not enough pdls to match signature" unless $#_ >= $n-1;
+ my @pdls = @_[0..$n-1];
+ if ($PDL::debug) { print "args: ".
+ join(' ,',map { "[".join(',',$_->dims)."]," } @pdls)
+ . "\n"}
+ my $i = 0;
+ my @creating = map $this->{Objects}->{$_}->perldimcheck($pdls[$i++]),
+ @{$this->{Names}};
+ $i = 0;
+ for (@{$this->{Names}}) {
+ push @creating, $this->{Objects}->{$_}->getcreatedims
+ if $creating[$i++];
+ }
+ $this->{Create} = \@creating;
+ $i = 0;
+ my $corr = 0;
+ for (@{$this->{Names}}) {
+ $corr = $this->{Objects}->{$_}->finalcheck($pdls[$i++]);
+ next unless $#$corr>-1;
+ my ($j,$str) = (0,"");
+ for (@$corr) {$str.= ":,"x($_->[0]-$j)."(0),*$_->[1],";
+ $j=$_->[0]+1 }
+ chop $str;
+ $_[$i-1] = $pdls[$i-1]->slice($str);
+ }
+}
diff --git a/Basic/Gen/PP/Struct.pm b/Basic/Gen/PP/Struct.pm
new file mode 100644
index 0000000..8e8d83c
--- /dev/null
+++ b/Basic/Gen/PP/Struct.pm
@@ -0,0 +1,5 @@
+# Just container for many C::Types
+
+package C::StructType;
+
+package C::StructObj;
diff --git a/Basic/Gen/PP/SymTab.pm b/Basic/Gen/PP/SymTab.pm
new file mode 100644
index 0000000..748f7cf
--- /dev/null
+++ b/Basic/Gen/PP/SymTab.pm
@@ -0,0 +1,71 @@
+# For making sure that no conflicts occur
+
+package SymTab;
+use Carp;
+
+sub new {
+ my($type,%ids) = @_;
+ my($this) = bless {
+ Id2Sym => {},
+ Sym2Id => {},
+ IsPar => {},
+ }, $type;
+ $this->add_ids(%ids);
+ $this;
+}
+
+sub add_ids {
+ my($this,%hash) = @_;
+ for(keys %hash) {
+ $this->{Id2Sym}{$_} = $hash{$_};
+
+ # This usually sets the 'undef' key to whatever is in $_, because the
+ # object in $hash{$_} is usually a scalar, not an array. I know this
+ # becuase this function is called by AddArgsyms in PDL::PP, which
+ # conructs the %hash to be
+ #
+ # sym_name => sym_name
+ #
+ # The only other place that invokes this code is the constructor,
+ # which itself is called by MkDefSyms in PDL::PP. That invocation is
+ # called with %hash set as
+ #
+ # _PDL_ThisTrans => ["__privtrans",C::Type->new(undef,"$_[0] *foo")]
+ #
+ # AFAIK, Sym2Id is never used anywhere in the code generation, and
+ # the setting of undef throws warning messages, so I am going to
+ # comment-out this line for now. --David Mertens, 12-12-2011
+ #$this->{Sym2Id}{$hash{$_}->[0]} = $_;
+ }
+}
+
+sub add_params {
+ my($this,%hash) = @_;
+ $this->add_ids(%hash);
+ for(keys %hash) {
+ $this->{IsPar}{$_} = 1;
+ }
+}
+
+sub decl_locals {
+ my($this) = @_;
+ my $str;
+ for(keys %{$this->{Id2Sym}}) {
+ if(!$this->{IsPar}{$_}) {
+ $str .= $this->{Id2Sym}{$_}[1]
+ ->get_decl($this->{Id2Sym}{$_}[0]).";";
+ }
+ }
+ $str;
+}
+
+sub get_params {
+}
+
+sub get_symname {
+ my($this,$id) = @_;
+ confess "Symbol not found: $id\n" if(!defined($this->{Id2Sym}{$id}));
+ return $this->{Id2Sym}{$id}[0];
+}
+
+1;
diff --git a/Basic/Gen/PP/Var.pm b/Basic/Gen/PP/Var.pm
new file mode 100644
index 0000000..fec6004
--- /dev/null
+++ b/Basic/Gen/PP/Var.pm
@@ -0,0 +1,13 @@
+
+package C::Var;
+
+# Get one from C::Type;
+
+sub alloccode {
+}
+
+sub copycode {
+}
+
+sub freecode {
+}
diff --git a/Basic/Gen/PP/XS.pm b/Basic/Gen/PP/XS.pm
new file mode 100644
index 0000000..bdc054d
--- /dev/null
+++ b/Basic/Gen/PP/XS.pm
@@ -0,0 +1,17 @@
+package XS;
+
+sub mkproto {
+ my($name,$pars) = @_;
+ my $shortpars = join ',',map {$_->[0]} @$pars;
+ my $longpars = join "\n",map {"\t".$_->[1]->get_decl($_->[0])} @$pars;
+ return<<END;
+
+void
+$name($shortpars)
+$longpars
+END
+
+
+}
+
+1;
diff --git a/Basic/Gen/PP/dump.pp b/Basic/Gen/PP/dump.pp
new file mode 100644
index 0000000..585828c
--- /dev/null
+++ b/Basic/Gen/PP/dump.pp
@@ -0,0 +1,101 @@
+# These are suspended for now...
+
+# use blib; # For Types.pm
+# require './PP.pm';
+
+open PP, "PP.pm" or die "can't open PP.pm";
+$str = join '',<PP>;
+$str =~ m|\@PDL::PP::EXPORT\s*=\s*qw/([^/]*)/|s;
+$str = $1; # Get the contents of the qw//
+
+
+$pm = '
+=head1 NAME
+
+PDL::PP::Dump -- dump pp_xxx calls to stdout
+
+=head1 SYNOPSIS
+
+ perl -MPDL::PP::Dump Basic/Ops/ops.pd
+
+=head1 DESCRIPTION
+
+The most basic PP script debugger thinkable.
+
+=head1 AUTHOR
+
+Christian Soeller <c.soeller at auckland.ac.nz> .
+
+=cut
+
+package PDL::PP::Dump;
+
+use Exporter;
+ at ISA = Exporter;
+
+ at EXPORT = qw('.$str.q|);
+
+my $typecheck =0;
+
+sub import {
+ my ($pack,$arg) = @_;
+ $typecheck =1 if defined $arg && $arg =~ /^typecheck$/i;
+ @_ = ($pack);
+ goto &Exporter::import;
+}
+
+sub printargs {
+ my $name = shift;
+ print "$name(";
+ print join ',',map("'$_'", at _);
+ print ");\n";
+}
+
+for (@EXPORT) {
+ if ($_ !~ /pp_def/) {
+ my $def = "sub $_ { printargs($_,\@_) unless \$typecheck }";
+ # print "defining =>\n$def\n";
+ eval($def);
+ }
+}
+
+sub pp_def {
+ my($name,%hash) = @_;
+ use PDL::Types ':All';
+
+ if ($typecheck) {
+ my @alltypes = ppdefs; my $jointypes = join '', at alltypes;
+ my $types = exists $hash{GenericTypes} ? $hash{GenericTypes} : [@alltypes];
+ for my $key (qw/Code BackCode/) {
+ if (exists $hash{$key}) {
+ while ($hash{$key} =~ s/\$T([a-zA-Z]+)\s*\(([^)]*)\)//) {
+ my ($mactypes,$alternatives) = ($1,$2);
+ # print "type macro ($mactypes) in $name\n";
+ my @mactypes = split '', $mactypes;
+ print "$name has extra types in macro: $mactypes vs $jointypes\n"
+ unless $mactypes =~ /^\s*[$jointypes]+\s*$/;
+ for my $gt (@$types) {
+ print "$name has no Macro for generic type $gt (has $mactypes)"
+ unless grep {$gt eq $_} @mactypes;
+ }
+ }
+ }
+ }
+ } else {
+ print "pp_def('$name',\n";
+ foreach (keys(%hash)) {
+ if ($_ =~ /(Generic)*Types/) {
+ print "$_ => [" . join(',',@{$hash{$_}}) . "]\n";
+ } else {
+ print "$_ =>\n'".$hash{$_}."',\n";
+ }
+ }
+ print ");\n";
+ }
+}
+
+1;
+|;
+
+print $pm;
+
diff --git a/Basic/Gen/pptemplate.PL b/Basic/Gen/pptemplate.PL
new file mode 100644
index 0000000..3de2ab5
--- /dev/null
+++ b/Basic/Gen/pptemplate.PL
@@ -0,0 +1,196 @@
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate. Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries. Thus you write
+# $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
+
+unlink $file if -f $file;
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+ eval 'exec perl -S \$0 "\$@"'
+ if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+##########################################################################
+# Here starts the actual script
+
+sub names {
+ my ($module) = @_;
+ my $name = (split '::', $module)[-1];
+ my $pdname = lc $name . '.pd';
+ return ($name,$pdname);
+}
+
+sub pdtmpl {
+ return join '', <DATA>;
+}
+
+sub pdMakefile {
+ my ($module,$name,$pdname,$internal) = @_;
+ my $coredev = $internal ? 'PDL::Core::Dev->import()' : 'use PDL::Core::Dev';
+ my $int = $internal ? '_int' : '';
+ return << "EOM";
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+$coredev;
+\@pack = (["$pdname",$name,$module]);
+
+\%hash = pdlpp_stdargs$int(\@::pack);
+# \$hash{'OPTIMIZE'} = '-g'; # If you want to debug, uncomment this.
+# \$hash{INC} .= " -I/usr/local/include"; # uncomment as required
+# \$hash{LIBS}[0] .= " -L/usr/local/lib -lmylib "; # uncomment as required
+
+WriteMakefile(\%hash);
+
+# Add genpp rule
+# add other makefile additions as required (see also ExtUtils::MakeMaker)
+sub MY::postamble {
+ pdlpp_postamble$int(\@::pack);
+}
+
+EOM
+}
+
+sub usage {
+ die << "EOU";
+
+usage: $0 [option] modulename
+
+Options:
+ -i internal mode - template for module that is in the PDL distribution
+
+EOU
+
+}
+
+use Getopt::Std;
+getopts('i');
+
+usage unless $#ARGV > -1;
+($module,$name,$pdname) = ($ARGV[0],names $ARGV[0]);
+
+die "Makefile.PL exists; move out of the way if you want to proceed"
+ if -f 'Makefile.PL';
+die "$pdname exists; move out of the way if you want to proceed"
+ if -f $pdname;
+
+open $mkfl, '>Makefile.PL' or die "couldn't open Makefile.PL for writing";
+open $pdfl, ">$pdname" or die "couldn't open $pdname for writing";
+
+print $mkfl pdMakefile($module,$name,$pdname,$opt_i);
+close $mkfl;
+
+print $pdfl pdtmpl;
+close $pdfl;
+
+=head1 NAME
+
+pptemplate - script to generate Makefile.PL and PP file skeleton
+
+=head1 SYNOPSIS
+
+ # generate Makefile.PL and mymodule.pd in CWD
+ pptemplate PDL::MyModule;
+
+
+=head1 DESCRIPTION
+
+The B<pptemplate> script is the easiest way to start a new module
+for PDL that contains PP code (see also L<PDL::PP>). The usage is simply
+
+ pptemplate modulename;
+
+As a result pptemplate will generate a perl Makefile for the new
+module (F<Makefile.PL>) that contains the minimal structure to
+generate a module from PP code and also a skeleton file
+for your new module.
+
+The file will be called F<mymod.pd> if you called C<pptemplate> as
+
+ pptemplate PDL::CleverAlgs::Mymod;
+
+I suppose you can work out the naming rule C<;)>. If not resort to
+experimentation or the source code.
+
+C<pptemplate> will refuse to overwrite existing files of the same name
+to avoid accidents. Move them out of the way if you really want to scrap
+them.
+
+=head2 Options
+
+Currently there is only the C<-i> option which switches C<pptemplate>
+into the so called I<internal mode>. It should only be used when you
+are starting a new module within the main PDL tree that is supposed to
+be part of the PDL distribution and the normal PDL build process, e.g.
+
+ cd PDL/IO;
+ mkdir Mpthree; cd Mpthree;
+ pptemplate -i PDL::IO::Mpthree;
+
+=head1 BUGS
+
+Maybe C<;)>.
+Feedback and bug reports are welcome.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2001, Christian Soeller. All Rights Reserved.
+This module is free software. It may be used, redistributed
+and/or modified under the same terms as PDL itself
+(see L<http://pdl.perl.org>).
+
+=cut
+
+__END__
+# template auto generated by pptemplate
+# uncomment commands, copy and fill in as needed
+# see also the PDL::PP manpage
+
+# pp_bless(''); # package namespace of pp_def'ed functions
+ # defaults to 'PDL'
+
+# pp_add_boot(''); # code to add to the XS boot section
+
+# pp_addhdr(''); # add C code to the section preceding
+ # the first MODULE keyword
+
+# pp_addpm(''); # add perl code to the perl module that PP will create
+
+# pp_add_exported(''); # add the list of function names
+ # to the list of exported functions
+
+# pp_addxs(''); # add plain XS code to the XS section
+
+# pp_add_isa(qw//); # inheritance business: add arglist to modules @ISA
+
+# pp_def('name', Code => ''); # minimal pp_def to define function
+
+pp_done(); # you will need this to finish pp processing
+
+!NO!SUBS!
diff --git a/Basic/Lite.pm b/Basic/Lite.pm
new file mode 100644
index 0000000..085232e
--- /dev/null
+++ b/Basic/Lite.pm
@@ -0,0 +1,52 @@
+=head1 NAME
+
+PDL::Lite - minimum PDL module OO loader
+
+=head1 DESCRIPTION
+
+Loads the smallest possible set of modules for
+PDL to work, without importing an functions in
+to the current namespace. This is the absolute
+minimum set for PDL.
+
+Although no functions are defined (apart from
+a few always exported by L<PDL::Core|PDL::Core>) you can still
+use method syntax, viz:
+
+ $x->wibble(42);
+
+=head1 SYNOPSIS
+
+ use PDL::Lite; # Is equivalent to the following:
+
+ use PDL::Core '';
+ use PDL::Ops '';
+ use PDL::Primitive '';
+ use PDL::Ufunc '';
+ use PDL::Basic '';
+ use PDL::Slices '';
+ use PDL::Bad '';
+ use PDL::Version;
+ use PDL::Lvalue;
+
+=cut
+
+# Load the fundamental PDL packages, no imports
+# Because there are no imports, we do not need
+# the usual 'eval in the user's namespace' routine.
+
+use PDL::Core '';
+use PDL::Ops '';
+use PDL::Primitive '';
+use PDL::Ufunc '';
+use PDL::Basic '';
+use PDL::Slices '';
+use PDL::Bad '';
+use PDL::Version ; # Doesn't export anything - no need for ''
+use PDL::Lvalue;
+
+$PDL::Lite::VERSION = $PDL::Version::VERSION;
+
+;# Exit with OK status
+
+1;
diff --git a/Basic/LiteF.pm b/Basic/LiteF.pm
new file mode 100644
index 0000000..4d46f1f
--- /dev/null
+++ b/Basic/LiteF.pm
@@ -0,0 +1,59 @@
+=head1 NAME
+
+PDL::LiteF - minimum PDL module function loader
+
+=head1 DESCRIPTION
+
+Loads the smallest possible set of modules for
+PDL to work, making the functions available in
+the current namespace. If you want something even
+smaller see the L<PDL::Lite|PDL::Lite> module.
+
+=head1 SYNOPSIS
+
+ use PDL::LiteF; # Is equivalent to the following:
+
+ use PDL::Core;
+ use PDL::Ops;
+ use PDL::Primitive;
+ use PDL::Ufunc;
+ use PDL::Basic;
+ use PDL::Slices;
+ use PDL::Bad;
+ use PDL::Version;
+ use PDL::Lvalue;
+
+=cut
+
+# get the version:
+use PDL::Version;
+$PDL::LiteF::VERSION = $PDL::Version::VERSION;
+
+
+# Load the fundamental PDL packages, with imports
+
+sub PDL::LiteF::import {
+
+my $pkg = (caller())[0];
+eval <<EOD;
+
+package $pkg;
+
+use PDL::Core;
+use PDL::Ops;
+use PDL::Primitive;
+use PDL::Ufunc;
+use PDL::Basic;
+use PDL::Slices;
+use PDL::Bad;
+use PDL::Lvalue;
+
+EOD
+
+die $@ if $@;
+
+}
+
+;# Exit with OK status
+
+1;
diff --git a/Basic/Lvalue.pm b/Basic/Lvalue.pm
new file mode 100644
index 0000000..19e790c
--- /dev/null
+++ b/Basic/Lvalue.pm
@@ -0,0 +1,92 @@
+=head1 NAME
+
+PDL::Lvalue - declare PDL lvalue subs
+
+=head1 DESCRIPTION
+
+Declares a subset of PDL functions so that they
+can be used as lvalue subs. In particular, this allows
+simpler constructs such as
+
+ $a->slice(',(0)') .= 1;
+
+instead of the clumsy
+
+ (my $tmp = $a->slice(',(0)')) .= 1;
+
+This will only work if your perl supports lvalue subroutines
+(i.e. versions >= v5.6.0). Note that lvalue subroutines
+are currently regarded experimental.
+
+=head1 SYNOPSIS
+
+ use PDL::Lvalue; # automatically done with all PDL loaders
+
+=head1 FUNCTIONS
+
+=cut
+
+package PDL::Lvalue;
+
+# list of functions that can be used as lvalue subs
+# extend as necessary
+my @funcs = qw/ clump diagonal dice dice_axis dummy flat
+ index index2d indexND indexNDb mslice mv
+ nslice nslice_if_pdl nnslice polyfillv px range
+ rangeb reshape sever slice where whereND xchg /;
+
+my $prots = join "\n", map {"use attributes 'PDL', \\&PDL::$_, 'lvalue';"}
+ @funcs;
+
+=head2 subs
+
+=for ref
+
+test if routine is a known PDL lvalue sub
+
+=for example
+
+ print "slice is an lvalue sub" if PDL::Lvalue->subs('slice');
+
+returns the list of PDL lvalue subs if no routine name is given, e.g.
+
+ @lvfuncs = PDL::Lvalue->subs;
+
+It can be used in scalar context to find out if your
+PDL has lvalue subs:
+
+ print 'has lvalue subs' if PDL::Lvalue->subs;
+
+=cut
+
+sub subs {
+ my ($type,$func) = @_;
+ if (defined $func) {
+ $func =~ s/^.*:://;
+ return ($^V and $^V >= 5.006007) && scalar grep {$_ eq $func} @funcs;
+ } else {
+ return ($^V and $^V >= 5.006007) ? @funcs : ();
+ }
+}
+
+# print "defining lvalue subs:\n$prots\n";
+
+eval << "EOV" if ($^V and $^V >= 5.006007);
+{ package PDL;
+ no warnings qw(misc);
+ $prots
+}
+EOV
+
+=head1 AUTHOR
+
+Copyright (C) 2001 Christian Soeller (c.soeller at auckland.ac.nz). All
+rights reserved. There is no warranty. You are allowed to redistribute
+this software / documentation under certain conditions. For details,
+see the file COPYING in the PDL distribution. If this file is
+separated from the PDL distribution, the copyright notice should be
+included in the file.
+
+=cut
+
+1;
diff --git a/Basic/Makefile.PL b/Basic/Makefile.PL
new file mode 100644
index 0000000..0ba934f
--- /dev/null
+++ b/Basic/Makefile.PL
@@ -0,0 +1,51 @@
+
+require 'Core/Dev.pm'; PDL::Core::Dev->import();
+
+use ExtUtils::MakeMaker;
+
+
+$defstartup = 'default.perldlrc';
+if ($^O =~ /win32/i) {
+ $defstartup = 'default.pdl';
+ system("copy default.perldlrc $defstartup");
+}
+
+# # See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# # the contents of the Makefile that is written.
+
+my @pm_names = qw ( PDL.pm Lite.pm LiteF.pm AutoLoader.pm Options.pm
+ Matrix.pm Reduce.pm Lvalue.pm Constants.pm);
+
+my %pm = map { $h = '$(INST_LIBDIR)/';
+ $h .= 'PDL/' if $_ !~ /PDL.pm$/;
+ ( $_, $h . $_ );
+ } ( @pm_names, $defstartup );
+
+my %man3pods = map { $h = '$(INST_MAN3DIR)/';
+ $h .= 'PDL::' if $_ !~ /PDL.pm$/;
+ ( $_, $h . substr($_,0,length($_)-3) . '.$(MAN3EXT)' );
+ } @pm_names;
+
+WriteMakefile(
+ 'NAME' => 'PDL',
+ 'VERSION_FROM' => 'Core/Version.pm',
+ 'PM' => \%pm,
+ 'MAN3PODS' => \%man3pods,
+ 'DIR' => ['Pod','Gen','SourceFilter','Core','Bad','Ops','Ufunc',
+ 'Primitive','Slices','Test','Math','MatrixOps','Complex'],
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
+# modify clean method not to delete files named 'core'
+# (required for MacOSX, where "Core" and "core" are
+# indistinguishable)
+package MY; # so that "SUPER" works right
+
+sub clean {
+ my $inherited = shift->SUPER::clean(@_);
+ $inherited =~ s/\s+core\s/ /;
+ # print STDERR "processed list :\n$inherited\n";
+ $inherited;
+}
+package main;
+
diff --git a/Basic/Math/Makefile.PL b/Basic/Math/Makefile.PL
new file mode 100644
index 0000000..34b265d
--- /dev/null
+++ b/Basic/Math/Makefile.PL
@@ -0,0 +1,176 @@
+
+# Makefile.PL for PDL::Primitive module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+use File::Basename;
+use Config;
+
+require File::Spec;
+$fs = 'File::Spec';
+sub cdir { return $fs->catdir(@_)}
+sub cfile { return $fs->catfile(@_)}
+
+sub is_sys_func {
+ my ( $code, $libs ) = @_;
+ trylink( '', qq{#include "$dir/mconf.h"}, $code, $libs );
+}
+
+PDL::Core::Dev->import();
+
+# Files for each routine (.c assumed)
+
+%source = qw( acosh acosh
+ asinh asinh
+ atanh atanh
+ erf ndtr
+ erfc ndtr
+ j0 j0
+ j1 j1
+ jn jn
+ y0 j0
+ y1 j1
+ yn yn
+ erfi ndtri
+ ndtri ndtri
+ rint rint
+ nan quiet_nan
+ infinity infinity
+ polyroots cpoly
+ );
+ at keys = sort keys %source;
+%included = ();
+
+# test for library features
+my (@sfuncs) = qw(nan infinity);
+my (@ufuncs2) = qw(acosh asinh atanh erf erfc rint);
+my (@besufuncs) = qw(j0 j1 y0 y1);
+my (@besbifuncs) = qw(jn yn);
+my ($libs) = $^O =~ /MSWin/ ? '' : $^O =~ /cygwin/ ? getcyglib('m') : '-lm';
+if ($^O eq 'solaris' or $^O eq 'sunos') {
+ # try to guess where sunmath is
+ my @d = split /:+/, $ENV{LD_LIBRARY_PATH};
+ my $ok = 0;
+ for my $d (@d) {
+ if (-e "$d/libsunmath.so" or -e "$d/libsunmath.a" ) {
+ $libs = "-lsunmath $libs";
+ $ok = 1;
+ last;
+ }
+ }
+ if (!$ok) {
+ print "libsunmath not found in LD_LIBRARY_PATH: looking elsewhere\n";
+
+ # get root directory of compiler; may be off of there
+ my @dirs = ();
+ foreach my $p ( split(':', $ENV{'PATH'} ) )
+ {
+ next unless -e "$p/$Config{cc}";
+ push @dirs, dirname($p) . '/lib';
+ last;
+ }
+
+ push @dirs, '/opt/SUNWspro/lib'; # default location if all else fails
+ for my $d ( @dirs ) {
+ if (-e "$d/libsunmath.so") {
+ $libs = "-R$d -L$d -lsunmath $libs";
+ $ok = 1;
+ last;
+ }
+ if (-e "$d/libsunmath.a") {
+ $libs = "-L$d -lsunmath $libs";
+ $ok = 1;
+ last;
+ }
+ }
+ }
+
+ if (!$ok) {
+ print "Couldn't find sunmath library in standard places\n\n";
+ print "If you can find libsunmath.a or libsunmath.so\n";
+ print "please let us know at pdl-porters\@jach.hawaii.edu\n\n";
+ }
+}
+
+# Test for absence of unary functions
+
+use Cwd;
+$mmdir = $mdir = cdir 'Basic','Math';
+$mmdir =~ s/\\/\\\\/g;
+$dir = $fs->canonpath(cwd);
+$dir = cdir $dir, $mdir unless $dir =~ /$mmdir$/;
+
+my $tempd = $PDL::Config{TEMPDIR} ||
+ die "TEMPDIR not found in %PDL::Config";
+
+foreach (@sfuncs) {
+ $source{$_} = 'system' if is_sys_func( "$_();", $libs );
+}
+
+foreach (@ufuncs2) {
+ $source{$_} = 'system' if is_sys_func( "$_(1.);", $libs );
+}
+
+# Test for absence of besfuncs
+
+foreach (@besufuncs) {
+ if ( is_sys_func( "$_(1.);", $libs ) ) {
+ $source{$_} = 'system';
+ next if $_ ne 'y0';
+# Need to test for buggy glibc
+ open (RES,"$te |");
+ my ($n) = <RES>;
+ close RES;
+# print "Done y0 test, received $n\n";
+ $n /= 0.088257; # This _should_ be the answer
+ $n -= 1.;
+ if ($n*$n > 1e-3) {
+ delete $source{$_};
+ delete $source{'yn'};
+ $source{'fixy0'} = 'j0';
+ $source{'fixyn'} = 'yn';
+ @keys = sort keys %source;
+ }
+ }
+}
+
+foreach (@besbifuncs) {
+ next if ! exists $source{$_}; # May have been deleted in buggy case
+ $source{$_} = 'system' if is_sys_func( "$_(1,1.);", $libs );
+}
+
+print "Source of functions\nSystem: ";
+foreach (@keys) {
+ print " $_" if $source{$_} eq 'system';
+}
+print "\nDistribution:";
+foreach (@keys) {
+ print " $_" if $source{$_} ne 'system';
+}
+print "\n\n";
+
+ at pack = (["math.pd",Math,PDL::Math]);
+%hash = pdlpp_stdargs_int(@::pack);
+
+%seen = (); # Build object file list
+foreach $func (@keys) {
+ $file = $source{$func};
+ next if $file eq 'system';
+ die "File for function $func not found\n" if $file eq '';
+ $hash{OBJECT} .= " $file\$(OBJ_EXT)" unless $seen{$file}++;
+ $hash{DEFINE} .= ' -DMY_'.uc($func);
+}
+
+# Add support routines
+$hash{OBJECT} .= " const\$(OBJ_EXT) mtherr\$(OBJ_EXT) polevl\$(OBJ_EXT)";
+
+$hash{LIBS}->[0] .= " $libs";
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
+
diff --git a/Basic/Math/NOTES b/Basic/Math/NOTES
new file mode 100644
index 0000000..499e12b
--- /dev/null
+++ b/Basic/Math/NOTES
@@ -0,0 +1,41 @@
+Notes
+-----
+
+Fixed to -DUNK (for reasons given below), but tried to get as much
+information on system specifics as possible from header files (may
+need to reconfigure mconf.h on systems other than Linux/Sun/Dec).
+
+Altered handling of nan and infinity to try to provide a consistent
+interface through function calls (system dependencies go in
+Makefile.PL, mconf.h: infinity.c and quiet_nan.c may need more obscure
+fallback ways of generating Inf and NaN for clever-clever compilers).
+
+More work will now be necessary to include extra cephes routines, but
+should be easier to configure what's there for new OSs.
+
+RJRW 29/10/98
+
+- added linalg.shar
+
+TJL 5/1/98
+
+Cephes lib config
+-----------------
+
+I leave the default as -DUNK (mconf.h). This is
+OK as all it means is that the important constants are in
+floating point format rather than binary hex.
+The only advantage of the latter is that it is exact, however
+we prefer portability to exactly the same numbers at the
+epsilon level. (After all PDL also uses system routines).
+
+We can ignore the comments about BIGENDIAN - it is not used
+in any of the .c files we have taken from cephes, **AT LEAST
+SO FAR**.
+
+The PP code includes protos.h whether or not the system
+routines are used. Since the prototypes for system
+and cephes versions should be the same this is not a big
+deal.
+
+KGB 28/11/97
diff --git a/Basic/Math/acosh.c b/Basic/Math/acosh.c
new file mode 100644
index 0000000..1542bfc
--- /dev/null
+++ b/Basic/Math/acosh.c
@@ -0,0 +1,105 @@
+/* acosh.c
+ *
+ * Inverse hyperbolic cosine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, acosh();
+ *
+ * y = acosh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic cosine of argument.
+ *
+ * If 1 <= x < 1.5, a rational approximation
+ *
+ * sqrt(z) * P(z)/Q(z)
+ *
+ * where z = x-1, is used. Otherwise,
+ *
+ * acosh(x) = log( x + sqrt( (x-1)(x+1) ).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 1,3 30000 4.2e-17 1.1e-17
+ * IEEE 1,3 30000 4.6e-16 8.7e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * acosh domain |x| < 1 NAN
+ *
+ */
+
+/* acosh.c */
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+
+/* acosh(z) = sqrt(x) * R(x), z = x + 1, interval 0 < x < 0.5 */
+
+#include "mconf.h"
+
+static double P[] = {
+ 1.18801130533544501356E2,
+ 3.94726656571334401102E3,
+ 3.43989375926195455866E4,
+ 1.08102874834699867335E5,
+ 1.10855947270161294369E5
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+ 1.86145380837903397292E2,
+ 4.15352677227719831579E3,
+ 2.97683430363289370382E4,
+ 8.29725251988426222434E4,
+ 7.83869920495893927727E4
+};
+
+#ifndef ANSIPROT
+double log(), sqrt(), polevl(), p1evl();
+#endif
+extern double LOGE2;
+
+double acosh(x)
+double x;
+{
+double a, z;
+
+if( x < 1.0 )
+ {
+ mtherr( "acosh", DOMAIN );
+ return(quiet_nan());
+ }
+
+if( x > 1.0e8 )
+ {
+ if( !finite(x) )
+ return(x);
+ return( log(x) + LOGE2 );
+ }
+
+z = x - 1.0;
+
+if( z < 0.5 )
+ {
+ a = sqrt(z) * (polevl(z, P, 4) / p1evl(z, Q, 5) );
+ return( a );
+ }
+
+a = sqrt( z*(x+1.0) );
+return( log(x + a) );
+}
diff --git a/Basic/Math/asinh.c b/Basic/Math/asinh.c
new file mode 100644
index 0000000..c7c98c0
--- /dev/null
+++ b/Basic/Math/asinh.c
@@ -0,0 +1,106 @@
+/* asinh.c
+ *
+ * Inverse hyperbolic sine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, asinh();
+ *
+ * y = asinh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic sine of argument.
+ *
+ * If |x| < 0.5, the function is approximated by a rational
+ * form x + x**3 P(x)/Q(x). Otherwise,
+ *
+ * asinh(x) = log( x + sqrt(1 + x*x) ).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -3,3 75000 4.6e-17 1.1e-17
+ * IEEE -1,1 30000 3.7e-16 7.8e-17
+ * IEEE 1,3 30000 2.5e-16 6.7e-17
+ *
+ */
+
+/* asinh.c */
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright 1984, 1995 by Stephen L. Moshier
+*/
+
+
+#include "mconf.h"
+
+static double P[] = {
+-4.33231683752342103572E-3,
+-5.91750212056387121207E-1,
+-4.37390226194356683570E0,
+-9.09030533308377316566E0,
+-5.56682227230859640450E0
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+ 1.28757002067426453537E1,
+ 4.86042483805291788324E1,
+ 6.95722521337257608734E1,
+ 3.34009336338516356383E1
+};
+
+#ifndef ANSIPROT
+double log(), sqrt(), polevl(), p1evl();
+#endif
+extern double LOGE2;
+
+double asinh(xx)
+double xx;
+{
+double a, z, x;
+int sign;
+
+#ifdef MINUSZERO
+if( xx == 0.0 )
+ return(xx);
+#endif
+if( xx < 0.0 )
+ {
+ sign = -1;
+ x = -xx;
+ }
+else
+ {
+ sign = 1;
+ x = xx;
+ }
+
+if( x > 1.0e8 )
+ {
+ if(!finite(x))
+ return(xx);
+ return( sign * (log(x) + LOGE2) );
+ }
+
+z = x * x;
+if( x < 0.5 )
+ {
+ a = ( polevl(z, P, 4)/p1evl(z, Q, 4) ) * z;
+ a = a * x + x;
+ if( sign < 0 )
+ a = -a;
+ return(a);
+ }
+
+a = sqrt( z + 1.0 );
+return( sign * log(x + a) );
+}
diff --git a/Basic/Math/atanh.c b/Basic/Math/atanh.c
new file mode 100644
index 0000000..ac0a514
--- /dev/null
+++ b/Basic/Math/atanh.c
@@ -0,0 +1,95 @@
+/* atanh.c
+ *
+ * Inverse hyperbolic tangent
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, atanh();
+ *
+ * y = atanh( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns inverse hyperbolic tangent of argument in the range
+ * MINLOG to MAXLOG.
+ *
+ * If |x| < 0.5, the rational form x + x**3 P(x)/Q(x) is
+ * employed. Otherwise,
+ * atanh(x) = 0.5 * log( (1+x)/(1-x) ).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -1,1 50000 2.4e-17 6.4e-18
+ * IEEE -1,1 30000 1.9e-16 5.2e-17
+ *
+ */
+
+/* atanh.c */
+
+
+/*
+Cephes Math Library Release 2.3: March, 1995
+Copyright (C) 1987, 1995 by Stephen L. Moshier
+*/
+
+#include "mconf.h"
+
+static double P[] = {
+-8.54074331929669305196E-1,
+ 1.20426861384072379242E1,
+-4.61252884198732692637E1,
+ 6.54566728676544377376E1,
+-3.09092539379866942570E1
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+-1.95638849376911654834E1,
+ 1.08938092147140262656E2,
+-2.49839401325893582852E2,
+ 2.52006675691344555838E2,
+-9.27277618139601130017E1
+};
+#ifndef ANSIPROT
+double fabs(), log(), polevl(), p1evl();
+#endif
+
+double atanh(x)
+double x;
+{
+double s, z;
+
+#ifdef MINUSZERO
+if( x == 0.0 )
+ return(x);
+#endif
+z = fabs(x);
+if( z >= 1.0 )
+ {
+ if( x == 1.0 )
+ return( infinity() );
+ if( x == -1.0 )
+ return( -infinity() );
+ mtherr( "atanh", DOMAIN );
+ return( quiet_nan() );
+ }
+
+if( z < 1.0e-7 )
+ return(x);
+
+if( z < 0.5 )
+ {
+ z = x * x;
+ s = x + x * z * (polevl(z, P, 4) / p1evl(z, Q, 5));
+ return(s);
+ }
+
+return( 0.5 * log((1.0+x)/(1.0-x)) );
+}
diff --git a/Basic/Math/const.c b/Basic/Math/const.c
new file mode 100644
index 0000000..f299df0
--- /dev/null
+++ b/Basic/Math/const.c
@@ -0,0 +1,80 @@
+/* Some constant values -- */
+
+#include "mconf.h"
+/* Many of these values should ideally come from <float.h> or
+ <values.h>, which should be included in mconf.h if required */
+
+#ifdef DBL_EPSILON
+double MACHEP = DBL_EPSILON;
+#else
+double MACHEP = 1.11022302462515654042E-16; /* 2**-53 */
+#endif
+
+#if defined DBL_MIN
+double UFLOWTHRESH = DBL_MIN;
+#elif defined MINDOUBLE
+double UFLOWTHRESH = MINDOUBLE;
+#else
+double UFLOWTHRESH = 2.22507385850720138309E-308; /* 2**-1022 */
+#endif
+
+#ifdef DBL_MAX_10_EXP
+double MAXLOG = DBL_MAX_10_EXP;
+#else
+double MAXLOG = 7.08396418532264106224E2; /* log 2**1022 */
+#endif
+
+#ifdef DBL_MIN_10_EXP
+double MINLOG = DBL_MIN_10_EXP;
+#else
+double MINLOG = -7.08396418532264106224E2; /* log 2**-1022 */
+#endif
+
+#if defined MAXDOUBLE
+double MAXNUM = MAXDOUBLE;
+#elif defined DBL_MAX
+double MAXNUM = DBL_MAX;
+#else
+double MAXNUM = 1.79769313486231570815E308; /* 2**1024*(1-MACHEP) */
+#endif
+
+#ifdef M_PI
+#ifndef PI
+double PI = M_PI;
+#endif
+double PIO2 = M_PI/2;
+double PIO4 = M_PI/4;
+double THPIO4 = 0.75*M_PI;
+double TWOOPI = 2/M_PI;
+#else
+#ifndef PI
+double PI = 3.14159265358979323846; /* pi */
+#endif
+double PIO2 = 1.57079632679489661923; /* pi/2 */
+double PIO4 = 7.85398163397448309616E-1; /* pi/4 */
+double THPIO4 = 2.35619449019234492885; /* 3*pi/4 */
+double TWOOPI = 6.36619772367581343075535E-1; /* 2/pi */
+#endif
+
+#ifdef M_SQRT2
+double SQRT2 = M_SQRT2; /* sqrt(2) */
+double SQRTH = M_SQRT2/2; /* sqrt(2)/2 */
+#else
+double SQRT2 = 1.41421356237309504880; /* sqrt(2) */
+double SQRTH = 7.07106781186547524401E-1; /* sqrt(2)/2 */
+#endif
+
+double SQ2OPI = 7.9788456080286535587989E-1; /* sqrt( 2/pi ) */
+
+#ifdef M_LN2
+double LOGE2 = M_LN2;
+double LOGSQ2 = M_LN2/2; /* log(2)/2 */
+double LOG2E = 1/M_LN2; /* 1/log(2) */
+#else
+double LOGE2 = 6.93147180559945309417E-1; /* log(2) */
+double LOGSQ2 = 3.46573590279972654709E-1; /* log(2)/2 */
+double LOG2E = 1.4426950408889634073599; /* 1/log(2) */
+#endif
+
+
+
diff --git a/Basic/Math/cpoly.c b/Basic/Math/cpoly.c
new file mode 100644
index 0000000..4bfbe42
--- /dev/null
+++ b/Basic/Math/cpoly.c
@@ -0,0 +1,819 @@
+/* Translated from F77 to C, rjrw 10/04/2000 */
+/* replaced 'bool' by 'boolvar' to get it to compile on my
+ linux machine, DJB Aug 02 2000 */
+
+/* algorithm 419 collected algorithms from acm.
+ algorithm appeared in comm. acm, vol. 15, no. 02, p. 097. */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+/*
+ #if !defined(WIN32) && !defined(_WIN32) && !defined(__APPLE__) && !defined(__CYGWIN__)
+ #include <values.h>
+ #endif
+*/
+#include <float.h>
+/* #define DEBUGMAIN */ /* Set up debugging main, etc. */
+#include "cpoly.h"
+
+/* Internal routines */
+static void noshft(int l1);
+static int fxshft(int l2, double *zr, double *zi);
+static int vrshft(int l3, double *zr, double *zi);
+static int calct(void);
+static void nexth(int boolvar);
+static void polyev(int nn, double sr, double si, double pr[], double pi[],
+ double qr[], double qi[], double *pvr, double *pvi);
+static double errev(int nn, double qr[], double qi[], double ms, double mp);
+static double cauchy(int nn, double pt[], double q[]);
+static double scale(int nn, double pt[]);
+static void cdivid(double ar, double ai, double br, double bi,
+ double *cr, double *ci);
+static double cmod(double r, double i);
+static void mcon(void);
+static int init(int nncr);
+
+/* Internal global variables */
+static double *pr,*pi,*hr,*hi,*qpr,*qpi,*qhr,*qhi,*shr,*shi;
+static double sr,si,tr,ti,pvr,pvi,are,mre,eta,infin,smalno,base;
+static int nn;
+
+#ifdef DEBUGMAIN
+/* driver to test cpoly */
+int main()
+{
+ int fail;
+ double p[50],pi[50],zr[50],zi[50];
+
+ int i;
+
+ printf("Example 1. polynomial with zeros 1,2,...,10.\n");
+ p[0]=1L;
+ p[1]=-55L;
+ p[2]=1320L;
+ p[3]=-18150L;
+ p[4]=157773L;
+ p[5]=-902055L;
+ p[6] = 3416930L;
+ p[7]=-8409500L;
+ p[8]=12753576L;
+ p[9]=-10628640L;
+ p[10]=3628800L;
+ for (i=0;i<11;i++)
+ pi[i]=0;
+ prtc(11,p,pi);
+ fail = cpoly(p,pi,10,zr,zi);
+ if(fail)
+ printf("cpoly has failed on this example\n");
+ prtz (10,zr,zi);
+ printf("Example 2. zeros on imaginary axis degree 3.\n");
+ p[0]=1;
+ p[1]=0;
+ p[2]=-10001.0001L;
+ p[3]=0;
+ pi[0]=0;
+ pi[1]=-10001.0001L;
+ pi[2]=0;
+ pi[3]=1;
+ prtc(4,p,pi);
+ fail = cpoly(p,pi,3,zr,zi);
+ if (fail)
+ printf("cpoly has failed on this example\n");
+ prtz(3,zr,zi);
+ printf("Example 3. zeros at 1+i,1/2*(1+i)....1/(2**-9)*(1+i)\n");
+ p[0]=1.0;
+ p[1]=-1.998046875L;
+ p[2]=0.0;
+ p[3]=.7567065954208374L;
+ p[4]=-.2002119533717632L;
+ p[5]=1.271507365163416e-2L;
+ p[6]=0;
+ p[7]=-1.154642632172909e-5L;
+ p[8]=1.584803612786345e-7L;
+ p[9]=-4.652065399568528e-10L;
+ p[10]=0;
+ pi[0]=0;
+ pi[1]=p[1];
+ pi[2]=2.658859252929688L;
+ pi[3]=-7.567065954208374e-1L;
+ pi[4]=0;
+ pi[5]=p[5];
+ pi[6]=-7.820779428584501e-4L;
+ pi[7]=-p[7];
+ pi[8]=0;
+ pi[9]=p[9];
+ pi[10]=9.094947017729282e-13L;
+ prtc(11,p,pi);
+ fail = cpoly(p,pi,10,zr,zi);
+ if (fail)
+ printf("cpoly has failed on this example\n");
+ prtz(10,zr,zi);
+ printf("Example 4. multiple zeros\n");
+ p[0]=1L;
+ p[1]=-10L;
+ p[2]=3L;
+ p[3]=284L;
+ p[4]=-1293L;
+ p[5]=2374L;
+ p[6]=-1587L;
+ p[7]=-920L;
+ p[8]=2204L;
+ p[9]=-1344L;
+ p[10]=288L;
+ pi[0]=0;
+ pi[1]=-10L;
+ pi[2]=100L;
+ pi[3]=-334L;
+ pi[4]=200L;
+ pi[5]=1394L;
+ pi[6] =-3836L;
+ pi[7]=4334L;
+ pi[8]=-2352L;
+ pi[9]=504L;
+ pi[10]=0;
+ prtc(11,p,pi);
+ fail = cpoly(p,pi,10,zr,zi);
+ if (fail)
+ printf("cpoly has failed on this example\n");
+ prtz(10,zr,zi);
+ printf("Example 5. 12 zeros evenly distributed on a circle of radius 1. centered at 0+2i.\n");
+ p[0]=1L;
+ p[1]=0;
+ p[2]=-264L;
+ p[3]=0;
+ p[4]=7920L;
+ p[5]=0;
+ p[6]=-59136L;
+ p[7]=0;
+ p[8]=126720L;
+ p[9]=0;
+ p[10]=-67584L;
+ p[11]=0;
+ p[12]=4095L;
+ pi[0]=0;
+ pi[1]=-24L;
+ pi[2]=0;
+ pi[3]=1760L;
+ pi[4]=0;
+ pi[5]=-25344L;
+ pi[6]=0;
+ pi[7]=101376L;
+ pi[8]=0;
+ pi[9]=-112640L;
+ pi[10]=0;
+ pi[11]=24576L;
+ pi[12]=0;
+ prtc(13,p,pi);
+ fail = cpoly(p,pi,12,zr,zi);
+ if(fail)
+ printf("cpoly has failed on this example\n");
+ prtz(12,zr,zi);
+ return 0;
+}
+void prtc(int n, double p[], double q[])
+{
+ int i;
+ printf("Coefficients\n");
+ for (i=0;i<n;i++)
+ printf("%26.16g %26.16g\n",p[i],q[i]);
+}
+
+void prtz(int n,double zr[], double zi[])
+{
+ int i;
+ printf("Zeroes\n");
+ for (i=0;i<n;i++)
+ printf("%26.16g %26.16g\n",zr[i],zi[i]);
+}
+#endif
+
+
+/* rjrw 10/04/2000: fix for cos 94: was -.060756474L */
+#define COSR (-.069756474L)
+#define SINR (.99756405L)
+
+int cpoly(double opr[], double opi[], int degree,
+ double zeror[], double zeroi[])
+{
+ /* Finds the zeros of a complex polynomial.
+
+ opr, opi - double precision vectors of real and imaginary parts
+ of the coefficients in order of decreasing powers.
+ degree - integer degree of polynomial
+ zeror, zeroi
+ - output double precision vectors of real and imaginary
+ parts of the zeros.
+ fail - output logical parameter, TRUE if leading coefficient
+ is zero, if cpoly has found fewer than degree zeros,
+ or if there is another internal error.
+
+ The program has been written to reduce the chance of overflow
+ occurring. If it does occur, there is still a possibility that
+ the zerofinder will work provided the overflowed quantity is
+ replaced by a large number. */
+
+ double xx,yy,xxx,zr,zi,bnd;
+ int fail,conv;
+ int cnt1,cnt2,i,idnn2;
+
+ /* initialization of constants */
+ nn = degree+1;
+ if (!init(nn)) {
+ fail = TRUE;
+ return fail;
+ }
+
+ xx = .70710678L;
+ yy = -xx;
+ fail = FALSE;
+
+ /* algorithm fails if the leading coefficient is zero. */
+ if (opr[0] == 0.0 && opi[0] == 0.0) {
+ fail = TRUE;
+ return fail;
+ }
+
+ /* Remove the zeros at the origin if any */
+ while (opr[nn-1] == 0.0 && opi[nn-1] == 0.0) {
+ idnn2 = degree+1-nn;
+ zeror[idnn2] = 0.0;
+ zeroi[idnn2] = 0.0;
+ nn--;
+ }
+
+ /* Make a copy of the coefficients */
+ for (i=0;i<nn;i++) {
+ pr[i] = opr[i];
+ pi[i] = opi[i];
+ shr[i] = cmod(pr[i],pi[i]);
+ }
+
+ /* Scale the polynomial */
+ bnd = scale(nn,shr);
+ if (bnd != 1.0) {
+ for (i=0;i<nn;i++) {
+ pr[i] *= bnd;
+ pi[i] *= bnd;
+ }
+ }
+
+ while (!fail) {
+
+ /* Start the algorithm for one zero */
+ if (nn < 3) {
+ /* Calculate the final zero and return */
+ cdivid(-pr[1],-pi[1],pr[0],pi[0],&(zeror[degree-1]),&(zeroi[degree-1]));
+ return fail;
+ }
+
+ /* Calculate bnd, a lower bound on the modulus of the zeros */
+ for (i=0;i<nn;i++) {
+ shr[i] = cmod(pr[i],pi[i]);
+ }
+ bnd = cauchy(nn,shr,shi);
+
+ /* Outer loop to control 2 major passes with different sequences
+ of shifts */
+ fail = TRUE;
+ for(cnt1=1;fail && (cnt1<=2);cnt1++) {
+
+ /* First stage calculation, no shift */
+ noshft(5);
+
+ /* Inner loop to select a shift. */
+ for (cnt2=1;fail && (cnt2<10);cnt2++) {
+ /* Shift is chosen with modulus bnd and amplitude rotated by
+ 94 degrees from the previous shift */
+ xxx = COSR*xx-SINR*yy;
+ yy = SINR*xx+COSR*yy;
+ xx = xxx;
+ sr = bnd*xx;
+ si = bnd*yy;
+
+ /* Second stage calculation, fixed shift */
+ conv = fxshft(10*cnt2,&zr,&zi);
+ if (conv) {
+
+ /* The second stage jumps directly to the third stage iteration
+ If successful the zero is stored and the polynomial deflated */
+ idnn2 = degree+1-nn;
+ zeror[idnn2] = zr;
+ zeroi[idnn2] = zi;
+ nn--;
+ for(i=0;i<nn;i++) {
+ pr[i] = qpr[i];
+ pi[i] = qpi[i];
+ }
+ fail = FALSE;
+ }
+ /* If the iteration is unsuccessful another shift is chosen */
+ }
+ /* If 9 shifts fail, the outer loop is repeated with another
+ sequence of shifts */
+ }
+ }
+
+ /* The zerofinder has failed on two major passes
+ Return empty handed */
+ return fail;
+}
+
+static void noshft(int l1)
+{
+ /* Computes the derivative polynomial as the initial h
+ polynomial and computes l1 no-shift h polynomials. */
+
+ double xni,t1,t2;
+ int i,j,jj,n = nn-1,nm1 = n-1,nm2=nm1-1;
+ for (i=0;i<n;i++) {
+ xni = n-i;
+ hr[i] = xni*pr[i]/((double)(n));
+ hi[i] = xni*pi[i]/((double)(n));
+ }
+ for (jj=0;jj<l1;jj++) {
+ if (cmod(hr[nm2],hi[nm2]) > eta*10.0*cmod(pr[nm2],pi[nm2])) {
+ cdivid(-pr[n],-pi[n],hr[nm1],hi[nm1],&tr,&ti);
+ for (i=0;i<nm1;i++) {
+ j = nm1-i;
+ t1 = hr[j-1];
+ t2 = hi[j-1];
+ hr[j] = tr*t1-ti*t2+pr[j];
+ hi[j] = tr*t2+ti*t1+pi[j];
+ }
+ hr[0] = pr[0];
+ hi[0] = pi[0];
+ } else {
+
+ /* If the constant term is essentially zero, shift h coefficients */
+ for (i=0;i<nm1;i++) {
+ j = nm1-i;
+ hr[j] = hr[j-1];
+ hi[j] = hi[j-1];
+ }
+ hr[0] = 0.0;
+ hi[0] = 0.0;
+ }
+ }
+}
+
+static int fxshft(int l2, double *zr, double *zi)
+ /* Computes l2 fixed-shift h polynomials and tests for convergence
+
+ Initiates a variable-shift iteration and returns with the
+ approximate zero if successful.
+
+ l2 - Limit of fixed shift steps
+ zr,zi - Approximate zero if conv is .true.
+ conv - Flag indicating convergence of stage 3 iteration
+ */
+{
+ double otr,oti,svsr,svsi;
+ int conv,test,pasd,boolvar;
+ int i,j,n = nn-1;
+
+ /* Evaluate p at s */
+ polyev(nn,sr,si,pr,pi,qpr,qpi,&pvr,&pvi);
+ test = TRUE;
+ pasd = FALSE;
+
+ /* Calculate first t = -p(s)/h(s) */
+ boolvar = calct();
+
+ /* Main loop for one second stage step */
+ for (j=0;j<l2;j++) {
+ otr = tr;
+ oti = ti;
+
+ /* Compute next h polynomial and new t */
+ nexth(boolvar);
+ boolvar = calct();
+ *zr = sr+tr;
+ *zi = si+ti;
+
+ /* Test for convergence unless stage 3 has failed once or
+ this is the last h polynomial */
+ if (!boolvar && test && j != l2) {
+ if (cmod(tr-otr,ti-oti) < .5*cmod(*zr,*zi)) {
+ if (pasd) {
+
+ /* The weak convergence test has been passed twice, start the
+ third stage iteration, after saving the current h polynomial
+ and shift */
+ for (i=0;i<n;i++) {
+ shr[i] = hr[i];
+ shi[i] = hi[i];
+ }
+ svsr = sr;
+ svsi = si;
+ conv = vrshft(10,zr,zi);
+ if (conv)
+ return conv;
+
+ /* The iteration failed to converge
+ Turn off testing and restore h,s,pv and t */
+ test = FALSE;
+ for (i=0;i<n;i++) {
+ hr[i] = shr[i];
+ hi[i] = shi[i];
+ }
+ sr = svsr;
+ si = svsi;
+ polyev(nn,sr,si,pr,pi,qpr,qpi,&pvr,&pvi);
+ boolvar = calct();
+ } else {
+ pasd = TRUE;
+ }
+ }
+ } else {
+ pasd = FALSE;
+ }
+ }
+
+ /* Attempt an iteration with final h polynomial from second stage */
+ conv = vrshft(10,zr,zi);
+ return conv;
+}
+
+static int vrshft(int l3, double *zr, double *zi)
+ /* Carries out the third stage iteration
+
+ l3 - Limit of steps in stage 3
+ zr,zi - On entry contains the initial iterate,
+ On exit, it contains the final iterate (if it converges).
+ conv - TRUE if iteration converges
+ */
+{
+ double mp,ms,omp,relstp,r1,r2,tp;
+ int i,j,conv,b,boolvar;
+
+ conv = FALSE;
+ b = FALSE;
+ sr = *zr;
+ si = *zi;
+
+ /* Main loop for stage three */
+ for (i=0; i<l3;i++) {
+
+ /* Evaluate p at s and test for convergence */
+ polyev(nn,sr,si,pr,pi,qpr,qpi,&pvr,&pvi);
+ mp = cmod(pvr,pvi);
+ ms = cmod(sr,si);
+ if (mp <= 20.0L*errev(nn,qpr,qpi,ms,mp)) {
+ /* Polynomial value is smaller in value than a bound on the error
+ in evaluating p, terminate the iteration */
+ conv = TRUE;
+ *zr = sr;
+ *zi = si;
+ return conv;
+ } else {
+ if (i!=0) {
+ if (!b && mp>=omp && relstp < .05L) {
+ /* Iteration has stalled, probably a cluster of zeros
+ Do 5 fixed shift steps into the cluster to force one zero
+ to dominate */
+ b = TRUE;
+ if (relstp < eta)
+ tp = eta;
+ else
+ tp = relstp;
+ r1 = sqrt(tp);
+ r2 = sr*(1.0L+r1)-si*r1;
+ si = sr*r1+si*(1.0L+r1);
+ sr = r2;
+ polyev(nn,sr,si,pr,pi,qpr,qpi,&pvr,&pvi);
+ for (j=0;j<5;j++) {
+ boolvar = calct();
+ nexth(boolvar);
+ }
+ omp = infin;
+ } else {
+ /* Exit if polynomial value increases significantly */
+ if (mp*0.1L > omp)
+ return conv;
+ omp = mp;
+ }
+ } else {
+ omp = mp;
+ }
+ }
+
+ /* Calculate next iterate. */
+ boolvar = calct();
+ nexth(boolvar);
+ boolvar = calct();
+ if (!boolvar) {
+ relstp = cmod(tr,ti)/cmod(sr,si);
+ sr += tr;
+ si += ti;
+ }
+ }
+ return conv;
+}
+
+static int calct(void)
+ /* Computes t = -p(s)/h(s)
+ Returns TRUE if h(s) is essentially zero
+ */
+{
+ double hvr,hvi;
+ int n = nn-1, boolvar;
+
+ /* Evaluate h(s) */
+ polyev(n,sr,si,hr,hi,qhr,qhi,&hvr,&hvi);
+ boolvar = (cmod(hvr,hvi) <= are*10.0*cmod(hr[n-1],hi[n-1]));
+ if (!boolvar) {
+ cdivid(-pvr,-pvi,hvr,hvi,&tr,&ti);
+ } else {
+ tr = 0.0;
+ ti = 0.0;
+ }
+ return boolvar;
+}
+
+static void nexth(int boolvar)
+ /* Calculates the next shifted h polynomial
+ boolvar - TRUE if h(s) is essentially zero
+ */
+{
+ double t1,t2;
+ int j,n = nn-1;
+
+ if (!boolvar) {
+ for (j=1;j<n;j++) {
+ t1 = qhr[j-1];
+ t2 = qhi[j-1];
+ hr[j] = tr*t1-ti*t2+qpr[j];
+ hi[j] = tr*t2+ti*t1+qpi[j];
+ }
+ hr[0] = qpr[0];
+ hi[0] = qpi[0];
+ } else {
+ /* If h(s) is zero, replace h with qh */
+ for (j=1;j<n;j++) {
+ hr[j] = qhr[j-1];
+ hi[j] = qhi[j-1];
+ }
+ hr[0] = 0.0;
+ hi[0] = 0.0;
+ }
+}
+
+static void polyev(int nn, double sr, double si, double pr[], double pi[],
+ double qr[], double qi[], double *tvr, double *tvi)
+ /* Evaluates a polynomial p at s by the Horner recurrence,
+ placing the partial sums in q and the computed value in pv
+ */
+{
+ double t, vr, vi;
+ int i;
+
+ qr[0] = pr[0];
+ qi[0] = pi[0];
+ vr = qr[0];
+ vi = qi[0];
+ for (i=1;i<nn;i++) {
+ t = vr*sr-vi*si+pr[i];
+ vi = vr*si+vi*sr+pi[i];
+ vr = t;
+ qr[i] = vr;
+ qi[i] = vi;
+ }
+ *tvr = vr;
+ *tvi = vi;
+}
+
+static double errev(int nn, double qr[], double qi[], double ms, double mp)
+ /* Bounds the error in evaluating the polynomial by the Horner recurrence
+
+ qr,qi - The partial sums
+ ms - Modulus of the point
+ mp - Modulus of polynomial value
+ */
+{
+ double e;
+ int i;
+
+ e = cmod(qr[0],qi[0])*mre/(are+mre);
+ for (i=0;i<nn;i++)
+ e = e*ms+cmod(qr[i],qi[i]);
+ return e*(are+mre)-mp*mre;
+}
+
+static double cauchy(int nn, double pt[], double q[])
+ /* Cauchy computes a lower bound on the moduli of the zeros of a
+ polynomial - pt is the modulus of the coefficients
+ */
+{
+ double x,xm,f,dx,df;
+ int n=nn-1, nm=nn-2, i;
+
+ pt[n] = -pt[n];
+
+ /* Compute upper estimate of bound */
+ xm = exp( (log(-pt[n]) - log(pt[0]))/((double)n) );
+ if (pt[nm] != 0.0) {
+ /* If Newton step at the origin is better, use it */
+ x = -pt[n]/pt[nm];
+ if (x < xm)
+ xm = x;
+ }
+
+ /* Chop the interval (0,x) until f <= 0 */
+ do {
+ x = xm;
+ xm *= .1;
+ f = pt[0];
+ for (i=1;i<nn;i++)
+ f = f*xm+pt[i];
+ } while (f > 0.);
+ dx = x;
+
+ /* Do Newton iteration until x converges to two decimal places */
+ while (fabs(dx/x) > .005L) {
+ q[0] = pt[0];
+ for(i=1;i<nn;i++)
+ q[i] = q[i-1]*x+pt[i];
+ f = q[n];
+ df = q[0];
+ for (i=1;i<n;i++)
+ df = df*x+q[i];
+ dx = f/df;
+ x -= dx;
+ }
+ return x;
+}
+
+static double scale(int nn, double pt[])
+ /* Returns a scale factor to multiply the coefficients of the
+ polynomial. The scaling is done to avoid overflow and to avoid
+ undetected underflow interfering with the convergence
+ criterion. The factor is a power of the base.
+
+ pt - modulus of coefficients of p
+ */
+{
+ double hi,lo,max,min,x,sc;
+ int i,l;
+
+ /* Find largest and smallest moduli of coefficients */
+ hi = sqrt(infin);
+ lo = smalno/eta;
+ max = 0.0;
+ min = infin;
+ for (i=0;i<nn;i++) {
+ x = pt[i];
+ if (x > max)
+ max = x;
+ if (x != 0.0 && x < min)
+ min = x;
+ }
+
+ /* Scale only if there are very large or very small components */
+ if (min >= lo && max <= hi)
+ return 1.0;
+ x = lo/min;
+ if (x <= 1.0L) {
+ sc = 1.0L/(sqrt(max)*sqrt(min));
+ } else {
+ sc = x;
+ if (infin/sc > max)
+ sc = 1.0;
+ }
+ l = log(sc)/log(base) + .500;
+ return pow(base,l);
+}
+
+static void cdivid(double ar, double ai, double br, double bi,
+ double *cr, double *ci)
+ /* Complex division c = a/b, avoiding overflow */
+{
+ double r,d;
+ if (br == 0.0 && bi == 0.0) {
+ /* division by zero, c = infinity. */
+ *cr = infin;
+ *ci = infin;
+ } else if (fabs(br) < fabs(bi)) {
+ r = br/bi;
+ d = bi+r*br;
+ *cr = (ar*r+ai)/d;
+ *ci = (ai*r-ar)/d;
+ } else {
+ r = bi/br;
+ d = br+r*bi;
+ *cr = (ar+ai*r)/d;
+ *ci = (ai-ar*r)/d;
+ }
+ return;
+}
+
+static double cmod(double r, double i)
+ /* Modulus of a complex number avoiding overflow */
+{
+ double ar,ai,f;
+ ar = fabs(r);
+ ai = fabs(i);
+ if (ar < ai) {
+ f = ar/ai;
+ return ai*sqrt(1.0+f*f);
+ } else if (ar > ai) {
+ f = ai/ar;
+ return ar*sqrt(1.0+f*f);
+ } else {
+ return ar*sqrt(2.0);
+ }
+}
+
+static void mcon()
+ /* mcon provides machine constants used in various parts of the
+ program. The user may either set them directly or use the
+ statements below to compute them. The meaning of the four
+ constants are -
+
+ eta the maximum relative representation error
+ which can be described as the smallest positive
+ floating-point number such that 1.0d0 + eta is
+ greater than 1.0d0.
+ infin the largest floating-point number
+ smalno the smallest positive floating-point number
+ base the base of the floating-point number system used
+
+ Let t be the number of base-digits in each floating-point
+ number (double precision). Then eta is either .5*b**(1-t)
+ or b**(1-t) depending on whether rounding or truncation
+ is used.
+
+ Let m be the largest exponent and n the smallest exponent
+ in the number system. Then infiny is (1-base**(-t))*base**m
+ and smalno is base**n.
+ */
+{
+
+ /*
+ #if !defined(WIN32) && !defined(_WIN32) && !defined(__APPLE__) && !defined(__CYGWIN__)
+ base = 2;
+ eta = DBL_EPSILON;
+ smalno = MINDOUBLE;
+ infin = MAXDOUBLE;
+ #else
+ */
+ base = 2;
+ eta = DBL_EPSILON;
+ smalno = DBL_MIN;
+ infin = DBL_MAX;
+ /* #endif */
+
+#ifdef IBM360
+ /* These values for base,t,m,n correspond to the ibm/360. */
+ int m,n,t;
+ base = 16.0;
+ t = 14;
+ m = 63;
+ n = -65;
+ eta = pow(base,1-t);
+ infin = (base)*(1.0-pow(base,-t))*pow(base,m-1);
+ smalno = pow(base,n+3)/pow(base,3);
+#endif
+}
+
+static int init(int nncr)
+{
+ static int nmax=0;
+
+ if (nmax == 0) {
+ /* Set up once-off constants */
+ mcon();
+
+ /* are, mre - Error bounds on complex addition and multiplication,
+ cf e.g. errev() above */
+ are = eta;
+ mre = 2.0L*sqrt(2.0L)*eta;
+
+ } else if (nmax >= nncr) {
+ return TRUE; /* Present arrays are big enough */
+ } else {
+ /* Free old arrays (no need to preserve contents */
+ free(shi); free(shr); free(qhi); free(qhr);
+ free(qpi); free(qpr); free(hi); free(hr); free(pi); free(pr);
+ }
+
+ nmax = nncr;
+
+ pr = (double *) malloc(nmax*sizeof(double));
+ pi = (double *) malloc(nmax*sizeof(double));
+ hr = (double *) malloc(nmax*sizeof(double));
+ hi = (double *) malloc(nmax*sizeof(double));
+ qpr = (double *) malloc(nmax*sizeof(double));
+ qpi = (double *) malloc(nmax*sizeof(double));
+ qhr = (double *) malloc(nmax*sizeof(double));
+ qhi = (double *) malloc(nmax*sizeof(double));
+ shr = (double *) malloc(nmax*sizeof(double));
+ shi = (double *) malloc(nmax*sizeof(double));
+
+ if (!(pr && pi && hr && hi && qpr && qpi && qhr && qhi && shr && shi)) {
+ fprintf(stderr,"Couldn't allocate space for cpoly\n");
+ return FALSE;
+ } else {
+ return TRUE;
+ }
+}
diff --git a/Basic/Math/cpoly.h b/Basic/Math/cpoly.h
new file mode 100644
index 0000000..97d700a
--- /dev/null
+++ b/Basic/Math/cpoly.h
@@ -0,0 +1,14 @@
+#ifdef DEBUGMAIN
+void prtc(int n, double p[], double q[]);
+void prtz(int n,double zr[], double zi[]);
+#endif
+int cpoly(double opr[], double opi[], int degree,
+ double zeror[], double zeroi[]);
+
+#if !defined(FALSE)
+#define FALSE (0)
+#endif
+#if !defined(TRUE)
+#define TRUE (1)
+#endif
+
diff --git a/Basic/Math/infinity.c b/Basic/Math/infinity.c
new file mode 100644
index 0000000..ca4a026
--- /dev/null
+++ b/Basic/Math/infinity.c
@@ -0,0 +1,10 @@
+#include "mconf.h"
+double infinity(void)
+{
+#ifdef DBL_INFINITY
+ return DBL_INFINITY;
+#else
+ double a=0;
+ return 1./a; /* Expect divide by zero error */
+#endif
+}
diff --git a/Basic/Math/j0.c b/Basic/Math/j0.c
new file mode 100644
index 0000000..a7aee50
--- /dev/null
+++ b/Basic/Math/j0.c
@@ -0,0 +1,261 @@
+/* j0.c
+ *
+ * Bessel function of order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, j0();
+ *
+ * y = j0( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order zero of the argument.
+ *
+ * The domain is divided into the intervals [0, 5] and
+ * (5, infinity). In the first interval the following rational
+ * approximation is used:
+ *
+ *
+ * 2 2
+ * (w - r ) (w - r ) P (w) / Q (w)
+ * 1 2 3 8
+ *
+ * 2
+ * where w = x and the two r's are zeros of the function.
+ *
+ * In the second interval, the Hankel asymptotic expansion
+ * is employed with two rational functions of degree 6/6
+ * and 7/7.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 10000 4.4e-17 6.3e-18
+ * IEEE 0, 30 60000 4.2e-16 1.1e-16
+ *
+ */
+
/* y0.c
+ *
+ * Bessel function of the second kind, order zero
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, y0();
+ *
+ * y = y0( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of the second kind, of order
+ * zero, of the argument.
+ *
+ * The domain is divided into the intervals [0, 5] and
+ * (5, infinity). In the first interval a rational approximation
+ * R(x) is employed to compute
+ * y0(x) = R(x) + 2 * log(x) * j0(x) / PI.
+ * Thus a call to j0() is required.
+ *
+ * In the second interval, the Hankel asymptotic expansion
+ * is employed with two rational functions of degree 6/6
+ * and 7/7.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error, when y0(x) < 1; else relative error:
+ *
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 9400 7.0e-17 7.9e-18
+ * IEEE 0, 30 30000 1.3e-15 1.6e-16
+ *
+ */
+
+/*
+Cephes Math Library Release 2.1: January, 1989
+Copyright 1984, 1987, 1989 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+/* Note: all coefficients satisfy the relative error criterion
+ * except YP, YQ which are designed for absolute error. */
+
+#include "mconf.h"
+
+static double PP[7] = {
+ 7.96936729297347051624E-4,
+ 8.28352392107440799803E-2,
+ 1.23953371646414299388E0,
+ 5.44725003058768775090E0,
+ 8.74716500199817011941E0,
+ 5.30324038235394892183E0,
+ 9.99999999999999997821E-1,
+};
+static double PQ[7] = {
+ 9.24408810558863637013E-4,
+ 8.56288474354474431428E-2,
+ 1.25352743901058953537E0,
+ 5.47097740330417105182E0,
+ 8.76190883237069594232E0,
+ 5.30605288235394617618E0,
+ 1.00000000000000000218E0,
+};
+
+static double QP[8] = {
+-1.13663838898469149931E-2,
+-1.28252718670509318512E0,
+-1.95539544257735972385E1,
+-9.32060152123768231369E1,
+-1.77681167980488050595E2,
+-1.47077505154951170175E2,
+-5.14105326766599330220E1,
+-6.05014350600728481186E0,
+};
+static double QQ[7] = {
+/* 1.00000000000000000000E0,*/
+ 6.43178256118178023184E1,
+ 8.56430025976980587198E2,
+ 3.88240183605401609683E3,
+ 7.24046774195652478189E3,
+ 5.93072701187316984827E3,
+ 2.06209331660327847417E3,
+ 2.42005740240291393179E2,
+};
+
+static double YP[8] = {
+ 1.55924367855235737965E4,
+-1.46639295903971606143E7,
+ 5.43526477051876500413E9,
+-9.82136065717911466409E11,
+ 8.75906394395366999549E13,
+-3.46628303384729719441E15,
+ 4.42733268572569800351E16,
+-1.84950800436986690637E16,
+};
+static double YQ[7] = {
+/* 1.00000000000000000000E0,*/
+ 1.04128353664259848412E3,
+ 6.26107330137134956842E5,
+ 2.68919633393814121987E8,
+ 8.64002487103935000337E10,
+ 2.02979612750105546709E13,
+ 3.17157752842975028269E15,
+ 2.50596256172653059228E17,
+};
+
+/* 5.783185962946784521175995758455807035071 */
+static double DR1 = 5.78318596294678452118E0;
+/* 30.47126234366208639907816317502275584842 */
+static double DR2 = 3.04712623436620863991E1;
+
+static double RP[4] = {
+-4.79443220978201773821E9,
+ 1.95617491946556577543E12,
+-2.49248344360967716204E14,
+ 9.70862251047306323952E15,
+};
+static double RQ[8] = {
+/* 1.00000000000000000000E0,*/
+ 4.99563147152651017219E2,
+ 1.73785401676374683123E5,
+ 4.84409658339962045305E7,
+ 1.11855537045356834862E10,
+ 2.11277520115489217587E12,
+ 3.10518229857422583814E14,
+ 3.18121955943204943306E16,
+ 1.71086294081043136091E18,
+};
+
+double j0(x)
+double x;
+{
+double polevl(), p1evl();
+double w, z, p, q, xn;
+double sin(), cos(), sqrt();
+extern double PIO4, SQ2OPI;
+
+
+if( x < 0 )
+ x = -x;
+
+if( x <= 5.0 )
+ {
+ z = x * x;
+ if( x < 1.0e-5 )
+ return( 1.0 - z/4.0 );
+
+ p = (z - DR1) * (z - DR2);
+ p = p * polevl( z, RP, 3)/p1evl( z, RQ, 8 );
+ return( p );
+ }
+
+w = 5.0/x;
+q = 25.0/(x*x);
+p = polevl( q, PP, 6)/polevl( q, PQ, 6 );
+q = polevl( q, QP, 7)/p1evl( q, QQ, 7 );
+xn = x - PIO4;
+p = p * cos(xn) - w * q * sin(xn);
+return( p * SQ2OPI / sqrt(x) );
+}
+
+/* y0() 2 */
+/* Bessel function of second kind, order zero */
+
+/* Rational approximation coefficients YP[], YQ[] are used here.
+ * The function computed is y0(x) - 2 * log(x) * j0(x) / PI,
+ * whose value at x = 0 is 2 * ( log(0.5) + EUL ) / PI
+ * = 0.073804295108687225.
+ */
+
+/*
+#define PIO4 .78539816339744830962
+#define SQ2OPI .79788456080286535588
+*/
+extern double MAXNUM;
+
+#ifdef MY_FIXY0
+double fixy0(x)
+#else
+double y0(x)
+#endif
+double x;
+{
+double polevl(), p1evl();
+double w, z, p, q, xn;
+double j0(), log(), sin(), cos(), sqrt();
+extern double TWOOPI, SQ2OPI, PIO4;
+
+
+if( x <= 5.0 )
+ {
+ if( x <= 0.0 )
+ {
+ mtherr( "y0", DOMAIN );
+ return( -MAXNUM );
+ }
+ z = x * x;
+ w = polevl( z, YP, 7) / p1evl( z, YQ, 7 );
+ w += TWOOPI * log(x) * j0(x);
+ return( w );
+ }
+
+w = 5.0/x;
+z = 25.0 / (x * x);
+p = polevl( z, PP, 6)/polevl( z, PQ, 6 );
+q = polevl( z, QP, 7)/p1evl( z, QQ, 7 );
+xn = x - PIO4;
+p = p * sin(xn) + w * q * cos(xn);
+return( p * SQ2OPI / sqrt(x) );
+}
diff --git a/Basic/Math/j1.c b/Basic/Math/j1.c
new file mode 100644
index 0000000..0f66bd5
--- /dev/null
+++ b/Basic/Math/j1.c
@@ -0,0 +1,234 @@
+/* j1.c
+ *
+ * Bessel function of order one
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, j1();
+ *
+ * y = j1( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order one of the argument.
+ *
+ * The domain is divided into the intervals [0, 8] and
+ * (8, infinity). In the first interval a 24 term Chebyshev
+ * expansion is used. In the second, the asymptotic
+ * trigonometric representation is employed using two
+ * rational functions of degree 5/5.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 10000 4.0e-17 1.1e-17
+ * IEEE 0, 30 30000 2.6e-16 1.1e-16
+ *
+ *
+ */
+
/* y1.c
+ *
+ * Bessel function of second kind of order one
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, y1();
+ *
+ * y = y1( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of the second kind of order one
+ * of the argument.
+ *
+ * The domain is divided into the intervals [0, 8] and
+ * (8, infinity). In the first interval a 25 term Chebyshev
+ * expansion is used, and a call to j1() is required.
+ * In the second, the asymptotic trigonometric representation
+ * is employed using two rational functions of degree 5/5.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 10000 8.6e-17 1.3e-17
+ * IEEE 0, 30 30000 1.0e-15 1.3e-16
+ *
+ * (error criterion relative when |y1| > 1).
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.1: January, 1989
+Copyright 1984, 1987, 1989 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+/*
+#define PIO4 .78539816339744830962
+#define THPIO4 2.35619449019234492885
+#define SQ2OPI .79788456080286535588
+*/
+
+#include "mconf.h"
+
+static double RP[4] = {
+-8.99971225705559398224E8,
+ 4.52228297998194034323E11,
+-7.27494245221818276015E13,
+ 3.68295732863852883286E15,
+};
+static double RQ[8] = {
+/* 1.00000000000000000000E0,*/
+ 6.20836478118054335476E2,
+ 2.56987256757748830383E5,
+ 8.35146791431949253037E7,
+ 2.21511595479792499675E10,
+ 4.74914122079991414898E12,
+ 7.84369607876235854894E14,
+ 8.95222336184627338078E16,
+ 5.32278620332680085395E18,
+};
+
+static double PP[7] = {
+ 7.62125616208173112003E-4,
+ 7.31397056940917570436E-2,
+ 1.12719608129684925192E0,
+ 5.11207951146807644818E0,
+ 8.42404590141772420927E0,
+ 5.21451598682361504063E0,
+ 1.00000000000000000254E0,
+};
+static double PQ[7] = {
+ 5.71323128072548699714E-4,
+ 6.88455908754495404082E-2,
+ 1.10514232634061696926E0,
+ 5.07386386128601488557E0,
+ 8.39985554327604159757E0,
+ 5.20982848682361821619E0,
+ 9.99999999999999997461E-1,
+};
+
+static double QP[8] = {
+ 5.10862594750176621635E-2,
+ 4.98213872951233449420E0,
+ 7.58238284132545283818E1,
+ 3.66779609360150777800E2,
+ 7.10856304998926107277E2,
+ 5.97489612400613639965E2,
+ 2.11688757100572135698E2,
+ 2.52070205858023719784E1,
+};
+static double QQ[7] = {
+/* 1.00000000000000000000E0,*/
+ 7.42373277035675149943E1,
+ 1.05644886038262816351E3,
+ 4.98641058337653607651E3,
+ 9.56231892404756170795E3,
+ 7.99704160447350683650E3,
+ 2.82619278517639096600E3,
+ 3.36093607810698293419E2,
+};
+
+
+static double YP[6] = {
+ 1.26320474790178026440E9,
+-6.47355876379160291031E11,
+ 1.14509511541823727583E14,
+-8.12770255501325109621E15,
+ 2.02439475713594898196E17,
+-7.78877196265950026825E17,
+};
+static double YQ[8] = {
+/* 1.00000000000000000000E0,*/
+ 5.94301592346128195359E2,
+ 2.35564092943068577943E5,
+ 7.34811944459721705660E7,
+ 1.87601316108706159478E10,
+ 3.88231277496238566008E12,
+ 6.20557727146953693363E14,
+ 6.87141087355300489866E16,
+ 3.97270608116560655612E18,
+};
+
+static double Z1 = 1.46819706421238932572E1;
+static double Z2 = 4.92184563216946036703E1;
+
+double j1(x)
+double x;
+{
+extern double THPIO4, SQ2OPI;
+double polevl(), p1evl();
+double w, z, p, q, xn;
+double sin(), cos(), sqrt();
+
+w = x;
+if( x < 0 )
+ w = -x;
+
+if( w <= 5.0 )
+ {
+ z = x * x;
+ w = polevl( z, RP, 3 ) / p1evl( z, RQ, 8 );
+ w = w * x * (z - Z1) * (z - Z2);
+ return( w );
+ }
+
+w = 5.0/x;
+z = w * w;
+p = polevl( z, PP, 6)/polevl( z, PQ, 6 );
+q = polevl( z, QP, 7)/p1evl( z, QQ, 7 );
+xn = x - THPIO4;
+p = p * cos(xn) - w * q * sin(xn);
+return( p * SQ2OPI / sqrt(x) );
+}
+
+
+
+
+extern double MAXNUM;
+
+double y1(x)
+double x;
+{
+extern double TWOOPI, THPIO4, SQ2OPI;
+double polevl(), p1evl();
+double w, z, p, q, xn;
+double j1(), log(), sin(), cos(), sqrt();
+
+
+if( x <= 5.0 )
+ {
+ if( x <= 0.0 )
+ {
+ mtherr( "y1", DOMAIN );
+ return( -MAXNUM );
+ }
+ z = x * x;
+ w = x * (polevl( z, YP, 5 ) / p1evl( z, YQ, 8 ));
+ w += TWOOPI * ( j1(x) * log(x) - 1.0/x );
+ return( w );
+ }
+
+w = 5.0/x;
+z = w * w;
+p = polevl( z, PP, 6)/polevl( z, PQ, 6 );
+q = polevl( z, QP, 7)/p1evl( z, QQ, 7 );
+xn = x - THPIO4;
+p = p * sin(xn) + w * q * cos(xn);
+return( p * SQ2OPI / sqrt(x) );
+}
diff --git a/Basic/Math/jn.c b/Basic/Math/jn.c
new file mode 100644
index 0000000..77d23e9
--- /dev/null
+++ b/Basic/Math/jn.c
@@ -0,0 +1,123 @@
+/* jn.c
+ *
+ * Bessel function of integer order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n;
+ * double x, y, jn();
+ *
+ * y = jn( n, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order n, where n is a
+ * (possibly negative) integer.
+ *
+ * The ratio of jn(x) to j0(x) is computed by backward
+ * recurrence. First the ratio jn/jn-1 is found by a
+ * continued fraction expansion. Then the recurrence
+ * relating successive orders is applied until j0 or j1 is
+ * reached.
+ *
+ * If n = 0 or 1 the routine for j0 or j1 is called
+ * directly.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Absolute error:
+ * arithmetic range # trials peak rms
+ * DEC 0, 30 5500 6.9e-17 9.3e-18
+ * IEEE 0, 30 5000 4.4e-16 7.9e-17
+ *
+ *
+ * Not suitable for large n or x. Use jv() instead.
+ *
+ */
+
+/* jn.c
+Cephes Math Library Release 2.0: April, 1987
+Copyright 1984, 1987 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+#include "mconf.h"
+
+extern double MACHEP;
+
+double jn( n, x )
+int n;
+double x;
+{
+double pkm2, pkm1, pk, xk, r, ans;
+int k, sign;
+double fabs(), j0(), j1();
+
+if( n < 0 )
+ {
+ n = -n;
+ if( (n & 1) == 0 ) /* -1**n */
+ sign = 1;
+ else
+ sign = -1;
+ }
+else
+ sign = 1;
+
+
+if( n == 0 )
+ return( sign * j0(x) );
+if( n == 1 )
+ return( sign * j1(x) );
+if( n == 2 )
+ return( sign * (2.0 * j1(x) / x - j0(x)) );
+
+if( x < MACHEP )
+ return( 0.0 );
+
+/* continued fraction */
+#ifdef DEC
+k = 56;
+#else
+k = 53;
+#endif
+
+pk = 2 * (n + k);
+ans = pk;
+xk = x * x;
+
+do
+ {
+ pk -= 2.0;
+ ans = pk - (xk/ans);
+ }
+while( --k > 0 );
+ans = x/ans;
+
+/* backward recurrence */
+
+pk = 1.0;
+pkm1 = 1.0/ans;
+k = n-1;
+r = 2 * k;
+
+do
+ {
+ pkm2 = (pkm1 * r - pk * x) / x;
+ pk = pkm1;
+ pkm1 = pkm2;
+ r -= 2.0;
+ }
+while( --k > 0 );
+
+if( fabs(pk) > fabs(pkm1) )
+ ans = j1(x)/pk;
+else
+ ans = j0(x)/pkm1;
+return( sign * ans );
+}
diff --git a/Basic/Math/math.pd b/Basic/Math/math.pd
new file mode 100644
index 0000000..5566de9
--- /dev/null
+++ b/Basic/Math/math.pd
@@ -0,0 +1,446 @@
+
+use strict;
+use Config;
+
+pp_addpm({At=>'Top'},<<'EOD');
+=head1 NAME
+
+PDL::Math - extended mathematical operations and special functions
+
+=head1 SYNOPSIS
+
+ use PDL::Math;
+
+ use PDL::Graphics::TriD;
+ imag3d [SURF2D,bessj0(rvals(zeroes(50,50))/2)];
+
+=head1 DESCRIPTION
+
+This module extends PDL with more advanced mathematical functions than
+provided by standard Perl.
+
+All the functions have one input pdl, and one output, unless otherwise
+stated.
+
+Many of the functions are linked from the system maths library or the
+Cephes maths library (determined when PDL is compiled); a few are implemented
+entirely in PDL.
+
+=cut
+
+### Kludge for backwards compatibility with older scripts
+### This should be deleted at some point later than 21-Nov-2003.
+BEGIN {use PDL::MatrixOps;}
+
+EOD
+
+# Internal doc util
+
+my %doco;
+sub doco {
+ my @funcs = @_;
+ my $doc = pop @funcs;
+ for (@funcs) { $doco{$_} = $doc }
+}
+
+doco (qw/acos asin atan tan/,
+'The usual trigonometric function.');
+
+doco (qw/cosh sinh tanh acosh asinh atanh/,
+'The standard hyperbolic function.');
+
+doco (qw/ceil floor/,
+'Round to integer values in floating-point format.');
+
+doco ('rint',
+q/=for ref
+
+Round to integer values in floating-point format.
+
+=for method
+
+rint uses the 'round half to even' rounding method (also known as
+banker's rounding). Half-integers are rounded to the nearest even
+number. This avoids a slight statistical bias inherent in always
+rounding half-integers up or away from zero.
+
+If you are looking to round half-integers up (regardless of sign), try
+C<floor($x+0.5)>. If you want to round half-integers away from zero,
+try C<< floor(abs($x)+0.5)*($x<=>0) >>./);
+
+doco( 'pow',"Synonym for `**'.");
+
+doco ('erf',"The error function.");
+doco ('erfc',"The complement of the error function.");
+doco ('erfi',"The inverse of the error function.");
+doco ('ndtri',
+"=for ref
+
+The value for which the area under the
+Gaussian probability density function (integrated from
+minus infinity) is equal to the argument (cf L<erfi|/erfi>).");
+
+doco(qw/bessj0 bessj1/,
+ "The regular Bessel function of the first kind, J_n" );
+
+doco(qw/bessy0 bessy1/,
+ "The regular Bessel function of the second kind, Y_n." );
+
+doco( qw/bessjn/,
+'=for ref
+
+The regular Bessel function of the first kind, J_n
+.
+This takes a second int argument which gives the order
+of the function required.
+');
+
+doco( qw/bessyn/,
+'=for ref
+
+The regular Bessel function of the first kind, Y_n
+.
+This takes a second int argument which gives the order
+of the function required.
+');
+
+if ($^O !~ /win32/i || $Config{cc} =~ /\bgcc/i) { # doesn't seem to be in the MS VC lib
+doco( 'lgamma' ,<<'EOD');
+=for ref
+
+log gamma function
+
+This returns 2 piddles -- the first set gives the log(gamma) values,
+while the second set, of integer values, gives the sign of the gamma
+function. This is useful for determining factorials, amongst other
+things.
+
+EOD
+
+} # if: $^O !~ win32
+
+pp_addhdr('
+#include <math.h>
+#include "protos.h"
+/* Change names when fixing glibc-2.1 bug */
+#ifdef MY_FIXY0
+#define y0(a) fixy0(a)
+extern double fixy0(double a);
+#endif
+#ifdef MY_FIXYN
+#define yn(a,b) fixyn(a,b)
+extern double fixyn(int a, double b);
+#endif
+');
+
+## handle various cases of 'finite'
+#
+if ($^O =~ /MSWin/) {
+# _finite in VC++ 4.0
+pp_addhdr('
+#define finite _finite
+#include <float.h>
+#ifdef _MSC_VER
+double rint (double);
+#endif
+');
+}
+
+# patch from Albert Chin
+if ($^O =~ /hpux/) {
+pp_addhdr('
+#ifdef isfinite
+#define finite isfinite
+#endif
+');
+}
+
+# Standard `-lm'
+my (@ufuncs1) = qw(acos asin atan cosh sinh tan tanh); # F,D only
+my (@ufuncs1g) = qw(ceil floor rint); # Any type
+
+# Note:
+# ops.pd has a power() function that does the same thing
+# (although it has OtherPars => 'int swap;' as well)
+# - left this in for now.
+#
+my (@bifuncs1) = qw(pow); # Any type
+
+# Extended `-lm'
+my (@ufuncs2) = qw(acosh asinh atanh erf erfc); # F,D only
+my (@besufuncs) = qw(j0 j1 y0 y1); # "
+my (@besbifuncs) = qw(jn yn); # "
+# Need igamma, ibeta, and a fall-back implementation of the above
+
+sub code_ufunc { return '$b() = ' . $_[0] . '($a());'; }
+sub badcode_ufunc {
+ my $name = $_[0];
+ return 'if ( $ISBAD(a()) ) { $SETBAD(b()); } else { $b() = ' . $name . '($a()); }';
+}
+
+sub code_bifunc {
+ my $name = $_[0]; my $a = $_[1] || 'a'; my $b = $_[2] || 'b';
+ my $c = $_[3] || 'c';
+ return "\$$c() = $name(\$$a(),\$$b());";
+}
+sub badcode_bifunc {
+ my $name = $_[0]; my $a = $_[1] || 'a'; my $b = $_[2] || 'b';
+ my $c = $_[3] || 'c';
+ return 'if ( $ISBAD('.$a.'()) || $ISBAD('.$b.'()) ) { $SETBAD('.$c.'()); } else { ' .
+ "\$$c() = $name(\$$a(),\$$b()); }";
+}
+
+sub inplace_doc {
+ my $func = shift;
+ return "$doco{$func} Works inplace.";
+}
+
+my $func;
+foreach $func (@ufuncs1) {
+ pp_def($func,
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ GenericTypes => ['F','D'],
+ Pars => 'a(); [o]b();',
+ Inplace => 1,
+ Doc => inplace_doc( $func ),
+ Code => code_ufunc($func),
+ BadCode => badcode_ufunc($func),
+ );
+}
+
+foreach $func (@ufuncs1g) {
+ pp_def($func,
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ Pars => 'a(); [o]b();',
+ Inplace => 1,
+ Doc => inplace_doc( $func ),
+ Code => code_ufunc($func),
+ BadCode => badcode_ufunc($func),
+ );
+}
+
+foreach $func (@bifuncs1) {
+ pp_def($func,
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ Pars => 'a(); b(); [o]c();',
+ Inplace => [ 'a' ],
+ Doc => inplace_doc( $func ),
+ Code => code_bifunc($func),
+ BadCode => badcode_bifunc($func),
+ );
+}
+
+# Functions provided by extended -lm
+foreach $func (@ufuncs2) {
+ pp_def($func,
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ GenericTypes => ['F','D'],
+ Pars => 'a(); [o]b();',
+ Inplace => 1,
+ Doc => inplace_doc( $func ),
+ Code => code_ufunc($func),
+ BadCode => badcode_ufunc($func),
+ );
+}
+
+foreach $func (@besufuncs) {
+ my $fname = "bess$func";
+ pp_def($fname,
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ GenericTypes => ['F','D'],
+ Pars => 'a(); [o]b();',
+ Inplace => 1,
+ Doc => inplace_doc( $fname ),
+ Code => code_ufunc($func),
+ BadCode => badcode_ufunc($func),
+ );
+}
+
+foreach $func (@besbifuncs) {
+ my $fname = "bess$func";
+ pp_def($fname,
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ GenericTypes => ['F','D'],
+ Pars => 'a(); int n(); [o]b();',
+ Inplace => [ 'a' ],
+ Doc => inplace_doc( $fname ),
+ Code => code_bifunc($func,'n','a','b'),
+ BadCode => badcode_bifunc($func,'n','a','b'),
+ );
+}
+
+if ($^O !~ /win32/i) {
+ pp_def("lgamma",
+ HandleBad => 1,
+ Pars => 'a(); [o]b(); int[o]s()',
+ Doc => $doco{"lgamma"},
+ Code =>
+ 'extern int signgam;
+ $b() = lgamma($a());
+ $s() = signgam;', # what happens to signgam if $a() is bad?
+ BadCode =>
+ 'extern int signgam;
+ if ( $ISBAD(a()) ) {
+ $SETBAD(b()); $SETBAD(s());
+ } else {
+ $b() = lgamma($a());
+ $s() = signgam;
+ }',
+ );
+} # if: os !~ win32
+
+elsif ($Config{cc} =~ /\bgcc/i) {
+ pp_def("lgamma",
+ HandleBad => 1,
+ Pars => 'a(); [o]b(); int[o]s()',
+ Doc => $doco{"lgamma"},
+ Code =>
+ '$b() = lgamma($a());
+ $s() = tgamma($a()) < 0 ? -1 : 1;', # what happens to signgam if $a() is bad?
+ BadCode =>
+ 'if ( $ISBAD(a()) ) {
+ $SETBAD(b()); $SETBAD(s());
+ } else {
+ $b() = lgamma($a());
+ $s() = tgamma($a()) < 0 ? -1 : 1;
+ }',
+ );
+} # elsif: cc =~ /\bgcc/i
+
+pp_def(
+ 'badmask',
+ Pars => 'a(); b(); [o]c();',
+ Inplace => [ 'a' ],
+ HandleBad => 1,
+ Code =>
+ '$c() = finite($a()) ? $a() : $b();',
+ BadCode =>
+ '$c() = ( finite($a()) && $ISGOOD(a()) ) ? $a() : $b();',
+ CopyBadStatusCode =>
+ 'if ( a == c && $ISPDLSTATEBAD(a) )
+ PDL->propogate_badflag( c, 0 ); /* propogate badflag if inplace AND its changed */
+ $SETPDLSTATEGOOD(c); /* always make sure the output is "good" */
+ ',
+ Doc =>
+'=for ref
+
+Clears all C<infs> and C<nans> in C<$a> to the corresponding value in C<$b>.
+
+badmask can be run with C<$a> inplace:
+
+ badmask($a->inplace,0);
+ $a->inplace->badmask(0);
+
+',
+ BadDoc =>
+ 'If bad values are present, these are also cleared.',
+ );
+
+pp_def(
+ 'isfinite',
+ Pars => 'a(); int [o]mask();',
+ Inplace => 1,
+ HandleBad => 1,
+ Code =>
+ '$mask() = finite((double) $a()) != 0;',
+ BadCode =>
+ '$mask() = finite((double) $a()) != 0 && $ISGOOD($a());',
+ CopyBadStatusCode =>
+ 'if ( a == mask && $ISPDLSTATEBAD(a) )
+ PDL->propogate_badflag( mask, 0 ); /* propogate badflag if inplace AND its changed */
+ $SETPDLSTATEGOOD(mask); /* always make sure the output is "good" */
+ ',
+ Doc =>
+'Sets C<$mask> true if C<$a> is not a C<NaN> or C<inf> (either positive or negative). Works inplace.',
+ BadDoc =>
+'Bad values are treated as C<NaN> or C<inf>.',
+ );
+
+# Extra functions from cephes
+pp_def(
+ "erfi",
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ GenericTypes => ['F','D'],
+ Pars => 'a(); [o]b()',
+ Inplace => 1,
+ Doc => inplace_doc( "erfi" ),
+ Code =>
+ 'extern double ndtri(double), SQRTH;
+ $b() = SQRTH*ndtri((1+(double)$a())/2);',
+ BadCode =>
+ 'extern double ndtri(double), SQRTH;
+ if ( $ISBAD(a()) ) { $SETBAD(b()); }
+ else { $b() = SQRTH*ndtri((1+(double)$a())/2); }',
+ );
+
+pp_def(
+ "ndtri",
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ GenericTypes => ['F','D'],
+ Pars => 'a(); [o]b()',
+ Inplace => 1,
+ Doc => inplace_doc( "ndtri" ),
+ Code =>
+ 'extern double ndtri(double);
+ $b() = ndtri((double)$a());',
+ BadCode =>
+ 'extern double ndtri(double);
+ if ( $ISBAD(a()) ) { $SETBAD(b()); }
+ else { $b() = ndtri((double)$a()); }',
+ );
+
+pp_def("polyroots",
+ Pars => 'cr(n); ci(n); [o]rr(m); [o]ri(m);',
+ RedoDimsCode => 'int sn = $PDL(cr)->dims[0]; $SIZE(m) = sn-1;',
+ GenericTypes => ['D'],
+ Code => '
+ extern int cpoly( double *cr, double *ci, int deg,
+ double *rr, double *ri );
+ int deg = $SIZE(n)-1, i;
+ if (cpoly($P(cr), $P(ci), deg, $P(rr), $P(ri)))
+ barf("PDL::Math::polyroots failed");
+',
+ , Doc => '
+
+=for ref
+
+Complex roots of a complex polynomial, given coefficients in order
+of decreasing powers.
+
+=for usage
+
+ ($rr, $ri) = polyroots($cr, $ci);
+
+',);
+
+pp_addpm({At=>'Bot'},<<'EOD');
+
+=head1 BUGS
+
+Hasn't been tested on all platforms to ensure Cephes
+versions are picked up automatically and used correctly.
+
+=head1 AUTHOR
+
+Copyright (C) R.J.R. Williams 1997 (rjrw at ast.leeds.ac.uk), Karl Glazebrook
+(kgb at aaoepp.aao.gov.au) and Tuomas J. Lukka (Tuomas.Lukka at helsinki.fi).
+Portions (C) Craig DeForest 2002 (deforest at boulder.swri.edu).
+
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the PDL copyright notice should be included in the file.
+
+=cut
+
+EOD
+pp_done();
diff --git a/Basic/Math/mconf.h b/Basic/Math/mconf.h
new file mode 100644
index 0000000..c34606c
--- /dev/null
+++ b/Basic/Math/mconf.h
@@ -0,0 +1,180 @@
+/* mconf.h
+ *
+ * Common include file for math routines
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * #include "mconf.h"
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * This file contains definitions for error codes that are
+ * passed to the common error handling routine mtherr()
+ * (which see).
+ *
+ * The file also includes a conditional assembly definition
+ * for the type of computer arithmetic (IEEE, DEC, Motorola
+ * IEEE, or UNKnown).
+ *
+ * For Digital Equipment PDP-11 and VAX computers, certain
+ * IBM systems, and others that use numbers with a 56-bit
+ * significand, the symbol DEC should be defined. In this
+ * mode, most floating point constants are given as arrays
+ * of octal integers to eliminate decimal to binary conversion
+ * errors that might be introduced by the compiler.
+ *
+ * For little-endian computers, such as IBM PC, that follow the
+ * IEEE Standard for Binary Floating Point Arithmetic (ANSI/IEEE
+ * Std 754-1985), the symbol IBMPC should be defined. These
+ * numbers have 53-bit significands. In this mode, constants
+ * are provided as arrays of hexadecimal 16 bit integers.
+ *
+ * Big-endian IEEE format is denoted MIEEE. On some RISC
+ * systems such as Sun SPARC, double precision constants
+ * must be stored on 8-byte address boundaries. Since integer
+ * arrays may be aligned differently, the MIEEE configuration
+ * may fail on such machines.
+ *
+ * To accommodate other types of computer arithmetic, all
+ * constants are also provided in a normal decimal radix
+ * which one can hope are correctly converted to a suitable
+ * format by the available C language compiler. To invoke
+ * this mode, define the symbol UNK.
+ *
+ * An important difference among these modes is a predefined
+ * set of machine arithmetic constants for each. The numbers
+ * MACHEP (the machine roundoff error), MAXNUM (largest number
+ * represented), and several other parameters are preset by
+ * the configuration symbol. Check the file const.c to
+ * ensure that these values are correct for your computer.
+ *
+ * Configurations NANS, INFINITIES, MINUSZERO, and DENORMAL
+ * may fail on many systems. Verify that they are supposed
+ * to work on your computer.
+ */
+
+/*
+Cephes Math Library Release 2.3: June, 1995
+Copyright 1984, 1987, 1989, 1995 by Stephen L. Moshier
+*/
+
+/* For PDL, use system defaults where possible */
+#include <math.h>
+#if !defined(WIN32) && !defined(_WIN32) && !defined(__APPLE__)
+/* values.h is gone on OpenBSD(?) and depracated on GNU systems */
+/* can we use values.h on all UN*X systems? */
+#if defined __GNUC__
+#include <limits.h>
+#else
+#include <values.h>
+#endif /* __GNUC__ */
+#endif
+#if defined(_WIN32) || defined(WIN32)
+#include <float.h>
+#define finite _finite
+#endif
+
+/* Now include system-specific stuff */
+
+/* Look for system quiet_nan function */
+#if defined __sun && ! defined __GNUC__
+#include <sunmath.h>
+#include <ieeefp.h>
+#include <float.h>
+#define NANARG 1L
+#endif
+#if defined __alpha && ! defined __linux
+#include <float.h>
+#include <nan.h>
+#endif
+#ifndef NANARG
+#define NANARG
+#endif
+
+/* Redefine nan so PDL doesn't die when we see one.
+ OK, nasty, but means the C-code is still as in the original */
+#define nan() quiet_nan(NANARG)
+
+/* Constant definitions for math error conditions */
+
+#ifndef DOMAIN
+#define DOMAIN 1 /* argument domain error */
+#endif
+#ifndef SING
+#define SING 2 /* argument singularity */
+#endif
+#ifndef OVERFLOW
+#define OVERFLOW 3 /* overflow range error */
+#endif
+#ifndef UNDERFLOW
+#define UNDERFLOW 4 /* underflow range error */
+#endif
+#ifndef TLOSS
+#define TLOSS 5 /* total loss of precision */
+#endif
+#ifndef PLOSS
+#define PLOSS 6 /* partial loss of precision */
+#endif
+
+#ifndef EDOM
+#define EDOM 33
+#endif
+#ifndef ERANGE
+#define ERANGE 34
+#endif
+
+/* Complex numeral. */
+typedef struct
+ {
+ double r;
+ double i;
+ } cmplx;
+
+/* Long double complex numeral. */
+typedef struct
+ {
+ double r;
+ double i;
+ } cmplxl;
+
+
+/* Get ANSI function prototypes, if you want them. */
+#ifdef __STDC__
+#define ANSIPROT
+#include "protos.h"
+#else
+int mtherr();
+#endif
+
+/* Variable for error reporting. See mtherr.c. */
+extern int merror;
+
+#ifdef MY_QUIET_NAN
+extern double quiet_nan();
+#endif
+#ifdef MY_INFINITY
+extern double infinity();
+#endif
+
+extern double MACHEP;
+extern double UFLOWTHRESH;
+extern double MAXLOG;
+extern double MINLOG;
+extern double MAXNUM;
+#ifndef PI
+extern double PI;
+#endif
+extern double PIO2;
+extern double PIO4;
+extern double SQRT2;
+extern double SQRTH;
+extern double LOG2E;
+extern double SQ2OPI;
+extern double LOGE2;
+extern double LOGSQ2;
+extern double THPIO4;
+extern double TWOOPI;
diff --git a/Basic/Math/mtherr.c b/Basic/Math/mtherr.c
new file mode 100644
index 0000000..3c91105
--- /dev/null
+++ b/Basic/Math/mtherr.c
@@ -0,0 +1,102 @@
+/* mtherr.c
+ *
+ * Library common error handling routine
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * char *fctnam;
+ * int code;
+ * int mtherr();
+ *
+ * mtherr( fctnam, code );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * This routine may be called to report one of the following
+ * error conditions (in the include file mconf.h).
+ *
+ * Mnemonic Value Significance
+ *
+ * DOMAIN 1 argument domain error
+ * SING 2 function singularity
+ * OVERFLOW 3 overflow range error
+ * UNDERFLOW 4 underflow range error
+ * TLOSS 5 total loss of precision
+ * PLOSS 6 partial loss of precision
+ * EDOM 33 Unix domain error code
+ * ERANGE 34 Unix range error code
+ *
+ * The default version of the file prints the function name,
+ * passed to it by the pointer fctnam, followed by the
+ * error condition. The display is directed to the standard
+ * output device. The routine then returns to the calling
+ * program. Users may wish to modify the program to abort by
+ * calling exit() under severe error conditions such as domain
+ * errors.
+ *
+ * Since all error conditions pass control to this function,
+ * the display may be easily changed, eliminated, or directed
+ * to an error logging device.
+ *
+ * SEE ALSO:
+ *
+ * mconf.h
+ *
+ */
+
+/*
+Cephes Math Library Release 2.0: April, 1987
+Copyright 1984, 1987 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+#include <stdio.h>
+#include "mconf.h"
+
+int merror = 0;
+
+/* Notice: the order of appearance of the following
+ * messages is bound to the error codes defined
+ * in mconf.h.
+ */
+static char *ermsg[7] = {
+"unknown", /* error code 0 */
+"domain", /* error code 1 */
+"singularity", /* et seq. */
+"overflow",
+"underflow",
+"total loss of precision",
+"partial loss of precision"
+};
+
+
+int mtherr( name, code )
+char *name;
+int code;
+{
+
+/* Display string passed by calling program,
+ * which is supposed to be the name of the
+ * function in which the error occurred:
+ */
+printf( "\n%s ", name );
+
+/* Set global error message word */
+merror = code;
+
+/* Display error message defined
+ * by the code argument.
+ */
+if( (code <= 0) || (code >= 7) )
+ code = 0;
+printf( "%s error\n", ermsg[code] );
+
+/* Return to calling
+ * program
+ */
+return( 0 );
+}
diff --git a/Basic/Math/ndtr.c b/Basic/Math/ndtr.c
new file mode 100644
index 0000000..ce08c76
--- /dev/null
+++ b/Basic/Math/ndtr.c
@@ -0,0 +1,301 @@
+/* ndtr.c
+ *
+ * Normal distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, ndtr();
+ *
+ * y = ndtr( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the area under the Gaussian probability density
+ * function, integrated from minus infinity to x:
+ *
+ * x
+ * -
+ * 1 | | 2
+ * ndtr(x) = --------- | exp( - t /2 ) dt
+ * sqrt(2pi) | |
+ * -
+ * -inf.
+ *
+ * = ( 1 + erf(z) ) / 2
+ * = erfc(z) / 2
+ *
+ * where z = x/sqrt(2). Computation is via the functions
+ * erf and erfc.
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC -13,0 8000 2.1e-15 4.8e-16
+ * IEEE -13,0 30000 3.4e-14 6.7e-15
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * erfc underflow x > 37.519379347 0.0
+ *
+ */
+
/* erf.c
+ *
+ * Error function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, erf();
+ *
+ * y = erf( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * The integral is
+ *
+ * x
+ * -
+ * 2 | | 2
+ * erf(x) = -------- | exp( - t ) dt.
+ * sqrt(pi) | |
+ * -
+ * 0
+ *
+ * The magnitude of x is limited to 9.231948545 for DEC
+ * arithmetic; 1 or -1 is returned outside this range.
+ *
+ * For 0 <= |x| < 1, erf(x) = x * P4(x**2)/Q5(x**2); otherwise
+ * erf(x) = 1 - erfc(x).
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0,1 14000 4.7e-17 1.5e-17
+ * IEEE 0,1 30000 3.7e-16 1.0e-16
+ *
+ */
+
/* erfc.c
+ *
+ * Complementary error function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, erfc();
+ *
+ * y = erfc( x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ *
+ * 1 - erf(x) =
+ *
+ * inf.
+ * -
+ * 2 | | 2
+ * erfc(x) = -------- | exp( - t ) dt
+ * sqrt(pi) | |
+ * -
+ * x
+ *
+ *
+ * For small x, erfc(x) = 1 - erf(x); otherwise rational
+ * approximations are computed.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 9.2319 12000 5.1e-16 1.2e-16
+ * IEEE 0,26.6417 30000 5.7e-14 1.5e-14
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * erfc underflow x > 9.231948545 (DEC) 0.0
+ *
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.2: June, 1992
+Copyright 1984, 1987, 1988, 1992 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+
+#include "mconf.h"
+
+extern double SQRTH;
+extern double MAXLOG;
+
+
+static double P[] = {
+ 2.46196981473530512524E-10,
+ 5.64189564831068821977E-1,
+ 7.46321056442269912687E0,
+ 4.86371970985681366614E1,
+ 1.96520832956077098242E2,
+ 5.26445194995477358631E2,
+ 9.34528527171957607540E2,
+ 1.02755188689515710272E3,
+ 5.57535335369399327526E2
+};
+static double Q[] = {
+/* 1.00000000000000000000E0,*/
+ 1.32281951154744992508E1,
+ 8.67072140885989742329E1,
+ 3.54937778887819891062E2,
+ 9.75708501743205489753E2,
+ 1.82390916687909736289E3,
+ 2.24633760818710981792E3,
+ 1.65666309194161350182E3,
+ 5.57535340817727675546E2
+};
+static double R[] = {
+ 5.64189583547755073984E-1,
+ 1.27536670759978104416E0,
+ 5.01905042251180477414E0,
+ 6.16021097993053585195E0,
+ 7.40974269950448939160E0,
+ 2.97886665372100240670E0
+};
+static double S[] = {
+/* 1.00000000000000000000E0,*/
+ 2.26052863220117276590E0,
+ 9.39603524938001434673E0,
+ 1.20489539808096656605E1,
+ 1.70814450747565897222E1,
+ 9.60896809063285878198E0,
+ 3.36907645100081516050E0
+};
+static double T[] = {
+ 9.60497373987051638749E0,
+ 9.00260197203842689217E1,
+ 2.23200534594684319226E3,
+ 7.00332514112805075473E3,
+ 5.55923013010394962768E4
+};
+static double U[] = {
+/* 1.00000000000000000000E0,*/
+ 3.35617141647503099647E1,
+ 5.21357949780152679795E2,
+ 4.59432382970980127987E3,
+ 2.26290000613890934246E4,
+ 4.92673942608635921086E4
+};
+
+#define UTHRESH 37.519379347
+
+#ifndef ANSIPROT
+double polevl(), p1evl(), exp(), log(), fabs();
+double erf(), erfc();
+#endif
+
+double ndtr(a)
+double a;
+{
+double x, y, z;
+
+x = a * SQRTH;
+z = fabs(x);
+
+if( z < SQRTH )
+ y = 0.5 + 0.5 * erf(x);
+
+else
+ {
+ y = 0.5 * erfc(z);
+
+ if( x > 0 )
+ y = 1.0 - y;
+ }
+
+return(y);
+}
+
+
+double erfc(a)
+double a;
+{
+double p,q,x,y,z;
+
+
+if( a < 0.0 )
+ x = -a;
+else
+ x = a;
+
+if( x < 1.0 )
+ return( 1.0 - erf(a) );
+
+z = -a * a;
+
+if( z < -MAXLOG )
+ {
+under:
+ mtherr( "erfc", UNDERFLOW );
+ if( a < 0 )
+ return( 2.0 );
+ else
+ return( 0.0 );
+ }
+
+z = exp(z);
+
+if( x < 8.0 )
+ {
+ p = polevl( x, P, 8 );
+ q = p1evl( x, Q, 8 );
+ }
+else
+ {
+ p = polevl( x, R, 5 );
+ q = p1evl( x, S, 6 );
+ }
+y = (z * p)/q;
+
+if( a < 0 )
+ y = 2.0 - y;
+
+if( y == 0.0 )
+ goto under;
+
+return(y);
+}
+
+
+
+double erf(x)
+double x;
+{
+double y, z;
+
+if( fabs(x) > 1.0 )
+ return( 1.0 - erfc(x) );
+z = x * x;
+y = x * polevl( z, T, 4 ) / p1evl( z, U, 5 );
+return( y );
+
+}
diff --git a/Basic/Math/ndtri.c b/Basic/Math/ndtri.c
new file mode 100644
index 0000000..b1cf74b
--- /dev/null
+++ b/Basic/Math/ndtri.c
@@ -0,0 +1,184 @@
+/* ndtri.c
+ *
+ * Inverse of Normal distribution function
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, ndtri();
+ *
+ * x = ndtri( y );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns the argument, x, for which the area under the
+ * Gaussian probability density function (integrated from
+ * minus infinity to x) is equal to y.
+ *
+ *
+ * For small arguments 0 < y < exp(-2), the program computes
+ * z = sqrt( -2.0 * log(y) ); then the approximation is
+ * x = z - log(z)/z - (1/z) P(1/z) / Q(1/z).
+ * There are two rational functions P/Q, one for 0 < y < exp(-32)
+ * and the other for y up to exp(-2). For larger arguments,
+ * w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)).
+ *
+ *
+ * ACCURACY:
+ *
+ * Relative error:
+ * arithmetic domain # trials peak rms
+ * DEC 0.125, 1 5500 9.5e-17 2.1e-17
+ * DEC 6e-39, 0.135 3500 5.7e-17 1.3e-17
+ * IEEE 0.125, 1 20000 7.2e-16 1.3e-16
+ * IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * ndtri domain x <= 0 -MAXNUM
+ * ndtri domain x >= 1 MAXNUM
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.1: January, 1989
+Copyright 1984, 1987, 1989 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+#include "mconf.h"
+extern double MAXNUM;
+
+/* sqrt(2pi) */
+static double s2pi = 2.50662827463100050242E0;
+
+/* approximation for 0 <= |y - 0.5| <= 3/8 */
+static double P0[5] = {
+-5.99633501014107895267E1,
+ 9.80010754185999661536E1,
+-5.66762857469070293439E1,
+ 1.39312609387279679503E1,
+-1.23916583867381258016E0,
+};
+static double Q0[8] = {
+/* 1.00000000000000000000E0,*/
+ 1.95448858338141759834E0,
+ 4.67627912898881538453E0,
+ 8.63602421390890590575E1,
+-2.25462687854119370527E2,
+ 2.00260212380060660359E2,
+-8.20372256168333339912E1,
+ 1.59056225126211695515E1,
+-1.18331621121330003142E0,
+};
+
+
+/* Approximation for interval z = sqrt(-2 log y ) between 2 and 8
+ * i.e., y between exp(-2) = .135 and exp(-32) = 1.27e-14.
+ */
+static double P1[9] = {
+ 4.05544892305962419923E0,
+ 3.15251094599893866154E1,
+ 5.71628192246421288162E1,
+ 4.40805073893200834700E1,
+ 1.46849561928858024014E1,
+ 2.18663306850790267539E0,
+-1.40256079171354495875E-1,
+-3.50424626827848203418E-2,
+-8.57456785154685413611E-4,
+};
+static double Q1[8] = {
+/* 1.00000000000000000000E0,*/
+ 1.57799883256466749731E1,
+ 4.53907635128879210584E1,
+ 4.13172038254672030440E1,
+ 1.50425385692907503408E1,
+ 2.50464946208309415979E0,
+-1.42182922854787788574E-1,
+-3.80806407691578277194E-2,
+-9.33259480895457427372E-4,
+};
+
+/* Approximation for interval z = sqrt(-2 log y ) between 8 and 64
+ * i.e., y between exp(-32) = 1.27e-14 and exp(-2048) = 3.67e-890.
+ */
+
+static double P2[9] = {
+ 3.23774891776946035970E0,
+ 6.91522889068984211695E0,
+ 3.93881025292474443415E0,
+ 1.33303460815807542389E0,
+ 2.01485389549179081538E-1,
+ 1.23716634817820021358E-2,
+ 3.01581553508235416007E-4,
+ 2.65806974686737550832E-6,
+ 6.23974539184983293730E-9,
+};
+static double Q2[8] = {
+/* 1.00000000000000000000E0,*/
+ 6.02427039364742014255E0,
+ 3.67983563856160859403E0,
+ 1.37702099489081330271E0,
+ 2.16236993594496635890E-1,
+ 1.34204006088543189037E-2,
+ 3.28014464682127739104E-4,
+ 2.89247864745380683936E-6,
+ 6.79019408009981274425E-9,
+};
+
+#ifndef ANSIPROT
+double polevl(), p1evl(), log(), sqrt();
+#endif
+
+double ndtri(y0)
+double y0;
+{
+double x, y, z, y2, x0, x1;
+int code;
+
+if( y0 <= 0.0 )
+ {
+ mtherr( "ndtri", DOMAIN );
+ return( -MAXNUM );
+ }
+if( y0 >= 1.0 )
+ {
+ mtherr( "ndtri", DOMAIN );
+ return( MAXNUM );
+ }
+code = 1;
+y = y0;
+if( y > (1.0 - 0.13533528323661269189) ) /* 0.135... = exp(-2) */
+ {
+ y = 1.0 - y;
+ code = 0;
+ }
+
+if( y > 0.13533528323661269189 )
+ {
+ y = y - 0.5;
+ y2 = y * y;
+ x = y + y * (y2 * polevl( y2, P0, 4)/p1evl( y2, Q0, 8 ));
+ x = x * s2pi;
+ return(x);
+ }
+
+x = sqrt( -2.0 * log(y) );
+x0 = x - log(x)/x;
+
+z = 1.0/x;
+if( x < 8.0 ) /* y > exp(-32) = 1.2664165549e-14 */
+ x1 = z * polevl( z, P1, 8 )/p1evl( z, Q1, 8 );
+else
+ x1 = z * polevl( z, P2, 8 )/p1evl( z, Q2, 8 );
+x = x0 - x1;
+if( code != 0 )
+ x = -x;
+return( x );
+}
diff --git a/Basic/Math/polevl.c b/Basic/Math/polevl.c
new file mode 100644
index 0000000..f11fe4d
--- /dev/null
+++ b/Basic/Math/polevl.c
@@ -0,0 +1,98 @@
+/* polevl.c
+ * p1evl.c
+ * XXX
+ *
+ * Evaluate polynomial
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int N;
+ * double x, y, coef[N+1], polevl[];
+ *
+ * y = polevl( x, coef, N );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Evaluates polynomial of degree N:
+ *
+ * 2 N
+ * y = C + C x + C x +...+ C x
+ * 0 1 2 N
+ *
+ * Coefficients are stored in reverse order:
+ *
+ * coef[0] = C , ..., coef[N] = C .
+ * N 0
+ *
+ * The function p1evl() assumes that coef[N] = 1.0 and is
+ * omitted from the array. Its calling arguments are
+ * otherwise the same as polevl().
+ *
+ *
+ * SPEED:
+ *
+ * In the interest of speed, there are no checks for out
+ * of bounds arithmetic. This routine is used by most of
+ * the functions in the library. Depending on available
+ * equipment features, the user may wish to rewrite the
+ * program in microcode or assembly language.
+ *
+ */
+
+
+/*
+Cephes Math Library Release 2.1: December, 1988
+Copyright 1984, 1987, 1988 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+
+double polevl( x, coef, N )
+double x;
+double coef[];
+int N;
+{
+double ans;
+int i;
+double *p;
+
+p = coef;
+ans = *p++;
+i = N;
+
+do
+ ans = ans * x + *p++;
+while( --i );
+
+return( ans );
+}
+
+/* p1evl() */
+/* N
+ * Evaluate polynomial when coefficient of x is 1.0.
+ * Otherwise same as polevl.
+ */
+
+double p1evl( x, coef, N )
+double x;
+double coef[];
+int N;
+{
+double ans;
+double *p;
+int i;
+
+p = coef;
+ans = x + *p++;
+i = N-1;
+
+do
+ ans = ans * x + *p++;
+while( --i );
+
+return( ans );
+}
diff --git a/Basic/Math/protos.h b/Basic/Math/protos.h
new file mode 100644
index 0000000..1a54099
--- /dev/null
+++ b/Basic/Math/protos.h
@@ -0,0 +1,45 @@
+/*
+ * This file was automatically generated by version 1.7 of cextract.
+ * Manual editing not recommended.
+ *
+ * Created: Fri Nov 28 17:00:03 1997
+ */
+#ifndef __CEXTRACT__
+#if __STDC__
+
+extern double asinh ( double xx );
+extern double j0 ( double x );
+extern double y0 ( double x );
+extern double jn ( int n, double x );
+extern double ndtr ( double a );
+extern double erfc ( double a );
+extern double erf ( double x );
+extern double acosh ( double x );
+extern double atanh ( double x );
+extern double j1 ( double x );
+extern double y1 ( double x );
+extern int mtherr ( char *name, int code );
+extern double polevl ( double x, double coef[], int N );
+extern double p1evl ( double x, double coef[], int N );
+extern double yn ( int n, double x );
+
+#else /* __STDC__ */
+
+extern double asinh (/* double xx */);
+extern double j0 (/* double x */);
+extern double y0 (/* double x */);
+extern double jn (/* int n, double x */);
+extern double ndtr (/* double a */);
+extern double erfc (/* double a */);
+extern double erf (/* double x */);
+extern double acosh (/* double x */);
+extern double atanh (/* double x */);
+extern double j1 (/* double x */);
+extern double y1 (/* double x */);
+extern int mtherr (/* char *name, int code */);
+extern double polevl (/* double x, double coef[], int N */);
+extern double p1evl (/* double x, double coef[], int N */);
+extern double yn (/* int n, double x */);
+
+#endif /* __STDC__ */
+#endif /* __CEXTRACT__ */
diff --git a/Basic/Math/quiet_nan.c b/Basic/Math/quiet_nan.c
new file mode 100644
index 0000000..1e5845a
--- /dev/null
+++ b/Basic/Math/quiet_nan.c
@@ -0,0 +1,12 @@
+#include "mconf.h"
+/* Patch NaN function where no system NaN is available */
+double quiet_nan(void)
+{
+#ifdef NaN
+ double a;
+ return NaN(a);
+#else
+ double a=0;
+ return 0./a; /* Expect bad value error */
+#endif
+}
diff --git a/Basic/Math/rint.c b/Basic/Math/rint.c
new file mode 100644
index 0000000..7d3ba4f
--- /dev/null
+++ b/Basic/Math/rint.c
@@ -0,0 +1,42 @@
+/*
+ * Round to neareast integer
+ *
+ * SYNOPSIS:
+ *
+ * double rint(double x);
+ *
+ * DESCRIPTION:
+ *
+ * Returns the integer (represented as a double precision number)
+ * nearest to x. For half-integers, this implements "banker's
+ * rounding", or round-half-to-even, in which half integers are
+ * rounded to the nearest even integer. For other floating-point
+ * numbers, returns floor(x + 0.5);
+ *
+ * Copyright (c) 1998, Raphael Manfredi <Raphael_Manfredi at hp.com>
+ * (c) 2010, Derek Lamb <lambd at users.sourceforge.net>
+
+ Note that other functions in PDL::Math use code from the Cephes math
+ library. If this new Banker's rounding code causes some problems, it
+ is possible to rename the round.c provided therein and use it here.
+
+All rights reserved. There is no warranty. You are allowed to
+ redistribute this software / documentation under certain
+ conditions. For details, see the file COPYING in the PDL
+ distribution. If this file is separated from the PDL distribution,
+ the copyright notice should be included in the file.
+
+ */
+
+#include "mconf.h"
+
+double rint(x)
+double x;
+{ //could do recursion but this is probably more memory efficient.
+ int i = x; //just get the integer part
+ if (x<0 && (i==x+0.5)){//if it is a neg half integer
+ return i-(i&1); //subtract one if it is odd
+ } else if (x>0 && (i==x-0.5)){//if it is a pos half integer
+ return i+(i&1); //add one if it is odd
+ } else return floor(x+0.5);
+}
diff --git a/Basic/Math/yn.c b/Basic/Math/yn.c
new file mode 100644
index 0000000..e793d19
--- /dev/null
+++ b/Basic/Math/yn.c
@@ -0,0 +1,113 @@
+/* yn.c
+ *
+ * Bessel function of second kind of integer order
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double x, y, yn();
+ * int n;
+ *
+ * y = yn( n, x );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * Returns Bessel function of order n, where n is a
+ * (possibly negative) integer.
+ *
+ * The function is evaluated by forward recurrence on
+ * n, starting with values computed by the routines
+ * y0() and y1().
+ *
+ * If n = 0 or 1 the routine for y0 or y1 is called
+ * directly.
+ *
+ *
+ *
+ * ACCURACY:
+ *
+ *
+ * Absolute error, except relative
+ * when y > 1:
+ * arithmetic domain # trials peak rms
+ * DEC 0, 30 2200 2.9e-16 5.3e-17
+ * IEEE 0, 30 30000 3.4e-15 4.3e-16
+ *
+ *
+ * ERROR MESSAGES:
+ *
+ * message condition value returned
+ * yn singularity x = 0 MAXNUM
+ * yn overflow MAXNUM
+ *
+ * Spot checked against tables for x, n between 0 and 100.
+ *
+ */
+
+/*
+Cephes Math Library Release 2.1: December, 1988
+Copyright 1984, 1987 by Stephen L. Moshier
+Direct inquiries to 30 Frost Street, Cambridge, MA 02140
+*/
+
+#include "mconf.h"
+extern double MAXNUM, MAXLOG;
+
+#ifdef MY_FIXYN
+double fixyn( n, x )
+#else
+double yn( n, x )
+#endif
+int n;
+double x;
+{
+double an, anm1, anm2, r;
+double y0(), y1(), log();
+int k, sign;
+
+if( n < 0 )
+ {
+ n = -n;
+ if( (n & 1) == 0 ) /* -1**n */
+ sign = 1;
+ else
+ sign = -1;
+ }
+else
+ sign = 1;
+
+
+if( n == 0 )
+ return( sign * y0(x) );
+if( n == 1 )
+ return( sign * y1(x) );
+
+/* test for overflow */
+if( x <= 0.0 )
+ {
+ mtherr( "yn", SING );
+ return( -MAXNUM );
+ }
+
+/* forward recurrence on n */
+
+anm2 = y0(x);
+anm1 = y1(x);
+k = 1;
+r = 2 * k;
+do
+ {
+ an = r * anm1 / x - anm2;
+ anm2 = anm1;
+ anm1 = an;
+ r += 2.0;
+ ++k;
+ }
+while( k < n );
+
+
+return( sign * an );
+}
diff --git a/Basic/Matrix.pm b/Basic/Matrix.pm
new file mode 100644
index 0000000..1faacb0
--- /dev/null
+++ b/Basic/Matrix.pm
@@ -0,0 +1,446 @@
+=head1 NAME
+
+PDL::Matrix -- a convenience matrix class for column-major access
+
+=head1 VERSION
+
+This document refers to version PDL::Matrix 0.5 of PDL::Matrix
+
+=head1 SYNOPSIS
+
+ use PDL::Matrix;
+
+ $m = mpdl [[1,2,3],[4,5,6]];
+ $m = PDL::Matrix->pdl([[1,2,3],[4,5,6]]);
+ $m = msequence(4,3);
+ @dimsa = $a->mdims; # 'dims' is not overloaded
+
+ $v = vpdl [0,1,2,3]
+ $v = vzeroes(4);
+
+=head1 DESCRIPTION
+
+=head2 Overview
+
+This package tries to help people who want to use PDL for 2D matrix
+computation with lots of indexing involved. It provides a PDL
+subclass so one- and two-dimensional piddles that are used as
+vectors resp and matrices can be typed in using traditional matrix
+convention.
+
+If you want to know more about matrix operation support in PDL, you
+want to read L<PDL::MatrixOps> or L<PDL::Slatec>.
+
+The original pdl class refers to the first index as the first row,
+the second index as the first column of a matrix. Consider
+
+ print $B = sequence(3,2)
+ [
+ [0 1 2]
+ [3 4 5]
+ ]
+
+which gives a 2x3 matrix in terms of the matrix convention, but the
+constructor used (3,2). This might get more confusing when using
+slices like sequence(3,2)->slice("1:2,(0)") : with traditional
+matrix convention one would expect [2 4] instead of [1 2].
+
+This subclass PDL::Matrix overloads the constructors and indexing
+functions of pdls so that they are compatible with the usual matrix
+convention, where the first dimension refers to the row of a
+matrix. So now, the above example would be written as
+
+ print $B = PDL::Matrix->sequence(3,2) # or $B = msequence(3,2)
+ [
+ [0 1]
+ [2 3]
+ [4 5]
+ ]
+
+Routines like L<eigens|PDL::MatrixOps/eigens> or
+L<inv|PDL::MatrixOps/inv> can be used without any changes.
+
+Furthermore one can construct and use vectors as n x 1 matrices
+without mentioning the second index '1'.
+
+=head2 Implementation
+
+C<PDL::Matrix> works by overloading a number of PDL constructors
+and methods such that first and second args (corresponding to
+first and second dims of corresponding matrices) are effectively swapped.
+It is not yet clear if PDL::Matrix achieves a consistent column-major
+look-and-feel in this way.
+
+=head1 NOTES
+
+As of version 0.5 (rewrite by CED) the matrices are stored in the usual
+way, just constructed and stringified differently. That way indexing
+and everything else works the way you think it should.
+
+=head1 FUNCTIONS
+
+=cut
+
+package PDL::Matrix;
+
+ at EXPORT_OK = ();
+
+
+#use PDL::Core;
+#use PDL::Slatec;
+use PDL::Exporter;
+use Carp;
+
+ at ISA = qw/PDL::Exporter PDL/;
+
+our $VERSION = "0.5";
+$VERSION = eval $VERSION;
+
+#######################################################################=
+#########
+#
+# overloads
+
+use overload( '""' => \&string,
+ 'x' => sub {my $foo = $_[0]->null();
+ &PDL::Primitive::matmult(@_[1,0],$foo);
+ $foo;}
+ );
+
+sub string {
+ my ($me, at a) = shift;
+ return $me->SUPER::string(@a) unless($me->ndims > 0);
+ $me = $me->dummy(1,1) unless($me->ndims > 1);
+ $me->xchg(0,1)->SUPER::string(@a);
+}
+
+
+# --------> constructors
+
+=head2 mpdl, PDL::Matrix::pdl
+
+=for ref
+
+constructs an object of class PDL::Matrix which is a piddle child class.
+
+=for example
+
+ $m = mpdl [[1,2,3],[4,5,6]];
+ $m = PDL::Matrix->pdl([[1,2,3],[4,5,6]]);
+
+=cut
+
+sub pdl {
+ my $class = shift;
+ my $pdl = $class->SUPER::pdl(@_);
+ if($pdl->ndims > 0) {
+ $pdl = $pdl->dummy(1,1) unless $pdl->ndims > 1;
+ $pdl = $pdl->xchg(0,1);
+ }
+ bless $pdl, ref $class || $class;
+}
+
+=head2 mzeroes, mones, msequence
+
+=for ref
+
+constructs a PDL::Matrix object similar to the piddle constructors
+zeroes, ones, sequence.
+
+=cut
+
+for my $func (qw /pdl zeroes ones sequence dims/) {
+ push @EXPORT_OK, "m$func";
+ eval " sub m$func { PDL::Matrix->$func(\@_) }; ";
+}
+
+=head2 vpdl
+
+=for ref
+
+constructs an object of class PDL::Matrix which is of matrix
+dimensions (n x 1)
+
+=for example
+
+ print $v = vpdl [0,1];
+ [
+ [0]
+ [1]
+ ]
+
+=cut
+
+sub vpdl {
+ my $pdl = PDL->pdl(@_);
+ bless $pdl, PDL::Matrix;
+}
+push @EXPORT_OK, "vpdl";
+
+=head2 vzeroes, vones, vsequence
+
+=for ref
+
+constructs a PDL::Matrix object with matrix dimensions (n x 1),
+therefore only the first scalar argument is used.
+
+=for example
+
+ print $v = vsequence(2);
+ [
+ [0]
+ [1]
+ ]
+
+=cut
+
+for my $func (qw /zeroes ones sequence/) {
+ push @EXPORT_OK, "v$func";
+ my $code = << "EOE";
+
+sub v$func {
+ my \@arg = \@_;
+ ref(\$arg[0]) ne 'PDL::Type' ? (\@arg = (\$arg[0],1)) :
+ (\@arg = (\$arg[0],\$arg[1],1));
+ PDL::Matrix->$func(\@arg);
+}
+
+EOE
+# print "evaluating $code\n";
+ eval $code;
+}
+
+
+
+eval "use PDL::Slatec";
+
+my $has_slatec = ($@ ? 0 : 1);
+sub inv {
+ my $self = shift;
+ croak "inv: PDL::Slatec not available" unless $has_slatec;
+ return $self->matinv;
+}
+
+=head2 kroneckerproduct
+
+=for ref
+
+returns kroneckerproduct of two matrices. This is not efficiently
+implemented.
+
+=for example
+print kroneckerproduct(msequence(2,2),mones(2,2))
+[
+ [0 0 1 1]
+ [0 0 1 1]
+ [2 2 3 3]
+ [2 2 3 3]
+]
+
+=cut
+
+# returns kroneckerproduct of two matrices
+sub kroneckerproduct {
+ my @arg = @_;
+
+ my ($r0,$c0) = $arg[0]->mdims;
+ my ($r1,$c1) = $arg[1]->mdims;
+
+ my $out = mzeroes($r0*$r1,$c0*$c1);
+
+ for (my $i=0;$i<$r0;$i++) {
+ for (my $j=0;$j<$c0;$j++) {
+ ($_ = $out->slice(($i*$r1).":".(($i+1)*$r1-1).",".
+ ($j*$c1).":".(($j+1)*$c1-1)) ) .= $arg[0]->at($i,$j) * $arg[1];
+ }
+ }
+
+ return $out;
+}
+push @EXPORT_OK, "kroneckerproduct";
+
+sub rotate {
+ my ($self, at args) = @_;
+ return $self->transpose->SUPER::rotate(@args)->transpose;
+}
+
+
+sub msumover {
+ my ($mpdl) = @_;
+ return PDL::sumover(transpose($mpdl)->xchg(0,2));
+}
+push @EXPORT_OK, "msumover";
+
+
+=head2 det_general
+
+=for ref
+
+returns a generalized determinant of a matrix. If the matrix is not
+regular, one can specify the rank of the matrix and the corresponding
+subdeterminant is returned. This is implemented using the C<eigens>
+function.
+
+=for example
+print msequence(3,3)->determinant(2) # determinant of
+ # regular 2x2 submatrix
+-24
+
+=cut
+
+#
+sub det_general {
+ my ($mpdl,$rank) = @_;
+ my $eigenvalues = (PDL::Math::eigens($mpdl))[1];
+ my @sort = list(PDL::Ufunc::qsorti(abs($eigenvalues)));
+ $eigenvalues = $eigenvalues->dice([@sort[-$rank..-1]]);
+ PDL::Ufunc::dprod($eigenvalues);
+}
+
+=head2 trace
+
+=for ref
+
+returns the trace of a matrix (sum of diagonals)
+
+=cut
+
+sub trace {
+ my ($mpdl) = @_;
+ $mpdl->diagonal(0,1)->sum;
+}
+
+# this has to be overloaded so that the PDL::slice
+# is called and not PDL::Matrix::slice :-(
+sub dummy($$;$) {
+ my ($pdl,$dim) = @_;
+ $dim = $pdl->getndims+1+$dim if $dim < 0;
+ barf ("too high/low dimension in call to dummy, allowed min/max=0/"
+ . $_[0]->getndims)
+ if $dim>$pdl->getndims || $dim < 0;
+ $_[2] = 1 if ($#_ < 2);
+ $pdl->PDL::slice((','x$dim)."*$_[2]");
+}
+
+
+# now some of my very own helper functions...
+# stupid function to print a PDL::Matrix object in Maple code
+sub stringifymaple {
+ my ($self, at args) = @_;
+
+ my ($dimR,$dimC) = mdims($self);
+ my $s;
+
+ $s .= $args[0].":=" unless $args[0] eq "";
+ if (defined($dimR)) {
+ $s .= "matrix($dimR,$dimC,[";
+ for(my $i=0;$i<$dimR;++$i) {
+ $s .= "[";
+ for(my $j=0;$j<$dimC;++$j) {
+ $s .= $self->at($i,$j);
+ $s .= "," if $j+1<$dimC;
+ }
+ $s .= "]";
+ $s .= "," if $i+1<$dimR;
+ }
+ $s .= "])";
+ }
+ else {
+ $s = "vector($dimC,[";
+ for(my $i=0;$i<$dimC;++$i) {
+ $s .= $self->at($i);
+ $s .= "," if $i+1<$dimC;
+ }
+ $s .= "])";
+ }
+ return $s;
+}
+sub printmaple {
+ print stringifymaple(@_).";\n";
+}
+
+# stupid function to print a PDL::Matrix object in (La)TeX code
+sub stringifyTeX {
+ my ($self, at args) = @_;
+
+ my ($dimR,$dimC) = mdims($self);
+ my $s;
+
+ $s .= $args[0]."=" unless $args[0] eq "";
+ $s .= "\\begin{pmatrix}\n";
+ for(my $i=0;$i<$dimR;++$i) {
+ for(my $j=0;$j<$dimC;++$j) {
+ $s .= $self->at($i,$j);
+ $s .= " & " if $j+1<$dimC;
+ }
+ $s .= " \\\\ \n" if $i+1<$dimR;
+ }
+ $s .= "\n \\end{pmatrix}\n";
+
+ return $s;
+}
+
+sub printTeX {
+ print stringifyTeX(@_)."\n";
+}
+
+=pod
+
+=begin comment
+
+DAL commented this out 17-June-2008. It didn't work, it used the
+outmoded (and incorrect) ~-is-transpose convention, and it wasn't
+necessary since the regular cross product worked fine.
+
+=head2 vcrossp, PDL::Matrix::crossp
+
+=for ref
+
+similar to PDL::crossp, however reflecting PDL::Matrix notations
+
+#=cut
+
+# crossp for my special vectors
+sub crossp {
+ my ($pdl1,$pdl2) = @_;
+ return PDL::transpose(PDL::crossp(~$pdl1,~$pdl2));
+}
+sub vcrossp { PDL::Matrix->crossp(\@_) }
+push @EXPORT_OK, "vcrossp";
+
+=end comment
+
+=cut
+
+%EXPORT_TAGS = (Func=>[@EXPORT_OK]);
+
+1;
+
+=head1 BUGS AND PROBLEMS
+
+Because we change the way piddles are constructed, not all pdl
+operators may be applied to piddle-matrices. The inner product is not
+redefined. We might have missed some functions/methods. Internal
+consistency of our approach needs yet to be established.
+
+Because PDL::Matrix changes the way slicing behaves, it breaks many
+operators, notably those in MatrixOps.
+
+=head1 TODO
+
+check all PDL functions, benchmarks, optimization, lots of other things ...
+
+=head1 AUTHOR(S)
+
+Stephan Heuel (stephan at heuel.org), Christian Soeller
+(c.soeller at auckland.ac.nz).
+
+=head1 COPYRIGHT
+
+All rights reserved. There is no warranty. You are allowed to
+redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution, the
+copyright notice should be included in the file.
+
+=cut
diff --git a/Basic/MatrixOps/Makefile.PL b/Basic/MatrixOps/Makefile.PL
new file mode 100644
index 0000000..2071c8b
--- /dev/null
+++ b/Basic/MatrixOps/Makefile.PL
@@ -0,0 +1,20 @@
+use ExtUtils::MakeMaker;
+
+ at pack = (["matrixops.pd",MatrixOps,PDL::MatrixOps]);
+%hash = pdlpp_stdargs_int(@::pack);
+
+PDL::Core::Dev->import();
+
+$hash{OBJECT} = "" unless exists $hash{OBJECT};
+
+foreach my $file (qw (blas eigens simq svd eigen complex matrix sslib)) {
+ $hash{OBJECT} .= " $file\$(OBJ_EXT)";
+}
+
+$hash{LIBS}->[0] .= " -lm ";
+
+WriteMakefile( %hash );
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+}
diff --git a/Basic/MatrixOps/NOTES b/Basic/MatrixOps/NOTES
new file mode 100644
index 0000000..896c22b
--- /dev/null
+++ b/Basic/MatrixOps/NOTES
@@ -0,0 +1,28 @@
+20-Jun-2006
+
+Moved the "Small Science Libraty" code from ssl/ into this directory
+to avoid having to deal with OS/system-specific make files.
+
+Changed nan("") to atof("NaN") on Solaris machines (done in a quick
+way; should be handled in Basic/Core/ or top-level Makefile.PL).
+
+--Doug Burke
+
+7-Jan-2004
+
+Added a subset of the "Small Science Library" available from
+geisshirt.dk, to handle eigens work. The former 'eigens.c' is
+now relegated to 'eigens_sym'.
+
+19-Nov-2002
+
+This is intended to be a useful repository of self-contained linear
+algebra routines. Some of the stuff has been stolen from ../Math,
+which in turn used the Cephes maths library sources. Some of it was
+ported to PDL from the algorithms in _Numerical_Recipes_, but the
+original C code should probably be used if the copyrights allow it.
+
+--Craig DeForest
+
+
+
diff --git a/Basic/MatrixOps/README.ssl b/Basic/MatrixOps/README.ssl
new file mode 100644
index 0000000..78edc76
--- /dev/null
+++ b/Basic/MatrixOps/README.ssl
@@ -0,0 +1,37 @@
+Files in this directory are a subset, slightly modified, of the Small
+Scientific Library by Kenneth Geisshirt. They may be distributed and
+modified under the same terms as PDL itself.
+
+------------------------------
+
+From kenneth at geisshirt.dk Thu Jan 13 14:40:30 2005
+Message-ID: <41E6EACE.6010600 at geisshirt.dk>
+Date: Thu, 13 Jan 2005 22:40:30 +0100
+From: Kenneth Geisshirt <kenneth at geisshirt.dk>
+To: deforest at boulder.swri.edu
+Subject: Re: Small Scientific Library use within Perl/PDL?
+
+Craig DeForest wrote:
+
+> I notice that, while you have made SSL available for download, there is no
+> indication that it is free software. Are you willing to distribute SSL under
+> the Perl Artistic License (or some other free software license)?
+
+That's my mistake: SSLib is free software. I'll create a new tar ball
+this weekend (including a license). I'll probably use the MIT X License
+since it's the less restricted license I know.
+
+If you decide to use some of my routines in PDL I'll be very happy. And
+if you need any help please let me know.
+
+SSLib is a very simple library - not that the routines are simple but
+the API is on a basic level and the application programmer must be very
+aware of how to call routines and use the data structure.
+
+/kneth
+
+--
+Kenneth Geisshirt, M.Sc., Ph.D. -- http://kenneth.geisshirt.dk/
+GPG Fingerprint: CEC4 7449 1B9B C8A5 7679 F062 DDDF 020E F812 4EE3
+
+
diff --git a/Basic/MatrixOps/blas.c b/Basic/MatrixOps/blas.c
new file mode 100644
index 0000000..242de36
--- /dev/null
+++ b/Basic/MatrixOps/blas.c
@@ -0,0 +1,157 @@
+/* Assorted matrix functions.
+ */
+
+
+/* Multiply r (rows) by c (columns) matrix A on the left
+ * by column vector V of dimension c on the right
+ * to produce a (column) vector Y output of dimension r.
+ */
+mvmpy( r, c, A, V, Y )
+int r, c;
+double *A, *V, *Y;
+{
+register double s;
+double *pA, *pV, *pY;
+int i, j;
+
+pA = A;
+pY = Y;
+for( i=0; i<r; i++ )
+ {
+ pV = V;
+ s = 0.0;
+ for( j=0; j<c; j++ )
+ {
+ s += *pA++ * *pV++;
+ }
+ *pY++ = s;
+ }
+}
+
+
+/* Multiply an r (rows) by c (columns) matrix A on the left
+ * by a c (rows) by r (columns) matrix B on the right
+ * to produce an r by r matrix Y.
+ */
+mmmpy( r, c, A, B, Y )
+int r, c;
+double *A, *B, *Y;
+{
+register double s;
+double *pA, *pB, *pY, *pt;
+int i, j, k;
+
+pY = Y;
+pB = B;
+for( i=0; i<r; i++ )
+ {
+ pA = A;
+ for( j=0; j<r; j++ )
+ {
+ pt = pB;
+ s = 0.0;
+ for( k=0; k<c; k++ )
+ {
+ s += *pA++ * *pt;
+ pt += r; /* increment to next row underneath */
+ }
+ *pY++ = s;
+ }
+ pB += 1;
+ }
+}
+
+
+/* Transpose the n by n square matrix A and put the result in T.
+ * T may occupy the same storage as A.
+ */
+mtransp( n, A, T )
+int n;
+double *A, *T;
+{
+int i, j, np1;
+double *pAc, *pAr, *pTc, *pTr, *pA0, *pT0;
+double x, y;
+
+np1 = n+1;
+pA0 = A;
+pT0 = T;
+for( i=0; i<n-1; i++ ) /* row index */
+ {
+ pAc = pA0; /* next diagonal element of input */
+ pAr = pAc + n; /* next row down underneath the diagonal element */
+ pTc = pT0; /* next diagonal element of the output */
+ pTr = pTc + n; /* next row underneath */
+ *pTc++ = *pAc++; /* copy the diagonal element */
+ for( j=i+1; j<n; j++ ) /* column index */
+ {
+ x = *pAr;
+ *pTr = *pAc++;
+ *pTc++ = x;
+ pAr += n;
+ pTr += n;
+ }
+ pA0 += np1; /* &A[n*i+i] for next i */
+ pT0 += np1; /* &T[n*i+i] for next i */
+ }
+*pT0 = *pA0; /* copy the diagonal element */
+}
+
+
+/* Return maximum off-diagonal element of n by n square matrix A
+ */
+double maxoffd( n, A )
+int n;
+double *A;
+{
+double e, x;
+int i, j, nm1;
+double *pA;
+
+nm1 = n-1;
+e = 0.0;
+pA = A;
+for( i=0; i<nm1; i++ )
+ {
+ ++pA; /* skip over the diagonal element */
+ for( j=0; j<n; j++ )
+ {
+ x = *pA++;
+ if( x < 0 )
+ x = -x;
+ if( x > e )
+ e = x;
+ }
+ }
+return( e );
+}
+
+
+
+
+/* Unpack symmetric matrix T stored in lower triangular form
+ * into a symmetric n by n square matrix S.
+ */
+tritosquare( n, T, S )
+int n;
+double T[], S[];
+{
+double *pT;
+int i, j, ni, nj;
+
+/* offset to (i,j) element is (j*j+j)/2 + i */
+pT = T;
+ni = 0;
+for( i=0; i<n; i++ )
+ {
+ nj = 0;
+ for( j=0; j<i; j++ )
+ {
+ S[ni+j] = *pT;
+ S[nj+i] = *pT++;
+ nj += n;
+ }
+ S[ni+i] = *pT++;
+ ni += n;
+ }
+}
diff --git a/Basic/MatrixOps/complex.c b/Basic/MatrixOps/complex.c
new file mode 100644
index 0000000..0dbf9fa
--- /dev/null
+++ b/Basic/MatrixOps/complex.c
@@ -0,0 +1,70 @@
+/* complex.c - a small library for doing complex algebra in C.
+ *
+ * (C) Copyright 2001 by NetGroup A/S. All rights reserved.
+ *
+ * $Log$
+ * Revision 1.1 2006/06/20 15:57:22 djburke
+ * Hopefully a saner way to build Basic/MatrixOps
+ *
+ * Revision 1.1 2005/01/08 09:22:57 zowie
+ * Added non-symmetric matrices to eigens; updated version to 2.4.2cvs.
+ *
+ * Revision 1.1.1.1 2001/07/06 13:39:35 kneth
+ * Initial import of code.
+ *
+ *
+ */
+
+
+#include <math.h>
+#include "complex.h"
+
+void SSL_ComplexAssign(double re, double im, SSL_Complex *z) {
+
+ z->re=re;
+ z->im=im;
+} /* SSL_ComplexAssign */
+
+
+void SSL_ComplexAdd(SSL_Complex z1, SSL_Complex z2, SSL_Complex *res) {
+
+ res->re=z1.re+z2.re;
+ res->im=z1.im+z2.im;
+} /* SSL_ComplexAdd */
+
+
+void SSL_ComplexSub(SSL_Complex z1, SSL_Complex z2, SSL_Complex *res) {
+
+ res->re=z1.re-z2.re;
+ res->im=z1.im-z2.im;
+} /* SSL_ComplexSub */
+
+
+void SSL_ComplexMul(SSL_Complex z1, SSL_Complex z2, SSL_Complex *res) {
+
+ res->re=z1.re*z2.re-z1.im*z2.im;
+ res->im=z1.re*z2.im+z1.im*z2.re;
+} /* SSL_ComplexMul */
+
+
+void SSL_ComplexDiv(SSL_Complex a, SSL_Complex b, SSL_Complex *res) {
+
+ double temp;
+
+ temp=b.re*b.re+b.im*b.im;
+ res->re=(a.re*b.re+a.im*b.im)/temp;
+ res->im=(a.im*b.re-a.re*b.im)/temp;
+} /* SSL_ComplexDiv */
+
+
+double SSL_ComplexNorm(SSL_Complex z) {
+
+ return (sqrt(z.re*z.re+z.im*z.im));
+} /* SSL_ComplexNorm */
+
+
+double SSL_ComplexArg(SSL_Complex z) {
+
+ return (atan2(z.im, z.re));
+} /* SSL_ComplexArg */
+
diff --git a/Basic/MatrixOps/complex.h b/Basic/MatrixOps/complex.h
new file mode 100644
index 0000000..e0aae5a
--- /dev/null
+++ b/Basic/MatrixOps/complex.h
@@ -0,0 +1,35 @@
+/* complex.h - a small library for doing complex algebra in C.
+ *
+ * (C) Copyright 2001 by NetGroup A/S. All rights reserved.
+ *
+ * $Log$
+ * Revision 1.1 2006/06/20 15:57:22 djburke
+ * Hopefully a saner way to build Basic/MatrixOps
+ *
+ * Revision 1.1 2005/01/08 09:22:57 zowie
+ * Added non-symmetric matrices to eigens; updated version to 2.4.2cvs.
+ *
+ * Revision 1.1.1.1 2001/07/06 13:39:35 kneth
+ * Initial import of code.
+ *
+ *
+ */
+
+#ifndef SSL_COMPLEX_H_
+#define SSL_COMPLEX_H_
+
+struct SSL_ComplexStruct {
+ double re, im;
+}; /* struct SSL_ComplexStruct */
+
+typedef struct SSL_ComplexStruct SSL_Complex;
+
+extern void SSL_ComplexAssign(double, double, SSL_Complex *);
+extern void SSL_ComplexAdd(SSL_Complex, SSL_Complex, SSL_Complex *);
+extern void SSL_ComplexSub(SSL_Complex, SSL_Complex, SSL_Complex *);
+extern void SSL_ComplexMul(SSL_Complex, SSL_Complex, SSL_Complex *);
+extern void SSL_ComplexDiv(SSL_Complex, SSL_Complex, SSL_Complex *);
+extern double SSL_ComplexNorm(SSL_Complex);
+extern double SSL_ComplexArg(SSL_Complex);
+
+#endif /* SSL_COMPLEX_H_ */
diff --git a/Basic/MatrixOps/eigen.c b/Basic/MatrixOps/eigen.c
new file mode 100644
index 0000000..0d58500
--- /dev/null
+++ b/Basic/MatrixOps/eigen.c
@@ -0,0 +1,938 @@
+/*
+ * eigen.c - calculation of eigen values and vectors.
+ *
+ * (C) Copyright 2001 by NetGroup A/S. All rights reserved.
+ *
+ * $Log$
+ * Revision 1.1 2006/06/20 15:57:22 djburke
+ * Hopefully a saner way to build Basic/MatrixOps
+ *
+ * Revision 1.1 2005/01/08 09:22:57 zowie
+ * Added non-symmetric matrices to eigens; updated version to 2.4.2cvs.
+ *
+ * Revision 1.1.1.1 2001/07/06 13:39:35 kneth
+ * Initial import of code.
+ *
+ *
+ * Eigen is a library for computing eigenvalues and eigenvectors of general
+ * matrices. There is only one routine exported, namely Eigen.
+ *
+ * The meaning of the arguments to Eigen is:
+ * 1. The dimension of the general matrix (n).
+ * 2. A general matrix (A).
+ * 3. The maximal number of iterations.
+ * 4. The precision.
+ * 5. A vector with the eigenvalues.
+ * 6. A matrix with the eigenvectors.
+ *
+ */
+
+#include "complex.h"
+#include "matrix.h"
+#include <math.h>
+#include <stdio.h>
+
+void BlockCheck(double **A, int n, int i, int *block, double epsx) {
+
+ /* block == 1 <=> TRUE, block == 0 <=> FALSE */
+
+ if (i==n)
+ *block=0;
+ else {
+ if ((fabs(A[i-1][i]-A[i][i-1])>epsx) &&
+ (fabs(A[i-1][i-1]-A[i][i])<=epsx))
+ *block=1;
+ else
+ *block=0;
+ } /* else */
+} /* BlockCheck */
+
+
+void PrintEigen(int n, double **A, double **B, double eps, FILE *outfile) {
+
+ int i, j;
+ int block;
+
+ fprintf(outfile, "\nEigenvalues:\t\t\tRe\t\t\tIm\n");
+ i=1;
+ do {
+ BlockCheck(A, n, i, &block, eps);
+ if (block==1) {
+ fprintf(outfile, "\t\t\t\t%e\t\t%e\n", A[i-1][i-1], A[i-1][i]);
+ fprintf(outfile, "\t\t\t\t%e\t\t%e\n", A[i][i], A[i][i-1]);
+ i+=2;
+ } else {
+ fprintf(outfile, "\t\t\t\t%e\t\t%e\n", A[i-1][i-1], 0.0);
+ i++;
+ } /* if else */
+ } while (i!=(n+1));
+ fprintf(outfile, "\nEigenvectors:\t\t\tRe\t\t\tIm\n");
+ i=1;
+ do {
+ BlockCheck(A, n, i, &block, eps);
+ if (block==1) {
+ for(j=1; j<=n; j++)
+ fprintf(outfile, "\t\t\t\t%e\t\t%e\n", B[j-1][i-1], B[j-1][i]);
+ fprintf(outfile, "\n");
+ for(j=1; j<=n; j++)
+ fprintf(outfile, "\t\t\t\t%e\t\t%e\n", B[j-1][i-1], -B[j-1][i]);
+ fprintf(outfile, "\n");
+ i+=2;
+ } else {
+ for(j=1; j<=n; j++)
+ fprintf(outfile, "\t\t\t\t%e\t\t%e\n", B[j-1][i-1], 0.0);
+ fprintf(outfile, "\n");
+ i++;
+ } /* if else */
+ } while (i!=(n+1));
+} /* PrintEigen */
+
+
+void NormalizingMatrix(int n, double **A, int fixedref, int *ref,
+ double **V, double eps) {
+
+ int j, col, block;
+ SSL_Complex c1, c2, c3;
+ double cd1, cd2, sqrnorm, norm, normi, max;
+
+ col=1;
+ do {
+ if (fixedref==0) {
+ *ref=1;
+ SSL_ComplexAssign(V[*ref-1][col-1], V[*ref-1][col], &c1);
+ max=SSL_ComplexNorm(c1);
+ for(j=2; j<=n; j++) {
+ SSL_ComplexAssign(V[j-1][col-1], V[j-1][col], &c2);
+ sqrnorm=SSL_ComplexNorm(c2);
+ if (sqrnorm>max) {
+ *ref=j;
+ max=sqrnorm;
+ } /* if */
+ } /* for j */
+ } /* if fixedref */
+ BlockCheck(A, n, col, &block, eps);
+ if (block==1) {
+ SSL_ComplexAssign(V[*ref-1][col-1], V[*ref-1][col], &c1);
+ for(j=1; j<=n; j++) {
+ SSL_ComplexAssign(V[j-1][col-1], V[j-1][col], &c2);
+ SSL_ComplexDiv(c2, c1, &c3);
+ V[j-1][col-1]=c3.re;
+ V[j-1][col]=c3.im;
+ } /* for j */
+ col+=2;
+ } /* if */
+ else {
+ norm=fabs(V[*ref-1][col-1]);
+ if (norm!=0.0)
+ for(j=1; j<=n; j++)
+ V[j-1][col-1]/=norm;
+ col++;
+ } /* else */
+ } while (col<=n);
+} /* NormalizingMatrix */
+
+void Permutation(int n, double **P, double **A, double **B, int colon,
+ double eps) {
+
+ int *nr;
+ int block, OK;
+ double max, y, x;
+ int im, j, ki, u, v, i, k, ii;
+ double **AA;
+
+ nr=IntVectorAlloc(n);
+ AA=MatrixAlloc(n);
+
+ MatrixCopy(n, AA, A);
+ for(i=1; i<=n; i++) {
+ nr[i-1]=i;
+ for(k=1; k<=n; k++)
+ P[i-1][k-1]=0.0;
+ } /* for i */
+ i=ii=ki=1;
+ while (i<n) {
+ BlockCheck(A, n, i, &block, eps);
+ if (block==1) {
+ A[i][i]=A[i-1][i-1];
+ AA[i][i]=AA[i-1][i-1];
+ if (A[i-1][i]>0.0) {
+ A[i][i-1]=A[i-1][i];
+ A[i-1][i]=-A[i][i-1];
+ AA[i][i-1]=AA[i-1][i];
+ AA[i-1][i]=-AA[i][i-1];
+ for(j=1; j<=n; j++)
+ B[j-1][i]=-B[j-1][i];
+ } else {
+ A[i][i-1]=-A[i-1][i];
+ AA[i][i-1]=-AA[i-1][i];
+ } /* else */
+ j=i;
+ for(k=ii; k<=(ii+1); k++) {
+ x=AA[k-1][k-1];
+ AA[k-1][k-1]=A[j-1][j-1];
+ AA[j-1][j-1]=x;
+ u=nr[k-1];
+ nr[k-1]=nr[j-1];
+ nr[j-1]=u;
+ j++;
+ } /* for k */
+ if (ii>1) {
+ if (AA[ii-1][ii-1]>AA[0][0]) {
+ j=ii;
+ for(k=1; k<=2; k++) {
+ x=AA[k-1][k-1];
+ AA[k-1][k-1]=A[j-1][j-1];
+ AA[j-1][j-1]=x;
+ u=nr[k-1];
+ nr[k-1]=nr[j-1];
+ nr[j-1]=u;
+ j++;
+ } /* for k */
+ } /* if */
+ } /* if */
+ ki=i;
+ i+=2;
+ ii+=2;
+ } /* if */
+ else
+ i++;
+ } /* while */
+
+ if (n>3) {
+ do {
+ im=ii;
+ i=ii;
+ max=AA[im-1][im-1];
+ do {
+ i++;
+ if (AA[i-1][i-1]>max) {
+ im=i;
+ max=AA[i-1][i-1];
+ } /* if */
+ } while (i<n);
+ if (im>ii) {
+ x=AA[ii-1][ii-1];
+ u=nr[ii-1];
+ AA[ii-1][ii-1]=max;
+ nr[ii-1]=nr[im-1];
+ AA[im-1][im-1]=x;
+ nr[im-1]=u;
+ } /* if */
+ ii++;
+ } while (ii<n);
+ } /* if */
+ for(i=1; i<=n; i++) {
+ if (colon==1)
+ P[nr[i-1]-1][i-1]=1.0;
+ else
+ P[i-1][nr[i-1]-1]=1.0;
+ } /* for i */
+
+ MatrixFree(n, AA);
+ IntVectorFree(n, nr);
+} /* Permutation */
+
+
+void Swap(int n, double **A, double **B, double epsx) {
+
+ double **PR, **PS;
+ double **temp;
+ int i, j;
+
+ PR=MatrixAlloc(n);
+ PS=MatrixAlloc(n);
+ temp=MatrixAlloc(n);
+
+ Permutation(n, PS, A, B, 1, epsx);
+ MatrixMul(n, temp, B, PS);
+ MatrixCopy(n, B, temp);
+ Transpose(n, PR, PS);
+ MatrixMul(n, temp, PR, A);
+ MatrixCopy(n, A, temp);
+ MatrixMul(n, temp, A, PS);
+ MatrixCopy(n, A, temp);
+
+ MatrixFree(n, PR);
+ MatrixFree(n, PS);
+ MatrixFree(n, temp);
+} /* Swap */
+
+void Balance(int n, int b, double **a, int *low, int *hi, double *d) {
+
+ int i, j, k, l;
+ double b2, c, f, g, r, s;
+ int noconv;
+
+ b2=b*b;
+ l=1;
+ k=n;
+
+ L110:
+ for(j=k; j>=1; j--) {
+ r=0.0;
+ for(i=1; i<=(j-1); i++)
+ r+=fabs(a[j-1][i-1]);
+ for(i=(j+1); i<=k; i++)
+ r+=fabs(a[j-1][i-1]);
+ if (r==0.0) {
+ d[k-1]=(double)j;
+ if (j!=k) {
+ for(i=1; i<=k; i++) {
+ f=a[i-1][j-1];
+ a[i-1][j-1]=a[i-1][k-1];
+ a[i-1][k-1]=f;
+ }
+ for(i=l; i<=n; i++) {
+ f=a[j-1][i-1];
+ a[j-1][i-1]=a[k-1][i-1];
+ a[k-1][i-1]=f;
+ }
+ }
+ k--;
+ goto L110;
+ } /* if */
+ } /* for j */
+
+ L120:
+ for(j=l; j<=k; j++) {
+ c=0.0;
+ for (i=l; i<=(j-1); i++)
+ c+=fabs(a[i-1][j-1]);
+ for(i=(j+1); i<=k; i++)
+ c+=fabs(a[i-1][j-1]);
+ if (c==0.0) {
+ d[l-1]=(double)j;
+ if (j!=l) {
+ for(i=1; i<=k; i++) {
+ f=a[i-1][j-1];
+ a[i-1][j-1]=a[i-1][l-1];
+ a[i-1][l-1]=f;
+ }
+ for(i=l; i<=n; i++) {
+ f=a[j-1][i-1];
+ a[j-1][i-1]=a[l-1][i-1];
+ a[l-1][i-1]=f;
+ }
+ }
+ l++;
+ goto L120;
+ } /* if */
+ } /* for j */
+
+ *low=l;
+ *hi=k;
+ for(i=l; i<=k; i++)
+ d[i-1]=1.0;
+
+ L130:
+ noconv=0;
+ for(i=l; i<=k; i++) {
+ r=c=0.0;
+ for(j=l; j<=(i-1); j++) {
+ c+=fabs(a[j-1][i-1]);
+ r+=fabs(a[i-1][j-1]);
+ } /* for j */
+ for(j=(i+1); j<=k; j++) {
+ c+=fabs(a[j-1][i-1]);
+ r+=fabs(a[i-1][j-1]);
+ } /* for j */
+ g=r/((double) b);
+ f=1.0;
+ s=c+r;
+
+ L140:
+ if (c<g) {
+ f*=(double) b;
+ c*=(double) b2;
+ goto L140;
+ } /* if */
+ g=r*((double) b);
+
+ L150:
+ if (c>=g) {
+ f/=(double) b;
+ c/=(double) b2;
+ goto L150;
+ } /* if */
+
+ if ((c+r)/f<(0.95*s)) {
+ g=1.0/f;
+ d[i-1]*=f;
+ noconv=1;
+ for(j=l; j<=n; j++)
+ a[i-1][j-1]*=g;
+ for(j=1; j<=k; j++)
+ a[j-1][i-1]*=f;
+ } /* if */
+ } /* for i */
+ if (noconv==1)
+ goto L130;
+} /* Balance */
+
+void BalBak(int n, int low, int hi, int m, double **z, double *d) {
+
+ int i, j, k;
+ double s;
+
+ for(i=low; i<=hi; i++) {
+ s=d[i-1];
+ for(j=1; j<=m; j++)
+ z[i-1][j-1]*=s;
+ } /* for i */
+ for(i=(low-1); i>=1; i--) {
+ k=(int)floor(d[i-1]+0.5);
+ if (k!=i)
+ for(j=1; j<=m; j++) {
+ s=z[i-1][j-1];
+ z[i-1][j-1]=z[k-1][j-1];
+ z[k-1][j-1]=s;
+ } /* for j */
+ } /* for i */
+ for(i=(hi+1); i<=n; i++) {
+ k=(int)floor(d[i-1]+0.5);
+ if (k!=i)
+ for(j=1; j<=m; j++) {
+ s=z[i-1][j-1];
+ z[i-1][j-1]=z[k-1][j-1];
+ z[k-1][j-1]=s;
+ } /* for j */
+ } /* for i */
+} /* BalBak */
+
+void Elmhes(int n, int k, int l, double **a, int *index) {
+
+ int i, j, la, m;
+ double x, y;
+
+ la=l-1;
+ for(m=(k+1); m<=la; m++) {
+ i=m;
+ x=0.0;
+ for(j=m; j<=l; j++)
+ if (fabs(a[j-1][m-2])>fabs(x)) {
+ x=a[j-1][m-2];
+ i=j;
+ } /* if */
+ index[m-1]=i;
+ if (i!=m) {
+ for(j=(m-1); j<=n; j++) {
+ y=a[i-1][j-1];
+ a[i-1][j-1]=a[m-1][j-1];
+ a[m-1][j-1]=y;
+ } /* for j */
+ for(j=1; j<=l; j++) {
+ y=a[j-1][i-1];
+ a[j-1][i-1]=a[j-1][m-1];
+ a[j-1][m-1]=y;
+ } /* for j */
+ } /* if */
+ if (x!=0.0)
+ for(i=(m+1); i<=l; i++) {
+ y=a[i-1][m-2];
+ if (y!=0.0) {
+ a[i-1][m-2]=y/x;
+ y/=x;
+ for(j=m; j<=n; j++)
+ a[i-1][j-1]-=y*a[m-1][j-1];
+ for(j=1; j<=l; j++)
+ a[j-1][m-1]+=y*a[j-1][i-1];
+ } /* if */
+ } /* for i */
+ } /* for m */
+} /* Elmhes */
+
+void Elmtrans(int n, int low, int upp, double **h, int *index,
+ double **v) {
+
+ int i, j, k;
+
+ for(i=1; i<=n; i++) {
+ for(j=1; j<=n; j++)
+ v[i-1][j-1]=0.0;
+ v[i-1][i-1]=1.0;
+ } /* for i */
+ for(i=(upp-1); i>=(low+1); i--) {
+ j=index[i-1];
+ for(k=(i+1); k<=upp; k++)
+ v[k-1][i-1]=h[k-1][i-2];
+ if (i!=j) {
+ for(k=i; k<=upp; k++) {
+ v[i-1][k-1]=v[j-1][k-1];
+ v[j-1][k-1]=0.0;
+ } /* for k */
+ v[j-1][i-1]=1.0;
+ } /* if */
+ } /* for i */
+} /* Elmtrans */
+
+
+void hqr2(int n, int low, int upp, int maxits, double macheps,
+ double **h, double **vecs, double *wr,
+ double *wi, int *cnt, int *fail) {
+
+ int i, j, k, l, m, na, its, en, dummy;
+ double p, q, r, s, t, w, x, y, z, ra, sa, vr, vi, norm;
+ int notlast;
+ SSL_Complex c1, c2, c3;
+
+ *fail=0;
+ for(i=1; i<=(low-1); i++) {
+ wr[i-1]=h[i-1][i-1];
+ wi[i-1]=0.0;
+ cnt[i-1]=0;
+ } /* for i */
+ for(i=(upp+1); i<=n; i++) {
+ wr[i-1]=h[i-1][i-1];
+ wi[i-1]=0.0;
+ cnt[i-1]=0;
+ } /* for i */
+ en=upp;
+ t=0.0;
+
+ L210:
+ if (en<low)
+ goto L260;
+ its=0;
+ na=en-1;
+
+ L220:
+ for(l=en; l>=(low+1); l--)
+ if (fabs(h[l-1][l-2])<=
+ macheps*(fabs(h[l-2][l-2])+fabs(h[l-1][l-1])))
+ goto L231;
+ l=low;
+
+ L231:
+ x=h[en-1][en-1];
+ if (l==en)
+ goto L240;
+ y=h[na-1][na-1];
+ w=h[en-1][na-1]*h[na-1][en-1];
+ if (l==na)
+ goto L250;
+ if (its==maxits) {
+ cnt[en-1]=maxits+1;
+ *fail=1;
+ goto L270;
+ } /* if */
+ if ((its % 10)==0) {
+ t+=x;
+ for(i=low; i<=en; i++)
+ h[i-1][i-1]-=x;
+ s=fabs(h[en-1][na-1])+fabs(h[na-1][en-3]);
+ y=0.75*s;
+ x=y;
+ w=-0.4375*s*s;
+ } /* if */
+ its++;
+
+ for(m=(en-2); m>=l; m--) {
+ z=h[m-1][m-1];
+ r=x-z;
+ s=y-z;
+ p=(r*s-w)/h[m][m-1]+h[m-1][m];
+ q=h[m][m]-z-r-s;
+ r=h[m+1][m];
+ s=fabs(p)+fabs(q)+fabs(r);
+ p/=s;
+ q/=s;
+ r/=s;
+ if (m==1)
+ goto L232;
+ if ((fabs(h[m-1][m-2])*(fabs(q)+fabs(r)))<=
+ (macheps*fabs(p)*(fabs(h[m-2][m-2])+fabs(z)+fabs(h[m][m]))))
+ goto L232;
+ } /* for m */
+
+ L232:
+ for(i=(m+2); i<=en; i++)
+ h[i-1][i-3]=0.0;
+ for(i=(m+3); i<=en; i++)
+ h[i-1][i-4]=0.0;
+
+ for(k=m; k<=na; k++) {
+ if (k!=na)
+ notlast=1;
+ else
+ notlast=0;
+ if (k!=m) {
+ p=h[k-1][k-2];
+ q=h[k][k-2];
+ if (notlast==1)
+ r=h[k+1][k-2];
+ else
+ r=0.0;
+ x=fabs(p)+fabs(q)+fabs(r);
+ if (x==0.0)
+ goto L233;
+ p/=x;
+ q/=x;
+ r/=x;
+ } /* if */
+ s=sqrt(p*p+q*q+r*r);
+ if (p<0)
+ s=-s;
+ if (k!=m)
+ h[k-1][k-2]=-s*x;
+ else
+ if (l!=m)
+ h[k-1][k-2]=-h[k-1][k-2];
+ p+=s;
+ x=p/s;
+ y=q/s;
+ z=r/s;
+ q/=p;
+ r/=p;
+
+ for(j=k; j<=n; j++) {
+ p=h[k-1][j-1]+q*h[k][j-1];
+ if (notlast==1) {
+ p+=r*h[k+1][j-1];
+ h[k][j-1]-=p*z;
+ } /* if */
+ h[k][j-1]-=p*y;
+ h[k-1][j-1]-=p*x;
+ } /* for j */
+ if ((k+3)<en)
+ j=k+3;
+ else
+ j=en;
+
+ for(i=1; i<=j; i++) {
+ p=x*h[i-1][k-1]+y*h[i-1][k];
+ if (notlast==1) {
+ p+=z*h[i-1][k+1];
+ h[i-1][k+1]-=p*r;
+ } /* if */
+ h[i-1][k]-=p*q;
+ h[i-1][k-1]-=p;
+ } /* for i */
+
+ for(i=low; i<=upp; i++) {
+ p=x*vecs[i-1][k-1]+y*vecs[i-1][k];
+ if (notlast==1) {
+ p+=z*vecs[i-1][k+1];
+ vecs[i-1][k+1]-=p*r;
+ } /* if */
+ vecs[i-1][k]-=p*q;
+ vecs[i-1][k-1]-=p;
+ } /* for i */
+
+ L233:
+ dummy=0;
+ } /* for k */
+ goto L220;
+
+ L240:
+ h[en-1][en-1]=x+t;
+ wr[en-1]=h[en-1][en-1];
+ wi[en-1]=0.0;
+ cnt[en-1]=its;
+ en=na;
+ goto L210;
+
+ L250:
+ p=0.5*(y-x);
+ q=p*p+w;
+ z=sqrt(fabs(q));
+ h[en-1][en-1]=x+t;
+ x=h[en-1][en-1];
+ h[na-1][na-1]=y+t;
+ cnt[en-1]=-its;
+ cnt[na-1]=its;
+ if (q>0.0) {
+ if (p<0.0)
+ z=p-z;
+ else
+ z+=p;
+ wr[na-1]=x+z;
+ s=x-w/z;
+ wr[en-1]=s;
+ wi[na-1]=0.0;
+ wi[en-1]=0.0;
+ x=h[en-1][na-1];
+ r=sqrt(x*x+z*z);
+ p=x/r;
+ q=z/r;
+ for(j=na; j<=n; j++) {
+ z=h[na-1][j-1];
+ h[na-1][j-1]=q*z+p*h[en-1][j-1];
+
+ /* h[en-1][j-1]=q*h[en-1][j-1]-p*z */
+ h[en-1][j-1]*=q;
+ h[en-1][j-1]-=p*z;
+ } /* for j */
+ for(i=1; i<=en; i++) {
+ z=h[i-1][na-1];
+ h[i-1][na-1]=q*z+p*h[i-1][en-1];
+
+ /* h[i-1][en-1]=q*h[i-1][en-1]-p*z */
+ h[i-1][en-1]*=q;
+ h[i-1][en-1]-=p*z;
+ } /* for i */
+ for(i=low; i<=upp; i++) {
+ z=vecs[i-1][na-1];
+ vecs[i-1][na-1]=q*z+p*vecs[i-1][en-1];
+
+ /* vecs[i-1][en-1]=q*vecs[i-1][en-1]-p*z */
+ vecs[i-1][en-1]*=q;
+ vecs[i-1][en-1]-=p*z;
+ } /* for i */
+ } /* if */
+ else {
+ wr[na-1]=x+p;
+ wr[en-1]=x+p;
+ wi[na-1]=z;
+ wi[en-1]=-z;
+ } /* else */
+ en-=2;
+ goto L210;
+
+ L260:
+ norm=0.0;
+ k=1;
+ for(i=1; i<=n; i++) {
+ for(j=k; j<=n; j++)
+ norm+=fabs(h[i-1][j-1]);
+ k=i;
+ } /* for i */
+
+ for(en=n; en>=1; en--) {
+ p=wr[en-1];
+ q=wi[en-1];
+ na=en-1;
+ if (q==0.0) {
+ m=en;
+ h[en-1][en-1]=1.0;
+ for(i=na; i>=1; i--) {
+ w=h[i-1][i-1]-p;
+ r=h[i-1][en-1];
+ for(j=m; j<=na; j++)
+ r+=h[i-1][j-1]*h[j-1][en-1];
+ if (wi[i-1]<0.0) {
+ z=w;
+ s=r;
+ } /* if */
+ else {
+ m=i;
+ if (wi[i-1]==0.0) {
+ if (w!=0.0)
+ h[i-1][en-1]=-r/w;
+ else
+ h[i-1][en-1]=-r/macheps/norm;
+ } else {
+ x=h[i-1][i];
+ y=h[i][i-1];
+ q=pow(wr[i-1]-p, 2.0)+wi[i-1]*wi[i-1];
+ t=(x*s-z*r)/q;
+ h[i-1][en-1]=t;
+ if (fabs(x)>fabs(z))
+ h[i][en-1]=(-r-w*t)/x;
+ else
+ h[i][en-1]=(-s-y*t)/z;
+ } /* else */
+ } /* else */
+ } /* i */
+ } else
+ if (q<0.0) {
+ m=na;
+ if (fabs(h[en-1][na-1])>fabs(h[na-1][en-1])) {
+ h[na-1][na-1]=-(h[en-1][en-1]-p)/h[en-1][na-1];
+ h[na-1][en-1]=-q/h[en-1][na-1];
+ } /* if */
+ else {
+ SSL_ComplexAssign(-h[na-1][en-1], 0.0, &c1);
+ SSL_ComplexAssign(h[na-1][na-1]-p, q, &c2);
+ SSL_ComplexDiv(c1, c2, &c3);
+ h[na-1][na-1]=c3.re;
+ h[na-1][en-1]=c3.im;
+ } /* else */
+ h[en-1][na-1]=1.0;
+ h[en-1][en-1]=0.0;
+ for(i=(na-1); i>=1; i--) {
+ w=h[i-1][i-1]-p;
+ ra=h[i-1][en-1];
+ sa=0.0;
+ for(j=m; j<=na; j++) {
+ ra+=h[i-1][j-1]*h[j-1][na-1];
+ sa+=h[i-1][j-1]*h[j-1][en-1];
+ } /* for j */
+ if (wi[i-1]<0.0) {
+ z=w;
+ r=ra;
+ s=sa;
+ } /* if */
+ else {
+ m=i;
+ if (wi[i-1]==0.0) {
+ SSL_ComplexAssign(-ra, -sa, &c1);
+ SSL_ComplexAssign(w, q, &c2);
+ SSL_ComplexDiv(c1, c2, &c3);
+ h[i-1][na-1]=c3.re;
+ h[i-1][en-1]=c3.im;
+ } /* if */
+ else {
+ x=h[i-1][i];
+ y=h[i][i-1];
+ vr=pow(wr[i-1]-p, 2.0)+wi[i-1]*wi[i-1]-q*q;
+ vi=(wr[i-1]-p)*2.0*q;
+ if ((vr==0.0) && (vi==0.0))
+ vr=macheps*norm*(fabs(w)+fabs(q)+fabs(x)+fabs(y)+fabs(z));
+ SSL_ComplexAssign(x*r-z*ra+q*sa, x*s-z*sa-q*ra, &c1);
+ SSL_ComplexAssign(vr, vi, &c2);
+ SSL_ComplexDiv(c1, c2, &c3);
+ h[i-1][na-1]=c3.re;
+ h[i-1][en-1]=c3.im;
+ if (fabs(x)>(fabs(z)+fabs(q))) {
+ h[i][na-1]=(-ra-w*h[i-1][na-1]+q*h[i-1][en-1])/x;
+ h[i][en-1]=(-sa-w*h[i-1][en-1]-q*h[i-1][na-1])/x;
+ } /* if */
+ else {
+ SSL_ComplexAssign(-r-y*h[i-1][na-1], -s-y*h[i-1][en-1],
+ &c1);
+ SSL_ComplexAssign(z, q, &c2);
+ SSL_ComplexDiv(c1, c2, &c3);
+ h[i][na-1]=c3.re;
+ h[i][en-1]=c3.im;
+ } /* else */
+ } /* else */
+ } /* else */
+ } /* for i */
+ } /* if */
+ } /* for en */
+
+ for(i=1; i<=(low-1); i++)
+ for(j=(i+1); j<=n; j++)
+ vecs[i-1][j-1]=h[i-1][j-1];
+ for(i=(upp+1); i<=n; i++)
+ for(j=(i+1); j<=n; j++)
+ vecs[i-1][j-1]=h[i-1][j-1];
+
+ for(j=n; j>=low; j--) {
+ if (j<=upp)
+ m=j;
+ else
+ m=upp;
+ l=j-1;
+ if (wi[j-1]<0.0) {
+ for(i=low; i<=upp; i++) {
+ y=z=0.0;
+ for(k=low; k<=m; k++) {
+ y+=vecs[i-1][k-1]*h[k-1][l-1];
+ z+=vecs[i-1][k-1]*h[k-1][j-1];
+ } /* for k */
+ vecs[i-1][l-1]=y;
+ vecs[i-1][j-1]=z;
+ } /* for i */
+ } /* if */
+ else
+ if (wi[j-1]==0.0)
+ for(i=low; i<=upp; i++) {
+ z=0.0;
+ for(k=low; k<=m; k++)
+ z+=vecs[i-1][k-1]*h[k-1][j-1];
+ vecs[i-1][j-1]=z;
+ } /* for i */
+ } /* for j */
+
+ L270:
+ dummy=0;
+} /* hqr2 */
+
+void Eigen(int n, int ref, double **AJAC, int maxit, double eps,
+ int fixedref, SSL_Complex *values, SSL_Complex **vectors) {
+
+ double *wr, *wi, *bald, **T, **A;
+ int i, j, ballow, balhi, max, block;
+ int *intout;
+ int fail;
+
+ intout=IntVectorAlloc(n);
+ wr=VectorAlloc(n);
+ wi=VectorAlloc(n);
+ bald=VectorAlloc(n);
+ T=MatrixAlloc(n);
+ A=MatrixAlloc(n);
+
+ for(i=1; i<=n; i++)
+ for(j=1; j<=n; j++)
+ A[i-1][j-1]=AJAC[i-1][j-1];
+
+ Balance(n, 10, A, &ballow, &balhi, bald);
+ Elmhes(n, ballow, balhi, A, intout);
+ Elmtrans(n, ballow, balhi, A, intout, T);
+
+ hqr2(n, ballow, balhi, maxit, eps, A, T, wr, wi, intout, &fail);
+ if (fail==1)
+ (void) fprintf(stderr, "Failure in hqr2 function. Do not trust the given eigenvectors and -values\n");
+ /*
+ tmxx=0;
+ for(i=1; i<=n; i++)
+ if (abs(intout[i-1])>tmxx)
+ tmxx=(int)ceil(abs(intout[i-1]));
+ */
+ for(i=1; i<=n; i++)
+ for(j=1; j<=n; j++)
+ A[i-1][j-1]=0.0;
+ i=1;
+ do {
+ if (wi[i-1]!=0.0) {
+ A[i-1][i-1]=wr[i-1];
+ A[i][i]=wr[i-1];
+ A[i-1][i]=wi[i-1];
+ A[i][i-1]=wi[i];
+ i+=2;
+ } /* if */
+ else {
+ A[i-1][i-1]=wr[i-1];
+ i++;
+ } /* else */
+ } while (i<n);
+ if (i==n)
+ A[i-1][i-1]=wr[i-1];
+
+ Swap(n, A, T, eps);
+ BalBak(n, ballow, balhi, n, T, bald);
+ NormalizingMatrix(n, A, fixedref, &ref, T, eps);
+
+ /* store eigenvectors and eigenvalues nicely */
+ i=1; /* eigenvalues */
+ do {
+ BlockCheck(A, n, i, &block, eps);
+ if (block==1) {
+ SSL_ComplexAssign(A[i-1][i-1], A[i-1][i], &values[i-1]);
+ SSL_ComplexAssign(A[i][i], A[i][i-1], &values[i]);
+ i+=2;
+ } else {
+ SSL_ComplexAssign(A[i-1][i-1], 0.0, &values[i-1]);
+ i++;
+ } /* if else */
+ } while (i!=(n+1));
+ i=1; /* eigenvectors */
+ do {
+ BlockCheck(A, n, i, &block, eps);
+ if (block==1) {
+ for(j=1; j<=n; j++)
+ SSL_ComplexAssign(T[j-1][i-1], T[j-1][i], &vectors[i-1][j-1]);
+ for(j=1; j<=n; j++)
+ SSL_ComplexAssign(T[j-1][i-1], -T[j-1][i], &vectors[i][j-1]);
+ i+=2;
+ } else {
+ for(j=1; j<=n; j++)
+ SSL_ComplexAssign(T[j-1][i-1], 0.0, &vectors[i-1][j-1]);
+ i++;
+ } /* if else */
+ } while (i!=(n+1));
+
+ VectorFree(n, wi);
+ VectorFree(n, wr);
+ VectorFree(n, bald);
+ IntVectorFree(n, intout);
+ MatrixFree(n, A);
+ MatrixFree(n, T);
+} /* Eigen */
+
+
+
+
+
diff --git a/Basic/MatrixOps/eigen.h b/Basic/MatrixOps/eigen.h
new file mode 100644
index 0000000..b2d6a93
--- /dev/null
+++ b/Basic/MatrixOps/eigen.h
@@ -0,0 +1,27 @@
+/*
+ * eigen.c - calculation of eigen values and vectors.
+ *
+ * (C) Copyright 2001 by NetGroup A/S. All rights reserved.
+ *
+ * $Log$
+ * Revision 1.1 2006/06/20 15:57:22 djburke
+ * Hopefully a saner way to build Basic/MatrixOps
+ *
+ * Revision 1.1 2005/01/08 09:22:57 zowie
+ * Added non-symmetric matrices to eigens; updated version to 2.4.2cvs.
+ *
+ * Revision 1.1.1.1 2001/07/06 13:39:35 kneth
+ * Initial import of code.
+ *
+ *
+ */
+
+#ifndef SSL_EIGEN_H_
+#define SSL_EIGEN_H_
+
+#include <stdio.h>
+#include "complex.h"
+
+extern void Eigen(int, int, double **, int, double, int, SSL_Complex *, SSL_Complex **);
+
+#endif /* SSL_EIGEN_SSL */
diff --git a/Basic/MatrixOps/eigens.c b/Basic/MatrixOps/eigens.c
new file mode 100644
index 0000000..ce4d6bc
--- /dev/null
+++ b/Basic/MatrixOps/eigens.c
@@ -0,0 +1,178 @@
+/* eigens.c
+ *
+ * Eigenvalues and eigenvectors of a real symmetric matrix
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * int n;
+ * double A[n*(n+1)/2], EV[n*n], E[n];
+ * void eigens( A, EV, E, n );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * The algorithm is due to J. vonNeumann.
+ * - -
+ * A[] is a symmetric matrix stored in lower triangular form.
+ * That is, A[ row, column ] = A[ (row*row+row)/2 + column ]
+ * or equivalently with row and column interchanged. The
+ * indices row and column run from 0 through n-1.
+ *
+ * EV[] is the output matrix of eigenvectors stored columnwise.
+ * That is, the elements of each eigenvector appear in sequential
+ * memory order. The jth element of the ith eigenvector is
+ * EV[ n*i+j ] = EV[i][j].
+ *
+ * E[] is the output matrix of eigenvalues. The ith element
+ * of E corresponds to the ith eigenvector (the ith row of EV).
+ *
+ * On output, the matrix A will have been diagonalized and its
+ * orginal contents are destroyed.
+ *
+ * ACCURACY:
+ *
+ * The error is controlled by an internal parameter called RANGE
+ * which is set to 1e-10. After diagonalization, the
+ * off-diagonal elements of A will have been reduced by
+ * this factor.
+ *
+ * ERROR MESSAGES:
+ *
+ * None.
+ *
+ */
+/*
+Copyright 1973, 1991 by Stephen L. Moshier
+Copyleft version.
+*/
+
+void eigens( A, RR, E, N )
+double A[], RR[], E[];
+int N;
+{
+int IND, L, LL, LM, M, MM, MQ, I, J, K, IA, LQ;
+int IQ, IM, IL, NLI, NMI;
+double ANORM, ANORMX, AIA, THR, ALM, QI, ALL, AMM, X, Y;
+double SINX, SINX2, COSX, COSX2, SINCS, AIL, AIM;
+double RLI, RMI, Q, V;
+double sqrt(), fabs();
+static double RANGE = 1.0e-10; /*3.0517578e-5;*/
+
+
+/* Initialize identity matrix in RR[] */
+for( J=0; J<N*N; J++ )
+ RR[J] = 0.0;
+MM = 0;
+for( J=0; J<N; J++ )
+ {
+ RR[MM + J] = 1.0;
+ MM += N;
+ }
+
+ANORM=0.0;
+for( I=0; I<N; I++ )
+ {
+ for( J=0; J<N; J++ )
+ {
+ if( I != J )
+ {
+ IA = I + (J*J+J)/2;
+ AIA = A[IA];
+ ANORM += AIA * AIA;
+ }
+ }
+ }
+if( ANORM <= 0.0 )
+ goto done;
+ANORM = sqrt( ANORM + ANORM );
+ANORMX = ANORM * RANGE / N;
+THR = ANORM;
+
+while( THR > ANORMX )
+{
+THR=THR/N;
+
+do
+{ /* while IND != 0 */
+IND = 0;
+
+for( L=0; L<N-1; L++ )
+ {
+
+for( M=L+1; M<N; M++ )
+ {
+ MQ=(M*M+M)/2;
+ LM=L+MQ;
+ ALM=A[LM];
+ if( fabs(ALM) < THR )
+ continue;
+
+ IND=1;
+ LQ=(L*L+L)/2;
+ LL=L+LQ;
+ MM=M+MQ;
+ ALL=A[LL];
+ AMM=A[MM];
+ X=(ALL-AMM)/2.0;
+ Y=-ALM/sqrt(ALM*ALM+X*X);
+ if(X < 0.0)
+ Y=-Y;
+ SINX = Y / sqrt( 2.0 * (1.0 + sqrt( 1.0-Y*Y)) );
+ SINX2=SINX*SINX;
+ COSX=sqrt(1.0-SINX2);
+ COSX2=COSX*COSX;
+ SINCS=SINX*COSX;
+
+/* ROTATE L AND M COLUMNS */
+for( I=0; I<N; I++ )
+ {
+ IQ=(I*I+I)/2;
+ if( (I != M) && (I != L) )
+ {
+ if(I > M)
+ IM=M+IQ;
+ else
+ IM=I+MQ;
+ if(I >= L)
+ IL=L+IQ;
+ else
+ IL=I+LQ;
+ AIL=A[IL];
+ AIM=A[IM];
+ X=AIL*COSX-AIM*SINX;
+ A[IM]=AIL*SINX+AIM*COSX;
+ A[IL]=X;
+ }
+ NLI = N*L + I;
+ NMI = N*M + I;
+ RLI = RR[ NLI ];
+ RMI = RR[ NMI ];
+ RR[NLI]=RLI*COSX-RMI*SINX;
+ RR[NMI]=RLI*SINX+RMI*COSX;
+ }
+
+ X=2.0*ALM*SINCS;
+ A[LL]=ALL*COSX2+AMM*SINX2-X;
+ A[MM]=ALL*SINX2+AMM*COSX2+X;
+ A[LM]=(ALL-AMM)*SINCS+ALM*(COSX2-SINX2);
+ } /* for M=L+1 to N-1 */
+ } /* for L=0 to N-2 */
+
+ }
+while( IND != 0 );
+
+} /* while THR > ANORMX */
+
+done: ;
+
+/* Extract eigenvalues from the reduced matrix */
+L=0;
+for( J=1; J<=N; J++ )
+ {
+ L=L+J;
+ E[J-1]=A[L-1];
+ }
+}
diff --git a/Basic/MatrixOps/matrix.c b/Basic/MatrixOps/matrix.c
new file mode 100644
index 0000000..a656536
--- /dev/null
+++ b/Basic/MatrixOps/matrix.c
@@ -0,0 +1,544 @@
+/*
+ * matrix.c - misc. routines for manipulating matrices and vectors.
+ *
+ * (C) Copyright 2001 by NetGroup A/S. All rights reserved.
+ *
+ * $Log$
+ * Revision 1.1 2006/06/20 15:57:22 djburke
+ * Hopefully a saner way to build Basic/MatrixOps
+ *
+ * Revision 1.1 2005/01/08 09:22:57 zowie
+ * Added non-symmetric matrices to eigens; updated version to 2.4.2cvs.
+ *
+ * Revision 1.1.1.1 2001/07/06 13:39:35 kneth
+ * Initial import of code.
+ *
+ *
+ *
+ * The matrices and vectors are indexed in C-style, i.e. from 0 to
+ * N-1. A matrix is assumed to be declared as double **, and it is
+ * allocated by MatrixAlloc.
+ *
+ *
+ * References:
+ * [1] Numerical Recipes in C, 2nd edition,
+ * W.H. Press, S.A. Teukolsky, W.T. Vitterling, and B.P. Flannery,
+ * Cambridge University Press, 1992.
+ * [2] Numerical Analysis,
+ * D. Kincaid and W. Cheney,
+ * Brooks/Cole Publishing Company, 1991.
+ * [3] The C Programming Language, 2nd edition,
+ * B.W. Kernighan and D.M. Ritchie,
+ * Prentice Hall, 1988.
+ * [4] Advanced Engineering Mathematics, 6th edition,
+ * E. Kreyszig,
+ * Wiley and Sons, 1988.
+ *
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+
+#ifndef TINY
+# define TINY 1.0e-18
+#endif
+
+#include "sslib.h"
+#include "matrix.h"
+
+
+/*
+ * MatrixAlloc allocates storage for a square matrix with dimension
+ * n*n. An error message is printed, if it was impossible to allocate
+ * the neccesary space, [3].
+ *
+ */
+
+double **MatrixAlloc(const int n) {
+
+ double **matrix;
+ int i;
+
+ matrix=(double **)calloc(n, sizeof(double *));
+ if (matrix==NULL)
+ SSLerror("No memory available in routine MatrixAlloc");
+ else
+ for(i=0; i<n; i++) {
+ matrix[i]=(double *)calloc(n, sizeof(double));
+ if (matrix[i]==NULL)
+ SSLerror("No memory available in routine MatrixAlloc");
+ } /* for i=1..n */
+ return matrix;
+} /* MatrixAlloc */
+
+
+/*
+ * VectorAlloc allocated space for an n-dimensional vector of the type
+ * double *, [3]. It can be freed by VectorFree.
+ *
+ */
+
+double *VectorAlloc(const int n) {
+
+ double *temp;
+
+ temp=(double *)calloc(n, sizeof(double));
+ if (temp==NULL)
+ SSLerror("No memory available in routine VectorAlloc");
+ return temp;
+} /* VectorAlloc */
+
+
+/*
+ * IntVectorAlloc is similar to VectorAlloc, except that the base type is
+ * integers (int) instead of reals (double), [3].
+ *
+ */
+
+int *IntVectorAlloc(const int n) {
+
+ int *temp;
+
+ temp=(int *)calloc(n, sizeof(int));
+ if (temp==NULL)
+ SSLerror("No memory available in routine IntVectorAlloc");
+ return temp;
+} /* IntVectorAlloc */
+
+
+/*
+ * SSL_ComplexMatrixAlloc allocates space for a nxn matrix with complex elements.
+ *
+ */
+
+SSL_Complex **SSL_ComplexMatrixAlloc(const int n) {
+
+ int i;
+ SSL_Complex **temp;
+
+ temp=(SSL_Complex **)calloc(n, sizeof(SSL_Complex *));
+ if (temp==NULL)
+ SSLerror("No memory available in routine SSL_ComplexMatrixAlloc");
+ else {
+ for(i=0; i<n; i++) {
+ temp[i]=(SSL_Complex *)calloc(n, sizeof(SSL_Complex));
+ if (temp[i]==NULL)
+ SSLerror("No memory available in routine SSL_ComplexMatrixAlloc");
+ } /* for i=1..n */
+ } /* if else */
+ return temp;
+} /* SSL_ComplexMatrixAlloc */
+
+
+/*
+ * SSL_ComplexVectorAlloc allocates a vector of dimension n with complex
+ * elements.
+ *
+ */
+
+SSL_Complex *SSL_ComplexVectorAlloc(const int n) {
+
+ SSL_Complex *temp;
+
+ temp=(SSL_Complex *)calloc(n, sizeof(SSL_Complex));
+ if (temp==NULL)
+ SSLerror("No memory available in routine SSL_ComplexVectorAlloc");
+ return temp;
+} /* SSL_ComplexVectorAlloc */
+
+
+/*
+ * MatrixMul computes the product between two square matrices, [4, pp.
+ * 357-358]. Both matrices are assumed to have the dimension n*n. A and B are
+ * input, and res is the output, i.e. the routine computes res=A*B.
+ *
+ */
+
+void MatrixMul(const int n, double **res, double **A, double **B) {
+
+ int i, j, k;
+ double x;
+
+ for(i=0; i<n; i++)
+ for(j=0; j<n; j++) {
+ x=0.0;
+ for(k=0; k<n; k++)
+ x+=A[i][k]*B[k][j];
+ res[i][j]=x;
+ } /* for j=1..n */
+} /* MatrixMul */
+
+
+/*
+ * Transpose is simply doing as the name says, i.e. transposing the
+ * matrix A, [4, pp. 368-370]. A is assumed to be a square matrix.
+ *
+ */
+
+void Transpose(const int n, double **res, double **A) {
+
+ int i, j;
+
+ for(i=0; i<n; i++)
+ for(j=0; j<n; j++)
+ res[j][i]=A[i][j];
+} /* Transpose */
+
+
+/*
+ * MatrixFree, VectorFree, IntVectorFree, SSL_ComplexMatrixFree, and
+ * SSL_ComplexVectorFree free the space used by the objects, [3].
+ *
+ */
+
+void MatrixFree(const int n, double **matrix) {
+
+ int i;
+
+ for(i=0; i<n; i++)
+ free((void *)matrix[i]);
+ free((void *)matrix);
+} /* MatrixFree */
+
+void SSL_ComplexMatrixFree(const int n, SSL_Complex **matrix) {
+
+ int i;
+
+ for(i=0; i<n; i++)
+ free((void *)matrix[i]);
+ free((void *)matrix);
+} /* SSL_ComplexMatrixFree */
+
+void VectorFree(const int n, double *vector) {
+
+ free((void *)vector);
+} /* VectorFree */
+
+void IntVectorFree(const int n, int *vector) {
+
+ free((void *)vector);
+} /* IntVectorFree */
+
+void SSL_ComplexVectorFree(const int n, SSL_Complex *vector) {
+
+ free((void *)vector);
+} /* SSL_ComplexVectorFree */
+
+
+/*
+ * LUfact and LUsubst are plain LU decomposition and substitution routines,
+ * [1, pp. 43-50], [2, pp. 145-149]. The version here is Gaussian elimination
+ * with scaled row pivoting, and it is based on the algorithm given in [2].
+ *
+ * LUfact_fixed and LUsubst_fixed are specialised versions of LUfact and
+ * LUsubst. They are used in OEE solvers.
+ *
+ * The parameters are used:
+ * n the dimension of the matrix.
+ * a the matrix; it contains both L and U at termination.
+ * p permutation index.
+ * b the constant vector, and at termination it will contain
+ * the solution.
+ *
+ */
+
+void LUfact(const int n, double **a, int *p) {
+
+ int i, j, k; /* counters */
+ double z; /* temporary real */
+ double *s; /* pivot elements */
+ int not_finished; /* loop control var. */
+ int i_swap; /* swap var. */
+ double temp; /* another temp. real */
+
+ s=VectorAlloc(n);
+ for(i=0; i<n; i++) {
+ p[i]=i;
+ s[i]=0.0;
+ for(j=0; j<n; j++) {
+ z=fabs(a[i][j]);
+ if (s[i]<z)
+ s[i]=z;
+ } /* for j */
+ } /* for i */
+
+ for(k=0; k<(n-1); k++) {
+ j=k-1; /* select j>=k so ... */
+ not_finished=1;
+ while (not_finished) {
+ j++;
+ temp=fabs(a[p[j]][k]/s[p[j]]);
+ for(i=k; i<n; i++)
+ if (temp>=(fabs(a[p[i]][k])/s[p[i]]))
+ not_finished=0; /* end loop */
+ } /* while */
+ i_swap=p[k];
+ p[k]=p[j];
+ p[j]=i_swap;
+ temp=1.0/a[p[k]][k];
+ for(i=(k+1); i<n; i++) {
+ z=a[p[i]][k]*temp;
+ a[p[i]][k]=z;
+ for(j=(k+1); j<n; j++)
+ a[p[i]][j]-=z*a[p[k]][j];
+ } /* for i */
+ } /* for k */
+
+ VectorFree(n, s);
+} /* LUfact */
+
+void LUsubst(const int n, double **a, int *p, double *b) {
+
+ int i, j, k; /* counters */
+ double sum; /* temporary sum variable */
+ double *x; /* solution */
+
+ x=VectorAlloc(n);
+
+ for(k=0; k<(n-1); k++) /* forward subst */
+ for(i=(k+1); i<n; i++)
+ b[p[i]]-=a[p[i]][k]*b[p[k]];
+
+ for(i=(n-1); i>=0; i--) { /* back subst */
+ sum=b[p[i]];
+ for(j=(i+1); j<n; j++)
+ sum-=a[p[i]][j]*x[j];
+ x[i]=sum/a[p[i]][i];
+ } /* for i */
+
+ for(i=0; i<n; i++) /* copy solution */
+ b[i]=x[i];
+
+ VectorFree(n, x);
+} /* LUsubst */
+
+
+/*
+ * GaussSeidel is an implementation of the Gauss-Seidel method, which is an
+ * iterative method, [2, pp. 189-191]. The norm applied is the L1-norm.
+ *
+ * The parameters are:
+ * n the dimension.
+ * a the coefficient matrix.
+ * b the constant vector.
+ * x the initial guess, and at termination the solution.
+ * eps the precision.
+ * max_iter the maximal number of iterations allowed.
+ *
+ */
+
+void GaussSeidel(const int n, double **a, double *b, double *x, double eps,
+ int max_iter) {
+
+ int iter, i, j; /* counter */
+ double sum; /* temporary real */
+ double *x_old; /* old solution */
+ double norm; /* L1-norm */
+
+ x_old=VectorAlloc(n);
+
+ iter=0;
+ do { /* repeat until safisfying sol. */
+ iter++;
+ for(i=0; i<n; i++) /* copy old solution */
+ x_old[i]=x[i];
+ norm=0.0; /* do an iteration */
+ for(i=0; i<n; i++) {
+ sum=-a[i][i]*x[i]; /* don't include term i=j */
+ for(j=0; j<n; j++)
+ sum+=a[i][j]*x[j];
+ x[i]=(b[i]-sum)/a[i][i];
+ norm+=fabs(x_old[i]-x[i]);
+ } /* for i */
+ } while ((iter<=max_iter) && (norm>=eps));
+
+ VectorFree(n, x_old);
+} /* GaussSeidel */
+
+
+/*
+ * Jacobi is an iterative equation solver, [2, pp. 185-189]. The algorithm
+ * can be optimised a bit, which is done in this implementation. The method
+ * is suitable for parallel computers.
+ *
+ * The arguments are the same as in GaussSeidel.
+ *
+ */
+
+void Jacobi(const int n, double **a, double *b, double *x, double eps,
+ int max_iter) {
+
+ double d; /* temporary real */
+ int i, j, iter; /* counters */
+ double **a_new; /* a is altered */
+ double *b_new; /* b is altered */
+ double *u; /* new solution */
+ double norm; /* L1-norm */
+
+ a_new=MatrixAlloc(3);
+ b_new=VectorAlloc(3);
+ u=VectorAlloc(3);
+
+ for(i=0; i<n; i++) { /* the trick */
+ d=1.0/a[i][i];
+ b_new[i]=d*b[i];
+ for(j=0; j<n; j++)
+ a_new[i][j]=d*a[i][j];
+ } /* for i */
+
+ iter=0;
+ do {
+ iter++;
+ norm=0.0;
+ for(i=0; i<n; i++) { /* update process */
+ d=-a_new[i][i]*x[i]; /* don't include term i=j */
+ for(j=0; j<n; j++)
+ d+=a_new[i][j]*x[j];
+ u[i]=b_new[i]-d;
+ norm=fabs(u[i]-x[i]);
+ } /* for i */
+ for(i=0; i<n; i++) /* copy solution */
+ x[i]=u[i];
+ } while ((iter<=max_iter) && (norm>=eps));
+
+ MatrixFree(3, a_new);
+ VectorFree(3, b_new);
+ VectorFree(3, u);
+} /* Jacobi */
+
+
+/*
+ * DotProd computes the dot product between two vectors. They are assumed to
+ * be of the same dimension.
+ *
+ */
+
+double DotProd(const int n, double *u, double *v) {
+
+ int i; /* counter */
+ double sum=0.0; /* temporary real */
+
+ for(i=0; i<n; i++)
+ sum+=u[i]*v[i];
+ return sum;
+} /* DotProd */
+
+
+/*
+ * MatrixVecProd computes the matrix product between a matrix and a vector of
+ * the dimension n. The result is found in res.
+ *
+ */
+
+void MatrixVecProd(const int n, double **A, double *v, double *res) {
+
+ int i, j; /* counters */
+
+ for(i=0; i<n; i++) {
+ res[i]=0.0;
+ for(j=0; j<n; j++)
+ res[i]+=A[i][j]*v[j];
+ } /* for i */
+} /* MatrixVecProd */
+
+
+/*
+ * MatrixCopy copies the elements of the matrix A to the B.
+ *
+ */
+
+void MatrixCopy(const int n, double **B, double **A) {
+
+ int i, j;
+
+ for(i=0; i<n; i++)
+ for(j=0; j<n; j++)
+ B[i][j]=A[i][j];
+} /* MatrixCopy */
+
+
+/*
+ * L2VectorNorm computes the L2 or Eucleadian norm of a vector.
+ *
+ */
+
+double L2VectorNorm(const int n, double *vec) {
+
+ int i;
+ double norm=0.0;
+
+ for(i=0; i<n; i++)
+ norm+=vec[i]*vec[i];
+ return sqrt(norm);
+} /* L2VectorNorm */
+
+/*
+ * GSR is an implementation of the Gram-Schmidt Reorthonormalisation process,
+ * [2, pp. 246-250]. The n vectors are collected in a matrix, and the matrix is
+ * both input and output. The implementation is actually the modified algorithm
+ * as disucced in [2, p. 248]. Modified by the authors, so the vectors are
+ * normalised at the end.
+ *
+ */
+
+void GSR(const int n, double **A) {
+
+ int i, j, k; /* counters */
+ double dot;
+
+ for(k=0; k<n; k++) { /* orthogonalisation */
+ for(j=(k+1); j<n; j++) {
+ dot=0.0; /* dot product <Aj, Ak> */
+ for(i=0; i<n; i++)
+ dot+=A[i][j]*A[i][k];
+ for(i=0; i<n; i++)
+ A[i][j]-=A[i][k]/dot;
+ } /* for j */
+ } /* for k */
+
+ for(k=0; k<n; k++) { /* normalisation */
+ dot=0.0; /* Compute (L2 norm) */
+ for(i=0; i<n; i++)
+ dot+=A[i][k]*A[i][k];
+ dot=sqrt(dot);
+ if (dot==0.0)
+ SSLerror("Norm = 0 in routine GSR");
+ for(i=0; i<n; i++)
+ A[i][k]/=dot;
+ } /* for k */
+} /* GSR */
+
+
+/*
+ * InversMatrix calculates the inverse matrix. The method is the solution
+ * of n linear set of equations which are solved by a LU factorisation.
+ *
+ */
+
+void InversMatrix(const int n, double **b, double **ib) {
+
+ double **a;
+ double *e;
+ int i,j;
+ int *p;
+
+ a=MatrixAlloc(n);
+ e=VectorAlloc(n);
+ p=IntVectorAlloc(n);
+ MatrixCopy(n, a, b);
+ LUfact(n, a, p);
+ for(i=0; i<n; i++) {
+ for(j=0; j<n; j++)
+ e[j]=0.0;
+ e[i]=1.0;
+ LUsubst(n, a, p, e);
+ for(j=0; j<n; j++)
+ ib[j][i]=e[j];
+ } /* for i=1..n */
+
+ MatrixFree(n, a);
+ VectorFree(n, e);
+ IntVectorFree(n, p);
+} /* InversMatrix */
+
diff --git a/Basic/MatrixOps/matrix.h b/Basic/MatrixOps/matrix.h
new file mode 100644
index 0000000..3dd1f79
--- /dev/null
+++ b/Basic/MatrixOps/matrix.h
@@ -0,0 +1,51 @@
+/*
+ * matrix.h - misc. routines for manipulating matrices and solving linear
+ * equations. Matrices are assumed to be declared as **double and
+ * allocated by the function MatrixAlloc. A matrix can be freed by
+ * MatrixFree. Similar for vectors.
+ *
+ * (C) Copyright 2001 by NetGroup A/S. All rights reserved.
+ *
+ * $Log$
+ * Revision 1.1 2006/06/20 15:57:22 djburke
+ * Hopefully a saner way to build Basic/MatrixOps
+ *
+ * Revision 1.1 2005/01/08 09:22:57 zowie
+ * Added non-symmetric matrices to eigens; updated version to 2.4.2cvs.
+ *
+ * Revision 1.1.1.1 2001/07/06 13:39:35 kneth
+ * Initial import of code.
+ *
+ *
+ */
+
+#ifndef SSL_MATRIX_H_
+#define SSL_MATRIX_H_
+
+#include "sslib.h"
+#include "complex.h"
+
+extern double **MatrixAlloc(const int);
+extern double *VectorAlloc(const int);
+extern int *IntVectorAlloc(const int);
+extern SSL_Complex *SSL_ComplexVectorAlloc(const int);
+extern SSL_Complex **SSL_ComplexMatrixAlloc(const int);
+extern void MatrixMul(const int, double **, double **, double **);
+extern void Transpose(const int, double **, double **);
+extern void MatrixFree(const int, double **);
+extern void VectorFree(const int, double *);
+extern void IntVectorFree(const int, int *);
+extern void SSL_ComplexMatrixFree(const int, SSL_Complex **);
+extern void SSL_ComplexVectorFree(const int, SSL_Complex *);
+extern void LUfact(const int, double **, int *);
+extern void LUsubst(const int, double **, int *, double *);
+extern void GaussSeidel(const int, double **, double *, double *, double, int);
+extern void Jacobi(const int, double **, double *, double *, double, int);
+extern double DotProd(const int, double *, double *);
+extern void MatrixVecProd(const int, double **, double *, double *);
+extern void MatrixCopy(const int, double **, double **);
+extern void GSR(const int, double **);
+extern double L2VectorNorm(const int, double *);
+extern void InversMatrix(const int, double **, double **);
+
+#endif /* SSL_MATRIX_H_ */
diff --git a/Basic/MatrixOps/matrixops.pd b/Basic/MatrixOps/matrixops.pd
new file mode 100644
index 0000000..9e124fc
--- /dev/null
+++ b/Basic/MatrixOps/matrixops.pd
@@ -0,0 +1,1438 @@
+pp_addhdr('
+#include <math.h>
+#include "protos.h"
+
+/* Change names when fixing glibc-2.1 bug */
+#ifdef MY_FIXY0
+#define y0(a) fixy0(a)
+extern double fixy0(double a);
+#endif
+#ifdef MY_FIXYN
+#define yn(a,b) fixyn(a,b)
+extern double fixyn(int a, double b);
+#endif
+');
+
+## handle various cases of 'finite'
+#
+if ($^O =~ /MSWin/) {
+# _finite in VC++ 4.0
+pp_addhdr('
+#define finite _finite
+#include <float.h>
+');
+}
+
+# patch from Albert Chin
+if ($^O =~ /hpux/) {
+pp_addhdr('
+#ifdef isfinite
+#define finite isfinite
+#endif
+');
+}
+
+
+use strict;
+
+pp_addpm({At=>'Top'},<<'EOD');
+
+=head1 NAME
+
+PDL::MatrixOps -- Some Useful Matrix Operations
+
+=head1 SYNOPSIS
+
+ $inv = $a->inv;
+
+ $det = $a->det;
+
+ ($lu,$perm,$par) = $a->lu_decomp;
+ $x = lu_backsub($lu,$perm,$b); # solve $a x $x = $b
+
+=head1 DESCRIPTION
+
+PDL::MatrixOps is PDL's built-in matrix manipulation code. It
+contains utilities for many common matrix operations: inversion,
+determinant finding, eigenvalue/vector finding, singular value
+decomposition, etc. PDL::MatrixOps routines are written in a mixture
+of Perl and C, so that they are reliably present even when there is no
+FORTRAN compiler or external library available (e.g.
+L<PDL::Slatec|PDL::Slatec> or any of the PDL::GSL family of modules).
+
+Matrix manipulation, particularly with large matrices, is a
+challenging field and no one algorithm is suitable in all cases. The
+utilities here use general-purpose algorithms that work acceptably for
+many cases but might not scale well to very large or pathological
+(near-singular) matrices.
+
+Except as noted, the matrices are PDLs whose 0th dimension ranges over
+column and whose 1st dimension ranges over row. The matrices appear
+correctly when printed.
+
+These routines should work OK with L<PDL::Matrix|PDL::Matrix> objects
+as well as with normal PDLs.
+
+=head1 TIPS ON MATRIX OPERATIONS
+
+Like most computer languages, PDL addresses matrices in (column,row)
+order in most cases; this corresponds to (X,Y) coordinates in the
+matrix itself, counting rightwards and downwards from the upper left
+corner. This means that if you print a PDL that contains a matrix,
+the matrix appears correctly on the screen, but if you index a matrix
+element, you use the indices in the reverse order that you would in a
+math textbook. If you prefer your matrices indexed in (row, column)
+order, you can try using the L<PDL::Matrix|PDL::Matrix> object, which
+includes an implicit exchange of the first two dimensions but should
+be compatible with most of these matrix operations. TIMTOWDTI.)
+
+Matrices, row vectors, and column vectors can be multiplied with the 'x'
+operator (which is, of course, threadable):
+
+ $m3 = $m1 x $m2;
+ $col_vec2 = $m1 x $col_vec1;
+ $row_vec2 = $row_vec1 x $m1;
+ $scalar = $row_vec x $col_vec;
+
+Because of the (column,row) addressing order, 1-D PDLs are treated as
+_row_ vectors; if you want a _column_ vector you must add a dummy dimension:
+
+ $rowvec = pdl(1,2); # row vector
+ $colvec = $rowvec->(*1); # 1x2 column vector
+ $matrix = pdl([[3,4],[6,2]]); # 2x2 matrix
+ $rowvec2 = $rowvec x $matrix; # right-multiplication by matrix
+ $colvec = $matrix x $colvec; # left-multiplication by matrix
+ $m2 = $matrix x $rowvec; # Throws an error
+
+Implicit threading works correctly with most matrix operations, but
+you must be extra careful that you understand the dimensionality. In
+particular, matrix multiplication and other matrix ops need nx1 PDLs
+as row vectors and 1xn PDLs as column vectors. In most cases you must
+explicitly include the trailing 'x1' dimension in order to get the expected
+results when you thread over multiple row vectors.
+
+When threading over matrices, it's very easy to get confused about
+which dimension goes where. It is useful to include comments with
+every expression, explaining what you think each dimension means:
+
+ $a = xvals(360)*3.14159/180; # (angle)
+ $rot = cat(cat(cos($a),sin($a)), # rotmat: (col,row,angle)
+ cat(-sin($a),cos($a)));
+
+=head1 ACKNOWLEDGEMENTS
+
+MatrixOps includes algorithms and pre-existing code from several
+origins. In particular, C<eigens_sym> is the work of Stephen Moshier,
+C<svd> uses an SVD subroutine written by Bryant Marks, and C<eigens>
+uses a subset of the Small Scientific Library by Kenneth Geisshirt.
+They are free software, distributable under same terms as PDL itself.
+
+
+=head1 NOTES
+
+This is intended as a general-purpose linear algebra package for
+small-to-mid sized matrices. The algorithms may not scale well to
+large matrices (hundreds by hundreds) or to near singular matrices.
+
+If there is something you want that is not here, please add and
+document it!
+
+=cut
+
+use Carp;
+use PDL::NiceSlice;
+use strict;
+
+EOD
+
+
+######################################################################
+
+pp_add_exported('','identity');
+pp_addpm(<<'EOD');
+=head2 identity
+
+=for sig
+
+ Signature: (n; [o]a(n,n))
+
+=for ref
+
+Return an identity matrix of the specified size. If you hand in a
+scalar, its value is the size of the identity matrix; if you hand in a
+dimensioned PDL, the 0th dimension is the size of the matrix.
+
+=cut
+
+sub identity {
+ my $n = shift;
+ my $out = ((UNIVERSAL::isa($n,'PDL')) ?
+ ( ($n->getndims > 0) ?
+ zeroes($n->dim(0),$n->dim(0)) :
+ zeroes($n->at(0),$n->at(0))
+ ) :
+ zeroes($n,$n)
+ );
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $out->diagonal(0,1))++;
+ $out;
+}
+EOD
+
+######################################################################
+pp_add_exported('','stretcher');
+pp_addpm(<<'EOD');
+
+=head2 stretcher
+
+=for sig
+
+ Signature: (a(n); [o]b(n,n))
+
+=for usage
+
+ $mat = stretcher($eigenvalues);
+
+=for ref
+
+Return a diagonal matrix with the specified diagonal elements
+
+=cut
+
+sub stretcher {
+ my $in = shift;
+ my $out = zeroes($in->dim(0),$in->dims);
+ my $tmp; # work around for perl -d "feature"
+ ($tmp = $out->diagonal(0,1)) += $in;
+ $out;
+}
+
+EOD
+
+######################################################################
+
+pp_add_exported('','inv');
+pp_addpm(<<'EOD');
+
+=head2 inv
+
+=for sig
+
+ Signature: (a(m,m); sv opt )
+
+=for usage
+
+ $a1 = inv($a, {$opt});
+
+=for ref
+
+Invert a square matrix.
+
+You feed in an NxN matrix in $a, and get back its inverse (if it
+exists). The code is inplace-aware, so you can get back the inverse
+in $a itself if you want -- though temporary storage is used either
+way. You can cache the LU decomposition in an output option variable.
+
+C<inv> uses C<lu_decomp> by default; that is a numerically stable
+(pivoting) LU decomposition method.
+
+
+OPTIONS:
+
+=over 3
+
+=item * s
+
+Boolean value indicating whether to complain if the matrix is singular. If
+this is false, singular matrices cause inverse to barf. If it is true, then
+singular matrices cause inverse to return undef.
+
+=item * lu (I/O)
+
+This value contains a list ref with the LU decomposition, permutation,
+and parity values for C<$a>. If you do not mention the key, or if the
+value is undef, then inverse calls C<lu_decomp>. If the key exists with
+an undef value, then the output of C<lu_decomp> is stashed here (unless
+the matrix is singular). If the value exists, then it is assumed to
+hold the LU decomposition.
+
+=item * det (Output)
+
+If this key exists, then the determinant of C<$a> get stored here,
+whether or not the matrix is singular.
+
+=back
+
+=cut
+
+*PDL::inv = \&inv;
+sub inv {
+ my $a = shift;
+ my $opt = shift;
+ $opt = {} unless defined($opt);
+
+
+ barf "inverse needs a square PDL as a matrix\n"
+ unless(UNIVERSAL::isa($a,'PDL') &&
+ $a->dims >= 2 &&
+ $a->dim(0) == $a->dim(1)
+ );
+
+ my ($lu,$perm,$par);
+ if(exists($opt->{lu}) &&
+ ref $opt->{lu} eq 'ARRAY' &&
+ ref $opt->{lu}->[0] eq 'PDL') {
+ ($lu,$perm,$par) = @{$opt->{lu}};
+ } else {
+ ($lu,$perm,$par) = lu_decomp($a);
+ @{$opt->{lu}} = ($lu,$perm,$par)
+ if(ref $opt->{lu} eq 'ARRAY');
+ }
+
+ my $det = (defined $lu) ? $lu->diagonal(0,1)->prodover * $par : pdl(0);
+ $opt->{det} = $det
+ if exists($opt->{det});
+
+ unless($det->nelem > 1 || $det) {
+ return undef
+ if $opt->{s};
+ barf("PDL::inv: got a singular matrix or LU decomposition\n");
+ }
+
+ my $out = lu_backsub($lu,$perm,$par,identity($a))->xchg(0,1)->sever;
+
+ return $out
+ unless($a->is_inplace);
+
+ $a .= $out;
+ $a;
+}
+
+EOD
+
+######################################################################
+
+pp_add_exported('','det');
+pp_addpm(<<'EOD');
+
+=head2 det
+
+=for sig
+
+ Signature: (a(m,m); sv opt)
+
+=for usage
+
+ $det = det($a,{opt});
+
+=for ref
+
+Determinant of a square matrix using LU decomposition (for large matrices)
+
+You feed in a square matrix, you get back the determinant. Some
+options exist that allow you to cache the LU decomposition of the
+matrix (note that the LU decomposition is invalid if the determinant
+is zero!). The LU decomposition is cacheable, in case you want to
+re-use it. This method of determinant finding is more rapid than
+recursive-descent on large matrices, and if you reuse the LU
+decomposition it's essentially free.
+
+OPTIONS:
+
+=over 3
+
+=item * lu (I/O)
+
+Provides a cache for the LU decomposition of the matrix. If you
+provide the key but leave the value undefined, then the LU decomposition
+goes in here; if you put an LU decomposition here, it will be used and
+the matrix will not be decomposed again.
+
+=back
+
+=cut
+
+*PDL::det = \&det;
+sub det {
+ my($a) = shift;
+ my($opt) = shift;
+ $opt = {} unless defined($opt);
+
+ my($lu,$perm,$par);
+ if(exists ($opt->{u}) and (ref $opt->{lu} eq 'ARRAY')) {
+ ($lu,$perm,$par) = @{$opt->{lu}};
+ } else {
+ ($lu,$perm,$par) = lu_decomp($a);
+ $opt->{lu} = [$lu,$perm,$par]
+ if(exists($opt->{lu}));
+ }
+
+ ( (defined $lu) ? $lu->diagonal(0,1)->prodover * $par : 0 );
+}
+
+EOD
+
+######################################################################
+
+pp_add_exported('','determinant');
+pp_addpm(<<'EOD');
+
+=head2 determinant
+
+=for sig
+
+ Signature: (a(m,m))
+
+=for usage
+
+ $det = determinant($a);
+
+=for ref
+
+Determinant of a square matrix, using recursive descent (threadable).
+
+This is the traditional, robust recursive determinant method taught in
+most linear algebra courses. It scales like C<O(n!)> (and hence is
+pitifully slow for large matrices) but is very robust because no
+division is involved (hence no division-by-zero errors for singular
+matrices). It's also threadable, so you can find the determinants of
+a large collection of matrices all at once if you want.
+
+Matrices up to 3x3 are handled by direct multiplication; larger matrices
+are handled by recursive descent to the 3x3 case.
+
+The LU-decomposition method L<det|det> is faster in isolation for
+single matrices larger than about 4x4, and is much faster if you end up
+reusing the LU decomposition of C<$a> (NOTE: check performance and
+threading benchmarks with new code).
+
+=cut
+
+*PDL::determinant = \&determinant;
+sub determinant {
+ my($a) = shift;
+ my($n);
+ return undef unless(
+ UNIVERSAL::isa($a,'PDL') &&
+ $a->getndims >= 2 &&
+ ($n = $a->dim(0)) == $a->dim(1)
+ );
+
+ return $a->clump(2) if($n==1);
+ if($n==2) {
+ my($b) = $a->clump(2);
+ return $b->index(0)*$b->index(3) - $b->index(1)*$b->index(2);
+ }
+ if($n==3) {
+ my($b) = $a->clump(2);
+
+ my $b3 = $b->index(3);
+ my $b4 = $b->index(4);
+ my $b5 = $b->index(5);
+ my $b6 = $b->index(6);
+ my $b7 = $b->index(7);
+ my $b8 = $b->index(8);
+
+ return (
+ $b->index(0) * ( $b4 * $b8 - $b5 * $b7 )
+ + $b->index(1) * ( $b5 * $b6 - $b3 * $b8 )
+ + $b->index(2) * ( $b3 * $b7 - $b4 * $b6 )
+ );
+ }
+
+ my($i);
+ my($sum) = zeroes($a->((0),(0)));
+
+ # Do middle submatrices
+ for $i(1..$n-2) {
+ my $el = $a->(($i),(0));
+ next if( ($el==0)->all ); # Optimize away unnecessary recursion
+
+ $sum += $el * (1-2*($i%2)) *
+ determinant( $a->(0:$i-1,1:-1)->
+ append($a->($i+1:-1,1:-1)));
+ }
+
+ # Do beginning and end submatrices
+ $sum += $a->((0),(0)) * determinant($a->(1:-1,1:-1));
+ $sum -= $a->((-1),(0)) * determinant($a->(0:-2,1:-1)) * (1 - 2*($n % 2));
+
+ return $sum;
+}
+
+EOD
+
+
+######################################################################
+### eigens_sym
+###
+pp_def("eigens_sym",
+ HandleBad => 0,
+ Pars => '[phys]a(m); [o,phys]ev(n,n); [o,phys]e(n)',
+ GenericTypes => ['D'],
+ Code => '
+ extern void eigens( double *A, double *RR, double *E, int N );
+ register int sn = $SIZE (n);
+ if($SIZE (m) != (sn * (sn + 1))/2) {
+ barf("Wrong sized args for eigens_sym");
+ }
+ eigens($P (a), $P (ev), $P (e), sn);
+',
+ PMCode =>'
+ sub PDL::eigens_sym {
+ my ($a) = @_;
+ my (@d) = $a->dims;
+ barf "Need real square matrix for eigens_sym"
+ if $#d < 1 or $d[0] != $d[1];
+ my ($n) = $d[0];
+ my ($sym) = 0.5*($a + $a->mv(0,1));
+ my ($err) = PDL::max(abs($sym));
+ barf "Need symmetric component non-zero for eigens_sym"
+ if $err == 0;
+ $err = PDL::max(abs($a-$sym))/$err;
+ warn "Using symmetrized version of the matrix in eigens_sym"
+ if $err > 1e-5 && $PDL::debug;
+
+ ## Get lower diagonal form
+ ## Use whichND/indexND because whereND doesn\'t exist (yet?) and
+ ## the combo is threadable (unlike where). Note that for historical
+ ## reasons whichND needs a scalar() around it to give back a
+ ## nice 2xn PDL index.
+ my $lt = PDL::indexND($sym,
+ scalar(PDL::whichND(PDL->xvals($n,$n) <=
+ PDL->yvals($n,$n)))
+ )->copy;
+ my $ev = PDL->zeroes($sym->dims);
+ my $e = PDL->zeroes($sym->index(0)->dims);
+
+ &PDL::_eigens_sym_int($lt, $ev, $e);
+
+ return $ev->xchg(0,1), $e
+ if(wantarray);
+ $e; #just eigenvalues
+ }
+'
+ , Doc => '
+=for ref
+
+Eigenvalues and -vectors of a symmetric square matrix. If passed
+an asymmetric matrix, the routine will warn and symmetrize it, by taking
+the average value. That is, it will solve for 0.5*($a+$a->mv(0,1)).
+
+It\'s threadable, so if C<$a> is 3x3x100, it\'s treated as 100 separate 3x3
+matrices, and both C<$ev> and C<$e> get extra dimensions accordingly.
+
+If called in scalar context it hands back only the eigenvalues. Ultimately,
+it should switch to a faster algorithm in this case (as discarding the
+eigenvectors is wasteful).
+
+The algorithm used is due to J. vonNeumann, which was a rediscovery of
+L<Jacobi\'s Method|http://en.wikipedia.org/wiki/Jacobi_eigenvalue_algorithm> .
+
+The eigenvectors are returned in COLUMNS of the returned PDL. That
+makes it slightly easier to access individual eigenvectors, since the
+0th dim of the output PDL runs across the eigenvectors and the 1st dim
+runs across their components.
+
+ ($ev,$e) = eigens_sym $a; # Make eigenvector matrix
+ $vector = $ev->($n); # Select nth eigenvector as a column-vector
+ $vector = $ev->(($n)); # Select nth eigenvector as a row-vector
+
+=for usage
+
+ ($ev, $e) = eigens_sym($a); # e-vects & e-values
+ $e = eigens_sym($a); # just eigenvalues
+
+=cut
+
+',);
+
+######################################################################
+### eigens
+###
+pp_def("eigens",
+ HandleBad => 0,
+ Pars => '[phys]a(m); [o,phys]ev(l,n,n); [o,phys]e(l,n)',
+ GenericTypes => ['D'],
+ Code => '
+ #include "complex.h"
+ #include "eigen.h"
+
+ register int sn = $SIZE(n);
+ int i,j;
+
+ void **foo;
+ void **bar;
+ New(42, foo, sn, void*);
+ New(111, bar, sn, void*);
+
+ if($SIZE (l) != 2) {
+ barf("eigens internal error...");
+ }
+ if($SIZE (m) != (sn * sn )) {
+ fprintf(stderr,"m=%d, sn=%d\n",$SIZE(m),sn);
+ barf("Wrong sized args for eigens");
+ }
+
+ for( i=j=0; i<$SIZE(m); i += sn ) {
+ foo[j] = &( ($P(a))[ i ] );
+ bar[j] = &( ($P(ev))[ i+i ] );
+ j++;
+ }
+
+ Eigen( sn, 0, (double **) foo, 20*sn, 1e-13, 0,
+ (SSL_Complex *)( $P(e) ),
+ (SSL_Complex **) bar
+ );
+ Safefree(foo);
+ Safefree(bar);
+
+ /* Check for invalid values: convenience block */
+ {
+ int k;
+ char ok, flag;
+ PDL_Double eps = 0;
+
+ /* First: find maximum eigenvalue */
+ for(i=0; i< sn; i++ ) {
+ PDL_Double z = fabs ( ($P(e))[i*2] );
+ if( z > eps )
+ eps = z;
+ }
+ eps *= 1e-10;
+
+ /* Next: scan for non-real terms and parallel vectors */
+ for( i=0; i < sn; i++ ) {
+ ok = ( fabs( ($P(e))[i*2+1] ) < eps );
+ for( j=0; ok && j< sn; j++)
+ ok &= fabs( ($P(ev))[ 2* (i*sn + j) + 1] ) < eps;
+ for( k=0; ok && k < i; k++ ) {
+ if( finite( ($P(ev))[ 2 * (k*sn) ] ) ) {
+ for( flag=1, j=0; ok && flag && j< sn; j++)
+ flag &= ( fabs( ($P(ev))[ 2 * (i*sn + j) ] -
+ ($P(ev))[ 2 * (k*sn + j) ]
+ )
+ < 1e-10 * (
+ fabs(($P(ev))[ 2 * (k*sn + j) ]) +
+ fabs(($P(ev))[ 2 * (i*sn + j) ]) )
+ );
+ ok &= !flag;
+ }
+ }
+ if (ok) {
+ for(j=0; ok && j<sn; j++) {
+ double ex = ($P(e))[i*2] * ($P(ev))[2 * (i*sn + j)];
+ double ac = 0.0; /*actual matrix product*/
+ for(k=0; k<sn; k++)
+ ac += ($P(a))[i*sn + k] * ($P(ev))[2 * (i*sn + k)];
+ ok &= fabs(ac-ex)<eps;
+ }
+ }
+
+ /* Set column to NaN if necessary */
+ if( !ok ) {
+ /* TODO: We should set the badval bit if in use. */
+ for(j=0; j< sn; j++)
+ ($P(ev))[2 * (i*sn+j)] = PDL->NaN_double;
+ ($P(e))[i*2] = PDL->NaN_double;
+ }
+ }
+ }
+',
+ PMCode =>'
+ sub PDL::eigens {
+ my ($a) = @_;
+ my (@d) = $a->dims;
+ my $n = $d[0];
+ barf "Need real square matrix for eigens"
+ if $#d < 1 or $d[0] != $d[1];
+ my $deviation = PDL::max(abs($a - $a->mv(0,1)))/PDL::max(abs($a));
+ if ( $deviation <= 1e-5 ) {
+ #taken from eigens_sym code
+
+ my $lt = PDL::indexND($a,
+ scalar(PDL::whichND(PDL->xvals($n,$n) <=
+ PDL->yvals($n,$n)))
+ )->copy;
+ my $ev = PDL->zeroes($a->dims);
+ my $e = PDL->zeroes($a->index(0)->dims);
+
+ &PDL::_eigens_sym_int($lt, $ev, $e);
+
+ return $ev->xchg(0,1), $e if wantarray;
+ return $e; #just eigenvalues
+ }
+ else {
+ if($PDL::verbose || $PDL::debug) {
+ print "eigens: using the asymmetric case from SSL\n";
+ }
+ if( !$PDL::eigens_bug_ack && !$ENV{PDL_EIGENS_ACK} ) {
+ print STDERR "WARNING: using sketchy algorithm for PDL::eigens asymmetric case -- you might\n".
+ " miss an eigenvector or two\nThis should be fixed in PDL v2.5 (due 2009), \n".
+ " or you might fix it yourself (hint hint). You can shut off this warning\n".
+ " by setting the variable $PDL::eigens_bug_ack, or the environment variable\n".
+ " PDL_EIGENS_HACK prior to calling eigens() with a non-symmetric matrix.\n";
+ $PDL::eigens_bug_ack = 1;
+ }
+
+ my $ev = PDL->zeroes(2, $a->dims);
+ my $e = PDL->zeroes(2, $a->index(0)->dims);
+
+ &PDL::_eigens_int($a->clump(0,1), $ev, $e);
+
+ return $ev->index(0)->xchg(0,1)->sever, $e->index(0)->sever
+ if(wantarray);
+ return $e->index(0)->sever; #just eigenvalues
+ }
+ }
+'
+ , Doc => '
+=for ref
+
+Real eigenvalues and -vectors of a real square matrix.
+
+(See also L<"eigens_sym"|/eigens_sym>, for eigenvalues and -vectors
+of a real, symmetric, square matrix).
+
+The eigens function will attempt to compute the eigenvalues and
+eigenvectors of a square matrix with real components. If the matrix
+is symmetric, the same underlying code as L<"eigens_sym"|/eigens_sym>
+is used. If asymmetric, the eigenvalues and eigenvectors are computed
+with algorithms from the sslib library. If any imaginary components
+exist in the eigenvalues, the results are currently considered to be
+invalid, and such eigenvalues are returned as "NaN"s. This is true
+for eigenvectors also. That is if there are imaginary components to
+any of the values in the eigenvector, the eigenvalue and corresponding
+eigenvectors are all set to "NaN". Finally, if there are any repeated
+eigenvectors, they are replaced with all "NaN"s.
+
+Use of the eigens function on asymmetric matrices should be considered
+experimental! For asymmetric matrices, nearly all observed matrices
+with real eigenvalues produce incorrect results, due to errors of the
+sslib algorithm. If your assymmetric matrix returns all NaNs, do not
+assume that the values are complex. Also, problems with memory access
+is known in this library.
+
+Not all square matrices are diagonalizable. If you feed in a
+non-diagonalizable matrix, then one or more of the eigenvectors will
+be set to NaN, along with the corresponding eigenvalues.
+
+C<eigens> is threadable, so you can solve 100 eigenproblems by
+feeding in a 3x3x100 array. Both C<$ev> and C<$e> get extra dimensions accordingly.
+
+If called in scalar context C<eigens> hands back only the eigenvalues. This
+is somewhat wasteful, as it calculates the eigenvectors anyway.
+
+The eigenvectors are returned in COLUMNS of the returned PDL (ie the
+the 0 dimension). That makes it slightly easier to access individual
+eigenvectors, since the 0th dim of the output PDL runs across the
+eigenvectors and the 1st dim runs across their components.
+
+ ($ev,$e) = eigens $a; # Make eigenvector matrix
+ $vector = $ev->($n); # Select nth eigenvector as a column-vector
+ $vector = $ev->(($n)); # Select nth eigenvector as a row-vector
+
+DEVEL NOTES:
+
+For now, there is no distinction between a complex eigenvalue and an
+invalid eigenvalue, although the underlying code generates complex
+numbers. It might be useful to be able to return complex eigenvalues.
+
+=for usage
+
+ ($ev, $e) = eigens($a); # e\'vects & e\'vals
+ $e = eigens($a); # just eigenvalues
+
+=cut
+
+
+',);
+
+######################################################################
+### svd
+pp_def(
+ "svd",
+ HandleBad => 0,
+ Pars => 'a(n,m); [o]u(n,m); [o,phys]z(n); [o]v(n,n);',
+ GenericTypes => ['D'],
+ Code => '
+ extern void SVD( double *W, double *Z, int nRow, int nCol );
+ int sm = $SIZE (m), sn = $SIZE (n), i;
+ double *w, *t, zv;
+ t = w = (double *) malloc(sn*(sm+sn)*sizeof(double));
+ loop (m) %{
+ loop(n) %{
+ *t++ = $a ();
+ %}
+ %}
+ SVD(w, $P (z), sm, sn);
+ t = w;
+ loop (n) %{
+ zv = sqrt($z ());
+ $z () = zv;
+ %}
+ loop (m) %{
+ loop (n) %{
+ $u () = *t++/$z ();
+ %}
+ %}
+ loop (n) %{
+ for (i=0;i<sn;i++) {
+ $v (n0=>i, n1=>n) = *t++;
+ }
+ %}
+ free(w);
+',
+ , Doc => '
+=for usage
+
+ ($r1, $s, $r2) = svd($a);
+
+=for ref
+
+Singular value decomposition of a matrix.
+
+C<svd> is threadable.
+
+C<$r1> and C<$r2> are rotation matrices that convert from the original
+matrix\'s singular coordinates to final coordinates, and from original
+coordinates to singular coordinates, respectively. C<$s> is the
+diagonal of the singular value matrix, so that, if C<$a> is square,
+then you can make an expensive copy of C<$a> by saying:
+
+ $ess = zeroes($r1); $ess->diagonal(0,1) .= $s;
+ $a_copy .= $r2 x $ess x $r1;
+
+EXAMPLE
+
+The computing literature has loads of examples of how to use SVD.
+Here\'s a trivial example (used in L<PDL::Transform::map|PDL::Transform/map>)
+of how to make a matrix less, er, singular, without changing the
+orientation of the ellipsoid of transformation:
+
+ { my($r1,$s,$r2) = svd $a;
+ $s++; # fatten all singular values
+ $r2 *= $s; # implicit threading for cheap mult.
+ $a .= $r2 x $r1; # a gets r2 x ess x r1
+ }
+
+=cut
+
+
+',);
+
+
+######################################################################
+pp_add_exported('','lu_decomp');
+pp_addpm(<<'EOD');
+
+=head2 lu_decomp
+
+=for sig
+
+ Signature: (a(m,m); [o]lu(m,m); [o]perm(m); [o]parity)
+
+=for ref
+
+LU decompose a matrix, with row permutation
+
+=for usage
+
+ ($lu, $perm, $parity) = lu_decomp($a);
+
+ $lu = lu_decomp($a, $perm, $par); # $perm and $par are outputs!
+
+ lu_decomp($a->inplace,$perm,$par); # Everything in place.
+
+=for description
+
+C<lu_decomp> returns an LU decomposition of a square matrix,
+using Crout's method with partial pivoting. It's ported
+from I<Numerical Recipes>. The partial pivoting keeps it
+numerically stable but means a little more overhead from
+threading.
+
+C<lu_decomp> decomposes the input matrix into matrices L and
+U such that LU = A, L is a subdiagonal matrix, and U is a
+superdiagonal matrix. By convention, the diagonal of L is
+all 1's.
+
+The single output matrix contains all the variable elements
+of both the L and U matrices, stacked together. Because the
+method uses pivoting (rearranging the lower part of the
+matrix for better numerical stability), you have to permute
+input vectors before applying the L and U matrices. The
+permutation is returned either in the second argument or, in
+list context, as the second element of the list. You need
+the permutation for the output to make any sense, so be sure
+to get it one way or the other.
+
+LU decomposition is the answer to a lot of matrix questions,
+including inversion and determinant-finding, and C<lu_decomp>
+is used by L<inv|/inv>.
+
+If you pass in C<$perm> and C<$parity>, they either must be
+predeclared PDLs of the correct size ($perm is an n-vector,
+C<$parity> is a scalar) or scalars.
+
+If the matrix is singular, then the LU decomposition might
+not be defined; in those cases, C<lu_decomp> silently returns
+undef. Some singular matrices LU-decompose just fine, and
+those are handled OK but give a zero determinant (and hence
+can't be inverted).
+
+C<lu_decomp> uses pivoting, which rearranges the values in the
+matrix for more numerical stability. This makes it really
+good for large and even near-singular matrices. There is
+a non-pivoting version C<lu_decomp2> available which is
+from 5 to 60 percent faster for typical problems at
+the expense of failing to compute a result in some cases.
+
+Now that the C<lu_decomp> is threaded, it is the recommended
+LU decomposition routine. It no longer falls back to C<lu_decomp2>.
+
+C<lu_decomp> is ported from I<Numerical Recipes> to PDL. It
+should probably be implemented in C.
+
+=cut
+
+*PDL::lu_decomp = \&lu_decomp;
+
+sub lu_decomp {
+ my($in) = shift;
+ my($permute) = shift;
+ my($parity) = shift;
+ my($sing_ok) = shift;
+
+ my $TINY = 1e-30;
+
+ barf("lu_decomp requires a square (2D) PDL\n")
+ if(!UNIVERSAL::isa($in,'PDL') ||
+ $in->ndims < 2 ||
+ $in->dim(0) != $in->dim(1));
+
+ my($n) = $in->dim(0);
+ my($n1) = $n; $n1--;
+
+ my($inplace) = $in->is_inplace;
+ my($out) = ($inplace) ? $in : $in->copy;
+
+
+ if(defined $permute) {
+ barf('lu_decomp: permutation vector must match the matrix')
+ if(!UNIVERSAL::isa($permute,'PDL') ||
+ $permute->ndims != 1 ||
+ $permute->dim(0) != $out->dim(0));
+ $permute .= PDL->xvals($in->dim(0));
+ } else {
+ $permute = $in->((0))->xvals;
+ }
+
+ if(defined $parity) {
+ barf('lu_decomp: parity must be a scalar PDL')
+ if(!UNIVERSAL::isa($parity,'PDL') ||
+ $parity->dim(0) != 1);
+ $parity .= 1.0;
+ } else {
+ $parity = $in->((0),(0))->ones;
+ }
+
+ my($scales) = $in->abs->maximum; # elementwise by rows
+
+ if(($scales==0)->sum) {
+ return undef;
+ }
+
+ # Some holding tanks
+ my($tmprow) = $out->((0))->double->zeroes;
+ my($tmpval) = $tmprow->((0))->sever;
+
+ my($col,$row);
+ for $col(0..$n1) {
+ for $row(1..$n1) {
+ my($klim) = $row<$col ? $row : $col;
+ if($klim > 0) {
+ $klim--;
+ my($el) = $out->index2d($col,$row);
+ $el -= ( $out->(($col),0:$klim) *
+ $out->(0:$klim,($row)) )->sumover;
+ }
+
+ }
+
+ # Figure a_ij, with pivoting
+
+ if($col < $n1) {
+ # Find the maximum value in the rest of the row
+ my $sl = $out->(($col),$col:$n1);
+ my $wh = $sl->abs->maximum_ind;
+ my $big = $sl->index($wh)->sever;
+
+ # Permute if necessary to make the diagonal the maximum
+ # if($wh != 0)
+ { # Permute rows to place maximum element on diagonal.
+ my $whc = $wh+$col;
+
+ # my $sl1 = $out->(:,($whc));
+ my $sl1 = $out->mv(1,0)->index($whc(*$n));
+ my $sl2 = $out->(:,($col));
+ $tmprow .= $sl1; $sl1 .= $sl2; $sl2 .= $tmprow;
+
+ $sl1 = $permute->index($whc);
+ $sl2 = $permute->index($col);
+ $tmpval .= $sl1; $sl1 .= $sl2; $sl2 .= $tmpval;
+
+ { my $tmp;
+ ($tmp = $parity->where($wh>0)) *= -1.0;
+ }
+ }
+
+ # Sidestep near-singularity (NR does this; not sure if it is helpful)
+
+ my $notbig = $big->where(abs($big) < $TINY);
+ $notbig .= $TINY * (1.0 - 2.0*($notbig < 0));
+
+ # Divide by the diagonal element (which is now the largest element)
+ my $tout;
+ ($tout = $out->(($col),$col+1:$n1)) /= $big->(*1);
+ } # end of pivoting part
+ } # end of column loop
+
+ if(wantarray) {
+ return ($out,$permute,$parity);
+ }
+ $out;
+}
+
+EOD
+
+######################################################################
+pp_add_exported('','lu_decomp2');
+pp_addpm(<<'EOD');
+
+=head2 lu_decomp2
+
+=for sig
+
+ Signature: (a(m,m); [o]lu(m,m))
+
+=for ref
+
+LU decompose a matrix, with no row permutation
+
+=for usage
+
+ ($lu, $perm, $parity) = lu_decomp2($a);
+
+ $lu = lu_decomp2($a,$perm,$parity); # or
+ $lu = lu_decomp2($a); # $perm and $parity are optional
+
+ lu_decomp($a->inplace,$perm,$parity); # or
+ lu_decomp($a->inplace); # $perm and $parity are optional
+
+=for description
+
+C<lu_decomp2> works just like L<lu_decomp|lu_decomp>, but it does B<no>
+pivoting at all. For compatibility with L<lu_decomp|lu_decomp>, it
+will give you a permutation list and a parity scalar if you ask
+for them -- but they are always trivial.
+
+Because C<lu_decomp2> does not pivot, it is numerically B<unstable> --
+that means it is less precise than L<lu_decomp>, particularly for
+large or near-singular matrices. There are also specific types of
+non-singular matrices that confuse it (e.g. ([0,-1,0],[1,0,0],[0,0,1]),
+which is a 90 degree rotation matrix but which confuses C<lu_decomp2>).
+
+On the other hand, if you want to invert rapidly a few hundred thousand
+small matrices and don't mind missing one or two, it could be the ticket.
+It can be up to 60% faster at the expense of possible failure of the
+decomposition for some of the input matrices.
+
+The output is a single matrix that contains the LU decomposition of C<$a>;
+you can even do it in-place, thereby destroying C<$a>, if you want. See
+L<lu_decomp> for more information about LU decomposition.
+
+C<lu_decomp2> is ported from I<Numerical Recipes> into PDL.
+
+=cut
+
+*PDL::lu_decomp2 = \&lu_decomp2;
+
+sub lu_decomp2 {
+ my($in) = shift;
+ my($perm) = shift;
+ my($par) = shift;
+
+ my($sing_ok) = shift;
+
+ my $TINY = 1e-30;
+
+ barf("lu_decomp2 requires a square (2D) PDL\n")
+ if(!UNIVERSAL::isa($in,'PDL') ||
+ $in->ndims < 2 ||
+ $in->dim(0) != $in->dim(1));
+
+ my($n) = $in->dim(0);
+ my($n1) = $n; $n1--;
+
+ my($inplace) = $in->is_inplace;
+ my($out) = ($inplace) ? $in : $in->copy;
+
+
+ if(defined $perm) {
+ barf('lu_decomp2: permutation vector must match the matrix')
+ if(!UNIVERSAL::isa($perm,'PDL') ||
+ $perm->ndims != 1 ||
+ $perm->dim(0) != $out->dim(0));
+ $perm .= PDL->xvals($in->dim(0));
+ } else {
+ $perm = PDL->xvals($in->dim(0));
+ }
+
+ if(defined $par) {
+ barf('lu_decomp: parity must be a scalar PDL')
+ if(!UNIVERSAL::isa($par,'PDL') ||
+ $par->nelem != 1);
+ $par .= 1.0;
+ } else {
+ $par = pdl(1.0);
+ }
+
+ my $diagonal = $out->diagonal(0,1);
+
+ my($col,$row);
+ for $col(0..$n1) {
+ for $row(1..$n1) {
+ my($klim) = $row<$col ? $row : $col;
+ if($klim > 0) {
+ $klim--;
+ my($el) = $out->index2d($col,$row);
+
+ $el -= ( $out->(($col),0:$klim) *
+ $out->(0:$klim,($row)) )->sumover;
+ }
+
+ }
+
+ # Figure a_ij, with no pivoting
+ if($col < $n1) {
+ # Divide the rest of the column by the diagonal element
+ my $tmp; # work around for perl -d "feature"
+ ($tmp = $out->(($col),$col+1:$n1)) /= $diagonal->index($col)->dummy(0,$n1-$col);
+ }
+
+ } # end of column loop
+
+ if(wantarray) {
+ return ($out,$perm,$par);
+ }
+ $out;
+}
+
+EOD
+
+######################################################################
+pp_add_exported('','lu_backsub');
+pp_addpm(<<'EOD');
+
+=head2 lu_backsub
+
+=for sig
+
+ Signature: (lu(m,m); perm(m); b(m))
+
+=for ref
+
+Solve a x = b for matrix a, by back substitution into a's LU decomposition.
+
+=for usage
+
+ ($lu,$perm,$par) = lu_decomp($a);
+
+ $x = lu_backsub($lu,$perm,$par,$b); # or
+ $x = lu_backsub($lu,$perm,$b); # $par is not required for lu_backsub
+
+ lu_backsub($lu,$perm,$b->inplace); # modify $b in-place
+
+ $x = lu_backsub(lu_decomp($a),$b); # (ignores parity value from lu_decomp)
+
+=for description
+
+Given the LU decomposition of a square matrix (from L<lu_decomp|lu_decomp>),
+C<lu_backsub> does back substitution into the matrix to solve
+C<a x = b> for given vector C<b>. It is separated from the
+C<lu_decomp> method so that you can call the cheap C<lu_backsub>
+multiple times and not have to do the expensive LU decomposition
+more than once.
+
+C<lu_backsub> acts on single vectors and threads in the usual
+way, which means that it treats C<$b> as the I<transpose>
+of the input. If you want to process a matrix, you must
+hand in the I<transpose> of the matrix, and then transpose
+the output when you get it back. that is because pdls are
+indexed by (col,row), and matrices are (row,column) by
+convention, so a 1-D pdl corresponds to a row vector, not a
+column vector.
+
+If C<$lu> is dense and you have more than a few points to
+solve for, it is probably cheaper to find C<a^-1> with
+L<inv|/inv>, and just multiply C<x = a^-1 b>.) in fact,
+L<inv|/inv> works by calling C<lu_backsub> with the identity
+matrix.
+
+C<lu_backsub> is ported from section 2.3 of I<Numerical Recipes>.
+It is written in PDL but should probably be implemented in C.
+
+=cut
+
+*PDL::lu_backsub = \&lu_backsub;
+
+sub lu_backsub {
+ my ($lu, $perm, $b, $par);
+ print STDERR "lu_backsub: entering debug version...\n" if $PDL::debug;
+ if(@_==3) {
+ ($lu, $perm, $b) = @_;
+ } elsif(@_==4) {
+ ($lu, $perm, $par, $b) = @_;
+ }
+
+ barf("lu_backsub: LU decomposition is undef -- probably from a singular matrix.\n")
+ unless defined($lu);
+
+ barf("Usage: \$x = lu_backsub(\$lu,\$perm,\$b); all must be PDLs\n")
+ unless(UNIVERSAL::isa($lu,'PDL') &&
+ UNIVERSAL::isa($perm,'PDL') &&
+ UNIVERSAL::isa($b,'PDL'));
+
+ my $n = $b->dim(0);
+ my $n1 = $n; $n1--;
+
+ # Make sure threading dimensions are compatible.
+ # There are two possible sources of thread dims:
+ #
+ # (1) over multiple LU (i.e., $lu,$perm) instances
+ # (2) over multiple B (i.e., $b) column instances
+ #
+ # The full dimensions of the function call looks like
+ #
+ # lu_backsub( lu(m,m,X), perm(m,X), b(m,Y) )
+ #
+ # where X is the list of extra LU dims and Y is
+ # the list of extra B dims. We have several possible
+ # cases:
+ #
+ # (1) Check that m dims are compatible
+ my $ludims = pdl($lu->dims);
+ my $permdims = pdl($perm->dims);
+ my $bdims = pdl($b->dims);
+
+ print STDERR "lu_backsub: called with args: \$lu$ludims, \$perm$permdims, \$b$bdims\n" if $PDL::debug;
+
+ my $m = $ludims((0)); # this is the sig dimension
+ unless ( ($ludims(0) == $m) and ($ludims(1) == $m) and
+ ($permdims(0) == $m) and ($bdims(0) == $m)) {
+ barf "lu_backsub: mismatched sig dimensions";
+ }
+
+ my $lunumthr = $ludims->dim(0)-2;
+ my $permnumthr = $permdims->dim(0)-1;
+ my $bnumthr = $bdims->dim(0)-1;
+ unless ( ($lunumthr == $permnumthr) and ($ludims(1:-1) == $permdims)->all ) {
+ barf "lu_backsub: \$lu and \$perm thread dims not equal! \n";
+ }
+
+ # (2) If X == Y then default threading is ok
+ if ( ($bnumthr==$permnumthr) and ($bdims==$permdims)->all) {
+ print STDERR "lu_backsub: have explicit thread dims, goto THREAD_OK\n" if $PDL::debug;
+ goto THREAD_OK;
+ }
+
+ # (3) If X == (x,Y) then add x dummy to lu,perm
+
+ # (4) If ndims(X) > ndims(Y) then must have #3
+
+ # (5) If ndims(X) < ndims(Y) then foreach
+ # non-trivial leading dim in X (x0,x1,..)
+ # insert dummy (x0,x1) into lu and perm
+
+ # This means that threading occurs over all
+ # leading non-trivial (not length 1) dims of
+ # B unless all the thread dims are explicitly
+ # matched to the LU dims.
+
+THREAD_OK:
+
+ # Permute the vector and make a copy if necessary.
+ my $out;
+ # my $nontrivial = ! (($perm==(PDL->xvals($perm->dims)))->all);
+ my $nontrivial = ! (($perm==$perm->xvals)->clump(-1)->andover);
+
+ if($nontrivial) {
+ if($b->is_inplace) {
+ $b .= $b->dummy(1,$b->dim(0))->index($perm->dummy(1,1))->sever; # TODO: check threading
+ $out = $b;
+ } else {
+ $out = $b->dummy(1,$b->dim(0))->index($perm->dummy(1,1))->sever; # TODO: check threading
+ }
+ } else {
+ # should check for more matrix dims to thread over
+ # but ignore the issue for now
+ $out = ($b->is_inplace ? $b : $b->copy);
+ }
+ print STDERR "lu_backsub: starting with \$out" . pdl($out->dims) . "\n" if $PDL::debug;
+
+ # Make sure threading over lu happens OK...
+
+ if($out->ndims < $lu->ndims-1) {
+ print STDERR "lu_backsub: adjusting dims for \$out" . pdl($out->dims) . "\n" if $PDL::debug;
+ do {
+ $out = $out->dummy(-1,$lu->dim($out->ndims+1));
+ } while($out->ndims < $lu->ndims-1);
+ $out = $out->sever;
+ }
+
+ ## Do forward substitution into L
+ my $row; my $r1;
+
+ for $row(1..$n1) {
+ $r1 = $row-1;
+ my $tmp; # work around perl -d "feature
+ ($tmp = $out->index($row)) -= ($lu->(0:$r1,$row) *
+ $out->(0:$r1)
+ )->sumover;
+ }
+
+ ## Do backward substitution into U, and normalize by the diagonal
+ my $ludiag = $lu->diagonal(0,1);
+ {
+ my $tmp; # work around for perl -d "feature"
+ ($tmp = $out->index($n1)) /= $ludiag->index($n1)->dummy(0,1); # TODO: check threading
+ }
+
+ for ($row=$n1; $row>0; $row--) {
+ $r1 = $row-1;
+ my $tmp; # work around for perl -d "feature"
+ ($tmp = $out->index($r1)) -= ($lu->($row:$n1,$r1) * # TODO: check thread dims
+ $out->($row:$n1)
+ )->sumover;
+ ($tmp = $out->index($r1)) /= $ludiag->index($r1)->dummy(0,1); # TODO: check thread dims
+ }
+
+ $out;
+}
+
+
+EOD
+
+
+######################################################################
+### simq
+###
+
+# XXX Destroys a!!!
+# To use the new a again, must store both a and ips.
+pp_def("simq",
+ HandleBad => 0,
+ Pars => '[phys]a(n,n); [phys]b(n); [o,phys]x(n); int [o,phys]ips(n)',
+ OtherPars => 'int flag;',
+ GenericTypes => ['D'],
+ Code => '
+ extern int simq( double *A, double *B, double *X,
+ int n, int flag, int *IPS );
+ simq($P (a),$P (b),$P (x),$SIZE (n),$COMP (flag),$P (ips));
+',
+ Doc => '
+=for ref
+
+Solution of simultaneous linear equations, C<a x = b>.
+
+C<$a> is an C<n x n> matrix (i.e., a vector of length C<n*n>), stored row-wise:
+that is, C<a(i,j) = a[ij]>, where C<ij = i*n + j>.
+
+While this is the transpose of the normal column-wise storage, this
+corresponds to normal PDL usage. The contents of matrix a may be
+altered (but may be required for subsequent calls with flag = -1).
+
+C<$b>, C<$x>, C<$ips> are vectors of length C<n>.
+
+Set C<flag=0> to solve.
+Set C<flag=-1> to do a new back substitution for
+different C<$b> vector using the same a matrix previously reduced when
+C<flag=0> (the C<$ips> vector generated in the previous solution is also
+required).
+
+See also L<lu_backsub|lu_backsub>, which does the same thing with a slightly
+less opaque interface.
+
+=cut
+
+
+');
+
+######################################################################
+### squaretotri
+###
+# this doesn't need to be changed to support bad values
+# I could put 'HandleBad => 1', but it would just cause an
+# unnecessary increase (admittedly small) in the amount of
+# code
+#
+pp_def("squaretotri",
+ Pars => 'a(n,n); b(m)',
+ Code => '
+ register int mna=0, nb=0, ns = $SIZE (n);
+ #if (PERL_VERSION >= 5) && (PERL_SUBVERSION >= 57)
+ dXSARGS;
+ #endif
+
+ if($SIZE (m) != (ns * (ns+1))/2) {
+ barf("Wrong sized args for squaretotri");
+ }
+ threadloop %{
+ loop(m) %{
+ $b () = $a (n0 => mna, n1 => nb);
+ mna++; if(mna > nb) {mna = 0; nb ++;}
+ %}
+ %}
+ ',
+ Doc => '
+=for ref
+
+Convert a symmetric square matrix to triangular vector storage.
+
+=cut
+
+
+',
+);
+
+pp_addpm({At=>'Bot'},<<'EOD');
+
+sub eigen_c {
+ print STDERR "eigen_c is no longer part of PDL::MatrixOps or PDL::Math; use eigens instead.\n";
+
+## my($mat) = @_;
+## my $s = $mat->getdim(0);
+## my $z = zeroes($s * ($s+1) / 2);
+## my $ev = zeroes($s);
+## squaretotri($mat,$z);
+## my $k = 0 * $mat;
+## PDL::eigens($z, $k, $ev);
+## return ($ev, $k);
+}
+
+
+=head1 AUTHOR
+
+Copyright (C) 2002 Craig DeForest (deforest at boulder.swri.edu),
+R.J.R. Williams (rjrw at ast.leeds.ac.uk), Karl Glazebrook
+(kgb at aaoepp.aao.gov.au). There is no warranty. You are allowed to
+redistribute and/or modify this work under the same conditions as PDL
+itself. If this file is separated from the PDL distribution, then the
+PDL copyright notice should be included in this file.
+
+=cut
+
+EOD
+
+pp_done();
diff --git a/Basic/MatrixOps/protos.h b/Basic/MatrixOps/protos.h
new file mode 100644
index 0000000..1a54099
--- /dev/null
+++ b/Basic/MatrixOps/protos.h
@@ -0,0 +1,45 @@
+/*
+ * This file was automatically generated by version 1.7 of cextract.
+ * Manual editing not recommended.
+ *
+ * Created: Fri Nov 28 17:00:03 1997
+ */
+#ifndef __CEXTRACT__
+#if __STDC__
+
+extern double asinh ( double xx );
+extern double j0 ( double x );
+extern double y0 ( double x );
+extern double jn ( int n, double x );
+extern double ndtr ( double a );
+extern double erfc ( double a );
+extern double erf ( double x );
+extern double acosh ( double x );
+extern double atanh ( double x );
+extern double j1 ( double x );
+extern double y1 ( double x );
+extern int mtherr ( char *name, int code );
+extern double polevl ( double x, double coef[], int N );
+extern double p1evl ( double x, double coef[], int N );
+extern double yn ( int n, double x );
+
+#else /* __STDC__ */
+
+extern double asinh (/* double xx */);
+extern double j0 (/* double x */);
+extern double y0 (/* double x */);
+extern double jn (/* int n, double x */);
+extern double ndtr (/* double a */);
+extern double erfc (/* double a */);
+extern double erf (/* double x */);
+extern double acosh (/* double x */);
+extern double atanh (/* double x */);
+extern double j1 (/* double x */);
+extern double y1 (/* double x */);
+extern int mtherr (/* char *name, int code */);
+extern double polevl (/* double x, double coef[], int N */);
+extern double p1evl (/* double x, double coef[], int N */);
+extern double yn (/* int n, double x */);
+
+#endif /* __STDC__ */
+#endif /* __CEXTRACT__ */
diff --git a/Basic/MatrixOps/simq.c b/Basic/MatrixOps/simq.c
new file mode 100644
index 0000000..587c7d3
--- /dev/null
+++ b/Basic/MatrixOps/simq.c
@@ -0,0 +1,177 @@
+/* simq.c
+ *
+ * Solution of simultaneous linear equations AX = B
+ * by Gaussian elimination with partial pivoting
+ *
+ *
+ *
+ * SYNOPSIS:
+ *
+ * double A[n*n], B[n], X[n];
+ * int n, flag;
+ * int IPS[];
+ * int simq();
+ *
+ * ercode = simq( A, B, X, n, flag, IPS );
+ *
+ *
+ *
+ * DESCRIPTION:
+ *
+ * B, X, IPS are vectors of length n.
+ * A is an n x n matrix (i.e., a vector of length n*n),
+ * stored row-wise: that is, A(i,j) = A[ij],
+ * where ij = i*n + j, which is the transpose of the normal
+ * column-wise storage.
+ *
+ * The contents of matrix A are destroyed.
+ *
+ * Set flag=0 to solve.
+ * Set flag=-1 to do a new back substitution for different B vector
+ * using the same A matrix previously reduced when flag=0.
+ *
+ * The routine returns nonzero on error; messages are printed.
+ *
+ *
+ * ACCURACY:
+ *
+ * Depends on the conditioning (range of eigenvalues) of matrix A.
+ *
+ *
+ * REFERENCE:
+ *
+ * Computer Solution of Linear Algebraic Systems,
+ * by George E. Forsythe and Cleve B. Moler; Prentice-Hall, 1967.
+ *
+ */
+
+/* simq 2 */
+
+int simq( A, B, X, n, flag, IPS )
+double A[], B[], X[];
+int n, flag;
+int IPS[];
+{
+int i, j, ij, ip, ipj, ipk, ipn;
+int idxpiv, iback;
+int k, kp, kp1, kpj, kpk, kpn;
+int nip, nkp, nm1;
+double em, q, rownrm, big, size, pivot, sum;
+double fabs();
+
+if( flag < 0 )
+ goto solve;
+
+/* Initialize IPS and X */
+
+ij=0;
+for( i=0; i<n; i++ )
+ {
+ IPS[i] = i;
+ rownrm = 0.0;
+ for( j=0; j<n; j++ )
+ {
+ q = fabs( A[ij] );
+ if( rownrm < q )
+ rownrm = q;
+ ++ij;
+ }
+ if( rownrm == 0.0 )
+ {
+ puts("SIMQ ROWNRM=0");
+ return(1);
+ }
+ X[i] = 1.0/rownrm;
+ }
+
+/* simq 3 */
+/* Gaussian elimination with partial pivoting */
+
+nm1 = n-1;
+for( k=0; k<nm1; k++ )
+ {
+ big= 0.0;
+ for( i=k; i<n; i++ )
+ {
+ ip = IPS[i];
+ ipk = n*ip + k;
+ size = fabs( A[ipk] ) * X[ip];
+ if( size > big )
+ {
+ big = size;
+ idxpiv = i;
+ }
+ }
+
+ if( big == 0.0 )
+ {
+ puts( "SIMQ BIG=0" );
+ return(2);
+ }
+ if( idxpiv != k )
+ {
+ j = IPS[k];
+ IPS[k] = IPS[idxpiv];
+ IPS[idxpiv] = j;
+ }
+ kp = IPS[k];
+ kpk = n*kp + k;
+ pivot = A[kpk];
+ kp1 = k+1;
+ for( i=kp1; i<n; i++ )
+ {
+ ip = IPS[i];
+ ipk = n*ip + k;
+ em = -A[ipk]/pivot;
+ A[ipk] = -em;
+ nip = n*ip;
+ nkp = n*kp;
+ for( j=kp1; j<n; j++ )
+ {
+ ipj = nip + j;
+ A[ipj] = A[ipj] + em * A[nkp + j];
+ }
+ }
+ }
+kpn = n * IPS[n-1] + n - 1; /* last element of IPS[n] th row */
+if( A[kpn] == 0.0 )
+ {
+ puts( "SIMQ A[kpn]=0");
+ return(3);
+ }
+
+/* simq 4 */
+/* back substitution */
+
+solve:
+ip = IPS[0];
+X[0] = B[ip];
+for( i=1; i<n; i++ )
+ {
+ ip = IPS[i];
+ ipj = n * ip;
+ sum = 0.0;
+ for( j=0; j<i; j++ )
+ {
+ sum += A[ipj] * X[j];
+ ++ipj;
+ }
+ X[i] = B[ip] - sum;
+ }
+
+ipn = n * IPS[n-1] + n - 1;
+X[n-1] = X[n-1]/A[ipn];
+
+for( iback=1; iback<n; iback++ )
+ {
+/* i goes (n-1),...,1 */
+ i = nm1 - iback;
+ ip = IPS[i];
+ nip = n*ip;
+ sum = 0.0;
+ for( j=i+1; j<n; j++ )
+ sum += A[nip+j] * X[j];
+ X[i] = (X[i] - sum)/A[nip+i];
+ }
+return(0);
+}
diff --git a/Basic/MatrixOps/sslib.c b/Basic/MatrixOps/sslib.c
new file mode 100644
index 0000000..1539f49
--- /dev/null
+++ b/Basic/MatrixOps/sslib.c
@@ -0,0 +1,45 @@
+/*
+ * ssl.c - misc. functions for Small Scientific Library
+ *
+ * (C) Copyright 2001 by NetGroup A/S. All rights reserved.
+ *
+ * $Log$
+ * Revision 1.1 2006/06/20 15:57:22 djburke
+ * Hopefully a saner way to build Basic/MatrixOps
+ *
+ * Revision 1.1 2005/01/08 09:22:57 zowie
+ * Added non-symmetric matrices to eigens; updated version to 2.4.2cvs.
+ *
+ * Revision 1.1.1.1 2001/07/06 13:39:35 kneth
+ * Initial import of code.
+ *
+ *
+ */
+
+#include <stdio.h>
+
+/*
+ * SSLerror is an error handling routine.
+ *
+ */
+
+void SSLerror(char *msg) {
+
+ fprintf(stderr, "Fatal error in SSL.\n%s\n", msg);
+} /* SSLerror */
+
+
+/*
+ * Sqr and Cube is two simple power-raising routines.
+ *
+ */
+
+double Sqr(double x) {
+
+ return x*x;
+} /* Sqr */
+
+double Cube(double x) {
+
+ return x*x*x;
+} /* Cube */
diff --git a/Basic/MatrixOps/sslib.h b/Basic/MatrixOps/sslib.h
new file mode 100644
index 0000000..3b40ffa
--- /dev/null
+++ b/Basic/MatrixOps/sslib.h
@@ -0,0 +1,42 @@
+/*
+ * ssl.h - Small Scientific Library.
+ *
+ * (C) Copyright 2001 by NetGroup A/S. All rights reserved.
+ *
+ * $Log$
+ * Revision 1.1 2006/06/20 15:57:22 djburke
+ * Hopefully a saner way to build Basic/MatrixOps
+ *
+ * Revision 1.1 2005/01/08 09:22:57 zowie
+ * Added non-symmetric matrices to eigens; updated version to 2.4.2cvs.
+ *
+ * Revision 1.2 2001/07/11 08:06:01 kneth
+ * Added SWAP macro
+ *
+ * Revision 1.1.1.1 2001/07/06 13:39:35 kneth
+ * Initial import of code.
+ *
+ *
+ */
+
+#ifndef SSL_H_
+#define SSL_H_
+
+#ifndef PI
+# define PI 3.141592653589793238462643
+#endif
+
+/***** A boolean type *****/
+typedef enum {false=0, true=1} bool;
+
+/***** Pratical macros *****/
+#define min(x, y) ((x)>(y))?(y):(x)
+#define max(x, y) ((x)>(y))?(x):(y)
+#define SWAP(x, y) { double tmp; tmp=x; x=y; y=tmp; }
+
+/***** General functions *****/
+extern void SSLerror(char *);
+extern double Sqr(double);
+extern double Cube(double);
+
+#endif /* SSL_H_ */
diff --git a/Basic/MatrixOps/svd.c b/Basic/MatrixOps/svd.c
new file mode 100644
index 0000000..68756c7
--- /dev/null
+++ b/Basic/MatrixOps/svd.c
@@ -0,0 +1,145 @@
+/* From bryant at sioux.stanford.edu Sat Apr 3 14:57:54 1993
+Return-Path: <bryant at sioux.stanford.edu>
+Received: from sioux.stanford.edu by alnitak.usc.edu (4.1/SMI-4.1+ucs-3.6)
+ id AA12724; Sat, 3 Apr 93 14:57:52 PST
+Received: from oglala.ice (oglala.Stanford.EDU) by sioux.stanford.edu (4.1/inc-1.0)
+ id AA07300; Sat, 3 Apr 93 14:53:25 PST
+Date: Sat, 3 Apr 93 14:53:25 PST
+From: bryant at sioux.stanford.edu (Bryant Marks)
+Message-Id: <9304032253.AA07300 at sioux.stanford.edu>
+To: ajayshah at rcf.usc.edu
+Subject: Re: SVD
+Status: ORr
+
+
+> Hi! Long ago you sent me an svd routine in C based on code
+> from Nash in Pascal. Has this changed any over the years? (Your
+> email is dated July 1992). Is your code available by anon ftp?
+
+Hi Ajay,
+
+I don't think I have changed the code -- but here's my most recent
+version of the code, you can check to see if it's any different.
+Currently it's not available via anonymous ftp but feel free to
+redistribute the code -- it seems to work well in the application
+I'm using it in.
+
+
+Bryant
+*/
+
+/* This SVD routine is based on pgs 30-48 of "Compact Numerical Methods
+ for Computers" by J.C. Nash (1990), used to compute the pseudoinverse.
+ Modifications include:
+ Translation from Pascal to ANSI C.
+ Array indexing from 0 rather than 1.
+ Float replaced by double everywhere.
+ Support for the Matrix structure.
+ I changed the array indexing so that the matricies (float [][])
+ could be replaced be a single list (double *) for more
+ efficient communication with Mathematica.
+*/
+
+/* rjrw 7/7/99: changed z back to a vector, moved one line... */
+
+#include <math.h>
+#define TOLERANCE 1.0e-22
+
+#ifdef MAIN
+#include <stdio.h>
+#define NC 2
+#define NR 2
+main()
+{
+ int i,j,n,m;
+ double w[NC*(NR+NC)*20], z[NC*NC*20];
+ void SVD(double *W, double *Z, int nRow, int nCol);
+
+ for (i=0;i<NC*(NR+NC);i++) {
+ w[i] = 0.;
+ }
+
+ w[0] = 1; w[1] = 3; w[NC] = -4; w[NC+1] = 3;
+
+ SVD(w, z, NR, NC);
+
+ for (i=0;i<NC*(NR+NC);i++) {
+ printf("%d %g\n",i,w[i]);
+ }
+ for (i=0;i<NC*NC;i++) {
+ printf("%d %g\n",i,z[i]);
+ }
+
+}
+#endif
+
+void SVD(double *W, double *Z, int nRow, int nCol)
+{
+ int i, j, k, EstColRank, RotCount, SweepCount, slimit;
+ double eps, e2, tol, vt, p, h2, x0, y0, q, r, c0, s0, c2, d1, d2;
+ eps = TOLERANCE;
+ slimit = nCol/4;
+ if (slimit < 6.0)
+ slimit = 6;
+ SweepCount = 0;
+ e2 = 10.0*nRow*eps*eps;
+ tol = eps*.1;
+ EstColRank = nCol;
+ for (i=0; i<nCol; i++) {
+ for (j=0; j<nCol; j++) {
+ W[nCol*(nRow+i)+j] = 0.0;
+ }
+ W[nCol*(nRow+i)+i] = 1.0; /* rjrw 7/7/99: moved this line out of j loop */
+ }
+ RotCount = EstColRank*(EstColRank-1)/2;
+ while (RotCount != 0 && SweepCount <= slimit)
+ {
+ RotCount = EstColRank*(EstColRank-1)/2;
+ SweepCount++;
+ for (j=0; j<EstColRank-1; j++)
+ {
+ for (k=j+1; k<EstColRank; k++)
+ {
+ p = q = r = 0.0;
+ for (i=0; i<nRow; i++)
+ {
+ x0 = W[nCol*i+j]; y0 = W[nCol*i+k];
+ p += x0*y0; q += x0*x0; r += y0*y0;
+ }
+ Z[j] = q; Z[k] = r;
+ if (q >= r)
+ {
+ if (q<=e2*Z[0] || fabs(p)<=tol*q) RotCount--;
+ else
+ {
+ p /= q; r = 1 - r/q; vt = sqrt(4*p*p+r*r);
+ c0 = sqrt(fabs(.5*(1+r/vt))); s0 = p/(vt*c0);
+ for (i=0; i<nRow+nCol; i++)
+ {
+ d1 = W[nCol*i+j]; d2 = W[nCol*i+k];
+ W[nCol*i+j] = d1*c0+d2*s0; W[nCol*i+k] = -d1*s0+d2*c0;
+ }
+ }
+ }
+ else
+ {
+ p /= r; q = q/r-1; vt = sqrt(4*p*p+q*q);
+ s0 = sqrt(fabs(.5*(1-q/vt)));
+ if (p<0) s0 = -s0;
+ c0 = p/(vt*s0);
+ for (i=0; i<nRow+nCol; i++)
+ {
+ d1 = W[nCol*i+j]; d2 = W[nCol*i+k];
+ W[nCol*i+j] = d1*c0+d2*s0; W[nCol*i+k] = -d1*s0+d2*c0;
+ }
+ }
+ }
+ }
+ while (EstColRank>=3 && Z[(EstColRank-1)]<=Z[0]*tol+tol*tol)
+ EstColRank--;
+ }
+#if DEBUG
+ if (SweepCount > slimit)
+ fprintf(stderr, "Sweeps = %d\n", SweepCount);
+#endif
+}
diff --git a/Basic/Ops/Makefile.PL b/Basic/Ops/Makefile.PL
new file mode 100644
index 0000000..31c9406
--- /dev/null
+++ b/Basic/Ops/Makefile.PL
@@ -0,0 +1,22 @@
+
+# Makefile.PL for PDL::Ops module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+ at pack = (["ops.pd",Ops,PDL::Ops]);
+
+#WriteMakefile(
+# pdlpp_stdargs_int(@::pack)
+#);
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{LIBS}->[0] .= ' -lm ';
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Basic/Ops/ops.pd b/Basic/Ops/ops.pd
new file mode 100644
index 0000000..b727bba
--- /dev/null
+++ b/Basic/Ops/ops.pd
@@ -0,0 +1,389 @@
+pp_addpm({At=>'Top'},<<'EOD');
+
+=head1 NAME
+
+PDL::Ops - Fundamental mathematical operators
+
+=head1 DESCRIPTION
+
+This module provides the functions used by PDL to
+overload the basic mathematical operators (C<+ - / *>
+etc.) and functions (C<sin sqrt> etc.)
+
+It also includes the function C<log10>, which should
+be a perl function so that we can overload it!
+
+Matrix multiplication (the operator C<x>) is handled
+by the module L<PDL::Primitive|PDL::Primitive>.
+
+=head1 SYNOPSIS
+
+none
+
+=cut
+
+EOD
+
+pp_addpm({At=>'Bot'},<<'EOPM');
+
+=head1 AUTHOR
+
+Tuomas J. Lukka (lukka at fas.harvard.edu),
+Karl Glazebrook (kgb at aaoepp.aao.gov.au),
+Doug Hunt (dhunt at ucar.edu),
+Christian Soeller (c.soeller at auckland.ac.nz),
+Doug Burke (burke at ifa.hawaii.edu),
+and Craig DeForest (deforest at boulder.swri.edu).
+
+=cut
+
+EOPM
+
+pp_addhdr('
+#include <math.h>
+
+/* MOD requires hackage to map properly into the positive-definite numbers. */
+/* Note that this code causes some warning messages in the compile, because */
+/* the unsigned data types always fail the ((foo)<0) tests. I believe that */
+/* gcc optimizes those tests away for those data types. --CED 7-Aug-2002 */
+/* Resurrect the old MOD operator as the unsigned US_MOD to get around this. --DAL 27-Jun-2008 */
+
+#define MOD(X,N) ( ((N) == 0) ? 0 : ( (X) - (ABS(N)) * ((int)((X)/(ABS(N))) + ( ( ((N) * ((int)((X)/(N)))) != (X) ) ? ( ( ((N)<0) ? 1 : 0 ) + ( (((X)<0) ? -1 : 0))) : 0 ))))
+
+#define BU_MOD(X,N) ( (X)-(N)*((int)((X)/(N))) )
+#define SPACE(A,B) ( ((A)<(B)) ? -1 : ((A)!=(B)) )
+#define ABS(A) ( (A)>=0 ? (A) : -(A) )
+#define NOTHING
+');
+
+sub protect_chars {
+ my ($txt) = @_;
+ $txt =~ s/>/E;gt#/g;
+ $txt =~ s/</E;lt#/g;
+ $txt =~ s/;/</g;
+ $txt =~ s/#/>/g;
+ return $txt;
+}
+
+# simple binary operators
+
+sub biop {
+ my ($name,$op,$swap,$doc,%extra) = @_;
+ my $optxt = protect_chars ref $op eq 'ARRAY' ? $op->[1] : $op;
+ $op = $op->[0] if ref $op eq 'ARRAY';
+
+ if ($swap) {
+ $extra{HdrCode} = << 'EOH';
+ pdl *tmp;
+ if (swap) {
+ tmp = a;
+ a = b;
+ b = tmp;
+
+ }
+EOH
+ }
+
+ # handle exceptions
+ my $badcode = '$ISBAD(a()) || $ISBAD(b())';
+ if ( exists $extra{Exception} ) {
+ delete $exists{Exception};
+ }
+
+ pp_def($name,
+ Pars => 'a(); b(); [o]c();',
+ OtherPars => 'int swap',
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ Inplace => [ 'a' ], # quick and dirty solution to get ->inplace do its job
+ Code =>
+ "\$c() = \$a() $op \$b();",
+ BadCode =>
+ 'if ( ' . $badcode . ' )
+ $SETBAD(c());
+ else' . "\n \$c() = \$a() $op \$b();\n",
+ CopyBadStatusCode =>
+ 'if ( $BADFLAGCACHE() ) {
+ if ( a == c && $ISPDLSTATEGOOD(a) ) {
+ PDL->propogate_badflag( c, 1 ); /* have inplace op AND badflag has changed */
+ }
+ $SETPDLSTATEBAD(c);
+ }',
+ %extra,
+ Doc => << "EOD");
+=for ref
+
+$doc
+
+=for example
+
+ \$c = $name \$a, \$b, 0; # explicit call with trailing 0
+ \$c = \$a $op \$b; # overloaded call
+ \$a->inplace->$name(\$b,0); # modify \$a inplace
+
+It can be made to work inplace with the C<\$a-E<gt>inplace> syntax.
+This function is used to overload the binary C<$optxt> operator.
+Note that when calling this function explicitly you need to supply
+a third argument that should generally be zero (see first example).
+This restriction is expected to go away in future releases.
+
+=cut
+
+EOD
+} # sub: biop()
+
+#simple binary functions
+sub bifunc {
+ my ($name,$func,$swap,$doc,%extra) = @_;
+ my $funcov = ref $func eq 'ARRAY' ? $func->[1] : $func;
+ my $isop=0; if ($funcov =~ s/^op//) { $isop = 1; }
+ my $funcovp = protect_chars $funcov;
+ $func = $func->[0] if ref $func eq 'ARRAY';
+ if ($swap) {
+ $extra{HdrCode} .= << 'EOH';
+ pdl *tmp;
+ if (swap) {
+ tmp = a;
+ a = b;
+ b = tmp;
+ }
+EOH
+ }
+ my $ovcall;
+ # is this one to be used as a function or operator ?
+ if ($isop) { $ovcall = "\$c = \$a $funcov \$b; # overloaded use"; }
+ else { $ovcall = "\$c = $funcov \$a, \$b; # overloaded use"; }
+
+
+#a little dance to avoid the MOD macro warnings for byte & ushort datatypes
+ my $codestr;
+ my $badcodestr;
+ if ($extra{unsigned}){
+ $codestr = << "ENDCODE";
+ types(BU) %{
+ \$c() = BU_$func(\$a(),\$b());
+ %}
+ types(SLNFD) %{
+ \$c() = $func(\$a(),\$b());
+ %}
+ENDCODE
+} else {
+ $codestr = "\$c() = $func(\$a(),\$b());";
+ }
+ delete $extra{unsigned}; #remove the key so it doesn't get added in pp_def.
+
+ $badcodestr = 'if ( $ISBAD(a()) || $ISBAD(b()) )
+ $SETBAD(c());
+ else {' . $codestr . " } \n";
+#end dance
+
+ pp_def($name,
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ Pars => 'a(); b(); [o]c();',
+ OtherPars => 'int swap',
+ Inplace => [ 'a' ], # quick and dirty solution to get ->inplace do its job
+ Code => $codestr,
+ BadCode => $badcodestr,
+ CopyBadStatusCode =>
+ 'if ( $BADFLAGCACHE() ) {
+ if ( a == c && $ISPDLSTATEGOOD(a) ) {
+ PDL->propogate_badflag( c, 1 ); /* have inplace op AND badflag has changed */
+ }
+ $SETPDLSTATEBAD(c);
+ }',
+ %extra,
+ Doc => << "EOD");
+=for ref
+
+$doc
+
+=for example
+
+ \$c = \$a->$name(\$b,0); # explicit function call
+ $ovcall
+ \$a->inplace->$name(\$b,0); # modify \$a inplace
+
+It can be made to work inplace with the C<\$a-E<gt>inplace> syntax.
+This function is used to overload the binary C<$funcovp> function.
+Note that when calling this function explicitly you need to supply
+a third argument that should generally be zero (see first example).
+This restriction is expected to go away in future releases.
+
+=cut
+
+EOD
+} # sub: bifunc()
+
+# simple unary functions and operators
+sub ufunc {
+ my ($name,$func,$doc,%extra) = @_;
+ my $funcov = ref $func eq 'ARRAY' ? $func->[1] : $func;
+ my $funcovp = protect_chars $funcov;
+ $func = $func->[0] if ref $func eq 'ARRAY';
+
+ # handle exceptions
+ my $badcode = '$ISBAD(a())';
+ if ( exists $extra{Exception} ) {
+# $badcode .= " || $extra{Exception}";
+# print "Warning: ignored exception for $name\n";
+ delete $exists{Exception};
+ }
+
+ # do not have to worry about propogation of the badflag when
+ # inplace since only input piddle is a, hence its badflag
+ # won't change
+ # UNLESS an exception occurs...
+ pp_def($name,
+ Pars => 'a(); [o]b()',
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ Inplace => 1,
+ Code =>
+ "\$b() = $func(\$a());",
+ BadCode =>
+ 'if ( ' . $badcode . ' )
+ $SETBAD(b());
+ else' . "\n \$b() = $func(\$a());\n",
+ %extra,
+ Doc => << "EOD");
+=for ref
+
+$doc
+
+=for example
+
+ \$b = $funcov \$a;
+ \$a->inplace->$name; # modify \$a inplace
+
+It can be made to work inplace with the C<\$a-E<gt>inplace> syntax.
+This function is used to overload the unary C<$funcovp> operator/function.
+
+=cut
+
+EOD
+} # sub: ufunc()
+
+######################################################################
+
+# we trap some illegal operations here -- see the Exception option
+# note, for the ufunc()'s, the checks do not work too well
+# for unsigned integer types (ie < 0)
+#
+# XXX needs thinking about
+# - have to integrate into Code section as well (so
+# 12/pdl(2,4,0,3) is trapped and flagged bad)
+# --> complicated
+# - perhaps could use type %{ %} ?
+#
+# ==> currently have commented out the exception code, since
+# want to see if can use NaN/Inf for bad values
+# (would solve many problems for F,D types)
+#
+# there is an issue over how we handle comparison operators
+# - see Primitive/primitive.pd/zcover() for more discussion
+#
+
+## arithmetic ops
+# no swap
+biop('plus','+',0,'add two piddles');
+biop('mult','*',0,'multiply two piddles');
+
+# all those need swapping
+biop('minus','-',1,'subtract two piddles');
+biop('divide','/',1,'divide two piddles', Exception => '$b() == 0' );
+
+## note: divide should perhaps trap division by zero as well
+
+## comparison ops
+# need swapping
+biop('gt','>',1,'the binary E<gt> (greater than) operation');
+biop('lt','<',1,'the binary E<lt> (less than) operation');
+biop('le','<=',1,'the binary E<lt>= (less equal) operation');
+biop('ge','>=',1,'the binary E<gt>= (greater equal) operation');
+# no swap required
+biop('eq','==',0,'binary I<equal to> operation (C<==>)');
+biop('ne','!=',0,'binary I<not equal to> operation (C<!=>)');
+
+## bit ops
+# those need to be limited to the right types
+my $T = [B,U,S,L]; # the sensible types here
+biop('shiftleft','<<',1,'leftshift C<$a> by C<$b>',GenericTypes => $T);
+biop('shiftright','>>',1,'rightshift C<$a> by C<$b>',GenericTypes => $T);
+biop('or2','|',0,'binary I<or> of two piddles',GenericTypes => $T);
+biop('and2','&',0,'binary I<and> of two piddles',GenericTypes => $T);
+biop('xor','^',0,'binary I<exclusive or> of two piddles',GenericTypes => $T);
+
+# really an ufunc
+ufunc('bitnot','~','unary bit negation',GenericTypes => $T);
+
+# some standard binary functions
+bifunc('power',['pow','op**'],1,'raise piddle C<$a> to the power C<$b>',GenericTypes => [D]);
+bifunc('atan2','atan2',1,'elementwise C<atan2> of two piddles',GenericTypes => [D]);
+bifunc('modulo',['MOD','op%'],1,'elementwise C<modulo> operation',unsigned=>1);
+bifunc('spaceship',['SPACE','op<=>'],1,'elementwise "<=>" operation');
+
+# some standard unary functions
+ufunc('sqrt','sqrt','elementwise square root', Exception => '$a() < 0' );
+ufunc('abs',['ABS','abs'],'elementwise absolute value',GenericTypes => [D,F,S,L]);
+ufunc('sin','sin','the sin function');
+ufunc('cos','cos','the cos function');
+ufunc('not','!','the elementwise I<not> operation');
+ufunc('exp','exp','the exponential function',GenericTypes => [D]);
+ufunc('log','log','the natural logarithm',GenericTypes => [D],
+ Exception => '$a() <= 0' );
+
+pp_export_nothing();
+
+# make log10() work on scalars (returning scalars)
+# as well as piddles
+ufunc('log10','log10','the base 10 logarithm', GenericTypes => [D],
+ Exception => '$a() <= 0',
+ PMCode =>
+'
+sub PDL::log10 {
+ my $x = shift;
+ if ( ! UNIVERSAL::isa($x,"PDL") ) { return log($x) / log(10); }
+ my $y;
+ if ( $x->is_inplace ) { $x->set_inplace(0); $y = $x; }
+ elsif( ref($x) eq "PDL"){
+ #PDL Objects, use nullcreate:
+ $y = PDL->nullcreate($x);
+ }else{
+ #PDL-Derived Object, use copy: (Consistent with
+ # Auto-creation docs in Objects.pod)
+ $y = $x->copy;
+ }
+ &PDL::_log10_int( $x, $y );
+ return $y;
+};
+'
+);
+
+# note: the extra code that adding 'HandleBad => 1' creates is
+# unneeded here. Things could be made clever enough to work this out,
+# but it's very low priority.
+# It does add doc information though, and lets people know it's been
+# looked at for bad value support
+# DJB adds: not completely sure about this now that I have added code
+# to avoid a valgrind-reported error (see the CacheBadFlagInit rule
+# in PP.pm)
+#
+# Can't this be handled in Core.pm when '.=' is overloaded ?
+#
+pp_def(
+ 'assgn',
+# HandleBad => 1,
+ Pars => 'a(); [o]b();',
+ Code =>
+ '$b() = $a();',
+# BadCode =>
+# 'if ( $ISBAD(a()) ) { $SETBAD(b()); } else { $b() = $a(); }',
+ Doc =>
+'Plain numerical assignment. This is used to implement the ".=" operator',
+); # pp_def assgn
+
+#pp_export_nothing();
+
+pp_done();
+
diff --git a/Basic/Options.pm b/Basic/Options.pm
new file mode 100644
index 0000000..f1e96bc
--- /dev/null
+++ b/Basic/Options.pm
@@ -0,0 +1,1010 @@
+
+package PDL::Options;
+
+=head1 NAME
+
+PDL::Options - simplifies option passing by hash in PerlDL
+
+=head1 SYNOPSIS
+
+ use PDL::Options;
+
+ %hash = parse( \%defaults, \%user_options);
+
+ use PDL::Options ();
+
+ $opt = new PDL::Options;
+ $opt = new PDL::Options ( \%defaults );
+
+ $opt->defaults ( \%defaults );
+ $opt->synonyms ( { 'COLOR' => 'COLOUR' } );
+
+ $hashref = $opt->defaults;
+
+ $opt->options ( \%user_options );
+
+ $hashref = $opt->options;
+
+ $opt->incremental(1);
+ $opt->full_options(0);
+
+=head1 DESCRIPTION
+
+Object to simplify option passing for PerlDL subroutines.
+Allows you to merge a user defined options with defaults.
+A simplified (non-OO) interface is provided.
+
+=cut
+
+use strict;
+use Carp;
+
+use vars qw/$VERSION %EXPORT_TAGS %DEF_SYNS @ISA/;
+
+require Exporter;
+
+# difference to 0.91 is that added CENTRE/CENTER as default
+# synonymns (patch by Diab Jerius [ #469110 ])
+our $VERSION = '0.92';
+$VERSION = eval $VERSION;
+
+ at ISA = qw(Exporter);
+
+%EXPORT_TAGS = (
+ 'Func' => [qw/
+ parse iparse ifhref
+ /]
+ );
+
+Exporter::export_tags('Func');
+
+# List of default synonyms
+%DEF_SYNS = (
+ COLOR => 'COLOUR',
+ COLOUR => 'COLOR',
+ CENTER => 'CENTRE',
+ CENTRE => 'CENTER',
+ );
+
+my $default = {
+ WarnOnMissing => 1,
+ FullOptions => 1,
+ DEBUG => 0,
+ };
+
+=head1 Utility functions
+
+=head2 ifhref
+
+ parse({Ext => 'TIF', ifhref($opt)});
+
+just return the argument if it is a hashref otherwise return
+an empty hashref. Useful in conjunction with parse to return
+just the default values if argument is not a hash ref
+
+=head1 NON-OO INTERFACE
+
+A simplified non-object oriented interface is provided.
+These routines are exported into the callers namespace by default.
+
+=over 4
+
+=item parse( \%defaults, \%user_options)
+
+This will parse user options by using the defaults. The following
+settings are used for parsing: The options are case-sensitive, a
+default synonym table is consulted (see L</Default Synonyms>),
+minimum-matching is turned on, and translation of values is not performed.
+
+A hash (not hash reference) containing the processed options is returned.
+
+ %options = parse( { LINE => 1, COLOUR => 'red'}, { COLOR => 'blue'});
+
+=item iparse( \%defaults, \%user_options)
+
+Same as C<parse> but matching is case insensitive
+
+=cut
+
+sub ifhref {
+ my ($href) = @_;
+ return defined $href && ref $href eq 'HASH' ? $href : {};
+}
+
+sub parse { return _parse(1, at _) }
+sub iparse { return _parse(0, at _) }
+
+sub _parse {
+
+ croak 'Usage: parse( \%defaults, \%user )' if scalar(@_) != 3;
+
+ my $casechk = shift;
+ my $defaults = shift;
+ croak ("First argument is not a hash reference")
+ unless ref($defaults) eq "HASH";
+
+ my $user = shift;
+ croak ("Second argument is not a hash reference")
+ unless ref($user) eq "HASH";
+
+ # Create new object
+ my $opt = new PDL::Options ( $defaults );
+
+ # Set up default behaviour
+ $opt->minmatch(1);
+ $opt->casesens($casechk);
+ $opt->synonyms( \%DEF_SYNS );
+
+ # Process the options
+ my $optref = $opt->options( $user );
+
+ return %$optref;
+}
+
+
+=back
+
+=head2 Default Synonyms
+
+The following default synonyms are available in the non-OO interface:
+
+ COLOR => COLOUR
+ COLOUR => COLOR
+ CENTER => CENTRE
+ CENTRE => CENTER
+
+=head1 METHODS
+
+The following methods are available to PDL::Options objects.
+
+=over 4
+
+=item new()
+
+Constructor. Creates the object. With an optional argument can also
+set the default options.
+
+=cut
+
+sub new {
+
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $opt = {};
+
+ # Set up object structure
+ $opt->{DEFAULTS} = {}; # Default options
+ $opt->{CURRENT} = {}; # Current options
+ $opt->{CurrKeys} = []; # list of selected keys if full_options(0)
+ $opt->{SYNONYMS} = {}; # List of synonyms
+ $opt->{INC} = 0; # Flag to decide whether we are incremental on cur
+ $opt->{CaseSens} = 0; # Are options case sensitive
+ $opt->{MinMatch} = 1; # Minimum matching on keys
+ $opt->{Translation} = {};# Translation from eg 'RED' to 1
+ $opt->{AutoTranslate}= 1;# Automatically translate options when processing
+ $opt->{MinMatchTrans} = 0; # Min matching during translation
+ $opt->{CaseSensTrans} = 0; # Case sensitive during translation
+ # Return full options list
+ $opt->{FullOptions} = $default->{FullOptions};
+ # Whether to warn for options that are invalid or not
+ $opt->{WarnOnMissing}= $default->{WarnOnMissing};
+ $opt->{DEBUG} = $default->{DEBUG}; # Turn on debug messages
+
+ # Bless into class
+ bless ( $opt, $class);
+
+ # If we were passed arguments, pass to defaults method
+ if (@_) { $opt->defaults( @_ ); }
+
+ return $opt;
+}
+
+=item extend (\%options)
+
+This will copy the existing options object and extend it with the
+requested extra options.
+
+=cut
+
+sub extend {
+
+ my ($self, $opt)=@_;
+
+ my $class = ref($self);
+ my $h = {%{$self}};
+ croak ("Argument is not reference to hash!\n") unless ref($opt) eq 'HASH';
+ #
+ # The next step is to perform a deep copy of the hash
+ # references since we might want to change these without
+ # changing the originals.
+ #
+ $h->{SYNONYMS}={%{$self->{SYNONYMS}}};
+ $h->{Translation}={%{$self->{Translation}}};
+ $h->{CurrKeys}=[@{$self->{CurrKeys}}];
+ #
+ # Create the extended option list.
+ #
+ my %all_options = (%{$opt}, %{$self->{DEFAULTS}});
+
+ # Bless it
+ bless ($h, $class);
+
+ # And parse the default options
+ $h->defaults(\%all_options);
+
+ return $h;
+
+}
+
+# =item change_defaults (\%options)
+
+# This will merge the options given with the defaults hash and hence change
+# the default hash. This is not normally a good idea, but in certain dynamic
+# situations you might want to adjust a default parameter for future calls
+# to the routine.
+
+# =cut
+
+# sub change_defaults {
+
+# my $self=shift;
+
+# my $arg = shift;
+# croak("Argument is not a hash reference!\n") unless ref($arg) eq 'HASH';
+
+# my $defs = $self->defaults($arg);
+
+# $self->defaults($)
+
+
+# }
+
+
+=item defaults( \%defaults )
+
+Method to set or return the current defaults. The argument should be
+a reference to a hash. The hash reference is returned if no arguments
+are supplied.
+
+The current values are reset whenever the defaults are changed.
+
+=cut
+
+sub defaults {
+ my $self = shift;
+
+ if (@_) {
+ my $arg = shift;
+ croak("Argument is not a hash reference") unless ref($arg) eq "HASH";
+ $self->{DEFAULTS} = $arg;
+
+ # Reset the current state (making sure that I disconnect the
+ # hashes
+ my %hash = %$arg;
+ $self->curr_full(\%hash);
+
+ }
+
+ # Decouple the hash to protect it from being modified outside the
+ # object
+ my %hash = %{$self->{DEFAULTS}};
+ return \%hash;
+
+}
+
+=item add_synonym (\%synonyms)
+
+Method to add another synonym to an option set
+The argument should be a reference to a hash.
+
+=cut
+
+sub add_synonym {
+ my $self=shift;
+ return unless @_;
+ my $arg = shift;
+ croak("Synonym argument is not a hash reference") unless ref($arg) eq "HASH";
+
+ foreach (keys %$arg) {
+ $self->{SYNONYMS}{$_}=$arg->{$_};
+ }
+ my %hash = %{$self->{SYNONYMS}};
+ return \%hash;
+
+}
+
+=item add_translation (\%translation)
+
+Method to add another translation rule to an option set.
+The argument should be a reference to a hash.
+
+=cut
+
+
+sub add_translation {
+ my $self = shift;
+ return unless @_;
+ my $arg = shift;
+ croak("Translation argument is not a hash reference") unless ref($arg) eq 'HASH';
+
+ foreach (keys %$arg) {
+ $self->{Translation}{$_}=$arg->{$_};
+ }
+ my %hash = %{$self->{Translation}};
+
+ return \%hash;
+
+}
+
+=item synonyms( \%synonyms )
+
+Method to set or return the current synonyms. The argument should be
+a reference to a hash. The hash reference is returned if no arguments
+are supplied.
+
+This allows you to provide alternate keywords (such as allowing
+'COLOR' as an option when your defaults uses 'COLOUR').
+
+=cut
+
+sub synonyms {
+ my $self = shift;
+
+ if (@_) {
+ my $arg = shift;
+ croak("Argument is not a hash reference") unless ref($arg) eq "HASH";
+ $self->{SYNONYMS} = $arg;
+ }
+
+ # Decouple the hash to protect it from being modified outside the
+ # object
+ my %hash = %{$self->{SYNONYMS}};
+ return \%hash;
+
+}
+
+
+=item current
+
+Returns the current state of the options. This is returned
+as a hash reference (although it is not a reference to the
+actual hash stored in the object). If full_options() is true
+the full options hash is returned, if full_options() is false
+only the modified options are returned (as set by the last call
+to options()).
+
+=cut
+
+sub current {
+ my $self = shift;
+
+ if ($self->full_options) {
+ return $self->curr_full;
+ } else {
+ my @keys = $self->curr_keys;
+ my %hash = ();
+ my $curr = $self->curr_full;
+
+ foreach my $key (@keys) {
+ $hash{$key} = $$curr{$key} if exists $$curr{$key};
+ }
+ return \%hash;
+ }
+}
+
+=item clear_current
+
+This routine clears the 'state' of the C<PDL::Options> object so that
+the next call to current will return an empty list
+
+=cut
+
+sub clear_current {
+ my $self = shift;
+ @{$self->{CurrKeys}}=();
+}
+
+
+# Method to set the 'mini' state of the object
+# This is just a list of the keys in %defaults that were selected
+# by the user. current() returns the hash with these keys if
+# called with full_options(0).
+# Not publicising this
+
+sub curr_keys {
+ my $self = shift;
+ if (@_) { @{$self->{CurrKeys}} = @_; }
+ return @{$self->{CurrKeys}};
+}
+
+# Method to set the full state of the object
+# Not publicising this
+
+sub curr_full {
+ my $self = shift;
+
+ if (@_) {
+ my $arg = shift;
+ croak("Argument is not a hash reference") unless ref($arg) eq "HASH";
+ $self->{CURRENT} = $arg;
+ }
+
+ # Decouple the hash
+ my %hash = %{$self->{CURRENT}};
+ return \%hash;
+
+}
+
+
+=item translation
+
+Provide translation of options to more specific values that are
+recognised by the program. This allows, for example, the automatic
+translation of the string 'red' to '#ff0000'.
+
+This method can be used to setup the dictionary and is hash reference
+with the following structure:
+
+ OPTIONA => {
+ 'string1' => decode1,
+ 'string2' => decode2
+ },
+ OPTIONB => {
+ 's4' => decodeb1,
+ }
+ etc....
+
+Where OPTION? corresponds to the top level option name as stored in
+the defaults array (eg LINECOLOR) and the anonymous hashes provide
+the translation from string1 ('red') to decode1 ('#ff0000').
+
+An options string will be translated automatically during the main options()
+processing if autotrans() is set to true. Else translation can be
+initiated by the user using the translate() method.
+
+=cut
+
+sub translation {
+ my $self = shift;
+
+ if (@_) {
+ my $arg = shift;
+ croak("Argument is not a hash reference") unless ref($arg) eq "HASH";
+ $self->{Translation} = $arg;
+ }
+
+ # Decouple the hash to protect it from being modified outside the
+ # object
+ my %hash = %{$self->{Translation}};
+ return \%hash;
+
+}
+
+
+=item incremental
+
+Specifies whether the user defined options will be treated as additions
+to the current state of the object (1) or modifications to the default
+values only (0).
+
+Can be used to set or return this value.
+Default is false.
+
+=cut
+
+sub incremental {
+ my $self = shift;
+ if (@_) { $self->{INC} = shift; }
+ return $self->{INC};
+}
+
+=item full_options
+
+Governs whether a complete set of options is returned (ie defaults
++ expanded user options), true, or if just the expanded user
+options are returned, false (ie the values specified by the user).
+
+This can be useful when you are only interested in the changes to
+the options rather than knowing the full state. (For example, if
+defaults contains keys for COLOUR and LINESTYLE and the user supplied
+a key of COL, you may simply be interested in the modification to
+COLOUR rather than the state of LINESTYLE and COLOUR.)
+
+Default is true.
+
+=cut
+
+sub full_options {
+ my $self = shift;
+ if (@_) { $self->{FullOptions} = shift; }
+ return $self->{FullOptions};
+
+}
+
+=item casesens
+
+Specifies whether the user defined options will be processed independent
+of case (0) or not (1). Default is to be case insensitive.
+
+Can be used to set or return this value.
+
+=cut
+
+sub casesens {
+ my $self = shift;
+ if (@_) { $self->{CaseSens} = shift; }
+ return $self->{CaseSens};
+}
+
+=item minmatch
+
+Specifies whether the user defined options will be minimum matched
+with the defaults (1) or whether the user defined options should match
+the default keys exactly. Defaults is true (1).
+
+If a particular key matches exactly (within the constraints imposed
+bby case sensitivity) this key will always be taken as correct even
+if others are similar. For example COL would match COL and COLOUR but
+this implementation will always return COL in this case (note that
+for CO it will return both COL and COLOUR and pick one at random.
+
+Can be used to set or return this value.
+
+=cut
+
+sub minmatch {
+ my $self = shift;
+ if (@_) { $self->{MinMatch} = shift; }
+ return $self->{MinMatch};
+}
+
+
+=item autotrans
+
+Specifies whether the user defined options will be processed via
+the translate() method immediately following the main options
+parsing. Default is to autotranslate (1).
+
+Can be used to set or return this value.
+
+=cut
+
+sub autotrans {
+ my $self = shift;
+ if (@_) { $self->{AutoTranslate} = shift; }
+ return $self->{AutoTranslate};
+}
+
+
+=item casesenstrans
+
+Specifies whether the keys in the options hash will be matched insensitive
+of case (0) during translation() or not (1). Default is to be case insensitive.
+
+Can be used to set or return this value.
+
+=cut
+
+sub casesenstrans {
+ my $self = shift;
+ if (@_) { $self->{CaseSensTrans} = shift; }
+ return $self->{CaseSensTrans};
+}
+
+=item minmatchtrans
+
+Specifies whether the keys in the options hash will be minimum matched
+during translation(). Default is false (0).
+
+If a particular key matches exactly (within the constraints imposed
+bby case sensitivity) this key will always be taken as correct even
+if others are similar. For example COL would match COL and COLOUR but
+this implementation will always return COL in this case (note that
+for CO it will return both COL and COLOUR and pick one at random.
+
+Can be used to set or return this value.
+
+=cut
+
+sub minmatchtrans {
+ my $self = shift;
+ if (@_) { $self->{MinMatchTrans} = shift; }
+ return $self->{MinMatchTrans};
+}
+
+
+=item warnonmissing
+
+Turn on or off the warning message printed when an options is not in
+the options hash. This can be convenient when a user passes a set of
+options that has to be parsed by several different option objects down
+the line.
+
+=cut
+
+sub warnonmissing {
+ my $self = shift;
+ if (ref $self) {
+ if (@_) { $self->{WarnOnMissing}=shift;}
+ return $self->{WarnOnMissing};
+ } else {
+ $default->{WarnOnMissing} = shift if @_;
+ return $default->{WarnOnMissing};
+ }
+}
+
+
+=item debug
+
+Turn on or off debug messages. Default is off (0).
+Can be used to set or return this value.
+
+=cut
+
+sub debug {
+ my $self = shift;
+ if (ref $self) {
+ if (@_) { $self->{DEBUG} = shift; }
+ return $self->{DEBUG};
+ } else {
+ $default->{DEBUG} = shift if @_;
+ return $default->{DEBUG};
+ }
+}
+
+
+=item options
+
+Takes a set of user-defined options (as a reference to a hash)
+and merges them with the current state (or the defaults; depends
+on the state of incremental()).
+
+The user-supplied keys will be compared with the defaults.
+Case sensitivity and minimum matching can be configured using
+the mimatch() and casesens() methods.
+
+A warning is raised if keys present in the user options are not
+present in the defaults unless warnonmissing is set.
+
+A reference to a hash containing the merged options is returned.
+
+ $merged = $opt->options( { COL => 'red', Width => 1});
+
+The state of the object can be retrieved after this by using the
+current() method or by using the options() method with no arguments.
+If full_options() is true, all options are returned (options plus
+overrides), if full_options() is false then only the modified
+options are returned.
+
+Synonyms are supported if they have been configured via the synonyms()
+method.
+
+=cut
+
+sub options {
+
+ my $self = shift;
+
+ # If there is an argument do something clever
+ if (@_) {
+
+ # check that the arg is a hash
+ my $arg = shift;
+ croak("Argument is not a hash reference") unless ref($arg) eq "HASH";
+
+ # Turn the options into a real hash
+ my %user = %$arg;
+
+ # Now read in the base options
+ my $base;
+ if ($self->incremental) {
+ $base = $self->curr_full;
+ } else {
+ $base = $self->defaults;
+ }
+
+ # Turn into a real hash for convenience
+ my %base = %$base;
+
+ # Store a list of all the expanded user keys
+ my @list = ();
+
+ # Read in synonyms
+ my %syn = %{$self->synonyms};
+
+ # Now go through the keys in the user hash and compare with
+ # the defaults
+ foreach my $userkey (sort keys %user) {
+
+ # Check for matches in the default set
+ my @matched = $self->compare_with_list(0, $userkey, keys %base);
+
+ # If we had no matches, check the synonyms list
+ if ($#matched == -1) {
+ @matched = $self->compare_with_list(0, $userkey, keys %syn);
+
+ # If we have matched then convert the key to the actual
+ # value stored in the object
+ for (my $i =0; $i <= $#matched; $i++) {
+ $matched[$i] = $syn{$matched[$i]};
+ }
+ }
+
+ # At this point we have matched the userkey to a key in the
+ # defaults list (or if not say so)
+ if ($#matched == -1) {
+ print "Warning: $userkey is not a valid option\n" if $self->{WarnOnMissing};
+ } else {
+ if ( $#matched > 0 ) {
+ print "Warning: Multiple matches for option $userkey\n";
+ print "Warning: Could be any of the following:\n";
+ print join("\n", at matched) . "\n";
+ print "Accepting the first match ($matched[0])\n";
+ }
+ # Modify the value in %base and keep track of a separate
+ # array containing only the matched keys
+ $base{$matched[0]} = $user{$userkey};
+ push(@list, $matched[0]);
+ print "Matched: $userkey for $matched[0]\n" if $self->debug;
+ }
+ }
+
+ # Finished matching so set this as the current state of the
+ # object
+ $self->curr_keys(@list);
+ $self->curr_full(\%base);
+
+ # Now process the values via the provided translation
+ # if required. Note that the current design means that
+ # We have to run this after we have set the current state.
+ # Otherwise the translation() method would not work directly
+ # and we would have to provide a public version and a private one.
+ # Note that translate updates the current state of the object
+ # So we don't need to catch the return value
+ $self->translate if $self->autotrans;
+
+ }
+
+ # Current state should now be in current.
+ # Simply return it
+ return $self->current;
+
+}
+
+=item translate
+
+Translate the current option values (eg those set via the options()
+method) using the provided translation().
+
+This method updates the current state of the object and returns the
+updated options hash as a reference.
+
+ $ref = $opt->translate;
+
+=cut
+
+sub translate {
+ my $self = shift;
+
+ my %trans = %{$self->translation};
+ my %opt = %{$self->curr_full}; # Process all options
+
+ # Now need to go through each of the keys
+ # and if the corresponding key exists in the translation
+ # hash we need to check that a valid translation exists
+ foreach my $key ( keys %opt ) {
+ if (exists $trans{$key}) {
+ # Okay so a translation might exist
+ # Now compare keys in the hash in the hash
+ my %subhash = %{$trans{$key}};
+
+ my @matched =
+ $self->compare_with_list(1, $opt{$key}, keys %subhash);
+
+ # At this point we have matched the userkey to a key in the
+ # dictionary. If there is no translation dont say anything
+ # since it may be a 'REAL' answer (ie 1 instead of 'red')
+
+ if ($#matched > -1) {
+ if ( $#matched > 0 ) {
+ print "Warning: Multiple matches for $opt{$key} in option $key\n";
+ print "Warning: Could be any of the following:\n";
+ print join("\n", at matched) . "\n";
+ print "Accepting the first match ($matched[0])\n";
+
+ }
+ # Modify the value in the options set
+ print "Translation: $opt{$key} translated to $subhash{$matched[0]}\n"
+ if $self->debug;
+ $opt{$key} = $subhash{$matched[0]};
+
+ }
+
+ }
+
+ }
+
+ # Update the current state
+ return $self->curr_full( \%opt );
+
+}
+
+# Private method to compare a key with a list of keys.
+# The object controls whether case-sensitivity of minimum matching
+# are required
+# Arguments: flag to determine whether I am matchin options or translations
+# this is needed since both methods are configurable with
+# regards to minimum matching and case sensitivity.
+# 0 - use $self->minmatch and $self->casesens
+# 1 - use $self->minmatchtrans and $self->casesenstrans
+# $key: Key to be compared
+# @keys: List of keys
+# Returns: Array of all keys that match $key taking into account the
+# object state.
+#
+# There must be a more compact way of doing this
+
+sub compare_with_list {
+ my $self = shift;
+
+ my $flag = shift;
+ my $key = shift;
+ my @list = @_;
+
+ my @result = ();
+
+ my ($casesens, $minmatch);
+ if ($flag == 0) {
+ $casesens = $self->casesens;
+ $minmatch = $self->minmatch;
+ } else {
+ $casesens = $self->casesenstrans;
+ $minmatch = $self->minmatchtrans;
+ }
+
+ # Do matches
+
+ # Case Sensitive
+ if ($casesens) {
+
+ # Always start with the exact match before proceding to minimum
+ # match.
+ # We want to make sure that we will always match on the
+ # exact match even if alternatives exist (eg COL will always
+ # match just COL if the keys are COL and COLOUR)
+ # Case insensitive
+ @result = grep { /^$key$/ } @list;
+
+ # Proceed to minimum match if we detected nothing
+ # Minumum match/ Case sensitive
+ if ($#result == -1 && $minmatch) {
+
+ @result = grep { /^$key/ } @list;
+
+ }
+
+ } else {
+
+ # We want to make sure that we will always match on the
+ # exact match even if alternatives exist (eg COL will always
+ # match just COL if the keys are COL and COLOUR)
+ # First do the exact match (case insensitive)
+ {
+ local $^W = undef; # To silence warnings about uninitialised values
+ @result = grep { /^$key$/i } @list;
+ }
+ # If this match came up with something then we will use it
+ # Else we will try a minimum match (assuming flag is true)
+
+ # Minumum match/ Case insensitive
+ if ($#result == -1 && $minmatch) {
+
+ @result = grep { /^$key/i } @list;
+
+ }
+ }
+ return @result;
+}
+
+
+
+
+=back
+
+=head1 EXAMPLE
+
+Two examples are shown. The first uses the simplified interface and
+the second uses the object-oriented interface.
+
+=head1 Non-OO
+
+ use PDL::Options (':Func');
+
+ %options = parse( {
+ LINE => 1,
+ COLOUR => 'red',
+ },
+ {
+ COLOR => 'blue'
+ }
+ );
+
+This will return a hash containg
+
+ %options = (
+ LINE => 1,
+ COLOUR => 'blue'
+ )
+
+
+=head1 Object oriented
+
+The following example will try to show the main points:
+
+ use PDL::Options ();
+
+ # Create new object and supply defaults
+ $opt = new PDL::Options( { Colour => 'red',
+ LineStyle => 'dashed',
+ LineWidth => 1
+ }
+ );
+
+ # Create synonyms
+ $opt->synonyms( { Color => 'Colour' } );
+
+ # Create translation dictionary
+ $opt->translation( { Colour => {
+ 'blue' => '#0000ff',
+ 'red' => '#ff0000',
+ 'green'=> '#00ff00'
+ },
+ LineStyle => {
+ 'solid' => 1,
+ 'dashed' => 2,
+ 'dotted' => 3
+ }
+ }
+ );
+
+ # Generate and parse test hash
+ $options = $opt->options( { Color => 'green',
+ lines => 'solid',
+ }
+ );
+
+When this code is run, $options will be the reference to a hash
+containing the following:
+
+ Colour => '#00ff00',
+ LineStyle => 1,
+ LineWidth => 1
+
+If full_options() was set to false (0), $options would be a reference
+to a hash containing:
+
+ Colour => '#00ff00',
+ LineStyle => 1
+
+Minimum matching and case insensitivity can be configured for both
+the initial parsing and for the subsequent translating. The translation
+can be turned off if not desired.
+
+Currently synonyms are not available for the translation although this
+could be added quite simply.
+
+=head1 AUTHOR
+
+Copyright (C) Tim Jenness 1998 (t.jenness at jach.hawaii.edu). All
+rights reserved. There is no warranty. You are allowed to redistribute
+this software / documentation under certain conditions. For details,
+see the file COPYING in the PDL distribution. If this file is
+separated from the PDL distribution, the copyright notice should be
+included in the file.
+
+=cut
+
+
+1;
+
diff --git a/Basic/PDL.pm b/Basic/PDL.pm
new file mode 100644
index 0000000..1d36e61
--- /dev/null
+++ b/Basic/PDL.pm
@@ -0,0 +1,213 @@
+=head1 NAME
+
+PDL - the Perl Data Language
+
+=head1 DESCRIPTION
+
+(For the exported PDL constructor, pdl(), see L<PDL::Core|PDL::Core>)
+
+PDL is the Perl Data Language, a perl extension that is designed for
+scientific and bulk numeric data processing and display. It extends
+perl's syntax and includes fully vectorized, multidimensional array
+handling, plus several paths for device-independent graphics output.
+
+PDL is fast, comparable and often outperforming IDL and MATLAB in real
+world applications. PDL allows large N-dimensional data sets such as large
+images, spectra, etc to be stored efficiently and manipulated quickly.
+
+
+=head1 VECTORIZATION
+
+For a description of the vectorization (also called "threading"), see
+L<PDL::Core|PDL::Core>.
+
+
+=head1 INTERACTIVE SHELL
+
+The PDL package includes an interactive shell. You can learn about it,
+run C<perldoc perldl>, or run the shell C<perldl> or C<pdl2> and type
+C<help>.
+
+=head1 LOOKING FOR A FUNCTION?
+
+If you want to search for a function name, you should use the PDL
+shell along with the "help" or "apropos" command (to do a fuzzy search).
+For example:
+
+ pdl> apropos xval
+ xlinvals X axis values between endpoints (see xvals).
+ xlogvals X axis values logarithmicly spaced...
+ xvals Fills a piddle with X index values...
+ yvals Fills a piddle with Y index values. See the CAVEAT for xvals.
+ zvals Fills a piddle with Z index values. See the CAVEAT for xvals.
+
+To learn more about the PDL shell, see L<perldl|perldl> or L<pdl2|pdl2>.
+
+=head1 LANGUAGE DOCUMENTATION
+
+Most PDL documentation describes the language features. The number of
+PDL pages is too great to list here. The following pages offer some
+guidance to help you find the documentation you need.
+
+
+=over 5
+
+=item L<PDL::FAQ|PDL::FAQ>
+
+Frequently asked questions about PDL. This page covers a lot of
+questions that do not fall neatly into any of the documentation
+categories.
+
+=item L<PDL::Tutorials|PDL::Tutorials>
+
+A guide to PDL's tutorial-style documentation. With topics from beginner
+to advanced, these pages teach you various aspects of PDL step by step.
+
+=item L<PDL::Modules|PDL::Modules>
+
+A guide to PDL's module reference. Modules are organized by level
+(foundation to advanced) and by category (graphics, numerical methods,
+etc) to help you find the module you need as quickly as possible.
+
+=item L<PDL::Course|PDL::Course>
+
+This page compiles PDL's tutorial and reference pages into a comprehensive
+course that takes you from a complete beginner level to expert.
+
+=item L<PDL::Index|PDL::Index>
+
+List of all available documentation, sorted alphabetically. If you
+cannot find what you are looking for, try here.
+
+=back
+
+
+=head1 MODULES
+
+PDL includes about a dozen perl modules that form the core of the
+language, plus additional modules that add further functionality.
+The perl module "PDL" loads all of the core modules automatically,
+making their functions available in the current perl namespace.
+Some notes:
+
+=over 5
+
+=item SYNOPSIS
+
+See the SYNOPSIS section at the end of this document for a list of
+modules loaded by default.
+
+=item L<PDL::Lite|PDL::Lite> and L<PDL::LiteF|PDL::LiteF>
+
+These are lighter-weight alternatives to the standard PDL module.
+Consider using these modules if startup time becomes an issue.
+
+=item Exports
+
+C<use PDL;> exports a large number of routines into the calling
+namespace. If you want to avoid namespace pollution, you must instead
+C<use PDL::Lite>, and include any additional modules explicitly.
+
+=item L<PDL::NiceSlice|PDL::NiceSlice>
+
+Note that the L<PDL::NiceSlice|PDL::NiceSlice> syntax is NOT automatically
+loaded by C<use PDL;>. If you want to use the extended slicing syntax in
+a standalone script, you must also say C<use PDL::NiceSlice;>.
+
+=item L<PDL::Math|PDL::Math>
+
+The L<PDL::Math|PDL::Math> module has been added to the list of modules
+for versions later than 2.3.1. Note that PDL::Math is still
+I<not> included in the L<PDL::Lite|PDL::Lite> and L<PDL::LiteF|PDL::LiteF>
+start-up modules.
+
+=back
+
+=head1 SYNOPSIS
+
+ use PDL; # Is equivalent to the following:
+
+ use PDL::Core;
+ use PDL::Ops;
+ use PDL::Primitive;
+ use PDL::Ufunc;
+ use PDL::Basic;
+ use PDL::Slices;
+ use PDL::Bad;
+ use PDL::MatrixOps;
+ use PDL::Math;
+ use PDL::Version;
+ use PDL::IO::Misc;
+ use PDL::IO::FITS;
+ use PDL::IO::Pic;
+ use PDL::Lvalue;
+
+=cut
+
+
+# set the version:
+$PDL::VERSION = '2.007'; # Go to sub numbering per git push
+
+# Main loader of standard PDL package
+
+sub PDL::import {
+
+my $pkg = (caller())[0];
+eval <<"EOD";
+
+package $pkg;
+
+# Load the fundamental packages
+
+use PDL::Core;
+use PDL::Ops;
+use PDL::Primitive;
+use PDL::Ufunc;
+use PDL::Basic;
+use PDL::Slices;
+use PDL::Bad;
+use PDL::Math;
+use PDL::MatrixOps;
+use PDL::Lvalue;
+
+# Load these for TPJ compatibility
+
+use PDL::IO::Misc; # Misc IO (Ascii)
+use PDL::IO::FITS; # FITS IO (rfits/wfits; used by rpic/wpic too)
+use PDL::IO::Pic; # rpic/wpic
+
+# Load this so config/install info is available
+
+use PDL::Config;
+
+EOD
+
+die $@ if $@;
+
+}
+
+
+# Dummy Package PDL Statement. This is only needed so CPAN
+# properly recognizes the PDL package.
+package PDL;
+
+##################################################
+# Rudimentary handling for multiple Perl threads #
+##################################################
+my $clone_skip_should_be_quiet = 0;
+sub CLONE_SKIP {
+ warn("* If you need to share PDL data across threads, use memory mapped data, or\n"
+ . "* check out PDL::Parallel::threads, available on CPAN.\n"
+ . "* You can silence this warning by saying `PDL::no_clone_skip_warning;'\n"
+ . "* before you create your first thread.\n")
+ unless $clone_skip_should_be_quiet;
+ PDL::no_clone_skip_warning();
+ # Whether we warned or not, always return 1 to tell Perl not to clone PDL data
+ return 1;
+}
+sub no_clone_skip_warning {
+ $clone_skip_should_be_quiet = 1;
+}
+
+# Exit with OK status
+1;
diff --git a/Basic/Pod/API.pod b/Basic/Pod/API.pod
new file mode 100644
index 0000000..8459da3
--- /dev/null
+++ b/Basic/Pod/API.pod
@@ -0,0 +1,442 @@
+=head1 NAME
+
+PDL::API - making piddles from Perl and C/XS code
+
+=head1 DESCRIPTION
+
+A simple cookbook how to create piddles manually.
+It covers both the Perl and the C/XS level.
+Additionally, it describes the PDL core routines
+that can be accessed from other modules. These
+routines basically define the PDL API. If you need to
+access piddles from C/XS you probably need to know
+about these functions.
+
+=head1 SYNOPSIS
+
+ use PDL;
+ sub mkmypiddle {
+ ...
+ }
+
+=head1 Creating a piddle manually from Perl
+
+Sometimes you want to create a piddle I<manually>
+from binary data. You can do that at the Perl level.
+Examples in the distribution include some of the
+IO routines. The code snippet below illustrates the
+required steps.
+
+ use Carp;
+ sub mkmypiddle {
+ my $class = shift;
+ my $pdl = $class->new;
+ $pdl->set_datatype($PDL_B);
+ my @dims = (1,3,4);
+ my $size = 1;
+ for (@dims) { $size *= $_ }
+ $pdl->setdims([@dims]);
+ my $dref = $pdl->get_dataref();
+
+ # read data directly from file
+ open my $file, '<data.dat' or die "couldn't open data.dat";
+ my $len = $size*PDL::Core::howbig($pdl->get_datatype);
+ croak "couldn't read enough data" if
+ read( $file, $$dref, $len) != $len;
+ close $file;
+ $pdl->upd_data();
+
+ return $pdl;
+ }
+
+=head1 Creating a piddle in C
+
+The following example creates a piddle at the C level.
+We use the C<Inline> module which is really the way to interface
+Perl and C these days. Note the use of the C<PDL_INCLUDE>, C<PDL_TYPEMAP>,
+C<PDL_AUTO_INCLUDE> and C<PDL_BOOT> functions that were imported from
+C<PDL::Core::Dev>. They are used in conjunction with an Inline
+Config call to ensure that the PDL typemap, the PDL include files
+and the PDL Core routines are found during compilation and later
+runtime execution.
+
+ use PDL::LiteF;
+ use PDL::Core::Dev;
+
+ $a = myfloatseq(); # exercise our C piddle constructor
+
+ print $a->info,"\n";
+
+ # the reason for this config call is explained below
+ use Inline C => Config =>
+ INC => &PDL_INCLUDE, # make sure we find pdlcore.h etc
+ TYPEMAPS => &PDL_TYPEMAP, # use the PDL typemap
+ AUTO_INCLUDE => &PDL_AUTO_INCLUDE, # global declarations and includes
+ BOOT => &PDL_BOOT; # boot code to load the Core struct
+
+ use Inline C;
+ Inline->init; # useful if you want to be able to 'do'-load this script
+
+ __DATA__
+
+ __C__
+
+ static pdl* new_pdl(int datatype, PDL_Indx dims[], int ndims)
+ {
+ pdl *p = PDL->pdlnew();
+ PDL->setdims (p, dims, ndims); /* set dims */
+ p->datatype = datatype; /* and data type */
+ PDL->allocdata (p); /* allocate the data chunk */
+
+ return p;
+ }
+
+ pdl* myfloatseq()
+ {
+ PDL_Indx dims[] = {5,5,5};
+ pdl *p = new_pdl(PDL_F,dims,3);
+ PDL_Float *dataf = (PDL_Float *) p->data;
+ PDL_Indx i; /* dimensions might be 64bits */
+
+ for (i=0;i<5*5*5;i++)
+ dataf[i] = i; /* the data must be initialized ! */
+ return p;
+ }
+
+=head2 Wrapping your own data into a piddle
+
+Sometimes you obtain a chunk of data from another
+source, for example an image processing library, etc.
+All you want to do in that case is wrap your data
+into a piddle struct at the C level. Examples using this approach
+can be found in the IO modules (where FastRaw and FlexRaw
+use it for mmapped access) and the Gimp Perl module (that
+uses it to wrap Gimp pixel regions into piddles).
+The following script demonstrates a simple example:
+
+ use PDL::LiteF;
+ use PDL::Core::Dev;
+ use PDL::Graphics::PGPLOT;
+
+ $b = mkpiddle();
+
+ print $b->info,"\n";
+
+ imag1 $b;
+
+ use Inline C => Config =>
+ INC => &PDL_INCLUDE,
+ TYPEMAPS => &PDL_TYPEMAP,
+ AUTO_INCLUDE => &PDL_AUTO_INCLUDE,
+ BOOT => &PDL_BOOT;
+
+ use Inline C;
+ Inline->init;
+
+ __DATA__
+
+ __C__
+
+ /* wrap a user supplied chunk of data into a piddle
+ * You must specify the dimensions (dims,ndims) and
+ * the datatype (constants for the datatypes are declared
+ * in pdl.h; e.g. PDL_B for byte type, etc)
+ *
+ * when the created piddle 'npdl' is destroyed on the
+ * Perl side the function passed as the 'delete_magic'
+ * parameter will be called with the pointer to the pdl structure
+ * and the 'delparam' argument.
+ * This gives you an opportunity to perform any clean up
+ * that is necessary. For example, you might have to
+ * explicitly call a function to free the resources
+ * associated with your data pointer.
+ * At the very least 'delete_magic' should zero the piddle's data pointer:
+ *
+ * void delete_mydata(pdl* pdl, int param)
+ * {
+ * pdl->data = 0;
+ * }
+ * pdl *p = pdl_wrap(mydata, PDL_B, dims, ndims, delete_mydata,0);
+ *
+ * pdl_wrap returns the pointer to the pdl
+ * that was created.
+ */
+ typedef void (*DelMagic)(pdl *, int param);
+ static void default_magic(pdl *p, int pa) { p->data = 0; }
+ static pdl* pdl_wrap(void *data, int datatype, PDL_Indx dims[],
+ int ndims, DelMagic delete_magic, int delparam)
+ {
+ pdl* npdl = PDL->pdlnew(); /* get the empty container */
+
+ PDL->setdims(npdl,dims,ndims); /* set dims */
+ npdl->datatype = datatype; /* and data type */
+ npdl->data = data; /* point it to your data */
+ /* make sure the core doesn't meddle with your data */
+ npdl->state |= PDL_DONTTOUCHDATA | PDL_ALLOCATED;
+ if (delete_magic != NULL)
+ PDL->add_deletedata_magic(npdl, delete_magic, delparam);
+ else
+ PDL->add_deletedata_magic(npdl, default_magic, 0);
+ return npdl;
+ }
+
+ #define SZ 256
+ /* a really silly function that makes a ramp image
+ * in reality this could be an opaque function
+ * in some library that you are using
+ */
+ static PDL_Byte* mkramp(void)
+ {
+ PDL_Byte *data;
+ int i; /* should use PDL_Indx to support 64bit pdl indexing */
+
+ if ((data = malloc(SZ*SZ*sizeof(PDL_Byte))) == NULL)
+ croak("mkramp: Couldn't allocate memory");
+ for (i=0;i<SZ*SZ;i++)
+ data[i] = i % SZ;
+
+ return data;
+ }
+
+ /* this function takes care of the required clean-up */
+ static void delete_myramp(pdl* p, int param)
+ {
+ if (p->data)
+ free(p->data);
+ p->data = 0;
+ }
+
+ pdl* mkpiddle()
+ {
+ PDL_Indx dims[] = {SZ,SZ};
+ pdl *p;
+
+ p = pdl_wrap((void *) mkramp(), PDL_B, dims, 2,
+ delete_myramp,0); /* the delparam is abitrarily set to 0 */
+ return p;
+ }
+
+=head1 The gory details
+
+=head2 The Core struct -- getting at PDL core routines at runtime
+
+PDL uses a technique similar to that employed by the Tk modules
+to let other modules use its core routines. A pointer to all
+shared core PDL routines is stored in the C<$PDL::SHARE> variable.
+XS code should get hold of this pointer at boot time so that
+the rest of the C/XS code can then use that pointer for access
+at run time. This initial loading of the pointer is most easily
+achieved using the functions C<PDL_AUTO_INCLUDE> and C<PDL_BOOT>
+that are defined and exported by C<PDL::Core::Dev>. Typical usage
+with the Inline module has already been demonstrated:
+
+ use Inline C => Config =>
+ INC => &PDL_INCLUDE,
+ TYPEMAPS => &PDL_TYPEMAP,
+ AUTO_INCLUDE => &PDL_AUTO_INCLUDE, # declarations
+ BOOT => &PDL_BOOT; # code for the XS boot section
+
+
+The code returned by C<PDL_AUTO_INCLUDE> makes sure that F<pdlcore.h>
+is included and declares the static variables to hold the pointer to
+the C<Core> struct. It looks something like this:
+
+ print PDL_AUTO_INCLUDE;
+
+ #include <pdlcore.h>
+ static Core* PDL; /* Structure holds core C functions */
+ static SV* CoreSV; /* Gets pointer to Perl var holding core structure */
+
+The code returned by C<PDL_BOOT> retrieves the C<$PDL::SHARE> variable
+and initializes the pointer to the C<Core> struct. For those who know
+their way around the Perl API here is the code:
+
+ print PDL_BOOT;
+
+ perl_require_pv ("PDL::Core"); /* make sure PDL::Core is loaded */
+ CoreSV = perl_get_sv("PDL::SHARE",FALSE); /* SV* value */
+ #ifndef aTHX_
+ #define aTHX_
+ #endif
+ if (CoreSV==NULL)
+ Perl_croak(aTHX_ "We require the PDL::Core module, which was not found");
+ PDL = INT2PTR(Core*,SvIV( CoreSV )); /* Core* value */
+ if (PDL->Version != PDL_CORE_VERSION)
+ Perl_croak(aTHX_ "The code needs to be recompiled against the newly installed PDL");
+
+The C<Core> struct contains version info to ensure that the structure defined
+in F<pdlcore.h> really corresponds to the one obtained at runtime. The code
+above tests for this
+
+ if (PDL->Version != PDL_CORE_VERSION)
+ ....
+
+For more information on the Core struct see L<PDL::Internals|PDL::Internals>.
+
+With these preparations your code can now access the
+core routines as already shown in some of the examples above, e.g.
+
+ pdl *p = PDL->pdlnew();
+
+By default the C variable named C<PDL> is used to hold the pointer to the
+C<Core> struct. If that is (for whichever reason) a problem you can
+explicitly specify a name for the variable with the C<PDL_AUTO_INCLUDE>
+and the C<PDL_BOOT> routines:
+
+ use Inline C => Config =>
+ INC => &PDL_INCLUDE,
+ TYPEMAPS => &PDL_TYPEMAP,
+ AUTO_INCLUDE => &PDL_AUTO_INCLUDE 'PDL_Corep',
+ BOOT => &PDL_BOOT 'PDL_Corep';
+
+Make sure you use the same identifier with C<PDL_AUTO_INCLUDE>
+and C<PDL_BOOT> and use that same identifier in your own code.
+E.g., continuing from the example above:
+
+ pdl *p = PDL_Corep->pdlnew();
+
+=head2 Some selected core routines explained
+
+The full definition of the C<Core> struct can be found in the file
+F<pdlcore.h>. In the following the most frequently used member
+functions of this struct are briefly explained.
+
+=over 5
+
+=item *
+
+C<pdl *SvPDLV(SV *sv)>
+
+=item *
+
+C<pdl *SetSV_PDL(SV *sv, pdl *it)>
+
+=item *
+
+C<pdl *pdlnew()>
+
+C<pdlnew> returns an empty pdl object that needs further initialization
+to turn it into a proper piddle. Example:
+
+ pdl *p = PDL->pdlnew();
+ PDL->setdims(p,dims,ndims);
+ p->datatype = PDL_B;
+
+=item *
+
+C<pdl *null()>
+
+=item *
+
+C<SV *copy(pdl* p, char* )>
+
+=item *
+
+C<void *smalloc(STRLEN nbytes)>
+
+=item *
+
+C<int howbig(int pdl_datatype)>
+
+=item *
+
+C<void add_deletedata_magic(pdl *p, void (*func)(pdl*, int), int param)>
+
+=item *
+
+C<void allocdata(pdl *p)>
+
+=item *
+
+C<void make_physical(pdl *p)>
+
+=item *
+
+C<void make_physdims(pdl *p)>
+
+=item *
+
+C<void make_physvaffine(pdl *p)>
+
+=item *
+
+C<void qsort_X(PDL_Xtype *data, PDL_Indx a, PDL_Indx b)> and
+C<void qsort_ind_X(PDL_Xtype *data, PDL_Indx *ix, PDL_Indx a, PDL_Indx b)>
+
+where X is one of B,S,U,L,F,D and Xtype is one of Byte, Short, Ushort,
+Long, Float or Double. PDL_Indx is the C integer type corresponding to
+appropriate indexing size for the perl configuration (ivsize and ivtype).
+It can be either 'long' or 'long long' depending on whether your perl
+is 32bit or 64bit enabled.
+
+=item *
+
+C<float NaN_float> and
+C<double NaN_double>
+
+These are constants to produce the required NaN values.
+
+=item *
+
+C<void pdl_barf(const char* pat,...)> and
+C<void pdl_warn(const char* pat,...)>
+
+These are C-code equivalents of C<barf> and C<warn>. They include special handling of error or warning
+messages during pthreading (i.e. processor multi-threading) that defer the messages until after pthreading
+is completed. When pthreading is complete, perl's C<barf> or C<warn> is called with the deferred messages. This
+is needed to keep from calling perl's C<barf> or C<warn> during pthreading, which can cause segfaults.
+
+Note that C<barf> and C<warn> have been redefined (using c-preprocessor macros) in pdlcore.h to C<< PDL->barf >>
+and C<< PDL->warn >>. This is to keep any XS or PP code from calling perl's C<barf> or C<warn> directly, which can
+cause segfaults during pthreading.
+
+See L<PDL::ParallelCPU> for more information on pthreading.
+
+=back
+
+=cut
+
+# ones that are not clear:
+# safe_indterm
+# converttypei_new
+# converttype
+# get_convertedpdl
+# affine_new
+# make_trans_mutual
+# make_now
+# get
+# get_offs
+# put_offs
+# setdims_careful
+# tmp
+# destroy
+# twod
+# grow
+# flushcache
+# reallocdims
+# reallocthreadids
+# resize_defaultincs
+
+=head1 SEE ALSO
+
+L<PDL>
+
+L<Inline>
+
+=head1 BUGS
+
+This manpage is still under development.
+Feedback and corrections are welcome.
+
+
+=head1 COPYRIGHT
+
+Copyright 2013 Chris Marshall (chm at cpan.org).
+
+Copyright 2010 Christian Soeller (c.soeller at auckland.ac.nz).
+You can distribute and/or modify this document under the same
+terms as the current Perl license.
+
+See: http://dev.perl.org/licenses/
+
+=cut
diff --git a/Basic/Pod/BadValues.pod b/Basic/Pod/BadValues.pod
new file mode 100644
index 0000000..72ce714
--- /dev/null
+++ b/Basic/Pod/BadValues.pod
@@ -0,0 +1,744 @@
+=head1 NAME
+
+PDL::BadValues - Discussion of bad value support in PDL
+
+=head1 DESCRIPTION
+
+=head2 What are bad values and why should I bother with them?
+
+Sometimes it's useful to be able to specify a certain value is 'bad' or
+'missing'; for example CCDs used in astronomy produce 2D images which are not
+perfect since certain areas contain invalid data due to imperfections in the
+detector. Whilst PDL's powerful index
+routines and all the complicated business with dataflow, slices, etc etc mean
+that these regions can be ignored in processing, it's awkward to do. It would
+be much easier to be able to say C<$c = $a + $b> and leave all the hassle to
+the computer.
+
+If you're not interested in this, then you may (rightly) be concerned
+with how this affects the speed of PDL, since the overhead of checking for a
+bad value at each operation can be large.
+Because of this, the code has been written to be as fast as possible -
+particularly when operating on piddles which do not contain bad values.
+In fact, you should notice essentially no speed difference when working
+with piddles which do not contain bad values.
+
+However, if you do not want bad values, then PDL's C<WITH_BADVAL>
+configuration option comes to the rescue; if set to 0 or undef, the bad-value
+support is ignored.
+About the only time I think you'll need to use this - I admit, I'm biased ;) -
+is if you have limited disk or memory space, since the size of the code
+is increased (see below).
+
+You may also ask 'well, my computer supports IEEE NaN, so I already have this'.
+Well, yes and no - many routines, such as C<y=sin(x)>, will propagate NaN's
+without the user having to code differently, but routines such as C<qsort>, or
+finding the median of an array, need to be re-coded to handle bad values.
+For floating-point datatypes, C<NaN> and C<Inf> are used to flag bad values
+I<IF> the option C<BADVAL_USENAN> is set to 1 in your config file. Otherwise
+special values are used (L<Default bad values|/Default bad values>). I
+do not have any benchmarks to see which option is faster.
+
+There is an experimental feature C<BADVAL_PER_PDL> which, if set,
+allows you to have different bad values for separate piddles of the
+same type. This currently does not work with the C<BADVAL_USENAN> option;
+if both are set then PDL will ignore the C<BADVAL_USENAN> value.
+
+=head2 Code increase due to bad values
+
+The following comparison is out of date!
+
+On an i386 machine running Linux and Perl 5.005_03, I measured the
+following sizes (the Slatec code was compiled in, but none of the other
+options: e.g., FFTW, GSL, and TriD were):
+
+=over 4
+
+=item WITH_BADVAL = 0
+
+Size of blib directory after a successful make = B<4963 kb>:
+blib/arch = 2485 kb and blib/lib = 1587 kb.
+
+=item WITH_BADVAL = 1
+
+Size of blib directory after a successful make = B<5723 kb>:
+blib/arch = 3178 kb and blib/lib = 1613 kb.
+
+=back
+
+So, the overall increase is I<only> 15% - not much to pay for all
+the wonders that bad values provides ;)
+
+The source code used for this test had the vast majority of the core routines
+(eg those in Basic/) converted to use bad values, whilst very few of the 'external'
+routines (i.e. everything else in the PDL distribution) had been changed.
+
+=head2 A quick overview
+
+ pdl> p $PDL::Bad::Status
+ 1
+ pdl> $a = sequence(4,3);
+ pdl> p $a
+ [
+ [ 0 1 2 3]
+ [ 4 5 6 7]
+ [ 8 9 10 11]
+ ]
+ pdl> $a = $a->setbadif( $a % 3 == 2 )
+ pdl> p $a
+ [
+ [ 0 1 BAD 3]
+ [ 4 BAD 6 7]
+ [BAD 9 10 BAD]
+ ]
+ pdl> $a *= 3
+ pdl> p $a
+ [
+ [ 0 3 BAD 9]
+ [ 12 BAD 18 21]
+ [BAD 27 30 BAD]
+ ]
+ pdl> p $a->sum
+ 120
+
+C<demo bad> and C<demo bad2>
+within L<perldl|PDL::perldl> or L<pdl2|PDL::Perldl2> gives a demonstration of some of the things
+possible with bad values. These are also available on PDL's web-site,
+at F<http://pdl.perl.org/demos/>. See L<PDL::Bad> for useful routines for working
+with bad values and F<t/bad.t> to see them in action.
+
+The intention is to:
+
+=over 4
+
+=item *
+
+not significantly affect PDL for users who don't need bad value support
+
+=item *
+
+be as fast as possible when bad value support is installed
+
+=back
+
+If you never want bad value support, then you set C<WITH_BADVAL> to 0 in
+F<perldl.conf>; PDL then has no bad value support compiled in, so will be as fast
+as it used to be.
+
+However, in most cases, the bad value support has a negligible affect on speed,
+so you should set C<WITH_CONFIG> to 1! One exception is if you are low on memory,
+since the amount of code produced is larger (but only by about 15% - see
+L<Code increase due to bad values>).
+
+To find out if PDL has been compiled with bad value support, look at the values
+of either C<$PDL::Config{WITH_BADVAL}> or C<$PDL::Bad::Status> - if true then
+it has been.
+
+To find out if a routine supports bad values, use the C<badinfo> command in
+L<perldl|PDL::perldl> or L<pdl2|PDL::Perldl2> or the C<-b> option to
+L<pdldoc|PDL::pdldoc>. This facility is currently a 'proof of concept'
+(or, more realistically, a quick hack) so expect it to be rough around the edges.
+
+Each piddle contains a flag - accessible via C<$pdl-E<gt>badflag> - to say
+whether there's any bad data present:
+
+=over 4
+
+=item *
+
+If B<false/0>, which means there's no bad data here, the code supplied by the
+C<Code> option to C<pp_def()> is executed. This means that the speed should be
+very close to that obtained with C<WITH_BADVAL=0>, since the only overhead is
+several accesses to a bit in the piddles state variable.
+
+=item *
+
+If B<true/1>, then this says there I<MAY> be bad data in the piddle, so use the
+code in the C<BadCode> option (assuming that the C<pp_def()> for this routine
+has been updated to have a BadCode key).
+You get all the advantages of threading, as with the C<Code> option,
+but it will run slower since you are going to have to handle the presence of bad values.
+
+=back
+
+If you create a piddle, it will have its bad-value flag set to 0. To change
+this, use C<$pdl-E<gt>badflag($new_bad_status)>, where C<$new_bad_status> can be 0 or 1.
+When a routine creates a piddle, its bad-value flag will depend on the input
+piddles: unless over-ridden (see the C<CopyBadStatusCode> option to C<pp_def>), the
+bad-value flag will be set true if any of the input piddles contain bad values.
+To check that a piddle really contains bad data, use the C<check_badflag> method.
+
+I<NOTE>: propogation of the badflag
+
+If you change the badflag of a piddle, this change is propagated to all
+the I<children> of a piddle, so
+
+ pdl> $a = zeroes(20,30);
+ pdl> $b = $a->slice('0:10,0:10');
+ pdl> $c = $b->slice(',(2)');
+ pdl> print ">>c: ", $c->badflag, "\n";
+ >>c: 0
+ pdl> $a->badflag(1);
+ pdl> print ">>c: ", $c->badflag, "\n";
+ >>c: 1
+
+I<No> change is made to the parents of a piddle, so
+
+ pdl> print ">>a: ", $a->badflag, "\n";
+ >>a: 1
+ pdl> $c->badflag(0);
+ pdl> print ">>a: ", $a->badflag, "\n";
+ >>a: 1
+
+Thoughts:
+
+=over 4
+
+=item *
+
+the badflag can ONLY be cleared IF a piddle has NO parents,
+and that this change will propagate to all the children of that
+piddle. I am not so keen on this anymore (too awkward to code, for
+one).
+
+=item *
+
+C<$a-E<gt>badflag(1)> should propagate the badflag to BOTH parents and
+children.
+
+=back
+
+This shouldn't be hard to implement (although an initial attempt failed!).
+Does it make sense though? There's also
+the issue of what happens if you change the badvalue of a piddle - should
+these propagate to children/parents (yes) or whether you should only be
+able to change the badvalue at the 'top' level - i.e. those piddles which do
+not have parents.
+
+The C<orig_badvalue()> method returns the compile-time value for a given
+datatype. It works on piddles, PDL::Type objects, and numbers - eg
+
+ $pdl->orig_badvalue(), byte->orig_badvalue(), and orig_badvalue(4).
+
+It also has a horrible name...
+
+To get the current bad value, use the C<badvalue()> method - it has the same
+syntax as C<orig_badvalue()>.
+
+To change the current bad value, supply the new number to badvalue - eg
+
+ $pdl->badvalue(2.3), byte->badvalue(2), badvalue(5,-3e34).
+
+I<Note>: the value is silently converted to the correct C type, and
+returned - i.e. C<byte-E<gt>badvalue(-26)> returns 230 on my Linux machine.
+It is also a C<nop> for floating-point types when C<BADVAL_USENAN> is true.
+
+Note that changes to the bad value are I<NOT> propagated to previously-created
+piddles - they will still have the bad value set, but suddenly the elements
+that were bad will become 'good', but containing the old bad value.
+See discussion below. It's not a problem for floating-point types
+which use NaN, since you can not change their badvalue.
+
+=head2 Bad values and boolean operators
+
+For those boolean operators in L<PDL::Ops|PDL::Ops>, evaluation
+on a bad value returns the bad value. Whilst this means that
+
+ $mask = $img > $thresh;
+
+correctly propagates bad values, it I<will> cause problems
+for checks such as
+
+ do_something() if any( $img > $thresh );
+
+which need to be re-written as something like
+
+ do_something() if any( setbadtoval( ($img > $thresh), 0 ) );
+
+When using one of the 'projection' functions in L<PDL::Ufunc|PDL::Ufunc> - such as
+L<orover|PDL::Ufunc/orover> -
+bad values are skipped over (see the documentation of these
+functions for the current (poor) handling of the case when
+all elements are bad).
+
+=head2 A bad value for each piddle, and related issues
+
+An B<experimental> option C<BADVAL_PER_PDL> has been added to F<perldl.conf>
+to allow per-piddle bad values. The documentation has not been updated
+to account for this change.
+
+The following is relevant only for integer types, and for floating-point
+types if C<BADVAL_USENAN> was not set when PDL was built.
+
+Currently, there is one bad value for each datatype. The code is written so
+that we could have a separate bad value for each piddle (stored in the
+pdl structure) - this would then remove the current problem of:
+
+ pdl> $a = byte( 1, 2, byte->badvalue, 4, 5 );
+ pdl> p $a;
+ [1 2 255 4 5]
+ pdl> $a->badflag(1)
+ pdl> p $a;
+ [1 2 BAD 4 5]
+ pdl> byte->badvalue(0);
+ pdl> p $a;
+ [1 2 255 4 5]
+
+ie the bad value in C<$a> has lost its I<bad> status using the current
+implementation. It would almost certainly cause problems elsewhere though!
+
+=head1 IMPLEMENTATION DETAILS
+
+During a C<perl Makefile.PL>, the file F<Basic/Core/badsupport.p> is created;
+this file contains the values of the C<WITH_BADVAL>, C<BADVAL_USENAN>
+and C<BADVAL_PER_PDL> variables, and should be used by code that is
+executed before the F<PDL::Config>
+file is created (e.g. F<Basic/Core/pdlcore.c.PL>.
+However, most PDL code will just need to access the C<%PDL::Config>
+array (e.g. F<Basic/Bad/bad.pd>) to find out whether bad-value support is required.
+
+A new flag has been added to the state of a piddle - C<PDL_BADVAL>. If unset, then
+the piddle does not contain bad values, and so all the support code can be
+ignored. If set, it does not guarantee that bad values are present, just that
+they should be checked for. Thanks to Christian, C<badflag()> - which
+sets/clears this flag (see F<Basic/Bad/bad.pd>) - will update I<ALL> the
+children/grandchildren/etc of a piddle if its state changes (see
+C<badflag> in F<Basic/Bad/bad.pd> and
+C<propagate_badflag> in F<Basic/Core/Core.xs.PL>).
+It's not clear what to do with parents: I can see the reason for propagating a
+'set badflag' request to parents, but I think a child should NOT be able to clear
+the badflag of a parent.
+There's also the issue of what happens when you change the bad value for a piddle.
+
+The C<pdl_trans> structure has been extended to include an integer value,
+C<bvalflag>, which acts as a switch to tell the code whether to handle bad values
+or not. This value is set if any of the input piddles have their C<PDL_BADVAL>
+flag set (although this code can be replaced by setting C<FindBadStateCode> in
+pp_def). The logic of the check is going to get a tad more complicated
+if I allow routines to fall back to using the C<Code> section for
+floating-point types (i.e. those routines with C<NoBadifNaN =E<gt> 1>
+when C<BADVAL_USENAN> is true).
+
+The bad values for the integer types
+are now stored in a structure within the Core PDL structure
+- C<PDL.bvals> (eg F<Basic/Core/pdlcore.h.PL>); see also
+C<typedef badvals> in F<Basic/Core/pdl.h.PL> and the
+BOOT code of F<Basic/Core/Core.xs.PL> where the values are initialised to
+(hopefully) sensible values.
+See F<PDL/Bad/bad.pd> for read/write routines to the values.
+
+The addition of the C<BADVAL_PER_PDL> option has resulted in additional
+changes to the internals of piddles. These changes are not documented yet.
+
+=head2 Why not make a PDL subclass?
+
+The support for bad values could have been done as a PDL sub-class.
+The advantage of this approach would be that you only load in the code
+to handle bad values if you actually want to use them.
+The downside is that the code then gets separated: any bug fixes/improvements
+have to be done to the code in two different files. With the present approach
+the code is in the same C<pp_def> function (although there is still the problem
+that both C<Code> and C<BadCode> sections need updating).
+
+=head2 Default bad values
+
+The default/original bad values are set to (taken from the Starlink
+distribution):
+
+ #include <limits.h>
+
+ PDL_Byte == UCHAR_MAX
+ PDL_Short == SHRT_MIN
+ PDL_Ushort == USHRT_MAX
+ PDL_Long == INT_MIN
+
+If C<BADVAL_USENAN == 0>, then we also have
+
+ PDL_Float == -FLT_MAX
+ PDL_Double == -DBL_MAX
+
+otherwise all of C<NaN>, C<+Inf>, and
+C<-Inf> are taken to be bad for floating-point types.
+In this case, the bad value can't be changed, unlike the
+integer types.
+
+=head2 How do I change a routine to handle bad values?
+
+Examples can be found in most of the F<*.pd> files in F<Basic/> (and
+hopefully many more places soon!).
+Some of the logic might appear a bit unclear - that's probably because it
+is! Comments appreciated.
+
+All routines should automatically propagate the bad status flag to output
+piddles, unless you declare otherwise.
+
+If a routine explicitly deals with bad values, you must provide this option
+to pp_def:
+
+ HandleBad => 1
+
+This ensures that the correct variables are initialised for the C<$ISBAD> etc
+macros. It is also used by the automatic document-creation routines to
+provide default information on the bad value support of a routine without
+the user having to type it themselves (this is in its early stages).
+
+To flag a routine as NOT handling bad values, use
+
+ HandleBad => 0
+
+This I<should> cause the routine to print a warning if it's sent any piddles
+with the bad flag set. Primitive's C<intover> has had this set - since it
+would be awkward to convert - but I've not tried it out to see if it works.
+
+If you want to handle bad values but not set the state of all the output
+piddles, or if it's only one input piddle that's important, then look
+at the PP rules C<NewXSFindBadStatus> and C<NewXSCopyBadStatus> and the
+corresponding C<pp_def> options:
+
+=over 4
+
+=item FindBadStatusCode
+
+By default, C<FindBadStatusCode> creates code which sets
+C<$PRIV(bvalflag)> depending on the state of the bad flag
+of the input piddles: see C<findbadstatus> in F<Basic/Gen/PP.pm>.
+User-defined code should also store the value of C<bvalflag>
+in the C<$BADFLAGCACHE()> variable.
+
+=item CopyBadStatusCode
+
+The default code here is a bit simpler than for C<FindBadStatusCode>:
+the bad flag of the output piddles are set if
+C<$BADFLAGCACHE()> is true after the code has been
+evaluated. Sometimes C<CopyBadStatusCode> is set to an empty string,
+with the responsibility of setting the badflag of the output piddle
+left to the C<BadCode> section (e.g. the C<xxxover> routines
+in F<Basic/Primitive/primitive.pd>).
+
+Prior to PDL 2.4.3 we used C<$PRIV(bvalflag)>
+instead of C<$BADFLAGCACHE()>. This is dangerous since the C<$PRIV()>
+structure is not guaranteed to be valid at this point in the
+code.
+
+=back
+
+If you have a routine that you want to be able to use as in-place, look
+at the routines in F<bad.pd> (or F<ops.pd>)
+which use the C<in-place> option to see how the
+bad flag is propagated to children using the C<xxxBadStatusCode> options.
+I decided not to automate this as rules would be a
+little complex, since not every in-place op will need to propagate the
+badflag (eg unary functions).
+
+If the option
+
+ HandleBad => 1
+
+is given, then many things happen. For integer types, the readdata code
+automatically creates a variable called C<E<lt>pdl nameE<gt>_badval>,
+which contains the bad value for that piddle (see
+C<get_xsdatapdecl()> in F<Basic/Gen/PP/PdlParObjs.pm>). However, do not
+hard code this name into your code!
+Instead use macros (thanks to Tuomas for the suggestion):
+
+ '$ISBAD(a(n=>1))' expands to '$a(n=>1) == a_badval'
+ '$ISGOOD(a())' '$a() != a_badval'
+ '$SETBAD(bob())' '$bob() = bob_badval'
+
+well, the C<$a(...)> is expanded as well. Also, you can use a C<$> before the
+pdl name, if you so wish, but it begins to look like line noise -
+eg C<$ISGOOD($a())>.
+
+If you cache a piddle value in a variable -- eg C<index> in F<slices.pd> --
+the following routines are useful:
+
+ '$ISBADVAR(c_var,pdl)' 'c_var == pdl_badval'
+ '$ISGOODVAR(c_var,pdl)' 'c_var != pdl_badval'
+ '$SETBADVAR(c_var,pdl)' 'c_var = pdl_badval'
+
+The following have been introduced, They may need playing around with to
+improve their use.
+
+ '$PPISBAD(CHILD,[i]) 'CHILD_physdatap[i] == CHILD_badval'
+ '$PPISGOOD(CHILD,[i]) 'CHILD_physdatap[i] != CHILD_badval'
+ '$PPSETBAD(CHILD,[i]) 'CHILD_physdatap[i] = CHILD_badval'
+
+If C<BADVAL_USENAN> is set, then
+it's a bit different for C<float> and C<double>, where we consider
+C<NaN>, C<+Inf>, and C<-Inf> all to be bad. In this case:
+
+ ISBAD becomes finite(piddle) == 0
+ ISGOOD finite(piddle) != 0
+ SETBAD piddle = NaN
+
+where the value for NaN is discussed below in
+L<Handling NaN values|/Handling NaN values>.
+
+This all means that you can change
+
+ Code => '$a() = $b() + $c();'
+
+to
+
+ BadCode => 'if ( $ISBAD(b()) || $ISBAD(c()) ) {
+ $SETBAD(a());
+ } else {
+ $a() = $b() + $c();
+ }'
+
+leaving Code as it is. PP::PDLCode will then create a loop something like
+
+ if ( __trans->bvalflag ) {
+ threadloop over BadCode
+ } else {
+ threadloop over Code
+ }
+
+(it's probably easier to just look at the F<.xs> file to see what goes on).
+
+=head2 Going beyond the Code section
+
+Similar to C<BadCode>, there's C<BadBackCode>, and C<BadRedoDimsCode>.
+
+Handling C<EquivCPOffsCode> is a bit different: under the assumption that the
+only access to data is via the C<$EQUIVCPOFFS(i,j)> macro, then we can
+automatically create the 'bad' version of it; see the C<[EquivCPOffsCode]>
+and C<[Code]> rules in L<PDL::PP>.
+
+=head2 Macro access to the bad flag of a piddle
+
+Macros have been provided to provide access to the bad-flag status of
+a pdl:
+
+ '$PDLSTATEISBAD(a)' -> '($PDL(a)->state & PDL_BADVAL) > 0'
+ '$PDLSTATEISGOOD(a)' '($PDL(a)->state & PDL_BADVAL) == 0'
+
+ '$PDLSTATESETBAD(a)' '$PDL(a)->state |= PDL_BADVAL'
+ '$PDLSTATESETGOOD(a)' '$PDL(a)->state &= ~PDL_BADVAL'
+
+For use in C<xxxxBadStatusCode> (+ other stuff that goes into the INIT: section)
+there are:
+
+ '$SETPDLSTATEBAD(a)' -> 'a->state |= PDL_BADVAL'
+ '$SETPDLSTATEGOOD(a)' -> 'a->state &= ~PDL_BADVAL'
+
+ '$ISPDLSTATEBAD(a)' -> '((a->state & PDL_BADVAL) > 0)'
+ '$ISPDLSTATEGOOD(a)' -> '((a->state & PDL_BADVAL) == 0)'
+
+In PDL 2.4.3 the C<$BADFLAGCACHE()> macro was introduced for use in
+C<FindBadStatusCode> and C<CopyBadStatusCode>.
+
+=head2 Handling NaN values
+
+There are two issues:
+
+=over 4
+
+=item NaN as the bad value
+
+which is done. To select, set C<BADVAL_USENAN> to 1 in perldl.conf;
+a value of 0 falls back to treating the floating-point types the
+same as the integers. I need to do some benchmarks to see which is faster,
+and whether it's dependent on machines (Linux seems to slow down much
+more than my Sparc machine in some very simple tests I did).
+
+=item Ignoring BadCode sections
+
+which is I<not>.
+
+=back
+
+For I<simple> routines processing floating-point numbers, we should let
+the computer process the bad values (i.e. C<NaN> and C<Inf> values) instead
+of using the code in the C<BadCode> section. Many such routines have
+been labeled using C<NoBadifNaN =E<gt> 1>; however this is currently
+I<ignored> by PDL::PP.
+
+For these routines, we want to use the C<Code> section if
+
+ the piddle does not have its bad flag set
+ the datatype is a float or double
+
+otherwise we use the C<BadCode> section. This is I<NOT IMPLEMENTED>, as
+it will require reasonable hacking of PP::PDLCode!
+
+There's also the problem of how we handle 'exceptions' - since C<$a = pdl(2) / pdl(0)>
+produces a bad value but doesn't update the badflag value of the piddle.
+Can we catch an exception, or do we have to trap for this
+(e.g. search for C<exception> in F<Basic/Ops/ops.pd>)?
+
+Checking for C<Nan>, and C<Inf> is done by using the C<finite()>
+system call. If you want to set a value to the C<NaN> value, the
+following bit of code can be used (this can be found in
+both F<Basic/Core/Core.xs.PL> and F<Basic/Bad/bad.pd>):
+
+ /* for big-endian machines */
+ static union { unsigned char __c[4]; float __d; }
+ __pdl_nan = { { 0x7f, 0xc0, 0, 0 } };
+
+ /* for little-endian machines */
+ static union { unsigned char __c[4]; float __d; }
+ __pdl_nan = { { 0, 0, 0xc0, 0x7f } };
+
+This approach should probably be replaced by library routines such as
+C<nan("")> or C<atof("NaN")>.
+
+To find out whether a particular machine is big endian, use the
+routine C<PDL::Core::Dev::isbigendian()>.
+
+=head1 WHAT ABOUT DOCUMENTATION?
+
+One of the strengths of PDL is its on-line documentation. The aim is to use
+this system to provide information on how/if a routine supports bad values:
+in many cases C<pp_def()> contains all the information anyway, so the
+function-writer doesn't need to do anything at all! For the cases when this is
+not sufficient, there's the C<BadDoc> option. For code written at
+the Perl level - i.e. in a .pm file - use the C<=for bad> pod directive.
+
+This information will be available via man/pod2man/html documentation. It's also
+accessible from the C<perldl> or C<pdl2> shells - using the C<badinfo> command - and the C<pdldoc>
+shell command - using the C<-b> option.
+
+This support is at a very early stage - i.e. not much thought has gone into it:
+comments are welcome; improvements to the code preferred ;) One awkward problem
+is for F<*.pm> code: you have to write a F<*.pm.PL> file which only inserts the
+C<=for bad> directive (+ text) if bad value support is compiled in. In fact, this
+is a pain when handling bad values at the Perl, rather than PDL::PP, level: perhaps
+I should just scrap the C<WITH_BADVAL> option...
+
+=head1 CURRENT ISSUES
+
+There are a number of areas that need work, user input, or both! They are
+mentioned elsewhere in this document, but this is just to make sure they don't get lost.
+
+=head2 Trapping invalid mathematical operations
+
+Should we add exceptions to the functions in C<PDL::Ops> to
+set the output bad for out-of-range input values?
+
+ pdl> p log10(pdl(10,100,-1))
+
+I would like the above to produce "[1 2 BAD]", but this would
+slow down operations on I<all> piddles.
+We could check for C<NaN>/C<Inf> values after the operation,
+but I doubt that would be any faster.
+
+=head2 Integration with NaN
+
+When C<BADVAL_USENAN> is true, the routines in C<PDL::Ops> should
+just fall through to the C<Code> section - i.e. don't use C<BadCode> -
+for C<float> and C<double> data types.
+
+=head2 Global versus per-piddle bad values
+
+I think all that's needed is to change the routines in
+C<Basic/Core/pdlconv.c.PL>, although there's bound to be complications.
+It would also mean that the pdl structure would need to have a
+variable to store its bad value, which would mean binary incompatibility
+with previous versions of PDL with bad value support.
+
+As of 17 March 2006, PDL contains the B<experimental> C<BADVAL_PER_PDL>
+configuration option which, if selected, adds per-piddle bad values.
+
+=head2 Dataflow of the badflag
+
+Currently changes to the bad flag are propagated to the children of a piddle,
+but perhaps they should also be passed on to the parents as well. With the
+advent of per-piddle bad values we need to consider how to handle changes
+to the value used to represent bad items too.
+
+=head1 EVERYTHING ELSE
+
+The build process has been affected. The following files are
+now created during the build:
+
+ Basic/Core/pdlcore.h pdlcore.h.PL
+ pdlcore.c pdlcore.c.PL
+ pdlapi.c pdlapi.c.PL
+ Core.xs Core.xs.PL
+ Core.pm Core.pm.PL
+
+Several new files have been added:
+
+ Basic/Pod/BadValues.pod (i.e. this file)
+
+ t/bad.t
+
+ Basic/Bad/
+ Basic/Bad/Makefile.PL
+ bad.pd
+
+etc
+
+=head1 TODO/SUGGESTIONS
+
+=over 4
+
+=item *
+
+Look at using per-piddle bad values. Would mean a change to the pdl structure
+(i.e. binary incompatibility) and the routines in C<Basic/Core/pdlconv.c.PL>
+would need changing to handle this. Most other routines I<should not>
+need to be changed ...
+
+See the B<experimental> C<BADVAL_PER_PDL> option.
+
+=item *
+
+what to do about C<$b = pdl(-2); $a = log10($b)> - C<$a> should
+be set bad, but it currently isn't.
+
+=item *
+
+Allow the operations in PDL::Ops to skip the check for bad values when using
+NaN as a bad value and processing a floating-point piddle.
+Needs a fair bit of work to PDL::PP::PDLCode.
+
+=item *
+
+C<$pdl-E<gt>baddata()> now updates all the children of this piddle
+as well. However, not sure what to do with parents, since:
+
+ $b = $a->slice();
+ $b->baddata(0)
+
+doesn't mean that C<$a> shouldn't have its badvalue cleared.
+however, after
+
+ $b->baddata(1)
+
+it's sensible to assume that the parents now get flagged as
+containing bad values.
+
+PERHAPS you can only clear the bad value flag if you are NOT
+a child of another piddle, whereas if you set the flag then all
+children AND parents should be set as well?
+
+Similarly, if you change the bad value in a piddle, should this
+be propagated to parent & children? Or should you only be able to do
+this on the 'top-level' piddle? Nasty...
+
+=item *
+
+get some code set up to do benchmarks to see how much things are
+slowed down (and to check that I haven't messed things up if
+C<WITH_BADVAL> is 0/undef).
+
+=item *
+
+some of the names aren't appealing - I'm thinking of C<orig_badvalue()>
+in F<Basic/Bad/bad.pd> in particular. Any suggestions appreciated.
+
+=back
+
+=head1 AUTHOR
+
+Copyright (C) Doug Burke (djburke at cpan.org), 2000, 2006.
+
+The per-piddle bad value support is by Heiko Klein (2006).
+
+Commercial reproduction of this documentation in a different format
+is forbidden.
+
+=cut
+
diff --git a/Basic/Pod/Course.pod b/Basic/Pod/Course.pod
new file mode 100644
index 0000000..d775ecb
--- /dev/null
+++ b/Basic/Pod/Course.pod
@@ -0,0 +1,492 @@
+=head1 NAME
+
+PDL::Course - A journey through PDL's documentation, from beginner to advanced.
+
+=head1 AUTHOR, DATE
+
+This is written by David Mertens with edits by Daniel Carrera.
+
+=head1 Preface
+
+PDL's documentation is extensive. Some sections cover deep core magic
+while others cover more usual topics like IO and numerical computation.
+How are these related? Where should you begin?
+
+This document is an attempt to pull all the key PDL documentation
+together in a coherent study course, starting from the beginner level,
+up to the expert.
+
+I've broken down everything by level of expertise, and within expertise
+I've covered documentation, library, and workflow modules. The
+documentation modules are useful for what they tell you; the library
+modules are useful for the functions that they define for you; the
+workflow modules are useful for the way that they allow you to get your
+work done in new and different ways.
+
+=head1 Introductory
+
+If you are new to PDL, these documentation modules will get
+you started down the right path for using PDL.
+
+=head2 Documentation
+
+Modules that tell you how to start using PDL. Many of these
+are library modules technically, but they are included when
+you C<use PDL>, so I've included them for their documentation.
+
+After the first three, most of the docs listed below are rather
+dry. Perhaps they would be better summarized by tables or better
+synopses. You should at least scan through them to
+familiarize yourself with the basic capabilities of PDL.
+
+=over
+
+=item * L<PDL::Philosophy|PDL::Philosophy>, L<PDL::QuickStart|PDL::QuickStart>
+
+A couple of brief introductions to PDL. The second one is a bit more
+hands-on. If you are new to PDL, you should start with these.
+
+=item * L<PDL::Basic|PDL::Basic>
+
+Covers basic piddle-creation routines like C<sequence>,
+C<rvals>, and C<logxvals> to name a random few. Also covers
+C<hist> and C<transpose>.
+
+=item * L<PDL::Ufunc|PDL::Ufunc>
+
+Explains a large collection of built-in functions which, given an
+N-dimension piddle, will create a piddle with N-1 dimensions.
+
+=item * L<PDL::NiceSlice|PDL::NiceSlice>
+
+PDL came of age right around the turn of the millennium and
+NiceSlice came on the scene slightly after that. Some of
+the docs still haven't caught up. NiceSlice is the 'modern'
+way to slice and dice your piddles. Read the Synopsis, then
+scroll down to The New Slicing Syntax. After you've read to
+the bottom, return to and read the stuff at the top.
+
+=item * L<PDL::Primitive|PDL::Primitive>
+
+Defines a whole slew of useful built-in functions. These
+are the sorts of things that beginners are likely to write to
+the list and say, "How do I do xxx?" You would be well
+on your way to learning the ropes after you've gotten through
+this document.
+
+=item * Selections from L<PDL::Core|PDL::Core>
+
+Like PDL::Primitive, defines a large set of useful functions.
+Unfortunately, some of the functions are quite esoteric, but
+are mixed in with the rest of the simple and easy ones. Skim
+the whole document, skipping over the complicated functions
+for now. I would point out in particular the function
+C<approx>.
+
+=back
+
+=head2 Workflow
+
+=over
+
+=item * The L<perldl|perldl> or L<pdl2|PDL::Perldl2> Shell
+
+The Perldl Shell is a REPL (Read-Evaluate-Print-Loop, in other words,
+a prompt or shell) that allows you to work with PDL (or any Perl, for
+that matter) in 'real time', loading data from files, plotting,
+manipulating... Anything you can do in a script, you can do in the PDL
+Shell, with instant feedback!
+
+=back
+
+=head2 Libraries
+
+=over
+
+=item * L<PDL|PDL>
+
+The main workhorse module. You'll include this in nearly every PDL
+program you write.
+
+=back
+
+=head1 Normal Usage
+
+The sorts of modules that you'll likely use on a normal basis in scripts
+or from within the perldl shell. Some of these modules you may never
+use, but you should still be aware that they exist, just in case you
+need their functionality.
+
+=head2 Documentation
+
+=over
+
+=item * L<PDL::Slices|PDL::Slices>
+
+In addition to explaining the original slicing and dicing functions -
+for which you can usually use L<PDL::NiceSlice|PDL::NiceSlice> - this also covers
+many dimension-handling functions such as C<mv>, C<xchg>, and
+C<reorder>. This also thoroughly documents the C<range> function, which
+can be very powerful, and covers a number of internal functions, which
+can probably be skipped.
+
+=item * L<PDL::Indexing|PDL::Indexing>
+
+This covers a lot of the deeper conceptual ground that you'll
+need to grasp to really use PDL to its full potential. It gets
+more complex as you go along, so don't be troubled if you find
+yourself loosing interest half way through. However, reading
+this document all the way through will bring you much closer to
+PDL enlightenment.
+
+=item * L<PDL::IO|PDL::IO>
+
+PDL has quite a few IO modules, most of which are discussed
+in this summary module.
+
+=item * L<PDL::Tips|PDL::Tips>
+
+A collection of some of Tuomas's ideas for making good use of PDL.
+
+=item * L<PDL::BadValues|PDL::BadValues>
+
+Explains what bad values are and how and why they are implemented.
+
+=item * Selections from L<Inline::Pdlpp|Inline::Pdlpp>
+
+Although writing PDL::PP code is considered an Advanced topic, and is
+covered in the next section, you should be aware that it is possible
+(and surprisingly simple) to write PDL-aware code. You needn't read
+the whole thing at this point, but to get some feel for how it works,
+you should read everything up through the first example. A copy of this
+documentation is contained in L<PDL::PP-Inline>.
+
+=item * L<PDL::Objects|PDL::Objects>
+
+Explains how to subclass a piddle object.
+
+=item * L<PDL::Index|PDL::Index>
+
+This was discussed in the Preface. It is an automatically generated
+file that lists all of the PDL modules on your computer. There are many
+modules that may be on your machine but which are not documented here,
+such as bindings to the FFTW library, or GSL. Give it a read!
+
+=back
+
+=head2 Libraries
+
+=over
+
+=item * L<PDL::Complex|PDL::Complex>
+
+Complex number support. No, PDL does not have complex number
+support built into the core, but this should help you out.
+
+=item * L<PDL::FFT|PDL::FFT>
+
+PDL's own Fast Fourier Transform. If you have FFTW, then you
+should probably make use of it; this is PDL's internal
+implementation and should always be available.
+
+=item * GSL
+
+PDL does not have bindings for every sub-library in the GNU Scientific
+Library, but it has quite a few. If you have GSL installed on your
+machine then chances are decent that your PDL has the GSL bindings.
+For a full list of the GSL bindings, check L<PDL::Index|PDL::Index>.
+
+=item * L<PDL::Func|PDL::Func>
+
+A somewhat uniform interface to the different interpolation modules in PDL.
+
+=item * L<PDL::Bad|PDL::Bad>
+
+Includes some basic bad-value functionality, including functions
+to query if a piddle has bad values (C<isbad>) and functions to
+set certain elements as bad (C<setbadat> and C<setbadif>). Among
+other places, bad values are used in L<PDL::Graphics::PLplot|PDL::Graphics::PLplot>'s
+xyplot to make a gap in a line plot.
+
+=item * L<PDL::DiskCache|PDL::DiskCache>
+
+A cool module that allows you to tie a Perl array to a collection of
+files on your disk, which will be loaded into and out of memory as
+piddles. If you find yourself writing scripts to process many data files,
+especially if that data processing is not necessarily in sequential
+order, you should consider using PDL::DiskCache.
+
+=item * L<PDL::Char|PDL::Char>
+
+A PDL subclass that allows you to store and manipulate collections
+of fixed-length character strings using PDL.
+
+=item * L<PDL::Image2D|PDL::Image2D>
+
+A whole collection of methods for manipulating images whose image data
+are stored in a piddle. These include methods for convolutions
+(smoothing), polygon fills, scaling, rotation, and warping, among
+others.
+
+=item * L<PDL::ImageND|PDL::ImageND>
+
+Contains a few functions that are conceptually related to image
+processing, but which can be defined for higher-dimensional data. For
+examples this module defines high-dimensional convolution and
+interpolation, among others.
+
+=item * L<PDL::ImageRGB|PDL::ImageRGB>
+
+Defines some useful functions for working with RBG image data. It's
+not very feature-full, but it may have something you need, and if not,
+you can always add more!
+
+=item * L<PDL::Transform|PDL::Transform>
+
+Creates the transform class, which allows you to create various
+coordinate transforms. For example, if you data is a collection of
+Cartesian coordinates, you could create a transform object to convert
+them to Spherical-Polar coordinates (although many such standard
+coordinate transformations are predefined for you, in this case it's
+called C<t_spherical>).
+
+=item * L<PDL::Opt::Simplex|PDL::Opt::Simplex>
+
+This package states that it "implements the commonly used simplex
+optimization algorithm." I'm going to assume that if you need this
+algorithm then you already know what it is.
+
+=item * L<PDL::Math|PDL::Math>
+
+A collection of fairly standard math functions, like the inverse
+trigonometric functions, hyperbolic functions and their inverses, and
+others. This module is included in the standard call to C<use PDL>, but
+not in the Lite versions.
+
+=item * L<PDL::Matrix|PDL::Matrix>
+
+Provides a few functions that use the standard mathematical Matrix
+notation of row-column indexing rather than the PDL-standard column-row.
+It appears that this module has not been heavily tested with other
+modules, so although it should work with other modules, don't be
+surprised if something breaks when you use it (and feel free to offer
+any fixes that you may develop).
+
+=item * L<PDL::MatrixOps|PDL::MatrixOps>
+
+Provides many standard matrix operations for piddles, such as computing
+eigenvalues, inverting square matrices, LU-decomposition, and solving
+a system of linear equations. Though it is not built on L<PDL::Matrix|PDL::Matrix>,
+it should generally work with that module. Also, the methods
+provided by this module do not depend on external libraries such as
+Slatec or GSL.
+
+=item * L<PDL::Reduce|PDL::Reduce>
+
+Implements an interface to all the functions that return piddles with
+one less dimension (for example, C<sumover>), such that they can be
+called by suppling their name, as a string.
+
+=back
+
+=head2 Workflow
+
+=over
+
+=item * L<PDL::AutoLoader|PDL::AutoLoader>
+
+Enables Matlab-style autoloading. When you call an unknown
+function, instead of complaining and croaking, PDL will go hunt
+around in the directories you specify in search of a like-named
+file. Particularly useful when used with the Perldl Shell.
+
+=item * L<PDL::Dbg|PDL::Dbg>
+
+Declares the C<px> function, which can be handy for debugging your
+PDL scripts and/or perldl shell commands.
+
+=item * L<PDL::Options|PDL::Options>
+
+Suppose you define a powerful, versatile function. Chances are good
+that you'll accept the arguments in the form of a hash or hashref. Now
+you face the problem of processing that hashref. L<PDL::Options|PDL::Options>
+assists you in writing code to process those options. (You'd think
+Perl would have tons of these sorts of modules lying around, but I
+couldn't find any.) Note this module does not depend on PDL for its
+usage or installation.
+
+=item * L<PDL::pdldoc|PDL::pdldoc>
+
+Ever fired-up the perldl shell just to look up the help for a particular
+function? You can use C<pdldoc> instead. This shell script extracts
+information from the help index without needing to start the perldl
+shell.
+
+=back
+
+=head1 Advanced Usage
+
+The sorts of modules and documentation that you'll use if you write
+modules that use PDL, or if you work on PDL maintenance. These modules
+can be difficult to use, but enable you to tackle some of your harder
+problems.
+
+=over
+
+=item * L<PDL::Lite|PDL::Lite>, L<PDL::LiteF|PDL::LiteF>
+
+Lite-weight replacements for C<use PDL>, from the standpoint of
+namespace pollution and load time.
+
+=item * L<Inline::Pdlpp|Inline::Pdlpp>
+
+This was mentioned earlier. Before you begin reading about L<PDL::PP|PDL::PP>
+(next), you should remind yourself about how to use this.
+L<Inline::Pdlpp|Inline::Pdlpp> will help you experiment with L<PDL::PP|PDL::PP> without having
+to go through the trouble of building a module and constructing
+makefiles (but see L<PDL::pptemplate|PDL::pptemplate> for help on that).
+
+=item * L<PDL::PP|PDL::PP>
+
+The PDL Pre-Processor, which vastly simplifies making you
+C or Fortran code play with Perl and piddles. Most of PDL's
+basic functionality is written using PDL::PP, so if you're
+thinking about how you might integrate some numerical
+library written in C, look no further.
+
+=item * L<PDL::pptemplate|PDL::pptemplate>
+
+A script that automates the creation of modules that use L<PDL::PP|PDL::PP>,
+which should make your life as a module author a bit simpler.
+
+=item * L<PDL::CallExt|PDL::CallExt>
+
+Allows you to call functions using external shared
+libraries. This is an alternative to using L<PDL::PP|PDL::PP>.
+The major difference between PDL::PP and PDL::CallExt is
+that the former will handle threading over implicit thread
+dimensions for you, whereas PDL::CallExt simply calls an
+external function. PDL::PP is generally the recommended
+way to interface your code with PDL, but it wouldn't be Perl
+if there wasn't another way to do it.
+
+=item * PDL::Config
+
+Defines the C<%PDL::Config> hash, which has lots of useful
+information pertinent to your PDL build.
+
+=item * L<PDL::Doc|PDL::Doc>
+
+Explanation of the PDL documentation conventions, and an
+interface to the PDL Documentation parser. Following these
+guidelines when writing documentation for PDL functions will
+ensure that your wonderful documentation is accessible from
+the perldl shell and from calls to C<barf>. (Did you notice
+that C<barf> used your documentation? Time to reread
+L<PDL::Core|PDL::Core>...)
+
+=item * L<PDL::Exporter|PDL::Exporter>
+
+A simple replacement for the standard L<Exporter|Exporter> module.
+The only major difference is that the default imported modules
+are those marked ':Func'.
+
+=item * L<PDL::Types|PDL::Types>
+
+Defines some useful functions for getting a piddle's type, as well as
+getting information about that type.
+
+=item * PDL::Version
+
+Simply defines the scalar C<$PDL::Version::Version> with the current
+version of PDL, as defined in PDL.pm. This is most useful if you
+distribute your own module on CPAN, use L<PDL::Lite|PDL::Lite> or L<PDL::LiteF|PDL::LiteF>
+and want to make sure that your users have a recent-enough version of
+PDL. Since the variable is defined in PDL.pm, you don't need this
+module if you C<use PDL>.
+
+=back
+
+=head1 Expert Usage
+
+=over
+
+=item * L<PDL::Core::Dev|PDL::Core::Dev>
+
+Provides some decently useful functions that are pretty
+much only needed by the PDL Porters.
+
+=item * L<PDL::API|PDL::API>
+
+Explains how to make a piddle I<by hand>, from Perl or your
+C source code, using the PDL API.
+
+=item * L<PDL::Internals|PDL::Internals>
+
+Explains the nitty-gritty of the PDL data structures. After reading
+this (a few times :), you should be able to create a piddle completely
+from scratch (i.e. without using the PDL API). Put a little
+differently, if you want to understand how PDL::PP works, you'll need
+to read this.
+
+=back
+
+=begin questionable
+
+=head1 Other Documents
+
+These documents are part of the PDL distribution but don't
+seem to fit anywhere above.
+
+=over
+
+=item * L<PDL::Delta|PDL::Delta>
+
+Explains how things changed from PDL 1.x to PDL 2.x
+
+=item * L<PDL::Graphics2D|PDL::Graphics2D>
+
+Supposed to be a uniform interface to plotting 2D graphics.
+
+=item * L<PDL::Dataflow|PDL::Dataflow>
+
+Covers data flow, a cool feature to be sure, but from what I can tell
+it is not currently supported.
+
+=item * L<PDL::Lvalues|PDL::Lvalues>
+
+PDL started before Perl 5.6, which introduce subs that could return
+lvalues. I'm pretty sure that this module has been rolled into the core
+and is no longer necessary.
+
+
+=item * L<PDL::Tests|PDL::Tests>
+
+Defines a few PDL::PP tests. This code should be moved into the testing
+suite, but hasn't been...
+
+=item * L<PDL::Ops|PDL::Ops>
+
+Defines the standard Perl-overloadable operators, like + and .=, for
+example. Since pretty much all of these operators and functions are
+discussed elsewhere, there's usually no need to read this documentation
+or use this module.
+
+=item * L<PDL::Gaussian|PDL::Gaussian>
+
+An apparently broken module to help generate and work with Gaussian
+distributions.
+
+=back
+
+=end questionable
+
+
+=head1 COPYRIGHT
+
+Copyright 2010 David Mertens (dcmertens.perl at gmail.com). You can
+distribute and/or modify this document under the same terms as the
+current Perl license.
+
+See: http://dev.perl.org/licenses/
+
diff --git a/Basic/Pod/Dataflow.pod b/Basic/Pod/Dataflow.pod
new file mode 100644
index 0000000..f6a2a32
--- /dev/null
+++ b/Basic/Pod/Dataflow.pod
@@ -0,0 +1,261 @@
+=head1 NAME
+
+PDL::Dataflow -- description of the dataflow philosophy
+
+=head1 SYNOPSIS
+
+ pdl> $a = zeroes(10);
+ pdl> $b = $a->slice("2:4:2");
+ pdl> $b ++;
+ pdl> print $a;
+ [0 0 1 0 1 0 0 0 0 0]
+
+
+=head1 WARNING
+
+Dataflow is very experimental. Many features of it are disabled
+for 2.0, particularly families for one-directional
+dataflow. If you wish to use one-directional dataflow for
+something, please contact the author first and we'll work out
+how to make it functional again.
+
+Two-directional dataflow (which implements ->slice() etc.)
+is fully functional, however. Just about any function which
+returns some subset of the values in some piddle will make a binding
+so that
+
+ $a = some piddle
+ $b = $a->slice("some parts");
+ $b->set(3,3,10);
+
+also changes the corresponding element in $a. $b has become effectively
+a window to some sub-elements of $a. You can also define your own routines
+that do different types of subsets. If you don't want $b to be a window
+to $a, you must do
+
+ $b = $a->slice("some parts")->copy;
+
+The copying turns off all dataflow between the two piddles.
+
+The difficulties with one-directional
+dataflow are related to sequences like
+
+ $b = $a + 1;
+ $b ++;
+
+where there are several possible outcomes and the semantics get a little
+murky.
+
+=head1 DESCRIPTION
+
+Dataflow is new to PDL2.0. The basic philosophy
+behind dataflow is that
+
+ > $a = pdl 2,3,4;
+ > $b = $a * 2;
+ > print $b
+ [2 3 4]
+ > $a->set(0,5);
+ > print $b;
+ [10 3 4]
+
+should work. It doesn't. It was considered that doing this
+might be too confusing for novices and occasional users of the language.
+Therefore, you need to explicitly turn on dataflow, so
+
+ > $a = pdl 2,3,4;
+ > $a->doflow();
+ > $b = $a * 2;
+ ...
+
+produces the unexpected result. The rest of this documents
+explains various features and details of the dataflow implementation.
+
+=head1 Lazy evaluation
+
+When you calculate something like the above
+
+ > $a = pdl 2,3,4;
+ > $a->doflow();
+ > $b = $a * 2;
+
+nothing will have been calculated at this point. Even the memory for
+the contents of $b has not been allocated. Only the command
+
+ > print $b
+
+will actually cause $b to be calculated. This is important to bear
+in mind when doing performance measurements and benchmarks as well
+as when tracking errors.
+
+There is an explanation for this behaviour: it may save cycles
+but more importantly, imagine the following:
+
+ > $a = pdl 2,3,4;
+ > $b = pdl 5,6,7;
+ > $c = $a + $b;
+ ...
+ > $a->resize(4);
+ > $b->resize(4);
+ > print $c;
+
+Now, if $c were evaluated between the two resizes, an error condition
+of incompatible sizes would occur.
+
+What happens in the current version is that resizing $a raises
+a flag in $c: "PDL_PARENTDIMSCHANGED" and $b just raises the same flag
+again. When $c is next evaluated, the flags are checked and it is found
+that a recalculation is needed.
+
+Of course, lazy evaluation can sometimes make debugging more painful
+because errors may occur somewhere where you'd not expect them.
+A better stack trace for errors is in the works for PDL, probably
+so that you can toggle a switch $PDL::traceevals and get a good trace
+of where the error actually was.
+
+=head1 Families
+
+This is one of the more intricate concepts of one-directional dataflow.
+Consider the following code ($a and $b are pdls that have dataflow enabled):
+
+ $c = $a + $b;
+ $e = $c + 1;
+ $d = $c->diagonal();
+ $d ++;
+ $f = $c + 1;
+
+What should $e and $f contain now? What about when $a is changed
+and a recalculation is triggered.
+
+In order to make dataflow work like you'd expect, a rather strange
+concept must be introduced: families. Let us make a diagram:
+
+ a b
+ \ /
+ c
+ /|
+ / |
+ e d
+
+This is what PDL actually has in memory after the first three lines.
+When $d is changed, we want $c to change but we don't want $e to change
+because it already is on the graph. It may not be clear now why you don't
+want it to change but if there were 40 lines of code between the 2nd
+and 4th lines, you would. So we need to make a copy of $c and $d:
+
+ a b
+ \ /
+ c' . . . c
+ /| |\
+ / | | \
+ e d' . . . d f
+
+Notice that we primed the original c and d, because they do not correspond
+to the objects in $c and $d any more. Also, notice the dotted lines
+between the two objects: when $a is changed and this diagram is re-evaluated,
+$c really does get the value of c' with the diagonal incremented.
+
+To generalize on the above, whenever a piddle is mutated i.e.
+when its actual *value* is forcibly changed (not just the reference:
+
+ $d = $d + 1
+
+would produce a completely different result ($c and $d would not be bound
+any more whereas
+
+ $d .= $d + 1
+
+would yield the same as $d++), a "family" consisting of all other piddles
+joined to the mutated piddle by a two-way transformation is created
+and all those are copied.
+
+All slices or transformations that simply select a subset of the original
+pdl are two-way. Matrix inverse should be. No arithmetic
+operators are.
+
+=head1 Sources
+
+What you were told in the previous section is not quite true:
+the behaviour described is not *always* what you want. Sometimes you
+would probably like to have a data "source":
+
+ $a = pdl 2,3,4; $b = pdl 5,6,7;
+ $c = $a + $b;
+ line($c);
+
+Now, if you know that $a is going to change and that you want
+its children to change with it, you can declare it into a data source
+(XXX unimplemented in current version):
+
+ $a->datasource(1);
+
+After this, $a++ or $a .= something will not create a new family
+but will alter $a and cut its relation with its previous parents.
+All its children will follow its current value.
+
+So if $c in the previous section had been declared as a source,
+$e and $f would remain equal.
+
+=head1 Binding
+
+A dataflow mechanism would not be very useful without the ability
+to bind events onto changed data. Therefore, we provide such a mechanism:
+
+ > $a = pdl 2,3,4
+ > $b = $a + 1;
+ > $c = $b * 2;
+ > $c->bind( sub { print "A now: $a, C now: $c\n" } )
+ > PDL::dowhenidle();
+ A now: [2,3,4], C now: [6 8 10]
+ > $a->set(0,1);
+ > $a->set(1,1);
+ > PDL::dowhenidle();
+ A now: [1,1,4], C now: [4 4 10]
+
+Notice how the callbacks only get called during PDL::dowhenidle.
+An easy way to interface this to Perl event loop mechanisms
+(such as Tk) is being planned.
+
+There are many kinds of uses for this feature: self-updating graphs,
+for instance.
+
+Blah blah blah XXX more explanation
+
+=head1 Limitations
+
+Dataflow as such is a fairly limited addition on top of Perl.
+To get a more refined addition, the internals of Perl need to be
+hacked a little. A true implementation would enable flow of everything,
+including
+
+=over 12
+
+=item data
+
+=item data size
+
+=item datatype
+
+=item operations
+
+=back
+
+At the moment we only have the first two (hey, 50% in a couple of months
+is not bad ;) but even this is useful by itself. However, especially
+the last one is desirable since it would add the possibility
+of flowing closures from place to place and would make many things
+more flexible.
+
+To get the rest working, the internals of dataflow probably need to
+be changed to be a more general framework.
+
+Additionally, it would be nice to be able to flow data in time,
+lucid-like (so you could easily define all kinds of signal processing
+things).
+
+=head1 AUTHOR
+
+Copyright(C) 1997 Tuomas J. Lukka (lukka at fas.harvard.edu).
+Redistribution in the same form is allowed provided that the copyright
+notice stays intact but reprinting requires
+a permission from the author.
diff --git a/Basic/Pod/Delta.pod b/Basic/Pod/Delta.pod
new file mode 100644
index 0000000..77add8b
--- /dev/null
+++ b/Basic/Pod/Delta.pod
@@ -0,0 +1,63 @@
+=head1 NAME
+
+PDL::Delta - PDL changes between V1.0 and V2.0
+
+
+=head1 DESCRIPTION
+
+This file is an attempt to list the major user-visible changes
+between PDL versions 1.0 and 2.0.
+
+
+=head1 Core Changes
+
+=head2 Piddles are not hashes any more:
+
+ $a = zeroes 10,10;
+ $$a{FOO} = "bar"
+
+doesn't work. They are currently scalar references (to opaque
+C structures in finer terms) because of speed as well as
+syntactic issues. If you want to have a hash, use
+
+ $a->hdr()
+
+which returns a reference to an anonymous hash. Also,
+subclassing works if you store a piddle in the hash member ``PDL''.
+
+There are also many core enhancements to support Dataflow and
+Slicing tricks, but these do not introduce any incompatibilities.
+
+=head2 Incompatible Changes vs 1.11
+
+=over 4
+
+=item rgrep
+
+Order of the arguments has changed.
+
+=item copy method
+
+No longer copies the header. This may not be a misfeature.
+
+=back
+
+=head1 Documentation Changes
+
+Many of the base and library pods were updated.
+
+=head1 SEE ALSO
+
+The F<Changes> file for exhaustive details on what changed.
+
+The F<INSTALL> file for how to build PDL.
+
+The F<README> file for general stuff.
+
+=head1 HISTORY
+
+pdldelta was inspired by I<perldelta> man page in the Perl
+5.004 distribution.
+
+
+
diff --git a/Basic/Pod/FAQ.pod b/Basic/Pod/FAQ.pod
new file mode 100644
index 0000000..b184d51
--- /dev/null
+++ b/Basic/Pod/FAQ.pod
@@ -0,0 +1,1585 @@
+
+=head1 NAME
+
+PDL::FAQ - Frequently asked questions about PDL
+
+
+=head1 VERSION
+
+Current FAQ version: 1.004
+
+
+=head1 DESCRIPTION
+
+This is version 1.004 of the PDL FAQ, a collection of frequently
+asked questions about PDL - the Perl Data Language.
+
+
+
+
+=head1 ABOUT THIS DOCUMENT
+
+
+=head2 Q: 1.1 Where to find this document
+
+
+You can find the latest version of this document at
+L<http://pdl.perl.org/?docs=FAQ&title=Frequently%20Asked%20Questions> .
+
+
+=head2 Q: 1.2 How to contribute to this document
+
+
+This is a considerably reworked version of the PDL FAQ. As
+such many errors might have crept in and many updates might
+not have made it in. You are explicitly encouraged to let us
+know about questions which you think should be answered in
+this document but currently aren't.
+
+Similarly, if you think parts of this document are
+unclear, please tell the FAQ maintainer about it. Where
+a specific answer is taken in full from someones posting
+the authorship should be indicated, let the FAQ maintainer
+know if it isn't. For more general information explicit
+acknowledgment is not made in the text, but rather there
+is an incomplete list of contributors at the end of this
+document. Please contact the FAQ maintainer if you feel
+hard done by.
+
+Send your comments, additions, suggestions or corrections
+to the PDL mailing list at perldl at jach.hawaii.edu. See Q: 3.2
+below for instructions on how to join the mailing lists.
+
+
+
+
+=head1 GENERAL QUESTIONS
+
+
+=head2 Q: 2.1 What is PDL ?
+
+
+PDL stands for
+I<Perl Data Language> . To say it with the words of Karl Glazebrook,
+initiator of the PDL project:
+
+
+ The PDL concept is to give standard perl5 the ability
+ to COMPACTLY store and SPEEDILY manipulate the large
+ N-dimensional data sets which are the bread and butter
+ of scientific computing. e.g. $a=$b+$c can add two
+ 2048x2048 images in only a fraction of a second.
+
+
+It provides tons of useful
+functionality for scientific and numeric analysis.
+
+For readers familiar with other scientific data evaluation packages it
+may be helpful to add that PDL is in many respects similar to IDL,
+MATLAB and similar packages. However, it tries to improve on a number
+of issues which were perceived (by the authors of PDL) as shortcomings
+of those existing packages.
+
+
+
+=head2 Q: 2.2 Who supports PDL? Who develops it?
+
+
+PDL is supported by its users. General informal support for PDL
+is provided through the PDL mailing list (perldl at jach.hawaii.edu ,
+see below).
+
+As a Perl extension (see Q: 2.5 below) it is devoted to the idea of free and
+open development put forth by the Perl community. PDL was and is being
+actively developed by a loosely knit group of people around the world who
+coordinate their activities through the PDL development mailing list
+(pdl-porters at jach.hawaii.edu , see Q: 3.2 below). If you would like to join in the
+ongoing efforts to improve PDL please join this list.
+
+
+=head2 Q: 2.3 Why yet another Data Language ?
+
+
+There are actually several reasons and everyone should decide for
+himself which are the most important ones:
+
+=over 4
+
+=item *
+
+PDL is "free software". The authors of PDL think
+that this concept has several advantages: everyone has
+access to the sources -> better debugging, easily
+adaptable to your own needs, extensible for your purposes,
+etc... In comparison with commercial packages such as MATLAB
+and IDL this is of considerable importance for workers who
+want to do some work at home and cannot afford the
+considerable cost to buy commercial packages for personal
+use.
+
+=item *
+
+PDL is based on a powerful and well designed scripting
+language: Perl. In contrast to other scientific/numeric data
+analysis languages it has been designed using the features of
+a proven language instead of having grown into existence from
+scratch. Defining the control structures while features were
+added during development leads to languages that often appear
+clumsy and badly planned for most existing packages with
+similar scope as PDL.
+
+=item *
+
+Using Perl as the basis a PDL programmer has all the
+powerful features of Perl at his hand, right from the
+start. This includes regular expressions, associative arrays
+(hashes), well designed interfaces to the operating system,
+network, etc. Experience has shown that even in mainly
+numerically oriented programming it is often extremely handy
+if you have easy access to powerful semi-numerical or
+completely non-numerical functionality as well. For example,
+you might want to offer the results of a complicated
+computation as a server process to other processes on the
+network, perhaps directly accepting input from other
+processes on the network. Using Perl and existing Perl
+extension packages things like this are no problem at all
+(and it all will fit into your "PDL script").
+
+=item *
+
+Extremely easy extensibility and interoperability as PDL is
+a Perl extension; development support for Perl extensions is
+an integral part of Perl and there are already numerous
+extensions to standard Perl freely available on the network.
+
+=item *
+
+Integral language features of Perl (regular expressions,
+hashes, object modules) immensely facilitated development
+and implementation of key concepts of PDL. One of the most
+striking examples for this point is probably L<PDL::PP|PDL::PP>
+(see Q: 6.16 below), a code generator/parser/pre-processor that
+generates PDL functions from concise descriptions.
+
+=item *
+
+None of the existing data languages follow the Perl language
+rules, which the authors firmly believe in:
+
+=over 4
+
+=item *
+
+TIMTOWTDI: There is more than one way to do it.
+Minimalist languages are interesting for computer
+scientists, but for users, a little bit of redundancy
+makes things wildly easier to cope with and allows
+individual programming styles - just as people speak in
+different ways. For many people this will undoubtedly be
+a reason to avoid PDL ;)
+
+=item *
+
+Simple things are simple, complicated things possible:
+Things that are often done should be easy to do in the language,
+whereas seldom done things shouldn't be too cumbersome.
+
+=back
+
+All existing languages violate at least one of these rules.
+
+=item *
+
+As a project for the future PDL should be able to use super
+computer features, e.g. vector capabilities/parallel processing,
+GPGPU acceleration. This will probably be achieved by having
+L<PDL::PP|PDL::PP> (see Q: 6.16 below) generate appropriate code
+on such architectures to exploit these features.
+
+=item *
+
+[ fill in your personal 111 favourite reasons here...]
+
+=back
+
+
+=head2 Q: 2.4 What is PDL good for ?
+
+
+Just in case you do not yet know what the main features of PDL are and
+what one could do with them, here is a (necessarily selective) list of
+key features:
+
+PDL is well suited for matrix computations, general handling
+of multidimensional data, image processing, general scientific
+computation, numerical applications. It supports I/O for many
+popular image and data formats, 1D (line plots), 2D (images)
+and 3D (volume visualization, surface plots via OpenGL - for
+instance implemented using Mesa or video card OpenGL drivers),
+graphics display capabilities and implements many numerical and
+semi-numerical algorithms.
+
+Through the powerful pre-processor it is also easy to interface Perl
+to your favorite C routines, more of that further below.
+
+
+=head2 Q: 2.5 What is the connection between PDL and Perl ?
+
+
+PDL is a Perl5 extension package. As such it needs an existing Perl5
+installation (see below) to run. Furthermore, much of PDL is written in
+Perl (+ some core functionality that is written in C). PDL programs
+are (syntactically) just Perl scripts that happen to use some of the
+functionality implemented by the package "PDL".
+
+
+=head2 Q: 2.6 What do I need to run PDL on my machine ?
+
+
+Since PDL is just a Perl5 package you need first of
+all an installation of Perl5 on your machine. As of this
+writing PDL requires version 5.8 of perl, or higher. More
+information on where and how to get a Perl installation
+can be found at the Perl home page L<http://www.perl.org>
+and at many CPAN sites (if you do not know what I<CPAN>
+is, check the answer to the next question).
+
+To build PDL you also need a working C compiler, support
+for Xsubs, and the package Extutils::MakeMaker. If you
+don't have a compiler there might be a binary distribution
+available, see "Binary distributions" below.
+
+If you can (or cannot) get PDL working on a new (previously
+unsupported) platform we would like to hear about it. Please,
+report your success/failure to the PDL mailing list at
+perldl at jach.hawaii.edu . We will do our best to assist
+you in porting PDL to a new system.
+
+
+=head2 Q: 2.7 Where do I get it?
+
+
+PDL is available as source distribution in the
+I<Comprehensive Perl Archive Network> (or CPAN) and from the
+sourceforge.net project page at L<https://sourceforge.net/projects/pdl/files/>.
+The CPAN archives contains not only the PDL distribution but
+also just about everything else that is Perl-related. CPAN is
+mirrored by dozens of sites all over the world. The main site
+is L<http://www.cpan.org>, and local CPAN sites (mirrors) can be
+found there. Within CPAN you find the latest released version of
+PDL in the directory /modules/by-module/PDL/. PDL's homepage is at
+L<http://pdl.perl.org> and the latest version can also be downloaded
+from there.
+
+
+=head2 Q: 2.8 What do I have to pay to get PDL?
+
+
+We are delighted to be able to give you the nicest possible
+answer on a question like this: PDL is *free software* and all
+sources are publicly available. But still, there are some
+copyrights to comply with. So please, try to be as nice as we
+(the PDL authors) are and try to comply with them.
+
+Oh, before you think it is *completely* free: you
+have to invest some time to pull the distribution from the net,
+compile and install it and (maybe) read the manuals.
+
+
+
+=head1 GETTING HELP/MORE INFORMATION
+
+
+
+=head2 Q: 3.1 Where can I get information on PDL?
+
+
+The complete PDL documentation is available with the PDL distribution.
+Use the command C<perldoc PDL> to start learning about PDL.
+
+The easiest way by far, however, to get familiar with PDL is to use
+the PDL on-line help facility from within the PDL
+shell, C<pdl2> Just type C<pdl2> at your system prompt. Once you are inside the
+C<pdl2> shell type C<help> . Using the C<help> and C<apropos> commands
+inside the shell you should be able to find the way round the
+documentation.
+
+Even better, you can immediately try your newly acquired
+knowledge about PDL by issuing PDL/Perl commands directly at the command
+line. To illustrate this process, here is the record of a typical
+C<pdl2> session of a PDL beginner (lengthy output is only symbolically
+reproduced in braces ( <... ...> ) ):
+
+ unix> pdl2
+ pdl> help
+ < ... help output ... >
+ pdl> help PDL::QuickStart
+ < ... perldoc page ... >
+ pdl> $a = pdl (1,5,7.3,1.0)
+ pdl> $b = sequence float, 4, 4
+ pdl> help inner
+ < ... help on the 'inner' function ... >
+ pdl> $c = inner $a, $b
+ pdl> p $c
+ [22.6 79.8 137 194.2]
+
+For further sources of information that are accessible through the
+Internet see next question.
+
+
+=head2 Q: 3.2 Are there other PDL information sources on the Internet?
+
+
+First of all, for all purely Perl-related questions there are
+tons of sources on the net. Good points to start are
+L<http://www.perl.com> and L<http://www.perl.org> .
+
+The PDL home site can be accessed by pointing your web browser to
+L<http://pdl.perl.org> . It has tons of goodies for anyone interested in PDL:
+
+=over 4
+
+=item *
+
+PDL distributions
+
+=item *
+
+On-line documentation
+
+=item *
+
+Pointers to an HTML archive of the PDL mailing lists
+
+=item *
+
+A list of platforms on which PDL has been successfully tested.
+
+=item *
+
+News about recently added features, ported libraries, etc.
+
+=item *
+
+Name of the current pumpkin holders for the different PDL modules (if
+you want to know what that means you better had a look at the web
+pages).
+
+=back
+
+If you are interested in PDL in general you can join the PDL mailing
+list perldl at jach.hawaii.edu. This is a forum to discuss programming
+issues in PDL, report bugs, seek assistance with PDL related problems,
+etc. To subscribe, fill out the form at
+L<http://mailman.jach.hawaii.edu/mailman/listinfo/perldl> .
+
+A searchable archive and a hypertext version of the traffic on this
+list (1997-2004) can be found at
+L<http://www.xray.mpe.mpg.de/mailing-lists/perldl/> . More recent
+messages (since June 2005) can be found at
+L<http://mailman.jach.hawaii.edu/mailman/listinfo/perldl> .
+
+If you are interested in all the technical details of the ongoing PDL
+development you can join the PDL developers mailing list
+pdl-porters at jach.hawaii.edu . To subscribe, fill out the form at
+L<http://mailman.jach.hawaii.edu/mailman/listinfo/pdl-porters> .
+
+A searchable archive and a hypertext version
+of the traffic on this list (1997-2004) can be found at
+L<http://www.xray.mpe.mpg.de/mailing-lists/pdl-porters/> . More recent messages
+(since June 2005) can be found at
+L<http://mailman.jach.hawaii.edu/mailman/listinfo/pdl-porters> .
+
+Cross-posting between these lists should be avoided unless there is a
+I<very> good reason for doing that.
+
+
+=head2 Q: 3.3 What is the current version of PDL ?
+
+
+As of this writing (FAQ version 1.004 of 16 Sep 2013) the latest stable version
+is 2.006. The latest stable version should always be available from a CPAN
+mirror site near you (see L<Question 2.7|"Q: 2.7 Where do I get it?"> for
+info on where to get PDL).
+
+The most current (possibly unstable) version of PDL can be obtained
+from the Git repository, see L<Question 4.10|"Q: 4.9 How do I get PDL via Git?">
+and periodic CPAN developers releases of the Git code will be made for testing
+purposes and more general availability. The current post-PDL-2.006 developers
+release of PDL is available as F<CHM/PDL-2.006_07.tar.gz> .
+
+
+=head2 Q: 3.4 I want to contribute to the further development of PDL. How can I help?
+
+
+Two ways that you could help almost immediately are (1) participate
+in CPAN Testers for PDL and related modules, and (2) proofreading and
+clarifying the PDL documentation so that it is most useable for PDL
+users, especially new users.
+
+To participate in CPAN Testers and contribute test reports, the page
+L<http://wiki.cpantesters.org/wiki/QuickStart> has instructions for
+starting for either C<CPAN> or C<CPANPLUS> users.
+
+If you have a certain project in mind you should check if somebody
+else is already working on it or if you could benefit from existing
+modules. Do so by posting your planned project to the PDL developers
+mailing list at pdl-porters at jach.hawaii.edu . See the subscription
+instructions in L<Question 3.2|"Q: 3.2 Are there other PDL information sources on the Internet?">.
+We are always looking for people to write code and/or documentation ;).
+
+
+=head2 Q: 3.5 I think I have found a bug in the current version of PDL. What shall I do?
+
+
+First, make sure that the bug/problem you came across has not already been
+dealt with somewhere else in this FAQ. Secondly, you can check the
+searchable archive of the PDL mailing lists to find whether
+this bug has already been discussed. If you still haven't found
+any explanations you can post a bug report to perldl at jach.hawaii.edu ,
+or through the Bugs link on L<http://pdl.perl.org> . See the F<BUGS>
+file in the PDL distribution for what information to include. If
+you are unsure, discussions via the perldl mailing list can be
+most helpful.
+
+
+
+=head1 INSTALLATION
+
+
+
+=head2 Q: 4.1 I have problems installing PDL. What shall I do?
+
+
+First make sure you have read the file F<INSTALL> in the distribution.
+This contains a list of common problems which are unnecessary to repeat
+here.
+
+Next, check the file F<perldl.conf> to see if by editing the
+configuration options in that file you will be able to successfully
+build PDL. Some of the modules need additional software installed,
+please refer to the file F<DEPENDENCIES> for further details. Make sure
+to edit the location of these packages in perldl.conf if you have them
+in non-standard locations.
+
+N.B. Unix shell specific: If you would like to save an edited perldl.conf
+for future builds just copy it as F<~/.perldl.conf> into your home directory
+where it will be picked up automatically during the PDL build process.
+
+Also, check for another, pre-existing version of PDL on the build
+system. Multiple PDL installs in the same PATH or @INC can cause
+puzzling test or build failures.
+
+If you still can't make it work properly please submit a bug
+report including detailed information on the problems you
+encountered to the perldl mailing list ( perldl at jach.hawaii.edu ,
+see also above). Response is often rapid.
+
+
+=head2 Q: 4.2 Are there configuration files for PDL I have to edit?
+
+
+Most users should not have to edit any configuration files manually.
+However, in some cases you might have to supply some information
+about awkwardly placed include files/libraries or you might want
+to explicitly disable building some of the optional PDL modules.
+Check the files F<INSTALL> and F<perldl.conf> for details.
+
+If you had to manually edit F<perldl.conf> and are happy with the
+results you can keep the file handy for future
+reference. Place it in F<~/.perldl.conf> where it will be picked
+up automatically or use C<perl Makefile.PL PDLCONF=your_file_name>
+next time you build PDL.
+
+
+=head2 Q: 4.3 Do I need other software for successful operation?
+
+
+For the basic PDL functionality you don't need any
+additional software. However, some of the optional PDL
+modules included in the distribution (notably most graphics
+and some I/O modules) require certain other
+libraries/programs to be installed. Check the file
+F<DEPENDENCIES> in the distribution for details and directions
+on how to get these.
+
+
+=head2 Q: 4.4 How can I install PDL in a non-standard location?
+
+
+To install PDL in a non-standard location, use the INSTALL_BASE
+option in the C<perl Makefile.PL> configure step. For example,
+C<perl Makefile.PL INSTALL_BASE=/mydir/perl5> will configure PDL
+to install into the tree rooted at C</mydir/perl5>. For more
+details see L<perlfaq8/"How do I keep my own module/library directory?">
+and subsequent sections. Another alternative is to use L<local::lib>
+to do the heavy listing for the needed configuration.
+
+
+=head2 Q: 4.5 How can I force a completely clean installation?
+
+
+To guarantee a completely clean installation of PDL, you will need
+to first delete the current installation files and folders. These
+will be all directories named C<PDL> in the Perl C<@INC> path,
+files named C<*Pdlpp*> in any C<Inline> directories, and the
+programs C<pdl, pdldoc, pdl2, perldl, and pptemplate>. Then just build
+and install as usual. This is much easier to keep track of if you
+always install C<PDL> into a non-standard location. See Q: 4.4 above.
+
+
+
+=head1 BINARY DISTRIBUTIONS
+
+
+
+=head2 Q: 4.5 What binary distributions are available?
+
+
+Information about binary distributions of PDL can be found on
+L<http://pdl.perl.org> . At present there are binary distributions
+of PDL for Linux (RedHat and Debian), FreeBSD, Mac OS X and Windows,
+though they might not be the most recent version.
+
+If someone is interested in providing binary distributions for other
+architectures, that would be very welcome. Let us know on the
+pdl-porters at jach.hawaii.edu mailing list. Also check your Linux
+distribution's package manager as many now include PDL. PPMs
+for win32 versions (both 32bit and 64bit) are also available.
+
+
+=head2 Q: 4.6 Does PDL run on Linux? (And what about packages?)
+
+
+Yes, PDL does run on Linux and indeed much of the development
+has been done under Linux. On L<http://pdl.perl.org> you can find
+links to packages for some of the major distributions. Also
+check your distribution's package manager (yum, apt, urpmi, ...)
+as PDL is now found by many of these.
+
+
+=head2 Q: 4.7 Does PDL run under Windows?
+
+
+PDL builds fine on Win32 using MinGW or Microsoft compilers. See
+the F<win32/INSTALL> file in the PDL source distribution for details.
+Other compilers have not been tested--input is welcome. There is
+also a distribution of PDL through ActiveState's ppm, though it
+might not always be the latest version. PDL-2.006 builds out of
+the box on Strawberry Perl and ActiveState Perl.
+
+
+
+=head1 CVS, GIT, AND ON-GOING DEVELOPMENT
+
+
+
+=head2 Q: 4.8 Can I get PDL via CVS?
+
+
+No. PDL development was conducted with a CVS repository from December
+1999 to April 2009. In April 2009 the project switched to the
+Git version control system (see L<http://git-scm.com>).
+
+
+=head2 Q: 4.9 How do I get PDL via Git?
+
+
+Assume you have Git installed on your system and want to download the
+project source code into the directory C<PDL>. To get read-only access
+to the repository, you type at the command line
+
+ git clone git://git.code.sf.net/p/pdl/code pdl-code
+
+For official PDL developers, to get read/write access to the repository
+type at the command line
+
+ git clone ssh://USERNAME@git.code.sf.net/p/pdl/code pdl-code
+
+
+=head2 Q: 4.10 I had a problem with the Git version, how do I check if someone has submitted a patch?
+
+
+The Sourceforge system contains a patch-manager which contains patches
+that have not yet been applied to the distribution. This can be
+accessed via the Tickets menu at PDL's Sourceforge project page
+L<http://sourceforge.net/projects/pdl> .
+
+In addition, if you are not subscribing to the mailing list,
+check the archive of the C<pdl-porters> and C<perldl> mailing lists.
+See L<Question 3.2|"Q: 3.2 Are there other PDL information sources on the Internet?"> for details.
+
+
+=head2 Q: 4.11 I have gotten developer access to Git, how do I upload my changes?
+
+
+The first thing you should do is to read the Git documentation and
+learn the basics about Git. There are many sources available online.
+But here are the basics:
+
+Before you upload your changes, commit them to YOUR repository
+
+ git add <file1> <file2> ...
+ git commit
+
+or combine these two with
+
+ git commit -a
+
+Then pull in any changes others have made
+
+ git pull origin
+
+Test the PDL before you push it to the main repository. If the
+code is broken for you, then it is most likely broken for others
+and they won't be happy to have their recent PDL fail to build!
+NOTE: git makes it very easy to maintain a separate branch of
+development. [ TBD, provide information on how ].
+
+Then update the shared repository (at SF.net) with your changes
+
+ git push origin master
+
+
+
+=head1 PDL JARGON
+
+
+
+=head2 Q: 5.1 What is threading (is PDL a newsreader) ?
+
+
+Unfortunately, in the context of PDL the term threading can have two
+different (but related) meanings:
+
+=over 4
+
+=item *
+
+When mentioned in the F<INSTALL> directions and possibly
+during the build process we have the usual computer science
+meaning of multi-threading in mind (useful mainly on
+multiprocessor machines or clusters)
+
+=item *
+
+PDL threading of operations on piddles (as mentioned in the
+indexing docs) is the iteration of a basic operation over
+appropriate sub-slices of piddles, e.g. the inner product
+C<inner $a, $b> of a (3) pdl C<$a> and a (3,5,4) pdl
+C<$b> results in a (5,4) piddle where each
+value is the result of an inner product of the (3) pdl with a
+(3) sub-slice of the (3,5,4) piddle. For details check
+L<PDL::Indexing|PDL::Indexing>
+
+=back
+
+PDL threading leads naturally to potentially parallel code
+which can make use of multi threading on multiprocessor
+machines/networks; there you have the connection between the
+two types of use of the term.
+
+
+=head2 Q: 5.2 What is a piddle?
+
+
+Well, PDL scalar variables (which are instances of a particular class
+of Perl objects, i.e. blessed thingies (see C<perldoc perlobj> )) are
+in common PDL parlance often called I<piddles> (for example, check the
+mailing list archives). Err, clear? If not, simply use the term
+I<piddle> when you refer to a PDL variable (an instance of a PDL
+object as you might remember) regardless of what actual data the PDL
+variable contains.
+
+
+
+=head1 TECHNICAL QUESTIONS
+
+
+
+=head2 Q: 6.1 What is perldl? What is pdl2?
+
+
+Sometimes C<perldl> (C<pdl2>) is used as a synonym for PDL. Strictly
+speaking, however, the name C<perldl> (C<pdl2>) is reserved for the
+little shell that comes with the PDL distribution and is
+supposed to be used for the interactive prototyping of PDL
+scripts. For details check L<perldl> or L<pdl2>.
+
+
+=head2 Q: 6.2 How do I get on-line help for PDL?
+
+
+Just type C<help> (shortcut = "?") at the C<pdl2> shell
+prompt and proceed from there. Another useful command
+is the C<apropos> (shortcut = "??") command.
+Also try the C<demo> command in the C<perldl> or C<pdl2>
+shell if you are new to PDL.
+
+
+
+=head1 MANIPULATION OF PIDDLES
+
+
+
+=head2 Q: 6.3 I want to access the third element of a pdl but $a[2] doesn't work ?!
+
+
+See answer to the next question why the normal Perl array syntax doesn't
+work for piddles.
+
+
+=head2 Q: 6.4 The docs say piddles are some kind of array. But why doesn't the Perl array syntax work with piddles then ?
+
+
+OK, you are right in a way. The docs say that piddles can be
+thought of arrays. More specifically, it says (
+L<PDL::QuickStart|PDL::QuickStart> ):
+
+ I find when using the Perl Data Language it is most useful
+ to think of standard Perl @x variables as "lists" of generic
+ "things" and PDL variables like $x as "arrays" which can be
+ contained in lists or hashes.
+
+So, while piddles can be thought of as some kind of
+multi-dimensional array they are
+B< not> arrays in the Perl sense. Rather,
+from the point of view of Perl they are some special class
+(which is currently implemented as an opaque pointer to some
+stuff in memory) and therefore need special functions (or
+'methods' if you are using the OO version) to access
+individual elements or a range of elements. The
+functions/methods to check are
+C<at> / C<set> (see
+L<the section 'Sections' in PDL::QuickStart|PDL::QuickStart/"Sections"> ) or the powerful
+C<slice> function and friends (see L<PDL::Slices|PDL::Slices> and
+L<PDL::Indexing|PDL::Indexing> and especially L<PDL::NiceSlice|PDL::NiceSlice> ).
+
+Finally, to confuse you completely, you can have Perl arrays
+of piddles, e.g. C<$spec[3]> can refer to a pdl representing ,e.g,
+a spectrum, where C<$spec[3]> is the fourth element of the Perl
+list (or array ;) C<@spec> . This may be confusing but is
+very useful !
+
+
+=head2 Q: 6.5 How do I concatenate piddles?
+
+
+Most people will try to form new piddles from old piddles
+using some variation over the theme:
+C<$a = pdl([$b, 0, 2])> , but this does not work. The way to
+concatenate piddles is to use the function
+C<cat> (see also C<append> and C<glue>). Similarly you can split piddles
+using the command C<dog> .
+
+
+=head2 Q: 6.6 Sometimes I am getting these strange results when using inplace operations?
+
+
+This question is related to the C<inplace> function. From the
+documentation (see L<PDL::QuickStart>):
+
+ Most functions, e.g. log(), return a result which is a
+ transformation of their argument. This makes for good
+ programming practice. However many operations can be done
+ "in-place" and this may be required when large arrays are in
+ use and memory is at a premium. For these circumstances the
+ operator inplace() is provided which prevents the extra copy
+ and allows the argument to be modified. e.g.:
+
+ $x = log($array); # $array unaffected
+ log( inplace($bigarray) ); # $bigarray changed in situ
+
+And also from the doc !!:
+
+ Obviously when used with some functions which can not be
+ applied in situ (e.g. convolve()) unexpected effects may
+ occur!
+
+=for comment Check the list of PDL functions at the end of PDL.pod which points out
+C<inplace>-safe functions. No longer in PDL.pod, need to fix!!
+
+
+=head2 Q: 6.7 What is this strange usage of the string concatenation operator C<.=> in PDL scripts?
+
+
+See next question on assignment in PDL.
+
+
+=head2 Q: 6.8 Why are there two different kinds of assignment in PDL ?
+
+
+This is caused by the fact that currently the assignment
+operator C<=> allows only restricted
+overloading. For some purposes of PDL it turned out to be
+necessary to have more control over the overloading of an
+assignment operator. Therefore, PDL peruses the operator
+C<.=> for certain types of assignments.
+
+
+=head2 Q: 6.9 How do I set a set of values in a piddle?
+
+
+In Perl 5.6.7 and higher this assignment can be made
+using lvalue subroutines:
+
+ pdl> $a = sequence(5); p $a
+ [0 1 2 3 4]
+ pdl> $a->slice('1:2') .= pdl([5,6])
+ pdl> p $a
+ [0 5 6 3 4]
+
+see L<PDL::Lvalue> for more info. PDL also supports a more
+matrix-like slice syntax via the L<PDL::NiceSlice|PDL::NiceSlice> module:
+
+ pdl> $a(1:2) .= pdl([5,6])
+ pdl> p $a
+ [0 5 6 3 4]
+
+With versions of Perl prior to 5.6.7 B<or when running under
+the perl debugger> this has to be done using a temporary variable:
+
+ pdl> $a = sequence(5); p $a
+ [0 1 2 3 4]
+ pdl> $tmp = $a->slice('1:2'); p $tmp;
+ [1 2]
+ pdl> $tmp .= pdl([5, 6]); # Note .= !!
+ pdl> p $a
+ [0 5 6 3 4]
+
+This can also be made into one expression, which is often
+seen in PDL code:
+
+ pdl> ($tmp = $a->slice('1:2')) .= pdl([5,6])
+ pdl> p $a
+ [0 5 6 3 4]
+
+
+=head2 Q: 6.10 Can I use a piddle in a conditional expression?
+
+
+Yes you can, but not in the way you probably tried first. It
+is not possible to use a piddle directly in a conditional
+expression since this is usually poorly defined. Instead PDL
+has two very useful functions:
+C<any> and C<all> . Use these to test if any or
+all elements in a piddle fulfills some criterion:
+
+ pdl> $a=pdl ( 1, -2, 3);
+ pdl> print '$a has at least one element < 0' if (any $a < 0);
+ $a has at least one element < 0
+
+ pdl> print '$a is not positive definite' unless (all $a > 0);
+ $a is not positive definite
+
+
+=head2 Q: 6.11 Logical operators and piddles - '||' and '&&' don't work!
+
+
+It is a common problem that you try to make a mask array or something
+similar using a construct such as
+
+ $mask = which($piddle > 1 && $piddle < 2); # incorrect
+
+This B< does not> work! What you are looking for is the B< bitwise>
+logical operators '|' and '&' which work on an element-by-element
+basis. So it is really very simple: Do not use logical operators on
+multi-element piddles since that really doesn't make sense, instead
+write the example as:
+
+ $mask = which($piddle > 1 & $piddle < 2);
+
+which works correctly.
+
+
+
+=head1 ADVANCED TOPICS
+
+
+
+=head2 Q: 6.12 What is a null pdl ?
+
+
+=for comment Is Q: 6.12 up-to-date with null and empty pdls?
+
+C<null> is a special token for 'empty piddle'. A null pdl
+can be used to flag to a PDL function that it should create
+an appropriately sized and typed piddle. I<Null> piddles
+can be used in places where a PDL function expects an
+I<output> or I<temporary> argument. I<Output> and
+I<temporary> arguments are flagged in the
+I<signature> of a PDL function with the C<[o]> and
+C<[t]> qualifiers (see next question if you don't know what
+the I<signature> of a PDL function is). For example, you
+can invoke the C<sumover> function as follows:
+
+ sumover $a, $b=null;
+
+which is equivalent to
+
+ $b = sumover $a;
+
+If this seems still a bit murky check
+L<PDL::Indexing|PDL::Indexing> and
+L<PDL::PP|PDL::PP> for details about calling
+conventions, the I<signature> and
+I<threading> (see also below).
+
+
+=head2 Q: 6.13 What is the signature of a PDL function ?
+
+
+The I<signature> of a function is an important concept in PDL.
+Many (but not all) PDL function have a I<signature> which
+specifies the arguments and their (minimal) dimensionality. As
+an example, look at the signature of the C<maximum> function:
+
+ 'a(n); [o] b;'
+
+this says that C<maximum> takes two arguments, the first of which is
+(at least) one-dimensional while the second one is zero-dimensional and
+an I<output> argument (flagged by the C<[o]> qualifier). If the function
+is called with piddles of higher dimension the function will be repeatedly
+called with slices of these piddles of appropriate dimension(this is called
+I<threading> in PDL).
+
+For details and further explanations consult
+L<PDL::Indexing|PDL::Indexing> and L<PDL::PP|PDL::PP> .
+
+
+=head2 Q: 6.14 How can I subclass (inherit from) piddles?
+
+
+The short answer is: read L<PDL::Objects|PDL::Objects> (e.g. type
+C<help PDL::Objects> in the I<perldl> or I<pdl2> shell).
+
+The longer answer (extracted from L<PDL::Objects|PDL::Objects> ):
+Since a PDL object is an opaque reference to a C struct, it is not
+possible to extend the PDL class by e.g. extra data via sub-classing
+(as you could do with a hash based Perl object). To circumvent this
+problem PDL has built-in support to extend the PDL class via the
+I<has-a> relation for blessed hashes. You can get the I<HAS-A> to
+behave like I<IS-A> simply in that you assign the PDL
+object to the attribute named C<PDL> and
+redefine the method initialize(). For example:
+
+ package FOO;
+
+ @FOO::ISA = qw(PDL);
+ sub initialize {
+ my $class = shift;
+ my $self = {
+ creation_time => time(), # necessary extension :-)
+ PDL => PDL->null, # used to store PDL object
+ };
+ bless $self, $class;
+ }
+
+For another example check the script
+F<t/subclass.t> in the PDL distribution.
+
+
+=head2 Q: 6.15 What on earth is this dataflow stuff ?
+
+
+Dataflow is an experimental project that you don't need to concern
+yourself with (it should not interfere with your usual programming).
+However, if you want to know, have a look at
+L<PDL::Dataflow|PDL::Dataflow> . There
+are applications which will benefit from this feature (and it is already
+at work behind the scenes).
+
+
+=head2 Q: 6.16 What is PDL::PP?
+
+
+Simple answer: PDL::PP is both a glue between external
+libraries and PDL and a concise language for writing PDL
+functions.
+
+Slightly longer answer: PDL::PP is used to compile very
+concise definitions into XSUB routines implemented in C that
+can easily be called from PDL and which automatically support
+threading, dataflow and other things without you having to
+worry about it.
+
+For further details check L<PDL::PP|PDL::PP> and the
+section below on L<Extensions of PDL|"EXTENSIONS OF PDL">.
+
+
+=head2 Q: 6.17 What happens when I have several references to the same PDL object in different variables (cloning, etc?) ?
+
+
+Piddles behave like Perl references in many respects. So when you say
+
+ $a = pdl [0,1,2,3];
+ $b = $a;
+
+then both $b and $a point to the same object, e.g. then saying
+
+ $b++;
+
+will *not* create a copy of the original piddle but just increment in
+place, of which you can convince yourself by saying
+
+ print $a;
+ [1 2 3 4]
+
+This should not be mistaken for dataflow which connects several
+*different* objects so that data changes are propagated between
+the so linked piddles (though, under certain circumstances, dataflown
+piddles can share physically the same data).
+
+It is important to keep the "reference nature" of piddles in mind
+when passing piddles into subroutines. If you modify the input
+piddles you modify the original argument, I<not> a copy of it. This
+is different from some other array processing languages but makes
+for very efficient passing of piddles between subroutines. If you
+do not want to modify the original argument but rather a copy
+of it just create a copy explicitly (this example also demonstrates
+how to properly check for an I<explicit> request to process
+inplace, assuming your routine can work inplace):
+
+ sub myfunc {
+ my $pdl = shift;
+ if ($pdl->is_inplace) {
+ $pdl->set_inplace(0)
+ } else {
+ # modify a copy by default
+ $pdl = $pdl->copy
+ }
+ $pdl->set(0,0);
+ return $pdl;
+ }
+
+
+
+=head1 MISCELLANEOUS
+
+
+
+=head2 Q: 6.18 What I/O formats are supported by PDL ?
+
+
+The current versions of PDL already support quite a number of different
+I/O formats. However, it is not always obvious which module implements
+which formats. To help you find the right module for the format you
+require, here is a short list of the current list of I/O formats and
+a hint in which module to find the implementation:
+
+=over 4
+
+=item *
+
+A home brew fast raw (binary) I/O format for PDL is implemented by the
+L<FastRaw|PDL::IO::FastRaw> module
+
+=item *
+
+The L<FlexRaw|PDL::IO::FlexRaw> module implements generic methods for
+the input and output of `raw' data arrays. In particular, it is
+designed to read output from FORTRAN 77 UNFORMATTED files and the
+low-level C C<write> function, even if the files are compressed or gzipped.
+
+It is possible that the FastRaw functionality will be included in the
+FlexRaw module at some time in the future.
+
+=item *
+
+FITS I/O is implemented by the C<wfits>/C<rfits> functions in L<PDL::IO::FITS|PDL::IO::FITS> .
+
+=item *
+
+ASCII file I/O in various formats can be achieved by using the
+C<rcols> and C<rgrep> functions, also in L<PDL::IO::Misc|PDL::IO::Misc> .
+
+=item *
+
+L<PDL::IO::Pic|PDL::IO::Pic> implements an interface to the
+NetPBM/PBM+ filters to read/write several popular image formats; also
+supported is output of image sequences as MPEG movies, animated GIFs
+and a wide variety of other video formats.
+
+=item *
+
+On CPAN you can find the L<PDL::NetCDF|PDL::NetCDF> module that works with the current
+released version of PDL 2.006.
+
+=back
+
+For further details consult the more detailed list in the L<PDL::IO|PDL::IO>
+documentation or the documentation for the individual modules.
+
+
+=head2 Q: 6.19 How can I stack a set of 2D arrays (images) into a 3D piddle?
+
+
+Assuming all arrays are of the same size and in some format recognized by
+C<rpic> (see L<PDL::IO::Pic|PDL::IO::Pic> ) you could say:
+
+ use PDL::IO::Pic;
+ @names = qw/name1.tif .... nameN.tif/; # some file names
+ $dummy = PDL->rpic($names[0]);
+ $cube = PDL->zeroes($dummy->type,$dummy->dims,$#names+1); # make 3D piddle
+ for (0..$#names) {
+ # this is the slice assignment
+ ($tmp = $cube->slice(":,:,($_)")) .= PDL->rpic($names[$_]);
+ }
+
+or
+
+ $cube(:,:,($_)) .= PDL->rpic($names[$_]);
+
+for the slice assignment using the new L<PDL::NiceSlice|PDL::NiceSlice> syntax and Lvalue
+assignments.
+
+The for loop reads the actual images into a temporary 2D piddle whose
+values are then assigned (using the overloaded C<.=> operator) to the
+appropriate slices of the 3D piddle C<$cube> .
+
+
+=head2 Q: 6.20 Where are test files for the graphics modules?
+
+
+This answer applies mainly to PDL::Graphics::TriD (PDL's device
+independent 3D graphics model) which is the trickiest one in this
+respect. You find some test scripts in Demos/TriD in the distribution.
+There are also F<3dtest.pl> and F<line3d.pl> in the PDL/Example/TriD
+directory. After you have built PDL you can do:
+
+ perl -Mblib Example/TriD/3dtest.pl
+
+ perl -Mblib Example/TriD/line3d.pl
+
+to try the two TriD test programs. They only exercise one TriD function
+each but their simplicity makes it easy to debug if needed with the
+Perl debugger, see L<perldbug>.
+
+The programs in the Demo directory can be run most easily from the
+C<perldl> or C<pdl2> interactive shell:
+
+ perl -Mblib perldl or perl -Mblib Perldl2/pdl2
+
+followed by C<demo 3d> or C<demo 3d2> at the prompt.
+C<demo> by itself will give you a list of the available PDL demos.
+
+You can run the test scripts in the Demos/TriD directory manually
+by changing to that directory and running
+
+ perl -Mblib <testfile>
+
+
+where C<< testfile >> ; should match the pattern C<test[3-9].p>
+and watch the results. Some of the tests should bring up a window
+where you can control (twiddle) the 3D objects with the mouse. Try using
+mouse button 1 for turning the objects in 3D space, mouse button 3
+to zoom in and out, and 'q' to advance to the next stage of the test.
+
+
+=head2 Q: 6.21 What is TriD or PDL::TriD or PDL::Graphics::TriD?
+
+
+Questions like this should be a thing of the past with the PDL
+on-line help system in place. Just try (after installation):
+
+ un*x> pdl2
+ pdl> apropos trid
+
+Check the output for promising hits and then try to look up
+some of them, e.g.
+
+ pdl> help PDL::Graphics::TriD
+
+Note that case matters with C<help> but not with C<apropos> .
+
+
+=head2 Q: 6.22 PGPLOT does not write out PNG files.
+
+
+There are a few sources of trouble with PGPLOT and PNG files. First,
+when compiling the pgplot libraries, make sure you uncomment the PNG
+entries in the F<drivers.list> file. Then when running 'make' you
+probably got an error like
+
+ C<make: *** No rule to make target `png.h', needed by `pndriv.o'. Stop.>
+
+To fix this, find the line in the 'makefile' that starts with
+'pndriv.o:' (it's near the bottom). Change, for example, ./png.h to
+/usr/include/png.h, if that is where your header files are (you do
+have the libpng and libz devel packages, don't you?). Do this for all
+four entries on that line, then go back and run C<make>.
+
+Second, if you already have the PGPLOT Perl module and PDL installed,
+you probably tried to write out a PNG file and got fatal error message
+like:
+
+ C<undefined symbol: png_create_write_struct>
+
+This is because the PGPLOT Perl module does not automatically link
+against the png and z libraries. So when you are installing the PGPLOT
+Perl module (version 2.19) from CPAN, don't do C<install PGPLOT>, but
+just do C<get PGPLOT>. Then exit from CPAN and manually install
+PGPLOT, calling the makefile thusly:
+
+ C<perl Makefile.PL EXLIB=png,z EXDIR=/usr/lib>
+
+assuming that there exist files such as /usr/lib/libpng.so.*,
+/usr/lib/libz.so.*. Then do the standard C<make;make test;make
+install;> sequence. Now you can write png files from PDL!
+
+
+
+=head1 EXTENSIONS OF PDL
+
+
+
+=head2 Q: 7.1 I am looking for a package to do XXX in PDL. Where shall I look for it?
+
+
+The first stop is again C<perldl> or C<pdl2> and the on-line help
+or the PDL documentation. There is already a lot of functionality in
+PDL which you might not be aware of. The easiest way to look for
+functionality is to use the C<apropos> command:
+
+ pdl> apropos 'integral'
+ ceil Round to integral values in floating-point format
+ floor Round to integral values in floating-point format
+ intover Project via integral to N-1 dimensions
+ rint Round to integral values in floating-point format
+
+Since the apropos command is no sophisticated search engine make
+sure that you search on a couple of related topics and use short
+phrases.
+
+However there is a good chance that what you need is not part
+of the PDL distribution. You are then well advised to check
+out L<http://pdl.perl.org> where there is a list of packages
+using PDL. If that does not solve your problem, ask on the
+mailing-list, if nothing else you might get assistance which
+will let you interface your package with PDL yourself, see
+also the next question.
+
+
+=head2 Q: 7.2 Can I access my C/FORTRAN library routines in PDL?
+
+
+Yes, you can, in fact it is very simple for many simple
+applications. What you want is the PDL pre-processor PP
+(L<PDL::PP|PDL::PP> ). This will allow you to make a
+simple interface to your C routine.
+
+The two functions you need to learn (at least first) are
+C<pp_def> which defines the calling interface to the function,
+specifying input and output parameters, and contains the code
+that links to the external library. The other command is
+C<pp_end> which finishes the PP definitions. For details see
+the L<PDL::PP|PDL::PP> man-page, but we also have a worked
+example here.
+
+ double eight_sum(int n)
+ {
+ int i;
+ double sum, x;
+
+ sum = 0.0; x=0.0;
+ for (i=1; i<=n; i++) {
+ x++;
+ sum += x/((4.0*x*x-1.0)*(4.0*x*x-1.0));
+ }
+ return 1.0/sum;
+ }
+
+
+We will here show you an example of how you interface C
+code with PDL. This is the first example and will show
+you how to approximate the number 8...
+
+The C code is shown above and is a simple function
+returning a double, and expecting an integer - the number
+of terms in the sum - as input. This function could be
+defined in a library or, as we do here, as an inline
+function.
+
+We will postpone the writing of the Makefile till
+later. First we will construct the
+C<.pd> file. This is the file
+containing PDL::PP code. We call this
+C<eight.pd> .
+
+ #
+ # pp_def defines a PDL function.
+ #
+ pp_addhdr (
+ '
+ double eight_sum(int n)
+ {
+ int i;
+ double sum, x;
+
+ sum = 0.0; x=0.0;
+ for (i=1; i<=n; i++) {
+ x++;
+ sum += x/((4.0*x*x-1.0)*(4.0*x*x-1.0));
+ }
+ return 1.0/sum;
+
+ }
+ ');
+
+ pp_def (
+ 'eight',
+ Pars => 'int a(); double [o]b();',
+ Code => '$b()=eight_sum($a());'
+ );
+
+ # Always make sure that you finish your PP declarations with
+ # pp_done
+
+ pp_done();
+
+A peculiarity with our example is that we have included
+the entire code with
+C<pp_addhdr> instead of linking it in. This is only for the purposes of
+example, in a typical application you will use
+C<pp_addhdr> to include header
+files. Note that the argument to
+C<pp_addhdr> is enclosed in quotes.
+
+What is most important in this example is however the
+C<pp_def> command. The first
+argument to this is the name of the new function
+I<eight > , then comes a hash which
+the real meat:
+
+=over 4
+
+=item *
+
+This gives the input parameters (here C<a>) and the output parameters
+(here C<b>). The latter are indicated by the C<[o]> specifier. Both
+arguments can have a type specification as shown here.
+
+Many variations and further flexibility in the interface can be
+specified. See C<perldoc PDL::PP> for details.
+
+=item *
+
+This switch contains the code that should be
+executed. As you can see this is a rather peculiar
+mix of C and Perl, but essentially it is just as
+you would write it in C, but the variables that
+are passed from PDL are treated differently and
+have to be referred to with a preceding '$'.
+
+There are also simple macros to pass pointers to
+data and to obtain the values of other Perl
+quantities, see the manual page for further
+details.
+
+=back
+
+Finally note the call to
+C<pp_done()> at the end of the
+file. This is necessary in all PP files.
+
+OK. So now we have a file with code that we dearly would
+like to use in Perl via PDL. To do this we need to
+compile the function, and to do that we need a
+Makefile.
+
+ use PDL::Core::Dev;
+ use ExtUtils::MakeMaker;
+ PDL::Core::Dev->import();
+
+ $package = ["eight.pd",Eight,PDL::Eight];
+ %hash = pdlpp_stdargs($package);
+
+ WriteMakefile( %hash );
+
+ sub MY::postamble {pdlpp_postamble($package)};
+
+The code above should go in a file called Makefile.PL,
+which should subsequently be called in the standard
+Perl way:
+C<perl Makefile.PL> .
+This should give you a Makefile and running
+C<make> should compile the module for
+you and
+C<make install> will
+install it for you.
+
+
+=head2 Q: 7.3 How can I interface package XXX in PDL?
+
+
+This question is closely related to the previous one, and as
+we said there, the
+L<PDL::PP|PDL::PP> pre-processor is the standard
+way of interfacing external packages with PDL. The most usual
+way to use PDL::PP is to write a short interface routine, see
+the L<PDL::PP|PDL::PP> perldoc page and
+the answer to the previous question for
+examples.
+
+However it is also possible to interface a package to PDL by
+re-writing your function in PDL::PP directly. This can be
+convenient in certain situations, in particular if you have a
+routine that expects a function as input and you would like to
+pass the function a Perl function for convenience.
+
+The L<PDL::PP|PDL::PP> perldoc page is the main
+source of information for writing PDL::PP extensions, but it
+is very useful to look for files in the distribution of PDL as
+many of the core functions are written in PDL::PP. Look for
+files that end in C<.pd> which is the generally accepted
+suffix for PDL::PP files. But we also have a simple example here.
+
+The following example will show you how to write a simple
+function that automatically allows threading. To make this
+concise the example is of an almost trivial function, but
+the intention is to show the basics of writing a PDL::PP
+interface.
+
+We will write a simple function that calculates the minimum,
+maximum and average of a piddle. On my machine the resulting
+function is 8 times faster than the built-in function
+C<stats> (of course the latter also
+calculates the median).
+
+Let's jump straight in. Here is the code (from a file called
+C<quickstats.pd> )
+
+ #
+ pp_def('quickstats',
+ Pars => 'a(n); [o]avg(); [o]max(); [o]min()',
+ Code => '$GENERIC(a) curmax, curmin;
+ $GENERIC(a) tmp=0;
+ loop(n) %{
+ tmp += $a();
+ if (!n || $a() > curmax) { curmax = $a();}
+ if (!n || $a() < curmin) { curmin = $a();}
+ %}
+ $avg() = tmp/$SIZE(n);
+ $max() = curmax;
+ $min() = curmin;
+ '
+ );
+
+ pp_done();
+
+The above might look like a confusing mixture of C and
+Perl, but behind the peculiar syntax lies a very
+powerful language. Let us take it line by line.
+
+The first line declares that we are starting the
+definition of a PDL:PP function called
+C<quickstats> .
+
+The second line is very important as it specifies the
+input and output parameters of the function.
+C<a(n)> tells us that there is one input
+parameter that we will refer to as
+C<a> which is expected to be a vector of
+length n (likewise matrices, both square and rectangular
+would be written as
+C<a(n,n)> and
+C<a(n,m)> respectively). To
+indicate that something is an output parameter we put
+C<[o]> in front of their names, so
+referring back to the code we see that avg, max and min
+are three output parameters, all of which are scalar
+(since they have no dimensional size indicated.
+
+The third line starts the code definition which is
+essentially pure C but with a couple of convenient
+functions.
+C<$GENERIC> is a
+function that returns the C type of its argument - here
+the input parameter a. Thus the first two lines of the
+code section are variable declarations.
+
+The
+C<loop(n)> construct is a
+convenience function that loops over the dimension
+called n in the parameter section. Inside this loop we
+calculate the cumulative sum of the input vector and
+keep track of the maximum and minimum values. Finally
+we assign the resulting values to the output
+parameters.
+
+Finally we finish our function declaration with
+C<pp_done()> .
+
+To compile our new function we need to create a Makefile,
+which we will just list since its creation is discussed in
+an earlier question.
+
+ use PDL::Core::Dev;
+ use ExtUtils::MakeMaker;
+ PDL::Core::Dev->import();
+
+ $package = ["quickstats.pd",Quickstats,PDL::Quickstats];
+ %hash = pdlpp_stdargs($package);
+
+ WriteMakefile( %hash );
+
+ sub MY::postamble {pdlpp_postamble($package)};
+
+
+An example Makefile.PL
+
+Our new statistic function should now compile using the
+tried and tested Perl way:
+C<perl Makefile.PL; make> .
+
+You should experiment with this function, changing the
+calculations and input and output parameters. In conjunction
+with the L<PDL::PP|PDL::PP> perldoc page this should allow you to quickly
+write more advanced routines directly in PDL::PP.
+
+
+
+=head1 BUGS
+
+
+If you find any inaccuracies in this document (or dis-functional
+URLs) please report to the perldl mailing list perldl at jach.hawaii.edu.
+
+
+
+=head1 ACKNOWLEDGMENTS
+
+
+Achim Bohnet (ach at mpe.mpg.de ) for suggesting CoolHTML as a
+prettypodder (although we have switched to XML now) and various
+other improvements. Suggestions for some questions were taken
+from Perl FAQ and adapted for PDL.
+
+
+
+=head1 CONTRIBUTORS
+
+
+Many people have contributed or given feedback on the current
+version of the FAQ, here is an incomplete list of individuals
+whose contributions or posts to the mailing-list have improved
+this FAQ at some point in time alphabetically listed by first
+name: Christian Soeller, Chris Marshall, Doug Burke, Doug Hunt,
+Frank Schmauder, Jarle Brinchmann, John Cerney, Karl Glazebrook,
+Kurt Starsinic, Thomas Yengst, Tuomas J. Lukka.
+
+
+
+=head1 AUTHOR AND COPYRIGHT
+
+
+This document emerged from a joint effort of several PDL
+developers (Karl Glazebrook, Tuomas J. Lukka, Christian
+Soeller) to compile a list of the most frequently asked questions
+about PDL with answers. Permission is granted for verbatim
+copying (and formatting) of this material as part of PDL.
+
+Permission is explicitly not granted for distribution in book
+or any corresponding form. Ask on the PDL mailing list
+perldl at jach.hawaii.edu if some of the issues covered
+in here are unclear.
diff --git a/Basic/Pod/Index.pod b/Basic/Pod/Index.pod
new file mode 100644
index 0000000..f940293
--- /dev/null
+++ b/Basic/Pod/Index.pod
@@ -0,0 +1,615 @@
+
+=head1 NAME
+
+PDL::Index - an index of PDL documentation
+
+=head1 DESCRIPTION
+
+A meta document listing the documented PDL modules and
+the PDL manual documents
+
+=head1 PDL manuals
+
+=over 4
+
+=item *
+
+L<PDL::API|PDL::API> - making piddles from Perl and C/XS code
+
+=item *
+
+L<PDL::BadValues|PDL::BadValues> - Discussion of bad value support in PDL
+
+=item *
+
+L<PDL::Course|PDL::Course> - A journey through PDL's documentation, from beginner to advanced.
+
+=item *
+
+L<PDL::Dataflow|PDL::Dataflow> - description of the dataflow philosophy
+
+=item *
+
+L<PDL::Delta|PDL::Delta> - PDL changes between V1.0 and V2.0
+
+=item *
+
+L<PDL::FAQ|PDL::FAQ> - Frequently asked questions about PDL
+
+=item *
+
+L<PDL::IO|PDL::IO> - An overview of the modules in the PDL::IO namespace.
+
+=item *
+
+L<PDL::Indexing|PDL::Indexing> - Introduction to indexing and slicing piddles.
+
+=item *
+
+L<PDL::Internals|PDL::Internals> - description of some aspects of the current internals
+
+=item *
+
+L<PDL::MATLAB|PDL::MATLAB> - A guide for MATLAB users.
+
+=item *
+
+L<PDL::Modules|PDL::Modules> - A guide to PDL's module reference.
+
+=item *
+
+L<PDL::Objects|PDL::Objects> - Object-Orientation, what is it and how to exploit it
+
+=item *
+
+L<PDL::PP|PDL::PP> - Generate PDL routines from concise descriptions
+
+=item *
+
+L<PDL::ParallelCPU|PDL::ParallelCPU> - Parallel Processor MultiThreading Support in PDL (Experimental)
+
+=item *
+
+L<PDL::Philosophy|PDL::Philosophy> - Why did we write PDL?
+
+=item *
+
+L<PDL::QuickStart|PDL::QuickStart> - Quick introduction to PDL features.
+
+=item *
+
+L<PDL::Scilab|PDL::Scilab> - A guide for Scilab users.
+
+=item *
+
+L<PDL::Threading|PDL::Threading> - Tutorial for PDL's Threading feature
+
+=item *
+
+L<PDL::Tips|PDL::Tips> - Small tidbits of useful arcana. Programming tidbits and such.
+
+=item *
+
+L<PDL::Tutorials|PDL::Tutorials> - A guide to PDL's tutorial documentation.
+
+
+=back
+
+=head1 PDL scripts
+
+=over 4
+
+=item *
+
+L<pdl2|PDL::pdl2> - Simple shell (version 2) for PDL
+
+=item *
+
+L<pdldoc|PDL::pdldoc> - shell interface to PDL documentation
+
+=item *
+
+L<perldl|PDL::perldl> - Simple shell for PDL (see also L<pdl2>)
+
+=item *
+
+L<pptemplate|PDL::pptemplate> - script to generate Makefile.PL and PP file skeleton
+
+
+=back
+
+=head1 PDL modules
+
+=over 4
+
+=item *
+
+L<PDL::PDL|PDL::PDL> - the Perl Data Language
+
+=item *
+
+L<PDL::AutoLoader|PDL::AutoLoader> - MatLab style AutoLoader for PDL
+
+=item *
+
+L<PDL::Bad|PDL::Bad> - PDL does process bad values
+
+=item *
+
+L<PDL::Basic|PDL::Basic> - Basic utility functions for PDL
+
+=item *
+
+L<PDL::CallExt|PDL::CallExt> - call functions in external shared libraries
+
+=item *
+
+L<PDL::Char|PDL::Char> - PDL subclass which allows reading and writing of fixed-length character strings as byte PDLs
+
+=item *
+
+L<PDL::Complex|PDL::Complex> - handle complex numbers
+
+=item *
+
+L<PDL::Compression|PDL::Compression> - compression utilities
+
+=item *
+
+L<PDL::Constants|PDL::Constants> - basic compile time constants for PDL
+
+=item *
+
+L<PDL::Core|PDL::Core> - fundamental PDL functionality and vectorization/threading
+
+=item *
+
+L<PDL::Core::Dev|PDL::Core::Dev> - PDL development module
+
+=item *
+
+L<PDL::Dbg|PDL::Dbg> - functions to support debugging of PDL scripts
+
+=item *
+
+L<PDL::DiskCache|PDL::DiskCache> - Non-memory-resident array object
+
+=item *
+
+L<PDL::Doc|PDL::Doc> - support for PDL online documentation
+
+=item *
+
+L<PDL::Doc::Perldl|PDL::Doc::Perldl> - commands for accessing PDL doc database from 'perldl' shell
+
+=item *
+
+L<PDL::Exporter|PDL::Exporter> - PDL export control
+
+=item *
+
+L<PDL::FFT|PDL::FFT> - FFTs for PDL
+
+=item *
+
+L<PDL::FFTW|PDL::FFTW> - PDL interface to the Fastest Fourier Transform in the West v2.x
+
+=item *
+
+L<PDL::Filter::LinPred|PDL::Filter::LinPred> - Linear predictive filtering
+
+=item *
+
+L<PDL::Filter::Linear|PDL::Filter::Linear> - linear filtering for PDL
+
+=item *
+
+L<PDL::Fit::Gaussian|PDL::Fit::Gaussian> - routines for fitting gaussians
+
+=item *
+
+L<PDL::Fit::LM|PDL::Fit::LM> - Levenberg-Marquardt fitting routine for PDL
+
+=item *
+
+L<PDL::Fit::Linfit|PDL::Fit::Linfit> - routines for fitting data with linear combinations of functions.
+
+=item *
+
+L<PDL::Fit::Polynomial|PDL::Fit::Polynomial> - routines for fitting with polynomials
+
+=item *
+
+L<PDL::Func|PDL::Func> - interpolation, integration, & gradient estimation (differentiation) of functions
+
+=item *
+
+L<PDL::GIS::Proj|PDL::GIS::Proj> - PDL interface to the Proj4 projection library.
+
+=item *
+
+L<PDL::GSL::DIFF|PDL::GSL::DIFF> - PDL interface to numerical differentiation routines in GSL
+
+=item *
+
+L<PDL::GSL::INTEG|PDL::GSL::INTEG> - PDL interface to numerical integration routines in GSL
+
+=item *
+
+L<PDL::GSL::INTERP|PDL::GSL::INTERP> - PDL interface to Interpolation routines in GSL
+
+=item *
+
+L<PDL::GSL::MROOT|PDL::GSL::MROOT> - PDL interface to multidimensional root-finding routines in GSL
+
+=item *
+
+L<PDL::GSL::RNG|PDL::GSL::RNG> - PDL interface to RNG and randist routines in GSL
+
+=item *
+
+L<PDL::GSLSF::AIRY|PDL::GSLSF::AIRY> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::BESSEL|PDL::GSLSF::BESSEL> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::CLAUSEN|PDL::GSLSF::CLAUSEN> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::COULOMB|PDL::GSLSF::COULOMB> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::COUPLING|PDL::GSLSF::COUPLING> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::DAWSON|PDL::GSLSF::DAWSON> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::DEBYE|PDL::GSLSF::DEBYE> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::DILOG|PDL::GSLSF::DILOG> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::ELEMENTARY|PDL::GSLSF::ELEMENTARY> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::ELLINT|PDL::GSLSF::ELLINT> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::ELLJAC|PDL::GSLSF::ELLJAC> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::ERF|PDL::GSLSF::ERF> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::EXP|PDL::GSLSF::EXP> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::EXPINT|PDL::GSLSF::EXPINT> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::FERMI_DIRAC|PDL::GSLSF::FERMI_DIRAC> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::GAMMA|PDL::GSLSF::GAMMA> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::GEGENBAUER|PDL::GSLSF::GEGENBAUER> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::HYPERG|PDL::GSLSF::HYPERG> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::LAGUERRE|PDL::GSLSF::LAGUERRE> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::LEGENDRE|PDL::GSLSF::LEGENDRE> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::LOG|PDL::GSLSF::LOG> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::POLY|PDL::GSLSF::POLY> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::POW_INT|PDL::GSLSF::POW_INT> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::PSI|PDL::GSLSF::PSI> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::SYNCHROTRON|PDL::GSLSF::SYNCHROTRON> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::TRANSPORT|PDL::GSLSF::TRANSPORT> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::TRIG|PDL::GSLSF::TRIG> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::GSLSF::ZETA|PDL::GSLSF::ZETA> - PDL interface to GSL Special Functions
+
+=item *
+
+L<PDL::Gaussian|PDL::Gaussian> - Gaussian distributions.
+
+=item *
+
+L<PDL::Graphics2D|PDL::Graphics2D> - An object oriented interface to PDL graphics
+
+=item *
+
+L<PDL::Graphics::IIS|PDL::Graphics::IIS> - Display PDL images on IIS devices (saoimage/ximtool)
+
+=item *
+
+L<PDL::Graphics::LUT|PDL::Graphics::LUT> - provides access to a number of look-up tables
+
+=item *
+
+L<PDL::Graphics::Limits|PDL::Graphics::Limits> - derive limits for display purposes
+
+=item *
+
+L<PDL::Graphics::OpenGL::Perl::OpenGL|PDL::Graphics::OpenGL::Perl::OpenGL> - PDL TriD OpenGL interface using POGL
+
+=item *
+
+L<PDL::Graphics::OpenGLQ|PDL::Graphics::OpenGLQ> - quick routines to plot lots of stuff from piddles.
+
+=item *
+
+L<PDL::Graphics::PGPLOT|PDL::Graphics::PGPLOT> - PGPLOT enhanced interface for PDL
+
+=item *
+
+L<PDL::Graphics::PGPLOT::Window|PDL::Graphics::PGPLOT::Window> - A OO interface to PGPLOT windows
+
+=item *
+
+L<PDL::Graphics::PGPLOTOptions|PDL::Graphics::PGPLOTOptions> - Setting PGPLOT options
+
+=item *
+
+L<PDL::Graphics::PLplot|PDL::Graphics::PLplot> - Object-oriented interface from perl/PDL to the PLPLOT plotting library
+
+=item *
+
+L<PDL::Graphics::TriD|PDL::Graphics::TriD> - PDL 3D interface
+
+=item *
+
+L<PDL::Graphics::TriD::ButtonControl|PDL::Graphics::TriD::ButtonControl> - default event handler subroutines
+
+=item *
+
+L<PDL::Graphics::TriD::Contours|PDL::Graphics::TriD::Contours> - 3D Surface contours for TriD
+
+=item *
+
+L<PDL::Graphics::TriD::Labels|PDL::Graphics::TriD::Labels> - Text tools
+
+=item *
+
+L<PDL::Graphics::TriD::MathGraph|PDL::Graphics::TriD::MathGraph> - Mathematical Graph objects for PDL
+
+=item *
+
+L<PDL::Graphics::TriD::Objects|PDL::Graphics::TriD::Objects> - Simple Graph Objects for TriD
+
+=item *
+
+L<PDL::Graphics::TriD::Rout|PDL::Graphics::TriD::Rout> - Helper routines for Three-dimensional graphics
+
+=item *
+
+L<PDL::Graphics::TriD::Tk|PDL::Graphics::TriD::Tk> - A Tk widget interface to the PDL::Graphics::TriD.
+
+=item *
+
+L<PDL::Graphics::TriD::VRML|PDL::Graphics::TriD::VRML> - TriD VRML backend
+
+=item *
+
+L<PDL::IO::Dicom|PDL::IO::Dicom> - a module for reading DICOM images.
+
+=item *
+
+L<PDL::IO::Dumper|PDL::IO::Dumper> - data dumping for structs with PDLs
+
+=item *
+
+L<PDL::IO::FITS|PDL::IO::FITS> - Simple FITS support for PDL
+
+=item *
+
+L<PDL::IO::FastRaw|PDL::IO::FastRaw> - A simple, fast and convenient io format for PerlDL.
+
+=item *
+
+L<PDL::IO::FlexRaw|PDL::IO::FlexRaw> - A flexible binary I/O format for PerlDL
+
+=item *
+
+L<PDL::IO::GD|PDL::IO::GD> - Interface to the GD image library.
+
+=item *
+
+L<PDL::IO::HDF|PDL::IO::HDF> - An interface library for HDF4 files.
+
+=item *
+
+L<PDL::IO::HDF::SD|PDL::IO::HDF::SD> - PDL interface to the HDF4 SD library.
+
+=item *
+
+L<PDL::IO::IDL|PDL::IO::IDL> - I/O of IDL Save Files
+
+=item *
+
+L<PDL::IO::Misc|PDL::IO::Misc> - misc IO routines for PDL
+
+=item *
+
+L<PDL::IO::Pic|PDL::IO::Pic> - image I/O for PDL
+
+=item *
+
+L<PDL::IO::Pnm|PDL::IO::Pnm> - pnm format I/O for PDL
+
+=item *
+
+L<PDL::IO::Storable|PDL::IO::Storable> - helper functions to make PDL usable with Storable
+
+=item *
+
+L<PDL::Image2D|PDL::Image2D> - Miscellaneous 2D image processing functions
+
+=item *
+
+L<PDL::ImageND|PDL::ImageND> - useful image processing in N dimensions
+
+=item *
+
+L<PDL::ImageRGB|PDL::ImageRGB> - some utility functions for RGB image data handling
+
+=item *
+
+L<PDL::Lite|PDL::Lite> - minimum PDL module OO loader
+
+=item *
+
+L<PDL::LiteF|PDL::LiteF> - minimum PDL module function loader
+
+=item *
+
+L<PDL::Lvalue|PDL::Lvalue> - declare PDL lvalue subs
+
+=item *
+
+L<PDL::Math|PDL::Math> - extended mathematical operations and special functions
+
+=item *
+
+L<PDL::Matrix|PDL::Matrix> - a convenience matrix class for column-major access
+
+=item *
+
+L<PDL::MatrixOps|PDL::MatrixOps> - Some Useful Matrix Operations
+
+=item *
+
+L<PDL::Minuit|PDL::Minuit> - a PDL interface to the Minuit library
+
+=item *
+
+L<PDL::NiceSlice|PDL::NiceSlice> - toward a nicer slicing syntax for PDL
+
+=item *
+
+L<PDL::Ops|PDL::Ops> - Fundamental mathematical operators
+
+=item *
+
+L<PDL::Opt::Simplex|PDL::Opt::Simplex> - Simplex optimization routines
+
+=item *
+
+L<PDL::Options|PDL::Options> - simplifies option passing by hash in PerlDL
+
+=item *
+
+L<PDL::Perldl2::Plugin::CleanErrors|PDL::Perldl2::Plugin::CleanErrors> - filter out Moose cruft
+
+=item *
+
+L<PDL::Perldl2::Plugin::NiceSlice|PDL::Perldl2::Plugin::NiceSlice> - enable PDL NiceSlice syntax
+
+=item *
+
+L<PDL::Perldl2::Plugin::PDLCommands|PDL::Perldl2::Plugin::PDLCommands> - implement perldl aliases/escapes
+
+=item *
+
+L<PDL::Perldl2::Plugin::PrintControl|PDL::Perldl2::Plugin::PrintControl> - disable default print output
+
+=item *
+
+L<PDL::Perldl2::Profile::Perldl2|PDL::Perldl2::Profile::Perldl2> - profile for Perldl2 shell
+
+=item *
+
+L<PDL::Primitive|PDL::Primitive> - primitive operations for pdl
+
+=item *
+
+L<PDL::Reduce|PDL::Reduce> - a C<reduce> function for PDL
+
+=item *
+
+L<PDL::Slatec|PDL::Slatec> - PDL interface to the slatec numerical programming library
+
+=item *
+
+L<PDL::Slices|PDL::Slices> - Indexing, slicing, and dicing
+
+=item *
+
+L<PDL::Tests|PDL::Tests> - tests for some PP features
+
+=item *
+
+L<PDL::Transform|PDL::Transform> - Coordinate transforms, image warping, and N-D functions
+
+=item *
+
+L<PDL::Transform::Cartography|PDL::Transform::Cartography> - Useful cartographic projections
+
+=item *
+
+L<PDL::Transform::Proj4|PDL::Transform::Proj4> - PDL::Transform interface to the Proj4 projection library
+
+=item *
+
+L<PDL::Types|PDL::Types> - define fundamental PDL Datatypes
+
+=item *
+
+L<PDL::Ufunc|PDL::Ufunc> - primitive ufunc operations for pdl
+
+
+=back
+
+=head1 HISTORY
+
+Automatically generated by scantree.pl for PDL version 2.004_995.
+
diff --git a/Basic/Pod/Indexing.pod b/Basic/Pod/Indexing.pod
new file mode 100644
index 0000000..d25ad41
--- /dev/null
+++ b/Basic/Pod/Indexing.pod
@@ -0,0 +1,1563 @@
+=head1 NAME
+
+PDL::Indexing - Introduction to indexing and slicing piddles.
+
+=head1 OVERVIEW
+
+This man page should serve as a first tutorial on the indexing and
+threading features of I<PDL>.
+
+Like all vectorized languages, PDL automates looping over arrays using
+a variant of mathematical vector notation. The automatic looping is called
+"threading", in part because ultimately PDL will implement parallel processing
+to speed up the loops.
+
+A lot of the flexibility and power of PDL relies on the indexing and threading
+features of the Perl extension. Indexing allows access to the data of a piddle
+in a very flexible way. Threading provides efficient vectorization of simple
+operations.
+
+The values of a piddle are stored compactly as typed values in a single block of memory,
+not (as in a normal Perl list-of-lists) as individual Perl scalars.
+
+In the sections that follow many "methods" are called out -- these are Perl operators
+that apply to PDLs. From the L<perldl|perldl> (or L<pdl2|PDL::Perldl2>) shell, you
+can find out more about each method by typing "?" followed by the method name.
+
+=head2 Dimension lists
+
+A piddle (PDL variable), in general, is an N-dimensional array where N can be
+0 (for a scalar), 1 (e.g. for a sound sample), or higher values for images
+and more complex structures. Each dimension of the piddle has a positive
+integer size. The C<perl> interpreter treats each piddle as a special type of
+Perl scalar (a blessed Perl object, actually -- but you don't have to know that
+to use them) that can be used anywhere you can put a normal scalar.
+
+You can access the dimensions of a piddle as a Perl list and otherwise determine
+the size of a piddle with several methods. The important ones are:
+
+=over 3
+
+=item nelem - the total number of elements in a PDL
+
+=item ndims - returns the number of dimensions in a PDL
+
+=item dims - returns the dimension list of a PDL as a Perl list
+
+=item dim - returns the size of a particular dimension of a PDL
+
+=back
+
+=head2 Indexing and Dataflow
+
+PDL maintains a notion of "dataflow" between a piddle and indexed subfields of
+that piddle. When you produce an indexed subfield or single element of a parent
+piddle, the child and parent remain attached until you manually disconnect them.
+This lets you represent the same data different ways within your code -- for example,
+you can consider an RGB image simultaneously as a collection of (R,G,B) values
+in a 3 x 1000 x 1000 image, and as three separate 1000 x 1000 color planes stored in
+different variables. Modifying any of the variables changes the underlying memory, and
+the changes are reflected in all representations of the data.
+
+There are two important methods that let you control dataflow connections between a
+child and parent PDL:
+
+=over 3
+
+=item copy - forces an explicit copy of a PDL
+
+=item sever - breaks the dataflow connection between a PDL and its parents (if any)
+
+=back
+
+=head2 Threading and Dimension Order
+
+Most PDL operations act on the first few dimensions of their piddle arguments. For
+example, C<sumover> sums all elements along the first dimension in the list (dimension 0).
+If you feed in a three-dimensional piddle, then the first dimension is considered the
+"active" dimension and the later dimensions are "thread" dimensions because they are simply
+looped over. There are several ways to transpose or re-order the dimension list of a PDL.
+Those techniques are very fast since they don't touch the underlying data, only change the
+way that PDL accesses the data. The main dimension ordering functions are:
+
+=over 3
+
+=item mv - moves a particular dimension somewhere else in the dimension list
+
+=item xchg - exchanges two dimensions in the dimension list, leaving the rest alone
+
+=item reorder - allows wholesale mixing of the dimensions
+
+=item clump - clumps together two or more small dimensions into one larger one
+
+=item squeeze - eliminates any dimensions of size 1
+
+
+=back
+
+=head2 Physical and Dummy Dimensions
+
+
+
+
+
+
+
+=over 5
+
+=item *
+
+document Perl level threading
+
+=item *
+
+threadids
+
+=item *
+
+update and correct description of slice
+
+=item *
+
+new functions in slice.pd (affine, lag, splitdim)
+
+=item *
+
+reworking of paragraph on explicit threading
+
+=back
+
+=head1 Indexing and threading with PDL
+
+A lot of the flexibility and power of PDL relies on the indexing and
+looping features of the Perl extension. Indexing allows access to the
+data of a pdl object in a very flexible way. Threading provides
+efficient implicit looping functionality (since the loops are
+implemented as optimized C code).
+
+Pdl objects (later often called "pdls") are Perl objects that
+represent multidimensional arrays and operations on those. In contrast
+to simple Perl C<@x> style lists the array data is compactly stored in
+a single block of memory thus taking up a lot less memory and enabling
+use of fast C code to implement operations (e.g. addition,
+etc) on pdls.
+
+=head2 pdls can have children
+
+Central to many of the indexing capabilities of PDL are the relation of
+"parent" and "child" between pdls. Many of the indexing commands
+create a new pdl from an existing pdl. The new pdl is the "child"
+and the old one is the "parent". The data of the new pdl is defined by a
+transformation that specifies how to generate (compute) its data from
+the parent's data. The relation between the child pdl and its parent
+are often bidirectional, meaning that changes in the child's data are
+propagated back to the parent. (Note: You see, we are aiming in our
+terminology already towards the new dataflow features. The kind of
+dataflow that is used by the indexing commands (about which you will
+learn in a minute) is always in operation, not only when you have
+explicitly switched on dataflow in your pdl by saying C<$a-E<gt>doflow>. For
+further information about data flow check the dataflow man page.)
+
+Another way to interpret the pdls created by our indexing commands is
+to view them as a kind of intelligent pointer that points back to some
+portion or all of its parent's data. Therefore, it is not surprising
+that the parent's data (or a portion of it) changes when manipulated
+through this "pointer". After these introductory remarks that
+hopefully prepared you for what is coming (rather than confuse you too
+much) we are going to dive right in and start with a description of
+the indexing commands and some typical examples how they might be used
+in PDL programs. We will further illustrate the pointer/dataflow
+analogies in the context of some of the examples later on.
+
+There are two different implementations of this ``smart pointer''
+relationship: the first one, which is a little slower but works
+for any transformation is simply to do the transformation forwards
+and backwards as necessary. The other is to consider the child piddle
+a ``virtual'' piddle, which only stores a pointer to the parent
+and access information so that routines which use the child piddle
+actually directly access the data in the parent.
+If the virtual piddle is given to a routine which cannot use it,
+PDL transparently physicalizes the virtual piddle before letting
+the routine use it.
+
+Currently (1.94_01) all transformations which are ``affine'',
+i.e. the indices of the data item in the parent piddle are determined
+by a linear transformation (+ constant) from the indices of the
+child piddle result in virtual piddles. All other indexing
+routines (e.g. C<-E<gt>index(...)>) result in physical piddles.
+All routines compiled by PP can accept affine piddles (except
+those routines that pass pointers to external library functions).
+
+Note that whether something is affine or not does not affect the semantics
+of what you do in any way: both
+
+ $a->index(...) .= 5;
+ $a->slice(...) .= 5;
+
+change the data in C<$a>. The affinity does, however, have a significant
+impact on memory usage and performance.
+
+=head2 Slicing pdls
+
+Probably the most important application of the concept of parent/child
+pdls is the representation of rectangular slices of a physical pdl by
+a virtual pdl. Having talked long enough about concepts let's get more
+specific. Suppose we are working with a 2D pdl representing a 5x5
+image (its unusually small so that we can print it without filling
+several screens full of digits ;).
+
+ pdl> $im = sequence(5,5)
+ pdl> p $im
+
+ [
+ [ 0 1 2 3 4]
+ [ 5 6 7 8 9]
+ [10 11 12 13 14]
+ [15 16 17 18 19]
+ [20 21 22 23 24]
+ ]
+
+ pdl> help vars
+ PDL variables in package main::
+
+ Name Type Dimension Flow State Mem
+ ----------------------------------------------------------------
+ $im Double D [5,5] P 0.20Kb
+
+[ here it might be appropriate to quickly talk about the
+C<help vars> command
+that provides information about pdls in the interactive
+C<perldl> or C<pdl2> shell that comes with PDL.
+]
+
+Now suppose we want to create a 1-D pdl that just references
+one line of the image, say line 2; or a pdl that represents all even
+lines of the image (imagine we have to deal with even and odd frames
+of an interlaced image due to some peculiar behaviour of our frame
+grabber). As another frequent application of slices we might want to
+create a pdl that represents a rectangular region of the image with
+top and bottom reversed. All these effects (and many more) can be
+easily achieved with the powerful slice function:
+
+ pdl> $line = $im->slice(':,(2)')
+ pdl> $even = $im->slice(':,1:-1:2')
+ pdl> $area = $im->slice('3:4,3:1')
+ pdl> help vars # or just PDL->vars
+ PDL variables in package main::
+
+ Name Type Dimension Flow State Mem
+ ----------------------------------------------------------------
+ $even Double D [5,2] -C 0.00Kb
+ $im Double D [5,5] P 0.20Kb
+ $line Double D [5] -C 0.00Kb
+ $area Double D [2,3] -C 0.00Kb
+
+All three "child" pdls are children of C<$im> or in the other (largely
+equivalent) interpretation pointers to data of C<$im>. Operations on
+those virtual pdls access only those portions of the data as specified
+by the argument to slice. So we can just print line 2:
+
+ pdl> p $line
+ [10 11 12 13 14]
+
+Also note the difference in the "Flow State" of C<$area> above
+and below:
+
+ pdl> p $area
+ pdl> help $area
+ This variable is Double D [2,3] VC 0.00Kb
+
+The following demonstrates that C<$im> and C<$line> really behave as you
+would expect from a pointer-like object (or in the dataflow picture:
+the changes in C<$line>'s data are propagated back to C<$im>):
+
+ pdl> $im++
+ pdl> p $line
+ [11 12 13 14 15]
+ pdl> $line += 2
+ pdl> p $im
+
+ [
+ [ 1 2 3 4 5]
+ [ 6 7 8 9 10]
+ [13 14 15 16 17]
+ [16 17 18 19 20]
+ [21 22 23 24 25]
+ ]
+
+Note how assignment operations on the child virtual pdls change the
+parent physical pdl and vice versa (however, the basic "=" assignment
+doesn't, use ".=" to obtain that effect. See below for the reasons).
+The virtual child pdls are
+something like "live links" to the "original" parent pdl. As
+previously said, they can be thought of to work similar to a
+C-pointer. But in contrast to a C-pointer they carry a lot more
+information. Firstly, they specify the structure of the data they
+represent (the dimensionality of the new pdl) and secondly, specify
+how to create this structure from its parents data (the way this works
+is buried in the internals of PDL and not important for you to know
+anyway (unless you want to hack the core in the future or would like
+to become a PDL guru in general (for a definition of this strange
+creature see L<PDL::Internals|PDL::Internals>)).
+
+The previous examples have demonstrated typical usage of the slice
+function. Since the slicing functionality is so important here is an
+explanation of the syntax for the string argument to slice:
+
+ $vpdl = $a->slice('ind0,ind1...')
+
+where C<ind0> specifies what to do with index No 0 of the pdl C<$a>,
+etc. Each element of the comma separated list can have one of the
+following forms:
+
+=over 6
+
+=item ':'
+
+Use the whole dimension
+
+=item 'n'
+
+Use only index C<n>. The dimension of this index in the
+resulting virtual pdl is 1. An example involving those first two index
+formats:
+
+ pdl> $column = $im->slice('2,:')
+ pdl> $row = $im->slice(':,0')
+ pdl> p $column
+
+ [
+ [ 3]
+ [ 8]
+ [15]
+ [18]
+ [23]
+ ]
+
+ pdl> p $row
+
+ [
+ [1 2 3 4 5]
+ ]
+
+ pdl> help $column
+ This variable is Double D [1,5] VC 0.00Kb
+
+ pdl> help $row
+ This variable is Double D [5,1] VC 0.00Kb
+
+=item '(n)'
+
+Use only index C<n>. This dimension is removed from the
+resulting pdl (relying on the fact that a dimension of size 1 can always be
+removed). The distinction between this case and the previous one
+becomes important in assignments where left and right hand side have to
+have appropriate dimensions.
+
+ pdl> $line = $im->slice(':,(0)')
+ pdl> help $line
+ This variable is Double D [5] -C 0.00Kb
+
+ pdl> p $line
+ [1 2 3 4 5]
+
+Spot the difference to the previous example?
+
+=item 'n1:n2' or 'n1:n2:n3'
+
+Take the range of indices from C<n1> to C<n2> or (second form)
+take the range of indices from C<n1> to C<n2> with step
+C<n3>. An example for the use of this format is the previous
+definition of the sub-image composed of even lines.
+
+ pdl> $even = $im->slice(':,1:-1:2')
+
+This example also demonstrates that negative indices work like they do
+for normal Perl style arrays by counting backwards from the end of the
+dimension. If C<n2> is smaller than C<n1> (in the example -1 is
+equivalent to index 4) the elements in the virtual pdl are effectively
+reverted with respect to its parent.
+
+=item '*[n]'
+
+Add a dummy dimension. The size of this dimension will be 1 by default
+or equal to C<n> if the optional numerical argument is given.
+
+Now, this is really something a bit strange on first sight. What is a
+dummy dimension? A dummy dimension inserts a dimension where there
+wasn't one before. How is that done ? Well, in the case of the new
+dimension having size 1 it can be easily explained by the way in which
+you can identify a vector (with C<m> elements) with an C<(1,m)> or C<(m,1)>
+matrix. The same holds obviously for higher dimensional objects. More
+interesting is the case of a dummy dimensions of size greater than one
+(e.g. C<slice('*5,:')>). This works in the same way as a call to the
+L<dummy|PDL::Core/dummy> function creates a new dummy dimension.
+So read on and check
+its explanation below.
+
+=item '([n1:n2[:n3]]=i)'
+
+[Not yet implemented ??????]
+With an argument like this you make I<generalised diagonals>. The
+I<diagonal> will be dimension no. C<i> of the new output pdl and (if
+optional part in brackets specified) will extend along the range of
+indices specified of the respective parent pdl's dimension. In general
+an argument like this only makes sense if there are other arguments
+like this in the same call to slice. The part in brackets is optional
+for this type of argument. All arguments of this type that specify the
+same target dimension C<i> have to relate to the same number of
+indices in their parent dimension. The best way to explain it is probably to
+give an example, here we make a pdl that refers to the elements along
+the space diagonal of its parent pdl (a cube):
+
+ $cube = zeroes(5,5,5);
+ $sdiag = $cube->slice('(=0),(=0),(=0)');
+
+The above command creates a virtual pdl that represents the diagonal
+along the parents' dimension no. 0, 1 and 2 and makes its dimension 0
+(the only dimension) of it. You use the extended syntax if the
+dimension sizes of the parent dimensions you want to build the
+diagonal from have different sizes or you want to reverse the sequence
+of elements in the diagonal, e.g.
+
+ $rect = zeroes(12,3,5,6,2);
+ $vpdl = $rect->slice('2:7,(0:1=1),(4),(5:4=1),(=1)');
+
+So the elements of $vpdl will then be related to those of its parent
+in way we can express as:
+
+ vpdl(i,j) = rect(i+2,j,4,5-j,j) 0<=i<5, 0<=j<2
+
+=back
+
+[ work in the new index function: C<$b = $a-E<gt>index($c);> ???? ]
+
+=head2 There are different kinds of assignments in PDL
+
+The previous examples have already shown that virtual pdls can be used
+to operate on or access portions of data of a parent pdl. They can
+also be used as lvalues in assignments (as the use of C<++> in some of
+the examples above has already demonstrated). For explicit assignments
+to the data represented by a virtual pdl you have to use the
+overloaded C<.=> operator (which in this context we call I<propagated
+assignment>). Why can't you use the normal assignment operator C<=>?
+
+Well, you definitely still can use the '=' operator but it wouldn't do
+what you want. This is due to the fact that the '=' operator cannot be
+overloaded in the same way as other assignment operators. If we tried
+to use '=' to try to assign data to a portion of a physical pdl
+through a virtual pdl we wouldn't achieve the desired effect (instead
+the variable representing the virtual pdl (a reference to a
+blessed thingy) would after the assignment just contain the reference
+to another blessed thingy which would behave to future assignments as
+a "physical" copy of the original rvalue [this is actually not yet
+clear and subject of discussions in the PDL developers mailing
+list]. In that sense it would break the connection of the pdl to the
+parent [ isn't this behaviour in a sense the opposite of what happens in
+dataflow, where C<.=> breaks the connection to the parent? ].
+
+E.g.
+
+ pdl> $line = $im->slice(':,(2)')
+ pdl> $line = zeroes(5);
+ pdl> $line++;
+ pdl> p $im
+
+ [
+ [ 1 2 3 4 5]
+ [ 6 7 8 9 10]
+ [13 14 15 16 17]
+ [16 17 18 19 20]
+ [21 22 23 24 25]
+ ]
+
+ pdl> p $line
+ [1 1 1 1 1]
+
+But using C<.=>
+
+ pdl> $line = $im->slice(':,(2)')
+ pdl> $line .= zeroes(5)
+ pdl> $line++
+ pdl> p $im
+
+ [
+ [ 1 2 3 4 5]
+ [ 6 7 8 9 10]
+ [ 1 1 1 1 1]
+ [16 17 18 19 20]
+ [21 22 23 24 25]
+ ]
+
+ pdl> print $line
+ [1 1 1 1 1]
+
+Also, you can substitute
+
+ pdl> $line .= 0;
+
+for the assignment above (the zero is converted to a scalar piddle,
+with no dimensions so it can be assigned to any piddle).
+
+A nice feature in recent perl versions is lvalue subroutines
+(i.e., versions 5.6.x and higher including all perls currently
+supported by PDL). That allows one to use the slicing syntax
+on both sides of the assignment:
+
+ pdl> $im->slice(':,(2)') .= zeroes(5)->xvals->float
+
+Related to the lvalue sub assignment feature is a little trap
+for the unwary: recent perls introduced a "feature" which breaks
+PDL's use of lvalue subs for slice assignments when running under
+the perl debugger, C<perl -d>. Under the debugger, the above
+usage gives an error like:
+C< Can't return a temporary from lvalue subroutine... >
+So you must use syntax like this:
+
+ pdl> ($pdl = $im->slice(':,(2)')) .= zeroes(5)->xvals->float
+
+which works both with and without the debugger but is arguably
+clumsy and awkward to read.
+
+Note that there can be a problem with assignments like this when
+lvalue and rvalue pdls refer to overlapping portions of data in the
+parent pdl:
+
+ # revert the elements of the first line of $a
+ ($tmp = $a->slice(':,(1)')) .= $a->slice('-1:0,(1)');
+
+Currently, the parent data on the right side of the assignments is not
+copied before the (internal) assignment loop proceeds. Therefore, the
+outcome of this assignment will depend on the sequence in which
+elements are assigned and almost certainly I<not> do what you
+wanted. So the semantics are currently B<undefined> for now and liable
+to change anytime. To obtain the desired behaviour, use
+
+ ($tmp = $a->slice(':,(1)')) .= $a->slice('-1:0,(1)')->copy;
+
+which makes a physical copy of the slice or
+
+ ($tmp = $a->slice(':,(1)')) .= $a->slice('-1:0,(1)')->sever;
+
+which returns the same slice but severs the connection of the slice
+to its parent.
+
+=head2 Other functions that manipulate dimensions
+
+Having talked extensively about the
+L<slice|PDL::Slices/slice> function it should be
+noted that this is not the only PDL indexing function. There
+are additional indexing functions which are also useful
+(especially in the context of threading which we will talk about
+later). Here are a list and some examples how to use them.
+
+=over 4
+
+=item C<dummy>
+
+inserts a dummy dimension of the size you specify (default 1) at the
+chosen location. You can't wait to hear how that is achieved? Well,
+all elements with index C<(X,x,Y)> (C<0E<lt>=xE<lt>size_of_dummy_dim>) just map to
+the element with index C<(X,Y)> of the parent pdl (where C<X> and C<Y> refer to
+the group of indices before and after the location where the dummy
+dimension was inserted.)
+
+This example calculates the x coordinate of the centroid of an
+image (later we will learn that we didn't actually need the dummy
+dimension thanks to the magic of implicit threading; but using dummy
+dimensions the code would also work in a thread-less world; though once
+you have worked with PDL threads you wouldn't want to live without
+them again).
+
+ # centroid
+ ($xd,$yd) = $im->dims;
+ $xc = sum($im*xvals(zeroes($xd))->dummy(1,$yd))/sum($im);
+
+Let's explain how that works in a little more detail. First, the
+product:
+
+ $xvs = xvals(zeroes($xd));
+ print $xvs->dummy(1,$yd); # repeat the line $yd times
+ $prod = $im*xvs->dummy(1,$yd); # form the pixel-wise product with
+ # the repeated line of x-values
+
+The rest is then summing the results of the pixel-wise product together
+and normalizing with the sum of all pixel values in the original image
+thereby calculating the x-coordinate of the "center of mass" of the
+image (interpreting pixel values as local mass) which is known as the
+centroid of an image.
+
+Next is a (from the point of view of memory consumption) very
+cheap conversion from grey-scale to RGB, i.e. every pixel holds now a
+triple of values instead of a scalar. The three values in the triple
+are, fortunately, all the same for a grey image, so that our trick
+works well in that it maps all the three members of the triple to the
+same source element:
+
+ # a cheap grey-scale to RGB conversion
+ $rgb = $grey->dummy(0,3)
+
+Unfortunately this trick cannot be used to convert your old B/W
+photos to color ones in the way you'd like. :(
+
+Note that the memory usage of piddles with dummy dimensions
+is especially sensitive to the internal representation. If the piddle
+can be represented as a virtual affine (``vaffine'') piddle,
+only the control structures are stored. But if C<$b> in
+
+ $a = zeroes(10000);
+ $b = $a->dummy(1,10000);
+
+is made physical by some routine, you will find that the memory usage
+of your program has suddenly grown by 100Mb.
+
+=item C<diagonal>
+
+replaces two dimensions (which have to be of equal size) by one
+dimension that references all the elements along the "diagonal" along
+those two dimensions. Here, we have two examples which should appear
+familiar to anyone who has ever done some linear algebra. Firstly,
+make a unity matrix:
+
+ # unity matrix
+ $e = zeroes(float, 3, 3); # make everything zero
+ ($tmp = $e->diagonal(0,1)) .= 1; # set the elements along the diagonal to 1
+ print $e;
+
+Or the other diagonal:
+
+ ($tmp = $e->slice(':-1:0')->diagonal(0,1)) .= 2;
+ print $e;
+
+(Did you notice how we used the slice function to revert the sequence
+of lines before setting the diagonal of the new child, thereby setting
+the cross diagonal of the parent ?) Or a mapping from the space of
+diagonal matrices to the field over which the matrices are defined,
+the trace of a matrix:
+
+ # trace of a matrix
+ $trace = sum($mat->diagonal(0,1)); # sum all the diagonal elements
+
+=item C<xchg> and C<mv>
+
+L<xchg|PDL::Slices/xchg> exchanges or "transposes" the two specified dimensions.
+A straightforward example:
+
+ # transpose a matrix (without explicitly reshuffling data and
+ # making a copy)
+ $prod = $a x $a->xchg(0,1);
+
+C<$prod> should now be pretty close to the unity matrix if C<$a> is an
+orthogonal matrix. Often C<xchg> will be used in the context of threading
+but more about that later.
+
+L<mv|PDL::Slices/mv> works in a similar fashion. It moves a dimension (specified by
+its number in the parent) to a new position in the new child pdl:
+
+ $b = $a->mv(4,0); # make the 5th dimension of $a the first in the
+ # new child $b
+
+The difference between C<xchg> and C<mv> is that C<xchg> only changes
+the position of two dimensions with each other, whereas C<mv>
+inserts the first dimension to the place of second, moving the other
+dimensions around accordingly.
+
+=item C<clump>
+
+collapses several dimensions into one. Its only argument specifies how
+many dimensions of the source pdl should be collapsed (starting from
+the first). An (admittedly unrealistic) example is a 3D pdl which
+holds data from a stack of image files that you have just read
+in. However, the data from each image really represents a 1D time
+series and has only been arranged that way because it was digitized
+with a frame grabber. So to have it again as an array of time
+sequences you say
+
+ pdl> $seqs = $stack->clump(2)
+ pdl> help vars
+ PDL variables in package main::
+
+ Name Type Dimension Flow State Mem
+ ----------------------------------------------------------------
+ $seqs Double D [8000,50] -C 0.00Kb
+ $stack Double D [100,80,50] P 3.05Mb
+
+Unrealistic as it may seem, our confocal microscope software writes
+data (sometimes) this way. But more often you use clump to achieve a
+certain effect when using implicit or explicit threading.
+
+=back
+
+=head2 Calls to indexing functions can be chained
+
+As you might have noticed in some of the examples above calls to the
+indexing functions can be nicely chained since all of these functions
+return a newly created child object. However, when doing extensive
+index manipulations in a chain be sure to keep track of what you are
+doing, e.g.
+
+ $a->xchg(0,1)->mv(0,4)
+
+moves the dimension 1 of C<$a> to position 4 since when the
+second command is executed the original dimension 1 has been moved
+to position 0 of the new child that calls the C<mv> function. I think
+you get the idea (in spite of my convoluted explanations).
+
+=head2 Propagated assignments ('.=') and dummy dimensions
+
+A sublety related to indexing is the assignment to pdls containing dummy
+dimensions of size greater than 1. These assignments (using C<.=>) are
+forbidden since several elements of the lvalue pdl point to the same
+element of the parent. As a consequence the value of those parent
+elements are potentially ambiguous and would depend on the sequence in
+which the implementation makes the assignments to elements. Therefore,
+an assignment like this:
+
+ $a = pdl [1,2,3];
+ $b = $a->dummy(1,4);
+ $b .= yvals(zeroes(3,4));
+
+can produce unexpected results and the results are explicitly
+B<undefined> by PDL because when PDL gets parallel computing
+features, the current result may well change.
+
+From the point of view of dataflow the introduction of
+greater-size-than-one dummy dimensions is regarded as an irreversible
+transformation (similar to the terminology in thermodynamics) which
+precludes backward propagation of assignment to a parent (which you had
+explicitly requested using the C<.=> assignment). A similar problem to
+watch out for occurs in the context of threading where sometimes
+dummy dimensions are created implicitly during the thread loop (see below).
+
+=head2 Reasons for the parent/child (or "pointer") concept
+
+[ this will have to wait a bit ]
+
+ XXXXX being memory efficient
+ XXXXX in the context of threading
+ XXXXX very flexible and powerful way of accessing portions of pdl data
+ (in much more general way than sec, etc allow)
+ XXXXX efficient implementation
+ XXXXX difference to section/at, etc.
+
+=head2 How to make things physical again
+
+[ XXXXX fill in later when everything has settled a bit more ]
+
+ ** When needed (xsub routine interfacing C lib function)
+ ** How achieved (->physical)
+ ** How to test (isphysical (explain how it works currently))
+ ** ->copy and ->sever
+
+=head1 Threading
+
+In the previous paragraph on indexing we have already mentioned the
+term occasionally but now its really time to talk explicitly about
+"threading" with pdls. The term threading has many different meanings in
+different fields of computing. Within the framework of PDL it could
+probably be loosely defined as an implicit looping
+facility. It is implicit because you don't specify anything like
+enclosing for-loops but rather the loops are automatically (or
+'magically') generated by PDL based on the dimensions of the pdls
+involved. This should give you a first idea why the index/dimension
+manipulating functions you have met in the previous paragraphs are
+especially important and useful in the context of threading.
+The other ingredient for threading (apart from the pdls involved) is
+a function that is threading aware (generally, these are
+L<PDL::PP|PDL::PP> compiled functions) and that the pdls are "threaded" over.
+So much about the terminology and now let's try to shed some light on what it
+all means.
+
+=head2 Implicit threading - a first example
+
+There are two slightly different variants of threading. We start
+with what we call "implicit threading". Let's pick a practical example
+that involves looping of a function over many elements of a
+pdl. Suppose we have an RGB image that we want to convert to
+grey-scale. The RGB image is represented by a 3-dim pdl C<im(3,x,y)> where
+the first dimension contains the three color components of each pixel and C<x>
+and C<y> are width and height of the image, respectively. Next we need to
+specify how to convert a color-triple at a given pixel into a
+grey-value (to be a realistic example it should represent the relative
+intensity with which our color insensitive eye cells would detect that
+color to achieve what we would call a natural conversion from color to
+grey-scale). An approximation that works quite well is to compute the
+grey intensity from each RGB triplet (r,g,b) as a weighted sum
+
+ grey-value = 77/256*r + 150/256*g + 29/256*b =
+ inner([77,150,29]/256, [r,g,b])
+
+where the last form indicates that we can write this as an inner
+product of the 3-vector comprising the weights for red, green and blue
+components with the 3-vector containing the color
+components. Traditionally, we might have written a function like the
+following to process the whole image:
+
+ my @dims=$im->dims;
+ # here normally check that first dim has correct size (3), etc
+ $grey=zeroes(@dims[1,2]); # make the pdl for the resulting grey image
+ $w = pdl [77,150,29] / 256; # the vector of weights
+ for ($j=0;$j<dims[2];$j++) {
+ for ($i=0;$i<dims[1];$i++) {
+ # compute the pixel value
+ $tmp = inner($w,$im->slice(':,(i),(j)'));
+ set($grey,$i,$j,$tmp); # and set it in the grey-scale image
+ }
+ }
+
+Now we write the same using threading (noting that C<inner> is a threading
+aware function defined in the L<PDL::Primitive|PDL::Primitive> package)
+
+ $grey = inner($im,pdl([77,150,29]/256));
+
+We have ended up with a one-liner that automatically
+creates the pdl C<$grey> with the right number and size of dimensions and
+performs the loops automatically (these loops are implemented as fast C code
+in the internals of PDL).
+Well, we
+still owe you an explanation how this 'magic' is achieved.
+
+=head2 How does the example work ?
+
+The first thing to note is that every function that is threading aware
+(these are without exception functions compiled from concise
+descriptions by L<PDL::PP|PDL::PP>, later just called PP-functions) expects a
+defined (minimum) number of dimensions (we call them core dimensions)
+from each of its pdl arguments. The L<inner|PDL::Primitive/inner> function
+expects two one-dimensional (input) parameters from which it calculates a
+zero-dimensional (output) parameter. We write that symbolically as
+C<inner((n),(n),[o]())> and call it C<inner>'s I<signature>, where n
+represents the size of that dimension. n being equal in the first and
+second parameter means that those dimensions have to be of equal size
+in any call. As a different example take the outer product which takes
+two 1D vectors to generate a 2D matrix, symbolically written as
+C<outer((n),(m),[o](n,m))>. The C<[o]> in both examples indicates that
+this (here third) argument is an output argument. In the latter
+example the dimensions of first and second argument don't have to
+agree but you see how they determine the size of the two dimensions of
+the output pdl.
+
+Here is the point when threading finally enters the game. If you call
+PP-functions with pdls that have I<more> than the required core
+dimensions the first dimensions of the pdl arguments are used as the
+core dimensions and the additional extra dimensions are threaded
+over. Let us demonstrate this first with our example above
+
+ $grey = inner($im,$w); # w is the weight vector from above
+
+In this case $w is 1D and so supplied just the core dimension, C<$im> is
+3D, more specifically C<(3,x,y)>. The first dimension (of size 3) is the
+required core dimension that matches (as required by inner) the first
+(and only) dimension of C<$w>. The second dimension is the first thread
+dimension (of size C<x>) and the third is here the second thread
+dimension (of size C<y>). The output pdl is automatically created (as
+requested by setting C<$grey> to "null" prior to invocation). The output
+dimensions are obtained by appending the I<loop dimensions> (here
+C<(x,y)>) to the core output dimensions (here 0D) to yield the final
+dimensions of the auto-created pdl (here C<0D+2D=2D> to yield a 2D
+output of size C<(x,y)>).
+
+So the above command calls the core functionality that computes the inner
+product of two 1D vectors C<x*y> times with C<$w> and all 1D slices of the
+form C<(':,(i),(j)')> of C<$im> and sets the respective elements of the
+output pdl C<$grey(i,j)> to the result of each computation. We could
+write that symbolically as
+
+ $grey(0,0) = f($w,$im(:,(0),(0)))
+ $grey(1,0) = f($w,$im(:,(1),(0)))
+ .
+ .
+ .
+ $grey(x-2,y-1) = f($w,$im(:,(x-2),(y-1)))
+ $grey(x-1,y-1) = f($w,$im(:,(x-1),(y-1)))
+
+But this is done automatically by PDL without writing any explicit
+Perl loops. We see that the command really creates an output pdl with
+the right dimensions and sets the elements indeed to the result of the
+computation for each pixel of the input image.
+
+When even more pdls and extra dimensions are involved things get a bit
+more complicated. We will first give the general rules how the thread
+dimensions depend on the dimensions of input pdls enabling you to
+figure out the dimensionality of an auto-created output pdl (for any
+given set of input pdls and core dimensions of the PP-function in
+question). The general rules will most likely appear a bit confusing
+on first sight so that we'll set out to illustrate the usage with a set
+of further examples (which will hopefully also demonstrate that there
+are indeed many practical situations where threading comes in extremely
+handy).
+
+=head2 A call for coding discipline
+
+Before we point out the other technical details of threading, please
+note this call for programming discipline when using threading:
+
+In order to preserve human readability, I<PLEASE> comment any nontrivial
+expression in your code involving threading. Most importantly, for
+any subroutine, include information at the beginning about what you
+expect the dimensions to represent (or ranges of dimensions).
+
+As a warning, look at this undocumented function and try to guess what
+might be going on:
+
+ sub lookup {
+ my ($im,$palette) = @_;
+ my $res;
+ index($palette->xchg(0,1),
+ $im->long->dummy(0,($palette->dim)[0]),
+ ($res=null));
+ return $res;
+ }
+
+Would you agree that it might be difficult to figure out expected
+dimensions, purpose of the routine, etc ?
+(If you want to find out what this piece of code does, see below)
+
+=head2 How to figure out the loop dimensions
+
+There are a couple of rules that allow you to figure out number and
+size of loop dimensions (and if the size of your input pdls comply
+with the threading rules). Dimensions of any pdl argument are broken
+down into two groups in the following: Core dimensions (as defined by
+the PP-function, see B<Appendix B> for a list of PDL primitives) and
+extra dimensions which comprises all remaining dimensions of that
+pdl. For example calling a function C<func> with the signature
+C<func((n,m),[o](n))> with a pdl C<a(2,4,7,1,3)> as C<f($a,($o = null))>
+results in the semantic splitting of a's dimensions into:
+core dimensions C<(2,4)> and extra dimensions C<(7,1,3)>.
+
+=over 6
+
+=item R0
+
+Core dimensions are identified with the first N dimensions of the
+respective pdl argument (and are required). Any further dimensions are
+extra dimensions and used to determine the loop dimensions.
+
+=item R1
+
+The number of (implicit) loop dimensions is equal to the maximal
+number of extra dimensions taken over the set of pdl arguments.
+
+=item R2
+
+The size of each of the loop dimensions is derived from the size
+of the respective dimensions of the pdl arguments. The size of a
+loop dimension is given by the maximal size found in any of
+the pdls having this extra dimension.
+
+=item R3
+
+For all pdls that have a given extra dimension the size must be
+equal to the size of the loop dimension (as determined by the
+previous rule) or 1; otherwise you raise a runtime exception. If the
+size of the extra dimension in a pdl is one it is implicitly treated
+as a dummy dimension of size equal to that loop dim size when
+performing the thread loop.
+
+=item R4
+
+If a pdl doesn't have a loop dimension, in the thread loop this
+pdl is treated as if having a dummy dimension of size equal to the
+size of that loop dimension.
+
+=item R5
+
+If output auto-creation is used (by setting the relevant pdl to
+C<PDL-E<gt>null> before invocation) the number of dimensions of the created
+pdl is equal to the sum of the number of core output dimensions +
+number of loop dimensions. The size of the core output dimensions is
+derived from the relevant dimension of input pdls (as specified in the
+function definition) and the sizes of the other dimensions are equal
+to the size of the loop dimension it is derived from. The
+automatically created pdl will be physical (unless dataflow is in
+operation).
+
+=back
+
+In this context, note that you can run into the problem with
+assignment to pdls containing greater-than-one dummy dimensions (see above).
+Although your output pdl(s) didn't contain any dummy dimensions in the
+first place they may end up with implicitly created dummy dimensions
+according to I<R4>.
+
+As an example, suppose we have a (here unspecified) PP-function with
+the signature:
+
+ func((m,n),(m,n,o),(m),[o](m,o))
+
+and you call it with 3 pdls C<a(5,3,10,11)>,
+C<b(5,3,2,10,1,12)>, and C<c(5,1,11,12)> as
+
+ func($a,$b,$c,($d=null))
+
+then the number of loop dimensions is 3 (by C<R0+R1> from C<$b> and C<$c>) with
+sizes C<(10,11,12)> (by R2); the two output core dimensions are C<(5,2)>
+(from the signature of func) resulting in a 5-dimensional output pdl
+C<$c> of size C<(5,2,10,11,12)> (see R5) and (the automatically created) C<$d>
+is derived from C<($a,$b,$c)> in a way that can be expressed in pdl
+pseudo-code as
+
+ $d(:,:,i,j,k) .= func($a(:,:,i,j),$b(:,:,:,i,0,k),$c(:,0,j,k))
+ with 0<=i<10, 0<=j<=11, 0<=k<12
+
+If we analyze the color to grey-scale conversion again with these rules
+in mind we note another great advantage of implicit threading.
+We can call the conversion with a pdl representing a pixel (C<im(3)>),
+a line of rgb pixels (C<im(3,x)>), a proper color image (C<im(3,x,y)>) or a
+whole stack of RGB images (C<im(3,x,y,z)>). As long as C<$im> is of the form
+C<(3,...)> the automatically created output pdl will contain the right
+number of dimensions and contain the intensity data as we expect it
+since the loops have been implicitly performed thanks to I<implicit
+threading>. You can easily convince yourself that calling with a color
+pixel C<$grey> is 0D, with a line it turns out 1D C<grey(x)>, with an image
+we get C<grey(x,y)> and finally we get a converted image stack C<grey(x,y,z)>.
+
+Let's fill these general rules with some more life by going through a
+couple of further examples. The reader may try to figure out equivalent
+formulations with explicit for-looping and compare the flexibility of
+those routines using implicit threading to the explicit
+formulation. Furthermore, especially when using several thread
+dimensions it is a useful exercise to check the relative speed
+by doing some benchmark tests (which we still have to do).
+
+First in the row is a slightly reworked centroid example, now coded
+with threading in mind.
+
+ # threaded mult to calculate centroid coords, works for stacks as well
+ $xc = sumover(($im*xvals(($im->dims)[0]))->clump(2)) /
+ sumover($im->clump(2));
+
+Let's analyze what's going on step by step. First the product:
+
+ $prod = $im*xvals(zeroes(($im->dims)[0]))
+
+This will actually work for C<$im> being one, two, three, and higher
+dimensional. If C<$im> is one-dimensional it's just an ordinary product
+(in the sense that every element of C<$im> is multiplied with the
+respective element of C<xvals(...)>), if C<$im> has more dimensions further
+threading is done by adding appropriate dummy dimensions to C<xvals(...)>
+according to R4.
+More importantly, the two L<sumover|PDL::Ufunc/sumover> operations show
+a first example of how to make use of the dimension manipulating
+commands. A quick look at sumover's signature will remind you that
+it will only "gobble up" the first dimension of a given input pdl. But
+what if we want to really compute the sum over all elements of the
+first two dimensions? Well, nothing keeps us from passing a virtual
+pdl into sumover which in this case is formed by clumping the first
+two dimensions of the "parent pdl" into one. From the point of view of
+the parent pdl the sum is now computed over the first two dimensions,
+just as we wanted, though sumover has just done the job as specified
+by its signature. Got it ?
+
+Another little finesse of writing the code like that: we intentionally
+used C<sumover($pdl-E<gt>clump(2))> instead of C<sum($pdl)> so that we can
+either pass just an image C<(x,y)> or a stack of images C<(x,y,t)> into this
+routine and get either just one x-coordiante or a vector of
+x-coordinates (of size t) in return.
+
+Another set of common operations are what one could call "projection
+operations". These operations take a N-D pdl as input and return a
+(N-1)-D "projected" pdl. These operations are often performed with
+functions like L<sumover|PDL::Ufunc/sumover>,
+L<prodover|PDL::Ufunc/prodover>, L<minimum|PDL::Ufunc/minimum> and
+L<maximum|PDL::Ufunc/maximum>.
+Using again images as examples we might want to calculate
+the maximum pixel value for each line of an image or image stack. We
+know how to do that
+
+ # maxima of lines (as function of line number and time)
+ maximum($stack,($ret=null));
+
+But what if you want to calculate maxima per column when implicit
+threading always applies the core functionality to the first dimension
+and threads over all others? How can we achieve that instead the
+core functionality is applied to the second dimension and threading is
+done over the others. Can you guess it? Yes, we make a virtual pdl
+that has the second dimension of the "parent pdl" as its first
+dimension using the C<mv> command.
+
+ # maxima of columns (as function of column number and time)
+ maximum($stack->mv(1,0),($ret=null));
+
+and calculating all the sums of sub-slices over the third dimension
+is now almost too easy
+
+ # sums of pixels in time (assuming time is the third dim)
+ sumover($stack->mv(2,0),($ret=null));
+
+Finally, if you want to apply the operation to all elements (like max over
+all elements or sum over all elements) regardless of the dimensions of
+the pdl in question C<clump> comes in handy. As an example look at the
+definition of C<sum> (as defined in C<Ufunc.pm>):
+
+ sub sum {
+ PDL::Ufunc::sumover($name->clump(-1),($tmp=null));
+ return $tmp->at(); # return a Perl number, not a 0D pdl
+ }
+
+We have already mentioned that all basic operations support threading
+and assignment is no exception. So here are a couple of threaded
+assignments
+
+ pdl> $im = zeroes(byte, 10,20)
+ pdl> $line = exp(-rvals(10)**2/9)
+ # threaded assignment
+ pdl> $im .= $line # set every line of $im to $line
+ pdl> $im2 .= 5 # set every element of $im2 to 5
+
+By now you probably see how it works and what it does, don't you?
+
+To finish the examples in this paragraph here is a function to create
+an RGB image from what is called a palette image. The palette image
+consists of two parts: an image of indices into a color lookup table
+and the color lookup table itself. [ describe how it works ] We
+are going to use a PP-function we haven't encoutered yet in the previous
+examples. It is the aptly named L<index|PDL::Slices/index> function, signature
+C<((n),(),[o]())> (see B<Appendix B>) with the core functionality that
+C<index(pdl (0,2,4,5),2,($ret=null))> will return the element with index
+2 of the first input pdl. In this case, C<$ret> will contain the value 4.
+So here is the example:
+
+ # a threaded index lookup to generate an RGB, or RGBA or YMCK image
+ # from a palette image (represented by a lookup table $palette and
+ # an color-index image $im)
+ # you can say just dummy(0) since the rules of threading make it fit
+ pdl> index($palette->xchg(0,1),
+ $im->long->dummy(0,($palette->dim)[0]),
+ ($res=null));
+
+Let's go through it and explain the steps involved. Assuming we are
+dealing with an RGB lookup-table $palette is of size C<(3,x)>. First we
+exchange the dimensions of the palette so that looping is done over
+the first dimension of C<$palette> (of size 3 that represent r, g, and b
+components). Now looking at C<$im>, we add a dummy dimension of size
+equal to the length of the number of components (in the case we are
+discussing here we could have just used the number 3 since we have 3
+color components). We can use a dummy dimension since for red, green
+and blue color components we use the same index from the original
+image,
+e.g.
+assuming a certain pixel of C<$im> had the value 4 then the
+lookup should produce the triple
+
+ [palette(0,4),palette(1,4),palette(2,4)]
+
+for the new red, green and
+blue components of the output image. Hopefully by now you have some
+sort of idea what the above piece of code is supposed to do (it is
+often actually quite complicated to describe in detail how a piece of
+threading code works; just go ahead and experiment a bit to get a
+better feeling for it).
+
+If you have read the threading rules carefully, then you might have
+noticed that we didn't have to explicitly state the size of the dummy
+dimension that we created for C<$im>; when we create it with size 1 (the
+default) the rules of threading make it automatically fit to the
+desired size (by rule R3, in our example the size would be 3 assuming
+a palette of size C<(3,x)>). Since situations like this do occur often in
+practice this is actually why rule R3 has been introduced (the part
+that makes dimensions of size 1 fit to the thread loop dim size). So
+we can just say
+
+ pdl> index($palette->xchg(0,1),$im->long->dummy(0),($res=null));
+
+Again, you can convince yourself that this routine will create the
+right output if called with a pixel (C<$im> is 0D), a line (C<$im> is 1D),
+an image (C<$im> is 2D), ..., an RGB lookup table (palette is C<(3,x)>) and
+RGBA lookup table (palette is C<(4,x)>, see e.g. OpenGL). This
+flexibility is achieved by the rules of threading which are made to do
+the right thing in most situations.
+
+To wrap it all up once again, the general idea is as follows. If you
+want to achieve looping over certain dimensions and have the I<core functionality>
+applied to another specified set of dimensions you use
+the dimension manipulating commands to create a (or several)
+I<virtual> pdl(s) so that from the point of view of the I<parent>
+pdl(s) you get what you want (always having the signature of the
+function in question and R1-R5 in mind!). Easy, isn't it ?
+
+=head2 Output auto-creation and PP-function calling conventions
+
+At this point we have to divert to some technical detail that has to
+do with the general calling conventions of PP-functions and the
+automatic creation of output arguments.
+Basically, there are two ways of invoking pdl routines, namely
+
+ $result = func($a,$b);
+
+and
+
+ func($a,$b,$result);
+
+If you are only using implicit threading then the output variable can
+be automatically created by PDL. You flag that to the PP-function by
+setting the output argument to a special kind of pdl that is returned
+from a call to the function C<PDL-E<gt>null> that returns an essentially
+"empty" pdl (for those interested in details there is a flag
+in the C pdl structure for this). The dimensions
+of the created pdl are determined by the rules of implicit
+threading: the first dimensions are the core output dimensions to
+which the threading dimensions are appended (which are in turn
+determined by the dimensions of the input pdls as described above).
+So you can say
+
+ func($a,$b,($result=PDL->null));
+
+or
+
+ $result = func($a,$b)
+
+which are B<exactly> equivalent.
+
+Be warned that you can I<not> use output auto-creation when using
+explicit threading (for reasons explained in the following section on
+B<explicit threading>, the second variant of threading).
+
+In "tight" loops you probably want to avoid the implicit creation of a
+temporary pdl in each step of the loop that comes along with the
+"functional" style but rather say
+
+ # create output pdl of appropriate size only at first invocation
+ $result = null;
+ for (0...$n) {
+ func($a,$b,$result); # in all but the first invocation $result
+ func2($b); # is defined and has the right size to
+ # take the output provided $b's dims don't change
+ twiddle($result,$a); # do something from $result to $a for iteration
+ }
+
+The take-home message of this section once more: be aware of the
+limitation on output creation when using B<explicit threading>.
+
+=head2 Explicit threading
+
+Having so far only talked about the first flavour of threading it is
+now about time to introduce the second variant. Instead of shuffling
+around dimensions all the time and relying on the rules of implicit
+threading to get it all right you sometimes might want to specify in a
+more explicit way how to perform the thread loop. It is probably not
+too surprising that this variant of the game is called I<explicit threading>.
+Now, before we create the wrong impression: it is not
+either I<implicit> or I<explicit>; the two flavours do mix. But more
+about that later.
+
+The two most used functions with explicit threading are
+L<thread|PDL::Core/PDL::thread>
+and L<unthread|PDL::Slices/unthread>.
+We start with an example that illustrates typical
+usage of the former:
+
+ [ # ** this is the worst possible example to start with ]
+ # but can be used to show that $mat += $line is different from
+ # $mat->thread(0) += $line
+ # explicit threading to add a vector to each column of a matrix
+ pdl> $mat = zeroes(4,3)
+ pdl> $line = pdl (3.1416,2,-2)
+ pdl> ($tmp = $mat->thread(0)) += $line
+
+In this example, C<$mat-E<gt>thread(0)> tells PDL that you want the second
+dimension of this pdl to be threaded over first leading to a thread
+loop that can be expressed as
+
+ for (j=0; j<3; j++) {
+ for (i=0; i<4; i++) {
+ mat(i,j) += src(j);
+ }
+ }
+
+C<thread> takes a list of numbers as arguments which explicitly
+specify which dimensions to thread over first. With the introduction
+of explicit threading the dimensions of a pdl are conceptually split into
+three different groups the latter two of which we have already
+encountered: thread dimensions, core dimensions and extra dimensions.
+
+Conceptually, it is best to think of those dimensions of a pdl that
+have been specified in a call to C<thread> as being taken away from
+the set of normal dimensions and put on a separate stack. So assuming
+we have a pdl C<a(4,7,2,8)> saying
+
+ $b = $a->thread(2,1)
+
+creates a new virtual pdl of dimension C<b(4,8)> (which we call the
+remaining dims) that also has 2 thread dimensions of size C<(2,7)>. For
+the purposes of this document we write that symbolically as
+C<b(4,8){2,7}>. An important difference to the previous examples where
+only implicit threading was used is the fact that the core dimensions
+are matched against the I<remaining dimensions> which are not
+necessarily the first dimensions of the pdl. We will now specify how
+the presence of thread dimensions changes the rules R1-R5 for
+thread loops (which apply to the special case where none of the pdl
+arguments has any thread dimensions).
+
+=over 4
+
+=item T0
+
+Core dimensions are matched against the first n I<remaining dimensions>
+of the pdl argument (note the difference to R1). Any
+further I<remaining dimensions> are I<extra dimensions> and are used
+to determine the I<implicit loop dimensions>.
+
+=item T1a
+
+The number of I<implicit loop dimensions> is equal to the maximal
+number of extra dimensions taken over the set of pdl arguments.
+
+=item T1b
+
+The number of I<explicit loop dimensions> is equal to the maximal
+number of thread dimensions taken over the set of pdl arguments.
+
+=item T1c
+
+The total number of I<loop dimensions> is equal to the sum of
+I<explicit loop dimensions> and I<implicit loop dimensions>. In the
+thread loop, I<explicit loop dimensions> are threaded over first
+followed by I<implicit loop dimensions>.
+
+=item T2
+
+The size of each of the I<loop dimensions> is derived from the size of
+the respective dimensions of the pdl arguments. It is given by the
+maximal size found in any pdls having this thread dimension (for
+I<explicit loop dimensions>) or extra dimension (for
+I<implicit loop dimensions>).
+
+=item T3
+
+This rule applies to any I<explicit loop dimension> as well as any
+I<implicit loop dimension>. For all pdls that have a given
+I<thread/extra dimension> the size must be equal to the size of the
+respective I<explicit/implicit loop dimension> or 1; otherwise you
+raise a runtime exception. If the size of a I<thread/extra dimension>
+of a pdl is one it is implicitly treated as a dummy
+dimension of size equal to the I<explicit/implicit loop dimension>.
+
+=item T4
+
+If a pdl doesn't have a I<thread/extra dimension> that corresponds to
+an I<explicit/implicit loop dimension>, in the thread loop this
+pdl is treated as if having a dummy dimension of size equal to the
+size of that loop dimension.
+
+=item T4a
+
+All pdls that do have I<thread dimensions> must have the same number of
+thread dimensions.
+
+=item T5
+
+Output auto-creation cannot be used if any of the pdl arguments has any
+I<thread dimensions>. Otherwise R5 applies.
+
+=back
+
+The same restrictions apply with regard to implicit dummy dimensions
+(created by application of T4) as already mentioned in the section
+on implicit threading: if any of the output pdls has an (explicit or
+implicitly created) greater-than-one dummy dimension a runtime
+exception will be raised.
+
+Let us demonstrate these rules at work in a generic case.
+Suppose we have a (here unspecified) PP-function with
+the signature:
+
+ func((m,n),(m),(),[o](m))
+
+and you call it with 3 pdls C<a(5,3,10,11)>, C<b(3,5,10,1,12)>, C<c(10)> and an
+output pdl C<d(3,11,5,10,12)> (which can here I<not> be automatically
+created) as
+
+ func($a->thread(1,3),$b->thread(0,3),$c,$d->thread(0,1))
+
+From the signature of func and the above call the pdls split into
+the following groups of core, extra and thread dimensions (written in
+the form C<pdl(core dims){thread dims}[extra dims]>):
+
+ a(5,10){3,11}[] b(5){3,1}[10,12] c(){}[10] d(5){3,11}[10,12]
+
+With this to help us along (it is in general helpful to write the
+arguments down like this when you start playing with threading and
+want to keep track of what is going on) we further deduce
+that the number of explicit loop dimensions is 2 (by T1b from C<$a> and C<$b>)
+with sizes C<(3,11)> (by T2); 2 implicit loop dimensions (by T1a from C<$b>
+and C<$d>) of size C<(10,12)> (by T2) and the elements of are computed from
+the input pdls in a way that can be expressed in pdl pseudo-code as
+
+ for (l=0;l<12;l++)
+ for (k=0;k<10;k++)
+ for (j=0;j<11;j++) effect of treating it as dummy dim (index j)
+ for (i=0;i<3;i++) |
+ d(i,j,:,k,l) = func(a(:,i,:,j),b(i,:,k,0,l),c(k))
+
+Ugh, this example was really not easy in terms of bookkeeping. It
+serves mostly as an example how to figure out what's going on when you
+encounter a complicated looking expression. But now it is really time
+to show that threading is useful by giving some more of our so called
+"practical" examples.
+
+[ The following examples will need some additional explanations in the
+future. For the moment please try to live with the comments in the
+code fragments. ]
+
+Example 1:
+
+ *** inverse of matrix represented by eigvecs and eigvals
+ ** given a symmetrical matrix M = A^T x diag(lambda_i) x A
+ ** => inverse M^-1 = A^T x diag(1/lambda_i) x A
+ ** first $tmp = diag(1/lambda_i)*A
+ ** then A^T * $tmp by threaded inner product
+ # index handling so that matrices print correct under pdl
+ $inv .= $evecs*0; # just copy to get appropriately sized output
+ $tmp .= $evecs; # initialise, no back-propagation
+ ($tmp2 = $tmp->thread(0)) /= $evals; # threaded division
+ # and now a matrix multiplication in disguise
+ PDL::Primitive::inner($evecs->xchg(0,1)->thread(-1,1),
+ $tmp->thread(0,-1),
+ $inv->thread(0,1));
+ # alternative for matrix mult using implicit threading,
+ # first xchg only for transpose
+ PDL::Primitive::inner($evecs->xchg(0,1)->dummy(1),
+ $tmp->xchg(0,1)->dummy(2),
+ ($inv=null));
+
+Example 2:
+
+ # outer product by threaded multiplication
+ # stress that we need to do it with explicit call to my_biop1
+ # when using explicit threading
+ $res=zeroes(($a->dims)[0],($b->dims)[0]);
+ my_biop1($a->thread(0,-1),$b->thread(-1,0),$res->(0,1),"*");
+ # similar thing by implicit threading with auto-created pdl
+ $res = $a->dummy(1) * $b->dummy(0);
+
+
+Example 3:
+
+ # different use of thread and unthread to shuffle a number of
+ # dimensions in one go without lots of calls to ->xchg and ->mv
+
+
+ # use thread/unthread to shuffle dimensions around
+ # just try it out and compare the child pdl with its parent
+ $trans = $a->thread(4,1,0,3,2)->unthread;
+
+Example 4:
+
+ # calculate a couple of bounding boxes
+ # $bb will hold BB as [xmin,xmax],[ymin,ymax],[zmin,zmax]
+ # we use again thread and unthread to shuffle dimensions around
+ pdl> $bb = zeroes(double, 2,3 );
+ pdl> minimum($vertices->thread(0)->clump->unthread(1), $bb->slice('(0),:'));
+ pdl> maximum($vertices->thread(0)->clump->unthread(1), $bb->slice('(1),:'));
+
+
+Example 5:
+
+ # calculate a self-rationed (i.e. self normalized) sequence of images
+ # uses explicit threading and an implicitly threaded division
+ $stack = read_image_stack();
+ # calculate the average (per pixel average) of the first $n+1 images
+ $aver = zeroes([stack->dims]->[0,1]); # make the output pdl
+ sumover($stack->slice(":,:,0:$n")->thread(0,1),$aver);
+ $aver /= ($n+1);
+ $stack /= $aver; # normalize the stack by doing a threaded division
+ # implicit versus explicit
+ # alternatively calculate $aver with implicit threading and auto-creation
+ sumover($stack->slice(":,:,0:$n")->mv(2,0),($aver=null));
+ $aver /= ($n+1);
+ #
+
+=head2 Implicit versus explicit threading
+
+In this paragraph we are going to illustrate when explicit threading
+is preferable over implicit threading and vice versa. But then again,
+this is probably not the best way of putting the case since you already
+know: the two flavours do mix. So, it's more about how to get the best
+of both worlds and, anyway, in the best of Perl traditions: TIMTOWTDI !
+
+[ Sorry, this still has to be filled in in a later release; either
+refer to above examples or choose some new ones ]
+
+Finally, this may be a good place to justify all the technical detail
+we have been going on about for a couple of pages: why threading ?
+
+Well, code that uses threading should be (considerably) faster than
+code that uses explicit for-loops (or similar Perl constructs) to achieve
+the same functionality. Especially on supercomputers (with vector
+computing facilities/parallel processing) PDL threading will be
+implemented in a way that takes advantage of the additional facilities
+of these machines. Furthermore, it is a conceptually simply
+construct (though technical details might get involved at times) and
+can I<greatly> reduce the syntactical complexity of PDL code (but keep
+the admonition for documentation in mind). Once you
+are comfortable with the I<threading> way of thinking (and coding) it
+shouldn't be too difficult to understand code that somebody else
+has written than (provided he gave
+you an idea what expected input dimensions are, etc.). As a general tip to
+increase the performance of your code: if you have to introduce a loop
+into your code try to reformulate the problem so that you can use
+threading to perform the loop (as with anything there are exceptions
+to this rule of thumb; but the authors of this document tend to
+think that these are rare cases ;).
+
+=head1 PDL::PP
+
+=head2 An easy way to define functions that are aware of indexing and threading (and the universe and everything)
+
+PDL:PP is part of the PDL distribution. It is used to generate
+functions that are aware of indexing and threading rules from very
+concise descriptions. It can be useful for you if you want to write
+your own functions or if you want to interface functions from an
+external library so that they support indexing and threading (and
+maybe dataflow as well, see L<PDL::Dataflow>). For further details
+check L<PDL::PP>.
+
+=head1 Appendix A
+
+=head2 Affine transformations - a special class of simple and powerful transformations
+
+[ This is also something to be added in future releases. Do we already
+have the general make_affine routine in PDL ? It is possible that we
+will reference another appropriate man page from here ]
+
+=head1 Appendix B
+
+=head2 signatures of standard PDL::PP compiled functions
+
+A selection of signatures of PDL primitives to show how many
+dimensions PP compiled functions gobble up (and therefore you can
+figure out what will be threaded over). Most of those functions are
+the basic ones defined in C<primitive.pd>
+
+ # functions in primitive.pd
+ #
+ sumover ((n),[o]())
+ prodover ((n),[o]())
+ axisvalues ((n)) inplace
+ inner ((n),(n),[o]())
+ outer ((n),(m),[o](n,m))
+ innerwt ((n),(n),(n),[o]())
+ inner2 ((m),(m,n),(n),[o]())
+ inner2t ((j,n),(n,m),(m,k),[o]())
+ index (1D,0D,[o])
+ minimum (1D,[o])
+ maximum (1D,[o])
+ wstat ((n),(n),(),[o],())
+ assgn ((),())
+
+ # basic operations
+ binary operations ((),(),[o]())
+ unary operations ((),[o]())
+
+=head1 AUTHOR & COPYRIGHT
+
+Copyright (C) 1997 Christian Soeller (c.soeller at auckland.ac.nz) & Tuomas
+J. Lukka (lukka at fas.harvard.edu). All rights reserved. Although destined for
+release as a man page with the standard PDL distribution, it is not
+public domain. Permission is granted to freely distribute verbatim
+copies of this document provided that no modifications outside of
+formatting be made, and that this notice remain intact. You are
+permitted and encouraged to use its code and derivatives thereof in
+your own source code for fun or for profit as you see fit.
diff --git a/Basic/Pod/Internals.pod b/Basic/Pod/Internals.pod
new file mode 100644
index 0000000..946a024
--- /dev/null
+++ b/Basic/Pod/Internals.pod
@@ -0,0 +1,605 @@
+=head1 NAME
+
+PDL::Internals - description of some aspects of the current internals
+
+=head1 DESCRIPTION
+
+=head2 Intro
+
+This document explains various aspects of the current implementation
+of PDL. If you just want to use PDL for something, you definitely
+do not need to read this. Even if you want to interface your C routines
+to PDL or create new L<PDL::PP|PDL::PP> functions, you do not need to read this
+man page (though it may be informative). This document is primarily
+intended for people interested in debugging or changing the internals
+of PDL. To read this, a good understanding of the C language
+and programming and data structures in general is required, as well
+as some Perl understanding. If you read through this document
+and understand all of it and are able to point what any part of
+this document refers to in the PDL core sources and additionally
+struggle to understand L<PDL::PP|PDL::PP>, you will be awarded the title
+"PDL Guru" (of course, the current version of this document
+is so incomplete that this is next to impossible from just these notes).
+
+B<Warning:> If it seems that this document has gotten out of date,
+please inform the PDL porters email list (pdl-porters at jach.hawaii.edu).
+This may well happen.
+
+=head2 Piddles
+
+The pdl data object is generally an opaque scalar reference into a
+pdl structure in memory. Alternatively, it may be a hash reference with
+the C<PDL> field containing the scalar reference (this makes overloading
+piddles easy, see L<PDL::Objects|PDL::Objects>). You can easily find out
+at the Perl level which type of piddle you are dealing with. The example
+code below demonstrates how to do it:
+
+ # check if this a piddle
+ die "not a piddle" unless UNIVERSAL::isa($pdl, 'PDL');
+ # is it a scalar ref or a hash ref?
+ if (UNIVERSAL::isa($pdl, "HASH")) {
+ die "not a valid PDL" unless exists $pdl->{PDL} &&
+ UNIVERSAL::isa($pdl->{PDL},'PDL');
+ print "This is a hash reference,",
+ " the PDL field contains the scalar ref\n";
+ } else {
+ print "This is a scalar ref that points to address $$pdl in memory\n";
+ }
+
+The scalar reference points to the numeric address of a C structure of
+type C<pdl> which is defined in F<pdl.h>. The mapping between the
+object at the Perl level and the C structure containing the actual
+data and structural that makes up a piddle is done by the PDL typemap.
+The functions used in the PDL typemap are defined pretty much at the top
+of the file F<pdlcore.h>. So what does the structure look like:
+
+ struct pdl {
+ unsigned long magicno; /* Always stores PDL_MAGICNO as a sanity check */
+ /* This is first so most pointer accesses to wrong type are caught */
+ int state; /* What's in this pdl */
+
+ pdl_trans *trans; /* Opaque pointer to internals of transformation from
+ parent */
+
+ pdl_vaffine *vafftrans;
+
+ void* sv; /* (optional) pointer back to original sv.
+ ALWAYS check for non-null before use.
+ We cannot inc refcnt on this one or we'd
+ never get destroyed */
+
+ void *datasv; /* Pointer to SV containing data. Refcnt inced */
+ void *data; /* Null: no data alloced for this one */
+ PDL_Indx nvals; /* How many values allocated */
+ int datatype;
+ PDL_Indx *dims; /* Array of data dimensions */
+ PDL_Indx *dimincs; /* Array of data default increments */
+ short ndims; /* Number of data dimensions */
+
+ unsigned char *threadids; /* Starting index of the thread index set n */
+ unsigned char nthreadids;
+
+ pdl *progenitor; /* I'm in a mutated family. make_physical_now must
+ copy me to the new generation. */
+ pdl *future_me; /* I'm the "then" pdl and this is my "now" (or more modern
+ version, anyway */
+
+ pdl_children children;
+
+ short living_for; /* Perl side not referenced; delete me when */
+
+ PDL_Indx def_dims[PDL_NDIMS]; /* Preallocated space for efficiency */
+ PDL_Indx def_dimincs[PDL_NDIMS]; /* Preallocated space for efficiency */
+ unsigned char def_threadids[PDL_NTHREADIDS];
+
+ struct pdl_magic *magic;
+
+ void *hdrsv; /* "header", settable from outside */
+ };
+
+This is quite a structure for just storing some data in - what is going on?
+
+=over 5
+
+=item Data storage
+
+We are going to start with some of the simpler members: first of all,
+there is the member
+
+ void *datasv;
+
+which is really a pointer to a Perl SV structure (C<SV *>). The SV is
+expected to be representing a string, in which the data of the piddle
+is stored in a tightly packed form. This pointer counts as a reference
+to the SV so the reference count has been incremented when the C<SV *>
+was placed here (this reference count business has to do with Perl's
+garbage collection mechanism -- don't worry if this doesn't mean much
+to you). This pointer is allowed to have the value C<NULL> which
+means that there is no actual Perl SV for this data - for instance, the data
+might be allocated by a C<mmap> operation. Note the use of an SV*
+was purely for convenience, it allows easy transformation of
+packed data from files into piddles. Other implementations are not
+excluded.
+
+The actual pointer to data is stored in the member
+
+ void *data;
+
+which contains a pointer to a memory area with space for
+
+ PDL_Indx nvals;
+
+data items of the data type of this piddle. PDL_Indx is either 'long' or
+'long long' depending on whether your perl is 64bit or not.
+
+The data type of the data is stored in the variable
+
+ int datatype;
+
+the values for this member are given in the enum C<pdl_datatypes> (see
+F<pdl.h>). Currently we have byte, short, unsigned short, long, float and
+double types, see also L<PDL::Types>.
+
+=item Dimensions
+
+The number of dimensions in the piddle is given by the member
+
+ int ndims;
+
+which shows how many entries there are in the arrays
+
+ PDL_Indx *dims;
+ PDL_Indx *dimincs;
+
+These arrays are intimately related: C<dims> gives the sizes of the dimensions
+and C<dimincs> is always calculated by the code
+
+ PDL_Indx inc = 1;
+ for(i=0; i<it->ndims; i++) {
+ it->dimincs[i] = inc; inc *= it->dims[i];
+ }
+
+in the routine C<pdl_resize_defaultincs> in C<pdlapi.c>.
+What this means is that the dimincs can be used to calculate the offset
+by code like
+
+ PDL_Indx offs = 0;
+ for(i=0; i<it->ndims; i++) {
+ offs += it->dimincs[i] * index[i];
+ }
+
+but this is not always the right thing to do,
+at least without checking for certain things first.
+
+=item Default storage
+
+Since the vast majority of piddles don't have more than 6 dimensions,
+it is more efficient to have default storage for the dimensions and dimincs
+inside the PDL struct.
+
+ PDL_Indx def_dims[PDL_NDIMS];
+ PDL_Indx def_dimincs[PDL_NDIMS];
+
+The C<dims> and C<dimincs> may be set to point to the beginning of these
+arrays if C<ndims> is smaller than or equal to the compile-time constant
+C<PDL_NDIMS>. This is important to note when freeing a piddle struct.
+The same applies for the threadids:
+
+ unsigned char def_threadids[PDL_NTHREADIDS];
+
+=item Magic
+
+It is possible to attach magic to piddles, much like Perl's own magic
+mechanism. If the member pointer
+
+ struct pdl_magic *magic;
+
+is nonzero, the PDL has some magic attached to it. The implementation
+of magic can be gleaned from the file F<pdlmagic.c> in the distribution.
+
+=item State
+
+One of the first members of the structure is
+
+ int state;
+
+The possible flags and their meanings are given in C<pdl.h>.
+These are mainly used to implement the lazy evaluation mechanism
+and keep track of piddles in these operations.
+
+=item Transformations and virtual affine transformations
+
+As you should already know, piddles often carry information about
+where they come from. For example, the code
+
+ $b = $a->slice("2:5");
+ $b .= 1;
+
+will alter $a. So C<$b> and C<$a> I<know> that they are connected
+via a C<slice>-transformation. This information is stored in the members
+
+ pdl_trans *trans;
+ pdl_vaffine *vafftrans;
+
+Both C<$a> (the I<parent>) and C<$b> (the child) store this information
+about the transformation in appropriate slots of the C<pdl> structure.
+
+C<pdl_trans> and C<pdl_vaffine> are structures that we will look at in
+more detail below.
+
+=item The Perl SVs
+
+When piddles are referred to through Perl SVs, we store an additional
+reference to it in the member
+
+ void* sv;
+
+in order to be able to return a reference to the user when he wants to
+inspect the transformation structure on the Perl side.
+
+Also, we store an opaque
+
+ void *hdrsv;
+
+which is just for use by the user to hook up arbitrary data with this sv.
+This one is generally manipulated through L<sethdr|PDL::Core/sethdr> and
+L<gethdr|PDL::Core/gethdr> calls.
+
+=back
+
+=head2 Smart references and transformations: slicing and dicing
+
+Smart references and most other fundamental functions
+operating on piddles are implemented via I<transformations>
+(Aas mentioned above) which are represented by the type C<pdl_trans> in PDL.
+
+A transformation links input and output piddles and contains
+all the infrastructure that defines how
+
+=over 4
+
+=item *
+
+output piddles are obtained from input piddles
+
+=item *
+
+changes in smartly linked output piddles (e.g. the I<child>
+of a sliced I<parent> piddle) are flown back to the input
+piddle in transformations where this is supported (the most
+often used example being C<slice> here).
+
+=item *
+
+datatype and size of output piddles that need to be created
+are obtained
+
+=back
+
+In general, executing a PDL function on a group of piddles
+results in creation of a transformation of the requested
+type that links all input and output arguments (at least
+those that are piddles). In PDL functions that support
+data flow between input and output args (e.g. C<slice>,
+C<index>) this transformation links I<parent> (input) and
+I<child> (output) piddles permanently until either the link is
+explicitly broken by user request (C<sever> at the Perl level)
+or all parents and children have been destroyed. In those
+cases the transformation is lazy-evaluated, e.g. only executed
+when piddle values are actually accessed.
+
+In I<non-flowing> functions, for example addition (C<+>) and inner
+products (C<inner>), the transformation is installed just as
+in flowing functions but then the transformation is immediately
+executed and destroyed (breaking the link between input and output args)
+before the function returns.
+
+It should be noted that the close link between input and output args
+of a flowing function (like L<slice|PDL::Slices/slice>) requires
+that piddle objects that are linked in
+such a way be kept alive beyond the point where they have gone
+out of scope from the point of view of Perl:
+
+ $a = zeroes(20);
+ $b = $a->slice('2:4');
+ undef $a; # last reference to $a is now destroyed
+
+Although $a should now be destroyed according to Perl's rules
+the underlying C<pdl> structure must actually only be freed when C<$b>
+also goes out of scope (since it still references
+internally some of C<$a>'s data). This example demonstrates that such
+a dataflow paradigm between PDL objects necessitates a special
+destruction algorithm that takes the links between piddles
+into account and couples the lifespan of those objects. The
+non-trivial algorithm is implemented in the function
+C<pdl_destroy> in F<pdlapi.c>. In fact, most of the code
+in F<pdlapi.c> and F<pdlfamily.c> is concerned with
+making sure that piddles (C<pdl *>s) are created, updated
+and freed at the right times depending on interactions
+with other piddles via PDL transformations (remember, C<pdl_trans>).
+
+=head2 Accessing children and parents of a piddle
+
+When piddles are dynamically linked via transformations as
+suggested above input and output piddles are referred to as parents
+and children, respectively.
+
+An example of processing the children of a piddle is provided
+by the C<baddata> method of PDL::Bad (only available if you
+have compiled PDL with the C<WITH_BADVAL> option set to 1,
+but still useful as an example!).
+
+Consider the following situation:
+
+ pdl> $a = rvals(7,7,Centre=>[3,4]);
+ pdl> $b = $a->slice('2:4,3:5');
+ pdl> ? vars
+ PDL variables in package main::
+
+ Name Type Dimension Flow State Mem
+ ----------------------------------------------------------------
+ $a Double D [7,7] P 0.38Kb
+ $b Double D [3,3] VC 0.00Kb
+
+Now, if I suddenly decide that C<$a> should be flagged as possibly
+containing bad values, using
+
+ pdl> $a->baddata(1)
+
+then I want the state of C<$b> - it's I<child> - to be changed as
+well (since it will either share or inherit some of C<$a>'s data and
+so be also I<bad>), so that I get a 'B' in the I<State> field:
+
+ pdl> ? vars
+ PDL variables in package main::
+
+ Name Type Dimension Flow State Mem
+ ----------------------------------------------------------------
+ $a Double D [7,7] PB 0.38Kb
+ $b Double D [3,3] VCB 0.00Kb
+
+This bit of magic is performed by the C<propogate_badflag> function,
+which is listed below:
+
+ /* newval = 1 means set flag, 0 means clear it */
+ /* thanks to Christian Soeller for this */
+
+ void propogate_badflag( pdl *it, int newval ) {
+ PDL_DECL_CHILDLOOP(it)
+ PDL_START_CHILDLOOP(it)
+ {
+ pdl_trans *trans = PDL_CHILDLOOP_THISCHILD(it);
+ int i;
+ for( i = trans->vtable->nparents;
+ i < trans->vtable->npdls;
+ i++ ) {
+ pdl *child = trans->pdls[i];
+
+ if ( newval ) child->state |= PDL_BADVAL;
+ else child->state &= ~PDL_BADVAL;
+
+ /* make sure we propogate to grandchildren, etc */
+ propogate_badflag( child, newval );
+
+ } /* for: i */
+ }
+ PDL_END_CHILDLOOP(it)
+ } /* propogate_badflag */
+
+Given a piddle (C<pdl *it>), the routine loops through each
+C<pdl_trans> structure, where access to this structure is provided by the
+C<PDL_CHILDLOOP_THISCHILD> macro.
+The I<children> of the piddle are stored in the C<pdls> array, after the
+I<parents>, hence the loop from C<i = ...nparents> to
+C<i = ...nparents - 1>.
+Once we have the pointer to the child piddle, we can do what we want to
+it; here we change the value of the C<state> variable, but the details
+are unimportant).
+What B<is> important is that we call C<propogate_badflag> on this
+piddle, to ensure we loop through its children. This recursion
+ensures we get to all the I<offspring> of a particular piddle.
+
+Access to I<parents> is similar, with the C<for> loop replaced by:
+
+ for( i = 0;
+ i < trans->vtable->nparents;
+ i++ ) {
+ /* do stuff with parent #i: trans->pdls[i] */
+ }
+
+=head2 What's in a transformation (C<pdl_trans>)
+
+All transformations are implemented as structures
+
+ struct XXX_trans {
+ int magicno; /* to detect memory overwrites */
+ short flags; /* state of the trans */
+ pdl_transvtable *vtable; /* the all important vtable */
+ void (*freeproc)(struct pdl_trans *); /* Call to free this trans
+ (in case we had to malloc some stuff dor this trans) */
+ pdl *pdls[NP]; /* The pdls involved in the transformation */
+ int __datatype; /* the type of the transformation */
+ /* in general more members
+ /* depending on the actual transformation (slice, add, etc)
+ */
+ };
+
+The transformation identifies all C<pdl>s involved in the trans
+
+ pdl *pdls[NP];
+
+with C<NP> depending on the number of piddle args of the particular
+trans. It records a state
+
+ short flags;
+
+and the datatype
+
+ int __datatype;
+
+of the trans (to which all piddles must be converted unless
+they are explicitly typed, PDL functions created with L<PDL::PP|PDL::PP>
+make sure that these conversions are done as necessary). Most important is
+the pointer to the vtable (virtual table) that contains the actual
+functionality
+
+ pdl_transvtable *vtable;
+
+The vtable structure in turn looks something like (slightly
+simplified from F<pdl.h> for clarity)
+
+ typedef struct pdl_transvtable {
+ pdl_transtype transtype;
+ int flags;
+ int nparents; /* number of parent pdls (input) */
+ int npdls; /* number of child pdls (output) */
+ char *per_pdl_flags; /* optimization flags */
+ void (*redodims)(pdl_trans *tr); /* figure out dims of children */
+ void (*readdata)(pdl_trans *tr); /* flow parents to children */
+ void (*writebackdata)(pdl_trans *tr); /* flow backwards */
+ void (*freetrans)(pdl_trans *tr); /* Free both the contents and it of
+ the trans member */
+ pdl_trans *(*copy)(pdl_trans *tr); /* Full copy */
+ int structsize;
+ char *name; /* For debuggers, mostly */
+ } pdl_transvtable;
+
+We focus on the callback functions:
+
+ void (*redodims)(pdl_trans *tr);
+
+C<redodims> will work out the dimensions of piddles that need
+to be created and is called from within the API function that
+should be called to ensure that the dimensions of a piddle are
+accessible (F<pdlapi.c>):
+
+ void pdl_make_physdims(pdl *it)
+
+C<readdata> and C<writebackdata> are responsible for the actual
+computations of the child data from the parents or parent data
+from those of the children, respectively (the dataflow aspect).
+The PDL core makes sure that these are called as needed when
+piddle data is accessed (lazy-evaluation). The general API
+function to ensure that a piddle is up-to-date is
+
+ void pdl_make_physvaffine(pdl *it)
+
+which should be called before accessing piddle data from
+XS/C (see F<Core.xs> for some examples).
+
+C<freetrans> frees dynamically allocated memory associated
+with the trans as needed and C<copy> can copy the transformation.
+Again, functions built with L<PDL::PP|PDL::PP> make sure that copying
+and freeing via these callbacks happens at the right times. (If they
+fail to do that we have got a memory leak -- this has happened in
+the past ;).
+
+The transformation and vtable code is hardly ever written by
+hand but rather generated by L<PDL::PP|PDL::PP> from concise descriptions.
+
+Certain types of transformations can be optimized very
+efficiently obviating the need for explicit C<readdata>
+and C<writebackdata> methods. Those transformations are
+called I<pdl_vaffine>. Most dimension manipulating
+functions (e.g., C<slice>, C<xchg>) belong to this class.
+
+The basic trick is that parent and child of such a transformation work
+on the same (shared) block of data which they just choose
+to interpret differently (by using different C<dims>, C<dimincs> and
+C<offs> on the same data, compare the C<pdl> structure above).
+Each operation on a piddle sharing
+data with another one in this way is therefore automatically flown
+from child to parent and back -- after all they are reading and writing
+the same block of memory. This is currently not Perl thread safe --
+no big loss since the whole PDL core is not reentrant
+(Perl threading C<!=> PDL threading!).
+
+=head2 Signatures: threading over elementary operations
+
+Most of that functionality of PDL threading (automatic iteration
+of elementary operations over multi-dim piddles) is implemented in the
+file F<pdlthread.c>.
+
+The L<PDL::PP|PDL::PP> generated functions (in particular the
+C<readdata> and C<writebackdata> callbacks) use this infrastructure to
+make sure that the fundamental operation implemented by the
+trans is performed in agreement with PDL's threading semantics.
+
+=head2 Defining new PDL functions -- Glue code generation
+
+Please, see L<PDL::PP> and examples in the PDL distribution. Implementation
+and syntax are currently far from perfect but it does a good job!
+
+=head2 The Core struct
+
+As discussed in L<PDL::API|PDL::API>, PDL uses a pointer to a structure
+to allow PDL modules access to its core routines. The definition of this
+structure (the C<Core> struct) is in F<pdlcore.h> (created by
+F<pdlcore.h.PL> in F<Basic/Core>) and looks something like
+
+ /* Structure to hold pointers core PDL routines so as to be used by
+ * many modules
+ */
+ struct Core {
+ I32 Version;
+ pdl* (*SvPDLV) ( SV* );
+ void (*SetSV_PDL) ( SV *sv, pdl *it );
+ #if defined(PDL_clean_namespace) || defined(PDL_OLD_API)
+ pdl* (*new) ( ); /* make it work with gimp-perl */
+ #else
+ pdl* (*pdlnew) ( ); /* renamed because of C++ clash */
+ #endif
+ pdl* (*tmp) ( );
+ pdl* (*create) (int type);
+ void (*destroy) (pdl *it);
+ ...
+ }
+ typedef struct Core Core;
+
+The first field of the structure (C<Version>) is used to ensure
+consistency between modules at run time; the following code
+is placed in the BOOT section of the generated xs code:
+
+ if (PDL->Version != PDL_CORE_VERSION)
+ Perl_croak(aTHX_ "Foo needs to be recompiled against the newly installed PDL");
+
+If you add a new field to the F<Core> struct you should:
+
+=over 5
+
+=item *
+
+discuss it on the pdl porters email list (pdl-porters at jach.hawaii.edu)
+[with the possibility of making your changes to a separate
+branch of the CVS tree if it's a change that will take time to complete]
+
+=item *
+
+increase by 1 the value of the C<$pdl_core_version> variable in
+F<pdlcore.h.PL>. This sets the value of the
+C<PDL_CORE_VERSION> C macro used to populate the Version field
+
+=item *
+
+add documentation (e.g. to L<PDL::API|PDL::API>) if it's a
+"useful" function for external module writers (as well as
+ensuring the code is as well documented as the rest of PDL
+;)
+
+=back
+
+=head1 BUGS
+
+This description is far from perfect. If you need more details
+or something is still unclear please ask on the pdl-porters
+mailing list (pdl-porters at jach.hawaii.edu).
+
+=head1 AUTHOR
+
+Copyright(C) 1997 Tuomas J. Lukka (lukka at fas.harvard.edu),
+2000 Doug Burke (djburke at cpan.org), 2002 Christian Soeller & Doug Burke,
+2013 Chris Marshall.
+
+Redistribution in the same form is allowed but reprinting requires
+a permission from the author.
+
diff --git a/Basic/Pod/MATLAB.pod b/Basic/Pod/MATLAB.pod
new file mode 100644
index 0000000..a386311
--- /dev/null
+++ b/Basic/Pod/MATLAB.pod
@@ -0,0 +1,874 @@
+=head1 NAME
+
+PDL::MATLAB - A guide for MATLAB users.
+
+=head1 INTRODUCTION
+
+If you are a MATLAB user, this page is for you. It explains the key
+differences between MATLAB and PDL to help you get going as quickly
+as possible.
+
+B<This document is not a tutorial>. For that, go to L<PDL::QuickStart|
+PDL::QuickStart>. This document B<complements> the Quick Start guide, as
+it highlights the key differences between MATLAB and PDL.
+
+=head1 Perl
+
+The key difference between MATLAB and PDL is B<Perl>.
+
+Perl is a general purpose programming language with thousands of modules
+freely available on the web. PDL is an extension of Perl. This gives PDL
+programs access to more features than most numerical tools can dream of.
+At the same time, most syntax differences between MATLAB and PDL are a
+result of its Perl foundation.
+
+B<You do not have to learn much Perl to be effective with PDL>. But
+if you wish to learn Perl, there is excellent documentation available
+on-line (L<http://perldoc.perl.org>) or through the command C<perldoc perl>.
+There is also a beginner's portal (L<http://perl-begin.org>).
+
+Perl's module repository is called CPAN (L<http://www.cpan.org>) and it
+has a vast array of modules. Run C<perldoc cpan> for more information.
+
+=head1 TERMINOLOGY: PIDDLE
+
+MATLAB typically refers to vectors, matrices, and arrays. Perl already
+has arrays, and the terms "vector" and "matrix" typically refer to one-
+and two-dimensional collections of data. Having no good term to describe
+their object, PDL developers coined the term "I<piddle>" to give a name to
+their data type.
+
+A I<piddle> consists of a series of numbers organized as an N-dimensional
+data set. Piddles provide efficient storage and fast computation of large
+N-dimensional matrices. They are highly optimized for numerical work.
+
+For more information, see "B<Piddles vs Perl Arrays>" later in this document.
+
+=head1 COMMAND WINDOW AND IDE
+
+Unlike MATLAB, PDL does not come with a dedicated IDE. It does however
+come with an interactive shell and you can use a Perl IDE to develop
+PDL programs.
+
+=head2 PDL interactive shell
+
+To start the interactive shell, open a terminal and run C<perldl> or C<pdl2>.
+As in MATLAB, the interactive shell is the best way to learn the
+language. To exit the shell, type C<exit>, just like MATLAB.
+
+=head2 Writing PDL programs
+
+One popular IDE for Perl is called Padre (L<http://padre.perlide.org>).
+It is cross platform and easy to use.
+
+Whenever you write a stand-alone PDL program (i.e. outside the
+C<perldl> or C<pdl2> shell) you must start the program with C<use PDL;>.
+This command imports the PDL module into Perl. Here is a sample
+PDL program:
+
+ use PDL; # Import main PDL module.
+ use PDL::NiceSlice; # Import additional PDL module.
+ use PDL::AutoLoader; # Import additional PDL module.
+
+ $b = pdl [2,3,4]; # Statements end in semicolon.
+ $A = pdl [ [1,2,3],[4,5,6] ]; # 2-dimensional matrix.
+
+ print $A x $b->transpose;
+
+Save this file as C<myprogram.pl> and run it with:
+
+ perl myprogram.pl
+
+=head2 New: Flexible syntax
+
+In current versions of PDL (version 2.4.7 or later) there is
+a flexible matrix syntax that can look extremely similar to MATLAB:
+
+1) Use a ';' to delimit rows:
+
+ $b = pdl q[ 2,3,4 ];
+ $A = pdl q[ 1,2,3 ; 4,5,6 ];
+
+2) Use spaces to separate elements:
+
+ $b = pdl q[ 2 3 4 ];
+ $A = pdl q[ 1 2 3 ; 4 5 6 ];
+
+
+Basically, as long as you put a C<q> in front of the opening bracket,
+PDL should "do what you mean". So you can write in a syntax that is
+more comfortable for you.
+
+
+=head1 MODULES FOR MATLAB USERS
+
+There are two modules that MATLAB users will want to use:
+
+=over 5
+
+=item L<PDL::NiceSlice|PDL::NiceSlice>
+
+Gives PDL a syntax for slices (sub-matrices) that is shorter and
+more familiar to MATLAB users.
+
+ % MATLAB
+ b(1:5) --> Selects the first 5 elements from b.
+
+ # PDL without NiceSlice
+ $b->slice("0:4") --> Selects the first 5 elements from $b.
+
+ # PDL with NiceSlice
+ $b(0:4) --> Selects the first 5 elements from $b.
+
+=item L<PDL::AutoLoader|PDL::AutoLoader>
+
+Provides a MATLAB-style autoloader for PDL. If an unknown function
+C<foo()> is called, PDL looks for a file called C<foo.pdl>. If it
+finds one, it reads it.
+
+=back
+
+
+
+=head1 BASIC FEATURES
+
+This section explains how PDL's syntax differs from MATLAB. Most
+MATLAB users will want to start here.
+
+
+=head2 General "gotchas"
+
+=over 5
+
+=item Indices
+
+In PDL, indices start at '0' (like C and Java), not 1 (like MATLAB or FORTRAN).
+For example, if C<$b> is an array with 5 elements, the elements would be
+numbered from 0 to 4.
+
+=item Displaying an object
+
+MATLAB normally displays object contents automatically. In the PDL shells you
+display objects explicitly with the C<print> command or the shortcut C<p>:
+
+MATLAB:
+
+ >> a = 12
+ a = 12
+ >> b = 23; % Suppress output.
+ >>
+
+PDL Shell (perldl or pdl2):
+
+ pdl> $a = 12 # No output.
+ pdl> print $a # Print object.
+ 12
+ pdl> p $a # "p" is a shorthand for "print" in the shell.
+ 12
+ pdl>
+
+
+=back
+
+
+
+=head2 Creating Piddles
+
+=over 5
+
+=item Variables in PDL
+
+Variables always start with the '$' sign.
+
+ MATLAB: value = 42
+ PerlDL: $value = 42
+
+=item Basic syntax
+
+Use the "pdl" constructor to create a new I<piddle>.
+
+ MATLAB: v = [1,2,3,4]
+ PerlDL: $v = pdl [1,2,3,4]
+
+ MATLAB: A = [ 1,2,3 ; 3,4,5 ]
+ PerlDL: $A = pdl [ [1,2,3] , [3,4,5] ]
+
+=item Simple matrices
+
+ MATLAB PDL
+ ------ ------
+ Matrix of ones ones(5) ones 5,5
+ Matrix of zeros zeros(5) zeros 5,5
+ Random matrix rand(5) random 5,5
+ Linear vector 1:5 sequence 5
+
+Notice that in PDL the parenthesis in a function call are often optional.
+It is important to keep an eye out for possible ambiguities. For example:
+
+ pdl> p zeros 2, 2 + 2
+
+Should this be interpreted as C<zeros(2,2) + 2> or as C<zeros 2, (2+2)>?
+Both are valid statements:
+
+ pdl> p zeros(2,2) + 2
+ [
+ [2 2]
+ [2 2]
+ ]
+ pdl> p zeros 2, (2+2)
+ [
+ [0 0]
+ [0 0]
+ [0 0]
+ [0 0]
+ ]
+
+Rather than trying to memorize Perl's order of precedence, it is best
+to use parentheses to make your code unambiguous.
+
+=item Linearly spaced sequences
+
+ MATLAB: >> linspace(2,10,5)
+ ans = 2 4 6 8 10
+
+ PerlDL: pdl> p zeroes(5)->xlinvals(2,10)
+ [2 4 6 8 10]
+
+B<Explanation>: Start with a 1-dimensional piddle of 5 elements and give
+it equally spaced values from 2 to 10.
+
+MATLAB has a single function call for this. On the other hand, PDL's
+method is more flexible:
+
+ pdl> p zeros(5,5)->xlinvals(2,10)
+ [
+ [ 2 4 6 8 10]
+ [ 2 4 6 8 10]
+ [ 2 4 6 8 10]
+ [ 2 4 6 8 10]
+ [ 2 4 6 8 10]
+ ]
+ pdl> p zeros(5,5)->ylinvals(2,10)
+ [
+ [ 2 2 2 2 2]
+ [ 4 4 4 4 4]
+ [ 6 6 6 6 6]
+ [ 8 8 8 8 8]
+ [10 10 10 10 10]
+ ]
+ pdl> p zeros(3,3,3)->zlinvals(2,6)
+ [
+ [
+ [2 2 2]
+ [2 2 2]
+ [2 2 2]
+ ]
+ [
+ [4 4 4]
+ [4 4 4]
+ [4 4 4]
+ ]
+ [
+ [6 6 6]
+ [6 6 6]
+ [6 6 6]
+ ]
+ ]
+
+=item Slicing and indices
+
+Extracting a subset from a collection of data is known as I<slicing>.
+PDL and MATLAB have a similar syntax for slicing, but there are two
+important differences:
+
+1) PDL indices start at 0, as in C and Java. MATLAB starts indices at 1.
+
+2) In MATLAB you think "rows and columns". In PDL, think "x and y".
+
+ MATLAB PerlDL
+ ------ ------
+ >> A pdl> p $A
+ A = [
+ 1 2 3 [1 2 3]
+ 4 5 6 [4 5 6]
+ 7 8 9 [7 8 9]
+ ]
+ -------------------------------------------------------
+ (row = 2, col = 1) (x = 0, y = 1)
+ >> A(2,1) pdl> p $A(0,1)
+ ans = [
+ 4 [4]
+ ]
+ -------------------------------------------------------
+ (row = 2 to 3, col = 1 to 2) (x = 0 to 1, y = 1 to 2)
+ >> A(2:3,1:2) pdl> p $A(0:1,1:2)
+ ans = [
+ 4 5 [4 5]
+ 7 8 [7 8]
+ ]
+
+=over 5
+
+=item B<Warning>
+
+When you write a stand-alone PDL program you have
+to include the L<PDL::NiceSlice|PDL::NiceSlice> module. See the
+previous section "B<MODULES FOR MATLAB USERS>" for more information.
+
+ use PDL; # Import main PDL module.
+ use PDL::NiceSlice; # Nice syntax for slicing.
+ use PDL::AutoLoader; # MATLAB-like autoloader.
+
+ $A = random 4,4;
+ print $A(0,1);
+
+=back
+
+=back
+
+
+
+=head2 Matrix Operations
+
+=over 10
+
+=item Matrix multiplication
+
+ MATLAB: A * B
+ PerlDL: $A x $B
+
+=item Element-wise multiplication
+
+ MATLAB: A .* B
+ PerlDL: $A * $B
+
+=item Transpose
+
+ MATLAB: A'
+ PerlDL: $A->transpose
+
+=back
+
+
+=head2 Functions that aggregate data
+
+Some functions (like C<sum>, C<max> and C<min>) aggregate data
+for an N-dimensional data set. This is a place where MATLAB and
+PDL take a different approach:
+
+=over 10
+
+=item In MATLAB, these functions all work along one dimension.
+
+ >> A = [ 1,5,4 ; 4,2,1 ]
+ A = 1 5 4
+ 4 2 1
+ >> max(A)
+ ans = 4 5 4
+ >> max(A')
+ ans = 5 4
+
+If you want the maximum for the entire data set, you can use the special
+C<A(:)> notation which basically turns the entire data set into a single
+1-dimensional vector.
+
+ >> max(A(:))
+ ans = 5
+ >> A = ones(2,2,2,2)
+ >> max(A(:))
+ ans = 1
+
+=item PDL offers two functions for each feature.
+
+ sum vs sumover
+ avg vs average
+ max vs maximum
+ min vs minimum
+
+The B<long name> works over a dimension, while the B<short name>
+works over the entire piddle.
+
+ pdl> p $A = pdl [ [1,5,4] , [4,2,1] ]
+ [
+ [1 5 4]
+ [4 2 1]
+ ]
+ pdl> p $A->maximum
+ [5 4]
+ pdl> p $A->transpose->maximum
+ [4 5 4]
+ pdl> p $A->max
+ 5
+ pdl> p ones(2,2,2)->max
+ 1
+ pdl> p ones(2,2,2,2)->max
+ 1
+
+
+=back
+
+=over 5
+
+=item B<Note>
+
+Notice that PDL aggregates horizontally while MATLAB aggregates
+vertically. In other words:
+
+ MATLAB PerlDL
+ max(A) == $A->transpose->maximum
+ max(A') == $A->maximum
+
+B<TIP>: In MATLAB you think "rows and columns". In PDL, think "x and y".
+
+=back
+
+=head2 Higher dimensional data sets
+
+A related issue is how MATLAB and PDL understand data sets of higher
+dimension. MATLAB was designed for 1D vectors and 2D matrices. Higher
+dimensional objects ("N-D arrays") were added on top. In contrast, PDL
+was designed for N-dimensional piddles from the start. This leads to
+a few surprises in MATLAB that don't occur in PDL:
+
+=over 5
+
+=item MATLAB sees a vector as a 2D matrix.
+
+ MATLAB PerlDL
+ ------ ------
+ >> vector = [1,2,3,4]; pdl> $vector = pdl [1,2,3,4]
+ >> size(vector) pdl> p $vector->dims
+ ans = 1 4 4
+
+MATLAB sees C<[1,2,3,4]> as a 2D matrix (1x4 matrix). PDL sees it
+as a 1D vector: A single dimension of size 4.
+
+=item But MATLAB ignores the last dimension of a 4x1x1 matrix.
+
+ MATLAB PerlDL
+ ------ ------
+ >> A = ones(4,1,1); pdl> $A = ones 4,1,1
+ >> size(A) pdl> p $A->dims
+ ans = 4 1 4 1 1
+
+=item And MATLAB treats a 4x1x1 matrix differently from a 1x1x4 matrix.
+
+ MATLAB PerlDL
+ ------ ------
+ >> A = ones(1,1,4); pdl> $A = ones 1,1,4
+ >> size(A) pdl> p $A->dims
+ ans = 1 1 4 1 1 4
+
+=item MATLAB has no direct syntax for N-D arrays.
+
+ pdl> $A = pdl [ [[1,2,3],[4,5,6]], [[2,3,4],[5,6,7]] ]
+ pdl> p $A->dims
+ 3 2 2
+
+=item Feature support.
+
+In MATLAB, several features such as sparse matrix support are not
+available for N-D arrays. In PDL, just about any feature supported by
+1D and 2D piddles, is equally supported by N-dimensional piddles.
+There is usually no distinction.
+
+=back
+
+
+=head2 Loop Structures
+
+Perl has many loop structures, but we will only show the one that
+is most familiar to MATLAB users:
+
+ MATLAB PerlDL
+ ------ ------
+ for i = 1:10 for $i (1..10) {
+ disp(i) print $i
+ endfor }
+
+=over 5
+
+=item B<Note>
+
+Never use for-loops for numerical work. Perl's for-loops are faster
+than MATLAB's, but they both pale against a "vectorized" operation.
+PDL has many tools that facilitate writing vectorized programs.
+These are beyond the scope of this guide. To learn more, see:
+L<PDL::Indexing|PDL::Indexing>, L<PDL::Threading|PDL::Threading>,
+and L<PDL::PP|PDL::PP>.
+
+Likewise, never use C<1..10> for numerical work, even outside a for-loop.
+C<1..10> is a Perl array. Perl arrays are designed for flexibility, not
+speed. Use I<piddles> instead. To learn more, see the next section.
+
+=back
+
+=head2 Piddles vs Perl Arrays
+
+It is important to note the difference between a I<Piddle> and a Perl
+array. Perl has a general-purpose array object that can hold any
+type of element:
+
+ @perl_array = 1..10;
+ @perl_array = ( 12, "Hello" );
+ @perl_array = ( 1, 2, 3, \@another_perl_array, sequence(5) );
+
+Perl arrays allow you to create powerful data structures (see
+B<Data structures> below), B<but they are not designed for numerical work>.
+For that, use I<piddles>:
+
+ $pdl = pdl [ 1, 2, 3, 4 ];
+ $pdl = sequence 10_000_000;
+ $pdl = ones 600, 600;
+
+For example:
+
+ $points = pdl 1..10_000_000 # 4.7 seconds
+ $points = sequence 10_000_000 # milliseconds
+
+B<TIP>: You can use underscores in numbers (C<10_000_000> reads better
+than C<10000000>).
+
+=head2 Conditionals
+
+Perl has many conditionals, but we will only show the one that is
+most familiar to MATLAB users:
+
+ MATLAB PerlDL
+ ------ ------
+ if value > MAX if ($value > $MAX) {
+ disp("Too large") print "Too large\n";
+ elseif value < MIN } elsif ($value < $MIN) {
+ disp("Too small") print "Too small\n";
+ else } else {
+ disp("Perfect!") print "Perfect!\n";
+ end }
+
+=over 5
+
+=item B<Note>
+
+Here is a "gotcha":
+
+ MATLAB: elseif
+ PerlDL: elsif
+
+If your conditional gives a syntax error, check that you wrote
+your C<elsif>'s correctly.
+
+=back
+
+=head2 TIMTOWDI (There Is More Than One Way To Do It)
+
+One of the most interesting differences between PDL and other tools
+is the expressiveness of the Perl language. TIMTOWDI, or "There Is
+More Than One Way To Do It", is Perl's motto.
+
+Perl was written by a linguist, and one of its defining properties
+is that statements can be formulated in different ways to give the
+language a more natural feel. For example, you are unlikely to say
+to a friend:
+
+ "While I am not finished, I will keep working."
+
+Human language is more flexible than that. Instead, you are more
+likely to say:
+
+ "I will keep working until I am finished."
+
+Owing to its linguistic roots, Perl is the only programming language
+with this sort of flexibility. For example, Perl has traditional
+while-loops and if-statements:
+
+ while ( ! finished() ) {
+ keep_working();
+ }
+
+ if ( ! wife_angry() ) {
+ kiss_wife();
+ }
+
+But it also offers the alternative B<until> and B<unless> statements:
+
+ until ( finished() ) {
+ keep_working();
+ }
+
+ unless ( wife_angry() ) {
+ kiss_wife();
+ }
+
+And Perl allows you to write loops and conditionals in "postfix" form:
+
+ keep_working() until finished();
+
+ kiss_wife() unless wife_angry();
+
+
+In this way, Perl often allows you to write more natural, easy to
+understand code than is possible in more restrictive programming
+languages.
+
+
+=head2 Functions
+
+PDL's syntax for declaring functions differs significantly from MATLAB's.
+
+ MATLAB PerlDL
+ ------ ------
+ function retval = foo(x,y) sub foo {
+ retval = x.**2 + x.*y my ($x, $y) = @_;
+ endfunction return $x**2 + $x*$y;
+ }
+
+Don't be intimidated by all the new syntax. Here is a quick run through
+a function declaration in PDL:
+
+1) "B<sub>" stands for "subroutine".
+
+2) "B<my>" declares variables to be local to the function.
+
+3) "B<@_>" is a special Perl array that holds all the function parameters.
+This might seem like a strange way to do functions, but it allows you
+to make functions that take a variable number of parameters. For example,
+the following function takes any number of parameters and adds them
+together:
+
+ sub mysum {
+ my ($i, $total) = (0, 0);
+ for $i (@_) {
+ $total += $i;
+ }
+ return $total;
+ }
+
+4) You can assign values to several variables at once using the syntax:
+
+ ($a, $b, $c) = (1, 2, 3);
+
+So, in the previous examples:
+
+ # This declares two local variables and initializes them to 0.
+ my ($i, $total) = (0, 0);
+
+ # This takes the first two elements of @_ and puts them in $x and $y.
+ my ($x, $y) = @_;
+
+5) The "B<return>" statement gives the return value of the function, if any.
+
+=head1 ADDITIONAL FEATURES
+
+=head2 ASCII File IO
+
+To read data files containing whitespace separated columns of
+numbers (as would be read using the MATLAB I<load> command)
+one uses the PDL I<rcols> in L<PDL::IO::Misc>. For a general
+review of the IO functionality available in PDL, see the
+documentation for L<PDL::IO>, e.g., C<help PDL::IO> in the I<pdl2>
+shell or C< pdldoc PDL::IO > from the shell command line.
+
+=head2 Data structures
+
+To create complex data structures, MATLAB uses "I<cell arrays>" and
+"I<structure arrays>". Perl's arrays and hashes offer similar functionality
+but are more powerful and flexible. This section is only a quick overview
+of what Perl has to offer. To learn more about this, please go to
+L<http://perldoc.perl.org/perldata.html> or run the command C<perldoc perldata>.
+
+=over 5
+
+=item Arrays
+
+Perl arrays are similar to MATLAB's cell arrays, but more flexible. For
+example, in MATLAB, a cell array is still fundamentally a matrix. It is
+made of rows, and rows must have the same length.
+
+ MATLAB
+ ------
+ array = {1, 12, 'hello'; rand(3, 2), ones(3), 'junk'}
+ => OK
+ array = {1, 12, 'hello'; rand(3, 2), ones(3) }
+ => ERROR
+
+A Perl array is a general purpose, sequential data structure. It can contain
+any data type.
+
+ PerlDL
+ ------
+ @array = ( [1, 12, 'hello'] , [ random(3,2), ones(3,3), 'junk' ] )
+ => OK
+ @array = ( [1, 12, 'hello'] , [ random(3,2), ones(3,3) ] )
+ => OK
+ @array = ( 5 , {'name' => 'Mike'} , [1, 12, 'hello'] )
+ => OK
+
+
+Notice that Perl array's start with the "@" prefix instead of the "$" used by
+piddles.
+
+I<To learn about Perl arrays, please go to L<http://perldoc.perl.org/perldata.html>
+or run the command C<perldoc perldata>.>
+
+=item Hashes
+
+Perl hashes are similar to MATLAB's structure arrays:
+
+ MATLAB
+ ------
+ >> drink = struct('type', 'coke', 'size', 'large', 'myarray', {1,2,3})
+ >> drink.type = 'sprite'
+ >> drink.price = 12 % Add new field to structure array.
+
+ PerlDL
+ ------
+ pdl> %drink = ( type => 'coke' , size => 'large', mypiddle => ones(3,3,3) )
+ pdl> $drink{type} = 'sprite'
+ pdl> $drink{price} = 12 # Add new field to hash.
+
+Notice that Perl hashes start with the "%" prefix instead of the "@" for
+arrays and "$" used by piddles.
+
+I<To learn about Perl hashes, please go to L<http://perldoc.perl.org/perldata.html>
+or run the command C<perldoc perldata>.>
+
+=back
+
+
+
+=head2 Performance
+
+PDL has powerful performance features, some of which are not normally
+available in numerical computation tools. The following pages will guide
+you through these features:
+
+=over 5
+
+=item L<PDL::Indexing|PDL::Indexing>
+
+B<Level>: Beginner
+
+This beginner tutorial covers the standard "vectorization" feature that
+you already know from MATLAB. Use this page to learn how to avoid for-loops
+to make your program more efficient.
+
+=item L<PDL::Threading|PDL::Threading>
+
+B<Level>: Intermediate
+
+PDL's "vectorization" feature goes beyond what most numerical software
+can do. In this tutorial you'll learn how to "thread" over higher dimensions,
+allowing you to vectorize your program further than is possible in MATLAB.
+
+
+=item Benchmarks
+
+B<Level>: Intermediate
+
+Perl comes with an easy to use benchmarks module to help you find how
+long it takes to execute different parts of your code. It is a great
+tool to help you focus your optimization efforts. You can read about it
+online (L<http://perldoc.perl.org/Benchmark.html>) or through the
+command C<perldoc Benchmark>.
+
+=item L<PDL::PP|PDL::PP>
+
+B<Level>: Advanced
+
+PDL's Pre-Processor is one of PDL's most powerful features. You
+write a function definition in special markup and the pre-processor
+generates real C code which can be compiled. With PDL:PP
+you get the full speed of native C code without having to deal with
+the full complexity of the C language.
+
+=back
+
+
+
+=head2 Plotting
+
+PDL has full-featured plotting abilities. Unlike MATLAB, PDL relies more on
+third-party libraries (pgplot and PLplot) for its 2D plotting features.
+Its 3D plotting and graphics uses OpenGL for performance and portability.
+PDL has three main plotting modules:
+
+=over 5
+
+=item L<PDL::Graphics::PGPLOT|PDL::Graphics::PGPLOT>
+
+B<Best for>: Plotting 2D functions and data sets.
+
+This is an interface to the venerable PGPLOT library. PGPLOT has
+been widely used in the academic and scientific communities for
+many years. In part because of its age, PGPLOT has some limitations
+compared to newer packages such as PLplot (e.g. no RGB graphics).
+But it has many features that still make it popular in the scientific
+community.
+
+=item L<PDL::Graphics::PLplot|PDL::Graphics::PLplot>
+
+B<Best for>: Plotting 2D functions as well as 2D and 3D data sets.
+
+This is an interface to the PLplot plotting library. PLplot
+is a modern, open source library for making scientific plots.
+It supports plots of both 2D and 3D data sets. PLplot is best
+supported for unix/linux/macosx platforms. It has an active
+developers community and support for win32 platforms is improving.
+
+=item L<PDL::Graphics::TriD|PDL::Graphics::TriD>
+
+B<Best for>: Plotting 3D functions.
+
+The native PDL 3D graphics library using OpenGL as a backend
+for 3D plots and data visualization. With OpenGL, it is easy
+to manipulate the resulting 3D objects with the mouse in real
+time.
+
+=back
+
+
+=head2 Writing GUIs
+
+Through Perl, PDL has access to all the major toolkits for creating
+a cross platform graphical user interface. One popular option is
+wxPerl (L<http://wxperl.sourceforge.net>). These are the Perl bindings
+for wxWidgets, a powerful GUI toolkit for writing cross-platform
+applications.
+
+wxWidgets is designed to make your application look and feel like
+a native application in every platform. For example, the Perl
+IDE B<Padre> is written with wxPerl.
+
+
+=head2 Simulink
+
+Simulink is a graphical dynamical system modeler and simulator. It
+can be purchased separately as an add-on to MATLAB.
+PDL and Perl do not have a direct equivalent to MATLAB's Simulink.
+If this feature is important to you, then take a look at B<Scilab>:
+
+L<http://www.scilab.org>
+
+Scilab is another numerical analysis software. Like PDL, it is free
+and open source. It doesn't have PDL's unique features, but it is
+very similar to MATLAB. Scilab comes with B<Xcos> (previously Scicos),
+a graphical system modeler and simulator similar to Simulink.
+
+
+=head1 COPYRIGHT
+
+Copyright 2010 Daniel Carrera (dcarrera at gmail.com). You can distribute and/or
+modify this document under the same terms as the current Perl license.
+
+See: http://dev.perl.org/licenses/
+
+=over 5
+
+=item B<Acknowledgements>
+
+I'd like to thank David Mertens, Chris Marshall and Sigrid Carrera for
+their immense help reviewing earlier drafts of this guide. Without their
+hours of work, this document would not be remotely as useful to MATLAB
+users as it is today.
+
+=back
+
diff --git a/Basic/Pod/Makefile.PL b/Basic/Pod/Makefile.PL
new file mode 100644
index 0000000..30c391a
--- /dev/null
+++ b/Basic/Pod/Makefile.PL
@@ -0,0 +1,50 @@
+BEGIN{if ($^O =~ /MSWin/) {
+ print "getting dosglob...\n";
+ require File::DosGlob;
+ File::DosGlob->import('glob');}
+}
+use ExtUtils::MakeMaker;
+
+ at pods = map { $_=~s/.pod//; $_ } grep { ! m/Index.pod/ } glob("*.pod");
+
+
+# do we want to create PP-Inline?
+eval 'require Pod::Select';
+if (!$@ && $] >= 5.005 ) {
+ push @pods, 'PP-Inline' unless grep {/PP-Inline/} @pods;
+}
+
+# DISABLED
+# push @pods, 'Export';
+
+
+my @man1 = map { $_.".pod", '$(INST_MAN1DIR)/PDL::' . $_ . '.$(MAN1EXT)' } @pods;
+
+my @pms = map { $_.".pod", '$(INST_LIBDIR)/' . $_ .".pod"} @pods;
+
+WriteMakefile(
+ 'NAME' => 'PDL::pod',
+
+ 'MAN1PODS' => { @man1 },
+ 'MAN3PODS' => { },
+ 'PM' => { @pms },
+ 'clean' => {FILES => "PP-Inline.pod"},
+ 'linkext' => {LINKTYPE => ''}, # No linking required in this directory
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
+sub MY::postamble {
+ my $text = '';
+ eval 'require Pod::Select';
+ if (!$@ && $] >= 5.005 ) {
+ $text .= << "EOPS" ;
+
+PP-Inline.pod: ../Gen/Inline/Pdlpp.pm
+\t\$(PERLRUN) -MPod::Select -e "podselect('../Gen/Inline/Pdlpp.pm');" > PP-Inline.pod
+
+EOPS
+
+ }
+ $text;
+}
+
diff --git a/Basic/Pod/Modules.pod b/Basic/Pod/Modules.pod
new file mode 100644
index 0000000..58697b1
--- /dev/null
+++ b/Basic/Pod/Modules.pod
@@ -0,0 +1,483 @@
+=head1 NAME
+
+PDL::Modules - A guide to PDL's module reference.
+
+
+=head1 DESCRIPTION
+
+This page serves as a table of contents for PDL's module documentation.
+This page does not list every single PDL module. It only shows the ones
+intended for PDL users, while ommitting those which are deemed "for
+internal use only". If you wish to see a comprehensive list of all
+documentation, please see the L<PDL::Index|PDL::Index> page.
+
+=head1 LOOKING FOR A FUNCTION?
+
+If you want to search for a function name, you should use the PDL
+shell along with the "help" or "apropos" command (to do a fuzzy search).
+For example:
+
+ pdl> apropos xval
+ xlinvals X axis values between endpoints (see xvals).
+ xlogvals X axis values logarithmicly spaced...
+ xvals Fills a piddle with X index values...
+ yvals Fills a piddle with Y index values. See the CAVEAT for xvals.
+ zvals Fills a piddle with Z index values. See the CAVEAT for xvals.
+
+To learn more about the PDL shell, see L<perldl|perldl> or L<pdl2|pdl2>.
+
+=head1 FOUNDATION
+
+=over 5
+
+=item L<perldl|perldl> or L<pdl2|pdl2>
+
+Learn about the PDL shell.
+
+=back
+
+=head2 Functions
+
+=over 5
+
+=item L<PDL::Core|PDL::Core>
+
+Core module (e.g. creating piddles).
+
+=item L<PDL::Basic|PDL::Basic>
+
+Simplified interface to the more general PDL::Primitive.
+
+=item L<PDL::Ops|PDL::Ops>
+
+Basic operators (e.g. arithmetic, comparisons, etc.).
+
+=item L<PDL::Ufunc|PDL::Ufunc>
+
+Functions that accumulate along a dimension (e.g. sum, max).
+
+=back
+
+=head2 Other Features
+
+=over 5
+
+=item L<PDL::AutoLoader|PDL::AutoLoader>
+
+MATLAB-style function autoloader.
+
+=item L<PDL::Slices|PDL::Slices>
+
+Indexing and slices. How to access a subset of a piddle.
+
+=item L<PDL::NiceSlice|PDL::NiceSlice>
+
+Nicer syntax for slices.
+
+=back
+
+
+
+=head1 MISCELLANEOUS
+
+=over 5
+
+=item L<PDL::Primitive|PDL::Primitive>
+
+Fundamental operations on piddles.
+
+=item L<PDL::Complex|PDL::Complex>
+
+Complex numbers.
+
+=item L<PDL::Bad|PDL::Bad>
+
+Bad value support.
+
+=item L<PDL::Reduce|PDL::Reduce>
+
+A 'reduce' function for PDL.
+
+=item L<PDL::Lite|PDL::Lite>
+
+Minimum PDL module OO loader.
+
+=item L<PDL::LiteF|PDL::LiteF>
+
+Minimum PDL module function loader.
+
+=item L<PDL::Extended|PDL::Extended>
+
+Extended Mathematical Operators.
+
+=item L<PDL::Func|PDL::Func>
+
+Interpolation-related functions.
+
+=back
+
+
+
+=head1 GRAPHICS
+
+=over 5
+
+=item L<PDL::Graphics::PGPLOT|PDL::Graphics::PGPLOT>
+
+PGPLOT library.
+
+=item L<PDL::Graphics::PLplot|PDL::Graphics::PLplot>
+
+PLplot library.
+
+=back
+
+
+=head2 3D Graphics
+
+=over 5
+
+=item L<PDL::Graphics::TriD|PDL::Graphics::TriD>
+
+3D graphics core module.
+
+=item L<PDL::Graphics::TriD::Rout|PDL::Graphics::TriD::Rout>
+
+Helper routines for 3D graphics.
+
+=item L<PDL::Graphics::TriD::Contours|PDL::Graphics::TriD::Contours>
+
+3D surface contours.
+
+=back
+
+
+
+=head2 Helper Modules
+
+=over 5
+
+=item L<PDL::Graphics::LUT|PDL::Graphics::LUT>
+
+Look-up tables.
+
+=item L<PDL::Graphics::IIS|PDL::Graphics::IIS>
+
+Display images on IIS devices.
+
+=item L<PDL::Graphics::Limits|PDL::Graphics::Limits>
+
+Derive data limits for display purposes.
+
+=back
+
+
+
+=head1 IMAGE PROCESSING
+
+=over 5
+
+=item L<PDL::Compression|PDL::Compression>
+
+Compression utilities.
+
+=item L<PDL::Image2D|PDL::Image2D>
+
+2-dimmensional image processing.
+
+=item L<PDL::ImageND|PDL::ImageND>
+
+N-dimmensional image processing.
+
+=item L<PDL::ImageRGB|PDL::ImageRGB>
+
+RGB image data handling.
+
+=back
+
+
+
+=head1 NUMERICAL METHODS
+
+=over 5
+
+=item L<PDL::FFT|PDL::FFT>
+
+Fast Fourier Transform (native implementation).
+
+=item L<PDL::FFTW|PDL::FFTW>
+
+PDL interface to the FFTW library.
+
+=item L<PDL::Filter::LinPred|PDL::Filter::LinPred>
+
+Linear predictive filtering.
+
+=item L<PDL::Filter::Linear|PDL::Filter::Linear>
+
+Linear filtering.
+
+=item L<PDL::Opt::Simplex|PDL::Opt::Simplex>
+
+Simplex optimization routines.
+
+=item L<PDL::Minuit|PDL::Minuit>
+
+PDL interface to the Minuit library.
+
+=item L<PDL::Slatec|PDL::Slatec>
+
+PDL interface to the Slatec library.
+
+=back
+
+
+
+=head1 COORDINATE TRANSFORMATIONS
+
+=over 5
+
+=item L<PDL::Transform|PDL::Transform>
+
+Coordinate transforms, image warping, and N-D functions.
+
+=item L<PDL::Transform::Cartography|PDL::Transform::Cartography>
+
+Cartographic projections.
+
+=item L<PDL::Transform::Proj4|PDL::Transform::Proj4>
+
+PDL interface to the Proj4 projection library.
+
+=back
+
+
+
+=head1 IO FUNCTIONS
+
+=over 5
+
+=item L<PDL::IO|PDL::IO>
+
+Overview of IO functions.
+
+=item L<PDL::IO::Dumper|PDL::IO::Dumper>
+
+Data dumper.
+
+=item L<PDL::IO::FastRaw|PDL::IO::FastRaw>
+
+Fast storage format (outdated).
+
+=item L<PDL::IO::FlexRaw|PDL::IO::FlexRaw>
+
+Flexible storage format.
+
+=item L<PDL::IO::Rout|PDL::IO::Rout>
+
+Misc IO routines.
+
+=item L<PDL::IO::Sortable|PDL::IO::Sortable>
+
+Support for Perl's 'Storable' module.
+
+=back
+
+
+=head2 Image Formats
+
+=over 5
+
+=item L<PDL::IO::FITS|PDL::IO::FITS>
+
+PDL support for FITS images.
+
+=item L<PDL::IO::PNM|PDL::IO::PNM>
+
+PDL support for PNM images.
+
+=item L<PDL::IO::GD|PDL::IO::GD>
+
+PDL interface to the GD image library.
+
+=item L<PDL::IO::HDF|PDL::IO::HDF>
+
+PDL interface to the HDH4 image library.
+
+=item L<PDL::IO::NetPBM|PDL::IO::NetPBM>
+
+PDL interface to the NetPBM image library.
+
+=item L<PDL::IO::NDF|PDL::IO::NDF>
+
+PDL interface to the Starlink image library. Available
+as a separate CPAN download.
+
+=back
+
+
+
+=head1 2D MATRICES
+
+=over 5
+
+=item L<PDL::Matrix|PDL::Matrix>
+
+Convenience class for 2D matrix work.
+
+=item L<PDL::MatrixOps|PDL::MatrixOps>
+
+Additional matrix operators.
+
+=back
+
+
+
+=head1 GNU SCIENTIFIC LIBRARY
+
+=over 5
+
+=item L<PDL::GSL::DIFF|PDL::GSL::DIFF>
+
+Numerical differentiation.
+
+=item L<PDL::GSL::INTEG|PDL::GSL::INTEG>
+
+Numerical integration.
+
+=item L<PDL::GSL::INTERP|PDL::GSL::INTERP>
+
+Interpolation.
+
+=item L<PDL::GSL::MROOT|PDL::GSL::MROOT>
+
+Multidimensional root-finding.
+
+=item L<PDL::GSL::RNG|PDL::GSL::RNG>
+
+RNG and randist.
+
+=back
+
+
+
+=head2 Special Functions
+
+=over 5
+
+=item L<PDL::GSL::AIRY|PDL::GSL::AIRY>
+
+=item L<PDL::GSL::BESSEL|PDL::GSL::BESSEL>
+
+=item L<PDL::GSL::CLAUSEN|PDL::GSL::CLAUSEN>
+
+=item L<PDL::GSL::COULOMB|PDL::GSL::COULOMB>
+
+=item L<PDL::GSL::COUPLING|PDL::GSL::COUPLING>
+
+=item L<PDL::GSL::DAWSON|PDL::GSL::DAWSON>
+
+=item L<PDL::GSL::DEBYE|PDL::GSL::DEBYE>
+
+=item L<PDL::GSL::DILOG|PDL::GSL::DILOG>
+
+=item L<PDL::GSL::ELEMENTARY|PDL::GSL::ELEMENTARY>
+
+=item L<PDL::GSL::ELLINT|PDL::GSL::ELLINT>
+
+=item L<PDL::GSL::ELLJAC|PDL::GSL::ELLJAC>
+
+=item L<PDL::GSL::ERF|PDL::GSL::ERF>
+
+=item L<PDL::GSL::EXP|PDL::GSL::EXP>
+
+=item L<PDL::GSL::EXPINT|PDL::GSL::EXPINT>
+
+=item L<PDL::GSL::FERMI_DIRAC|PDL::GSL::FERMI_DIRAC>
+
+=item L<PDL::GSL::GAMMA|PDL::GSL::GAMMA>
+
+=item L<PDL::GSL::GEGENBAUER|PDL::GSL::GEGENBAUER>
+
+=item L<PDL::GSL::HYPERG|PDL::GSL::HYPERG>
+
+=item L<PDL::GSL::LAGUERRE|PDL::GSL::LAGUERRE>
+
+=item L<PDL::GSL::LEGENDRE|PDL::GSL::LEGENDRE>
+
+=item L<PDL::GSL::LOG|PDL::GSL::LOG>
+
+=item L<PDL::GSL::POLY|PDL::GSL::POLY>
+
+=item L<PDL::GSL::POW_INT|PDL::GSL::POW_INT>
+
+=item L<PDL::GSL::PSI|PDL::GSL::PSI>
+
+=item L<PDL::GSL::SYNCHROTRON|PDL::GSL::SYNCHROTRON>
+
+=item L<PDL::GSL::TRANSPORT|PDL::GSL::TRANSPORT>
+
+=item L<PDL::GSL::TRIG|PDL::GSL::TRIG>
+
+=item L<PDL::GSL::ZETA|PDL::GSL::ZETA>
+
+=back
+
+
+
+=head1 FITTING FUNCTIONS
+
+=over 5
+
+=item L<PDL::Fit::Gaussian|PDL::Fit::Gaussian>
+
+Fit gaussian curves.
+
+=item L<PDL::Fit::Polynomial|PDL::Fit::Polynomial>
+
+Fit polynomials.
+
+=item L<PDL::Fit::Linfit|PDL::Fit::Linfit>
+
+Fit linear combinations of functions.
+
+=item L<PDL::Fit::LM|PDL::Fit::LM>
+
+Fit functions using the Levenberg-Marquardt algorithm.
+
+=back
+
+
+
+=head1 ADVANCED
+
+=over 5
+
+=item L<PDL::Dbg|PDL::Dbg>
+
+PDL debugger.
+
+=item L<PDL::DiskCache|PDL::DiskCache>
+
+Manage many piddles through a disk cache.
+
+=item L<PDL::CallExt|PDL::CallExt>
+
+Call external functions.
+
+=item L<PDL::Objects|PDL::Objects>
+
+If you want to sub-class from PDL (note: incomplete).
+
+=back
+
+
+
+
+=head1 COPYRIGHT
+
+Copyright 2010 Daniel Carrera (dcarrera at gmail.com). You can distribute
+and/or modify this document under the same terms as the current Perl
+license.
+
+See: http://dev.perl.org/licenses/
diff --git a/Basic/Pod/Objects.pod b/Basic/Pod/Objects.pod
new file mode 100644
index 0000000..39293f0
--- /dev/null
+++ b/Basic/Pod/Objects.pod
@@ -0,0 +1,114 @@
+=head1 NAME
+
+PDL::Objects -- Object-Orientation, what is it and how to exploit it
+
+=head1 DESCRIPTION
+
+This still needs to be written properly. [Also, is there a good reason
+we don't recommend storing extra object data in the header hash?]
+
+=head2 Inheritance
+
+There are basically two reasons for subclassing piddles.
+The first is simply that you want to be able to use your own routines
+like
+
+ $piddle->something()
+
+but don't want to mess up the PDL namespace (a worthy goal, indeed!).
+The other is that you wish to provide special handling of some functions
+or more information about the data the piddle contains.
+In the first case, you can do with
+
+ package BAR;
+ @ISA=qw/PDL/;
+ sub foo {my($this) = @_; fiddle;}
+
+ package main;
+ $a = PDL::pdl(BAR,5);
+ $a->foo();
+
+However, because a PDL object is an opaque reference to a C struct,
+it is not possible to
+extend the PDL class by e.g. extra data via subclassing.
+To circumvent this problem
+PerlDL has built-in support to extent the PDL class via the I<has-a>
+relation for blessed hashes. You can get the I<HAS-A> behave like
+I<IS-A> simply in that you assign the C<PDL> object to the attribute
+named PDL and redefine the method initialize().
+
+ package FOO;
+
+ @FOO::ISA = qw(PDL);
+ sub initialize {
+ my $class = shift;
+ my $self = {
+ creation_time => time(), # necessary extension :-)
+ PDL => null, # used to store PDL object
+ };
+ bless $self, $class;
+ }
+
+All PDL constructors will call initialize() to make sure that your
+extensions are added by I<all> PDL constructors automatically. The
+C<PDL> attribute is used by perlDL to store the PDL object and
+all PDL methods use this attribute automatically if they are called
+with a blessed hash reference instead of a PDL object (a blessed scalar).
+
+Do remember that if you subclass a class that is subclassed from a piddle,
+you need to call SUPER::initialize.
+
+
+NEED STUFF ABOUT CODE REFs!!
+
+=head2 Examples
+
+You can find some simple examples of PDL subclassing in the PDL distribution
+test-case files. Look in C<t/subclass2.t>, C<t/subclass3.t>, etc.
+
+=head2 Output Auto-Creation and Subclassed Objects
+
+For PDL Functions where the output is created and returned, PDL will either
+call the subclassed object's C<initialize> or C<copy> method to create the
+output object. (See L<PDL::Indexing|PDL::Indexing/"Output auto-creation and PP-function calling conventions">
+for a discussion on Output Auto-Creation.) This behavior is summarized as follows:
+
+=over 1
+
+=item *
+
+For I<Simple> functions, defined as having a signature of
+
+ func( a(), [o]b() )
+
+PDL will call $a->copy to create the output object.
+
+In the spirit of the Perl philosophy of making I<Easy Things Easy>,
+This behavior enables PDL-subclassed objects to be written without having to
+overload the many simple PDL functions in this category.
+
+The file t/subclass4.t in the PDL Distribution tests for this behavior.
+See that file for an example.
+
+=item *
+
+For other functions, PDL will call $class->initialize to create the output object.
+Where $class is the class name of the first argument supplied to the function.
+
+For these more complex cases, it is difficult to second-guess the subclassed object's
+designer to know if a C<copy> or a C<initialize> is appropriate. So for these cases,
+$class->initialize is called by default. If this is not appropriate for you,
+overload the function in your subclass and do whatever is appropriate is the overloaded
+function's code.
+
+=back
+
+
+=head1 AUTHOR
+
+Copyright (C) Karl Glazebrook (kgb at aaoepp.aao.gov.au), Tuomas J. Lukka,
+(lukka at husc.harvard.edu) and Christian Soeller (c.soeller at auckland.ac.nz) 2000.
+Commercial reproduction of this documentation in a different format is forbidden.
+
+=cut
+
diff --git a/Basic/Pod/PP.pod b/Basic/Pod/PP.pod
new file mode 100644
index 0000000..5cfd38c
--- /dev/null
+++ b/Basic/Pod/PP.pod
@@ -0,0 +1,2447 @@
+package PDL::PP;
+
+__END__
+
+=head1 NAME
+
+PDL::PP - Generate PDL routines from concise descriptions
+
+=head1 SYNOPSIS
+
+e.g.
+
+ pp_def(
+ 'sumover',
+ Pars => 'a(n); [o]b();',
+ Code => q{
+ double tmp=0;
+ loop(n) %{
+ tmp += $a();
+ %}
+ $b() = tmp;
+ },
+ );
+
+ pp_done();
+
+=head1 FUNCTIONS
+
+Here is a quick reference list of the functions provided by PDL::PP.
+
+=head2 pp_add_boot
+
+=for ref
+
+Add code to the BOOT section of generated XS file
+
+
+=head2 pp_add_exported
+
+=for ref
+
+Add functions to the list of exported functions
+
+
+=head2 pp_add_isa
+
+=for ref
+
+Add entries to the @ISA list
+
+
+=head2 pp_addbegin
+
+=for ref
+
+Sets code to be added at the top of the generate .pm file
+
+
+=head2 pp_addhdr
+
+=for ref
+
+Add code and includes to C section of the generated XS file
+
+
+=head2 pp_addpm
+
+=for ref
+
+Add code to the generated .pm file
+
+
+=head2 pp_addxs
+
+=for ref
+
+Add extra XS code to the generated XS file
+
+=head2 pp_beginwrap
+
+=for ref
+
+Add BEGIN-block wrapping to code for the generated .pm file
+
+
+=head2 pp_bless
+
+=for ref
+
+Sets the package to which the XS code is added (default is PDL)
+
+
+=head2 pp_boundscheck
+
+=for ref
+
+Control state of PDL bounds checking activity
+
+
+=head2 pp_core_importList
+
+=for ref
+
+Specify what is imported from PDL::Core
+
+
+=head2 pp_def
+
+=for ref
+
+Define a new PDL function
+
+
+=head2 pp_deprecate_module
+
+=for ref
+
+Add runtime and POD warnings about a module being deprecated
+
+
+=head2 pp_done
+
+=for ref
+
+Mark the end of PDL::PP definitions in the file
+
+
+=head2 pp_export_nothing
+
+=for ref
+
+Clear out the export list for your generated module
+
+
+=head2 pp_line_numbers
+
+=for ref
+
+Add line number information to simplify debugging of PDL::PP code
+
+
+=head2 pp_setversion
+
+=for ref
+
+Set the version for .pm and .xs files
+
+
+
+=head1 OVERVIEW
+
+Why do we need PP? Several reasons: firstly, we want to be able to
+generate subroutine code for each of the PDL datatypes (PDL_Byte,
+PDL_Short,. etc). AUTOMATICALLY. Secondly, when referring to slices
+of PDL arrays in Perl (e.g. C<< $a->slice('0:10:2,:') >> or other things such
+as transposes) it is nice to be able to do this transparently and to
+be able to do this 'in-place' - i.e, not to have to make a memory copy
+of the section. PP handles all the necessary element and offset
+arithmetic for you. There are also the notions of threading (repeated
+calling of the same routine for multiple slices, see L<PDL::Indexing>)
+and dataflow (see L<PDL::Dataflow>) which use of PP allows.
+
+In much of what follows we will assume familiarity of the reader with
+the concepts of implicit and explicit threading and index manipulations
+within PDL. If you have not yet heard of these concepts or are not very
+comfortable with them it is time to check L<PDL::Indexing>.
+
+As you may appreciate from its name PDL::PP is a Pre-Processor, i.e.
+it expands code via substitutions to make real C-code. Technically, the
+output is XS code (see I<perlxs>) but that is very close to C.
+
+So how do you use PP? Well for the most part you just write ordinary C
+code except for special PP constructs which take the form:
+
+ $something(something else)
+
+or:
+
+ PPfunction %{
+ <stuff>
+ %}
+
+The most important PP construct is the form C<$array()>. Consider the very
+simple PP function to sum the elements of a 1D vector (in fact this is
+very similar to the actual code used by 'sumover'):
+
+ pp_def('sumit',
+ Pars => 'a(n); [o]b();',
+ Code => q{
+ double tmp;
+ tmp = 0;
+ loop(n) %{
+ tmp += $a();
+ %}
+ $b() = tmp;
+ }
+ );
+
+What's going on? The C<< Pars => >> line is very important for PP - it
+specifies all the arguments and their dimensionality. We call
+this the I<signature> of the PP function (compare also the explanations in
+L<PDL::Indexing>). In this case the
+routine takes a 1-D function as input and returns a 0-D scalar as
+output. The C<$a()> PP construct is used to access elements of the array
+a(n) for you - PP fills in all the required C code.
+
+You will notice that we are using the C<q{}> single-quote operator. This is
+not an accident. You generally want to use single quotes to denote your
+PP Code sections. PDL::PP uses C<$var()> for its parsing and if you don't
+use single quotes, Perl will try to interpolate C<$var()>. Also, using the
+single quote C<q> operator with curly braces makes it look like you are
+creating a code block, which is What You Mean. (Perl is smart enough to look
+for nested curly braces and not close the quote until it finds the matching
+curly brace, so it's safe to have nested blocks.) Under other circumstances,
+such as when you're stitching together a Code block using string
+concatenations, it's often easiest to use real single quotes as
+
+ Code => 'something'.$interpolatable.'somethingelse;'
+
+In the simple case here where all elements are accessed the PP construct
+C<loop(n) %{ ... %}> is used to loop over all elements in dimension C<n>.
+Note this feature of PP: ALL DIMENSIONS ARE SPECIFIED BY NAME.
+
+This is made clearer if we avoid the PP loop() construct
+and write the loop explicitly using conventional C:
+
+ pp_def('sumit',
+ Pars => 'a(n); [o]b();',
+ Code => q{
+ int i,n_size;
+ double tmp;
+ n_size = $SIZE(n);
+ tmp = 0;
+ for(i=0; i<n_size; i++) {
+ tmp += $a(n=>i);
+ }
+ $b() = tmp;
+ },
+ );
+
+which does the same as before, but is more long-winded.
+You can see to get element C<i> of a() we say C<< $a(n=>i) >> - we are
+specifying the dimension by name C<n>. In 2D we might say:
+
+
+ Pars=>'a(m,n);',
+ ...
+ tmp += $a(m=>i,n=>j);
+ ...
+
+The syntax C<< m=>i >> borrows from Perl hashes, which are in fact
+used in the implementation of PP. One could also say
+C<< $a(n=>j,m=>i) >> as order is not important.
+
+You can also see in the above example the use of another PP
+construct - C<$SIZE(n)> to get the length of the dimension C<n>.
+
+It should, however, be noted that you shouldn't write an explicit C-loop
+when you could have used the PP C<loop> construct since PDL::PP checks
+automatically the loop limits for you, usage of C<loop> makes the code more
+concise, etc. But there are certainly situations where you need explicit
+control of the loop and now you know how to do it ;).
+
+To revisit 'Why PP?' - the above code for sumit() will be
+generated for each data-type. It will operate on slices
+of arrays 'in-place'. It will thread automatically - e.g. if
+a 2D array is given it will be called repeatedly for each
+1D row (again check L<PDL::Indexing> for the details of threading).
+And then b() will be a 1D array of sums of each row.
+We could call it with $a->xchg(0,1) to sum the columns instead.
+And Dataflow tracing etc. will be available.
+
+You can see PP saves the programmer from writing a lot of
+needlessly repetitive C-code -- in our opinion this is
+one of the best features of PDL making writing
+new C subroutines for PDL an amazingly concise exercise. A second reason is
+the ability to make PP expand your concise code definitions into different
+C code based on the needs of the computer architecture in question. Imagine
+for example you are lucky to have a supercomputer at your hands; in that
+case you want PDL::PP certainly to generate code that takes advantage of
+the vectorising/parallel computing features of your machine (this a project
+for the future). In any case, the bottom line is that your unchanged code
+should still expand to working XS code even if the internals of PDL
+changed.
+
+Also, because you are generating the code in an actual Perl script,
+there are many fun things that you can do. Let's say that you need
+to write both sumit (as above) and multit. With a little bit of creativity,
+we can do
+
+ for({Name => 'sumit', Init => '0', Op => '+='},
+ {Name => 'multit', Init => '1', Op => '*='}) {
+ pp_def($_->{Name},
+ Pars => 'a(n); [o]b();',
+ Code => '
+ double tmp;
+ tmp = '.$_->{Init}.';
+ loop(n) %{
+ tmp '.$_->{Op}.' $a();
+ %}
+ $b() = tmp;
+ ');
+ }
+
+which defines both the functions easily. Now, if you later need to
+change the signature or dimensionality or whatever, you only need
+to change one place in your code.
+Yeah, sure, your editor does have 'cut and paste' and 'search and replace'
+but it's still less bothersome and definitely more difficult to
+forget just one place and have strange bugs creep in.
+Also, adding 'orit' (bitwise or) later is a one-liner.
+
+And remember, you really have Perl's full abilities with you -
+you can very easily read any input file and make routines from
+the information in that file. For simple cases like the above,
+the author (Tjl) currently favors the hash syntax like the above -
+it's not too much more characters than the corresponding array
+syntax but much easier to understand and change.
+
+We should mention here also the ability to get the pointer to the
+beginning of the data in memory - a prerequisite for interfacing
+PDL to some libraries. This is handled with the C<$P(var)> directive,
+see below.
+
+When starting work on a new pp_def'ined function, if you make a mistake, you
+will usually find a pile of compiler errors indicating line numbers in the
+generated XS file. If you know how to read XS files (or if you want to learn
+the hard way), you could open the generated XS file and search for the line
+number with the error. However, a recent addition to PDL::PP helps report
+the correct line number of your errors: C<pp_line_numbers>. Working with the
+original summit example, if you had a mis-spelling of tmp in your code, you
+could change the (erroneos) code to something like this and the compiler
+would give you much more useful information:
+
+ pp_def('sumit',
+ Pars => 'a(n); [o]b();',
+ Code => pp_line_numbers(__LINE__, q{
+ double tmp;
+ tmp = 0;
+ loop(n) %{
+ tmp += $a();
+ %}
+ $b() = rmp;
+ })
+ );
+
+For the above situation, my compiler tells me:
+
+ ...
+ test.pd:15: error: ‘rmp’ undeclared (first use in this function)
+ ...
+
+In my example script (called test.pd), line 15 is exactly the line at which
+I made my typo: C<rmp> instead of C<tmp>.
+
+So, after this quick overview of the general flavour of programming
+PDL routines using PDL::PP let's summarise in which circumstances you
+should actually use this preprocessor/precompiler. You should use PDL::PP
+if you want to
+
+=over 3
+
+=item *
+
+interface PDL to some external library
+
+=item *
+
+write some algorithm that would be slow if coded in Perl
+(this is not as often as you think; take a look at threading
+and dataflow first).
+
+=item *
+
+be a PDL developer (and even then it's not obligatory)
+
+=back
+
+=head1 WARNING
+
+Because of its architecture, PDL::PP can be both flexible and easy to use
+on the one hand, yet exuberantly complicated at the same time. Currently,
+part of the problem is that error messages are not very informative and if
+something goes wrong, you'd better know what you are doing and be able to
+hack your way through the internals (or be able to figure out by trial and
+error what is wrong with your args to C<pp_def>). Although work is being
+done to produce better warnings, do not be afraid to send your questions to
+the mailing list if you run into trouble.
+
+=head1 DESCRIPTION
+
+Now that you have some idea how to use C<pp_def> to define new PDL functions
+it is time to explain the general syntax of C<pp_def>.
+C<pp_def> takes as arguments first the name of the function
+you are defining and then a hash list that can contain various keys.
+
+Based on these keys PP generates XS code and a .pm file. The function
+C<pp_done> (see example in the SYNOPSIS) is used to tell PDL::PP that there
+are no more definitions in this file and it is time to generate the .xs and
+ .pm file.
+
+As a consequence, there may be several pp_def() calls inside a file (by
+convention files with PP code have the extension .pd or .pp) but generally
+only one pp_done().
+
+There are two main different types of usage of pp_def(),
+the 'data operation' and 'slice operation' prototypes.
+
+The 'data operation' is used to take some data, mangle it and
+output some other data; this includes for example the '+' operation,
+matrix inverse, sumover etc and all the examples we have talked about
+in this document so far. Implicit and explicit threading and the creation
+of the result are taken care of automatically in those operations. You
+can even do dataflow with C<sumit>, C<sumover>, etc
+(don't be dismayed if you don't understand the concept of dataflow
+in PDL very well yet; it is still very much experimental).
+
+The 'slice operation' is a different kind of operation: in a slice
+operation, you are not changing any data, you are defining
+correspondences between different elements of two piddles (examples include
+the index manipulation/slicing function definitions in the file F<slices.pd>
+that is part of the PDL distribution; but beware, this is not introductory
+level stuff).
+
+If PDL was compiled with support for bad values (i.e. C<WITH_BADVAL =E<gt> 1>),
+then additional keys are required for C<pp_def>, as explained below.
+
+If you are just interested in communicating with some external
+library (for example some linear algebra/matrix library), you'll usually
+want the 'data operation' so we are going to discuss that first.
+
+=head1 Data operation
+
+=head2 A simple example
+
+In the data operation, you must know what dimensions of data
+you need. First, an example with scalars:
+
+ pp_def('add',
+ Pars => 'a(); b(); [o]c();',
+ Code => '$c() = $a() + $b();'
+ );
+
+That looks a little strange but let's dissect it. The first
+line is easy: we're defining a routine with the name 'add'.
+The second line simply declares our parameters and the parentheses
+mean that they are scalars. We call the string that defines our parameters
+and their dimensionality the I<signature> of that function. For its
+relevance with regard to threading and index manipulations check the
+L<PDL::Indexing> man page.
+
+The third line is the actual operation. You need to use the
+dollar signs and parentheses to refer to your parameters
+(this will probably change at some point in the future, once
+a good syntax is found).
+
+These lines are all that is necessary to actually define the function
+for PDL (well, actually it isn't; you additionally need to write a
+Makefile.PL (see below) and build the module (something like 'perl
+Makefile.PL; make'); but let's ignore that for the moment). So now you
+can do
+
+ use MyModule;
+ $a = pdl 2,3,4;
+ $b = pdl 5;
+
+ $c = add($a,$b);
+ # or
+ add($a,$b,($c=null)); # Alternative form, useful if $c has been
+ # preset to something big, not useful here.
+
+and have threading work correctly (the result is $c == [7 8 9]).
+
+=head2 The Pars section: the signature of a PP function
+
+Seeing the above example code you will most probably ask: what is this
+strange C<$c=null> syntax in the second call to our new C<add> function? If
+you take another look at the definition of C<add> you will notice that
+the third argument C<c> is flagged with the qualifier C<[o]> which
+tells PDL::PP that this is an output argument. So the above call to
+add means 'create a new $c from scratch with correct dimensions' -
+C<null> is a special token for 'empty piddle' (you might ask why we
+haven't used the value C<undef> to flag this instead of the PDL
+specific C<null>; we are currently thinking about it ;).
+
+[This should be explained in some other section of the manual
+as well!!]
+The reason for having this syntax as an alternative is that if you have
+really huge piddles, you can do
+
+ $c = PDL->null;
+ for(some long loop) {
+ # munge a,b
+ add($a,$b,$c);
+ # munge c, put something back to a,b
+ }
+
+and avoid allocating and deallocating $c each time. It is allocated
+once at the first add() and thereafter the memory stays until $c is
+destroyed.
+
+If you just say
+
+ $c = add($a,$b);
+
+the code generated by PP will automatically fill in C<$c=null>
+and return
+the result. If you want to learn more
+about the reasons why PDL::PP supports this style where output arguments
+are given as last arguments check the
+L<PDL::Indexing> man page.
+
+C<[o]> is not the only qualifier a pdl argument can have in the signature.
+Another important qualifier is the C<[t]> option which flags a pdl as
+temporary. What does that mean? You tell PDL::PP that this pdl is only
+used for temporary results in the course of the calculation and you are
+not interested in its value after the computation has been completed. But
+why should PDL::PP want to know about this in the first place? The reason
+is closely related to the concepts of pdl auto creation (you heard
+about that above) and implicit threading. If you use implicit threading
+the dimensionality of automatically created pdls is actually larger than
+that specified in the signature. With C<[o]> flagged pdls will be created
+so that they have the additional dimensions as required by the number
+of implicit thread dimensions. When creating a temporary pdl, however,
+it will always only be made big enough so that it can hold the result
+for one iteration in a thread loop, i.e. as large as required by the signature.
+So less memory is wasted when you flag a pdl as temporary. Secondly, you
+can use output auto creation with temporary pdls even when you are using
+explicit threading which is forbidden for normal output pdls flagged with
+C<[o]> (see L<PDL::Indexing>).
+
+Here is an example where we use the [t] qualifier. We define the function
+C<callf> that calls a C routine C<f> which needs a temporary array of the
+same size and type as the array C<a> (sorry about the forward reference
+for C<$P>; it's a pointer access, see below) :
+
+ pp_def('callf',
+ Pars => 'a(n); [t] tmp(n); [o] b()',
+ Code => 'int ns = $SIZE(n);
+ f($P(a),$P(b),$P(tmp),ns);
+ '
+ );
+
+=head2 Argument dimensions and the signature
+
+Now we have just talked about dimensions of pdls and the signature. How
+are they related? Let's say that we want to add a scalar + the index
+number to a vector:
+
+ pp_def('add2',
+ Pars => 'a(n); b(); [o]c(n);',
+ Code => 'loop(n) %{
+ $c() = $a() + $b() + n;
+ %}'
+ );
+
+There are several points to notice here: first, the C<Pars>
+argument now contains the I<n> arguments to show that we have a single
+dimensions in I<a> and I<c>. It is important to note that dimensions
+are actual entities that are accessed by name so this declares
+I<a> and I<c> to have the B<same> first dimensions. In most PP definitions
+the size of named dimensions will be set from the respective dimensions
+of non-output pdls (those with no C<[o]> flag) but sometimes you might
+want to set the size of a named dimension explicitly through an integer
+parameter. See below in the description of the C<OtherPars> section how
+that works.
+
+=head2 Constant argument dimensions in the signature
+
+Suppose you want an output piddle to be created
+automatically and you know that on every call its dimension
+will have the same size (say 9) regardless of the dimensions
+of the input piddles. In this case you use the following
+syntax in the Pars section to specify the size of the dimension:
+
+ ' [o] y(n=9); '
+
+As expected, extra dimensions required by threading will be
+created if necessary. If you need to assign a named dimension according
+to a more complicated formula (than a constant) you must use the
+C<RedoDimsCode> key described below.
+
+=head2 Type conversions and the signature
+
+The signature also determines the type conversions that will be performed
+when a PP function is invoked. So what happens when we invoke one of
+our previously defined functions with pdls of different type, e.g.
+
+ add2($a,$b,($ret=null));
+
+where $a is of type C<PDL_Float> and $b of type C<PDL_Short>? With the signature
+as shown in the definition of C<add2> above the datatype of the operation
+(as determined at runtime) is that of the pdl with the 'highest' type
+(sequence is byte < short < ushort < long < float < double). In the add2
+example the datatype of the operation is float ($a has that datatype). All
+pdl arguments are then type converted to that datatype (they are not
+converted inplace but a copy with the right type is created if a pdl argument
+doesn't have the type of the operation).
+Null pdls don't contribute a type
+in the determination of the type of the operation.
+However, they will be
+created with the datatype of the operation; here, for example, $ret will be
+of type float. You should be aware of these rules when calling PP functions
+with pdls of different types to take the additional storage and runtime
+requirements into account.
+
+These type conversions are correct for most functions you normally define
+with C<pp_def>. However, there are certain cases where slightly modified
+type conversion behaviour is desired. For these cases additional qualifiers
+in the signature can be used to specify the desired properties with regard
+to type conversion. These qualifiers can be combined with those we have
+encountered already (the I<creation qualifiers> C<[o]> and C<[t]>). Let's
+go through the list of qualifiers that change type conversion behaviour.
+
+The most important is the C<int> qualifier which comes in handy when a
+pdl argument represents indices into another pdl. Let's take a look at
+an example from C<PDL::Ufunc>:
+
+ pp_def('maximum_ind',
+ Pars => 'a(n); int [o] b()',
+ Code => '$GENERIC() cur;
+ int curind;
+ loop(n) %{
+ if (!n || $a() > cur) {cur = $a(); curind = n;}
+ %}
+ $b() = curind;',
+ );
+
+The function C<maximum_ind> finds the index of the largest element of
+a vector. If you look at the signature you notice that the output
+argument C<b> has been declared with the additional C<int> qualifier.
+This has the following consequences for type conversions: regardless of
+the type of the input pdl C<a> the output pdl C<b> will be of type
+C<PDL_Long> which makes sense since C<b> will represent an index into
+C<a>. Furthermore, if you call the function with an existing output
+pdl C<b> its type will not influence the datatype of the operation (see
+above). Hence, even if C<a> is of a smaller type than C<b> it will not
+be converted to match the type of C<b> but stays untouched, which saves
+memory and CPU cycles and is the right thing to do when C<b> represents
+indices. Also note that you can use the 'int' qualifier together with
+other qualifiers (the C<[o]> and C<[t]> qualifiers). Order is significant --
+type qualifiers precede creation qualifiers (C<[o]> and C<[t]>).
+
+The above example also demonstrates typical usage of the C<$GENERIC()>
+macro. It expands to the current type in a so called generic
+loop. What is a generic loop? As you already heard a PP function has a
+runtime datatype as determined by the type of the pdl arguments it has
+been invoked with. The PP generated XS code for this function
+therefore contains a switch like C<switch (type) {case PDL_Byte: ... case
+PDL_Double: ...}> that selects a case based on the runtime
+datatype of the function (it's called a type ``loop''
+because there is a loop in PP code that generates the cases).
+In any case your code is inserted once for each PDL type
+into this switch statement. The C<$GENERIC()> macro just expands to
+the respective type in each copy of your parsed code in this C<switch>
+statement, e.g., in the C<case PDL_Byte> section C<cur> will expand to
+C<PDL_Byte> and so on for the other case statements. I guess you
+realise that this is a useful macro to hold values of pdls in some
+code.
+
+There are a couple of other qualifiers with similar effects as C<int>.
+For your convenience there are the C<float> and C<double> qualifiers
+with analogous consequences on type conversions as C<int>. Let's
+assume you have a I<very> large array for which you want to compute
+row and column sums with an equivalent of the C<sumover> function.
+However, with the normal definition of C<sumover> you might run
+into problems when your data is, e.g. of type short. A call like
+
+ sumover($large_pdl,($sums = null));
+
+will result in C<$sums> be of type short and is therefore prone to
+overflow errors if C<$large_pdl> is a very large array. On the other
+hand calling
+
+ @dims = $large_pdl->dims; shift @dims;
+ sumover($large_pdl,($sums = zeroes(double, at dims)));
+
+is not a good alternative either. Now we don't have overflow problems with
+C<$sums> but at the expense of a type conversion of C<$large_pdl> to
+double, something bad if this is really a large pdl. That's where C<double>
+comes in handy:
+
+ pp_def('sumoverd',
+ Pars => 'a(n); double [o] b()',
+ Code => 'double tmp=0;
+ loop(n) %{ tmp += a(); %}
+ $b() = tmp;',
+ );
+
+This gets us around the type conversion and overflow problems. Again,
+analogous to the C<int> qualifier C<double> results in C<b> always being of
+type double regardless of the type of C<a> without leading to a
+type conversion of C<a> as a side effect.
+
+Finally, there are the C<type+> qualifiers where type is one of C<int>
+or C<float>. What shall that mean. Let's illustrate the C<int+>
+qualifier with the actual definition of sumover:
+
+ pp_def('sumover',
+ Pars => 'a(n); int+ [o] b()',
+ Code => '$GENERIC(b) tmp=0;
+ loop(n) %{ tmp += a(); %}
+ $b() = tmp;',
+ );
+
+As we had already seen for the C<int>, C<float> and C<double>
+qualifiers, a pdl marked with a C<type+> qualifier does not influence
+the datatype of the pdl operation. Its meaning is "make this pdl at
+least of type C<type> or higher, as required by the type of the
+operation". In the sumover example this means that when you call the
+function with an C<a> of type PDL_Short the output pdl will be of type
+PDL_Long (just as would have been the case with the C<int>
+qualifier). This again tries to avoid overflow problems when using
+small datatypes (e.g. byte images). However, when the datatype of the
+operation is higher than the type specified in the C<type+> qualifier
+C<b> will be created with the datatype of the operation, e.g. when
+C<a> is of type double then C<b> will be double as well. We hope you
+agree that this is sensible behaviour for C<sumover>. It should be
+obvious how the C<float+> qualifier works by analogy.
+It may become necessary to be able to specify a set of alternative
+types for the parameters. However, this will probably not be
+implemented until someone comes up with a reasonable use for it.
+
+Note that we now had to specify the C<$GENERIC> macro with the name
+of the pdl to derive the type from that argument. Why is that? If you
+carefully followed our explanations you will have realised that in some
+cases C<b> will have a different type than the type of the operation.
+Calling the '$GENERIC' macro with C<b> as argument makes sure that
+the type will always the same as that of C<b> in that part of the
+generic loop.
+
+This is about all there is to say about the C<Pars> section in a
+C<pp_def> call. You should remember that this section defines the I<signature>
+of a PP defined function, you can use several options to qualify certain
+arguments as output and temporary args and all dimensions that you can
+later refer to in the C<Code> section are defined by name.
+
+It is important that you understand the meaning of the signature since
+in the latest PDL versions you can use it to define threaded functions
+from within Perl, i.e. what we call I<Perl level threading>. Please check
+L<PDL::Indexing> for details.
+
+=head2 The Code section
+
+The C<Code> section contains the actual XS code that will be in the
+innermost part of a thread loop (if you don't know what a thread loop is then
+you still haven't read L<PDL::Indexing>; do it now ;) after any PP macros
+(like C<$GENERIC>) and PP functions have been expanded (like the
+C<loop> function we are going to explain next).
+
+Let's quickly reiterate the C<sumover> example:
+
+ pp_def('sumover',
+ Pars => 'a(n); int+ [o] b()',
+ Code => '$GENERIC(b) tmp=0;
+ loop(n) %{ tmp += a(); %}
+ $b() = tmp;',
+ );
+
+The C<loop> construct in the C<Code> section also refers to the
+dimension name so you don't need to specify any limits: the loop is
+correctly sized and everything is done for you, again.
+
+Next, there is the surprising fact that C<$a()> and C<$b()> do B<not>
+contain the index. This is not necessary because we're looping over
+I<n> and both variables know which dimensions they have so
+they automatically know they're being looped over.
+
+This feature comes in very handy in many places and makes for
+much shorter code. Of course, there are times when you want to
+circumvent this; here is a function which make a matrix symmetric
+and serves as an example of how to code explicit looping:
+
+ pp_def('symm',
+ Pars => 'a(n,n); [o]c(n,n);',
+ Code => 'loop(n) %{
+ int n2;
+ for(n2=n; n2<$SIZE(n); n2++) {
+ $c(n0 => n, n1 => n2) =
+ $c(n0 => n2, n1 => n) =
+ $a(n0 => n, n1 => n2);
+ }
+ %}
+ '
+ );
+
+Let's dissect what is happening. Firstly, what is this function supposed to
+do? From its signature you see that it takes a 2D matrix with equal numbers
+of columns and rows and outputs a matrix of the same size. From a given
+input matrix $a it computes a symmetric output matrix $c (symmetric in
+the matrix sense that A^T = A where ^T means matrix transpose, or in PDL
+parlance $c == $c->xchg(0,1)). It does this by using only the values
+on and below the diagonal of $a. In the output matrix $c all values on
+and below the diagonal are the same as those in $a while those above the
+diagonal are a mirror image of those below the diagonal (above and below
+are here interpreted in the way that PDL prints 2D pdls). If this explanation
+still sounds a bit strange just go ahead, make a little file into which you
+write this definition, build the new PDL extension (see section on Makefiles
+for PP code) and try it out with a couple of examples.
+
+Having explained what the function is supposed to do there are a
+couple of points worth noting from the syntactical point of
+view. First, we get the size of the dimension named C<n> again by
+using the C<$SIZE> macro. Second, there are suddenly these funny C<n0>
+and C<n1> index names in the code though the signature defines only
+the dimension C<n>. Why this? The reason becomes clear when you note
+that both the first and second dimension of $a and $b are named C<n>
+in the signature of C<symm>. This tells PDL::PP that the first and
+second dimension of these arguments should have the same
+size. Otherwise the generated function will raise a runtime error.
+However, now in an access to C<$a> and C<$c> PDL::PP cannot figure out
+which index C<n> refers to any more just from the name of the index.
+Therefore, the indices with equal dimension names get numbered from
+left to right starting at 0, e.g. in the above example C<n0> refers to
+the first dimension of C<$a> and C<$c>, C<n1> to the second and so on.
+
+In all examples so far, we have only used the C<Pars> and C<Code>
+members of the hash that was passed to C<pp_def>. There are certainly
+other keys that are recognised by PDL::PP and we will hear about some
+of them in the course of this document. Find a (non-exhaustive) list
+of keys in Appendix A. A list of macros and PPfunctions (we have only
+encountered some of those in the examples above yet) that are expanded
+in values of the hash argument to C<pp_def> is summarised in Appendix
+B.
+
+At this point, it might be appropriate to mention that
+PDL::PP is not a completely static, well designed set of routines (as
+Tuomas puts it: "stop thinking of PP as a set of routines carved in
+stone") but rather a collection of things that the PDL::PP author
+(Tuomas J. Lukka) considered he would have to write often into his PDL
+extension routines. PP tries to be expandable so that in the future,
+as new needs arise, new common code can be abstracted back into it. If
+you want to learn more on why you might want to change PDL::PP and how
+to do it check the section on PDL::PP internals.
+
+=head2 Handling bad values
+
+If you do not have bad-value support compiled into PDL you can
+ignore this section and the related keys: C<BadCode>, C<HandleBad>, ...
+(try printing out the value of C<$PDL::Bad::Status> - if it equals 0
+then move straight on).
+
+There are several keys and macros used when writing code to handle
+bad values. The first one is the C<HandleBad> key:
+
+=over 4
+
+=item HandleBad => 0
+
+This flags a pp-routine as I<NOT> handling bad values. If this routine
+is sent piddles with their C<badflag> set, then a warning message is
+printed to STDOUT and the piddles are processed as if the value used to
+represent bad values is a valid number. The C<badflag> value is
+not propogated to the output piddles.
+
+An example of when this is used is for FFT routines, which generally
+do not have a way of ignoring part of the data.
+
+=item HandleBad => 1
+
+This causes PDL::PP to write extra code that ensures the BadCode
+section is used, and that the C<$ISBAD()> macro (and its brethren)
+work.
+
+=item HandleBad is not given
+
+If any of the input piddles have their C<badflag> set, then the
+output piddles will have their C<badflag> set, but any supplied
+BadCode is ignored.
+
+=back
+
+The value of C<HandleBad> is used to define the contents of
+the C<BadDoc> key, if it is not given.
+
+To handle bad values, code must be written somewhat differently;
+for instance,
+
+ $c() = $a() + $b();
+
+becomes something like
+
+ if ( $a() != BADVAL && $b() != BADVAL ) {
+ $c() = $a() + $b();
+ } else {
+ $c() = BADVAL;
+ }
+
+However, we only want the second version if bad values are present in
+the input piddles (and that bad-value support is wanted!) - otherwise
+we actually want the original code. This is where the C<BadCode>
+key comes in; you use it to specify the code to execute if bad values
+may be present, and PP uses both it and the C<Code> section to create
+something like:
+
+ if ( bad_values_are_present ) {
+ fancy_threadloop_stuff {
+ BadCode
+ }
+ } else {
+ fancy_threadloop_stuff {
+ Code
+ }
+ }
+
+This approach means that there is virtually no overhead when
+bad values are not present (i.e. the L<badflag|PDL::Bad/badflag> routine
+returns 0).
+
+The BadCode section can use the same macros and looping constructs
+as the Code section.
+However, it wouldn't be much use without the following additional
+macros:
+
+=over 4
+
+=item $ISBAD(var)
+
+To check whether a piddle's value is bad, use the C<$ISBAD> macro:
+
+ if ( $ISBAD(a()) ) { printf("a() is bad\n"); }
+
+You can also access given elements of a piddle:
+
+ if ( $ISBAD(a(n=>l)) ) { printf("element %d of a() is bad\n", l); }
+
+=item $ISGOOD(var)
+
+This is the opposite of the C<$ISBAD> macro.
+
+=item $SETBAD(var)
+
+For when you want to set an element of a piddle bad.
+
+=item $ISBADVAR(c_var,pdl)
+
+If you have cached the value of a piddle C<$a()> into a c-variable (C<foo> say),
+then to check whether it is bad, use C<$ISBADVAR(foo,a)>.
+
+=item $ISGOODVAR(c_var,pdl)
+
+As above, but this time checking that the cached value
+isn't bad.
+
+=item $SETBADVAR(c_var,pdl)
+
+To copy the bad value for a piddle into a c variable, use
+C<$SETBADVAR(foo,a)>.
+
+=back
+
+I<TODO:> mention C<$PPISBAD()> etc macros.
+
+Using these macros, the above code could be specified as:
+
+ Code => '$c() = $a() + $b();',
+ BadCode => '
+ if ( $ISBAD(a()) || $ISBAD(b()) ) {
+ $SETBAD(c());
+ } else {
+ $c() = $a() + $b();
+ }',
+
+Since this is Perl, TMTOWTDI, so you could also write:
+
+ BadCode => '
+ if ( $ISGOOD(a()) && $ISGOOD(b()) ) {
+ $c() = $a() + $b();
+ } else {
+ $SETBAD(c());
+ }',
+
+If you want access to the value of the badflag for a given
+piddle, you can use the C<$PDLSTATExxxx()> macros:
+
+=over 4
+
+=item $PDLSTATEISBAD(pdl)
+
+=item $PDLSTATEISGOOD(pdl)
+
+=item $PDLSTATESETBAD(pdl)
+
+=item $PDLSTATESETGOOD(pdl)
+
+=back
+
+I<TODO:> mention the C<FindBadStatusCode> and
+C<CopyBadStatusCode> options to C<pp_def>, as well as the
+C<BadDoc> key.
+
+=head2 Interfacing your own/library functions using PP
+
+Now, consider the following: you have your own C function
+(that may in fact be part of some library you want to interface to PDL)
+which takes as arguments two pointers to vectors of double:
+
+ void myfunc(int n,double *v1,double *v2);
+
+The correct way of defining the PDL function is
+
+ pp_def('myfunc',
+ Pars => 'a(n); [o]b(n);',
+ GenericTypes => ['D'],
+ Code => 'myfunc($SIZE(n),$P(a),$P(b));'
+ );
+
+The C<$P(>I<par>C<)> syntax returns a pointer to the first
+element and the other elements are guaranteed to lie after that.
+
+Notice that here it is possible to make many mistakes. First,
+C<$SIZE(n)> must be used instead of C<n>. Second, you shouldn't put
+any loops in this code. Third, here we encounter a new hash key
+recognised by PDL::PP : the C<GenericTypes> declaration tells PDL::PP
+to ONLY GENERATE THE TYPELOOP FOP THE LIST OF TYPES SPECIFIED. In
+this case C<double>. This has two advantages. Firstly the size of
+the compiled code is reduced vastly, secondly if non-double arguments
+are passed to C<myfunc()> PDL will automatically convert them to
+double before passing to the external C routine and convert them
+back afterwards.
+
+One can also use C<Pars> to qualify the types of individual
+arguments. Thus one could also write this as:
+
+ pp_def('myfunc',
+ Pars => 'double a(n); double [o]b(n);',
+ Code => 'myfunc($SIZE(n),$P(a),$P(b));'
+ );
+
+The type specification in C<Pars> exempts the argument from
+variation in the typeloop - rather it is automatically converted
+too and from the type specified. This is obviously useful in
+a more general example, e.g.:
+
+ void myfunc(int n,float *v1,long *v2);
+
+ pp_def('myfunc',
+ Pars => 'float a(n); long [o]b(n);',
+ GenericTypes => ['F'],
+ Code => 'myfunc($SIZE(n),$P(a),$P(b));'
+ );
+
+Note we still use C<GenericTypes> to reduce the size of the
+type loop, obviously PP could in principle spot this and do
+it automatically though the code has yet to attain that
+level of sophistication!
+
+Finally note when types are converted automatically one MUST
+use the C<[o]> qualifier for output variables or you hard
+one changes will get optimised away by PP!
+
+If you interface a large library you can automate the interfacing even
+further. Perl can help you again(!) in doing this. In many libraries
+you have certain calling conventions. This can be exploited. In short,
+you can write a little parser (which is really not difficult in Perl) that
+then generates the calls to C<pp_def> from parsed descriptions of the
+functions in that library. For an example, please check the I<Slatec>
+interface in the C<Lib> tree of the PDL distribution. If you want to check
+(during debugging) which calls to PP functions your Perl code generated
+a little helper package comes in handy which replaces the PP functions
+by identically named ones that dump their arguments to stdout.
+
+Just say
+
+ perl -MPDL::PP::Dump myfile.pd
+
+to see the calls to C<pp_def> and friends. Try it with F<ops.pd> and
+F<slatec.pd>. If you're interested (or want to enhance it), the source
+is in Basic/Gen/PP/Dump.pm
+
+=head2 Other macros and functions in the Code section
+
+Macros: So far we have encountered the C<$SIZE>, C<$GENERIC> and C<$P> macros.
+Now we are going to quickly explain the other macros that are expanded in the
+C<Code> section of PDL::PP along with examples of their usage.
+
+=over 3
+
+=item C<$T>
+
+The C<$T> macro is used for type switches. This is very useful when you have
+to use different external (e.g. library) functions depending on the input
+type of arguments. The general syntax is
+
+ $Ttypeletters(type_alternatives)
+
+where C<typeletters> is a permutation of a subset of the letters
+C<BSULFD> which stand for Byte, Short, Ushort, etc. and
+C<type_alternatives> are the expansions when the type of the PP
+operation is equal to that indicated by the respective letter. Let's
+illustrate this incomprehensible description by an example. Assuming
+you have two C functions with prototypes
+
+ void float_func(float *in, float *out);
+ void double_func(double *in, double *out);
+
+which do basically the same thing but one accepts float and the other
+double pointers. You could interface them to PDL by defining a generic
+function C<foofunc> (which will call the correct function depending
+on the type of the transformation):
+
+ pp_def('foofunc',
+ Pars => ' a(n); [o] b();',
+ Code => ' $TFD(float_func,double_func) ($P(a),$P(b));'
+ GenericTypes => [qw(F D)],
+ );
+
+Please note that you can't say
+
+ Code => ' $TFD(float,double)_func ($P(a),$P(b));'
+
+since the C<$T> macro expands with trailing spaces, analogously to
+C preprocessor macros.
+The slightly longer form illustrated above is correct.
+If you really want brevity, you can of course do
+
+ '$TBSULFD('.(join ',',map {"long_identifier_name_$_"}
+ qw/byt short unseigned lounge flotte dubble/).');'
+
+=item C<$PP>
+
+The C<$PP> macro is used for a so called I<physical pointer access>. The
+I<physical> refers to some internal optimisations of PDL (for those who
+are familiar with the PDL core we are talking about the vaffine
+optimisations). This macro is mainly for internal use and you shouldn't
+need to use it in any of your normal code.
+
+=item C<$COMP> (and the C<OtherPars> section)
+
+The C<$COMP> macro is used to access non-pdl values in the code section. Its
+name is derived from the implementation of transformations in PDL. The
+variables you can refer to using C<$COMP> are members
+of the ``compiled'' structure that represents the PDL transformation in question
+but does not yet contain any information about dimensions
+(for further details check L<PDL::Internals>). However, you can treat
+C<$COMP> just as a black box without knowing anything about the
+implementation of transformations in PDL. So when would you use this
+macro? Its main usage is to access values of arguments that are
+declared in the C<OtherPars> section of a C<pp_def> definition. But
+then you haven't heard about the C<OtherPars> key yet?! Let's have
+another example that illustrates typical usage of both new features:
+
+ pp_def('pnmout',
+ Pars => 'a(m)',
+ OtherPars => "char* fd",
+ GenericTypes => [qw(B U S L)],
+ Code => 'PerlIO *fp;
+ IO *io;
+
+ io = GvIO(gv_fetchpv($COMP(fd),FALSE,SVt_PVIO));
+ if (!io || !(fp = IoIFP(io)))
+ croak("Can\'t figure out FP");
+
+ if (PerlIO_write(fp,$P(a),len) != len)
+ croak("Error writing pnm file");
+ ');
+
+This function is used to write data from a pdl to a file. The file descriptor
+is passed as a string into this function. This parameter does not go into
+the C<Pars> section since it cannot be usefully treated like a pdl but rather
+into the aptly named C<OtherPars> section. Parameters in the C<OtherPars>
+section follow those in the C<Pars> section when invoking the function, i.e.
+
+ open FILE,">out.dat" or die "couldn't open out.dat";
+ pnmout($pdl,'FILE');
+
+When you want to access this parameter inside the code section you
+have to tell PP by using the C<$COMP> macro, i.e. you write
+C<$COMP(fd)> as in the example. Otherwise PP wouldn't know that the
+C<fd> you are referring to is the same as that specified in the
+C<OtherPars> section.
+
+Another use for the C<OtherPars> section is to set a named dimension
+in the signature. Let's have an example how that is done:
+
+ pp_def('setdim',
+ Pars => '[o] a(n)',
+ OtherPars => 'int ns => n',
+ Code => 'loop(n) %{ $a() = n; %}',
+ );
+
+This says that the named dimension C<n> will be initialised from the
+value of the I<other parameter> C<ns> which is of integer type (I guess
+you have realised that we use the C<CType From =E<gt> named_dim> syntax).
+Now you can call this function in the usual way:
+
+ setdim(($a=null),5);
+ print $a;
+ [ 0 1 2 3 4 ]
+
+Admittedly this function is not very useful but it demonstrates how it
+works. If you call the function with an existing pdl and you don't need
+to explicitly specify the size of C<n> since PDL::PP can figure it out
+from the dimensions of the non-null pdl. In that case you just give the
+dimension parameter as C<-1>:
+
+ $a = hist($b);
+ setdim($a,-1);
+
+That should do it.
+
+=back
+
+
+
+
+The only PP function that we have used in the examples so far is C<loop>.
+Additionally, there are currently two other functions which are recognised
+in the C<Code> section:
+
+=over 2
+
+=item threadloop
+
+As we heard above the signature of a PP defined function defines the
+dimensions of all the pdl arguments involved in a I<primitive> operation.
+However, you often call the functions that you defined with PP with pdls
+that have more dimensions than those specified in the signature. In this
+case the primitive operation is performed on all subslices of appropriate
+dimensionality in what is called a I<thread loop> (see also overview above
+and L<PDL::Indexing>). Assuming you have some notion of this concept you
+will probably appreciate that the operation specified in the code section
+should be optimised since this is the tightest loop inside a thread loop.
+However, if you revisit the example where we define the C<pnmout> function,
+you will quickly realise that looking up the C<IO> file descriptor
+in the inner thread loop is not very efficient when writing a pdl with
+many rows. A better approach would be to look up the C<IO> descriptor
+once outside the thread loop and use its value then inside the tightest
+thread loop. This is exactly where the C<threadloop> function comes in
+handy. Here is an improved definition of C<pnmout> which uses this
+function:
+
+ pp_def('pnmout',
+ Pars => 'a(m)',
+ OtherPars => "char* fd",
+ GenericTypes => [qw(B U S L)],
+ Code => 'PerlIO *fp;
+ IO *io;
+ int len;
+
+ io = GvIO(gv_fetchpv($COMP(fd),FALSE,SVt_PVIO));
+ if (!io || !(fp = IoIFP(io)))
+ croak("Can\'t figure out FP");
+
+ len = $SIZE(m) * sizeof($GENERIC());
+
+ threadloop %{
+ if (PerlIO_write(fp,$P(a),len) != len)
+ croak("Error writing pnm file");
+ %}
+ ');
+
+This works as follows. Normally the C code you write inside the
+C<Code> section is placed inside a thread loop (i.e. PP generates the
+appropriate wrapping XS code around it). However, when you explicitly
+use the C<threadloop> function, PDL::PP recognises this and doesn't
+wrap your code with an additional thread loop. This has the effect that
+code you write outside the thread loop is only executed once per
+transformation and just the code with in the surrounding C<%{ ... %}>
+pair is placed within the tightest thread loop. This also comes in
+handy when you want to perform a decision (or any other code,
+especially CPU intensive code) only once per thread, i.e.
+
+ pp_addhdr('
+ #define RAW 0
+ #define ASCII 1
+ ');
+ pp_def('do_raworascii',
+ Pars => 'a(); b(); [o]c()',
+ OtherPars => 'int mode',
+ Code => ' switch ($COMP(mode)) {
+ case RAW:
+ threadloop %{
+ /* do raw stuff */
+ %}
+ break;
+ case ASCII:
+ threadloop %{
+ /* do ASCII stuff */
+ %}
+ break;
+ default:
+ croak("unknown mode");
+ }'
+ );
+
+
+=item types
+
+The types function works similar to the C<$T> macro. However, with the
+C<types> function the code in the following block (delimited by C<%{>
+and C<%}> as usual) is executed for all those cases in which the datatype
+of the operation is I<any of> the types represented by the letters in the
+argument to C<type>, e.g.
+
+ Code => '...
+
+ types(BSUL) %{
+ /* do integer type operation */
+ %}
+ types(FD) %{
+ /* do floating point operation */
+ %}
+ ...'
+
+=back
+
+=head2 The RedoDimsCode Section
+
+The C<RedoDimsCode> key is an optional key that is used to
+compute dimensions of piddles at runtime in case the
+standard rules for computing dimensions from the signature
+are not sufficient. The contents of the C<RedoDimsCode> entry
+is interpreted in the same way that the Code section is
+interpreted-- I<i.e.>, PP macros are expanded and the result
+is interpreted as C code. The purpose of the code is to set
+the size of some dimensions that appear in the
+signature. Storage allocation and threadloops and so forth
+will be set up as if the computed dimension had appeared in
+the signature. In your code, you first compute the desired
+size of a named dimension in the signature according to
+your needs and then assign that value to it via the $SIZE()
+macro.
+
+As an example, consider the following situation. You are
+interfacing an external library routine that requires an
+temporary array for workspace to be passed as an
+argument. Two input data arrays that are passed are C<p(m)>
+and C<x(n)>. The output data array is C<y(n)>. The routine
+requires a workspace array with a length of n+m*m, and you'd
+like the storage created automatically just like it would be
+for any piddle flagged with [t] or [o]. What you'd like is to
+say something like
+
+ pp_def( "myexternalfunc",
+ Pars => " p(m); x(n); [o] y; [t] work(n+m*m); ", ...
+
+but that won't work, because PP can't interpret expressions with arithmetic
+in the signature. Instead you write
+
+ pp_def( "myexternalfunc",
+ Pars => " p(m); x(n); [o] y; [t] work(wn); ",
+ RedoDimsCode => "
+ int im = $PDL(p)->dims[0];
+ int in = $PDL(x)->dims[0];
+ int min = in + im * im;
+ int inw = $PDL(work)->dims[0];
+ $SIZE(wn) = inw >= min ? inw : min; ",
+ Code => "
+ externalfunc($P(p),$P(x),$SIZE(m),$SIZE(n),$P(work));
+ ";)
+
+This code works as follows: The macro $PDL(p) expands to a
+pointer to the pdl struct for the piddle p. You don't want
+a pointer to the data ( ie $P ) in this case, because you
+want to access the methods for the piddle on the C
+level. You get the first dimension of each of the piddles
+and store them in integers. Then you compute the minimum
+length the work array can be. If the user sent a piddle
+C<work> with sufficient storage, then leave it alone. If the
+user sent, say a null pdl, or no pdl at all, then the size
+of wn will be zero and you reset it to the minimum
+value. Before the code in the Code section is executed PP
+will create the proper storage for C<work> if it does not
+exist. Note that you only took the first dimension of C<p>
+and C<x> because the user may have sent piddles with extra
+threading dimensions. Of course, the temporary piddle C<work> (note the
+[t] flag) should not be given any thread dimensions anyway.
+
+You can also use C<RedoDimsCode> to set the dimension of a
+piddle flagged with [o]. In this case you set the dimensions
+for the named dimension in the signature using $SIZE() as in
+the preceeding example. However, because the piddle is
+flagged with [o] instead of [t], threading dimensions will
+be added if required just as if the size of the dimension
+were computed from the signature according to the usual
+rules. Here is an example from PDL::Math
+
+ pp_def("polyroots",
+ Pars => 'cr(n); ci(n); [o]rr(m); [o]ri(m);',
+ RedoDimsCode => 'int sn = $PDL(cr)->dims[0]; $SIZE(m) = sn-1;',
+
+The input piddles are the real and imaginary parts of
+complex coefficients of a polynomial. The output piddles are
+real and imaginary parts of the roots. There are C<n> roots
+to an C<n>th order polynomial and such a polynomial has
+C<n+1> coefficients (the zeoreth through the C<n>th). In
+this example, threading will work correctly. That is, the
+first dimension of the output piddle with have its dimension
+adjusted, but other threading dimensions will be assigned
+just as if there were no C<RedoDimsCode>.
+
+=head2 Typemap handling in the C<OtherPars> section
+
+The C<OtherPars> section discussed above is very often absolutely
+crucial when you interface external libraries with PDL. However in
+many cases the external libraries either use derived types or
+pointers of various types.
+
+The standard way to handle this in Perl is to use a C<typemap> file.
+This is discussed in some detail in L<perlxs|perlxs> in the standard
+Perl documentation. In PP the functionality is very similar, so you can
+create a C<typemap> file in the directory where your PP file resides and
+when it is built it is automatically read in to figure out the appropriate
+translation between the C type and Perl's built-in type.
+
+That said, there are a couple of important differences from the general
+handling of types in XS. The first, and probably most important, is that
+at the moment pointers to types are not allowed in the C<OtherPars>
+section. To get around this limitation you must use the C<IV> type
+(thanks to Judd Taylor for pointing out that this is necessary for
+portability).
+
+It is probably best to illustrate this with a couple of code-snippets:
+
+For instance the C<gsl_spline_init> function has the following C
+declaration:
+
+ int gsl_spline_init(gsl_spline * spline,
+ const double xa[], const double ya[], size_t size);
+
+Clearly the C<xa> and C<ya> arrays are candidates for being passed
+in as piddles and the C<size> argument is just the length of these
+piddles so that can be handled by the C<$SIZE()> macro in PP. The
+problem is the pointer to the C<gsl_spline> type. The natural solution
+would be to write an C<OtherPars> declaration of the form
+
+ OtherPars => 'gsl_spline *spl'
+
+and write a short C<typemap> file which handled this type. This does
+not work at present however! So what you have to do is to go around
+the problem slightly (and in some ways this is easier too!):
+
+
+The solution is to declare C<spline> in the C<OtherPars> section using
+an "Integer Value", C<IV>. This hides the nature of the variable from
+PP and you then need to (well to avoid compiler warnings at least!)
+perform a type cast when you use the variable in your code. Thus
+C<OtherPars> should take the form:
+
+ OtherPars => 'IV spl'
+
+and when you use it in the code you will write
+
+ INT2PTR(gsl_spline *, $COMP(spl))
+
+where the Perl API macro C<INT2PTR> has been used to handle the pointer
+cast to avoid compiler warnings and problems for machines with mixed 32bit
+and 64bit Perl configurations. Putting this together as Andres Jordan has
+done (with the modification using C<IV> by Judd Taylor) in the
+C<gsl_interp.pd> in the distribution source you get:
+
+ pp_def('init_meat',
+ Pars => 'double x(n); double y(n);',
+ OtherPars => 'IV spl',
+ Code =>'
+ gsl_spline_init,( INT2PTR(gsl_spline *, $COMP(spl)), $P(x),$P(y),$SIZE(n)));'
+ );
+
+where I have removed a macro wrapper call, but that would obscure the
+discussion.
+
+The other minor difference as compared to the standard typemap handling
+in Perl, is that the user cannot specify non-standard typemap locations or
+typemap filenames using the C<TYPEMAPS> option in MakeMaker... Thus you
+can only use a file called C<typemap> and/or the C<IV> trick above.
+
+
+
+=head2 Other useful PP keys in data operation definitions
+
+You have already heard about the C<OtherPars> key. Currently, there are not
+many other keys for a data operation that will be useful in normal (whatever
+that is) PP programming. In fact, it would be interesting to hear about
+a case where you think you need more than what is provided at the moment.
+Please speak up on one of the PDL mailing lists. Most other keys recognised
+by C<pp_def> are only really useful for what we call I<slice operations>
+(see also above).
+
+One thing that is strongly being planned is variable number
+of arguments, which will be a little tricky.
+
+An incomplete list of the available keys:
+
+=over 4
+
+=item Inplace
+
+Setting this key marks the routine as working inplace - ie
+the input and output piddles are the same. An example is
+C<$a-E<gt>inplace-E<gt>sqrt()> (or C<sqrt(inplace($a))>).
+
+=over 4
+
+=item Inplace => 1
+
+Use when the routine is a unary function, such as C<sqrt>.
+
+=item Inplace => ['a']
+
+If there are more than one input piddles, specify the name
+of the one that can be changed inplace using an array reference.
+
+=item Inplace => ['a','b']
+
+If there are more than one output piddle, specify the name
+of the input piddle and output piddle in a 2-element array
+reference. This probably isn't needed, but left in for
+completeness.
+
+=back
+
+If bad values are being used, care must be taken to ensure the
+propagation of the badflag when inplace is being used;
+consider this excerpt from F<Basic/Bad/bad.pd>:
+
+ pp_def('replacebad',HandleBad => 1,
+ Pars => 'a(); [o]b();',
+ OtherPars => 'double newval',
+ Inplace => 1,
+ CopyBadStatusCode =>
+ '/* propogate badflag if inplace AND it has changed */
+ if ( a == b && $ISPDLSTATEBAD(a) )
+ PDL->propogate_badflag( b, 0 );
+
+ /* always make sure the output is "good" */
+ $SETPDLSTATEGOOD(b);
+ ',
+ ...
+
+Since this routine removes all bad values, then the output piddle had
+its bad flag cleared. If run inplace (so C<a == b>), then we have to
+tell all the children of C<a> that the bad flag has been cleared (to
+save time we make sure that we call C<PDL-E<gt>propogate_badgflag> only
+if the input piddle had its bad flag set).
+
+NOTE: one idea is that the documentation for the routine could be
+automatically flagged to indicate that it can be executed inplace,
+ie something similar to how C<HandleBad> sets C<BadDoc> if it's not
+supplied (it's not an ideal solution).
+
+=back
+
+=head2 Other PDL::PP functions to support concise package definition
+
+So far, we have described the C<pp_def> and C<pp_done> functions. PDL::PP
+exports a few other functions to aid you in writing concise PDL extension
+package definitions.
+
+=head3 pp_addhdr
+
+Often when you interface library functions as in the above example
+you have to include additional C include files. Since the XS file is
+generated by PP we need some means to make PP insert the appropriate
+include directives in the right place into the generated XS file.
+To this end there is the C<pp_addhdr> function. This is also the function
+to use when you want to define some C functions for internal use by some
+of the XS functions (which are mostly functions defined by C<pp_def>).
+By including these functions here you make sure that PDL::PP inserts your
+code before the point where the actual XS module section begins and will
+therefore be left untouched by xsubpp (cf. I<perlxs> and I<perlxstut>
+man pages).
+
+A typical call would be
+
+ pp_addhdr('
+ #include <unistd.h> /* we need defs of XXXX */
+ #include "libprotos.h" /* prototypes of library functions */
+ #include "mylocaldecs.h" /* Local decs */
+
+ static void do_the real_work(PDL_Byte * in, PDL_Byte * out, int n)
+ {
+ /* do some calculations with the data */
+ }
+ ');
+
+This ensures that all the constants and prototypes you need will be properly
+included and that you can use the internal functions defined here in the
+C<pp_def>s, e.g.:
+
+ pp_def('barfoo',
+ Pars => ' a(n); [o] b(n)',
+ GenericTypes => ['B'],
+ Code => ' int ns = $SIZE(n);
+ do_the_real_work($P(a),$P(b),ns);
+ ',
+ );
+
+=head3 pp_addpm
+
+In many cases the actual PP code (meaning the arguments to C<pp_def>
+calls) is only part of the package you are currently
+implementing. Often there is additional Perl code and XS code
+you would normally have written into the pm and XS files which are now
+automatically generated by PP. So how to get this stuff into those
+dynamically generated files? Fortunately, there are a couple of
+functions, generally called C<pp_addXXX> that assist you in doing
+this.
+
+Let's assume you have additional Perl code that should go into the
+generated B<pm>-file. This is easily achieved with the C<pp_addpm> command:
+
+ pp_addpm(<<'EOD');
+
+ =head1 NAME
+
+ PDL::Lib::Mylib -- a PDL interface to the Mylib library
+
+ =head1 DESCRIPTION
+
+ This package implements an interface to the Mylib package with full
+ threading and indexing support (see L<PDL::Indexing>).
+
+ =cut
+
+ use PGPLOT;
+
+ =head2 use_myfunc
+ this function applies the myfunc operation to all the
+ elements of the input pdl regardless of dimensions
+ and returns the sum of the result
+ =cut
+
+ sub use_myfunc {
+ my $pdl = shift;
+
+ myfunc($pdl->clump(-1),($res=null));
+
+ return $res->sum;
+ }
+
+ EOD
+
+=head3 pp_add_exported
+
+You have probably got the idea. In some cases you also want to export
+your additional functions. To avoid getting into trouble with PP which
+also messes around with the C<@EXPORT> array you just tell PP to add
+your functions to the list of exported functions:
+
+ pp_add_exported('use_myfunc gethynx');
+
+=head3 pp_add_isa
+
+The C<pp_add_isa> command works like the the C<pp_add_exported> function.
+The arguments to C<pp_add_isa> are added the @ISA list, e.g.
+
+ pp_add_isa(' Some::Other::Class ');
+
+=head3 pp_bless
+
+If your pp_def routines are to be used as object methods use
+C<pp_bless> to specify the package (i.e. class) to which
+your I<pp_def>ed methods will be added. For example,
+C<pp_bless('PDL::MyClass')>. The default is C<PDL> if this is
+omitted.
+
+=head3 pp_addxs
+
+Sometimes you want to add extra XS code of your own
+(that is generally not involved with any threading/indexing issues
+but supplies some other functionality you want to access from the Perl
+side) to the generated XS file, for example
+
+ pp_addxs('','
+
+ # Determine endianness of machine
+
+ int
+ isbigendian()
+ CODE:
+ unsigned short i;
+ PDL_Byte *b;
+
+ i = 42; b = (PDL_Byte*) (void*) &i;
+
+ if (*b == 42)
+ RETVAL = 0;
+ else if (*(b+1) == 42)
+ RETVAL = 1;
+ else
+ croak("Impossible - machine is neither big nor little endian!!\n");
+ OUTPUT:
+ RETVAL
+ ');
+
+Especially C<pp_add_exported> and C<pp_addxs> should be used with care. PP uses
+PDL::Exporter, hence letting PP export your function means that they get added
+to the standard list of function exported by default (the list defined by the
+export tag ``:Func''). If you use C<pp_addxs> you shouldn't try to do anything
+that involves threading or indexing directly. PP is much better at generating
+the appropriate code from your definitions.
+
+=head3 pp_add_boot
+
+Finally, you may want to add some code to the BOOT section of the XS file
+(if you don't know what that is check I<perlxs>). This is easily done
+with the C<pp_add_boot> command:
+
+ pp_add_boot(<<EOB);
+ descrip = mylib_initialize(KEEP_OPEN);
+
+ if (descrip == NULL)
+ croak("Can't initialize library");
+
+ GlobalStruc->descrip = descrip;
+ GlobalStruc->maxfiles = 200;
+ EOB
+
+=head3 pp_export_nothing
+
+By default, PP.pm puts all subs defined using the pp_def function into the output .pm
+file's EXPORT list. This can create problems if you are creating a subclassed
+object where you don't want any methods exported. (i.e. the methods will only
+be called using the $object->method syntax).
+
+For these cases you can call pp_export_nothing() to clear out the export list. Example (At
+the end of the .pd file):
+
+
+ pp_export_nothing();
+ pp_done();
+
+=head3 pp_core_importList
+
+By default, PP.pm puts the 'use Core;' line into the output .pm file. This imports Core's
+exported names into the current namespace, which can create
+problems if you are over-riding one of Core's methods in the current file.
+You end up getting messages like "Warning: sub sumover redefined in file
+subclass.pm" when running the program.
+
+For these cases the pp_core_importList can be used to change what is imported from Core.pm.
+For example:
+
+ pp_core_importList('()')
+
+This would result in
+
+ use Core();
+
+being generated in the output .pm file. This would result in no names being imported
+from Core.pm. Similarly, calling
+
+ pp_core_importList(' qw/ barf /')
+
+would result in
+
+ use Core qw/ barf/;
+
+being generated in the output .pm file. This would result in just 'barf'
+being imported from Core.pm.
+
+=head3 pp_setversion
+
+I am pretty sure that this allows you to simultaneously set the .pm and
+.xs files' versions, thus avoiding unnecessary version-skew between the
+two. To use this, simply have the following line at some point in your
+.pd file:
+
+ pp_setversion('0.0.3');
+
+However, don't use this if you use L<Module::Build::PDL>. See that
+module's documentation for details.
+
+=head3 pp_deprecate_module
+
+If a particular module is deemed obsolete, this function can be used to mark it
+as deprecated. This has the effect of emitting a warning when a user tries to
+C<use> the module. The generated POD for this module also carries a deprecation
+notice. The replacement module can be passed as an argument like this:
+
+ pp_deprecate_module( infavor => "PDL::NewNonDeprecatedModule" );
+
+Note that function affects I<only> the runtime warning and the POD.
+
+=head1 Making your PP function "private"
+
+Let's say that you have a function in your module called PDL::foo that
+uses the PP function C<bar_pp> to do the heavy lifting. But you don't
+want to advertise that C<bar_pp> exists. To do this, you must move your
+PP function to the top of your module file, then call
+
+ pp_export_nothing()
+
+to clear the C<EXPORT> list. To ensure that no documentation (even the
+default PP docs) is generated, set
+
+ Doc => undef
+
+and to prevent the function from being added to the symbol table, set
+
+ PMFunc => ''
+
+in your pp_def declaration (see Image2D.pd for an example). This will
+effectively make your PP function "private." However, it is I<always>
+accessible via PDL::bar_pp due to Perl's module design. But making
+it private will cause the user to go very far out of his or her way
+to use it, so he or she shoulders the consequences!
+
+=head1 Slice operation
+
+The slice operation section of this manual is provided using
+dataflow and lazy evaluation: when you need it, ask Tjl to write it.
+a delivery in a week from when I receive the email is 95% probable and
+two week delivery is 99% probable.
+
+And anyway, the slice operations require a much more intimate knowledge
+of PDL internals than the data operations. Furthermore, the complexity
+of the issues involved is considerably higher than that in the average
+data operation. If you would like to convince yourself of this fact
+take a look at the F<Basic/Slices/slices.pd> file in the PDL
+distribution :-). Nevertheless,
+functions generated using the slice operations are at the heart of the
+index manipulation and dataflow capabilities of PDL.
+
+Also, there are a lot of dirty issues with virtual piddles and
+vaffines which we shall entirely skip here.
+
+=head2 Slices and bad values
+
+Slice operations need to be able to handle bad values (if support
+is compiled into PDL). The easiest thing to do is look at
+F<Basic/Slices/slices.pd> to see how this works.
+
+Along with C<BadCode>, there are also the C<BadBackCode> and
+C<BadRedoDimsCode> keys for C<pp_def>. However, any
+C<EquivCPOffsCode> should I<not> need changing, since
+any changes are absorbed into the definition of the
+C<$EQUIVCPOFFS()> macro (i.e. it is handled automatically
+by PDL::PP>.
+
+=head2 A few notes on writing a slicing routine...
+
+The following few paragraphs describe writing of a new slicing routine
+('range'); any errors are CED's. (--CED 26-Aug-2002)
+
+=head1 Handling of C<warn> and C<barf> in PP Code
+
+For printing warning messages or aborting/dieing, you can call C<warn> or C<barf> from PP code.
+However, you should be aware that these calls have been redefined using C preprocessor
+macros to C<< PDL->barf >> and C<< PDL->warn >>. These redefinitions are in place to keep
+you from inadvertently calling perl's C<warn> or C<barf> directly, which can cause segfaults during
+pthreading (i.e. processor multi-threading).
+
+PDL's own versions of C<barf> and C<warn> will queue-up warning or barf messages until after pthreading
+is completed, and then call the perl versions of these routines.
+
+See L<PDL::ParallelCPU> for more information on pthreading.
+
+=head1 USEFUL ROUTINES
+
+The PDL C<Core> structure, defined in F<Basic/Core/pdlcore.h.PL>, contains
+pointers to a number of routines that may be useful to you. The majority
+of these routines deal with manipulating piddles, but some are more general:
+
+=over 4
+
+=item PDL->qsort_B( PDL_Byte *xx, int a, int b )
+
+Sort the array C<xx> between the indices C<a> and C<b>.
+There are also versions for the other PDL datatypes,
+with postfix C<_S>, C<_U>, C<_L>, C<_F>, and C<_D>.
+Any module using this must ensure that C<PDL::Ufunc>
+is loaded.
+
+=item PDL->qsort_ind_B( PDL_Byte *xx, int *ix, int a, int b )
+
+As for C<PDL-E<gt>qsort_B>, but this time sorting the indices
+rather than the data.
+
+=back
+
+The routine C<med2d> in F<Lib/Image2D/image2d.pd> shows how such routines are
+used.
+
+=head1 MAKEFILES FOR PP FILES
+
+If you are going to generate a package from your PP file (typical file
+extensions are C<.pd> or C<.pp> for the files containing PP code) it
+is easiest and safest to leave generation of the appropriate commands
+to the Makefile. In the following we will outline the typical format
+of a Perl Makefile to automatically build and install your package
+from a description in a PP file. Most of the rules to build the xs, pm
+and other required files from the PP file are already predefined in
+the PDL::Core::Dev package. We just have to tell MakeMaker to use
+it.
+
+In most cases you can define your Makefile like
+
+ # Makefile.PL for a package defined by PP code.
+
+ use PDL::Core::Dev; # Pick up development utilities
+ use ExtUtils::MakeMaker;
+
+ $package = ["mylib.pd",Mylib,PDL::Lib::Mylib];
+ %hash = pdlpp_stdargs($package);
+ $hash{OBJECT} .= ' additional_Ccode$(OBJ_EXT) ';
+ $hash{clean}->{FILES} .= ' todelete_Ccode$(OBJ_EXT) ';
+ $hash{'VERSION_FROM'} = 'mylib.pd';
+ WriteMakefile(%hash);
+
+ sub MY::postamble { pdlpp_postamble($package); }
+
+Here, the list in $package is: first: PP source file name,
+then the prefix for the produced files and finally the whole package name.
+You can modify the hash in whatever way you like but it would be reasonable
+to stay within some limits so that your package will continue to work
+with later versions of PDL.
+
+If you don't want to use prepackaged arguments,
+here is a generic F<Makefile.PL> that you can adapt for your own
+needs:
+
+ # Makefile.PL for a package defined by PP code.
+
+ use PDL::Core::Dev; # Pick up development utilities
+ use ExtUtils::MakeMaker;
+
+ WriteMakefile(
+ 'NAME' => 'PDL::Lib::Mylib',
+ 'VERSION_FROM' => 'mylib.pd',
+ 'TYPEMAPS' => [&PDL_TYPEMAP()],
+ 'OBJECT' => 'mylib$(OBJ_EXT) additional_Ccode$(OBJ_EXT)',
+ 'PM' => { 'Mylib.pm' => '$(INST_LIBDIR)/Mylib.pm'},
+ 'INC' => &PDL_INCLUDE(), # add include dirs as required by your lib
+ 'LIBS' => [''], # add link directives as necessary
+ 'clean' => {'FILES' =>
+ 'Mylib.pm Mylib.xs Mylib$(OBJ_EXT)
+ additional_Ccode$(OBJ_EXT)'},
+ );
+
+ # Add genpp rule; this will invoke PDL::PP on our PP file
+ # the argument is an array reference where the array has three string elements:
+ # arg1: name of the source file that contains the PP code
+ # arg2: basename of the xs and pm files to be generated
+ # arg3: name of the package that is to be generated
+ sub MY::postamble { pdlpp_postamble(["mylib.pd",Mylib,PDL::Lib::Mylib]); }
+
+To make life even easier PDL::Core::Dev defines the function C<pdlpp_stdargs>
+that returns a hash with default values that can be passed (either
+directly or after appropriate modification) to a call to WriteMakefile.
+Currently, C<pdlpp_stdargs> returns a hash where the keys are filled in
+as follows:
+
+ (
+ 'NAME' => $mod,
+ 'TYPEMAPS' => [&PDL_TYPEMAP()],
+ 'OBJECT' => "$pref\$(OBJ_EXT)",
+ PM => {"$pref.pm" => "\$(INST_LIBDIR)/$pref.pm"},
+ MAN3PODS => {"$src" => "\$(INST_MAN3DIR)/$mod.\$(MAN3EXT)"},
+ 'INC' => &PDL_INCLUDE(),
+ 'LIBS' => [''],
+ 'clean' => {'FILES' => "$pref.xs $pref.pm $pref\$(OBJ_EXT)"},
+ )
+
+Here, C<$src> is the name of the source file with PP code, C<$pref> the
+prefix for the generated .pm and .xs files and C<$mod> the name of the
+extension module to generate.
+
+=head1 INTERNALS
+
+The internals of the current version consist of a large
+table which gives the rules according to which things are translated
+and the subs which implement these rules.
+
+Later on, it would be good to make the table modifiable by the user
+so that different things may be tried.
+
+[Meta comment: here will hopefully be more in the future; currently,
+your best bet will be to read the source code :-( or ask on the list
+(try the latter first) ]
+
+=head1 Appendix A: Some keys recognised by PDL::PP
+
+Unless otherwise specified, the arguments are strings. Keys marked with
+(bad) are only used if bad-value support is compiled into PDL.
+
+=over 4
+
+=item Pars
+
+define the signature of your function
+
+=item OtherPars
+
+arguments which are not pdls. Default: nothing. This is a semi-colon
+separated list of arguments, e.g.,
+C<< OtherPars=>'int k; double value; char* fd' >>. See C<$COMP(x)> and
+also the same entry in L<Appendix B|/Appendix B: PP macros and functions>.
+
+=item Code
+
+the actual code that implements the functionality; several PP macros and
+PP functions are recognised in the string value
+
+=item HandleBad (bad)
+
+If set to 1, the routine is assumed to support bad values and the code in
+the BadCode key is used if bad values are present;
+it also sets things up so that the C<$ISBAD()> etc macros can be used.
+If set to 0, cause the routine to print a warning if any of the input piddles
+have their bad flag set.
+
+=item BadCode (bad)
+
+Give the code to be used if bad values may be present in the input piddles.
+Only used if C<HandleBad =E<gt> 1>.
+
+=item GenericTypes
+
+An array reference. The array may contain any subset of the one-character
+strings `B', `S', `U', `L', `Q', `F' and `D', which specify which types
+your operation will accept. The meaning of each type is:
+
+ B - signed byte (i.e. signed char)
+ S - signed short (two-byte integer)
+ U - unsigned short
+ L - signed long (four-byte integer, int on 32 bit systems)
+ Q - signed long long (eight byte integer)
+ F - float
+ D - double
+
+This is very useful (and important!) when interfacing an external library.
+Default: [qw/B S U L Q F D/]
+
+=item Inplace
+
+Mark a function as being able to work inplace.
+
+ Inplace => 1 if Pars => 'a(); [o]b();'
+ Inplace => ['a'] if Pars => 'a(); b(); [o]c();'
+ Inplace => ['a','b'] if Pars => 'a(); b(); [o]c(); [o]d();'
+
+If bad values are being used, care must be taken to ensure the
+propagation of the badflag when inplace is being used;
+for instance see the code for C<replacebad> in F<Basic/Bad/bad.pd>.
+
+=item Doc
+
+Used to specify a documentation string in Pod format. See PDL::Doc
+for information on PDL documentation conventions. Note: in
+the special case where the PP 'Doc' string is one line this is
+implicitly used for the quick reference AND the documentation!
+
+If the Doc field is omitted PP will generate default documentation
+(after all it knows about the Signature).
+
+If you really want the function NOT to be documented in any way at this point
+(e.g. for an internal routine, or because you are doing it elsewhere in the
+code) explicitly specify C<Doc=E<gt>undef>.
+
+=item BadDoc (bad)
+
+Contains the text returned by the C<badinfo> command (in C<perldl>) or
+the C<-b> switch to the C<pdldoc> shell script. In many cases, you will
+not need to specify this, since the information can be automatically
+created by PDL::PP. However, as befits computer-generated text, it's
+rather stilted; it may be much better to do it yourself!
+
+=item NoPthread
+
+Optional flag to indicate the PDL function should B<not> use processor threads (i.e.
+pthreads or POSIX threads) to split up work across mutliple CPU cores. This option
+is typically set to 1 if the underlying PDL function is not threadsafe. If this option
+isn't present, then the function is assumed to be threadsafe. This option only
+applies if PDL has been compiled with POSIX threads enabled.
+
+=cut
+
+# FTypes is specified only in the two internal slice functions
+# converttypei and flowconvert. converttypei is never used anywhere in the
+# core. The related function, converttypei_new, does not appear to ever be
+# defined, but it is named used in converttypei as the GlobalNew, which I
+# presume we'll get to later. At any rate, converttypei appears to be
+# defunct. flowconvert, on the other hand, claims that it 'converts vaffine
+# piddles without physicalizing them'. However, its only use, in Core.pm,
+# is followed immediately by a "->make_physical->sever", so I don't see the
+# advantage of not making things physical. At any rate, FTypes needs to be
+# documented.
+
+=item PMCode
+
+PDL functions allow you to pass in a piddle into which you want the output
+saved. This is handy because you can allocate an output piddle once and
+reuse it many times; the alternative would be for PDL to create a new piddle
+each time, which may waste compute cycles or, more likely, RAM. This added
+flexibility comes at the cost of more complexity: PDL::PP has to write
+functions that are smart enough to count the arguments passed to it and
+create new piddles on the fly, but only if you want them.
+
+PDL::PP is smart enough to do that, but there are restrictions on argument
+order and the like. If you want a more flexible function, you can write your
+own Perl-side wrapper and specify it in the PMCode key. The string that you
+supply must (should) define a Perl function with a name that matches what you
+gave to pp_def in the first place. When you wish to eventually invoke the
+PP-generated function, you will need to supply all piddles in the exact
+order specified in the signature: output piddles are not optional, and the
+PP-generated function will not return anything. The obfuscated name that you
+will call is _<funcname>_int.
+
+I believe this documentation needs further clarification, but this will have
+to do. :-(
+
+=item PMFunc
+
+When pp_def generates functions, it typically defines them in the PDL
+package. Then, in the .pm file that it generates for your module, it
+typically adds a line that essentially copies that function into your current
+package's symbol table with code that looks like this:
+
+ *func_name = \&PDL::func_name;
+
+It's a little bit smarter than that (it knows when to wrap that sort of
+thing in a BEGIN block, for example, and if you specified something different
+for pp_bless), but that's the gist of it. If you don't care to import the
+function into your current package's symbol table, you can specify
+
+ PMFunc => '',
+
+PMFunc has no other side-effects, so you could use it to insert arbitrary
+Perl code into your module if you like. However, you should use pp_addpm
+if you want to add Perl code to your module.
+
+=back
+
+=head1 Appendix B: PP macros and functions
+
+=head2 Macros
+
+Macros labeled by (bad) are only used if bad-value support is compiled into
+PDL.
+
+=over 7
+
+=item $I<variablename_from_sig>()
+
+access a pdl (by its name) that was specified in the signature
+
+=item $COMP(x)
+
+access a value in the private data structure of this transformation (mainly
+used to use an argument that is specified in the C<OtherPars> section)
+
+=item $SIZE(n)
+
+replaced at runtime by the actual size of a I<named> dimension (as specified
+in the I<signature>)
+
+=item $GENERIC()
+
+replaced by the C type that is equal to the runtime type of the operation
+
+=item $P(a)
+
+a pointer access to the PDL named C<a> in the signature. Useful for
+interfacing to C functions
+
+=item $PP(a)
+
+a physical pointer access to pdl C<a>; mainly for internal use
+
+=item $TXXX(Alternative,Alternative)
+
+expansion alternatives according to runtime type of operation,
+where XXX is some string that is matched by C</[BSULFD+]/>.
+
+=item $PDL(a)
+
+return a pointer to the pdl data structure (pdl *) of piddle C<a>
+
+=item $ISBAD(a()) (bad)
+
+returns true if the value stored in C<a()> equals the bad value
+for this piddle.
+Requires C<HandleBad> being set to 1.
+
+=item $ISGOOD(a()) (bad)
+
+returns true if the value stored in C<a()> does not equal the bad value
+for this piddle.
+Requires C<HandleBad> being set to 1.
+
+=item $SETBAD(a()) (bad)
+
+Sets C<a()> to equal the bad value for this piddle.
+Requires C<HandleBad> being set to 1.
+
+=back
+
+=head2 functions
+
+=over 3
+
+=item C<loop(DIMS) %{ ... %}>
+
+loop over named dimensions; limits are generated automatically by PP
+
+=item C<threadloop %{ ... %}>
+
+enclose following code in a thread loop
+
+=item C<types(TYPES) %{ ... %}>
+
+execute following code if type of operation is any of C<TYPES>
+
+=back
+
+=head1 Appendix C: Functions imported by PDL::PP
+
+A number of functions are imported when you C<use PDL::PP>. These include
+functions that control the generated C or XS code, functions that control
+the generated Perl code, and functions that manipulate the packages and
+symbol tables into which the code is created.
+
+=head2 Generating C and XS Code
+
+PDL::PP's main purpose is to make it easy for you to wrap the threading
+engine around your own C code, but you can do some other things, too.
+
+=over
+
+=item pp_def
+
+Used to wrap the threading engine around your C code. Virtually all of this
+document discusses the use of pp_def.
+
+=item pp_done
+
+Indicates you are done with PDL::PP and that it should generate its .xs
+and .pm files based upon the other pp_* functions that you have called.
+This function takes no arguments.
+
+=item pp_addxs
+
+This lets you add XS code to your .xs file. This is useful if you want to
+create Perl-accessible functions that invoke C code but cannot or should not
+invoke the threading engine. XS is the standard means by which you wrap
+Perl-accessible C code. You can learn more at L<perlxs>.
+
+=item pp_add_boot
+
+This function adds whatever string you pass to the XS BOOT section. The BOOT
+section is C code that gets called by Perl when your module is loaded and is
+useful for automatic initialization. You can learn more about XS and the BOOT
+section at L<perlxs>.
+
+=item pp_addhdr
+
+Adds pure-C code to your XS file. XS files are structured such that pure C
+code must come before XS specifications. This allows you to specify such
+C code.
+
+=item pp_boundscheck
+
+PDL normally checks the bounds of your accesses before making them. You can
+turn that on or off at runtime by setting MyPackage::set_boundscheck. This
+function allows you to remove that runtime flexibility and B<never> do bounds
+checking. It also returns the current boundschecking status if called
+without any argumens.
+
+NOTE: I have not found anything about bounds checking in other documentation.
+That needs to be addressed.
+
+=back
+
+=head2 Generating Perl Code
+
+Many functions imported when you use PDL::PP allow you to modify the
+contents of the generated .pm file. In addition to pp_def and pp_done,
+the role of these functions is primarily to add code to various parts of
+your generated .pm file.
+
+=over
+
+=item pp_addpm
+
+Adds Perl code to the generated .pm file. PDL::PP actually keeps track of
+three different sections of generated code: the Top, the Middle, and the
+Bottom. You can add Perl code to the Middle section using the one-argument
+form, where the argument is the Perl code you want to supply. In the
+two-argument form, the first argument is an anonymous hash with only
+one key that specifies where to put the second argument, which is the string
+that you want to add to the .pm file. The hash is one of these three:
+
+ {At => 'Top'}
+ {At => 'Middle'}
+ {At => 'Bot'}
+
+For example:
+
+ pp_addpm({At => 'Bot'}, <<POD);
+
+ =head1 Some documentation
+
+ I know I'm typing this in the middle of my file, but it'll go at
+ the bottom.
+
+ =cut
+
+ POD
+
+Warning: If, in the middle of your .pd file, you put documentation meant for
+the bottom of your pod, you will thoroughly confuse CPAN. On the other hand,
+if in the middle of your .pd fil, you add some Perl code destined for the
+bottom or top of your .pm file, you only have yourself to confuse. :-)
+
+=item pp_beginwrap
+
+Adds BEGIN-block wrapping. Certain declarations can be wrapped in BEGIN
+blocks, though the default behavior is to have no such wrapping.
+
+=item pp_addbegin
+
+Sets code to be added to the top of your .pm file, even above code that you
+specify with C<< pp_addpm({At => 'Top'}, ...) >>. Unlike pp_addpm, calling
+this overwrites whatever was there before. Generally, you probably shouldn't
+use it.
+
+=back
+
+=head2 Tracking Line Numbers
+
+When you get compile errors, either from your C-like code or your Perl
+code, it can help to make those errors back to the line numbers in the source
+file at which the error occurred.
+
+=over
+
+=item pp_line_numbers
+
+Takes a line number and a (usually long) string of code. The line number
+should indicate the line at which the quote begins. This is usually Perl's
+C<__LINE__> literal, unless you are using heredocs, in which case it is
+C<__LINE__ + 1>. The returned string has #line directives interspersed to
+help the compiler report errors on the proper line.
+
+=back
+
+=head2 Modifying the Symbol Table and Export Behavior
+
+PDL::PP usually exports all functions generated using pp_def, and usually
+installs them into the PDL symbol table. However, you can modify this
+behavior with these functions.
+
+=over
+
+=item pp_bless
+
+Sets the package (symbol table) to which the XS code is added. The default
+is PDL, which is generally what you want. If you use the default blessing
+and you create a function myfunc, then you can do the following:
+
+ $piddle->myfunc(<args>);
+ PDL::myfunc($piddle, <args>);
+
+On the other hand, if you bless your functions into another package, you
+cannot invoke them as PDL methods, and must invoke them as:
+
+ MyPackage::myfunc($piddle, <args>);
+
+Of course, you could always use the PMFunc key to add your function to the
+PDL symbol table, but why do that?
+
+=item pp_add_isa
+
+Adds to the list of modules from which your B<module> inherits. The default
+list is
+
+ qw(PDL::Exporter DynaLoader)
+
+=item pp_core_importlist
+
+At the top of your generated .pm file is a line that looks like this:
+
+ use PDL::Core;
+
+You can modify that by specifying a string to pp_core_importlist. For
+example,
+
+ pp_core_importlist('::Blarg');
+
+will result in
+
+ use PDL::Core::Blarg;
+
+You can use this, for example, to add a list of symbols to import from
+PDL::Core. For example:
+
+ pp_core_importlist(" ':Internal'");
+
+will lead to the following use statement:
+
+ use PDL::Core ':Internal';
+
+=item pp_setversion
+
+Sets your module's version. The version must be consistent between the .xs
+and the .pm file, and is used to ensure that your Perl's libraries do not
+suffer from version skew.
+
+=item pp_add_exported
+
+Adds to the export list whatever names you give it. Functions created using
+pp_def are automatically added to the list. This function is useful if you
+define any Perl functions using pp_addpm or pp_addxs that you want exported
+as well.
+
+=item pp_export_nothing
+
+This resets the list of exported symbols to nothing. This is probably better
+called C<pp_export_clear>, since you can add exported symbols after calling
+C<pp_export_nothing>. When called just before calling pp_done, this ensures
+that your module does not export anything, for example, if you only want
+programmers to use your functions as methods.
+
+=back
+
+=head1 SEE ALSO
+
+I<PDL>
+
+For the concepts of threading and slicing check L<PDL::Indexing>.
+
+L<PDL::Internals>
+
+L<PDL::BadValues> for information on bad values
+
+I<perlxs>, I<perlxstut>
+
+=head1 CURRENTLY UNDOCUMENTED
+
+$RESIZE()
+
+=head1 BUGS
+
+Although PDL::PP is quite flexible and thoroughly used, there are surely
+bugs. First amonth them: this documentation needs a thorough revision.
+
+=head1 AUTHOR
+
+Copyright(C) 1997 Tuomas J. Lukka (lukka at fas.harvard.edu), Karl
+Glaazebrook (kgb at aaocbn1.aao.GOV.AU) and Christian Soeller
+(c.soeller at auckland.ac.nz). All rights reserved.
+Documentation updates Copyright(C) 2011 David Mertens
+(dcmertens.perl at gmail.com). This documentation is licensed under the same
+terms as Perl itself.
+
diff --git a/Basic/Pod/ParallelCPU.pod b/Basic/Pod/ParallelCPU.pod
new file mode 100644
index 0000000..f83b7c4
--- /dev/null
+++ b/Basic/Pod/ParallelCPU.pod
@@ -0,0 +1,157 @@
+=head1 NAME
+
+PDL::ParallelCPU - Parallel Processor MultiThreading Support in PDL (Experimental)
+
+
+=head1 DESCRIPTION
+
+PDL has support (currently experimental) for splitting up numerical processing
+between multiple parallel processor threads (or pthreads) using the I<set_autopthread_targ>
+and I<set_autopthread_size> functions.
+This can improve processing performance (by greater than 2-4X in most cases)
+by taking advantage of multi-core and/or multi-processor machines.
+
+=head1 SYNOPSIS
+
+ use PDL;
+
+ # Set target of 4 parallel pthreads to create, with a lower limit of
+ # 5Meg elements for splitting processing into parallel pthreads.
+ set_autopthread_targ(4);
+ set_autopthread_size(5);
+
+ $a = zeroes(5000,5000); # Create 25Meg element array
+
+ $b = $a + 5; # Processing will be split up into multiple pthreads
+
+ # Get the actual number of pthreads for the last
+ # processing operation.
+ $actualPthreads = get_autopthread_actual();
+
+
+=head1 Terminology
+
+The use of the term I<threading> can be confusing with PDL, because it can refer to I<PDL threading>,
+as defined in the L<PDL::Threading> docs, or to I<processor multi-threading>.
+
+To reduce confusion with the existing PDL threading terminology, this document uses
+B<pthreading> to refer to I<processor multi-threading>, which is the use of multiple processor threads
+to split up numerical processing into parallel operations.
+
+=head1 Functions that control PDL PThreads
+
+This is a brief listing and description of the PDL pthreading functions, see the L<PDL::Core> docs
+for detailed information.
+
+=over 5
+
+=item set_autopthread_targ
+
+Set the target number of processor-threads (pthreads) for multi-threaded processing. Setting auto_pthread_targ
+to 0 means that no pthreading will occur.
+
+See L<PDL::Core|set_autopthread_targ> for details.
+
+=item set_autopthread_size
+
+Set the minimum size (in Meg-elements or 2**20 elements) of the largest PDL involved in a function where auto-pthreading will
+be performed. For small PDLs, it probably isn't worth starting multiple pthreads, so this function
+is used to define a minimum threshold where auto-pthreading won't be attempted.
+
+See L<PDL::Core|set_autopthread_size> for details.
+
+=item get_autopthread_actual
+
+Get the actual number of pthreads executed for the last pdl processing function.
+
+See L<PDL::get_autopthread_actual> for details.
+
+=back
+
+=head1 Global Control of PDL PThreading using Environment Variables
+
+PDL PThreading can be globally turned on, without modifying existing code by setting
+environment variables B<PDL_AUTOPTHREAD_TARG> and B<PDL_AUTOPTHREAD_SIZE> before running a PDL script.
+These environment variables are checked when PDL starts up and calls to I<set_autopthread_targ> and
+I<set_autopthread_size> functions made with the environment variable's values.
+
+For example, if the environment var B<PDL_AUTOPTHREAD_TARG> is set to 3, and B<PDL_AUTOPTHREAD_SIZE> is
+set to 10, then any pdl script will run as if the following lines were at the top of the file:
+
+ set_autopthread_targ(3);
+ set_autopthread_size(10);
+
+=head1 How It Works
+
+The auto-pthreading process works by analyzing threaded array dimensions in PDL operations
+and splitting up processing based on the thread dimension sizes and desired number of
+pthreads (i.e. the pthread target or pthread_targ). The offsets and increments that PDL uses to step
+thru the data in memory are modified for each pthread so each one sees a different set of data when
+performing processing.
+
+B<Example>
+
+ $a = sequence(20,4,3); # Small 3-D Array, size 20,4,3
+
+ # Setup auto-pthreading:
+ set_autopthread_targ(2); # Target of 2 pthreads
+ set_autopthread_size(0); # Zero so that the small PDLs in this example will be pthreaded
+
+ # This will be split up into 2 pthreads
+ $c = maximum($a);
+
+For the above example, the I<maximum> function has a signature of C<(a(n); [o]c())>, which means that the first
+dimension of $a (size 20) is a I<Core> dimension of the I<maximum> function. The other dimensions of $a (size 4,3)
+are I<threaded> dimensions (i.e. will be threaded-over in the I<maximum> function.
+
+The auto-pthreading algorithm examines the threaded dims of size (4,3) and picks the 4 dimension,
+since it is evenly divisible by the autopthread_targ of 2. The processing of the maximum function is then
+split into two pthreads on the size-4 dimension, with dim indexes 0,2 processed by one pthread
+ and dim indexes 1,3 processed by the other pthread.
+
+
+=head1 Limitations
+
+=head2 Must have POSIX Threads Enabled
+
+Auto-PThreading only works if your PDL installation was compiled with POSIX threads enabled. This is normally
+the case if you are running on linux, or other unix variants.
+
+=head2 Non-Threadsafe Code
+
+Not all the libraries that PDL intefaces to are thread-safe, i.e. they aren't written to operate
+in a multi-threaded environment without crashing or causing side-effects. Some examples in the PDL
+core is the I<fft> function and the I<pnmout> functions.
+
+To operate properly with these types of functions, the PPCode flag B<NoPthread> has been introduced to indicate
+a function as I<not> being pthread-safe. See L<PDL::PP> docs for details.
+
+=head2 Size of PDL Dimensions and PThread Target
+
+Due to the way a PDL is split-up for operation using multiple pthreads, the size of a dimension
+must be evenly divisible by the pthread target. For example, if a PDL has threaded dimension sizes
+of (4,3,3) and the I<auto_pthread_targ> has been set to 2, then the first threaded dimension (size 4) will
+be picked to be split up into two pthreads of size 2 and 2. However, if the threaded dimension sizes are
+(3,3,3) and the I<auto_pthread_targ> is still 2, then pthreading won't occur, because no threaded dimensions
+are divisible by 2.
+
+The algorithm that picks the actual number of pthreads has some smarts (but could probably be improved)
+to adjust down from the I<auto_pthread_targ> to get a number of pthreads that can evenly divide one of the
+threaded dimensions. For example, if a PDL has threaded dimension sizes of (9,2,2) and the
+I<auto_pthread_targ> is 4, the algorithm will see that no dimension is divisible by 4, then adjust
+down the target to 3, resulting in splitting up the first threaded dimension (size 9) into 3 pthreads.
+
+=head2 Speed improvement might be less than you expect.
+
+If you have a 8 core machine and call I<auto_pthread_targ> with 8 to generate 8 parallel pthreads, you
+probably won't get a 8X improvement in speed, due to memory bandwidth issues. Even though you have 8 separate
+CPUs crunching away on data, you will have (for most common machine architectures) common RAM that now becomes
+your bottleneck. For simple calculations (e.g simple additions) you can run into a performance limit at about
+ 4 pthreads. For more complex calculations the limit will be higher.
+
+=head1 COPYRIGHT
+
+Copyright 2011 John Cerney. You can distribute and/or
+modify this document under the same terms as the current Perl license.
+
+See: http://dev.perl.org/licenses/
diff --git a/Basic/Pod/Philosophy.pod b/Basic/Pod/Philosophy.pod
new file mode 100644
index 0000000..ef64e0c
--- /dev/null
+++ b/Basic/Pod/Philosophy.pod
@@ -0,0 +1,148 @@
+=head1 NAME
+
+PDL::Philosophy -- Why did we write PDL?
+
+=head1 DESCRIPTION
+
+Some history from the creator of PDL, leading into the philosophy and
+motivation behind this data language. This is an attempt to summarize
+some of the common spirit between pdl developers in order to answer the
+question "Why PDL"?
+
+=head2 The Start of PDL
+
+B<"Why is it that we entertain the belief that for every purpose odd numbers are the most effectual?"> - I<Pliny the Elder>
+
+The PDL project began in February 1996, when I decided to experiment
+with writing my own `Data Language'. I am an astronomer. My day job
+involves a lot of analysis of digital data accumulated on many nights
+observing on telescopes around the world. Such data might for example be
+images containing millions of pixels and thousands of images of distant
+stars and galaxies. Or more abstrusely, many hundreds of digital
+spectra revealing the secrets of the composition and properties of
+these distant objects.
+
+Obviously many astronomers have dealt with these problems before, and a
+large amount of software has been constructed to facilitate their
+analysis. However, like many of my colleagues, I was constantly
+frustrated by the lack of generality and flexibility of these programs
+and the difficulty of doing anything out of the ordinary quickly and
+easily. What I wanted had a name: "Data Language", i.e. a language which
+allowed the manipulation of large amounts of data with simple arithmetic
+expressions. In fact some commercial software worked like this, and I
+was impressed with the capabilities but not with the price tag. And I
+thought I could do better.
+
+As a fairly computer literate astronomer (read "nerd" or "geek"
+according to your local argot) I was very familiar with "Perl", a
+computer language which now seems to fill the shelves of many bookstores
+around the world. I was impressed by its power and flexibility, and
+especially its ease of use. I had even explored the depths of its
+internals and written an interface to allow graphics, the ease with
+which I could then create charts and graphs, for my papers, was
+refreshing.
+
+Version 5 of Perl had just been released, and I was fascinated by the
+new features available. Especially the support of arbitrary data
+structures (or "objects" in modern parlance) and the ability to
+"overload" operators - i.e. make mathematical symbols like C<+-*/>
+do whatever you felt like. It seemed to me it ought to be possible to
+write an extension to Perl where I could play with my data in a general
+way: for example using the maths operators manipulate whole images at
+once.
+
+Well one slow night at an observatory I just thought I would try a
+little experiment. In a bored moment I fired up a text editor and
+started to create a file called `PDL.xs' - a Perl extension module to
+manipulate data vectors. A few hours later I actually had something half
+decent working, where I could add two images in the Perl language,
+B<fast!> This was something I could not let rest, and it probably cost me
+one or two scientific papers worth of productivity. A few weeks later
+the Perl Data Language version 1.0 was born. It was a pretty bare
+infant: very little was there apart from the basic arithmetic operators.
+But encouraged I made it available on the Internet to see what people
+thought.
+
+Well people were fairly critical - among the most vocal were Tuomas
+Lukka and Christian Soeller. Unfortunately for them they were both Perl
+enthusiasts too and soon found themselves improving my code to implement
+all the features they thought PDL ought to have and I had heinously
+neglected. PDL is a prime example of that modern phenomenon of authoring
+large free software packages via the Internet. Large numbers of people,
+most of whom have never met, have made contributions ranging for core
+functionality to large modules to the smallest of bug patches. PDL
+version 2.0 is now here (though it should perhaps have been called
+version 10 to reflect the amount of growth in size and functionality)
+and the phenomenon continues. I firmly believe that PDL is a great tool
+for tackling general problems of data analysis. It is powerful, fast,
+easy to add too and freely available to anyone. I wish I had had it
+when I was a graduate student! I hope you too will find it of immense
+value, I hope it will save you from heaps of time and frustration in
+solving complex problems. Of course it can't do everything, but it
+provides the framework, the hammers and the nails for building solutions
+without having to reinvent wheels or levers.
+
+--- Karl Glazebook, the creator of PDL
+
+=head2 Major ideas
+
+The first tenet of our philosophy is the "free software" idea: software
+being free has several advantages (less bugs because more people see the
+code, you can have the source and port it to your own working
+environment with you, ... and of course, that you don't need to pay
+anything).
+
+The second idea is a pet peeve of many: many languages like Matlab are
+pretty well suited for their specific tasks but for a different
+application, you need to change to an entirely different tool and regear
+yourself mentally. Not to speak about doing an application that does two
+things at once... Because we use Perl, we have the power and ease of
+Perl syntax, regular expressions, hash tables, etc. at our fingertips at
+all times. By extending an existing language, we start from a much
+healthier base than languages like Matlab which have grown into
+existence from a very small functionality at first and expanded little
+by little, making things look badly planned. We stand by the Perl
+sayings: "simple things should be simple but complicated things should
+be possible" and "There is more than one way to do it" (TIMTOWTDI).
+
+The third idea is interoperability: we want to be able to use PDL to
+drive as many tools as possible, we can connect to OpenGL or Mesa for
+graphics or whatever. There isn't anything out there that's really
+satisfactory as a tool and can do everything we want easily. And be
+portable.
+
+The fourth idea is related to C<PDL::PP> and is Tuomas's personal favorite:
+code should only specify as little as possible redundant info. If you
+find yourself writing very similar-looking code much of the time, all
+that code could probably be generated by a simple Perl script. The PDL C
+preprocessor takes this to an extreme.
+
+=head2 Minor goals and purposes
+
+We want speed. Optimally, it should ultimately (e.g. with the Perl
+compiler) be possible to compile C<PDL::PP> subs to C and obtain the top
+vectorized speeds on supercomputers. Also, we want to be able to
+calculate things at near top speed from inside Perl, by using dataflow
+to avoid memory allocation and deallocation (the overhead should
+ultimately be only a little over one indirect function call plus couple
+of ifs per function in the pipe).
+
+=head2 Go on, try it!
+
+Well, that's the philosophy behind PDL - speed, conciseness, free,
+expandable, and integrated with the wide base of modules and libraries
+that Perl provides. Feel free to download it, install it, run through
+some of the tutorials and introductions and have a play with it.
+
+Enjoy!
+
+=head1 AUTHOR
+
+Added Karl Glazebrook (2001) contributions by Matthew Kenworthy
+
+Copyright(C) 1997 Tuomas J. Lukka (lukka at fas.harvard.edu).
+
+Redistribution in the same form is allowed but reprinting requires
+a permission from the author.
+
+
diff --git a/Basic/Pod/QuickStart.pod b/Basic/Pod/QuickStart.pod
new file mode 100644
index 0000000..b7cf131
--- /dev/null
+++ b/Basic/Pod/QuickStart.pod
@@ -0,0 +1,615 @@
+
+=head1 NAME
+
+PDL::QuickStart - Quick introduction to PDL features.
+
+=head1 SYNOPSIS
+
+A brief summary of the main PDL features and how to use them.
+
+=head1 DESCRIPTION
+
+=head2 Introduction
+
+Perl is an extremely good and versatile scripting language, well suited to
+beginners and allows rapid prototyping. However until recently it did not
+support data structures which allowed it to do fast number crunching.
+
+However with the development of Perl v5, Perl acquired 'Objects'. To put
+it simply users can define their own special data types, and write
+custom routines to manipulate them either in low level languages (C and
+Fortran) or in Perl itself.
+
+This has been fully exploited by the PerlDL developers. The 'PDL' module is a
+complete Object-Oriented extension to Perl (although you don't have to know
+what an object is to use it) which allows large N-dimensional data sets, such
+as large images, spectra, time series, etc to be stored B<efficiently> and
+manipulated B<en masse>. For example with the PDL module we can write the
+Perl code C<$a = $b + $c>, where C<$b> and C<$c> are large datasets
+(e.g. 2048x2048 images), and get the result in only a fraction of a second.
+
+PDL variables (or 'piddles' as they have come to be known)
+support a wide range of fundamental data types - arrays can be bytes,
+short integers (signed or unsigned), long integers, floats or
+double precision floats. And because of the Object-Oriented nature
+of PDL new customised datatypes can be derived from them.
+
+As well as the PDL modules, that can be used by normal Perl programs, PerlDL
+comes with a command line Perl shell, called 'perldl', which supports command
+line editing. In combination with the various PDL graphics modules this allows
+data to be easily played with and visualised.
+
+=head2 Help
+
+PDL contains extensive documentation, available both within the
+I<perldl> or I<pdl2> shells and from the command line, using the C<pdldoc> program.
+For further information try either of:
+
+ pdl> help help
+ $ pdldoc
+
+HTML copies of the documentation should also be available.
+To find their location, try the following:
+
+ pdl> foreach ( map{"$_/PDL/HtmlDocs"}@INC ) { p "$_\n" if -d $_ }
+
+=head2 Perl Datatypes and how PDL extends them
+
+The fundamental Perl data structures are scalar variables, e.g. C<$x>,
+which can hold numbers or strings, lists or arrays of scalars, e.g. C<@x>,
+and associative arrays/hashes of scalars, e.g. C<%x>.
+
+Perl v5 introduces to Perl data structures and objects. A simple
+scalar variable C<$x> now be a user-defined data type or full blown
+object (it actually holds a reference (a smart "pointer") to this
+but that is not relevant for ordinary use of perlDL)
+
+The fundamental idea behind perlDL is to allow C<$x> to hold a whole 1D
+spectrum, or a 2D image, a 3D data cube, and so on up to large
+N-dimensional data sets. These can be manipulated all at once, e.g.
+C<$a = $b + 2> does a vector operation on each value in the
+spectrum/image/etc.
+
+You may well ask: "Why not just store a spectrum as a simple Perl C<@x>
+style list with each pixel being a list item?" The two key answers to
+this are I<memory> and I<speed>. Because we know our spectrum consists of
+pure numbers we can compactly store them in a single block of memory
+corresponding to a C style numeric array. This takes up a LOT less
+memory than the equivalent Perl list. It is then easy to pass this
+block of memory to a fast addition routine, or to any other C function
+which deals with arrays. As a result perlDL is very fast --- for example
+one can multiply a 2048*2048 image in exactly the same time as it
+would take in C or FORTRAN (0.1 sec on my SPARC). A further advantage
+of this is that for simple operations (e.g. C<$x += 2>) one can manipulate
+the whole array without caring about its dimensionality.
+
+I find when using perlDL it is most useful to think of standard Perl
+C<@x> variables as "lists" of generic "things" and PDL variables like
+C<$x> as "arrays" which can be contained in lists or hashes. Quite
+often in my perlDL scripts I have C<@x> contain a list of spectra, or a
+list of images (or even a mix!). Or perhaps one could have a hash
+(e.g. C<%x>) of images... the only limit is memory!
+
+perlDL variables support a range of data types - arrays can be bytes,
+short integers (signed or unsigned), long integers, floats or
+double precision floats.
+
+=head2 Usage
+
+PerlDL is loaded into your Perl script using this command:
+
+ use PDL; # in Perl scripts: use the standard perlDL modules
+
+There are also a lot of extension modules, e.g.
+L<PDL::Graphics::TriD|PDL::Graphics::TriD>.
+Most of these (but not all as sometimes it is not appropriate) follow
+a standard convention. If you say:
+
+ use PDL::Graphics::TriD;
+
+You import everything in a standard list from the module. Sometimes
+you might want to import nothing (e.g. if you want to use OO syntax
+all the time and save the import tax). For these you say:
+
+ use PDL::Graphics::TriD qw();
+
+And the empty C<qw()> quotes are recognised as meaning 'nothing'.
+You can also specify a list of functions to import in the normal
+Perl way.
+
+There is also an interactive shell, C<perldl> or C<pdl2>, see I<perldl>
+or L<pdl2|PDL::Perldl2> for details.
+
+=head2 To create a new PDL variable
+
+Here are some ways of creating a PDL variable:
+
+ $a = pdl [1..10]; # 1D array
+ $a = pdl (1,2,3,4); # Ditto
+ $a = pdl '[1 2 3 4]'; # Ditto
+ $b = pdl [[1,2,3],[4,5,6]]; # 2D 3x2 array
+ $b = pdl '[1 2 3; 4 5 6]'; # Ditto
+ $b = pdl q[1,2,3; 4,5,6]; # Ditto
+ $b = pdl <<NEWPDL # Ditto
+ [1 2 3]
+ [4 5 6]
+ NEWPDL
+ $c = pdl q[1 -2]; # 2-element piddle containing 1 and -2
+ $c = pdl q[1 - 2]; # 2-element piddle containing 1 and -2
+ $b = pdl 42 # 0-dimensional scalar
+ $c = pdl $a; # Make a new copy
+
+ $d = byte [1..10]; # See "Type conversion"
+ $e = zeroes(3,2,4); # 3x2x4 zero-filled array
+
+ $c = rfits $file; # Read FITS file
+
+ @x = ( pdl(42), zeroes(3,2,4), rfits($file) ); # Is a LIST of PDL variables!
+
+The L<pdl()|PDL::Core/pdl> function is used to initialise a PDL variable from a scalar,
+list, list reference, another PDL variable, or a properly formatted string.
+
+In addition all PDL functions automatically convert normal Perl scalars
+to PDL variables on-the-fly.
+
+(also see "Type Conversion" and "Input/Output" sections below)
+
+=head2 Arithmetic (and boolean expressions)
+
+ $a = $b + 2; $a++; $a = $b / $c; # Etc.
+
+ $c=sqrt($a); $d = log10($b+100); # Etc
+
+ $e = $a>42; # Vector conditional
+
+ $e = 42*($a>42) + $a*($a<=42); # Cap top
+
+ $b = $a->log10 unless any ($a <= 0); # avoid floating point error
+
+ $a = $a / ( max($a) - min($a) );
+
+ $f = where($a, $a > 10); # where returns a piddle of elements for
+ # which the condition is true
+
+ print $a; # $a in string context prints it in a N-dimensional format
+
+(and other Perl operators/functions)
+
+When using piddles in conditional expressions (i.e. C<if>, C<unless> and
+C<while> constructs) only piddles with exactly one element are allowed, e.g.
+
+ $a = pdl (1,0,0,1);
+ print "is set" if $a->index(2);
+
+Note that the boolean operators return in general multi-element
+piddles. Therefore, the following will raise an error
+
+ print "is ok" if $a > 3;
+
+since C<$a E<gt> 3> is a piddle with 4 elements. Rather use
+L<all|PDL::Ufunc/all> or L<any|PDL::Ufunc/any>
+to test if all or any of the elements fulfill the condition:
+
+ print "some are > 3" if any $a>3;
+ print "can't take logarithm" unless all $a>0;
+
+There are also many predefined functions, which are described on other
+man pages. Check L<PDL::Index>.
+
+=head2 Matrix functions
+
+C<'x'> is hijacked as the matrix multiplication operator. e.g.
+C<$c = $a x $b>;
+
+perlDL is row-major not column major so this is actually
+C<c(i,j) = sum_k a(k,j) b(i,k)> - but when matrices are printed the
+results will look right. Just remember the indices are reversed.
+e.g.:
+
+ $a = [ $b = [
+ [ 1 2 3 0] [1 1]
+ [ 1 -1 2 7] [0 2]
+ [ 1 0 0 1] [0 2]
+ ] [1 1]
+ ]
+
+ gives $c = [
+ [ 1 11]
+ [ 8 10]
+ [ 2 2]
+ ]
+
+Note: L<transpose()|PDL::Basic/transpose>
+does what it says and is a convenient way
+to turn row vectors into column vectors.
+
+=head2 How to write a simple function
+
+ sub dotproduct {
+ my ($a,$b) = @_;
+ return sum($a*$b) ;
+ }
+ 1;
+
+If put in file dotproduct.pdl would be autoloaded if you
+are using L<PDL::AutoLoader|PDL::AutoLoader> (see below).
+
+Of course, this function is already available as the
+L<inner|PDL::Primitive/inner>
+function, see L<PDL::Primitive>.
+
+=head2 Type Conversion
+
+Default for pdl() is double. Conversions are:
+
+ $a = float($b);
+ $c = long($d); # "long" is generally a 4 byte int
+ $d = byte($a);
+
+Also double(), short(), ushort(), indx().
+
+ NOTE: The indx() routine is a special integer type that
+ is the correct size for a PDL index value (dimension size,
+ index, or offest) which can be either a 32bit (long) or
+ 64bit (longlong) quantity depending on whether the perl
+ is built with 32bit or 64bit support.
+
+These routines also automatically convert Perl lists to
+allow the convenient shorthand:
+
+ $a = byte [[1..10],[1..10]]; # Create 2D byte array
+ $a = float [1..1000]; # Create 1D float array
+
+etc.
+
+=head2 Printing
+
+Automatically expands array in N-dimensional format:
+
+ print $a;
+
+ $b = "Answer is = $a ";
+
+=head2 Sections
+
+PDL has very powerful multidimensional slicing and sectioning
+operators; see L<the PDL::Slices(3) man page|PDL::Slices> for details;
+we'll describe the most important one here.
+
+PDL shows its Perl/C heritage in that arrays are zero-offset. Thus a
+100x100 image has indices C<0..99,0..99>. (The convention is that the
+I<center> of pixel (0,0) is at coordinate (0.0,0.0). All PDL graphics
+functions conform to this definition and hide away the unit offsets
+of, for example, the PGPLOT FORTRAN library.
+
+Following the usual convention coordinate (0,0) is displayed
+at the bottom left when displaying an image. It appears at the
+top left when using "C<print $a>" etc.
+
+Simple sectioning uses a syntax extension to Perl,
+L<PDL::NiceSlice|PDL::NiceSlice>, that allows you to specify subranges
+via a null-method modifier to a PDL:
+
+ $b = $a->($x1:$x2,$y1:$y2,($z1)); # Take subsection
+
+Here, C<$a> is a 3-dimensional variable, and C<$b> gets a planar
+cutout that is defined by the limits $x1, $x2, $y1, $y2, at the location
+$z1. The parenthesis around C<$z1> cause the trivial index to be omitted --
+otherwise C<$b> would be three-dimensional with a third dimension of order 1.
+
+You can put PDL slices on either side of the element-wise assignment
+operator C<.=>, like so:
+
+ # Set part of $bigimage to values from $smallimage
+ $bigimage->($xa:$xb,$ya:$yb) .= $smallimage;
+
+Some other miscellany:
+
+ $c = nelem($a); # Number of pixels
+
+ $val = at($object, $x,$y,$z...) # Pixel value at position, as a Perl scalar
+ $val = $object->at($x,$y,$z...) # equivalent (method syntax OK)
+
+ $b = xvals($a); # Fill array with X-coord values (also yvals(), zvals(),
+ # axisvals($x,$axis) and rvals() for radial distance
+ # from centre).
+
+=head2 Input/Output
+
+The C<PDL::IO> modules implement several useful IO format functions.
+It would be too much to give examples of each, but you can find a nice
+overview at L<PDL::IO|PDL::IO>. Here is a sample of some of the
+supported IO formats in PDL.
+
+=over 8
+
+=item PDL::IO::Misc
+
+Ascii, FITS and FIGARO/NDF IO routines.
+
+=item PDL::IO::FastRaw
+
+Using the raw data types of your machine, an unportable but blindingly
+fast IO format. Also supports memory mapping to conserve memory as
+well as get more speed.
+
+=item PDL::IO::FlexRaw
+
+General raw data formats. Like FastRaw, only better.
+
+=item PDL::IO::Browser
+
+A Curses browser for arrays.
+
+=item PDL::IO::Pnm
+
+Portaple bitmap and pixmap support.
+
+=item PDL::IO::Pic
+
+Using the previous module and netpbm, makes it possible to easily
+write GIF, jpeg and whatever with simple commands.
+
+=back
+
+=head2 Graphics
+
+The philosophy behind perlDL is to make it work with a variety of
+existing graphics libraries since no single package will satisfy all
+needs and all people and this allows one to work with packages one
+already knows and likes. Obviously there will be some overlaps in
+functionality and some lack of consistency and uniformity. However
+this allows PDL to keep up with a rapidly developing field - the
+latest PDL modules provide interfaces to OpenGL and VRML graphics!
+
+=over 4
+
+=item PDL::Graphics::PGPLOT
+
+PGPLOT provides a simple library for line graphics and image display.
+
+There is an easy interface to this in the internal module
+L<PDL::Graphics::PGPLOT|PDL::Graphics::PGPLOT>, which
+calls routines in the separately available
+PGPLOT top-level module.
+
+=item PDL::Graphics::PLplot
+
+PLplot provides a simple library for creating graphics with multiple
+output drivers, including a direct-to-piddle driver.
+
+This module provides both high-level and low-level functionality built
+on PLplot. The low-level commands are pretty much direct bindings to
+PLplot's C interface. Read more at L<PDL::Graphics::PLplot|PDL::Graphics::PLplot>.
+
+=item PDL::Graphics::IIS
+
+Many astronomers like to use SAOimage and Ximtool (or there
+derivations/clones). These are useful free widgets for inspection and
+visualisation of images. (They are not provided with perlDL but can
+easily be obtained from their official sites off the Net.)
+
+The L<PDL::Graphics::IIS|PDL::Graphics::IIS>
+package provides allows one to display images
+in these ("IIS" is the name of an ancient item of image display
+hardware whose protocols these tools conform to.)
+
+=item PDL::Graphics::TriD
+
+See L<PDL::Graphics::TriD|PDL::Graphics::TriD>, this is a collection
+of 3D routines for OpenGL and (soon) VRML and other 3D formats which
+allow 3D point, line, and surface plots from PDL.
+
+=back
+
+=head2 Autoloading
+
+See L<PDL::AutoLoader>. This allows one to autoload functions
+on demand, in a way perhaps familiar to users of MatLab.
+
+One can also write PDL extensions as normal Perl modules.
+
+=head2 PDL shells
+
+The Perl script C<pdl2> (or C<perldl>) provides a simple command line interface
+to PDL. If the latest Readlines/ReadKey modules have been installed C<pdl2>
+detects this and enables command line recall and editing.
+See the man page for details.
+
+e.g.:
+
+ % perldl
+ perlDL shell v1.354
+ PDL comes with ABSOLUTELY NO WARRANTY. For details, see the file
+ 'COPYING' in the PDL distribution. This is free software and you
+ are welcome to redistribute it under certain conditions, see
+ the same file for details.
+ ReadLines, NiceSlice, MultiLines enabled
+ Reading PDL/default.perldlrc...
+ Found docs database /home/pdl/dev/lib/perl5/site_perl/PDL/pdldoc.db
+ Type 'help' for online help
+ Type 'demo' for online demos
+ Loaded PDL v2.4.9_003 (supports bad values)
+ pdl> $x = rfits 'm51.fits'
+ Reading IMAGE data...
+ BITPIX = 32 size = 147456 pixels
+ Reading 589824 bytes
+ BSCALE = && BZERO =
+
+ pdl> use PDL::Graphics::PGPLOT;
+ pdl> imag $x
+ Displaying 384 x 384 image from 40 to 761, using 84 colors (16-99)...
+
+You can also run it from the Perl debugger (C<perl -MPDL -d -e 1>)
+if you want.
+
+Miscellaneous shell features:
+
+=over 4
+
+=item p
+
+The shell aliases C<p> to be a convenient short form of C<print>, e.g.
+
+ pdl> p ones 5,3
+ [
+ [1 1 1 1 1]
+ [1 1 1 1 1]
+ [1 1 1 1 1]
+ ]
+
+=item Initialization
+
+The files C<~/.perldlrc> and C<local.perldlrc> (in the current
+directory) are sourced if found. This allows the user to have global
+and local PDL code for startup.
+
+=item Help
+
+Type 'help'! One can search the PDL documentation, and look up documentation
+on any function.
+
+=item Escape
+
+Any line starting with the C<#> character is treated as a shell
+escape. This character is configurable by setting the Perl variable
+C<$PERLDL_ESCAPE>. This could, for example, be set in C<~/.perldlrc>.
+
+=back
+
+=head2 Overload operators
+
+The following builtin Perl operators and functions have been overloaded
+to work on PDL variables:
+
+ + - * / > < >= <= << >> & | ^ == != <=> ** % ! ~
+ sin log abs atan2 sqrt cos exp
+
+[All the unary functions (sin etc.) may be used with inplace() - see
+"Memory" below.]
+
+=head2 Object-Orientation and perlDL
+
+PDL operations are available as functions and methods.
+Thus one can derive new types of object, to represent
+custom data classes.
+
+By using overloading one can make mathematical operators
+do whatever you please, and PDL has some built-in tricks
+which allow existing PDL functions to work unchanged, even
+if the underlying data representation is vastly changed!
+See L<PDL::Objects>
+
+=head2 Memory usage and references
+
+Messing around with really huge data arrays may require some care.
+perlDL provides many facilities to let you perform operations on big
+arrays without generating extra copies though this does require a bit
+more thought and care from the programmer.
+
+NOTE: On some most systems it is better to configure Perl (during the
+build options) to use the system C<malloc()> function rather than Perl's
+built-in one. This is because Perl's one is optimised for speed rather
+than consumption of virtual memory - this can result in a factor of
+two improvement in the amount of memory storage you can use.
+The Perl malloc in 5.004 and later does have a number of compile-time
+options you can use to tune the behaviour.
+
+=over
+
+=item Simple arithmetic
+
+If $a is a big image (e.g. occupying 10MB) then the command
+
+ $a = $a + 1;
+
+eats up another 10MB of memory. This is because
+the expression C<$a+1> creates a temporary copy of C<$a> to hold the
+result, then C<$a> is assigned a reference to that.
+After this, the original C<$a> is destroyed so there is no I<permanent>
+memory waste. But on a small machine, the growth in the memory footprint
+can be considerable.
+It is obviously done
+this way so C<$c=$a+1> works as expected.
+
+Also if one says:
+
+ $b = $a; # $b and $a now point to same data
+ $a = $a + 1;
+
+Then C<$b> and C<$a> end up being different, as one naively expects,
+because a new reference is created and C<$a> is assigned to it.
+
+However if C<$a> was a huge memory hog (e.g. a 3D volume) creating a copy
+of it may not be a good thing. One can avoid this memory overhead in
+the above example by saying:
+
+ $a++;
+
+The operations C<++,+=,--,-=>, etc. all call a special "in-place"
+version of the arithmetic subroutine. This means no more memory is
+needed - the downside of this is that if C<$b=$a> then C<$b> is also
+incremented. To force a copy explicitly:
+
+ $b = pdl $a; # Real copy
+
+or, alternatively, perhaps better style:
+
+ $b = $a->copy;
+
+=item Functions
+
+Most functions, e.g. C<log()>, return a result which is a transformation
+of their argument. This makes for good programming practice. However many
+operations can be done "in-place" and this may be required when large
+arrays are in use and memory is at a premium. For these circumstances
+the operator L<inplace()|PDL::Core/inplace>
+is provided which prevents the extra copy and
+allows the argument to be modified. e.g.:
+
+ $x = log($array); # $array unaffected
+ log( inplace($bigarray) ); # $bigarray changed in situ
+
+WARNINGS:
+
+=over
+
+=item 1
+
+The usual caveats about duplicate references apply.
+
+=item 2
+
+Obviously when used with some functions which can not be applied
+in situ (e.g. C<convolve()>) unexpected effects may occur! We try to
+indicate C<inplace()>-safe functions in the documentation.
+
+=item 3
+
+Type conversions, such asC<float()>, may cause hidden copying.
+
+=back
+
+=back
+
+=head2 Ensuring piddleness
+
+If you have written a simple function and
+you don't want it to blow up in your face if you pass it a simple
+number rather than a PDL variable. Simply call the function
+L<topdl()|PDL::Core/topdl> first to make it safe. e.g.:
+
+ sub myfiddle { my $pdl = topdl(shift); $pdl->fiddle_foo(...); ... }
+
+C<topdl()> does NOT perform a copy if a pdl variable is passed - it
+just falls through - which is obviously the desired behaviour. The
+routine is not of course necessary in normal user defined functions
+which do not care about internals.
+
+=head1 AUTHOR
+
+Copyright (C) Karl Glazebrook (kgb at aaoepp.aao.gov.au), Tuomas J. Lukka,
+(lukka at husc.harvard.edu) and Christian Soeller (c.soeller at auckland.ac.nz) 1997.
+Commercial reproduction of this documentation in a different format is forbidden.
+
+=cut
diff --git a/Basic/Pod/Scilab.pod b/Basic/Pod/Scilab.pod
new file mode 100644
index 0000000..7793157
--- /dev/null
+++ b/Basic/Pod/Scilab.pod
@@ -0,0 +1,813 @@
+=head1 NAME
+
+PDL::Scilab - A guide for Scilab users.
+
+=head1 INTRODUCTION
+
+If you are a Scilab user, this page is for you. It explains the key
+differences between Scilab and PDL to help you get going as quickly
+as possible.
+
+B<This document is not a tutorial>. For that, go to L<PDL::QuickStart|
+PDL::QuickStart>. This document B<complements> the Quick Start guide, as
+it highlights the key differences between Scilab and PDL.
+
+=head1 Perl
+
+The key difference between Scilab and PDL is B<Perl>.
+
+Perl is a general purpose programming language with thousands of modules
+freely available on the web. PDL is an extension of Perl. This gives PDL
+programs access to more features than most numerical tools can dream of.
+At the same time, most syntax differences between Scilab and PDL are a
+result of its Perl foundation.
+
+B<You do not have to learn much Perl to be effective with PDL>. But
+if you wish to learn Perl, there is excellent documentation available
+on-line (L<http://perldoc.perl.org>) or through the command C<perldoc perl>.
+There is also a beginner's portal (L<http://perl-begin.org>).
+
+Perl's module repository is called CPAN (L<http://www.cpan.org>) and it
+has a vast array of modules. Run C<perldoc cpan> for more information.
+
+=head1 TERMINOLOGY: PIDDLE
+
+Scilab typically refers to vectors, matrices, and arrays. Perl already
+has arrays, and the terms "vector" and "matrix" typically refer to one-
+and two-dimensional collections of data. Having no good term to describe
+their object, PDL developers coined the term "I<piddle>" to give a name to
+their data type.
+
+A I<piddle> consists of a series of numbers organized as an N-dimensional
+data set. Piddles provide efficient storage and fast computation of large
+N-dimensional matrices. They are highly optimized for numerical work.
+
+For more information, see "B<Piddles vs Perl Arrays>" later in this document.
+
+=head1 COMMAND WINDOW AND IDE
+
+PDL does not come with a dedicated IDE. It does however come with an
+interactive shell and you can use a Perl IDE to develop PDL programs.
+
+=head2 PDL interactive shell
+
+To start the interactive shell, open a terminal and run C<perldl> or C<pdl2>.
+As in Scilab, the interactive shell is the best way to learn the
+language. To exit the shell, type C<exit>, just like Scilab.
+
+=head2 Writing PDL programs
+
+One popular IDE for Perl is called Padre (L<http://padre.perlide.org>).
+It is cross platform and easy to use.
+
+Whenever you write a stand-alone PDL program (i.e. outside the
+C<perldl> or C<pdl2> shells) you must start the program with C<use PDL;>.
+This command imports the PDL module into Perl. Here is a sample
+PDL program:
+
+ use PDL; # Import main PDL module.
+ use PDL::NiceSlice; # Import additional PDL module.
+
+ $b = pdl [2,3,4]; # Statements end in semicolon.
+ $A = pdl [ [1,2,3],[4,5,6] ]; # 2-dimensional piddle.
+
+ print $A x $b->transpose;
+
+Save this file as C<myprogram.pl> and run it with:
+
+ perl myprogram.pl
+
+=head2 New: Flexible syntax
+
+In very recent versions of PDL (version 2.4.7 or later) there is
+a flexible matrix syntax that can look extremely similar to Scilab:
+
+1) Use a ';' to delimit rows:
+
+ $b = pdl q[ 2,3,4 ];
+ $A = pdl q[ 1,2,3 ; 4,5,6 ];
+
+2) Use spaces to separate elements:
+
+ $b = pdl q[ 2 3 4 ];
+ $A = pdl q[ 1 2 3 ; 4 5 6 ];
+
+
+Basically, as long as you put a C<q> in front of the opening bracket,
+PDL should "do what you mean". So you can write in a syntax that is
+more comfortable for you.
+
+
+=head1 A MODULE FOR SCILAB USERS
+
+Here is a module that Scilab users will want to use:
+
+=over 5
+
+=item L<PDL::NiceSlice|PDL::NiceSlice>
+
+Gives PDL a syntax for slices (sub-matrices) that is shorter and
+more familiar to Scilab users.
+
+ // Scilab
+ b(1:5) --> Selects the first 5 elements from b.
+
+ # PDL without NiceSlice
+ $b->slice("0:4") --> Selects the first 5 elements from $b.
+
+ # PDL with NiceSlice
+ $b(0:4) --> Selects the first 5 elements from $b.
+
+=back
+
+
+
+=head1 BASIC FEATURES
+
+This section explains how PDL's syntax differs from Scilab. Most
+Scilab users will want to start here.
+
+
+=head2 General "gotchas"
+
+=over 5
+
+=item Indices
+
+In PDL, indices start at '0' (like C and Java), not 1 (like Scilab).
+For example, if C<$b> is an array with 5 elements, the elements would be
+numbered from 0 to 4.
+
+=item Displaying an object
+
+Scilab normally displays object contents automatically. In PDL you display
+objects explicitly with the C<print> command or the shortcut C<p>:
+
+Scilab:
+
+ --> a = 12
+ a = 12.
+ --> b = 23; // Suppress output.
+ -->
+
+PerlDL:
+
+ pdl> $a = 12 # No output.
+ pdl> print $a # Print object.
+ 12
+ pdl> p $a # "p" is a shorthand for "print" in the shell.
+ 12
+
+=back
+
+
+
+=head2 Creating Piddles
+
+=over 5
+
+=item Variables in PDL
+
+Variables always start with the '$' sign.
+
+ Scilab: value = 42
+ PerlDL: $value = 42
+
+=item Basic syntax
+
+Use the "pdl" constructor to create a new I<piddle>.
+
+ Scilab: v = [1,2,3,4]
+ PerlDL: $v = pdl [1,2,3,4]
+
+ Scilab: A = [ 1,2,3 ; 3,4,5 ]
+ PerlDL: $A = pdl [ [1,2,3] , [3,4,5] ]
+
+=item Simple matrices
+
+ Scilab PDL
+ ------ ------
+ Matrix of ones ones(5,5) ones 5,5
+ Matrix of zeros zeros(5,5) zeros 5,5
+ Random matrix rand(5,5) random 5,5
+ Linear vector 1:5 sequence 5
+
+Notice that in PDL the parenthesis in a function call are often optional.
+It is important to keep an eye out for possible ambiguities. For example:
+
+ pdl> p zeros 2, 2 + 2
+
+Should this be interpreted as C<zeros(2,2) + 2> or as C<zeros 2, (2+2)>?
+Both are valid statements:
+
+ pdl> p zeros(2,2) + 2
+ [
+ [2 2]
+ [2 2]
+ ]
+ pdl> p zeros 2, (2+2)
+ [
+ [0 0]
+ [0 0]
+ [0 0]
+ [0 0]
+ ]
+
+Rather than trying to memorize Perl's order of precedence, it is best
+to use parentheses to make your code unambiguous.
+
+=item Linearly spaced sequences
+
+ Scilab: --> linspace(2,10,5)
+ ans = 2. 4. 6. 8. 10.
+
+ PerlDL: pdl> p zeroes(5)->xlinvals(2,10)
+ [2 4 6 8 10]
+
+B<Explanation>: Start with a 1-dimensional piddle of 5 elements and give
+it equally spaced values from 2 to 10.
+
+Scilab has a single function call for this. On the other hand, PDL's
+method is more flexible:
+
+ pdl> p zeros(5,5)->xlinvals(2,10)
+ [
+ [ 2 4 6 8 10]
+ [ 2 4 6 8 10]
+ [ 2 4 6 8 10]
+ [ 2 4 6 8 10]
+ [ 2 4 6 8 10]
+ ]
+ pdl> p zeros(5,5)->ylinvals(2,10)
+ [
+ [ 2 2 2 2 2]
+ [ 4 4 4 4 4]
+ [ 6 6 6 6 6]
+ [ 8 8 8 8 8]
+ [10 10 10 10 10]
+ ]
+ pdl> p zeros(3,3,3)->zlinvals(2,6)
+ [
+ [
+ [2 2 2]
+ [2 2 2]
+ [2 2 2]
+ ]
+ [
+ [4 4 4]
+ [4 4 4]
+ [4 4 4]
+ ]
+ [
+ [6 6 6]
+ [6 6 6]
+ [6 6 6]
+ ]
+ ]
+
+=item Slicing and indices
+
+Extracting a subset from a collection of data is known as I<slicing>.
+The PDL shell and Scilab have a similar syntax for slicing, but there
+are two important differences:
+
+1) PDL indices start at 0, as in C and Java. Scilab starts indices at 1.
+
+2) In Scilab you think "rows and columns". In PDL, think "x and y".
+
+ Scilab PerlDL
+ ------ ------
+ --> A pdl> p $A
+ A = [
+ 1. 2. 3. [1 2 3]
+ 4. 5. 6. [4 5 6]
+ 7. 8. 9. [7 8 9]
+ ]
+ -------------------------------------------------------
+ (row = 2, col = 1) (x = 0, y = 1)
+ --> A(2,1) pdl> p $A(0,1)
+ ans = [
+ 4. [4]
+ ]
+ -------------------------------------------------------
+ (row = 2 to 3, col = 1 to 2) (x = 0 to 1, y = 1 to 2)
+ --> A(2:3,1:2) pdl> p $A(0:1,1:2)
+ ans = [
+ 4. 5. [4 5]
+ 7. 8. [7 8]
+ ]
+
+=over 5
+
+=item B<Warning>
+
+When you write a stand-alone PDL program you have
+to include the L<PDL::NiceSlice|PDL::NiceSlice> module. See the
+previous section "B<MODULES FOR SCILAB USERS>" for more information.
+
+ use PDL; # Import main PDL module.
+ use PDL::NiceSlice; # Nice syntax for slicing.
+
+ $A = random 4,4;
+ print $A(0,1);
+
+=back
+
+=back
+
+
+
+=head2 Matrix Operations
+
+=over 10
+
+=item Matrix multiplication
+
+ Scilab: A * B
+ PerlDL: $A x $B
+
+=item Element-wise multiplication
+
+ Scilab: A .* B
+ PerlDL: $A * $B
+
+=item Transpose
+
+ Scilab: A'
+ PerlDL: $A->transpose
+
+=back
+
+
+=head2 Functions that aggregate data
+
+Some functions (like C<sum>, C<max> and C<min>) aggregate data
+for an N-dimensional data set. Scilab and PDL both give you the
+option to apply these functions to the entire data set or to
+just one dimension.
+
+
+=over 10
+
+=item Scilab
+
+In Scilab, these functions work along the entire data set by default,
+and an optional parameter "r" or "c" makes them act over rows or columns.
+
+ --> A = [ 1,5,4 ; 4,2,1 ]
+ A = 1. 5. 4.
+ 4. 2. 1.
+ --> max(A)
+ ans = 5
+ --> max(A, "r")
+ ans = 4. 5. 4.
+ --> max(A, "c")
+ ans = 5.
+ 4.
+
+=item PDL
+
+PDL offers two functions for each feature.
+
+ sum vs sumover
+ avg vs average
+ max vs maximum
+ min vs minimum
+
+The B<long name> works over a dimension, while the B<short name>
+works over the entire piddle.
+
+ pdl> p $A = pdl [ [1,5,4] , [4,2,1] ]
+ [
+ [1 5 4]
+ [4 2 1]
+ ]
+ pdl> p $A->maximum
+ [5 4]
+ pdl> p $A->transpose->maximum
+ [4 5 4]
+ pdl> p $A->max
+ 5
+
+=back
+
+
+=head2 Higher dimensional data sets
+
+A related issue is how Scilab and PDL understand data sets of higher
+dimension. Scilab was designed for 1D vectors and 2D matrices with
+higher dimensional objects added on top. In contrast, PDL was designed
+for N-dimensional piddles from the start. This leads to a few surprises
+in Scilab that don't occur in PDL:
+
+=over 5
+
+=item Scilab sees a vector as a 2D matrix.
+
+ Scilab PerlDL
+ ------ ------
+ --> vector = [1,2,3,4]; pdl> $vector = pdl [1,2,3,4]
+ --> size(vector) pdl> p $vector->dims
+ ans = 1 4 4
+
+Scilab sees C<[1,2,3,4]> as a 2D matrix (1x4 matrix). PDL sees it
+as a 1D vector: A single dimension of size 4.
+
+=item But Scilab ignores the last dimension of a 4x1x1 matrix.
+
+ Scilab PerlDL
+ ------ ------
+ --> A = ones(4,1,1); pdl> $A = ones 4,1,1
+ --> size(A) pdl> p $A->dims
+ ans = 4 1 4 1 1
+
+=item And Scilab treats a 4x1x1 matrix differently from a 1x1x4 matrix.
+
+ Scilab PerlDL
+ ------ ------
+ --> A = ones(1,1,4); pdl> $A = ones 1,1,4
+ --> size(A) pdl> p $A->dims
+ ans = 1 1 4 1 1 4
+
+=item Scilab has no direct syntax for N-D arrays.
+
+ pdl> $A = pdl [ [[1,2,3],[4,5,6]], [[2,3,4],[5,6,7]] ]
+ pdl> p $A->dims
+ 3 2 2
+
+=item Feature support.
+
+In Scilab, several features are not available for N-D arrays. In PDL,
+just about any feature supported by 1D and 2D piddles, is equally
+supported by N-dimensional piddles. There is usually no distinction:
+
+ Scilab PerlDL
+ ------ ------
+ --> A = ones(3,3,3); pdl> $A = ones(3,3,3);
+ --> A' pdl> transpose $A
+ => ERROR => OK
+
+=back
+
+
+=head2 Loop Structures
+
+Perl has many loop structures, but we will only show the one that
+is most familiar to Scilab users:
+
+ Scilab PerlDL
+ ------ ------
+ for i = 1:10 for $i (1..10) {
+ disp(i) print $i
+ end }
+
+=over 5
+
+=item B<Note>
+
+Never use for-loops for numerical work. Perl's for-loops are faster
+than Scilab's, but they both pale against a "vectorized" operation.
+PDL has many tools that facilitate writing vectorized programs.
+These are beyond the scope of this guide. To learn more, see:
+L<PDL::Indexing|PDL::Indexing>, L<PDL::Threading|PDL::Threading>,
+and L<PDL::PP|PDL::PP>.
+
+Likewise, never use C<1..10> for numerical work, even outside a for-loop.
+C<1..10> is a Perl array. Perl arrays are designed for flexibility, not
+speed. Use I<piddles> instead. To learn more, see the next section.
+
+=back
+
+
+=head2 Piddles vs Perl Arrays
+
+It is important to note the difference between a I<Piddle> and a Perl
+array. Perl has a general-purpose array object that can hold any
+type of element:
+
+ @perl_array = 1..10;
+ @perl_array = ( 12, "Hello" );
+ @perl_array = ( 1, 2, 3, \@another_perl_array, sequence(5) );
+
+Perl arrays allow you to create powerful data structures (see
+B<Data structures> below), B<but they are not designed for numerical work>.
+For that, use I<piddles>:
+
+ $pdl = pdl [ 1, 2, 3, 4 ];
+ $pdl = sequence 10_000_000;
+ $pdl = ones 600, 600;
+
+For example:
+
+ $points = pdl 1..10_000_000 # 4.7 seconds
+ $points = sequence 10_000_000 # milliseconds
+
+B<TIP>: You can use underscores in numbers (C<10_000_000> reads better
+than C<10000000>).
+
+
+=head2 Conditionals
+
+Perl has many conditionals, but we will only show the one that is
+most familiar to Scilab users:
+
+ Scilab PerlDL
+ ------ ------
+ if value > MAX if ($value > $MAX) {
+ disp("Too large") print "Too large\n";
+ elseif value < MIN } elsif ($value < $MIN) {
+ disp("Too small") print "Too small\n";
+ else } else {
+ disp("Perfect!") print "Perfect!\n";
+ end }
+
+=over 5
+
+=item B<Note>
+
+Here is a "gotcha":
+
+ Scilab: elseif
+ PerlDL: elsif
+
+If your conditional gives a syntax error, check that you wrote
+your C<elsif>'s correctly.
+
+=back
+
+
+=head2 TIMTOWDI (There Is More Than One Way To Do It)
+
+One of the most interesting differences between PDL and other tools
+is the expressiveness of the Perl language. TIMTOWDI, or "There Is
+More Than One Way To Do It", is Perl's motto.
+
+Perl was written by a linguist, and one of its defining properties
+is that statements can be formulated in different ways to give the
+language a more natural feel. For example, you are unlikely to say
+to a friend:
+
+ "While I am not finished, I will keep working."
+
+Human language is more flexible than that. Instead, you are more
+likely to say:
+
+ "I will keep working until I am finished."
+
+Owing to its linguistic roots, Perl is the only programming language
+with this sort of flexibility. For example, Perl has traditional
+while-loops and if-statements:
+
+ while ( ! finished() ) {
+ keep_working();
+ }
+
+ if ( ! wife_angry() ) {
+ kiss_wife();
+ }
+
+But it also offers the alternative B<until> and B<unless> statements:
+
+ until ( finished() ) {
+ keep_working();
+ }
+
+ unless ( wife_angry() ) {
+ kiss_wife();
+ }
+
+And Perl allows you to write loops and conditionals in "postfix" form:
+
+ keep_working() until finished();
+
+ kiss_wife() unless wife_angry();
+
+
+In this way, Perl often allows you to write more natural, easy to
+understand code than is possible in more restrictive programming
+languages.
+
+
+=head2 Functions
+
+PDL's syntax for declaring functions differs significantly from Scilab's.
+
+ Scilab PerlDL
+ ------ ------
+ function retval = foo(x,y) sub foo {
+ retval = x.**2 + x.*y my ($x, $y) = @_;
+ endfunction return $x**2 + $x*$y;
+ }
+
+Don't be intimidated by all the new syntax. Here is a quick run through
+a function declaration in PDL:
+
+1) "B<sub>" stands for "subroutine".
+
+2) "B<my>" declares variables to be local to the function.
+
+3) "B<@_>" is a special Perl array that holds all the function parameters.
+This might seem like a strange way to do functions, but it allows you
+to make functions that take a variable number of parameters. For example,
+the following function takes any number of parameters and adds them
+together:
+
+ sub mysum {
+ my ($i, $total) = (0, 0);
+ for $i (@_) {
+ $total += $i;
+ }
+ return $total;
+ }
+
+4) You can assign values to several variables at once using the syntax:
+
+ ($a, $b, $c) = (1, 2, 3);
+
+So, in the previous examples:
+
+ # This declares two local variables and initializes them to 0.
+ my ($i, $total) = (0, 0);
+
+ # This takes the first two elements of @_ and puts them in $x and $y.
+ my ($x, $y) = @_;
+
+5) The "B<return>" statement gives the return value of the function, if any.
+
+
+=head1 ADDITIONAL FEATURES
+
+=head2 Data structures
+
+To create complex data structures, Scilab uses "I<lists>" and "I<structs>".
+Perl's arrays and hashes offer similar functionality. This section is only a
+quick overview of what Perl has to offer. To learn more about this, please go to
+L<http://perldoc.perl.org/perldata.html> or run the command C<perldoc perldata>.
+
+=over 5
+
+=item Arrays
+
+Perl arrays are similar to Scilab's lists. They are both a sequential data
+structure that can contain any data type.
+
+ Scilab
+ ------
+ list( 1, 12, "hello", zeros(3,3) , list( 1, 2) );
+
+ PerlDL
+ ------
+ @array = ( 1, 12, "hello" , zeros(3,3), [ 1, 2 ] )
+
+
+Notice that Perl array's start with the "@" prefix instead of the "$" used by
+piddles.
+
+I<To learn about Perl arrays, please go to L<http://perldoc.perl.org/perldata.html>
+or run the command C<perldoc perldata>.>
+
+=item Hashes
+
+Perl hashes are similar to Scilab's structure arrays:
+
+ Scilab
+ ------
+ --> drink = struct('type', 'coke', 'size', 'large', 'myarray', ones(3,3,3))
+ --> drink.type = 'sprite'
+ --> drink.price = 12 // Add new field to structure array.
+
+ PerlDL
+ ------
+ pdl> %drink = ( type => 'coke' , size => 'large', mypiddle => ones(3,3,3) )
+ pdl> $drink{type} = 'sprite'
+ pdl> $drink{price} = 12 # Add new field to hash.
+
+Notice that Perl hashes start with the "%" prefix instead of the "@" for
+arrays and "$" used by piddles.
+
+I<To learn about Perl hashes, please go to L<http://perldoc.perl.org/perldata.html>
+or run the command C<perldoc perldata>.>
+
+=back
+
+
+
+=head2 Performance
+
+PDL has powerful performance features, some of which are not normally
+available in numerical computation tools. The following pages will guide
+you through these features:
+
+=over 5
+
+=item L<PDL::Indexing|PDL::Indexing>
+
+B<Level>: Beginner
+
+This beginner tutorial covers the standard "vectorization" feature that
+you already know from Scilab. Use this page to learn how to avoid for-loops
+to make your program more efficient.
+
+=item L<PDL::Threading|PDL::Threading>
+
+B<Level>: Intermediate
+
+PDL's "vectorization" feature goes beyond what most numerical software
+can do. In this tutorial you'll learn how to "thread" over higher dimensions,
+allowing you to vectorize your program further than is possible in Scilab.
+
+
+=item Benchmarks
+
+B<Level>: Intermediate
+
+Perl comes with an easy to use benchmarks module to help you find how
+long it takes to execute different parts of your code. It is a great
+tool to help you focus your optimization efforts. You can read about it
+online (L<http://perldoc.perl.org/Benchmark.html>) or through the
+command C<perldoc Benchmark>.
+
+=item L<PDL::PP|PDL::PP>
+
+B<Level>: Advanced
+
+PDL's Pre-Processor is one of PDL's most powerful features. You
+write a function definition in special markup and the pre-processor
+generates real C code which can be compiled. With PDL:PP
+you get the full speed of native C code without having to deal with
+the full complexity of the C language.
+
+=back
+
+
+
+=head2 Plotting
+
+PDL has full-featured plotting abilities. Unlike Scilab, PDL relies more on
+third-party libraries (pgplot and PLplot) for its 2D plotting features.
+Its 3D plotting and graphics uses OpenGL for performance and portability.
+PDL has three main plotting modules:
+
+=over 5
+
+=item L<PDL::Graphics::PGPLOT|PDL::Graphics::PGPLOT>
+
+B<Best for>: Plotting 2D functions and data sets.
+
+This is an interface to the venerable PGPLOT library. PGPLOT has
+been widely used in the academic and scientific communities for
+many years. In part because of its age, PGPLOT has some limitations
+compared to newer packages such as PLplot (e.g. no RGB graphics).
+But it has many features that still make it popular in the scientific
+community.
+
+=item L<PDL::Graphics::PLplot|PDL::Graphics::PLplot>
+
+B<Best for>: Plotting 2D functions as well as 2D and 3D data sets.
+
+This is an interface to the PLplot plotting library. PLplot
+is a modern, open source library for making scientific plots.
+It supports plots of both 2D and 3D data sets. PLplot is best
+supported for unix/linux/macosx platforms. It has an active
+developers community and support for win32 platforms is improving.
+
+=item L<PDL::Graphics::TriD|PDL::Graphics::TriD>
+
+B<Best for>: Plotting 3D functions.
+
+The native PDL 3D graphics library using OpenGL as a backend
+for 3D plots and data visualization. With OpenGL, it is easy
+to manipulate the resulting 3D objects with the mouse in real
+time.
+
+=back
+
+
+=head2 Writing GUIs
+
+Through Perl, PDL has access to all the major toolkits for creating
+a cross platform graphical user interface. One popular option is
+wxPerl (L<http://wxperl.sourceforge.net>). These are the Perl bindings
+for wxWidgets, a powerful GUI toolkit for writing cross-platform
+applications.
+
+wxWidgets is designed to make your application look and feel like
+a native application in every platform. For example, the Perl
+IDE B<Padre> is written with wxPerl.
+
+=head2 Xcos / Scicos
+
+Xcos (formerly Scicos) is a graphical dynamical system modeler and
+simulator. It is part of the standard Scilab distribution. PDL and
+Perl do not have a direct equivalent to Scilab's Xcos. If this
+feature is important to you, you should probably keep a copy of
+Scilab around for that.
+
+
+=head1 COPYRIGHT
+
+Copyright 2010 Daniel Carrera (dcarrera at gmail.com). You can distribute and/or
+modify this document under the same terms as the current Perl license.
+
+See: http://dev.perl.org/licenses/
+
diff --git a/Basic/Pod/Threading.pod b/Basic/Pod/Threading.pod
new file mode 100644
index 0000000..3506de2
--- /dev/null
+++ b/Basic/Pod/Threading.pod
@@ -0,0 +1,961 @@
+=head1 NAME
+
+PDL::Threading - Tutorial for PDL's Threading feature
+
+=head1 INTRODUCTION
+
+One of the most powerful features of PDL is B<threading>, which can
+produce very compact and very fast PDL code by avoiding multiple nested
+for loops that C and BASIC users may be familiar with. The trouble is
+that it can take some getting used to, and new users may not appreciate
+the benefits of threading.
+
+Other vector based languages, such as MATLAB, use a subset of threading
+techniques, but PDL shines by completely generalizing them for all sorts
+of vector-based applications.
+
+=head1 TERMINOLOGY: PIDDLE
+
+MATLAB typically refers to vectors, matrices, and arrays. Perl already
+has arrays, and the terms "vector" and "matrix" typically refer to one-
+and two-dimensional collections of data. Having no good term to describe
+their object, PDL developers coined the term "I<piddle>" to give a name to
+their data type.
+
+A I<piddle> consists of a series of numbers organized as an N-dimensional
+data set. Piddles provide efficient storage and fast computation of large
+N-dimensional matrices. They are highly optimized for numerical work.
+
+=head1 THINKING IN TERMS OF THREADING
+
+If you have used PDL for a little while already, you may have been using
+threading without realising it. Start the PDL shell (type C<perldl> or
+C<pdl2> on a terminal). Most examples in this tutorial use the PDL shell.
+Make sure that L<PDL::NiceSlice|PDL::NiceSlice> and L<PDL::AutoLoader|PDL::AutoLoader>
+are enabled. For example:
+
+ % pdl2
+ perlDL shell v1.352
+ ...
+ ReadLines, NiceSlice, MultiLines enabled
+ ...
+ Note: AutoLoader not enabled ('use PDL::AutoLoader' recommended)
+
+ pdl>
+
+In this example, NiceSlice was automatically enabled, but AutoLoader was not.
+To enable it, type C<use PDL::AutoLoader>.
+
+Let's start with a two-dimensional I<piddle>:
+
+ pdl> $a = sequence(11,9)
+ pdl> p $a
+ [
+ [ 0 1 2 3 4 5 6 7 8 9 10]
+ [11 12 13 14 15 16 17 18 19 20 21]
+ [22 23 24 25 26 27 28 29 30 31 32]
+ [33 34 35 36 37 38 39 40 41 42 43]
+ [44 45 46 47 48 49 50 51 52 53 54]
+ [55 56 57 58 59 60 61 62 63 64 65]
+ [66 67 68 69 70 71 72 73 74 75 76]
+ [77 78 79 80 81 82 83 84 85 86 87]
+ [88 89 90 91 92 93 94 95 96 97 98]
+ ]
+
+The C<info> method gives you basic information about a I<piddle>:
+
+ pdl> p $a->info
+ PDL: Double D [11,9]
+
+This tells us that C<$a> is an 11 x 9 I<piddle> composed of double
+precision numbers. If we wanted to add 3 to all elements in an C<n x m>
+piddle, a traditional language would use two nested for-loops:
+
+ # Pseudo-code. Traditional way to add 3 to an array.
+ for (x=0; x < n; x++) {
+ for (y=0; y < m; y++) {
+ a(x,y) = a(x,y) + 3
+ }
+ }
+
+B<Note>: Notice that indices start at 0, as in Perl, C and Java (and unlike
+MATLAB and IDL).
+
+But with PDL, we can just write:
+
+ pdl> $b = $a + 3
+ pdl> p $b
+ [
+ [ 3 4 5 6 7 8 9 10 11 12 13]
+ [ 14 15 16 17 18 19 20 21 22 23 24]
+ [ 25 26 27 28 29 30 31 32 33 34 35]
+ [ 36 37 38 39 40 41 42 43 44 45 46]
+ [ 47 48 49 50 51 52 53 54 55 56 57]
+ [ 58 59 60 61 62 63 64 65 66 67 68]
+ [ 69 70 71 72 73 74 75 76 77 78 79]
+ [ 80 81 82 83 84 85 86 87 88 89 90]
+ [ 91 92 93 94 95 96 97 98 99 100 101]
+ ]
+
+This is the simplest example of threading, and it is something that
+all numerical software tools do. The C<+ 3> operation was automatically
+applied along two dimensions. Now suppose you want to to subtract a
+line from every row in C<$a>:
+
+ pdl> $line = sequence(11)
+ pdl> p $line
+ [0 1 2 3 4 5 6 7 8 9 10]
+ pdl> $c = $a - $line
+ pdl> p $c
+ [
+ [ 0 0 0 0 0 0 0 0 0 0 0]
+ [11 11 11 11 11 11 11 11 11 11 11]
+ [22 22 22 22 22 22 22 22 22 22 22]
+ [33 33 33 33 33 33 33 33 33 33 33]
+ [44 44 44 44 44 44 44 44 44 44 44]
+ [55 55 55 55 55 55 55 55 55 55 55]
+ [66 66 66 66 66 66 66 66 66 66 66]
+ [77 77 77 77 77 77 77 77 77 77 77]
+ [88 88 88 88 88 88 88 88 88 88 88]
+ ]
+
+Two things to note here: First, the value of C<$a> is still the same. Try
+C<p $a> to check. Second, PDL automatically subtracted C<$line> from each
+row in C<$a>. Why did it do that? Let's look at the dimensions of C<$a>,
+C<$line> and C<$c>:
+
+ pdl> p $line->info => PDL: Double D [11]
+ pdl> p $a->info => PDL: Double D [11,9]
+ pdl> p $c->info => PDL: Double D [11,9]
+
+So, both C<$a> and C<$line> have the same number of elements in the 0th
+dimension! What PDL then did was thread over the higher dimensions in C<$a>
+and repeated the same operation 9 times to all the rows on C<$a>. This is
+PDL threading in action.
+
+What if you want to subtract C<$line> from the first line in C<$a> only?
+You can do that by specifying the line explicitly:
+
+ pdl> $a(:,0) -= $line
+ pdl> p $a
+ [
+ [ 0 0 0 0 0 0 0 0 0 0 0]
+ [11 12 13 14 15 16 17 18 19 20 21]
+ [22 23 24 25 26 27 28 29 30 31 32]
+ [33 34 35 36 37 38 39 40 41 42 43]
+ [44 45 46 47 48 49 50 51 52 53 54]
+ [55 56 57 58 59 60 61 62 63 64 65]
+ [66 67 68 69 70 71 72 73 74 75 76]
+ [77 78 79 80 81 82 83 84 85 86 87]
+ [88 89 90 91 92 93 94 95 96 97 98]
+ ]
+
+See L<PDL::Indexing|PDL::Indexing> and L<PDL::NiceSlice|PDL::NiceSlice> to
+learn more about specifying subsets from piddles.
+
+The true power of threading comes when you realise that the piddle can
+have any number of dimensions! Let's make a 4 dimensional piddle:
+
+ pdl> $piddle_4D = sequence(11,3,7,2)
+ pdl> $c = $piddle_4D - $line
+
+Now C<$c> is a piddle of the same dimension as C<$piddle_4D>.
+
+ pdl> p $piddle_4D->info => PDL: Double D [11,3,7,2]
+ pdl> p $c->info => PDL: Double D [11,3,7,2]
+
+This time PDL has threaded over three higher dimensions automatically,
+subtracting C<$line> all the way.
+
+But, maybe you don't want to subtract from the rows (dimension 0), but from
+the columns (dimension 1). How do I subtract a column of numbers from each
+column in C<$a>?
+
+ pdl> $cols = sequence(9)
+ pdl> p $a->info => PDL: Double D [11,9]
+ pdl> p $cols->info => PDL: Double D [9]
+
+Naturally, we can't just type C<$a - $cols>. The dimensions don't match:
+
+ pdl> p $a - $cols
+ PDL: PDL::Ops::minus(a,b,c): Parameter 'b'
+ PDL: Mismatched implicit thread dimension 0: should be 11, is 9
+
+How do we tell PDL that we want to subtract from dimension 1 instead?
+
+=head1 MANIPULATING DIMENSIONS
+
+There are many PDL functions that let you rearrange the dimensions of PDL
+arrays. They are mostly covered in L<PDL::Slices|PDL::Slices>. The three
+most common ones are:
+
+ xchg
+ mv
+ reorder
+
+
+=head2 Method: C<xchg>
+
+The C<xchg> method "B<exchanges>" two dimensions in a piddle:
+
+ pdl> $a = sequence(6,7,8,9)
+ pdl> $a_xchg = $a->xchg(0,3)
+
+ pdl> p $a->info => PDL: Double D [6,7,8,9]
+ pdl> p $a_xchg->info => PDL: Double D [9,7,8,6]
+ | |
+ V V
+ (dim 0) (dim 3)
+
+Notice that dimensions 0 and 3 were exchanged without affecting the other
+dimensions. Notice also that C<xchg> does not alter C<$a>. The original
+variable C<$a> remains untouched.
+
+=head2 Method: C<mv>
+
+The C<mv> method "B<moves>" one dimension, in a piddle, shifting other
+dimensions as necessary.
+
+ pdl> $a = sequence(6,7,8,9) (dim 0)
+ pdl> $a_mv = $a->mv(0,3) |
+ pdl> V _____
+ pdl> p $a->info => PDL: Double D [6,7,8,9]
+ pdl> p $a_mv->info => PDL: Double D [7,8,9,6]
+ ----- |
+ V
+ (dim 3)
+
+Notice that when dimension 0 was moved to position 3, all the other dimensions
+had to be shifted as well. Notice also that C<mv> does not alter C<$a>. The
+original variable C<$a> remains untouched.
+
+=head2 Method: C<reorder>
+
+The C<reorder> method is a generalization of the C<xchg> and C<mv> methods.
+It "B<reorders>" the dimensions in any way you specify:
+
+ pdl> $a = sequence(6,7,8,9)
+ pdl> $a_reorder = $a->reorder(3,0,2,1)
+ pdl>
+ pdl> p $a->info => PDL: Double D [6,7,8,9]
+ pdl> p $a_reorder->info => PDL: Double D [9,6,8,7]
+ | | | |
+ V V v V
+ dimensions: 0 1 2 3
+
+Notice what happened. When we wrote C<reorder(3,0,2,1)> we instructed PDL to:
+
+ * Put dimension 3 first.
+ * Put dimension 0 next.
+ * Put dimension 2 next.
+ * Put dimension 1 next.
+
+When you use the C<reorder> method, all the dimensions are shuffled. Notice that
+C<reorder> does not alter C<$a>. The original variable C<$a> remains untouched.
+
+
+=head1 GOTCHA: LINKING VS ASSIGNMENT
+
+=head2 Linking
+
+By default, piddles are B<linked together> so that changes on one will go
+back and affect the original B<as well>.
+
+ pdl> $a = sequence(4,5)
+ pdl> $a_xchg = $a->xchg(1,0)
+
+Here, C<$a_xchg> B<is not a separate object>. It is merely a different way
+of looking at C<$a>. Any change in C<$a_xchg> will appear in C<$a> as well.
+
+ pdl> p $a
+ [
+ [ 0 1 2 3]
+ [ 4 5 6 7]
+ [ 8 9 10 11]
+ [12 13 14 15]
+ [16 17 18 19]
+ ]
+ pdl> $a_xchg += 3
+ pdl> p $a
+ [
+ [ 3 4 5 6]
+ [ 7 8 9 10]
+ [11 12 13 14]
+ [15 16 17 18]
+ [19 20 21 22]
+ ]
+
+=head2 Assignment
+
+Some times, linking is not the behaviour you want. If you want to make the
+piddles independent, use the C<copy> method:
+
+ pdl> $a = sequence(4,5)
+ pdl> $a_xchg = $a->copy->xchg(1,0)
+
+Now C<$a> and C<$a_xchg> are completely separate objects:
+
+ pdl> p $a
+ [
+ [ 0 1 2 3]
+ [ 4 5 6 7]
+ [ 8 9 10 11]
+ [12 13 14 15]
+ [16 17 18 19]
+ ]
+ pdl> $a_xchg += 3
+ pdl> p $a
+ [
+ [ 0 1 2 3]
+ [ 4 5 6 7]
+ [ 8 9 10 11]
+ [12 13 14 15]
+ [16 17 18 19]
+ ]
+ pdl> $a_xchg
+ [
+ [ 3 7 11 15 19]
+ [ 4 8 12 16 20]
+ [ 5 9 13 17 21]
+ [ 6 10 14 18 22]
+ ]
+
+
+=head1 PUTTING IT ALL TOGETHER
+
+Now we are ready to solve the problem that motivated this whole discussion:
+
+ pdl> $a = sequence(11,9)
+ pdl> $cols = sequence(9)
+ pdl>
+ pdl> p $a->info => PDL: Double D [11,9]
+ pdl> p $cols->info => PDL: Double D [9]
+
+How do we tell PDL to subtract C<$cols> along dimension 1 instead of dimension 0?
+The simplest way is to use the C<xchg> method and rely on PDL linking:
+
+ pdl> p $a
+ [
+ [ 0 1 2 3 4 5 6 7 8 9 10]
+ [11 12 13 14 15 16 17 18 19 20 21]
+ [22 23 24 25 26 27 28 29 30 31 32]
+ [33 34 35 36 37 38 39 40 41 42 43]
+ [44 45 46 47 48 49 50 51 52 53 54]
+ [55 56 57 58 59 60 61 62 63 64 65]
+ [66 67 68 69 70 71 72 73 74 75 76]
+ [77 78 79 80 81 82 83 84 85 86 87]
+ [88 89 90 91 92 93 94 95 96 97 98]
+ ]
+ pdl> $a->xchg(1,0) -= $cols
+ pdl> p $a
+ [
+ [ 0 1 2 3 4 5 6 7 8 9 10]
+ [10 11 12 13 14 15 16 17 18 19 20]
+ [20 21 22 23 24 25 26 27 28 29 30]
+ [30 31 32 33 34 35 36 37 38 39 40]
+ [40 41 42 43 44 45 46 47 48 49 50]
+ [50 51 52 53 54 55 56 57 58 59 60]
+ [60 61 62 63 64 65 66 67 68 69 70]
+ [70 71 72 73 74 75 76 77 78 79 80]
+ [80 81 82 83 84 85 86 87 88 89 90]
+ ]
+
+=over 5
+
+=item General Strategy:
+
+Move the dimensions you want to operate on to the start of your piddle's
+dimension list. Then let PDL thread over the higher dimensions.
+
+=back
+
+=head1 EXAMPLE: CONWAY'S GAME OF LIFE
+
+Okay, enough theory. Let's do something a bit more interesting: We'll write
+B<Conway's Game of Life> in PDL and see how powerful PDL can be!
+
+The B<Game of Life> is a simulation run on a big two dimensional grid. Each
+cell in the grid can either be alive or dead (represented by 1 or 0). The
+next generation of cells in the grid is calculated with simple rules according
+to the number of living cells in it's immediate neighbourhood:
+
+1) If an empty cell has exactly three neighbours, a living cell is generated.
+
+2) If a living cell has less than two neighbours, it dies of overfeeding.
+
+3) If a living cell has 4 or more neighbours, it dies from starvation.
+
+Only the first generation of cells is determined by the programmer. After that,
+the simulation runs completely according to these rules. To calculate the next
+generation, you need to look at each cell in the 2D field (requiring two loops),
+calculate the number of live cells adjacent to this cell (requiring another two
+loops) and then fill the next generation grid.
+
+=head2 Classical implementation
+
+Here's a classic way of writing this program in Perl. We only use PDL for
+addressing individual cells.
+
+ #!/usr/bin/perl -w
+ use PDL;
+ use PDL::NiceSlice;
+
+ # Make a board for the game of life.
+ my $nx = 20;
+ my $ny = 20;
+
+ # Current generation.
+ my $a = zeroes($nx, $ny);
+
+ # Next generation.
+ my $n = zeroes($nx, $ny);
+
+ # Put in a simple glider.
+ $a(1:3,1:3) .= pdl ( [1,1,1],
+ [0,0,1],
+ [0,1,0] );
+
+ for (my $i = 0; $i < 100; $i++) {
+ $n = zeroes($nx, $ny);
+ $new_a = $a->copy;
+ for ($x = 0; $x < $nx; $x++) {
+ for ($y = 0; $y < $ny; $y++) {
+
+ # For each cell, look at the surrounding neighbours.
+ for ($dx = -1; $dx <= 1; $dx++) {
+ for ($dy = -1; $dy <= 1; $dy++) {
+ $px = $x + $dx;
+ $py = $y + $dy;
+
+ # Wrap around at the edges.
+ if ($px < 0) {$px = $nx-1};
+ if ($py < 0) {$py = $ny-1};
+ if ($px >= $nx) {$px = 0};
+ if ($py >= $ny) {$py = 0};
+
+ $n($x,$y) .= $n($x,$y) + $a($px,$py);
+ }
+ }
+ # Do not count the central cell itself.
+ $n($x,$y) -= $a($x,$y);
+
+ # Work out if cell lives or dies:
+ # Dead cell lives if n = 3
+ # Live cell dies if n is not 2 or 3
+ if ($a($x,$y) == 1) {
+ if ($n($x,$y) < 2) {$new_a($x,$y) .= 0};
+ if ($n($x,$y) > 3) {$new_a($x,$y) .= 0};
+ } else {
+ if ($n($x,$y) == 3) {$new_a($x,$y) .= 1}
+ }
+ }
+ }
+
+ print $a;
+
+ $a = $new_a;
+ }
+
+If you run this, you will see a small glider crawl diagonally across the grid
+of zeroes. On my machine, it prints out a couple of generations per second.
+
+=head2 Threaded PDL implementation
+
+And here's the threaded version in PDL. Just four lines of PDL code, and
+one of those is printing out the latest generation!
+
+ #!/usr/bin/perl -w
+ use PDL;
+ use PDL::NiceSlice;
+
+ my $a = zeroes(20,20);
+
+ # Put in a simple glider.
+ $a(1:3,1:3) .= pdl ( [1,1,1],
+ [0,0,1],
+ [0,1,0] );
+
+ my $n;
+ for (my $i = 0; $i < 100; $i++) {
+ # Calculate the number of neighbours per cell.
+ $n = $a->range(ndcoords($a)-1,3,"periodic")->reorder(2,3,0,1);
+ $n = $n->sumover->sumover - $a;
+
+ # Calculate the next generation.
+ $a = ((($n == 2) + ($n == 3))* $a) + (($n==3) * !$a);
+
+ print $a;
+ }
+
+The threaded PDL version is much faster:
+
+ Classical => 32.79 seconds.
+ Threaded => 0.41 seconds.
+
+=head2 Explanation
+
+How does the threaded version work?
+
+There are many PDL functions designed to help you carry out PDL threading.
+In this example, the key functions are:
+
+=head3 Method: C<range>
+
+At the simplest level, the C<range> method is a different way to select a
+portion of a piddle. Instead of using the C<$a(2,3)> notation, we use
+another piddle.
+
+ pdl> $a = sequence(6,7)
+ pdl> p $a
+ [
+ [ 0 1 2 3 4 5]
+ [ 6 7 8 9 10 11]
+ [12 13 14 15 16 17]
+ [18 19 20 21 22 23]
+ [24 25 26 27 28 29]
+ [30 31 32 33 34 35]
+ [36 37 38 39 40 41]
+ ]
+ pdl> p $a->range( pdl [1,2] )
+ 13
+ pdl> p $a(1,2)
+ [
+ [13]
+ ]
+
+At this point, the C<range> method looks very similar to a regular PDL slice.
+But the C<range> method is more general. For example, you can select several
+components at once:
+
+ pdl> $index = pdl [ [1,2],[2,3],[3,4],[4,5] ]
+ pdl> p $a->range( $index )
+ [13 20 27 34]
+
+Additionally, C<range> takes a second parameter which determines the size
+of the chunk to return:
+
+ pdl> $size = 3
+ pdl> p $a->range( pdl([1,2]) , $size )
+ [
+ [13 14 15]
+ [19 20 21]
+ [25 26 27]
+ ]
+
+We can use this to select one or more 3x3 boxes.
+
+Finally, C<range> can take a third parameter called the "boundary" condition.
+It tells PDL what to do if the size box you request goes beyond the edge of
+the piddle. We won't go over all the options. We'll just say that the option
+C<periodic> means that the piddle "wraps around". For example:
+
+ pdl> p $a
+ [
+ [ 0 1 2 3 4 5]
+ [ 6 7 8 9 10 11]
+ [12 13 14 15 16 17]
+ [18 19 20 21 22 23]
+ [24 25 26 27 28 29]
+ [30 31 32 33 34 35]
+ [36 37 38 39 40 41]
+ ]
+ pdl> $size = 3
+ pdl> p $a->range( pdl([4,2]) , $size , "periodic" )
+ [
+ [16 17 12]
+ [22 23 18]
+ [28 29 24]
+ ]
+ pdl> p $a->range( pdl([5,2]) , $size , "periodic" )
+ [
+ [17 12 13]
+ [23 18 19]
+ [29 24 25]
+ ]
+
+Notice how the box wraps around the boundary of the piddle.
+
+=head3 Method: C<ndcoords>
+
+The C<ndcoords> method is a convenience method that returns an enumerated
+list of coordinates suitable for use with the C<range> method.
+
+ pdl> p $piddle = sequence(3,3)
+ [
+ [0 1 2]
+ [3 4 5]
+ [6 7 8]
+ ]
+ pdl> p ndcoords($piddle)
+ [
+ [
+ [0 0]
+ [1 0]
+ [2 0]
+ ]
+ [
+ [0 1]
+ [1 1]
+ [2 1]
+ ]
+ [
+ [0 2]
+ [1 2]
+ [2 2]
+ ]
+ ]
+
+This can be a little hard to read. Basically it's saying that the coordinates
+for every element in C<$piddle> is given by:
+
+ (0,0) (1,0) (2,0)
+ (1,0) (1,1) (2,1)
+ (2,0) (2,1) (2,2)
+
+=head3 Combining C<range> and C<ndcoords>
+
+What really matters is that C<ndcoords> is designed to work together with
+C<range>, with no C<$size> parameter, you get the same piddle back.
+
+ pdl> p $piddle
+ [
+ [0 1 2]
+ [3 4 5]
+ [6 7 8]
+ ]
+ pdl> p $piddle->range( ndcoords($piddle) )
+ [
+ [0 1 2]
+ [3 4 5]
+ [6 7 8]
+ ]
+
+Why would this be useful? Because now we can ask for a series of "boxes" for
+the entire piddle. For example, 2x2 boxes:
+
+ pdl> p $piddle->range( ndcoords($piddle) , 2 , "periodic" )
+
+The output of this function is difficult to read because the "boxes" along
+the last two dimension. We can make the result more readable by rearranging
+the dimensions:
+
+ pdl> p $piddle->range( ndcoords($piddle) , 2 , "periodic" )->reorder(2,3,0,1)
+ [
+ [
+ [
+ [0 1]
+ [3 4]
+ ]
+ [
+ [1 2]
+ [4 5]
+ ]
+ ...
+ ]
+
+Here you can see more clearly that
+
+ [0 1]
+ [3 4]
+
+Is the 2x2 box starting with the (0,0) element of C<$piddle>.
+
+We are not done yet. For the game of life, we want 3x3 boxes from C<$a>:
+
+ pdl> p $a
+ [
+ [ 0 1 2 3 4 5]
+ [ 6 7 8 9 10 11]
+ [12 13 14 15 16 17]
+ [18 19 20 21 22 23]
+ [24 25 26 27 28 29]
+ [30 31 32 33 34 35]
+ [36 37 38 39 40 41]
+ ]
+ pdl> p $a->range( ndcoords($a) , 3 , "periodic" )->reorder(2,3,0,1)
+ [
+ [
+ [
+ [ 0 1 2]
+ [ 6 7 8]
+ [12 13 14]
+ ]
+ ...
+ ]
+
+We can confirm that this is the 3x3 box starting with the (0,0) element of C<$a>.
+But there is one problem. We actually want the 3x3 box to be B<centered> on
+(0,0). That's not a problem. Just subtract 1 from all the coordinates in
+C<ndcoords($a)>. Remember that the "periodic" option takes care of making
+everything wrap around.
+
+ pdl> p $a->range( ndcoords($a) - 1 , 3 , "periodic" )->reorder(2,3,0,1)
+ [
+ [
+ [
+ [41 36 37]
+ [ 5 0 1]
+ [11 6 7]
+ ]
+ [
+ [36 37 38]
+ [ 0 1 2]
+ [ 6 7 8]
+ ]
+ ...
+
+Now we see a 3x3 box with the (0,0) element in the centre of the box.
+
+=head3 Method: C<sumover>
+
+The C<sumover> method adds along only the first dimension. If we apply it
+twice, we will be adding all the elements of each 3x3 box.
+
+ pdl> $n = $a->range(ndcoords($a)-1,3,"periodic")->reorder(2,3,0,1)
+ pdl> p $n
+ [
+ [
+ [
+ [41 36 37]
+ [ 5 0 1]
+ [11 6 7]
+ ]
+ [
+ [36 37 38]
+ [ 0 1 2]
+ [ 6 7 8]
+ ]
+ ...
+ pdl> p $n->sumover->sumover
+ [
+ [144 135 144 153 162 153]
+ [ 72 63 72 81 90 81]
+ [126 117 126 135 144 135]
+ [180 171 180 189 198 189]
+ [234 225 234 243 252 243]
+ [288 279 288 297 306 297]
+ [216 207 216 225 234 225]
+ ]
+
+Use a calculator to confirm that 144 is the sum of all the elements in the
+first 3x3 box and 135 is the sum of all the elements in the second 3x3 box.
+
+=head3 Counting neighbours
+
+We are almost there!
+
+Adding up all the elements in a 3x3 box is not B<quite> what we want. We
+don't want to count the center box. Fortunately, this is an easy fix:
+
+ pdl> p $n->sumover->sumover - $a
+ [
+ [144 134 142 150 158 148]
+ [ 66 56 64 72 80 70]
+ [114 104 112 120 128 118]
+ [162 152 160 168 176 166]
+ [210 200 208 216 224 214]
+ [258 248 256 264 272 262]
+ [180 170 178 186 194 184]
+ ]
+
+When applied to Conway's Game of Life, this will tell us how many living
+neighbours each cell has:
+
+ pdl> $a = zeroes(10,10)
+ pdl> $a(1:3,1:3) .= pdl ( [1,1,1],
+ ..( > [0,0,1],
+ ..( > [0,1,0] )
+ pdl> p $a
+ [
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 1 1 1 0 0 0 0 0 0]
+ [0 0 0 1 0 0 0 0 0 0]
+ [0 0 1 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ ]
+ pdl> $n = $a->range(ndcoords($a)-1,3,"periodic")->reorder(2,3,0,1)
+ pdl> $n = $n->sumover->sumover - $a
+ pdl> p $n
+ [
+ [1 2 3 2 1 0 0 0 0 0]
+ [1 1 3 2 2 0 0 0 0 0]
+ [1 3 5 3 2 0 0 0 0 0]
+ [0 1 1 2 1 0 0 0 0 0]
+ [0 1 1 1 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ ]
+
+For example, this tells us that cell (0,0) has 1 living neighbour, while
+cell (2,2) has 5 living neighbours.
+
+=head3 Calculating the next generation
+
+At this point, the variable C<$n> has the number of living neighbours for
+every cell. Now we apply the rules of the game of life to calculate the next
+generation.
+
+=over 5
+
+=item If an empty cell has exactly three neighbours, a living cell is generated.
+
+Get a list of cells that have exactly three neighbours:
+
+ pdl> p ($n == 3)
+ [
+ [0 0 1 0 0 0 0 0 0 0]
+ [0 0 1 0 0 0 0 0 0 0]
+ [0 1 0 1 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ ]
+
+Get a list of B<empty> cells that have exactly three neighbours:
+
+ pdl> p ($n == 3) * !$a
+
+=item If a living cell has less than 2 or more than 3 neighbours, it dies.
+
+Get a list of cells that have exactly 2 or 3 neighbours:
+
+ pdl> p (($n == 2) + ($n == 3))
+ [
+ [0 1 1 1 0 0 0 0 0 0]
+ [0 0 1 1 1 0 0 0 0 0]
+ [0 1 0 1 1 0 0 0 0 0]
+ [0 0 0 1 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ ]
+
+Get a list of B<living> cells that have exactly 2 or 3 neighbours:
+
+ pdl> p (($n == 2) + ($n == 3)) * $a
+
+=back
+
+Putting it all together, the next generation is:
+
+ pdl> $a = ((($n == 2) + ($n == 3)) * $a) + (($n == 3) * !$a)
+ pdl> p $a
+ [
+ [0 0 1 0 0 0 0 0 0 0]
+ [0 0 1 1 0 0 0 0 0 0]
+ [0 1 0 1 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ ]
+
+=head2 Bonus feature: Graphics!
+
+If you have L<PDL::Graphics::TriD|PDL::Graphics::TriD> installed, you can
+make a graphical version of the program by just changing three lines:
+
+ #!/usr/bin/perl
+ use PDL;
+ use PDL::NiceSlice;
+ use PDL::Graphics::TriD;
+
+ my $a = zeroes(20,20);
+
+ # Put in a simple glider.
+ $a(1:3,1:3) .= pdl ( [1,1,1],
+ [0,0,1],
+ [0,1,0] );
+
+ my $n;
+ for (my $i = 0; $i < 100; $i++) {
+ # Calculate the number of neighbours per cell.
+ $n = $a->range(ndcoords($a)-1,3,"periodic")->reorder(2,3,0,1);
+ $n = $n->sumover->sumover - $a;
+
+ # Calculate the next generation.
+ $a = ((($n == 2) + ($n == 3))* $a) + (($n==3) * !$a);
+
+ # Display.
+ nokeeptwiddling3d();
+ imagrgb [$a];
+ }
+
+
+But if we really want to see something interesting, we should make a few more
+changes:
+
+1) Start with a random collection of 1's and 0's.
+
+2) Make the grid larger.
+
+3) Add a small timeout so we can see the game evolve better.
+
+4) Use a while loop so that the program can run as long as it needs to.
+
+
+ #!/usr/bin/perl
+ use PDL;
+ use PDL::NiceSlice;
+ use PDL::Graphics::TriD;
+ use Time::HiRes qw(usleep);
+
+ my $a = random(100,100);
+ $a = ($a < 0.5);
+
+ my $n;
+ while (1) {
+ # Calculate the number of neighbours per cell.
+ $n = $a->range(ndcoords($a)-1,3,"periodic")->reorder(2,3,0,1);
+ $n = $n->sumover->sumover - $a;
+
+ # Calculate the next generation.
+ $a = ((($n == 2) + ($n == 3))* $a) + (($n==3) * !$a);
+
+ # Display.
+ nokeeptwiddling3d();
+ imagrgb [$a];
+
+ # Sleep for 0.1 seconds.
+ usleep(100000);
+ }
+
+
+=head1 CONCLUSION: GENERAL STRATEGY
+
+The general strategy is: I<Move the dimensions you want to operate on to the
+start of your piddle's dimension list. Then let PDL thread over the higher
+dimensions.>
+
+Threading is a powerful tool that helps eliminate for-loops and can make your
+code more concise. Hopefully this tutorial has shown why it is worth getting
+to grips with threading in PDL.
+
+
+=head1 COPYRIGHT
+
+Copyright 2010 Matthew Kenworthy (kenworthy at strw.leidenuniv.nl) and
+Daniel Carrera (dcarrera at gmail.com). You can distribute and/or modify this
+document under the same terms as the current Perl license.
+
+See: http://dev.perl.org/licenses/
+
+
diff --git a/Basic/Pod/Tips.pod b/Basic/Pod/Tips.pod
new file mode 100644
index 0000000..0331c51
--- /dev/null
+++ b/Basic/Pod/Tips.pod
@@ -0,0 +1,130 @@
+=head1 NAME
+
+PDL::Tips - Small tidbits of useful arcana. Programming tidbits and such.
+
+=head1 SYNOPSIS
+
+ use PDL;
+
+ # Whatever happens here.
+
+=head1 DESCRIPTION
+
+This page documents useful idioms, helpful hints and tips for using
+Perl Data Language v2.0.
+
+=head2 Help
+
+Use C<help help> within I<perldl> or I<pdl2> or use the C<pdldoc>
+program from the command line for access to the PerlDL documentation.
+HTML versions of the pages should also be present, in the
+F<HtmlDocs/PDL> directory of the PDL distribution. To find this
+directory, try the following
+
+ pdl> foreach ( map{"$_/PDL/HtmlDocs"}@INC ) { p "$_\n" if -d $_ }
+
+=head2 Indexing idioms
+
+The following code normalizes a bunch of vectors in $a.
+This works regardless of the dimensionality of $a.
+
+ $a /= $a->sumover->dummy(0);
+
+=head2 What is actually happening?
+
+If you want to see what the code is actually doing,
+try the command
+
+ PDL::Core::set_debugging(1);
+
+somewhere. This spews out a huge amount of debug info for PDL
+into STDOUT. Plans for the future include making it possible to
+redirect the output, and also making it possible to select mesages
+with more precision.
+
+Many of the messages come from C<Basic/Core/pdlapi.c> and you
+can look at the source to see what is going on.
+
+If you have any extra time to work on these mechanisms,
+inform the pdl-porters mailing list.
+
+=head2 Memory savings
+
+If you are running recursively something that selects certain
+indices of a large piddle, like
+
+ while(1) {
+ $inds = where($a>0);
+ $a = $a->index($inds);
+ $b = $b->index($inds);
+ func($b,$a);
+ }
+
+If you are not writing to $b, it saves a lot of memory to change this
+to
+
+ $b = $b->index($inds)->sever;
+
+The new method C<sever> is a causes the write-back relation to be
+forgotten. It is like copy except it changes the original piddle
+and returns it).
+
+Of course, the probably best way to do the above is
+
+ $inds = xvals ($a->long);
+ while(1) {
+ $inds0 = where($a>0);
+ $inds1 = $inds->index($inds)->sever;
+ $a = $a0->index($inds1);
+ $b = $b->index($inds1)->sever;
+ func($b,$a);
+ }
+
+which doesn't save all the temporary instances of $a in memory.
+See C<mandel.pl> in the Demos subdirectory of the PerlDL distribution
+for an example.
+
+=head2 PP speed
+
+If you really want to write speedy PP code, the first
+thing you need to do is to make sure that your C compiler
+is allowed to do the necessary optimizations.
+
+What this means is that you have to allow as many variables
+as possible to go into registers:
+
+ loop(a) %{
+ $a() += $COMP(foo_member) * $b()
+ %}
+
+expands to
+
+ for(i=0; i<10000; i++) {
+ a[i] += __privtrans->foo_member * b[i];
+ }
+
+is about the worst you can do, since your C compiler is not
+allowed to assume that C<a> doesn't clobber C<foo_member>
+which completely inhibits vectorization. Instead, do
+
+ float foo = $COMP(foo_member);
+ loop(a) %{
+ $a() += foo * $b();
+ %}
+
+This is not a restriction caused by PP but by ANSI C semantics.
+Of course, we could copy the struct into local variables and back but that
+could cause very strange things sometimes.
+
+There are many other issues on organizing loops.
+
+We are currently planning to make PP able to do fixed-width
+things as well as physical piddles (where looping over the first
+dimensions would be cheaper as there are less distinct increments,
+which might make a difference on machines with a small number of registers).
+
+=head1 AUTHOR
+
+Copyright (C) Tuomas J. Lukka 1997. All rights reserved.
+Duplication in the same form and printing a copy for yourself allowed.
+
diff --git a/Basic/Pod/Tutorials.pod b/Basic/Pod/Tutorials.pod
new file mode 100644
index 0000000..f7a6e5f
--- /dev/null
+++ b/Basic/Pod/Tutorials.pod
@@ -0,0 +1,131 @@
+=head1 NAME
+
+PDL::Tutorials - A guide to PDL's tutorial documentation.
+
+=head1 MIGRATION
+
+These are our migration guides for users familiar with other types
+of numerical analysis software.
+
+=over 5
+
+=item L<PDL::MATLAB|PDL::MATLAB>
+
+Migration guide for MATLAB users. This page explains the key differences
+between MATLAB and PDL from the point of view of a MATLAB user.
+
+=item L<PDL::Scilab|PDL::Scilab>
+
+Migration guide for Scilab users. This page explains the key differences
+between Scilab and PDL from the point of view of a Scilab user.
+
+=back
+
+
+
+=head1 FOUNDATION
+
+=over 5
+
+=item L<PDL::Philosophy|PDL::Philosophy>
+
+Why did we write PDL? This document explains some of the history and
+motivation behind the Perl Data Language. It is an attempt to answer
+the question "Why PDL?".
+
+=item L<PDL::QuickStart|PDL::QuickStart>
+
+Quick introduction to PDL features. A hands-on guide suitable for
+complete beginners. This page assumes no previous knowledge of Perl
+or PDL.
+
+=item L<PDL::Indexing|PDL::Indexing>
+
+After you have read the QuickStart guide, you should follow up with
+this document. This guide goes more deeply into the concepts of
+"indexing" and "slicing" and how they form the core of numerical
+analysis with PDL.
+
+
+=back
+
+
+
+=head1 INTERMEDIATE
+
+=over 5
+
+=item L<PDL::Threading|PDL::Threading>
+
+B<Threading> is one of PDL's most powerful features. If you know MATLAB,
+you've heard of "vectorizing". Well, B<threading> is like "vectorizing on
+steroids". It lets you make very fast and compact code by avoiding
+nested loops. All vector-based languages do this, but PDL generalizes
+the technique to all sorts of applications.
+
+This tutorial introduces PDL's threading feature, and it shows an example
+implementing Conway's Game of Life in 10 lines and 80 times faster than
+a classical implementation.
+
+=item L<PDL::BadValues|PDL::BadValues>
+
+Sometimes it is useful to specify that a certain value is "bad" or
+"missing". Scientific instruments some times include portions of
+invalid data. For example, a CCD camera might produce an image with
+over-exposed pixels. PDL's "bad values" feature gives you an easy way
+to deal with this sort of imperfect data.
+
+
+=item L<PDL::Tips|PDL::Tips>
+
+Tips and suggestions for using PDL. This page is an assorted collection
+of programming tidbits that some PDL users have found useful. Some of
+these tips might be of help when you write your programs.
+
+=back
+
+
+
+=head1 ADVANCED
+
+=over 5
+
+=item L<PDL::PP|PDL::PP>
+
+PDL's Pre-Processor is one of PDL's most powerful features. You
+write a function definition in special markup and the preprocessor
+generates real C code which can be compiled. With PDL:PP you get the
+full speed of native C code without having to deal with the full
+complexity of the C language.
+
+=item L<PDL::API|PDL::API>
+
+A simple cookbook explaining how to create piddle manually, either
+from Perl or from C/XS code. This page covers the PDL core routines
+that comprise the PDL API. If you need to access piddles from C/XS,
+this is the document for you.
+
+
+=item L<PDL::Internals|PDL::Internals>
+
+Description of the inner workings of the PDL module. Very few people
+need to see this. This page is mainly for PDL developers, or people
+interested in debugging PDL or changing the internals of PDL. If you
+can read this document and understand all of it, and you additionally
+understand L<PDL::PP|PDL::PP>, you will be awarded the title of
+"PDL Guru".
+
+
+=back
+
+
+
+=head1 COPYRIGHT
+
+Copyright 2010 Daniel Carrera (dcarrera at gmail.com). You can distribute
+and/or modify this document under the same terms as the current Perl
+license.
+
+See: http://dev.perl.org/licenses/
+
+
diff --git a/Basic/Primitive/Makefile.PL b/Basic/Primitive/Makefile.PL
new file mode 100644
index 0000000..63d840f
--- /dev/null
+++ b/Basic/Primitive/Makefile.PL
@@ -0,0 +1,58 @@
+
+# Makefile.PL for PDL::Primitive module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+use Config;
+
+PDL::Core::Dev->import();
+
+ at pack = (["primitive.pd",Primitive,PDL::Primitive]);
+
+if ($^O eq 'dec_osf') {
+ require Config;
+ if ($Config::Config{cc} =~ /^cc/) {
+ my $no_optimize = $::PDL_OPTIONS{OPTIMIZE}
+ || $Config::Config{optimize}
+ || '-g2';
+ $no_optimize =~ s/(\s|^)(-O)\d/$1${2}0/;
+ $no_optimize =~ s/(\s|^)(-g)\d/$1${2}2/;
+ print <<EOT;
+ Digital Unix cc optimizer has a bug that is
+ triggered by primitive.c. Therefore
+EOT
+ # Becaue OPTIMIZE in PASTHRU it can't be overridden so
+ # it gets hard coded in Makefile
+ eval q|
+ sub MY::const_cccmd {
+ package MY;
+ my $defval = shift->SUPER::const_cccmd(@_);
+ $defval =~ s/\$\(OPTIMIZE\)/|
+ . $no_optimize . q|/gs;
+ print "$defval\n";
+ return $defval;
+ };
+ |;
+ }
+}
+
+
+#WriteMakefile(
+# pdlpp_stdargs_int(@::pack)
+#);
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{LIBS}->[0] .= ' -lm';
+
+# If we don't do this, and Perl core is using the wrapped API, then it will
+# call (say) srand48_r(), and get its random numbers from drand48_r(), but we
+# will get ours from drand48(), and srand48() never gets called.
+$hash{CCFLAGS} ||= $Config{ccflags};
+$hash{CCFLAGS} .= ' -DPERL_REENTR_API';
+
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Basic/Primitive/primitive.pd b/Basic/Primitive/primitive.pd
new file mode 100644
index 0000000..17f09ad
--- /dev/null
+++ b/Basic/Primitive/primitive.pd
@@ -0,0 +1,3397 @@
+use strict;
+
+# check for bad value support
+use PDL::Config;
+my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
+
+pp_addhdr(<<'EOD');
+
+#ifndef RAND_MAX
+#error "You must have a working RAND_MAX! Something's wrong with your include files"
+#endif
+
+EOD
+
+pp_addpm({At=>'Top'},<<'EOD');
+
+use PDL::Slices;
+use Carp;
+
+=head1 NAME
+
+PDL::Primitive - primitive operations for pdl
+
+=head1 DESCRIPTION
+
+This module provides some primitive and useful functions defined
+using PDL::PP and able to use the new indexing tricks.
+
+See L<PDL::Indexing|PDL::Indexing> for how to use indices creatively.
+For explanation of the signature format, see L<PDL::PP|PDL::PP>.
+
+=head1 SYNOPSIS
+
+ # Pulls in PDL::Primitive, among other modules.
+ use PDL;
+
+ # Only pull in PDL::Primitive:
+ use PDL::Primitive;
+
+=cut
+
+EOD
+
+=head1 FUNCTIONS
+
+=cut
+
+################################################################
+# a whole bunch of quite basic functions for inner, outer
+# and matrix products (operations that are not normally
+# available via operator overloading)
+################################################################
+
+=head2 inner
+
+=for sig
+
+ Signature: (a(n); b(n); [o]c())
+
+=cut
+
+pp_def(
+ 'inner',
+ HandleBad => 1,
+ Pars => 'a(n); b(n); [o]c();',
+ Code =>
+ 'double tmp = 0;
+ loop(n) %{ tmp += $a() * $b(); %}
+ $c() = tmp;',
+ BadCode =>
+ 'double tmp = 0;
+ int badflag = 0;
+ loop(n) %{
+ if ( $ISGOOD(a()) && $ISGOOD(b()) ) { tmp += $a() * $b(); } else { badflag = 1; }
+ %}
+ if ( badflag ) { $SETBAD(c()); $PDLSTATESETBAD(c); }
+ else { $c() = tmp; }',
+ CopyBadStatusCode => '',
+ Doc => '
+
+=for ref
+
+Inner product over one dimension
+
+ c = sum_i a_i * b_i
+
+=cut
+
+',
+ BadDoc => '
+
+=for bad
+
+If C<a() * b()> contains only bad data,
+C<c()> is set bad. Otherwise C<c()> will have its bad flag cleared,
+as it will not contain any bad values.
+
+=cut
+
+',
+ ); # pp_def( inner )
+
+=head2 outer
+
+=for sig
+
+ Signature: (a(n); b(m); [o]c(n,m))
+
+=cut
+
+pp_def(
+ 'outer',
+ HandleBad => 1,
+ Pars => 'a(n); b(m); [o]c(n,m);',
+ Code =>
+ 'loop(n,m) %{
+ $c() = $a() * $b();
+ %}',
+ BadCode =>
+ 'loop(n,m) %{
+ if ( $ISBAD(a()) || $ISBAD(b()) ) {
+ $SETBAD(c());
+ } else {
+ $c() = $a() * $b();
+ }
+ %}',
+ Doc => '
+
+=for ref
+
+outer product over one dimension
+
+Naturally, it is possible to achieve the effects of outer
+product simply by threading over the "C<*>"
+operator but this function is provided for convenience.
+
+=cut
+
+'); # pp_def( outer )
+
+
+pp_addpm(<<'EOD');
+
+=head2 x
+
+=for sig
+
+ Signature: (a(i,z), b(x,i),[o]c(x,z))
+
+=for ref
+
+Matrix multiplication
+
+PDL overloads the C<x> operator (normally the repeat operator) for
+matrix multiplication. The number of columns (size of the 0
+dimension) in the left-hand argument must normally equal the number of
+rows (size of the 1 dimension) in the right-hand argument.
+
+Row vectors are represented as (N x 1) two-dimensional PDLs, or you
+may be sloppy and use a one-dimensional PDL. Column vectors are
+represented as (1 x N) two-dimensional PDLs.
+
+Threading occurs in the usual way, but as both the 0 and 1 dimension
+(if present) are included in the operation, you must be sure that
+you don't try to thread over either of those dims.
+
+EXAMPLES
+
+Here are some simple ways to define vectors and matrices:
+
+ pdl> $r = pdl(1,2); # A row vector
+ pdl> $c = pdl([[3],[4]]); # A column vector
+ pdl> $c = pdl(3,4)->(*1); # A column vector, using NiceSlice
+ pdl> $m = pdl([[1,2],[3,4]]); # A 2x2 matrix
+
+Now that we have a few objects prepared, here is how to
+matrix-multiply them:
+
+ pdl> print $r x $m # row x matrix = row
+ [
+ [ 7 10]
+ ]
+
+ pdl> print $m x $r # matrix x row = ERROR
+ PDL: Dim mismatch in matmult of [2x2] x [2x1]: 2 != 1
+
+ pdl> print $m x $c # matrix x column = column
+ [
+ [ 5]
+ [11]
+ ]
+
+ pdl> print $m x 2 # Trivial case: scalar mult.
+ [
+ [2 4]
+ [6 8]
+ ]
+
+ pdl> print $r x $c # row x column = scalar
+ [
+ [11]
+ ]
+
+ pdl> print $c x $r # column x row = matrix
+ [
+ [3 6]
+ [4 8]
+ ]
+
+
+INTERNALS
+
+The mechanics of the multiplication are carried out by the
+L<matmult|/matmult> method.
+
+=cut
+
+EOD
+
+pp_add_exported('', 'matmult');
+
+pp_def('matmult',
+ HandleBad=>0,
+ Pars => 'a(t,h); b(w,t); [o]c(w,h);',
+ PMCode => <<'EOPM',
+sub PDL::matmult {
+ my ($a,$b,$c) = @_;
+
+ $b = pdl($b) unless eval { $b->isa('PDL') };
+ $c = PDL->null unless eval { $c->isa('PDL') };
+
+ while($a->getndims < 2) {$a = $a->dummy(-1)}
+ while($b->getndims < 2) {$b = $b->dummy(-1)}
+
+ return ($c .= $a * $b) if( ($a->dim(0)==1 && $a->dim(1)==1) ||
+ ($b->dim(0)==1 && $b->dim(1)==1) );
+ if($b->dim(1) != $a->dim(0)) {
+ barf(sprintf("Dim mismatch in matmult of [%dx%d] x [%dx%d]: %d != %d",$a->dim(0),$a->dim(1),$b->dim(0),$b->dim(1),$a->dim(0),$b->dim(1)));
+ }
+ PDL::_matmult_int($a,$b,$c);
+ $c;
+}
+EOPM
+ Code => <<'EOC',
+ PDL_Indx ih, iw, it, ow, oh, ot, wlim, hlim, tlim;
+ $GENERIC() *ad, *bd, *cd;
+ PDL_Indx atdi, btdi;
+ PDL_Indx resh, resw, rest;
+ PDL_Indx tsiz = 64;
+
+ // Zero the output
+ loop(w) %{
+ loop(h) %{
+ $c() = 0;
+ %}
+ %}
+
+ // Make sure we're physical
+ // (Not needed if we don't need dimincs, see below)
+ // PDL->make_physdims($PDL(a));
+ // PDL->make_physdims($PDL(b));
+
+ // Cache the dimincs to avoid constant lookups
+ // These two lines are what I wanted, but they break sometimes (dimincs not set right despite calling physdims?)
+ // I deleted them in favor of explicit offset calculation, which appears more robust.
+ // atdi = $PDL(a)->dimincs[0];
+ // btdi = $PDL(b)->dimincs[1];
+ atdi = &($a(t=>1, h=>0)) - &($a(t=>0,h=>0));
+ btdi = &($b(t=>1, w=>0)) - &($b(t=>0,w=>0));
+
+
+ // Loop over tiles
+ for( oh=0; oh < $SIZE(h); oh += tsiz ) {
+ hlim = ( oh + tsiz > $SIZE(h) ) ? $SIZE(h) : oh + tsiz;
+
+ for( ow=0; ow < $SIZE(w); ow += tsiz ) {
+ wlim = ( ow + tsiz > $SIZE(w) ) ? $SIZE(w) : ow + tsiz;
+
+ for( ot=0; ot < $SIZE(t); ot += tsiz ) {
+ tlim = (ot + tsiz > $SIZE(t) ) ? $SIZE(t) : ot + tsiz;
+
+
+ for( ih=oh; ih<hlim; ih++ ) {
+ for( iw=ow; iw<wlim; iw++ ) {
+ $GENERIC() cc;
+
+ // Cache data pointers before 't' run through tile
+ ad = &($a(t=>ot, h=>ih));
+ bd = &($b(w=>iw, t=>ot));
+
+ // Cache the accumulated value for the output
+ cc = $c(w=>iw, h=>ih);
+
+ // Hotspot - run the 't' summation
+ for( it=ot; it<tlim; it++ ) {
+ cc += *ad * *bd;
+ ad += atdi;
+ bd += btdi;
+ }
+
+ // put the output back to be further accumulated later
+ $c(w=>iw, h=>ih) = cc;
+ }
+ }
+ }
+ }
+ }
+EOC
+ Doc => <<'EOD'
+=for ref
+
+Matrix multiplication
+
+Notionally, matrix multiplication $a x $b is equivalent to the
+threading expression
+
+ $a->dummy(1)->inner($b->xchg(0,1)->dummy(2),$c);
+
+but for large matrices that breaks CPU cache and is slow. Instead,
+matmult calculates its result in 32x32x32 tiles, to keep the memory
+footprint within cache as long as possible on most modern CPUs.
+
+For usage, see L<x|/x>, a description of the overloaded 'x' operator
+
+EOD
+ );
+
+=head2 innerwt
+
+=for sig
+
+ Signature: (a(n); b(n); c(n); [o]d())
+
+=cut
+
+pp_def(
+ 'innerwt',
+ HandleBad => 1,
+ Pars => 'a(n); b(n); c(n); [o]d();',
+ Code =>
+ 'double tmp = 0;
+ loop(n) %{
+ tmp += $a() * $b() * $c();
+ %}
+ $d() = tmp;',
+ BadCode =>
+ 'double tmp = 0;
+ int flag = 0;
+
+ loop(n) %{
+ if ( $ISGOOD(a()) && $ISGOOD(b()) && $ISGOOD(c()) ) {
+ tmp += $a() * $b() * $c();
+ flag = 1;
+ }
+ %}
+ if ( flag ) { $d() = tmp; }
+ else { $SETBAD(d()); }',
+ Doc => '
+
+=for ref
+
+Weighted (i.e. triple) inner product
+
+ d = sum_i a(i) b(i) c(i)
+
+=cut
+
+'
+ );
+
+=head2 inner2
+
+=for sig
+
+ Signature: (a(n); b(n,m); c(m); [o]d())
+
+=cut
+
+pp_def(
+ 'inner2',
+ HandleBad => 1,
+ Pars => 'a(n); b(n,m); c(m); [o]d();',
+ Code =>
+ 'double tmp=0;
+ loop(n,m) %{
+ tmp += $a() * $b() * $c();
+ %}
+ $d() = tmp;',
+ BadCode =>
+ 'double tmp = 0;
+ int flag = 0;
+ loop(n,m) %{
+ if ( $ISGOOD(a()) && $ISGOOD(b()) && $ISGOOD(c()) ) {
+ tmp += $a() * $b() * $c();
+ flag = 1;
+ }
+ %}
+ if ( flag ) { $d() = tmp; }
+ else { $SETBAD(d()); }',
+ Doc => '
+
+=for ref
+
+Inner product of two vectors and a matrix
+
+ d = sum_ij a(i) b(i,j) c(j)
+
+Note that you should probably not thread over C<a> and C<c> since that would be
+very wasteful. Instead, you should use a temporary for C<b*c>.
+
+=cut
+
+'
+ );
+
+=head2 inner2d
+
+=for sig
+
+ Signature: (a(n,m); b(n,m); [o]c())
+
+=cut
+
+pp_def(
+ 'inner2d',
+ HandleBad => 1,
+ Pars => 'a(n,m); b(n,m); [o]c();',
+ Code =>
+ 'double tmp=0;
+ loop(n,m) %{
+ tmp += $a() * $b();
+ %}
+ $c() = tmp;',
+ BadCode =>
+ 'double tmp = 0;
+ int flag = 0;
+ loop(n,m) %{
+ if ( $ISGOOD(a()) && $ISGOOD(b()) ) {
+ tmp += $a() * $b();
+ flag = 1;
+ }
+ %}
+ if ( flag ) { $c() = tmp; }
+ else { $SETBAD(c()); }',
+ Doc => '
+
+=for ref
+
+Inner product over 2 dimensions.
+
+Equivalent to
+
+ $c = inner($a->clump(2), $b->clump(2))
+
+=cut
+
+'
+ );
+
+=head2 inner2t
+
+=for sig
+
+ Signature: (a(j,n); b(n,m); c(m,k); [t]tmp(n,k); [o]d(j,k)))
+
+=cut
+
+pp_def(
+ 'inner2t',
+ HandleBad => 1,
+ Pars => 'a(j,n); b(n,m); c(m,k); [t]tmp(n,k); [o]d(j,k));',
+ Code =>
+ 'loop(n,k) %{
+ double tmp0 = 0;
+ loop(m) %{
+ tmp0 += $b() * $c();
+ %}
+ $tmp() = tmp0;
+ %}
+ loop(j,k) %{
+ double tmp1 = 0;
+ loop(n) %{
+ tmp1 += $a() * $tmp();
+ %}
+ $d() = tmp1;
+ %}',
+ BadCode =>
+ 'loop(n,k) %{
+ double tmp0 = 0;
+ int flag = 0;
+ loop(m) %{
+ if ( $ISGOOD(b()) && $ISGOOD(c()) ) {
+ tmp0 += $b() * $c();
+ flag = 1;
+ }
+ %}
+ if ( flag ) { $tmp() = tmp0; }
+ else { $SETBAD(tmp()); }
+ %}
+ loop(j,k) %{
+ double tmp1 = 0;
+ int flag = 0;
+ loop(n) %{
+ if ( $ISGOOD(a()) && $ISGOOD(tmp()) ) {
+ tmp1 += $a() * $tmp();
+ flag = 1;
+ }
+ %}
+ if ( flag ) { $d() = tmp1; }
+ else { $SETBAD(d()); }
+ %}',
+ Doc => '
+
+=for ref
+
+Efficient Triple matrix product C<a*b*c>
+
+Efficiency comes from by using the temporary C<tmp>. This operation only
+scales as C<N**3> whereas threading using L<inner2|/inner2> would scale
+as C<N**4>.
+
+The reason for having this routine is that you do not need to
+have the same thread-dimensions for C<tmp> as for the other arguments,
+which in case of large numbers of matrices makes this much more
+memory-efficient.
+
+It is hoped that things like this could be taken care of as a kind of
+closures at some point.
+
+=cut
+
+'
+ ); # pp_def inner2t()
+
+
+# a helper function for the cross product definition
+sub crassgn {
+ "\$c(tri => $_[0]) = \$a(tri => $_[1])*\$b(tri => $_[2]) -
+ \$a(tri => $_[2])*\$b(tri => $_[1]);"
+}
+
+=head2 crossp
+
+=for sig
+
+ Signature: (a(tri=3); b(tri); [o] c(tri))
+
+=cut
+
+pp_def('crossp',
+ Doc => <<'EOD',
+
+=for ref
+
+Cross product of two 3D vectors
+
+After
+
+=for example
+
+ $c = crossp $a, $b
+
+the inner product C<$c*$a> and C<$c*$b> will be zero, i.e. C<$c> is
+orthogonal to C<$a> and C<$b>
+
+=cut
+
+EOD
+ Pars => 'a(tri=3); b(tri); [o] c(tri)',
+ Code =>
+ crassgn(0,1,2)."\n".
+ crassgn(1,2,0)."\n".
+ crassgn(2,0,1),
+ );
+
+=head2 norm
+
+=for sig
+
+ Signature: (vec(n); [o] norm(n))
+
+Normalises a vector to unit Euclidean length
+
+=cut
+
+pp_def('norm',
+ HandleBad => 1,
+ Pars => 'vec(n); [o] norm(n)',
+ Doc => 'Normalises a vector to unit Euclidean length',
+ Code =>
+ 'double sum=0;
+ loop(n) %{ sum += $vec()*$vec(); %}
+ if (sum > 0) {
+ sum = sqrt(sum);
+ loop(n) %{ $norm() = $vec()/sum; %}
+ } else {
+ loop(n) %{ $norm() = $vec(); %}
+ }',
+ BadCode =>
+ 'double sum=0;
+ int flag = 0;
+ loop(n) %{
+ if ( $ISGOOD(vec()) ) {
+ sum += $vec()*$vec();
+ flag = 1;
+ }
+ %}
+ if ( flag ) {
+ if (sum > 0) {
+ sum = sqrt(sum);
+ loop(n) %{
+ if ( $ISBAD(vec()) ) { $SETBAD(norm()); }
+ else { $norm() = $vec()/sum; }
+ %}
+ } else {
+ loop(n) %{
+ if ( $ISBAD(vec()) ) { $SETBAD(norm()); }
+ else { $norm() = $vec(); }
+ %}
+ }
+ } else {
+ loop(n) %{
+ $SETBAD(norm());
+ %}
+ }',
+);
+
+# this one was motivated by the need to compute
+# the circular mean efficiently
+# without it could not be done efficiently or without
+# creating large intermediates (check pdl-porters for
+# discussion)
+# see PDL::ImageND for info about the circ_mean function
+
+=head2 indadd
+
+=for sig
+
+ Signature: (a(); indx ind(); [o] sum(m))
+
+=cut
+
+pp_def(
+ 'indadd',
+ HandleBad => 1,
+ Pars => 'a(); indx ind(); [o] sum(m)',
+ Code =>
+ 'register PDL_Indx foo = $ind();
+ if( foo<0 || foo>=$SIZE(m) ) {
+ barf("PDL::indadd: invalid index");
+ }
+ $sum(m => foo) += $a();',
+ BadCode =>
+ 'register PDL_Indx foo = $ind();
+ if( $ISBADVAR(foo,ind) || foo<0 || foo>=$SIZE(m) ) {
+ barf("PDL::indadd: invalid index");
+ }
+ if ( $ISBAD(a()) ) { $SETBAD(sum(m => foo)); }
+ else { $sum(m => foo) += $a(); }',
+ BadDoc => '
+
+=for bad
+
+The routine barfs if any of the indices are bad.
+
+=cut
+
+',
+ Doc=>'
+
+=for ref
+
+Threaded Index Add: Add C<a> to the C<ind> element of C<sum>, i.e:
+
+ sum(ind) += a
+
+=for example
+
+Simple Example:
+
+ $a = 2;
+ $ind = 3;
+ $sum = zeroes(10);
+ indadd($a,$ind, $sum);
+ print $sum
+ #Result: ( 2 added to element 3 of $sum)
+ # [0 0 0 2 0 0 0 0 0 0]
+
+Threaded Example:
+
+ $a = pdl( 1,2,3);
+ $ind = pdl( 1,4,6);
+ $sum = zeroes(10);
+ indadd($a,$ind, $sum);
+ print $sum."\n";
+ #Result: ( 1, 2, and 3 added to elements 1,4,6 $sum)
+ # [0 1 0 0 2 0 3 0 0 0]
+
+=cut
+
+');
+
+=head2 conv1d
+
+=for sig
+
+ Signature: (a(m); kern(p); [o]b(m); int reflect)
+
+=cut
+
+# 1D convolution
+# useful for threaded 1D filters
+pp_addhdr('
+/* Fast Modulus with proper negative behaviour */
+#define REALMOD(a,b) while ((a)>=(b)) (a) -= (b); while ((a)<0) (a) += (b);
+');
+pp_def('conv1d',
+ Doc => << 'EOD',
+
+=for ref
+
+1D convolution along first dimension
+
+The m-th element of the discrete convolution of an input piddle
+C<$a> of size C<$M>, and a kernel piddle C<$kern> of size C<$P>, is
+calculated as
+
+ n = ($P-1)/2
+ ====
+ \
+ ($a conv1d $kern)[m] = > $a_ext[m - n] * $kern[n]
+ /
+ ====
+ n = -($P-1)/2
+
+where C<$a_ext> is either the periodic (or reflected) extension of
+C<$a> so it is equal to C<$a> on C< 0..$M-1 > and equal to the
+corresponding periodic/reflected image of C<$a> outside that range.
+
+
+=for example
+
+ $con = conv1d sequence(10), pdl(-1,0,1);
+
+ $con = conv1d sequence(10), pdl(-1,0,1), {Boundary => 'reflect'};
+
+By default, periodic boundary conditions are assumed (i.e. wrap around).
+Alternatively, you can request reflective boundary conditions using
+the C<Boundary> option:
+
+ {Boundary => 'reflect'} # case in 'reflect' doesn't matter
+
+The convolution is performed along the first dimension. To apply it across
+another dimension use the slicing routines, e.g.
+
+ $b = $a->mv(2,0)->conv1d($kernel)->mv(0,2); # along third dim
+
+This function is useful for threaded filtering of 1D signals.
+
+Compare also L<conv2d|PDL::Image2D/conv2d>, L<convolve|PDL::ImageND/convolve>,
+L<fftconvolve|PDL::FFT/fftconvolve()>, L<fftwconv|PDL::FFTW/fftwconv>,
+L<rfftwconv|PDL::FFTW/rfftwconv>
+
+=for bad
+
+WARNING: C<conv1d> processes bad values in its inputs as
+the numeric value of C<< $pdl->badvalue >> so it is not
+recommended for processing pdls with bad values in them
+unless special care is taken.
+
+=cut
+
+EOD
+ Pars => 'a(m); kern(p); [o]b(m);',
+ OtherPars => 'int reflect;',
+ HandleBad => 0,
+ PMCode => '
+
+sub PDL::conv1d {
+ my $opt = pop @_ if ref($_[$#_]) eq \'HASH\';
+ die \'Usage: conv1d( a(m), kern(p), [o]b(m), {Options} )\'
+ if $#_<1 || $#_>2;
+ my($a,$kern) = @_;
+ my $c = $#_ == 2 ? $_[2] : PDL->null;
+ &PDL::_conv1d_int($a,$kern,$c,
+ !(defined $opt && exists $$opt{Boundary}) ? 0 :
+ lc $$opt{Boundary} eq "reflect");
+ return $c;
+}
+
+',
+ Code => '
+ int i,i1,i2,poff,pflip;
+ double tmp;
+ int reflect = $COMP(reflect);
+ int m_size = $COMP(__m_size);
+ int p_size = $COMP(__p_size);
+
+ poff = (p_size-1)/2;
+ for(i=0; i<m_size; i++) {
+ tmp = 0;
+ for(i1=0; i1<p_size; i1++) {
+ pflip = p_size - 1 - i1;
+ i2 = i+i1 - poff;
+ if (reflect && i2<0)
+ i2 = -i2;
+ if (reflect && i2>=m_size)
+ i2 = m_size-(i2-m_size+1);
+
+ REALMOD(i2,m_size);
+ tmp += $a(m=>i2) * $kern(p=>pflip);
+ }
+ $b(m=>i) = tmp;
+ }
+');
+
+
+=head2 in
+
+=for sig
+
+ Signature: (a(); b(n); [o] c())
+
+=cut
+
+# this can be achieved by
+# ($a->dummy(0) == $b)->orover
+# but this one avoids a larger intermediate and potentially shortcuts
+pp_def('in',
+ Pars => 'a(); b(n); [o] c()',
+ Code => '$c() = 0;
+ loop(n) %{ if ($a() == $b()) {$c() = 1; break;} %}',
+ Doc => <<'EOD',
+
+=for ref
+
+test if a is in the set of values b
+
+=for example
+
+ $goodmsk = $labels->in($goodlabels);
+ print pdl(3,1,4,6,2)->in(pdl(2,3,3));
+ [1 0 0 0 1]
+
+C<in> is akin to the I<is an element of> of set theory. In priciple,
+PDL threading could be used to achieve its functionality by using a
+construct like
+
+ $msk = ($labels->dummy(0) == $goodlabels)->orover;
+
+However, C<in> doesn't create a (potentially large) intermediate
+and is generally faster.
+
+=cut
+
+EOD
+);
+
+
+pp_add_exported ('', 'uniq');
+pp_addpm (<< 'EOPM');
+
+=head2 uniq
+
+=for ref
+
+return all unique elements of a piddle
+
+The unique elements are returned in ascending order.
+
+=for example
+
+ PDL> p pdl(2,2,2,4,0,-1,6,6)->uniq
+ [-1 0 2 4 6] # 0 is returned 2nd (sorted order)
+
+ PDL> p pdl(2,2,2,4,nan,-1,6,6)->uniq
+ [-1 2 4 6 nan] # NaN value is returned at end
+
+Note: The returned pdl is 1D; any structure of the input
+piddle is lost. C<NaN> values are never compare equal to
+any other values, even themselves. As a result, they are
+always unique. C<uniq> returns the NaN values at the end
+of the result piddle. This follows the Matlab usage.
+
+See L<uniqind|uniqind> if you need the indices of the unique
+elements rather than the values.
+
+=cut
+
+EOPM
+
+if ( $bvalflag ) {
+ pp_addpm(<<'EOPM');
+
+=for bad
+
+Bad values are not considered unique by uniq and are ignored.
+
+ $a=sequence(10);
+ $a=$a->setbadif($a%3);
+ print $a->uniq;
+ [0 3 6 9]
+
+=cut
+
+EOPM
+} # if: $bvalflag
+
+pp_addpm(<<'EOPM');
+
+*uniq = \&PDL::uniq;
+# return unique elements of array
+# find as jumps in the sorted array
+# flattens in the process
+sub PDL::uniq {
+ use PDL::Core 'barf';
+ my ($arr) = @_;
+ return $arr if($arr->nelem == 0); # The null list is unique (CED)
+ my $srt = $arr->clump(-1)->where($arr==$arr)->qsort; # no NaNs or BADs for qsort
+ my $nans = $arr->clump(-1)->where($arr!=$arr);
+ my $uniq = ($srt->nelem > 0) ? $srt->where($srt != $srt->rotate(-1)) : $srt;
+ # make sure we return something if there is only one value
+ my $answ = $nans; # NaN values always uniq
+ if ( $uniq->nelem > 0 ) {
+ $answ = $uniq->append($answ);
+ } else {
+ $answ = ( ($srt->nelem == 0) ? $srt : PDL::pdl( ref($srt), [$srt->index(0)] ) )->append($answ);
+ }
+ return $answ;
+}
+
+EOPM
+
+pp_add_exported ('', 'uniqind');
+pp_addpm (<< 'EOPM');
+
+=head2 uniqind
+
+=for ref
+
+Return the indices of all unique elements of a piddle
+The order is in the order of the values to be consistent
+with uniq. C<NaN> values never compare equal with any
+other value and so are always unique. This follows the
+Matlab usage.
+
+=for example
+
+ PDL> p pdl(2,2,2,4,0,-1,6,6)->uniqind
+ [5 4 1 3 6] # the 0 at index 4 is returned 2nd, but...
+
+ PDL> p pdl(2,2,2,4,nan,-1,6,6)->uniqind
+ [5 1 3 6 4] # ...the NaN at index 4 is returned at end
+
+
+Note: The returned pdl is 1D; any structure of the input
+piddle is lost.
+
+See L<uniq|uniq> if you want the unique values instead of the
+indices.
+
+=cut
+
+EOPM
+
+if ($bvalflag ) {
+ pp_addpm(<<'EOPM');
+
+=for bad
+
+Bad values are not considered unique by uniqind and are ignored.
+
+=cut
+
+EOPM
+} # if: $bvalflag
+
+pp_addpm(<<'EOPM');
+
+*uniqind = \&PDL::uniqind;
+# return unique elements of array
+# find as jumps in the sorted array
+# flattens in the process
+sub PDL::uniqind {
+ use PDL::Core 'barf';
+ my ($arr) = @_;
+ return $arr if($arr->nelem == 0); # The null list is unique (CED)
+ # Different from uniq we sort and store the result in an intermediary
+ my $aflat = $arr->flat;
+ my $nanind = which($aflat!=$aflat); # NaN indexes
+ my $good = $aflat->sequence->long->where($aflat==$aflat); # good indexes
+ my $i_srt = $aflat->where($aflat==$aflat)->qsorti; # no BAD or NaN values for qsorti
+ my $srt = $aflat->where($aflat==$aflat)->index($i_srt);
+ my $uniqind;
+ if ($srt->nelem > 0) {
+ $uniqind = which($srt != $srt->rotate(-1));
+ $uniqind = $i_srt->slice('0') if $uniqind->isempty;
+ } else {
+ $uniqind = which($srt);
+ }
+ # Now map back to the original space
+ my $ansind = $nanind;
+ if ( $uniqind->nelem > 0 ) {
+ $ansind = ($good->index($i_srt->index($uniqind)))->append($ansind);
+ } else {
+ $ansind = $uniqind->append($ansind);
+ }
+ return $ansind;
+}
+
+EOPM
+
+pp_add_exported ('', 'uniqvec');
+pp_addpm (<< 'EOPM');
+
+=head2 uniqvec
+
+=for ref
+
+Return all unique vectors out of a collection
+
+ NOTE: If any vectors in the input piddle have NaN values
+ they are returned at the end of the non-NaN ones. This is
+ because, by definition, NaN values never compare equal with
+ any other value.
+
+ NOTE: The current implementation does not sort the vectors
+ containing NaN values.
+
+The unique vectors are returned in lexicographically sorted
+ascending order. The 0th dimension of the input PDL is treated
+as a dimensional index within each vector, and the 1st and any
+higher dimensions are taken to run across vectors. The return
+value is always 2D; any structure of the input PDL (beyond using
+the 0th dimension for vector index) is lost.
+
+See also L<uniq|uniq> for a uniqe list of scalars; and
+L<qsortvec|PDL::Ufunc/qsortvec> for sorting a list of vectors
+lexicographcally.
+
+=cut
+
+EOPM
+
+if ( $bvalflag ) {
+pp_addpm(<<'EOPM');
+
+=for bad
+
+If a vector contains all bad values, it is ignored as in L<uniq|uniq>.
+If some of the values are good, it is treated as a normal vector. For
+example, [1 2 BAD] and [BAD 2 3] could be returned, but [BAD BAD BAD]
+could not. Vectors containing BAD values will be returned after any
+non-NaN and non-BAD containing vectors, followed by the NaN vectors.
+
+
+=cut
+
+EOPM
+} # if: $bvalflag
+
+pp_addpm(<<'EOPM');
+
+sub PDL::uniqvec {
+
+ my($pdl) = shift;
+
+ return $pdl if ( $pdl->nelem == 0 || $pdl->ndims < 2 );
+ return $pdl if ( $pdl->slice("(0)")->nelem < 2 ); # slice isn't cheap but uniqvec isn't either
+
+ my $pdl2d = null;
+ $pdl2d = $pdl->mv(0,-1)->clump($pdl->ndims-1)->mv(-1,0); # clump all but dim(0)
+
+ my $ngood = null;
+ $ngood = $pdl2d->ones->sumover;
+ $ngood = $pdl2d->ngoodover if ($PDL::Bad::Status && $pdl->badflag); # number of good values each vector
+ my $ngood2 = null;
+ $ngood2 = $ngood->where($ngood); # number of good values with no all-BADs
+
+ $pdl2d = $pdl2d->mv(0,-1)->dice($ngood->which)->mv(-1,0); # remove all-BAD vectors
+
+
+ my $numnan = null;
+ $numnan = ($pdl2d!=$pdl2d)->sumover; # works since no all-BADs to confuse
+
+ my $presrt = null;
+ $presrt = $pdl2d->mv(0,-1)->dice($numnan->not->which)->mv(0,-1); # remove vectors with any NaN values
+ my $nanvec = null;
+ $nanvec = $pdl2d->mv(0,-1)->dice($numnan->which)->mv(0,-1); # the vectors with any NaN values
+
+ # use dice instead of nslice since qsortvec might be packing
+ # the badvals to the front of the array instead of the end like
+ # the docs say. If that is the case and it gets fixed, it won't
+ # bust uniqvec. DAL 14-March 2006
+
+ my $srt = null;
+ $srt = $presrt->qsortvec->mv(0,-1); # BADs are sorted by qsortvec
+ my $srtdice = $srt;
+ my $somebad = null;
+ if ($PDL::Bad::Status && $srt->badflag) {
+ $srtdice = $srt->dice($srt->mv(0,-1)->nbadover->not->which);
+ $somebad = $srt->dice($srt->mv(0,-1)->nbadover->which);
+ }
+
+ my $uniq = null;
+ if ($srtdice->nelem > 0) {
+ $uniq = ($srtdice != $srtdice->rotate(-1))->mv(0,-1)->orover->which;
+ } else {
+ $uniq = $srtdice->orover->which;
+ }
+
+ my $ans = null;
+ if ( $uniq->nelem > 0 ) {
+ $ans = $srtdice->dice($uniq);
+ } else {
+ $ans = ($srtdice->nelem > 0) ? $srtdice->slice("0,:") : $srtdice;
+ }
+ return $ans->append($somebad)->append($nanvec->mv(0,-1))->mv(0,-1);
+}
+
+EOPM
+
+#####################################################################
+# clipping routines
+#####################################################################
+
+# clipping
+
+=head2 hclip
+
+=for sig
+
+ Signature: (a(); b(); [o] c())
+
+clip (threshold) C<$a> by C<$b> (C<$b> is upper bound)
+
+=head2 lclip
+
+=for sig
+
+ Signature: (a(); b(); [o] c())
+
+clip (threshold) C<$a> by C<$b> (C<$b> is lower bound)
+
+=cut
+
+for my $opt (
+ ['hclip','>'],
+ ['lclip','<']
+ ) {
+ my $name = $opt->[0];
+ my $op = $opt->[1];
+ pp_def(
+ $name,
+ HandleBad => 1,
+ Pars => 'a(); b(); [o] c()',
+ Code =>
+ '$c() = ($a() '.$op.' $b()) ? $b() : $a();',
+ BadCode =>
+ 'if ( $ISBAD(a()) || $ISBAD(b()) ) {
+ $SETBAD(c());
+ } else {
+ $c() = ($a() '.$op.' $b()) ? $b() : $a();
+ }',
+ Doc => 'clip (threshold) C<$a> by C<$b> (C<$b> is '.
+ ($name eq 'hclip' ? 'upper' : 'lower').' bound)',
+ PMCode=><<"EOD",
+sub PDL::$name {
+ my (\$a,\$b) = \@_;
+ my \$c;
+ if (\$a->is_inplace) {
+ \$a->set_inplace(0); \$c = \$a;
+ } elsif (\$#_ > 1) {\$c=\$_[2]} else {\$c=PDL->nullcreate(\$a)}
+ &PDL::_${name}_int(\$a,\$b,\$c);
+ return \$c;
+}
+EOD
+ ); # pp_def $name
+
+} # for: my $opt
+
+pp_add_exported('', 'clip');
+
+pp_addpm(<<'EOD');
+
+=head2 clip
+
+=for ref
+
+Clip (threshold) a piddle by (optional) upper or lower bounds.
+
+=for usage
+
+ $b = $a->clip(0,3);
+ $c = $a->clip(undef, $x);
+
+=cut
+
+EOD
+
+ if ( $bvalflag ) {
+ pp_addpm(<<'EOD');
+
+=for bad
+
+clip handles bad values since it is just a
+wrapper around L<hclip|/hclip> and
+L<lclip|/lclip>.
+
+=cut
+
+EOD
+} # if: $bvalflag
+
+pp_addpm(<<'EOD');
+*clip = \&PDL::clip;
+sub PDL::clip {
+ my($a, $b, $c) = @_;
+ my $d; if($a->is_inplace) {$a->set_inplace(0); $d = $a}
+ elsif($#_ > 2) {$d=$_[3]} else {$d = PDL->nullcreate($a)}
+ if(defined $b) {
+ &PDL::_lclip_int($a,$b,$d);
+ if(defined $c) {
+ &PDL::_hclip_int($d,$c,$d);
+ }
+ } elsif(defined $c) {
+ &PDL::_hclip_int($a,$c,$d);
+ }
+ return $d;
+}
+
+EOD
+
+############################################################
+# elementary statistics and histograms
+############################################################
+
+=head2 wtstat
+
+=for sig
+
+ Signature: (a(n); wt(n); avg(); [o]b(); int deg)
+
+=cut
+
+pp_def(
+ 'wtstat',
+ HandleBad => 1,
+ Pars => 'a(n); wt(n); avg(); [o]b();',
+ OtherPars => 'int deg',
+ Code =>
+ 'double wtsum = 0;
+ double statsum = 0;
+ loop(n) %{
+ register double tmp;
+ register int i;
+ wtsum += $wt();
+ tmp=1;
+ for(i=0; i<$COMP(deg); i++)
+ tmp *= $a();
+ statsum += $wt() * (tmp - $avg());
+ %}
+ $b() = statsum / wtsum;',
+ BadCode =>
+ 'double wtsum = 0;
+ double statsum = 0;
+ int flag = 0;
+ loop(n) %{
+ if ( $ISGOOD(wt()) && $ISGOOD(a()) && $ISGOOD(avg()) ) {
+ register double tmp;
+ register int i;
+ wtsum += $wt();
+ tmp=1;
+ for(i=0; i<$COMP(deg); i++)
+ tmp *= $a();
+ statsum += $wt() * (tmp - $avg());
+ flag = 1;
+ }
+ %}
+ if ( flag ) { $b() = statsum / wtsum; }
+ else { $SETBAD(b()); $PDLSTATESETBAD(b); }',
+ CopyBadStatusCode => '',
+ Doc => '
+
+=for ref
+
+Weighted statistical moment of given degree
+
+This calculates a weighted statistic over the vector C<a>.
+The formula is
+
+ b() = (sum_i wt_i * (a_i ** degree - avg)) / (sum_i wt_i)
+
+=cut
+
+',
+ BadDoc => '
+
+=for bad
+
+Bad values are ignored in any calculation; C<$b> will only
+have its bad flag set if the output contains any bad data.
+
+=cut
+
+',
+ );
+
+
+
+pp_def('statsover',
+ HandleBad => 1,
+ Pars => 'a(n); w(n); float+ [o]avg(); float+ [o]prms(); int+ [o]median(); int+ [o]min(); int+ [o]max(); float+ [o]adev(); float+ [o]rms()',
+ Code =>
+ '$GENERIC(avg) tmp = 0;
+ $GENERIC(avg) tmp1 = 0;
+ $GENERIC(avg) diff = 0;
+ $GENERIC(min) curmin, curmax;
+ $GENERIC(avg) norm = 0;
+ loop(n) %{ /* Accumulate sum and summed weight. */
+ tmp += $a()*$w();
+ norm += ($GENERIC(avg)) $w();
+ if (!n) { curmin = $a(); curmax = $a();}
+ if ($a() < curmin) {
+ curmin = $a();
+ } else if ($a() > curmax) {
+ curmax = $a();
+ }
+ %}
+ $avg() = tmp / norm; /* Find mean */
+ $min() = curmin;
+ $max() = curmax;
+
+ /* Calculate the RMS and standard deviation. */
+ tmp = 0;
+ loop(n) %{
+ diff = ($a() - $avg());
+ tmp += diff * diff * $w();
+ tmp1 += fabs(diff) * $w();
+ %}
+ $rms() = sqrt ( tmp/norm );
+ $prms() = (norm>1) ? sqrt( tmp/(norm-1) ) : 0;
+ $adev() = tmp1/norm ;
+',
+ BadCode =>
+ '$GENERIC(avg) tmp = 0;
+ $GENERIC(avg) tmp1 = 0;
+ $GENERIC(avg) diff = 0;
+ $GENERIC(min) curmin, curmax;
+ $GENERIC(w) norm = 0;
+ int flag = 0;
+ loop(n) %{
+ /* perhaps should check w() for bad values too ? */
+ if ( $ISGOOD(a()) ) {
+ tmp += $a()*$w();
+ norm += $w();
+ if (!flag) { curmin = $a(); curmax = $a(); flag=1; }
+ if ($a() < curmin) {
+ curmin = $a();
+ } else if ($a() > curmax) {
+ curmax = $a();
+ }
+ }
+ %}
+ /* have at least one valid point if flag == 1 */
+ if ( flag ) {
+ $avg() = tmp / norm; /* Find mean */
+ $min() = curmin;
+ $max() = curmax;
+
+ /* Calculate the RMS and standard deviation. */
+ tmp = 0;
+ loop(n) %{
+ if ($ISGOOD(a())) {
+ diff = $a()-$avg();
+ tmp += diff * diff * $w();
+ tmp1 += fabs(diff) * $w();
+ }
+ %}
+ $rms() = sqrt( tmp/norm );
+ if(norm>1)
+ $prms() = sqrt( tmp/(norm-1) );
+ else
+ $SETBAD(prms());
+ $adev() = tmp1 / norm ;
+ } else {
+ $SETBAD(avg());
+ $SETBAD(rms());
+ $SETBAD(adev());
+ $SETBAD(min());
+ $SETBAD(max());
+ $SETBAD(prms());
+ }',
+ PMCode => '
+
+sub PDL::statsover {
+ barf(\'Usage: ($mean,[$prms, $median, $min, $max, $adev, $rms]) = statsover($data,[$weights])\') if $#_>1;
+ my ($data, $weights) = @_;
+ $weights = $data->ones() if !defined($weights);
+
+ my $median = $data->medover();
+ my $mean = PDL->nullcreate($data);
+ my $rms = PDL->nullcreate($data);
+ my $min = PDL->nullcreate($data);
+ my $max = PDL->nullcreate($data);
+ my $adev = PDL->nullcreate($data);
+ my $prms = PDL->nullcreate($data);
+ &PDL::_statsover_int($data, $weights, $mean, $prms, $median, $min, $max, $adev, $rms);
+
+ return $mean unless wantarray;
+ return ($mean, $prms, $median, $min, $max, $adev, $rms);
+}
+
+',
+ Doc => '
+
+=for ref
+
+Calculate useful statistics over a dimension of a piddle
+
+=for usage
+
+ ($mean,$prms,$median,$min,$max,$adev,$rms) = statsover($piddle, $weights);
+
+This utility function calculates various useful
+quantities of a piddle. These are:
+
+=over 3
+
+=item * the mean:
+
+ MEAN = sum (x)/ N
+
+with C<N> being the number of elements in x
+
+=item * the population RMS deviation from the mean:
+
+ PRMS = sqrt( sum( (x-mean(x))^2 )/(N-1)
+
+The population deviation is the best-estimate of the deviation
+of the population from which a sample is drawn.
+
+=item * the median
+
+The median is the 50th percentile data value. Median is found by
+L<medover|PDL::Ufunc/medover>, so WEIGHTING IS IGNORED FOR THE MEDIAN CALCULATION.
+
+=item * the minimum
+
+=item * the maximum
+
+=item * the average absolute deviation:
+
+ AADEV = sum( abs(x-mean(x)) )/N
+
+=item * RMS deviation from the mean:
+
+ RMS = sqrt(sum( (x-mean(x))^2 )/N)
+
+(also known as the root-mean-square deviation, or the square root of the
+variance)
+
+=back
+
+This operator is a projection operator so the calculation
+will take place over the final dimension. Thus if the input
+is N-dimensional each returned value will be N-1 dimensional,
+to calculate the statistics for the entire piddle either
+use C<clump(-1)> directly on the piddle or call C<stats>.
+
+=cut
+
+',
+ BadDoc =>'
+
+=for bad
+
+Bad values are simply ignored in the calculation, effectively reducing
+the sample size. If all data are bad then the output data are marked bad.
+
+=cut
+
+',
+);
+
+pp_add_exported('','stats');
+pp_addpm(<<'EOD');
+
+=head2 stats
+
+=for ref
+
+Calculates useful statistics on a piddle
+
+=for usage
+
+ ($mean,$prms,$median,$min,$max,$adev,$rms) = stats($piddle,[$weights]);
+
+This utility calculates all the most useful quantities in one call.
+It works the same way as L</statsover>, except that the quantities are
+calculated considering the entire input PDL as a single sample, rather
+than as a collection of rows. See L</statsover> for definitions of the
+returned quantities.
+
+=cut
+
+EOD
+
+ if ( $bvalflag ) {
+ pp_addpm(<<'EOD');
+
+=for bad
+
+Bad values are handled; if all input values are bad, then all of the output
+values are flagged bad.
+
+=cut
+
+EOD
+} # if: bvalflag
+pp_addpm(<<'EOD');
+*stats = \&PDL::stats;
+sub PDL::stats {
+ barf('Usage: ($mean,[$rms]) = stats($data,[$weights])') if $#_>1;
+ my ($data,$weights) = @_;
+
+ # Ensure that $weights is properly threaded over; this could be
+ # done rather more efficiently...
+ if(defined $weights) {
+ $weights = pdl($weights) unless UNIVERSAL::isa($weights,'PDL');
+ if( ($weights->ndims != $data->ndims) or
+ (pdl($weights->dims) != pdl($data->dims))->or
+ ) {
+ $weights = $weights + zeroes($data)
+ }
+ $weights = $weights->flat;
+ }
+
+ return PDL::statsover($data->flat,$weights);
+}
+EOD
+
+=head2 histogram
+
+=for sig
+
+ Signature: (in(n); int+[o] hist(m); double step; double min; int msize => m)
+
+=cut
+
+my $histogram_doc = <<'EOD';
+
+=for ref
+
+Calculates a histogram for given stepsize and minimum.
+
+=for usage
+
+ $h = histogram($data, $step, $min, $numbins);
+ $hist = zeroes $numbins; # Put histogram in existing piddle.
+ histogram($data, $hist, $step, $min, $numbins);
+
+The histogram will contain C<$numbins> bins starting from C<$min>, each
+C<$step> wide. The value in each bin is the number of
+values in C<$data> that lie within the bin limits.
+
+
+Data below the lower limit is put in the first bin, and data above the
+upper limit is put in the last bin.
+
+The output is reset in a different threadloop so that you
+can take a histogram of C<$a(10,12)> into C<$b(15)> and get the result
+you want.
+
+For a higher-level interface, see L<hist|PDL::Basic/hist>.
+
+=for example
+
+ pdl> p histogram(pdl(1,1,2),1,0,3)
+ [0 2 1]
+
+=cut
+
+EOD
+
+=head2 whistogram
+
+=for sig
+
+ Signature: (in(n); float+ wt(n);float+[o] hist(m); double step; double min; int msize => m)
+
+=cut
+
+my $whistogram_doc = <<'EOD';
+
+=for ref
+
+Calculates a histogram from weighted data for given stepsize and minimum.
+
+=for usage
+
+ $h = whistogram($data, $weights, $step, $min, $numbins);
+ $hist = zeroes $numbins; # Put histogram in existing piddle.
+ whistogram($data, $weights, $hist, $step, $min, $numbins);
+
+The histogram will contain C<$numbins> bins starting from C<$min>, each
+C<$step> wide. The value in each bin is the sum of the values in C<$weights>
+that correspond to values in C<$data> that lie within the bin limits.
+
+Data below the lower limit is put in the first bin, and data above the
+upper limit is put in the last bin.
+
+The output is reset in a different threadloop so that you
+can take a histogram of C<$a(10,12)> into C<$b(15)> and get the result
+you want.
+
+=for example
+
+ pdl> p whistogram(pdl(1,1,2), pdl(0.1,0.1,0.5), 1, 0, 4)
+ [0 0.2 0.5 0]
+
+=cut
+
+EOD
+
+
+for(
+ {Name => 'histogram',
+ WeightPar => '',
+ HistType => 'int+',
+ HistOp => '++',
+ Doc => $histogram_doc,
+ },
+ {Name => 'whistogram',
+ WeightPar => 'float+ wt(n);',
+ HistType => 'float+',
+ HistOp => '+= $wt()',
+ Doc => $whistogram_doc,
+ }
+ )
+{
+pp_def($_->{Name},
+ Pars => 'in(n); '.$_->{WeightPar}.$_->{HistType}. '[o] hist(m)',
+ # set outdim by Par!
+ OtherPars => 'double step; double min; int msize => m',
+ HandleBad => 1,
+ Code =>
+ 'register int j;
+ register int maxj = $SIZE(m)-1;
+ register double min = $COMP(min);
+ register double step = $COMP(step);
+ threadloop %{
+ loop(m) %{ $hist() = 0; %}
+ %}
+ threadloop %{
+ loop(n) %{
+ j = (int) (($in()-min)/step);
+ if (j<0) j=0;
+ if (j > maxj) j = maxj;
+ ($hist(m => j))'.$_->{HistOp}.';
+ %}
+ %}',
+ BadCode =>
+ 'register int j;
+ register int maxj = $SIZE(m)-1;
+ register double min = $COMP(min);
+ register double step = $COMP(step);
+ threadloop %{
+ loop(m) %{ $hist() = 0; %}
+ %}
+ threadloop %{
+ loop(n) %{
+ if ( $ISGOOD(in()) ) {
+ j = (int) (($in()-min)/step);
+ if (j<0) j=0;
+ if (j > maxj) j = maxj;
+ ($hist(m => j))'.$_->{HistOp}.';
+ }
+ %}
+ %}',
+ Doc=>$_->{Doc});
+}
+
+=head2 histogram2d
+
+=for sig
+
+ Signature: (ina(n); inb(n); int+[o] hist(ma,mb); double stepa; double mina; int masize => ma;
+ double stepb; double minb; int mbsize => mb;)
+
+=cut
+
+my $histogram2d_doc = <<'EOD';
+
+=for ref
+
+Calculates a 2d histogram.
+
+=for usage
+
+ $h = histogram2d($datax, $datay, $stepx, $minx,
+ $nbinx, $stepy, $miny, $nbiny);
+ $hist = zeroes $nbinx, $nbiny; # Put histogram in existing piddle.
+ histogram2d($datax, $datay, $hist, $stepx, $minx,
+ $nbinx, $stepy, $miny, $nbiny);
+
+The histogram will contain C<$nbinx> x C<$nbiny> bins, with the lower
+limits of the first one at C<($minx, $miny)>, and with bin size
+C<($stepx, $stepy)>.
+The value in each bin is the number of
+values in C<$datax> and C<$datay> that lie within the bin limits.
+
+Data below the lower limit is put in the first bin, and data above the
+upper limit is put in the last bin.
+
+=for example
+
+ pdl> p histogram2d(pdl(1,1,1,2,2),pdl(2,1,1,1,1),1,0,3,1,0,3)
+ [
+ [0 0 0]
+ [0 2 2]
+ [0 1 0]
+ ]
+
+=cut
+
+EOD
+
+=head2 whistogram2d
+
+=for sig
+
+ Signature: (ina(n); inb(n); float+ wt(n);float+[o] hist(ma,mb); double stepa; double mina; int masize => ma;
+ double stepb; double minb; int mbsize => mb;)
+
+=cut
+
+my $whistogram2d_doc = <<'EOD';
+
+=for ref
+
+Calculates a 2d histogram from weighted data.
+
+=for usage
+
+ $h = whistogram2d($datax, $datay, $weights,
+ $stepx, $minx, $nbinx, $stepy, $miny, $nbiny);
+ $hist = zeroes $nbinx, $nbiny; # Put histogram in existing piddle.
+ whistogram2d($datax, $datay, $weights, $hist,
+ $stepx, $minx, $nbinx, $stepy, $miny, $nbiny);
+
+The histogram will contain C<$nbinx> x C<$nbiny> bins, with the lower
+limits of the first one at C<($minx, $miny)>, and with bin size
+C<($stepx, $stepy)>.
+The value in each bin is the sum of the values in
+C<$weights> that correspond to values in C<$datax> and C<$datay> that lie within the bin limits.
+
+Data below the lower limit is put in the first bin, and data above the
+upper limit is put in the last bin.
+
+=for example
+
+ pdl> p whistogram2d(pdl(1,1,1,2,2),pdl(2,1,1,1,1),pdl(0.1,0.2,0.3,0.4,0.5),1,0,3,1,0,3)
+ [
+ [ 0 0 0]
+ [ 0 0.5 0.9]
+ [ 0 0.1 0]
+ ]
+
+
+=cut
+
+EOD
+
+
+for(
+ {Name => 'histogram2d',
+ WeightPar => '',
+ HistType => 'int+',
+ HistOp => '++',
+ Doc => $histogram2d_doc,
+ },
+ {Name => 'whistogram2d',
+ WeightPar => 'float+ wt(n);',
+ HistType => 'float+',
+ HistOp => '+= $wt()',
+ Doc => $whistogram2d_doc,
+ }
+ )
+{
+pp_def($_->{Name},
+ Pars => 'ina(n); inb(n); '.$_->{WeightPar}.$_->{HistType}. '[o] hist(ma,mb)',
+ # set outdim by Par!
+ OtherPars => 'double stepa; double mina; int masize => ma;
+ double stepb; double minb; int mbsize => mb;',
+ HandleBad => 1,
+ Code =>
+ 'register int ja,jb;
+ register int maxja = $SIZE(ma)-1;
+ register int maxjb = $SIZE(mb)-1;
+ register double mina = $COMP(mina);
+ register double minb = $COMP(minb);
+ register double stepa = $COMP(stepa);
+ register double stepb = $COMP(stepb);
+ threadloop %{
+ loop(ma,mb) %{ $hist() = 0; %}
+ %}
+ threadloop %{
+ loop(n) %{
+ ja = (int) (($ina()-mina)/stepa);
+ jb = (int) (($inb()-minb)/stepb);
+ if (ja<0) ja=0;
+ if (ja > maxja) ja = maxja;
+ if (jb<0) jb=0;
+ if (jb > maxjb) jb = maxjb;
+ ($hist(ma => ja,mb => jb))'.$_->{HistOp}.';
+ %}
+ %}
+ ',
+ BadCode =>
+ 'register int ja,jb;
+ register int maxja = $SIZE(ma)-1;
+ register int maxjb = $SIZE(mb)-1;
+ register double mina = $COMP(mina);
+ register double minb = $COMP(minb);
+ register double stepa = $COMP(stepa);
+ register double stepb = $COMP(stepb);
+ threadloop %{
+ loop(ma,mb) %{ $hist() = 0; %}
+ %}
+ threadloop %{
+ loop(n) %{
+ if ( $ISGOOD(ina()) && $ISGOOD(inb()) ) {
+ ja = (int) (($ina()-mina)/stepa);
+ jb = (int) (($inb()-minb)/stepb);
+ if (ja<0) ja=0;
+ if (ja > maxja) ja = maxja;
+ if (jb<0) jb=0;
+ if (jb > maxjb) jb = maxjb;
+ ($hist(ma => ja,mb => jb))'.$_->{HistOp}.';
+ }
+ %}
+ %}
+ ',
+ Doc=> $_->{Doc});
+}
+
+
+###########################################################
+# a number of constructors: fibonacci, append, axisvalues &
+# random numbers
+###########################################################
+
+=head2 fibonacci
+
+=for sig
+
+ Signature: ([o]x(n))
+
+Constructor - a vector with Fibonacci's sequence
+
+=cut
+
+pp_def('fibonacci',
+ Pars => '[o]x(n);',
+ Doc=>'Constructor - a vector with Fibonacci\'s sequence',
+ PMFunc=>'',
+ PMCode=><<'EOD',
+sub fibonacci { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->fibonacci : PDL->fibonacci(@_) }
+sub PDL::fibonacci{
+ my $class = shift;
+ my $x = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
+ &PDL::_fibonacci_int($x->clump(-1));
+ return $x;
+}
+EOD
+ Code => '
+ PDL_Indx i=0;
+ $GENERIC() x1, x2;
+
+ x1 = 1; x2 = 0;
+
+ loop(n) %{
+ $x() = x1 + x2;
+ if (i++>0) {
+ x2 = x1;
+ x1 = $x();
+ }
+ %}
+');
+
+=head2 append
+
+=for sig
+
+ Signature: (a(n); b(m); [o] c(mn))
+
+=cut
+
+pp_def('append',
+ Pars => 'a(n); b(m); [o] c(mn)',
+# note that ideally we want to say '$SIZE(mn) = $SIZE(m)+$SIZE(n);'
+# but that requires placing RedoDimsParsedCode *after* assignment of
+# childdims to $SIZE(XXX)!!! XXXXXmake that workXXXXX
+ RedoDimsCode => '
+ pdl * dpdla = $PDL(a);
+ pdl * dpdlb = $PDL(b);
+ $SIZE(mn) = (dpdla->ndims > 0 ? dpdla->dims[0] : 1) +
+ (dpdlb->ndims > 0 ? dpdlb->dims[0] : 1);
+ ',
+ Code => 'register PDL_Indx mnp;
+ PDL_Indx ns = $SIZE(n);
+ threadloop %{
+ loop(n) %{ $c(mn => n) = $a(); %}
+ loop(m) %{ mnp = m+ns; $c(mn => mnp) = $b(); %}
+ %}',
+ Doc => '
+
+=for ref
+
+append two or more piddles by concatenating along their first dimensions
+
+=for example
+
+ $a = ones(2,4,7);
+ $b = sequence 5;
+ $c = $a->append($b); # size of $c is now (7,4,7) (a jumbo-piddle ;)
+
+C<append> appends two piddles along their first dims. Rest of the dimensions
+must be compatible in the threading sense. Resulting size of first dim is
+the sum of the sizes of the first dims of the two argument piddles -
+ie C<n + m>.
+
+Similar functions include L<glue|/glue> (below) and L<cat|PDL::Core/cat>.
+
+=cut
+
+'
+ );
+
+pp_addpm(<<'EOD')
+
+=head2 glue
+
+=for usage
+
+ $c = $a->glue(<dim>,$b,...)
+
+=for ref
+
+Glue two or more PDLs together along an arbitrary dimension
+(N-D L<append|append>).
+
+Sticks $a, $b, and all following arguments together along the
+specified dimension. All other dimensions must be compatible in the
+threading sense.
+
+Glue is permissive, in the sense that every PDL is treated as having an
+infinite number of trivial dimensions of order 1 -- so C<< $a->glue(3,$b) >>
+works, even if $a and $b are only one dimensional.
+
+If one of the PDLs has no elements, it is ignored. Likewise, if one
+of them is actually the undefined value, it is treated as if it had no
+elements.
+
+If the first parameter is a defined perl scalar rather than a pdl,
+then it is taken as a dimension along which to glue everything else,
+so you can say C<$cube = PDL::glue(3, at image_list);> if you like.
+
+C<glue> is implemented in pdl, using a combination of L<xchg|PDL::Slices/xchg> and
+L<append|append>. It should probably be updated (one day) to a pure PP
+function.
+
+Similar functions include L<append|/append> (above) and L<cat|PDL::Core/cat>.
+
+=cut
+
+sub PDL::glue{
+ my($a) = shift;
+ my($dim) = shift;
+
+ if(defined $a && !(ref $a)) {
+ my $b = $dim;
+ $dim = $a;
+ $a = $b;
+ }
+
+ if(!defined $a || $a->nelem==0) {
+ return $a unless(@_);
+ return shift() if(@_<=1);
+ $a=shift;
+ return PDL::glue($a,$dim, at _);
+ }
+
+ if($dim - $a->dim(0) > 100) {
+ print STDERR "warning:: PDL::glue allocating >100 dimensions!\n";
+ }
+ while($dim >= $a->ndims) {
+ $a = $a->dummy(-1,1);
+ }
+ $a = $a->xchg(0,$dim);
+
+ while(scalar(@_)){
+ my $b = shift;
+ next unless(defined $b && $b->nelem);
+
+ while($dim >= $b->ndims) {
+ $b = $b->dummy(-1,1);
+ }
+ $b = $b->xchg(0,$dim);
+ $a = $a->append($b);
+ }
+ $a->xchg(0,$dim);
+}
+
+
+
+
+EOD
+;
+
+=head2 axisvalues
+
+=for sig
+
+ Signature: ([o,nc]a(n))
+
+=cut
+
+pp_def( 'axisvalues',
+ Pars => '[o,nc]a(n)',
+ Code => 'loop(n) %{ $a() = n; %}',
+ Doc => '
+
+=for ref
+
+Internal routine
+
+C<axisvalues> is the internal primitive that implements
+L<axisvals|PDL::Basic/axisvals>
+and alters its argument.
+
+=cut
+
+'
+ ); # pp_def: axisvalues
+
+
+pp_addpm(<<'EOD');
+
+=head2 random
+
+=for ref
+
+Constructor which returns piddle of random numbers
+
+=for usage
+
+ $a = random([type], $nx, $ny, $nz,...);
+ $a = random $b;
+
+etc (see L<zeroes|PDL::Core/zeroes>).
+
+This is the uniform distribution between 0 and 1 (assumedly
+excluding 1 itself). The arguments are the same as C<zeroes>
+(q.v.) - i.e. one can specify dimensions, types or give
+a template.
+
+You can use the perl function L<srand|perlfunc/srand> to seed the random
+generator. For further details consult Perl's L<srand|perlfunc/srand>
+documentation.
+
+=head2 randsym
+
+=for ref
+
+Constructor which returns piddle of random numbers
+
+=for usage
+
+ $a = randsym([type], $nx, $ny, $nz,...);
+ $a = randsym $b;
+
+etc (see L<zeroes|PDL::Core/zeroes>).
+
+This is the uniform distribution between 0 and 1 (excluding both 0 and
+1, cf L<random|/random>). The arguments are the same as C<zeroes> (q.v.) -
+i.e. one can specify dimensions, types or give a template.
+
+You can use the perl function L<srand|perlfunc/srand> to seed the random
+generator. For further details consult Perl's L<srand|perlfunc/srand>
+documentation.
+
+=cut
+
+EOD
+
+pp_addhdr(<<'EOH');
+
+#ifndef Drand01
+#define Drand01() (((double)rand()) / (RAND_MAX+1.0))
+#endif
+
+EOH
+
+pp_def(
+ 'random',
+ Pars=>'a();',
+ PMFunc => '',
+ Code =>
+ '$a() = Drand01();',
+ 'NoPthread' => 1, # random isn't threadsafe
+ Doc=>undef,
+ PMCode=><<'EOD',
+sub random { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->random : PDL->random(@_) }
+sub PDL::random {
+ my $class = shift;
+ my $x = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
+ &PDL::_random_int($x);
+ return $x;
+}
+EOD
+);
+
+pp_def(
+ 'randsym',
+ 'NoPthread' => 1, # random isn't threadsafe
+ Pars=>'a();',
+ PMFunc => '',
+ Code =>
+ 'double tmp;
+ do tmp = Drand01(); while (tmp == 0.0); /* 0 < tmp < 1 */
+ $a() = tmp;',
+ Doc=>undef,
+ PMCode=><<'EOD',
+sub randsym { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->randsym : PDL->randsym(@_) }
+sub PDL::randsym {
+ my $class = shift;
+ my $x = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
+ &PDL::_randsym_int($x);
+ return $x;
+}
+EOD
+);
+
+pp_addpm(<<'EOD');
+
+=head2 grandom
+
+=for ref
+
+Constructor which returns piddle of Gaussian random numbers
+
+=for usage
+
+ $a = grandom([type], $nx, $ny, $nz,...);
+ $a = grandom $b;
+
+etc (see L<zeroes|PDL::Core/zeroes>).
+
+This is generated using the math library routine C<ndtri>.
+
+Mean = 0, Stddev = 1
+
+
+You can use the perl function L<srand|perlfunc/srand> to seed the random
+generator. For further details consult Perl's L<srand|perlfunc/srand>
+documentation.
+
+=cut
+
+sub grandom { ref($_[0]) && ref($_[0]) ne 'PDL::Type' ? $_[0]->grandom : PDL->grandom(@_) }
+sub PDL::grandom {
+ my $class = shift;
+ my $x = scalar(@_)? $class->new_from_specification(@_) : $class->new_or_inplace;
+ use PDL::Math 'ndtri';
+ $x .= ndtri(randsym($x));
+ return $x;
+}
+
+EOD
+
+pp_add_exported('','grandom');
+
+###############################################################
+# routines somehow related to interpolation
+###############################################################
+
+=head2 vsearch
+
+=for sig
+
+ Signature: (i(); x(n); indx [o]ip())
+
+=cut
+
+# The last x is ignored...
+pp_def('vsearch',
+ HandleBad => 0,
+ BadDoc => 'needs major (?) work to handles bad values',
+ Pars => 'i(); x(n); indx [o]ip()',
+ GenericTypes => ['F','D'], # too restrictive ?
+ Code => 'int carp=0;
+ threadloop %{
+ PDL_Indx n1 = $SIZE(n)-1;
+ PDL_Indx jl=-1, jh=n1, m;
+ int up = ($x(n => n1) > $x(n => 0));
+ $GENERIC() d;
+ while (jh-jl > 1) /* binary search */
+ {
+ m = (jh+jl) >> 1;
+ if ($i() > $x(n => m) == up)
+ jl = m;
+ else
+ jh = m;
+ }
+ if (jl == -1) {
+ jh = 0;
+ } else if (jl == n1) {
+ if ($i() != $x(n => n1)) carp = 1;
+ jh = n1;
+ } else {
+ jh = jl+1;
+ }
+ $ip() = jh;
+ %}
+ if (carp) warn("some values had to be extrapolated");
+', Doc=><<'EOD');
+
+=for ref
+
+routine for searching 1D values i.e. step-function interpolation.
+
+=for usage
+
+ $inds = vsearch($vals, $xs);
+
+Returns for each value of C<$vals> the index of the least larger member
+of C<$xs> (which need to be in increasing order). If the value is larger
+than any member of C<$xs>, the index to the last element of C<$xs> is
+returned.
+
+=for example
+
+This function is useful e.g. when you have a list of probabilities
+for events and want to generate indices to events:
+
+ $a = pdl(.01,.86,.93,1); # Barnsley IFS probabilities cumulatively
+ $b = random 20;
+ $c = vsearch($b, $a); # Now, $c will have the appropriate distr.
+
+It is possible to use the L<cumusumover|PDL::Ufunc/cumusumover>
+function to obtain cumulative probabilities from absolute probabilities.
+
+=cut
+
+EOD
+
+=head2 interpolate
+
+=for sig
+
+ Signature: (xi(); x(n); y(n); [o] yi(); int [o] err())
+
+=cut
+
+pp_def('interpolate',
+ HandleBad => 0,
+ BadDoc => 'needs major (?) work to handles bad values',
+ Pars => 'xi(); x(n); y(n); [o] yi(); int [o] err()',
+ GenericTypes => ['F','D'], # too restrictive ?
+ Code => '
+ $GENERIC() d;
+ PDL_Indx n = $SIZE(n);
+ PDL_Indx n1 = n-1;
+ int up = ($x(n => n1) > $x(n => 0));
+ PDL_Indx jl, jh, m;
+ int carp;
+
+ threadloop %{
+ jl = -1;
+ jh = n;
+ carp = 0;
+ while (jh-jl > 1) /* binary search */
+ {
+ m = (jh+jl) >> 1;
+ if ($xi() > $x(n => m) == up)
+ jl = m;
+ else
+ jh = m;
+ }
+ if (jl == -1) {
+ if ($xi() != $x(n => 0)) carp = 1;
+ jl = 0;
+ } else if (jh == n) {
+ if ($xi() != $x(n => n1)) carp = 1;
+ jl = n1-1;
+ }
+ jh = jl+1;
+ if ((d = $x(n => jh)-$x(n => jl)) == 0)
+ barf("identical abscissas");
+ d = ($x(n => jh)-$xi())/d;
+ $yi() = d*$y(n => jl) + (1-d)*$y(n => jh);
+ $err() = carp;
+ %}
+', Doc=><<'EOD');
+
+=for ref
+
+routine for 1D linear interpolation
+
+=for usage
+
+ ( $yi, $err ) = interpolate($xi, $x, $y)
+
+Given a set of points C<($x,$y)>, use linear interpolation
+to find the values C<$yi> at a set of points C<$xi>.
+
+C<interpolate> uses a binary search to find the suspects, er...,
+interpolation indices and therefore abscissas (ie C<$x>)
+have to be I<strictly> ordered (increasing or decreasing).
+For interpolation at lots of
+closely spaced abscissas an approach that uses the last index found as
+a start for the next search can be faster (compare Numerical Recipes
+C<hunt> routine). Feel free to implement that on top of the binary
+search if you like. For out of bounds values it just does a linear
+extrapolation and sets the corresponding element of C<$err> to 1,
+which is otherwise 0.
+
+See also L<interpol|/interpol>, which uses the same routine,
+differing only in the handling of extrapolation - an error message
+is printed rather than returning an error piddle.
+
+=cut
+
+EOD
+
+pp_add_exported('', 'interpol');
+pp_addpm(<<'EOD');
+
+=head2 interpol
+
+=for sig
+
+ Signature: (xi(); x(n); y(n); [o] yi())
+
+=for ref
+
+routine for 1D linear interpolation
+
+=for usage
+
+ $yi = interpol($xi, $x, $y)
+
+C<interpol> uses the same search method as L<interpolate|/interpolate>,
+hence C<$x> must be I<strictly> ordered (either increasing or decreasing).
+The difference occurs in the handling of out-of-bounds values; here
+an error message is printed.
+
+=cut
+
+# kept in for backwards compatability
+sub interpol ($$$;$) {
+ my $xi = shift;
+ my $x = shift;
+ my $y = shift;
+
+ my $yi;
+ if ( $#_ == 0 ) { $yi = $_[0]; }
+ else { $yi = PDL->null; }
+
+ interpolate( $xi, $x, $y, $yi, my $err = PDL->null );
+ print "some values had to be extrapolated\n"
+ if any $err;
+
+ return $yi if $#_ == -1;
+
+} # sub: interpol()
+*PDL::interpol = \&interpol;
+
+EOD
+
+pp_add_exported('','interpND');
+pp_addpm(<<'EOD');
+
+=head2 interpND
+
+=for ref
+
+Interpolate values from an N-D piddle, with switchable method
+
+=for example
+
+ $source = 10*xvals(10,10) + yvals(10,10);
+ $index = pdl([[2.2,3.5],[4.1,5.0]],[[6.0,7.4],[8,9]]);
+ print $source->interpND( $index );
+
+InterpND acts like L<indexND|PDL::Slices/indexND>,
+collapsing C<$index> by lookup
+into C<$source>; but it does interpolation rather than direct sampling.
+The interpolation method and boundary condition are switchable via
+an options hash.
+
+By default, linear or sample interpolation is used, with constant
+value outside the boundaries of the source pdl. No dataflow occurs,
+because in general the output is computed rather than indexed.
+
+All the interpolation methods treat the pixels as value-centered, so
+the C<sample> method will return C<< $a->(0) >> for coordinate values on
+the set [-0.5,0.5), and all methods will return C<< $a->(1) >> for
+a coordinate value of exactly 1.
+
+
+Recognized options:
+
+=over 3
+
+=item method
+
+Values can be:
+
+=over 3
+
+=item * 0, s, sample, Sample (default for integer source types)
+
+The nearest value is taken. Pixels are regarded as centered on their
+respective integer coordinates (no offset from the linear case).
+
+=item * 1, l, linear, Linear (default for floating point source types)
+
+The values are N-linearly interpolated from an N-dimensional cube of size 2.
+
+=item * 3, c, cube, cubic, Cubic
+
+The values are interpolated using a local cubic fit to the data. The
+fit is constrained to match the original data and its derivative at the
+data points. The second derivative of the fit is not continuous at the
+data points. Multidimensional datasets are interpolated by the
+successive-collapse method.
+
+(Note that the constraint on the first derivative causes a small amount
+of ringing around sudden features such as step functions).
+
+=item * f, fft, fourier, Fourier
+
+The source is Fourier transformed, and the interpolated values are
+explicitly calculated from the coefficients. The boundary condition
+option is ignored -- periodic boundaries are imposed.
+
+If you pass in the option "fft", and it is a list (ARRAY) ref, then it
+is a stash for the magnitude and phase of the source FFT. If the list
+has two elements then they are taken as already computed; otherwise
+they are calculated and put in the stash.
+
+=back
+
+=item b, bound, boundary, Boundary
+
+This option is passed unmodified into L<indexND|PDL::Slices/indexND>,
+which is used as the indexing engine for the interpolation.
+Some current allowed values are 'extend', 'periodic', 'truncate', and 'mirror'
+(default is 'truncate').
+
+=item bad
+
+contains the fill value used for 'truncate' boundary. (default 0)
+
+=item fft
+
+An array ref whose associated list is used to stash the FFT of the source
+data, for the FFT method.
+
+=back
+
+=cut
+
+*interpND = *PDL::interpND;
+sub PDL::interpND {
+ my $source = shift;
+ my $index = shift;
+ my $options = shift;
+
+ barf 'Usage: interp_nd($source,$index,[{%options}])\n'
+ if(defined $options and ref $options ne 'HASH');
+
+ my($opt) = (defined $options) ? $options : {};
+
+ my($method) = $opt->{m} || $opt->{meth} || $opt->{method} || $opt->{Method};
+ if(!defined $method) {
+ $method = ($source->type <= zeroes(long,1)->type) ?
+ 'sample' :
+ 'linear';
+ }
+
+ my($boundary) = $opt->{b} || $opt->{boundary} || $opt->{Boundary} || $opt->{bound} || $opt->{Bound} || 'extend';
+ my($bad) = $opt->{bad} || $opt->{Bad} || 0.0;
+
+ if($method =~ m/^s(am(p(le)?)?)?/i) {
+ return $source->range(PDL::Math::floor($index+0.5),0,$boundary);
+ }
+
+ elsif (($method eq 1) || $method =~ m/^l(in(ear)?)?/i) {
+ ## key: (ith = index thread; cth = cube thread; sth = source thread)
+ my $d = $index->dim(0);
+ my $di = $index->ndims - 1;
+
+ # Grab a 2-on-a-side n-cube around each desired pixel
+ my $samp = $source->range($index->floor,2,$boundary); # (ith, cth, sth)
+
+ # Reorder to put the cube dimensions in front and convert to a list
+ $samp = $samp->reorder( $di .. $di+$d-1,
+ 0 .. $di-1,
+ $di+$d .. $samp->ndims-1) # (cth, ith, sth)
+ ->clump($d); # (clst, ith, sth)
+
+ # Enumerate the corners of an n-cube and convert to a list
+ # (the 'x' is the normal perl repeat operator)
+ my $crnr = PDL::Basic::ndcoords( (2) x $index->dim(0) ) # (index,cth)
+ ->mv(0,-1)->clump($index->dim(0))->mv(-1,0); # (index, clst)
+
+ # a & b are the weighting coefficients.
+ my($a,$b);
+ my($indexwhere);
+ ($indexwhere = $index->where( 0 * $index )) .= -10; # Change NaN to invalid
+ {
+ my $bb = PDL::Math::floor($index);
+ $a = ($index - $bb) -> dummy(1,$crnr->dim(1)); # index, clst, ith
+ $b = ($bb + 1 - $index) -> dummy(1,$crnr->dim(1)); # index, clst, ith
+ }
+
+ # Use 1/0 corners to select which multiplier happens, multiply
+ # 'em all together to get sample weights, and sum to get the answer.
+ my $out0 = ( ($a * ($crnr==1) + $b * ($crnr==0)) #index, clst, ith
+ -> prodover #clst, ith
+ );
+
+ my $out = ($out0 * $samp)->sumover; # ith, sth
+
+ # Work around BAD-not-being-contagious bug in PDL <= 2.6 bad handling code --CED 3-April-2013
+ if($PDL::Bad::Status and $source->badflag) {
+ my $baddies = $samp->isbad->orover;
+ $out = $out->setbadif($baddies);
+ }
+
+ return $out;
+
+ } elsif(($method eq 3) || $method =~ m/^c(u(b(e|ic)?)?)?/i) {
+
+ my ($d, at di) = $index->dims;
+ my $di = $index->ndims - 1;
+
+ # Grab a 4-on-a-side n-cube around each desired pixel
+ my $samp = $source->range($index->floor - 1,4,$boundary) #ith, cth, sth
+ ->reorder( $di .. $di+$d-1, 0..$di-1, $di+$d .. $source->ndims-1 );
+ # (cth, ith, sth)
+
+ # Make a cube of the subpixel offsets, and expand its dims to
+ # a 4-on-a-side N-1 cube, to match the slices of $samp (used below).
+ my $b = $index - $index->floor;
+ for my $i(1..$d-1) {
+ $b = $b->dummy($i,4);
+ }
+
+ # Collapse by interpolation, one dimension at a time...
+ for my $i(0..$d-1) {
+ my $a0 = $samp->slice("(1)"); # Just-under-sample
+ my $a1 = $samp->slice("(2)"); # Just-over-sample
+ my $a1a0 = $a1 - $a0;
+
+ my $gradient = 0.5 * ($samp->slice("2:3")-$samp->slice("0:1"));
+ my $s0 = $gradient->slice("(0)"); # Just-under-gradient
+ my $s1 = $gradient->slice("(1)"); # Just-over-gradient
+
+ $bb = $b->slice("($i)");
+
+ # Collapse the sample...
+ $samp = ( $a0 +
+ $bb * (
+ $s0 +
+ $bb * ( (3 * $a1a0 - 2*$s0 - $s1) +
+ $bb * ( $s1 + $s0 - 2*$a1a0 )
+ )
+ )
+ );
+
+ # "Collapse" the subpixel offset...
+ $b = $b->slice(":,($i)");
+ }
+
+ return $samp;
+
+ } elsif($method =~ m/^f(ft|ourier)?/i) {
+
+ eval "use PDL::FFT;";
+ my $fftref = $opt->{fft};
+ $fftref = [] unless(ref $fftref eq 'ARRAY');
+ if(@$fftref != 2) {
+ my $a = $source->copy;
+ my $b = zeroes($source);
+ fftnd($a,$b);
+ $fftref->[0] = sqrt($a*$a+$b*$b) / $a->nelem;
+ $fftref->[1] = - atan2($b,$a);
+ }
+
+ my $i;
+ my $c = PDL::Basic::ndcoords($source); # (dim, source-dims)
+ for $i(1..$index->ndims-1) {
+ $c = $c->dummy($i,$index->dim($i))
+ }
+ my $id = $index->ndims-1;
+ my $phase = (($c * $index * 3.14159 * 2 / pdl($source->dims))
+ ->sumover) # (index-dims, source-dims)
+ ->reorder($id..$id+$source->ndims-1,0..$id-1); # (src, index)
+
+ my $phref = $fftref->[1]->copy; # (source-dims)
+ my $mag = $fftref->[0]->copy; # (source-dims)
+
+ for $i(1..$index->ndims-1) {
+ $phref = $phref->dummy(-1,$index->dim($i));
+ $mag = $mag->dummy(-1,$index->dim($i));
+ }
+ my $out = cos($phase + $phref ) * $mag;
+ $out = $out->clump($source->ndims)->sumover;
+
+ return $out;
+ } else {
+ barf("interpND: unknown method '$method'; valid ones are 'linear' and 'sample'.\n");
+ }
+}
+
+EOD
+
+##############################################################
+# things related to indexing: one2nd, which, where
+##############################################################
+
+pp_add_exported("", 'one2nd');
+pp_addpm(<<'EOD');
+
+=head2 one2nd
+
+=for ref
+
+Converts a one dimensional index piddle to a set of ND coordinates
+
+=for usage
+
+ @coords=one2nd($a, $indices)
+
+returns an array of piddles containing the ND indexes corresponding to
+the one dimensional list indices. The indices are assumed to
+correspond to array C<$a> clumped using C<clump(-1)>. This routine is
+used in the old vector form of L<whichND|/whichND>, but is useful on
+its own occasionally.
+
+=for example
+
+ pdl> $a=pdl [[[1,2],[-1,1]], [[0,-3],[3,2]]]; $c=$a->clump(-1)
+ pdl> $maxind=maximum_ind($c); p $maxind;
+ 6
+ pdl> print one2nd($a, maximum_ind($c))
+ 0 1 1
+ pdl> p $a->at(0,1,1)
+ 3
+
+=cut
+
+*one2nd = \&PDL::one2nd;
+sub PDL::one2nd {
+ barf "Usage: one2nd \$array \$indices\n" if $#_ != 1;
+ my ($a, $ind)=@_;
+ my @dimension=$a->dims;
+ my(@index);
+ my $count=0;
+ foreach (@dimension) {
+ $index[$count++]=$ind % $_;
+ $ind=long($ind/$_);
+ }
+ return @index;
+}
+
+EOD
+
+=head2 which
+
+=for sig
+
+ Signature: (mask(n); indx [o] inds(m))
+
+=cut
+
+my $doc_which = <<'EOD';
+
+=for ref
+
+Returns indices of non-zero values from a 1-D PDL
+
+=for usage
+
+ $i = which($mask);
+
+returns a pdl with indices for all those elements that are nonzero in
+the mask. Note that the returned indices will be 1D. If you feed in a
+multidimensional mask, it will be flattened before the indices are
+calculated. See also L<whichND|/whichND> for multidimensional masks.
+
+If you want to index into the original mask or a similar piddle
+with output from C<which>, remember to flatten it before calling index:
+
+ $data = random 5, 5;
+ $idx = which $data > 0.5; # $idx is now 1D
+ $bigsum = $data->flat->index($idx)->sum; # flatten before indexing
+
+Compare also L<where|/where> for similar functionality.
+
+SEE ALSO:
+
+L<which_both|/which_both> returns separately the indices of both
+zero and nonzero values in the mask.
+
+L<where|/where> returns associated values from a data PDL, rather than
+indices into the mask PDL.
+
+L<whichND|/whichND> returns N-D indices into a multidimensional PDL.
+
+=for example
+
+ pdl> $x = sequence(10); p $x
+ [0 1 2 3 4 5 6 7 8 9]
+ pdl> $indx = which($x>6); p $indx
+ [7 8 9]
+
+=cut
+
+EOD
+
+=head2 which_both
+
+=for sig
+
+ Signature: (mask(n); indx [o] inds(m); indx [o]notinds(q))
+
+=cut
+
+my $doc_which_both = <<'EOD';
+
+=for ref
+
+Returns indices of zero and nonzero values in a mask PDL
+
+=for usage
+
+ ($i, $c_i) = which_both($mask);
+
+This works just as L<which|/which>, but the complement of C<$i> will be in
+C<$c_i>.
+
+=for example
+
+ pdl> $x = sequence(10); p $x
+ [0 1 2 3 4 5 6 7 8 9]
+ pdl> ($small, $big) = which_both ($x >= 5); p "$small\n $big"
+ [5 6 7 8 9]
+ [0 1 2 3 4]
+
+=cut
+
+EOD
+
+ for (
+ {Name=>'which',
+ Pars => 'mask(n); indx [o] inds(m);',
+ Variables => 'int dm=0;',
+ Elseclause => "",
+ Autosize => '$SIZE(m) = sum;',
+ Doc => $doc_which,
+ PMCode=><<'EOD',
+ sub which { my ($this,$out) = @_;
+ $this = $this->flat;
+ $out = $this->nullcreate unless defined $out;
+ PDL::_which_int($this,$out);
+ return $out;
+ }
+ *PDL::which = \&which;
+EOD
+ },
+ {Name => 'which_both',
+ Pars => 'mask(n); indx [o] inds(m); indx [o]notinds(q)',
+ Variables => 'int dm=0; int dm2=0;',
+ Elseclause => "else { \n \$notinds(q => dm2)=n; \n dm2++;\n }",
+ Autosize => '$SIZE(m) = sum;'."\n".' $SIZE(q) = dpdl->dims[0]-sum;',
+ Doc => $doc_which_both,
+ PMCode=><<'EOD',
+ sub which_both { my ($this,$outi,$outni) = @_;
+ $this = $this->flat;
+ $outi = $this->nullcreate unless defined $outi;
+ $outni = $this->nullcreate unless defined $outni;
+ PDL::_which_both_int($this,$outi,$outni);
+ return wantarray ? ($outi,$outni) : $outi;
+ }
+ *PDL::which_both = \&which_both;
+EOD
+ }
+ )
+{
+ pp_def($_->{Name},
+ HandleBad => 1,
+ Doc => $_->{Doc},
+ Pars => $_->{Pars},
+ PMCode => $_->{PMCode},
+ Code => $_->{Variables} .
+ 'loop(n) %{
+ if($mask()) {
+ $inds(m => dm) = n;
+ dm++;
+ }'.$_->{Elseclause} . "\n".
+ ' %}',
+ BadCode => $_->{Variables} .
+ 'loop(n) %{
+ if ( $mask() && $ISGOOD($mask()) ) {
+ $inds(m => dm) = n;
+ dm++;
+ }'.$_->{Elseclause} . "\n".
+ ' %}',
+
+# the next one is currently a dirty hack
+# this will probably break once dataflow is enabled again
+# *unless* we have made sure that mask is physical by now!!!
+ RedoDimsCode => '
+ PDL_Indx sum = 0;
+ /* not sure if this is necessary */
+ pdl * dpdl = $PDL(mask);
+ $GENERIC() *m_datap = (($GENERIC() *)(PDL_REPRP(dpdl)));
+ PDL_Indx inc = PDL_REPRINC(dpdl,0);
+ PDL_Indx offs = PDL_REPROFFS(dpdl);
+ PDL_Indx i;
+
+ if (dpdl->ndims != 1)
+ barf("dimflag currently works only with 1D pdls");
+
+'.
+($bvalflag ? '
+ if(dpdl->state & PDL_BADVAL)
+ for (i=0; i<dpdl->dims[0]; i++) {
+ $GENERIC() foo = *(m_datap+inc*i+offs);
+ if(foo && $ISGOODVAR(foo,mask) )sum++;
+ }
+ else
+':'').'
+ for (i=0; i<dpdl->dims[0]; i++) {
+ $GENERIC() foo = *(m_datap+inc*i+offs);
+ if(foo) sum++;
+ }
+
+ '. $_->{Autosize} . '
+ /* printf("RedoDimsCode: setting dim m to %ld\n",sum); */'
+ );
+}
+
+pp_addpm(<<'EOD'
+
+=head2 where
+
+=for ref
+
+Use a mask to select values from one or more data PDLs
+
+C<where> accepts one or more data piddles and a mask piddle. It
+returns a list of output piddles, corresponding to the input data
+piddles. Each output piddle is a 1-dimensional list of values in its
+corresponding data piddle. The values are drawn from locations where
+the mask is nonzero.
+
+The output PDLs are still connected to the original data PDLs, for the
+purpose of dataflow.
+
+C<where> combines the functionality of L<which|/which> and L<index|PDL::Slices/index>
+into a single operation.
+
+BUGS:
+
+While C<where> works OK for most N-dimensional cases, it does not
+thread properly over (for example) the (N+1)th dimension in data
+that is compared to an N-dimensional mask. Use C<whereND> for that.
+
+=for usage
+
+ $i = $x->where($x+5 > 0); # $i contains those elements of $x
+ # where mask ($x+5 > 0) is 1
+ $i .= -5; # Set those elements (of $x) to -5. Together, these
+ # commands clamp $x to a maximum of -5.
+
+It is also possible to use the same mask for several piddles with
+the same call:
+
+ ($i,$j,$k) = where($x,$y,$z, $x+5>0);
+
+Note: C<$i> is always 1-D, even if C<$x> is E<gt>1-D.
+
+WARNING: The first argument
+(the values) and the second argument (the mask) currently have to have
+the exact same dimensions (or horrible things happen). You *cannot*
+thread over a smaller mask, for example.
+
+
+=cut
+
+sub PDL::where {
+ barf "Usage: where( \$pdl1, ..., \$pdlN, \$mask )\n" if $#_ == 0;
+
+ if($#_ == 1) {
+ my($data,$mask) = @_;
+ $data = $_[0]->clump(-1) if $_[0]->getndims>1;
+ $mask = $_[1]->clump(-1) if $_[0]->getndims>1;
+ return $data->index($mask->which());
+ } else {
+ if($_[-1]->getndims > 1) {
+ my $mask = $_[-1]->clump(-1)->which;
+ return map {$_->clump(-1)->index($mask)} @_[0..$#_-1];
+ } else {
+ my $mask = $_[-1]->which;
+ return map {$_->index($mask)} @_[0..$#_-1];
+ }
+ }
+}
+*where = \&PDL::where;
+
+EOD
+);
+
+pp_add_exported("", 'where');
+
+pp_addpm(<<'EOD'
+
+=head2 whereND
+
+=for ref
+
+C<where> with support for ND masks and threading
+
+C<whereND> accepts one or more data piddles and a
+mask piddle. It returns a list of output piddles,
+corresponding to the input data piddles. The values
+are drawn from locations where the mask is nonzero.
+
+C<whereND> differs from C<where> in that the mask
+dimensionality is preserved which allows for
+proper threading of the selection operation over
+higher dimensions.
+
+As with C<where> the output PDLs are still connected
+to the original data PDLs, for the purpose of dataflow.
+
+=for usage
+
+ $sdata = whereND $data, $mask
+ ($s1, $s2, ..., $sn) = whereND $d1, $d2, ..., $dn, $mask
+
+ where
+
+ $data is M dimensional
+ $mask is N < M dimensional
+ dims($data) 1..N == dims($mask) 1..N
+ with threading over N+1 to M dimensions
+
+=for example
+
+ $data = sequence(4,3,2); # example data array
+ $mask4 = (random(4)>0.5); # example 1-D mask array, has $n4 true values
+ $mask43 = (random(4,3)>0.5); # example 2-D mask array, has $n43 true values
+ $sdat4 = whereND $data, $mask4; # $sdat4 is a [$n4,3,2] pdl
+ $sdat43 = whereND $data, $mask43; # $sdat43 is a [$n43,2] pdl
+
+Just as with C<where>, you can use the returned value in an
+assignment. That means that both of these examples are valid:
+
+ # Used to create a new slice stored in $sdat4:
+ $sdat4 = $data->whereND($mask4);
+ $sdat4 .= 0;
+ # Used in lvalue context:
+ $data->whereND($mask4) .= 0;
+
+=cut
+
+sub PDL::whereND :lvalue {
+ barf "Usage: whereND( \$pdl1, ..., \$pdlN, \$mask )\n" if $#_ == 0;
+
+ my $mask = pop @_; # $mask has 0==false, 1==true
+ my @to_return;
+
+ my $n = PDL::sum($mask);
+
+ foreach my $arr (@_) {
+
+ my $sub_i = $mask * ones($arr);
+ my $where_sub_i = PDL::where($arr, $sub_i);
+
+ # count the number of dims in $mask and $arr
+ # $mask = a b c d e f.....
+ my @idims = dims($arr);
+
+ # ...and pop off the number of dims in $mask
+ foreach ( dims($mask) ) { shift(@idims) };
+
+ my $ndim = 0;
+ foreach my $id ($n, @idims[0..($#idims-1)]) {
+ $where_sub_i = $where_sub_i->splitdim($ndim++,$id) if $n>0;
+ }
+
+ push @to_return, $where_sub_i;
+ }
+
+ return (@to_return == 1) ? $to_return[0] : @to_return;
+}
+*whereND = \&PDL::whereND;
+
+EOD
+);
+
+pp_add_exported("", 'whereND');
+
+pp_addpm(<<'EOD'
+
+=head2 whichND
+
+=for ref
+
+Return the coordinates of non-zero values in a mask.
+
+=for usage
+
+WhichND returns the N-dimensional coordinates of each nonzero value in
+a mask PDL with any number of dimensions. The returned values arrive
+as an array-of-vectors suitable for use in
+L<indexND|PDL::Slices/indexND> or L<range|PDL::Slices/range>.
+
+ $coords = whichND($mask);
+
+returns a PDL containing the coordinates of the elements that are non-zero
+in C<$mask>, suitable for use in indexND. The 0th dimension contains the
+full coordinate listing of each point; the 1st dimension lists all the points.
+For example, if $mask has rank 4 and 100 matching elements, then $coords has
+dimension 4x100.
+
+If no such elements exist, then whichND returns a structured empty PDL:
+an Nx0 PDL that contains no values (but matches, threading-wise, with
+the vectors that would be produced if such elements existed).
+
+DEPRECATED BEHAVIOR IN LIST CONTEXT:
+
+whichND once delivered different values in list context than in scalar
+context, for historical reasons. In list context, it returned the
+coordinates transposed, as a collection of 1-PDLs (one per dimension)
+in a list. This usage is deprecated in PDL 2.4.10, and will cause a
+warning to be issued every time it is encountered. To avoid the
+warning, you can set the global variable "$PDL::whichND" to 's' to
+get scalar behavior in all contexts, or to 'l' to get list behavior in
+list context.
+
+In later versions of PDL, the deprecated behavior will disappear. Deprecated
+list context whichND expressions can be replaced with:
+
+ @list = $a->whichND->mv(0,-1)->dog;
+
+
+SEE ALSO:
+
+L<which|/which> finds coordinates of nonzero values in a 1-D mask.
+
+L<where|/where> extracts values from a data PDL that are associated
+with nonzero values in a mask PDL.
+
+=for example
+
+ pdl> $a=sequence(10,10,3,4)
+ pdl> ($x, $y, $z, $w)=whichND($a == 203); p $x, $y, $z, $w
+ [3] [0] [2] [0]
+ pdl> print $a->at(list(cat($x,$y,$z,$w)))
+ 203
+
+=cut
+
+*whichND = \&PDL::whichND;
+sub PDL::whichND {
+ my $mask = shift;
+ $mask = PDL::pdl('PDL',$mask) unless(UNIVERSAL::isa($mask,'PDL'));
+
+ # List context: generate a perl list by dimension
+ if(wantarray) {
+ if(!defined($PDL::whichND)) {
+ printf STDERR "whichND: WARNING - list context deprecated. Set \$PDL::whichND. Details in pod.";
+ } elsif($PDL::whichND =~ m/l/i) {
+ # old list context enabled by setting $PDL::whichND to 'l'
+ my $ind=($mask->clump(-1))->which;
+ return $mask->one2nd($ind);
+ }
+ # if $PDL::whichND does not contain 'l' or 'L', fall through to scalar context
+ }
+
+ # Scalar context: generate an N-D index piddle
+
+ unless($mask->nelem) {
+ return PDL::new_from_specification('PDL',$mask->ndims,0);
+ }
+
+ unless($mask->getndims) {
+ return $mask ? pdl(0) : PDL::new_from_specification('PDL',0);
+ }
+
+ $ind = $mask->flat->which->dummy(0,$mask->getndims)->long->make_physical;
+ if($ind->nelem==0) {
+ # In the empty case, explicitly return the correct type of structured empty
+ return PDL::new_from_specification('PDL',$mask->ndims, 0);
+ }
+
+ my $mult = ones($mask->getndims)->long;
+ my @mdims = $mask->dims;
+ my $i;
+
+ for $i(0..$#mdims-1) {
+ # use $tmp for 5.005_03 compatibility
+ (my $tmp = $mult->index($i+1)) .= $mult->index($i)*$mdims[$i];
+ }
+
+ for $i(0..$#mdims) {
+ my($s) = $ind->index($i);
+ $s /= $mult->index($i);
+ $s %= $mdims[$i];
+ }
+
+ return $ind;
+}
+
+EOD
+);
+
+pp_add_exported("", 'whichND');
+
+#
+# Set operations suited for manipulation of the operations above.
+#
+
+
+pp_addpm(<<'EOD'
+
+=head2 setops
+
+=for ref
+
+Implements simple set operations like union and intersection
+
+=for usage
+
+ Usage: $set = setops($a, <OPERATOR>, $b);
+
+The operator can be C<OR>, C<XOR> or C<AND>. This is then applied
+to C<$a> viewed as a set and C<$b> viewed as a set. Set theory says
+that a set may not have two or more identical elements, but setops
+takes care of this for you, so C<$a=pdl(1,1,2)> is OK. The functioning
+is as follows:
+
+=over
+
+=item C<OR>
+
+The resulting vector will contain the elements that are either in C<$a>
+I<or> in C<$b> or both. This is the union in set operation terms
+
+=item C<XOR>
+
+The resulting vector will contain the elements that are either in C<$a>
+or C<$b>, but not in both. This is
+
+ Union($a, $b) - Intersection($a, $b)
+
+in set operation terms.
+
+=item C<AND>
+
+The resulting vector will contain the intersection of C<$a> and C<$b>, so
+the elements that are in both C<$a> and C<$b>. Note that for convenience
+this operation is also aliased to L<intersect|intersect>
+
+=back
+
+It should be emphasized that these routines are used when one or both of
+the sets C<$a>, C<$b> are hard to calculate or that you get from a separate
+subroutine.
+
+Finally IDL users might be familiar with Craig Markwardt's C<cmset_op.pro>
+routine which has inspired this routine although it was written independently
+However the present routine has a few less options (but see the exampels)
+
+=for example
+
+You will very often use these functions on an index vector, so that is
+what we will show here. We will in fact something slightly silly. First
+we will find all squares that are also cubes below 10000.
+
+Create a sequence vector:
+
+ pdl> $x = sequence(10000)
+
+Find all odd and even elements:
+
+ pdl> ($even, $odd) = which_both( ($x % 2) == 0)
+
+Find all squares
+
+ pdl> $squares= which(ceil(sqrt($x)) == floor(sqrt($x)))
+
+Find all cubes (being careful with roundoff error!)
+
+ pdl> $cubes= which(ceil($x**(1.0/3.0)) == floor($x**(1.0/3.0)+1e-6))
+
+Then find all squares that are cubes:
+
+ pdl> $both = setops($squares, 'AND', $cubes)
+
+And print these (assumes that C<PDL::NiceSlice> is loaded!)
+
+ pdl> p $x($both)
+ [0 1 64 729 4096]
+
+Then find all numbers that are either cubes or squares, but not both:
+
+ pdl> $cube_xor_square = setops($squares, 'XOR', $cubes)
+
+ pdl> p $cube_xor_square->nelem()
+ 112
+
+So there are a total of 112 of these!
+
+Finally find all odd squares:
+
+ pdl> $odd_squares = setops($squares, 'AND', $odd)
+
+
+Another common occurance is to want to get all objects that are
+in C<$a> and in the complement of C<$b>. But it is almost always best
+to create the complement explicitly since the universe that both are
+taken from is not known. Thus use L<which_both|which_both> if possible
+to keep track of complements.
+
+If this is impossible the best approach is to make a temporary:
+
+This creates an index vector the size of the universe of the sets and
+set all elements in C<$b> to 0
+
+ pdl> $tmp = ones($n_universe); $tmp($b) .= 0;
+
+This then finds the complement of C<$b>
+
+ pdl> $C_b = which($tmp == 1);
+
+and this does the final selection:
+
+ pdl> $set = setops($a, 'AND', $C_b)
+
+=cut
+
+*setops = \&PDL::setops;
+
+sub PDL::setops {
+
+ my ($a, $op, $b)=@_;
+
+ # Check that $a and $b are 1D.
+ if ($a->ndims() > 1 || $b->ndims() > 1) {
+ warn 'setops: $a and $b must be 1D - flattening them!'."\n";
+ $a = $a->flat;
+ $b = $b->flat;
+ }
+
+ #Make sure there are no duplicate elements.
+ $a=$a->uniq;
+ $b=$b->uniq;
+
+ my $result;
+
+ if ($op eq 'OR') {
+ # Easy...
+ $result = uniq(append($a, $b));
+ } elsif ($op eq 'XOR') {
+ # Make ordered list of set union.
+ my $union = append($a, $b)->qsort;
+ # Index lists.
+ my $s1=zeroes(byte, $union->nelem());
+ my $s2=zeroes(byte, $union->nelem());
+
+ # Find indices which are duplicated - these are to be excluded
+ #
+ # We do this by comparing x with x shifted each way.
+ my $i1 = which($union != rotate($union, 1));
+ my $i2 = which($union != rotate($union, -1));
+ #
+ # We then mark/mask these in the s1 and s2 arrays to indicate which ones
+ # are not equal to their neighbours.
+ #
+ my $ts;
+ ($ts = $s1->index($i1)) .= 1 if $i1->nelem() > 0;
+ ($ts = $s2->index($i2)) .= 1 if $i2->nelem() > 0;
+
+ my $inds=which($s1 == $s2);
+
+ if ($inds->nelem() > 0) {
+ return $union->index($inds);
+ } else {
+ return $inds;
+ }
+
+ } elsif ($op eq 'AND') {
+ # The intersection of the arrays.
+
+ # Make ordered list of set union.
+ my $union = append($a, $b)->qsort;
+
+ return $union->where($union == rotate($union, -1));
+ } else {
+ print "The operation $op is not known!";
+ return -1;
+ }
+
+}
+EOD
+);
+
+
+pp_add_exported("", 'setops');
+
+
+
+pp_addpm(<<'EOD'
+
+=head2 intersect
+
+=for ref
+
+Calculate the intersection of two piddles
+
+=for usage
+
+ Usage: $set = intersect($a, $b);
+
+This routine is merely a simple interface to L<setops|setops>. See
+that for more information
+
+=for example
+
+Find all numbers less that 100 that are of the form 2*y and 3*x
+
+ pdl> $x=sequence(100)
+ pdl> $factor2 = which( ($x % 2) == 0)
+ pdl> $factor3 = which( ($x % 3) == 0)
+ pdl> $ii=intersect($factor2, $factor3)
+ pdl> p $x($ii)
+ [0 6 12 18 24 30 36 42 48 54 60 66 72 78 84 90 96]
+
+=cut
+
+*intersect = \&PDL::intersect;
+
+sub PDL::intersect {
+
+ return setops($_[0], 'AND', $_[1]);
+
+}
+
+EOD
+);
+
+pp_add_exported("", 'intersect');
+
+
+
+pp_addpm({At=>'Bot'},<<'EOD');
+
+=head1 AUTHOR
+
+Copyright (C) Tuomas J. Lukka 1997 (lukka at husc.harvard.edu). Contributions
+by Christian Soeller (c.soeller at auckland.ac.nz), Karl Glazebrook
+(kgb at aaoepp.aao.gov.au), Craig DeForest (deforest at boulder.swri.edu)
+and Jarle Brinchmann (jarle at astro.up.pt)
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+Updated for CPAN viewing compatibility by David Mertens.
+
+=cut
+
+EOD
+
+
+pp_done();
diff --git a/Basic/Reduce.pm b/Basic/Reduce.pm
new file mode 100644
index 0000000..275a87f
--- /dev/null
+++ b/Basic/Reduce.pm
@@ -0,0 +1,197 @@
+=head1 NAME
+
+PDL::Reduce -- a C<reduce> function for PDL
+
+=head1 DESCRIPTION
+
+Many languages have a C<reduce> function used to reduce
+the rank of an N-D array by one. It works by applying a selected
+operation along a specified dimension. This module implements
+such a function for PDL by providing a simplified interface
+to the existing projection functions (e.g. C<sumover>,
+C<maximum>, C<average>, etc).
+
+=head1 SYNOPSIS
+
+ use PDL::Reduce;
+ $a = sequence 5,5;
+ # reduce by adding all
+ # elements along 2nd dimension
+ $b = $a->reduce('add',1);
+ @ops = $a->canreduce; # return a list of all allowed operations
+
+=head1 FUNCTIONS
+
+=cut
+
+# in a very similar vein we want the following methods
+# (1) accumulate
+# (2) outer
+# what's reduceat ??
+
+# TODO
+# - aliases (e.g. plus -> add)
+# - other binary ops?
+# - allow general subs?
+
+package PDL::Reduce;
+use PDL::Core ''; # barf
+use PDL::Exporter;
+use strict;
+
+ at PDL::Reduce::ISA = qw/PDL::Exporter/;
+ at PDL::Reduce::EXPORT_OK = qw/reduce canreduce/;
+%PDL::Reduce::EXPORT_TAGS = (Func=>[@PDL::Reduce::EXPORT_OK]);
+
+# maps operations onto underlying PDL primitives
+my %reduce = (
+ add => 'sumover',
+ '+' => 'sumover',
+ plus => 'sumover',
+ mult => 'prodover',
+ '*' => 'prodover',
+ dadd => 'dsumover',
+ dmult => 'dprodover',
+ avg => 'average',
+ davg => 'daverage',
+ and => 'andover',
+ band => 'bandover',
+ bor => 'borover',
+ or => 'orover',
+ median => 'medover',
+ integral => 'intover',
+ max => 'maximum',
+ min => 'minimum',
+ oddmedian => 'oddmedover',
+ iszero => 'zcover',
+ );
+
+=head2 reduce
+
+=for ref
+
+reduce dimension of piddle by one by applying an operation
+along the specified dimension
+
+=for example
+
+ $a = sequence 5,5;
+ # reduce by adding all
+ # elements along 2nd dimension
+ $b = $a->reduce('add',1);
+ $b = $a->reduce('plus',1);
+ $b = $a->reduce('+',1); # three ways to do the same thing
+
+[ As an aside: if you are familiar with threading you will see that
+this is actually the same as
+
+ $b = $a->mv(1,0)->sumover
+
+]
+
+NOTE: You should quote the name of the operation (1st arg) that
+you want C<reduce> to perform. This is important since some of the
+names are identical to the names of the actual PDL functions
+which might be imported into your namespace. And you definitely
+want a string as argument, not a function invocation! For example,
+this will probably fail:
+
+ $b = $a->reduce(avg,1); # gives an error from invocation of 'avg'
+
+Rather use
+
+ $b = $a->reduce('avg',1);
+
+C<reduce> provides a simple and unified interface to the
+I<projection> functions and makes people coming from other
+data/array languages hopefully feel more at home.
+
+=for usage
+
+ $result = $pdl->reduce($operation [, at dims]);
+
+C<reduce> applies the named operation along the specified
+dimension(s) reducing the input piddle dimension by as many
+dimensions as supplied as arguments. If the
+dimension(s) argument is omitted the operation is applied along the first
+dimension. To get a list of valid operations see L<canreduce>.
+
+NOTE - new power user feature: you can now supply a code
+reference as operation to reduce with.
+
+=for example
+
+ # reduce by summing over dims 0 and 2
+ $result = $pdl->reduce(\&sumover, 0, 2);
+
+It is your responsibility to ensure that this is indeed a
+PDL projection operation that turns vectors into scalars!
+You have been warned.
+
+=cut
+
+*reduce = \&PDL::reduce;
+sub PDL::reduce ($$;$) {
+ my ($pdl, $op, @dims) = @_;
+ barf "trying to reduce using unknown operation"
+ unless exists $reduce{$op} || ref $op eq 'CODE';
+ my $dim;
+ if (@dims > 1) {
+ my $n = $pdl->getndims;
+ @dims = map { $_ < 0 ? $_ + $n : $_ } @dims;
+ my $min = $n;
+ my $max = 0;
+ for (@dims) { $min = $_ if $_ < $min; $max = $_ if $_ > $max }
+ barf "dimension out of bounds (one of @dims >= $n)"
+ if $min >= $n || $max >= $n;
+ $dim = $min; # this will be the resulting dim of the clumped piddle
+ $pdl = $pdl->clump(@dims);
+ } else {
+ $dim = @dims > 0 ? $dims[0] : 0;
+ }
+ if (defined $dim && $dim != 0) { # move the target dim to the front
+ my $n = $pdl->getndims;
+ $dim += $n if $dim < 0;
+ barf "dimension out of bounds" if $dim <0 || $dim >= $n;
+ $pdl = $pdl->mv($dim,0);
+ }
+ my $method = ref $op eq 'CODE' ? $op : $reduce{$op};
+ return $pdl->$method();
+}
+
+=head2 canreduce
+
+=for ref
+
+return list of valid named C<reduce> operations
+Some common operations can be accessed using a
+number of names, e.g. C<'+'>, C<add> and C<plus>
+all sum the elements along the chosen dimension.
+
+=for example
+
+ @ops = PDL->canreduce;
+
+This list is useful if you want to make sure which
+operations can be used with C<reduce>.
+
+=cut
+
+*canreduce = \&PDL::canreduce;
+sub PDL::canreduce {
+ my ($this) = @_;
+ return keys %reduce;
+}
+
+=head1 AUTHOR
+
+Copyright (C) 2000 Christian Soeller (c.soeller at auckland.ac.nz). All
+rights reserved. There is no warranty. You are allowed to redistribute
+this software / documentation under certain conditions. For details,
+see the file COPYING in the PDL distribution. If this file is
+separated from the PDL distribution, the copyright notice should be
+included in the file.
+
+=cut
+
+1;
diff --git a/Basic/Slices/Makefile.PL b/Basic/Slices/Makefile.PL
new file mode 100644
index 0000000..d666095
--- /dev/null
+++ b/Basic/Slices/Makefile.PL
@@ -0,0 +1,20 @@
+
+# Makefile.PL for PDL::Slices module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+ at pack = (["slices.pd",Slices,PDL::Slices]);
+
+%hash =pdlpp_stdargs_int(@::pack);
+WriteMakefile(
+%hash
+);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Basic/Slices/slices.pd b/Basic/Slices/slices.pd
new file mode 100644
index 0000000..5d8db25
--- /dev/null
+++ b/Basic/Slices/slices.pd
@@ -0,0 +1,3579 @@
+pp_addpm({At => 'Top'},<< 'EOD');
+
+=head1 NAME
+
+PDL::Slices -- Indexing, slicing, and dicing
+
+=head1 SYNOPSIS
+
+ use PDL;
+ $a = ones(3,3);
+ $b = $a->slice('-1:0,(1)');
+ $c = $a->dummy(2);
+
+
+=head1 DESCRIPTION
+
+This package provides many of the powerful PerlDL core index
+manipulation routines. These routines mostly allow two-way data flow,
+so you can modify your data in the most convenient representation.
+For example, you can make a 1000x1000 unit matrix with
+
+ $a = zeroes(1000,1000);
+ $a->diagonal(0,1) ++;
+
+which is quite efficient. See L<PDL::Indexing> and L<PDL::Tips> for
+more examples.
+
+Slicing is so central to the PDL language that a special compile-time
+syntax has been introduced to handle it compactly; see L<PDL::NiceSlice>
+for details.
+
+PDL indexing and slicing functions usually include two-way data flow,
+so that you can separate the actions of reshaping your data structures
+and modifying the data themselves. Two special methods, L<copy|copy> and
+L<sever|sever>, help you control the data flow connection between related
+variables.
+
+ $b = $a->slice("1:3"); # Slice maintains a link between $a and $b.
+ $b += 5; # $a is changed!
+
+If you want to force a physical copy and no data flow, you can copy or
+sever the slice expression:
+
+ $b = $a->slice("1:3")->copy;
+ $b += 5; # $a is not changed.
+
+ $b = $a->slice("1:3")->sever;
+ $b += 5; # $a is not changed.
+
+The difference between C<sever> and C<copy> is that sever acts on (and
+returns) its argument, while copy produces a disconnected copy. If you
+say
+
+ $b = $a->slice("1:3");
+ $c = $b->sever;
+
+then the variables C<$b> and C<$c> point to the same object but with
+C<-E<gt>copy> they would not.
+
+=cut
+
+use PDL::Core ':Internal';
+
+EOD
+
+=head1
+FUNCTIONS
+=cut
+
+# $::PP_VERBOSE=1;
+
+pp_addhdr(<<'EOH');
+
+#ifdef _MSC_VER
+#if _MSC_VER < 1300
+#define strtoll strtol
+#else
+#define strtoll _strtoi64
+#endif
+#endif
+
+EOH
+
+pp_add_boot(
+" PDL->readdata_affine = pdl_readdata_affineinternal;\n" .
+" PDL->writebackdata_affine = pdl_writebackdata_affineinternal;\n"
+);
+
+## Several routines use the 'Dims' and 'ParentInds'
+## rules - these currently do nothing
+
+pp_def(
+ 'affineinternal',
+ HandleBad => 1,
+ AffinePriv => 1,
+ DefaultFlow => 1,
+ P2Child => 1,
+ NoPdlThread => 1,
+ ReadDataFuncName => "pdl_readdata_affineinternal",
+ WriteBackDataFuncName => "pdl_writebackdata_affineinternal",
+ MakeComp => '$CROAK("AFMC MUSTNT BE CALLED");',
+ RedoDims => '$CROAK("AFRD MUSTNT BE CALLED");',
+ EquivCPOffsCode => '
+ PDL_Indx i; PDL_Indx poffs=$PRIV(offs); int nd;
+ for(i=0; i<$CHILD_P(nvals); i++) {
+ $EQUIVCPOFFS(i,poffs);
+ for(nd=0; nd<$CHILD_P(ndims); nd++) {
+ poffs += $PRIV(incs[nd]);
+ if(nd<$CHILD_P(ndims)-1 &&
+ (i+1)%$CHILD_P(dimincs[nd+1]) ||
+ nd == $CHILD_P(ndims)-1)
+ break;
+ poffs -= $PRIV(incs[nd]) *
+ $CHILD_P(dims[nd]);
+ }
+ }',
+ Doc => undef, # 'internal',
+);
+
+=head2 s_identity
+=cut
+
+$doc = <<'DOC';
+=for ref
+
+Internal vaffine identity function.
+
+=cut
+
+DOC
+
+pp_def(
+ 's_identity',
+ HandleBad => 1,
+ P2Child => 1,
+ NoPdlThread => 1,
+ DefaultFlow => 1,
+ OtherPars => '',
+ Reversible => 1,
+ Dims => '$COPYDIMS();',
+ ParentInds => '$COPYINDS();',
+ Identity => 1,
+ Doc => $doc,
+);
+
+=head2 index, index2d
+
+=cut
+
+$doc = <<'EOD';
+=for ref
+
+C<index>, C<index1d>, and C<index2d> provide rudimentary index indirection.
+
+=for example
+
+ $c = index($source,$ind);
+ $c = index($source,$ind);
+ $c = index2d($source2,$ind1,$ind2);
+
+use the C<$ind> variables as indices to look up values in C<$source>.
+The three routines thread slightly differently.
+
+=over 3
+
+=item C<index> uses direct threading for 1-D indexing across the 0 dim
+of C<$source>. It can thread over source thread dims or index thread
+dims dims not not (easily) both: If <$source> has more than 1
+dimension and C<$ind> has more than 0 dimensions, they must agree in
+a threading sense.
+
+C<index1d> uses a single active dim in C<$ind> to produce a list of
+indexed values in the 0 dim of the output - it is useful for
+collapsing C<$source> by indexing with a single row of values long
+C<$source>'s 0 dimension. The output has the same number of dims as
+C<$source>. The 0 dim of the output has size 1 if C<$ind> is a
+scalar, and the same size as the 0 dim of C<$ind> if it is not. If
+C<$ind> and $<source> both have more than 1 dim, then all dims higher
+than 0 must agree in a threading sense.
+
+C<index2d> works like C<index> but uses separate piddles for X and Y
+coordinates. For more general N-dimensional indexing, see the
+L<PDL::NiceSlice> syntax or L<PDL::Slices> (in particular C<slice>,
+C<indexND>, and C<range>).
+
+These functions are two-way, i.e. after
+
+ $c = $a->index(pdl[0,5,8]);
+ $c .= pdl [0,2,4];
+
+the changes in C<$c> will flow back to C<$a>.
+
+C<index> provids simple threading: multiple-dimensioned arrays are treated
+as collections of 1-D arrays, so that
+
+ $a = xvals(10,10)+10*yvals(10,10);
+ $b = $a->index(3);
+ $c = $a->index(9-xvals(10));
+
+puts a single column from C<$a> into C<$b>, and puts a single element
+from each column of C<$a> into C<$c>. If you want to extract multiple
+columns from an array in one operation, see L<dice|/dice> or
+L<indexND|/indexND>.
+
+=cut
+
+EOD
+
+my $index_init_good =
+ 'register PDL_Indx foo = $ind();
+ if( foo<0 || foo>=$SIZE(n) ) {
+ barf("PDL::index: invalid index %d (valid range 0..%d)",
+ foo,$SIZE(n)-1);
+ }';
+my $index_init_bad =
+ 'register PDL_Indx foo = $ind();
+ if( $ISBADVAR(foo,ind) || foo<0 || foo>=$SIZE(n) ) {
+ barf("PDL::index: invalid index %d (valid range 0..%d)",
+ foo,$SIZE(n)-1);
+ }';
+
+pp_def(
+ 'index',
+ HandleBad => 1,
+ DefaultFlow => 1,
+ Reversible => 1,
+ Pars => 'a(n); indx ind(); [oca] c();',
+ Code =>
+ $index_init_good . ' $c() = $a(n => foo);',
+$a = BadCode =>
+ $index_init_bad . ' $c() = $a(n => foo);',
+ BackCode =>
+ $index_init_good . ' $a(n => foo) = $c();',
+ BadBackCode =>
+ $index_init_bad . ' $a(n => foo) = $c();',
+ Doc => $doc,
+ BadDoc =>
+ 'index barfs if any of the index values are bad.',
+ );
+
+pp_def(
+ 'index1d',
+ HandleBad => 1,
+ DefaultFlow => 1,
+ Reversible => 1,
+ Pars => 'a(n); indx ind(m); [oca] c(m);',
+ Code =>
+ q{
+ PDL_Indx i;
+ for(i=0;i<$SIZE(m);i++) {
+ PDL_Indx foo = $ind(m=>i);
+ if( foo<0 || foo >= $SIZE(n) ) {
+ barf("PDL::index1d: invalid index %d at pos %d (valid range 0..%d)",
+ foo, i, $SIZE(n)-1);
+ }
+ $c(m=>i) = $a(n=>foo);
+ }
+ },
+ BadCode =>
+ q{
+ PDL_Indx i;
+ for(i=0;i<$SIZE(m);i++) {
+ PDL_Indx foo = $ind(m=>i);
+ if( $ISBADVAR(foo, ind) ) {
+ $SETBAD(c(m=>i));
+ } else {
+ if( foo<0 || foo >= $SIZE(n) ) {
+ barf("PDL::index1d: invalid/bad index %d at pos %d (valid range 0..%d)",
+ foo, i, $SIZE(n)-1);
+ }
+ $c(m=>i) = $a(n=>foo);
+ }
+ }
+ },
+ BackCode => q{
+ PDL_Indx i;
+ for(i=0;i<$SIZE(m);i++) {
+ PDL_Indx foo = $ind(m=>i);
+ if( foo<0 || foo >= $SIZE(n) ) {
+ barf("PDL::index1d: invalid index %d at pos %d (valid range 0..%d)",
+ foo, i, $SIZE(n)-1);
+ }
+ $a(n=>foo) = $c(m=>i);
+ }
+ },
+ BadBackCode => q{
+ PDL_Indx i;
+ for(i=0;i<$SIZE(m);i++) {
+ PDL_Indx foo = $ind(m=>i);
+ if( $ISBADVAR(foo, ind) ) {
+ /* do nothing */
+ } else {
+ if( foo<0 || foo >= $SIZE(n) ) {
+ barf("PDL::index1d: invalid/bad index %d at pos %d (valid range 0..%d)",
+ foo, i, $SIZE(n)-1);
+ }
+ $a(n=>foo) = $c(m=>i);
+ }
+ }
+ },
+ Doc => $doc,
+ BadDoc =>
+ 'index1d propagates BAD index elements to the output variable.'
+ );
+
+my $index2d_init_good =
+ 'register PDL_Indx fooa,foob;
+ fooa = $inda();
+ if( fooa<0 || fooa>=$SIZE(na) ) {
+ barf("PDL::index: invalid x-index %d (valid range 0..%d)",
+ fooa,$SIZE(na)-1);
+ }
+ foob = $indb();
+ if( foob<0 || foob>=$SIZE(nb) ) {
+ barf("PDL::index: invalid y-index %d (valid range 0..%d)",
+ foob,$SIZE(nb)-1);
+ }';
+my $index2d_init_bad =
+ 'register PDL_Indx fooa,foob;
+ fooa = $inda();
+ if( $ISBADVAR(fooa,inda) || fooa<0 || fooa>=$SIZE(na) ) {
+ barf("PDL::index: invalid index 1");
+ }
+ foob = $indb();
+ if( $ISBADVAR(foob,indb) || foob<0 || foob>=$SIZE(nb) ) {
+ barf("PDL::index: invalid index 2");
+ }';
+
+pp_def(
+ 'index2d',
+ HandleBad => 1,
+ DefaultFlow => 1,
+ Reversible => 1,
+ Pars => 'a(na,nb); indx inda(); indx indb(); [oca] c();',
+ Code =>
+ $index2d_init_good . ' $c() = $a(na => fooa, nb => foob);',
+ BadCode =>
+ $index2d_init_bad . '$c() = $a(na => fooa, nb => foob);',
+ BackCode =>
+ $index2d_init_good . ' $a(na => fooa, nb => foob) = $c();',
+ BadBackCode =>
+ $index2d_init_bad . '$a(na => fooa, nb => foob) = $c();',
+ Doc => $doc,
+ BadDoc =>
+ 'index2d barfs if either of the index values are bad.',
+);
+
+
+# indexND: CED 2-Aug-2002
+pp_add_exported('','indexND indexNDb');
+pp_addpm(<<'EOD-indexND');
+
+=head2 indexNDb
+
+=for ref
+
+ Backwards-compatibility alias for indexND
+
+=head2 indexND
+
+=for ref
+
+ Find selected elements in an N-D piddle, with optional boundary handling
+
+=for example
+
+ $out = $source->indexND( $index, [$method] )
+
+ $source = 10*xvals(10,10) + yvals(10,10);
+ $index = pdl([[2,3],[4,5]],[[6,7],[8,9]]);
+ print $source->indexND( $index );
+
+ [
+ [23 45]
+ [67 89]
+ ]
+
+IndexND collapses C<$index> by lookup into C<$source>. The
+0th dimension of C<$index> is treated as coordinates in C<$source>, and
+the return value has the same dimensions as the rest of C<$index>.
+The returned elements are looked up from C<$source>. Dataflow
+works -- propagated assignment flows back into C<$source>.
+
+IndexND and IndexNDb were originally separate routines but they are both
+now implemented as a call to L<range|/range>, and have identical syntax to
+one another.
+
+=cut
+
+sub PDL::indexND {
+ my($source,$index, $boundary) = @_;
+ return PDL::range($source,$index,undef,$boundary);
+}
+
+*PDL::indexNDb = \&PDL::indexND;
+
+EOD-indexND
+
+pp_addpm(<<'EOD-range');
+
+sub PDL::range {
+ my($source,$ind,$sz,$bound) = @_;
+ my $index = PDL->pdl($ind);
+
+ my $size = defined($sz) ? PDL->pdl($sz) : undef;
+
+
+ # Handle empty PDL case: return a properly constructed Empty.
+ if($index->isempty) {
+ my @sdims= $source->dims;
+ splice(@sdims, 0, $index->dim(0) + ($index->dim(0)==0)); # added term is to treat Empty[0] like a single empty coordinate
+ unshift(@sdims, $size->list) if(defined($size));
+ return PDL->new_from_specification(0 x ($index->ndims-1), @sdims);
+ }
+
+
+ $index = $index->dummy(0,1) unless $index->ndims;
+
+
+ # Pack boundary string if necessary
+ if(defined $bound) {
+ if(ref $bound eq 'ARRAY') {
+ my ($s,$el);
+ foreach $el(@$bound) {
+ barf "Illegal boundary value '$el' in range"
+ unless( $el =~ m/^([0123fFtTeEpPmM])/ );
+ $s .= $1;
+ }
+ $bound = $s;
+ }
+ elsif($bound !~ m/^[0123ftepx]+$/ && $bound =~ m/^([0123ftepx])/i ) {
+ $bound = $1;
+ }
+ }
+
+ no warnings; # shut up about passing undef into rangeb
+ $source->rangeb($index,$size,$bound);
+}
+EOD-range
+
+=head2 range
+
+=cut
+
+pp_def(
+ 'rangeb',
+ OtherPars => 'SV *index; SV *size; SV *boundary',
+ Doc => <<'EOD',
+=for ref
+
+Engine for L<range|/range>
+
+=for example
+
+Same calling convention as L<range|/range>, but you must supply all
+parameters. C<rangeb> is marginally faster as it makes a direct PP call,
+avoiding the perl argument-parsing step.
+
+=cut
+
+=head2 range
+
+=for ref
+
+Extract selected chunks from a source piddle, with boundary conditions
+
+=for example
+
+ $out = $source->range($index,[$size,[$boundary]])
+
+Returns elements or rectangular slices of the original piddle, indexed by
+the C<$index> piddle. C<$source> is an N-dimensional piddle, and C<$index> is
+a piddle whose first dimension has size up to N. Each row of C<$index> is
+treated as coordinates of a single value or chunk from C<$source>, specifying
+the location(s) to extract.
+
+If you specify a single index location, then range is essentially an expensive
+slice, with controllable boundary conditions.
+
+B<INPUTS>
+
+C<$index> and C<$size> can be piddles or array refs such as you would
+feed to L<zeroes|PDL::Core/zeroes> and its ilk. If C<$index>'s 0th dimension
+has size higher than the number of dimensions in C<$source>, then
+C<$source> is treated as though it had trivial dummy dimensions of
+size 1, up to the required size to be indexed by C<$index> -- so if
+your source array is 1-D and your index array is a list of 3-vectors,
+you get two dummy dimensions of size 1 on the end of your source array.
+
+You can extract single elements or N-D rectangular ranges from C<$source>,
+by setting C<$size>. If C<$size> is undef or zero, then you get a single
+sample for each row of C<$index>. This behavior is similar to
+L<indexNDb|/indexNDb>, which is in fact implemented as a call to L<range|/range>.
+
+If C<$size> is positive then you get a range of values from C<$source> at
+each location, and the output has extra dimensions allocated for them.
+C<$size> can be a scalar, in which case it applies to all dimensions, or an
+N-vector, in which case each element is applied independently to the
+corresponding dimension in C<$source>. See below for details.
+
+C<$boundary> is a number, string, or list ref indicating the type of
+boundary conditions to use when ranges reach the edge of C<$source>. If you
+specify no boundary conditions the default is to forbid boundary violations
+on all axes. If you specify exactly one boundary condition, it applies to
+all axes. If you specify more (as elements of a list ref, or as a packed
+string, see below), then they apply to dimensions in the order in which they
+appear, and the last one applies to all subsequent dimensions. (This is
+less difficult than it sounds; see the examples below).
+
+=over 3
+
+=item 0 (synonyms: 'f','forbid') B<(default)>
+
+Ranges are not allowed to cross the boundary of the original PDL. Disallowed
+ranges throw an error. The errors are thrown at evaluation time, not
+at the time of the range call (this is the same behavior as L<slice|/slice>).
+
+=item 1 (synonyms: 't','truncate')
+
+Values outside the original piddle get BAD if you've got bad value
+support compiled into your PDL and set the badflag for the source PDL;
+or 0 if you haven't (you must set the badflag if you want BADs for out
+of bound values, otherwise you get 0). Reverse dataflow works OK for
+the portion of the child that is in-bounds. The out-of-bounds part of
+the child is reset to (BAD|0) during each dataflow operation, but
+execution continues.
+
+=item 2 (synonyms: 'e','x','extend')
+
+Values that would be outside the original piddle point instead to the
+nearest allowed value within the piddle. See the CAVEAT below on
+mappings that are not single valued.
+
+=item 3 (synonyms: 'p','periodic')
+
+Periodic boundary conditions apply: the numbers in $index are applied,
+strict-modulo the corresponding dimensions of $source. This is equivalent to
+duplicating the $source piddle throughout N-D space. See the CAVEAT below
+about mappings that are not single valued.
+
+=item 4 (synonyms: 'm','mirror')
+
+Mirror-reflection periodic boundary conditions apply. See the CAVEAT
+below about mappings that are not single valued.
+
+=back
+
+The boundary condition identifiers all begin with unique characters, so
+you can feed in multiple boundary conditions as either a list ref or a
+packed string. (The packed string is marginally faster to run). For
+example, the four expressions [0,1], ['forbid','truncate'], ['f','t'],
+and 'ft' all specify that violating the boundary in the 0th dimension
+throws an error, and all other dimensions get truncated.
+
+If you feed in a single string, it is interpreted as a packed boundary
+array if all of its characters are valid boundary specifiers (e.g. 'pet'),
+but as a single word-style specifier if they are not (e.g. 'forbid').
+
+B<OUTPUT>
+
+The output threads over both C<$index> and C<$source>. Because implicit
+threading can happen in a couple of ways, a little thought is needed. The
+returned dimension list is stacked up like this:
+
+ (index thread dims), (index dims (size)), (source thread dims)
+
+The first few dims of the output correspond to the extra dims of
+C<$index> (beyond the 0 dim). They allow you to pick out individual
+ranges from a large, threaded collection.
+
+The middle few dims of the output correspond to the size dims
+specified in C<$size>, and contain the range of values that is extracted
+at each location in C<$source>. Every nonzero element of C<$size> is copied to
+the dimension list here, so that if you feed in (for example) C<$size
+= [2,0,1]> you get an index dim list of C<(2,1)>.
+
+The last few dims of the output correspond to extra dims of C<$source> beyond
+the number of dims indexed by C<$index>. These dims act like ordinary
+thread dims, because adding more dims to C<$source> just tacks extra dims
+on the end of the output. Each source thread dim ranges over the entire
+corresponding dim of C<$source>.
+
+B<Dataflow>: Dataflow is bidirectional.
+
+B<Examples>:
+Here are basic examples of C<range> operation, showing how to get
+ranges out of a small matrix. The first few examples show extraction
+and selection of individual chunks. The last example shows
+how to mark loci in the original matrix (using dataflow).
+
+ pdl> $src = 10*xvals(10,5)+yvals(10,5)
+ pdl> print $src->range([2,3]) # Cut out a single element
+ 23
+ pdl> print $src->range([2,3],1) # Cut out a single 1x1 block
+ [
+ [23]
+ ]
+ pdl> print $src->range([2,3], [2,1]) # Cut a 2x1 chunk
+ [
+ [23 33]
+ ]
+ pdl> print $src->range([[2,3]],[2,1]) # Trivial list of 1 chunk
+ [
+ [
+ [23]
+ [33]
+ ]
+ ]
+ pdl> print $src->range([[2,3],[0,1]], [2,1]) # two 2x1 chunks
+ [
+ [
+ [23 1]
+ [33 11]
+ ]
+ ]
+ pdl> # A 2x2 collection of 2x1 chunks
+ pdl> print $src->range([[[1,1],[2,2]],[[2,3],[0,1]]],[2,1])
+ [
+ [
+ [
+ [11 22]
+ [23 1]
+ ]
+ [
+ [21 32]
+ [33 11]
+ ]
+ ]
+ ]
+ pdl> $src = xvals(5,3)*10+yvals(5,3)
+ pdl> print $src->range(3,1) # Thread over y dimension in $src
+ [
+ [30]
+ [31]
+ [32]
+ ]
+
+ pdl> $src = zeroes(5,4);
+ pdl> $src->range(pdl([2,3],[0,1]),pdl(2,1)) .= xvals(2,2,1) + 1
+ pdl> print $src
+ [
+ [0 0 0 0 0]
+ [2 2 0 0 0]
+ [0 0 0 0 0]
+ [0 0 1 1 0]
+ ]
+
+B<CAVEAT>: It's quite possible to select multiple ranges that
+intersect. In that case, modifying the ranges doesn't have a
+guaranteed result in the original PDL -- the result is an arbitrary
+choice among the valid values. For some things that's OK; but for
+others it's not. In particular, this doesn't work:
+
+ pdl> $photon_list = new PDL::RandVar->sample(500)->reshape(2,250)*10
+ pdl> histogram = zeroes(10,10)
+ pdl> histogram->range($photon_list,1)++; #not what you wanted
+
+The reason is that if two photons land in the same bin, then that bin
+doesn't get incremented twice. (That may get fixed in a later version...)
+
+B<PERMISSIVE RANGING>: If C<$index> has too many dimensions compared
+to C<$source>, then $source is treated as though it had dummy
+dimensions of size 1, up to the required number of dimensions. These
+virtual dummy dimensions have the usual boundary conditions applied to
+them.
+
+If the 0 dimension of C<$index> is ludicrously large (if its size is
+more than 5 greater than the number of dims in the source PDL) then
+range will insist that you specify a size in every dimension, to make
+sure that you know what you're doing. That catches a common error with
+range usage: confusing the initial dim (which is usually small) with another
+index dim (perhaps of size 1000).
+
+If the index variable is Empty, then range() always returns the Empty PDL.
+If the index variable is not Empty, indexing it always yields a boundary
+violation. All non-barfing conditions are treated as truncation, since
+there are no actual data to return.
+
+B<EFFICIENCY>: Because C<range> isn't an affine transformation (it
+involves lookup into a list of N-D indices), it is somewhat
+memory-inefficient for long lists of ranges, and keeping dataflow open
+is much slower than for affine transformations (which don't have to copy
+data around).
+
+Doing operations on small subfields of a large range is inefficient
+because the engine must flow the entire range back into the original
+PDL with every atomic perl operation, even if you only touch a single element.
+One way to speed up such code is to sever your range, so that PDL
+doesn't have to copy the data with each operation, then copy the
+elements explicitly at the end of your loop. Here's an example that
+labels each region in a range sequentially, using many small
+operations rather than a single xvals assignment:
+
+ ### How to make a collection of small ops run fast with range...
+ $a = $data->range($index, $sizes, $bound)->sever;
+ $aa = $data->range($index, $sizes, $bound);
+ map { $a($_ - 1) .= $_; } (1..$a->nelem); # Lots of little ops
+ $aa .= $a;
+
+C<range> is a perl front-end to a PP function, C<rangeb>. Calling
+C<rangeb> is marginally faster but requires that you include all arguments.
+
+DEVEL NOTES
+
+* index thread dimensions are effectively clumped internally. This
+makes it easier to loop over the index array but a little more brain-bending
+to tease out the algorithm.
+
+=cut
+
+EOD
+ HandleBad => 1,
+ DefaultFlow => 1,
+ Reversible => 1,
+ P2Child => 1,
+ NoPdlThread => 1,
+
+#
+# rdim: dimensionality of each range (0 dim of index PDL)
+#
+# ntsize: number of nonzero size dimensions
+# sizes: array of range sizes, indexed (0..rdim-1). A zero element means
+# that the dimension is omitted from the child dim list.
+# corners: parent coordinates of each corner, running fastest over coord index.
+# (indexed 0 .. (nitems-1)*(rdim)+rdim-1)
+# nitems: total number of list elements (product of itdims)
+# itdim: number of index thread dimensions
+# itdims: Size of each index thread dimension, indexed (0..itdim-1)
+#
+# bsize: Number of independently specified boundary conditions
+# nsizes: Number of independently specified range dim sizes
+# boundary: Array containing all the boundary condition specs
+# indord: Order/size of the indexing dim (0th dim of $index)
+
+ Comp => 'PDL_Indx rdim;
+ PDL_Indx nitems;
+ PDL_Indx itdim;
+ PDL_Indx ntsize;
+ PDL_Indx bsize;
+ PDL_Indx nsizes;
+ PDL_Indx sizes[$COMP(rdim)];
+ PDL_Indx itdims[$COMP(itdim)];
+ PDL_Indx corners[$COMP(rdim) * $COMP(nitems)];
+ char boundary[$COMP(rdim)];
+ ',
+ MakeComp => <<'EOD-MakeComp',
+pdl *ind_pdl;
+pdl *size_pdl;
+
+/***
+ * Check and condition the index piddle. Some of this is apparently
+ * done by XS -- but XS doesn't check for existing SVs that are undef.
+ */
+if ((index==NULL) || (index == &PL_sv_undef))
+ { $CROAK("rangeb: index variable must be defined"); }
+
+if(!(ind_pdl = PDL->SvPDLV(index))) /* assignment */
+ { $CROAK("rangeb: unable to convert index variable to a PDL"); }
+
+PDL->make_physdims(ind_pdl);
+
+/* Generalized empties are ok, but not in the special 0 dim (the index vector) */
+if(ind_pdl->dims[0] == 0)
+ { $CROAK("rangeb: can't handle Empty indices -- call range instead"); }
+
+/***
+ * Ensure that the index is a PDL_Indx. If there's no loss of information,
+ * just upgrade it -- otherwise, make a temporary copy.
+ */
+switch(ind_pdl->datatype) {
+ default: /* Most types: */
+ ind_pdl = PDL->hard_copy(ind_pdl); /* copy and fall through */
+ case PDL_B: case PDL_S: case PDL_US: case PDL_L: case PDL_LL:
+ PDL->converttype(&ind_pdl,PDL_IND,1); /* convert in place. */
+ break;
+ case PDL_IND:
+ /* do nothing */
+ break;
+}
+
+/***
+ * Figure sizes of the COMP arrrays and allocate them.
+ */
+{
+ PDL_Indx i,nitems;
+
+ $COMP(rdim) = ind_pdl->ndims ? ind_pdl->dims[0] : 1;
+ for(i=nitems=1; i < ind_pdl->ndims; i++) /* Accumulate item list size */
+ nitems *= ind_pdl->dims[i];
+ $COMP(nitems) = nitems;
+ $COMP(itdim) = ind_pdl->ndims ? ind_pdl->ndims - 1 : 0;
+ $DOCOMPDIMS();
+}
+
+/***
+ * Fill in the boundary condition array
+ */
+{
+ char *bstr;
+ STRLEN blen;
+ bstr = SvPV(boundary,blen);
+
+ if(blen == 0) {
+ /* If no boundary is specified then every dim gets forbidden */
+ int i;
+ for (i=0;i<$COMP(rdim);i++)
+ $COMP(boundary[i]) = 0;
+ } else {
+ int i;
+ for(i=0;i<$COMP(rdim);i++) {
+ switch(bstr[i < blen ? i : blen-1 ]) {
+ case '0': case 'f': case 'F': /* forbid */
+ $COMP(boundary[i]) = 0;
+ break;
+ case '1': case 't': case 'T': /* truncate */
+ $COMP(boundary[i]) = 1;
+ break;
+ case '2': case 'e': case 'E': /* extend */
+ $COMP(boundary[i]) = 2;
+ break;
+ case '3': case 'p': case 'P': /* periodic */
+ $COMP(boundary[i]) = 3;
+ break;
+ case '4': case 'm': case 'M': /* mirror */
+ $COMP(boundary[i]) = 4;
+ break;
+ default:
+ {
+ /* No need to check if i < blen -- this will barf out the
+ * first time it gets hit. I didn't use $ CROAK 'coz that
+ * macro doesn't let you pass in a string variable -- only a
+ * constant.
+ */
+ barf("Error in rangeb: Unknown boundary condition '%c' in range",bstr[i]);
+ }
+ break;
+ } // end of switch
+ }
+ }
+}
+/***
+ * Store the sizes of the index-thread dims
+ */
+{
+ PDL_Indx i;
+ PDL_Indx nd = ind_pdl->ndims - 1;
+ for(i=0; i < nd ; i++)
+ $COMP(itdims[i]) = ind_pdl->dims[i+1];
+}
+
+/***
+ * Check and condition the size piddle, and store sizes of the ranges
+ */
+{
+ PDL_Indx i,ntsize;
+
+ if( (size == NULL) || (size == &PL_sv_undef) ) {
+ // NO size was passed in (not normally executed even if you passed in no size to range(),
+ // as range() generates a size array...
+ for(i=0;i<$COMP(rdim);i++)
+ $COMP(sizes[i]) = 0;
+
+ } else {
+ /* Normal case with sizes present in a PDL */
+
+ if(!(size_pdl = PDL->SvPDLV(size))) /* assignment */
+ $CROAK("Unable to convert size to a PDL in range");
+
+ if(size_pdl->nvals == 0) {
+ // no values in the size_pdl - Empty or Null. Just copy 0s to all the range dims
+ for(i=0;i<$COMP(rdim);i++)
+ $COMP(sizes[i]) = 0;
+
+ } else {
+
+ // Convert size PDL to PDL_IND to support indices
+ switch(size_pdl->datatype) {
+ default: /* Most types: */
+ size_pdl = PDL->hard_copy(size_pdl); /* copy and fall through */
+ case PDL_B: case PDL_S: case PDL_US: case PDL_L: case PDL_LL:
+ PDL->converttype(&size_pdl,PDL_IND,1); /* convert in place. */
+ break;
+ case PDL_IND:
+ break;
+ }
+
+ $COMP(nsizes) = size_pdl->nvals; /* Store for later permissiveness check */
+
+ /* Copy the sizes, or die if they're the wrong shape */
+ if(size_pdl->nvals == 1) {
+ for(i=0;i<$COMP(rdim);i++) {
+ $COMP(sizes[i]) = *((PDL_Indx *)(size_pdl->data));
+ }
+
+ /* Check for nonnegativity of sizes. The rdim>0 mask ensures that */
+ /* we don't barf on the Empty PDL (as an index). */
+ if( $COMP(rdim) > 0 && $COMP(sizes[0]) < 0 ) {
+ $CROAK(" Negative range size is not allowed in range\n");
+ }
+ }
+ else if( size_pdl->nvals <= $COMP(rdim) && size_pdl->ndims == 1) {
+ for(i=0;i<$COMP(rdim);i++) {
+ $COMP(sizes[i]) = ( (i < size_pdl->nvals) ?
+ ((PDL_Indx *)(size_pdl->data))[i] :
+ 0
+ );
+ if($COMP(sizes[i]) < 0)
+ $CROAK(" Negative range sizes are not allowed in range\n");
+ }
+ }
+ else {
+ $CROAK(" Size must match index's 0th dim in range\n");
+ }
+
+ } /* end of nonempty size-piddle code */
+ } /* end of defined-size-piddle code */
+
+ /* Insert the number of nontrivial sizes (these get output dimensions) */
+ for(i=ntsize=0;i<$COMP(rdim);i++)
+ if($COMP(sizes[i]))
+ ntsize++;
+ $COMP(ntsize) = ntsize;
+}
+
+/***
+ * Stash coordinates of the corners
+ */
+
+{
+ PDL_Indx i,j,k,ioff;
+ PDL_Indx *cptr;
+ PDL_Indx *iter = (PDL_Indx *)(PDL->smalloc((STRLEN) (sizeof(PDL_Indx) * ($COMP(itdim)))));
+
+ /* initialize iterator to loop over index threads */
+ cptr = iter;
+ for(k=0;k<$COMP(itdim);k++)
+ *(cptr++) = 0;
+
+ cptr = $COMP(corners);
+ do {
+ /* accumulate offset into the index from the iterator */
+ for(k=ioff=0;k<$COMP(itdim);k++)
+ ioff += iter[k] * ind_pdl->dimincs[k+1];
+
+ /* Loop over the 0th dim of index, copying coords. */
+ /* This is the natural place to check for permissive ranging; too */
+ /* bad we don't have access to the parent piddle here... */
+
+ for(j=0;j<$COMP(rdim);j++)
+ *(cptr++) = ((PDL_Indx *)(ind_pdl->data))[ioff + ind_pdl->dimincs[0] * j];
+
+ /* Increment the iterator -- the test increments, the body carries. */
+ for(k=0; k<$COMP(itdim) && (++(iter[k]))>=($COMP(itdims)[k]) ;k++)
+ iter[k] = 0;
+ } while(k<$COMP(itdim));
+
+
+
+}
+
+
+$SETREVERSIBLE(1);
+
+EOD-MakeComp
+
+ RedoDims => <<'EOD-RedoDims' ,
+{
+ PDL_Indx stdim = $PARENT(ndims) - $COMP(rdim);
+ PDL_Indx dim,inc;
+ PDL_Indx i,rdvalid;
+
+ // Speed bump for ludicrous cases
+ if( $COMP(rdim) > $PARENT(ndims)+5 && $COMP(nsizes) != $COMP(rdim)) {
+ barf("Ludicrous number of extra dims in range index; leaving child null.\n (%d implicit dims is > 5; index has %d dims; source has %d dim%s.)\n This often means that your index PDL is incorrect. To avoid this message,\n allocate dummy dims in the source or use %d dims in range's size field.\n",$COMP(rdim)-$PARENT(ndims),$COMP(rdim),$PARENT(ndims),($PARENT(ndims))>1?"s":"",$COMP(rdim));
+ }
+
+ if(stdim < 0)
+ stdim = 0;
+
+ /* Set dimensionality of child */
+ $CHILD(ndims) = $COMP(itdim) + $COMP(ntsize) + stdim;
+ $SETNDIMS($COMP(itdim)+$COMP(ntsize)+stdim);
+
+ inc = 1;
+ /* Copy size dimensions to child, crunching as we go. */
+ dim = $COMP(itdim);
+ for(i=rdvalid=0;i<$COMP(rdim);i++) {
+ if($COMP(sizes[i])) {
+ rdvalid++;
+ $CHILD(dimincs[dim]) = inc;
+ inc *= ($CHILD(dims[dim++]) = $COMP(sizes[i])); /* assignment */
+ }
+ }
+
+ /* Copy index thread dimensions to child */
+ for(dim=0; dim<$COMP(itdim); dim++) {
+ $CHILD(dimincs[dim]) = inc;
+ inc *= ($CHILD(dims[dim]) = $COMP(itdims[dim])); /* assignment */
+ }
+
+ /* Copy source thread dimensions to child */
+ dim = $COMP(itdim) + rdvalid;
+ for(i=0;i<stdim;i++) {
+ $CHILD(dimincs[dim]) = inc;
+ inc *= ($CHILD(dims[dim++]) = $PARENT(dims[i+$COMP(rdim)])); /* assignment */
+ }
+
+ /* Cover bizarre case where the source PDL is empty - in that case, change */
+ /* all non-barfing boundary conditions to truncation, since we have no data */
+ /* to reflect, extend, or mirror. */
+ if($PARENT(dims[0])==0) {
+ for(dim=0; dim<$COMP(rdim); dim++) {
+ if($COMP(boundary[dim]))
+ $COMP(boundary[dim]) = 1; // force truncation
+ }
+ }
+
+
+ $CHILD(datatype) = $PARENT(datatype);
+
+ $SETDIMS();
+}
+
+EOD-RedoDims
+
+ EquivCPOffsCode => <<'EOD-EquivCPOffsCode',
+{
+ PDL_Indx *iter, *ip; /* vector iterator */
+ PDL_Indx *sizes, *sp; /* size vector including stdims */
+ PDL_Indx *coords; /* current coordinates */
+
+ PDL_Indx k; /* index */
+ PDL_Indx item; /* index thread iterator */
+ PDL_Indx pdim = $PARENT_P(ndims);
+ PDL_Indx rdim = $COMP(rdim);
+ PDL_Indx prdim = (rdim < pdim) ? rdim : pdim;
+ PDL_Indx stdim = pdim - prdim;
+
+ /* Allocate iterator and larger size vector -- do it all in one foop
+ * to avoid extra calls to smalloc.
+ */
+ if(!(iter = (PDL_Indx *)(PDL->smalloc((STRLEN) (sizeof(PDL_Indx) * ($PARENT_P(ndims) * 2 + rdim)))))) {
+ barf("couldn't get memory for range iterator");
+ }
+ sizes = iter + $PARENT_P(ndims);
+ coords = sizes + $PARENT_P(ndims);
+
+ /* Figure out size vector */
+ for(ip = $COMP(sizes), sp = sizes, k=0; k<rdim; k++)
+ *(sp++) = *(ip++);
+ for(; k < $PARENT_P(ndims); k++)
+ *(sp++) = $PARENT_P(dims[k]);
+
+
+ /* Loop over all the ranges in the index list */
+ for(item=0; item<$COMP(nitems); item++) {
+
+ /* initialize in-range iterator to loop within each range */
+ for(ip = iter, k=0; k<$PARENT_P(ndims); k++)
+ *(ip++) = 0;
+
+ do {
+ PDL_Indx poff = 0;
+ PDL_Indx coff;
+ PDL_Indx k2;
+ char trunc = 0; /* Flag used to skip truncation case */
+
+ /* Collect and boundary-check the current N-D coords */
+ for(k=0; k < prdim; k++){
+
+ PDL_Indx ck = iter[k] + $COMP(corners[ item * rdim + k ]) ;
+
+ /* normal case */
+ if(ck < 0 || ck >= $PARENT_P(dims[k])) {
+ switch($COMP(boundary[k])) {
+ case 0: /* no boundary breakage allowed */
+ barf("index out-of-bounds in range");
+ break;
+ case 1: /* truncation */
+ trunc = 1;
+ break;
+ case 2: /* extension -- crop */
+ ck = (ck >= $PARENT_P(dims[k])) ? $PARENT_P(dims[k])-1 : 0;
+ break;
+ case 3: /* periodic -- mod it */
+ ck %= $PARENT_P(dims[k]);
+ if(ck < 0) /* Fix mod breakage in C */
+ ck += $PARENT_P(dims[k]);
+ break;
+ case 4: /* mirror -- reflect off the edges */
+ ck += $PARENT_P(dims[k]);
+ ck %= ($PARENT_P(dims[k]) * 2);
+ if(ck < 0) /* Fix mod breakage in C */
+ ck += $PARENT_P(dims[k])*2;
+ ck -= $PARENT_P(dims[k]);
+ if(ck < 0) {
+ ck *= -1;
+ ck -= 1;
+ }
+ break;
+ default:
+ barf("Unknown boundary condition in range -- bug alert!");
+ break;
+ }
+ }
+
+ coords[k] = ck;
+
+ }
+
+ /* Check extra dimensions -- pick up where k left off... */
+ for( ; k < rdim ; k++) {
+ /* Check for indexing off the end of the dimension list */
+
+ PDL_Indx ck = iter[k] + $COMP(corners[ item * rdim + k ]) ;
+
+ switch($COMP(boundary[k])) {
+ case 0: /* No boundary breakage allowed -- nonzero corners cause barfage */
+ if(ck != 0)
+ barf("Too many dims in range index (and you've forbidden boundary violations)");
+ break;
+ case 1: /* truncation - just truncate if the corner is nonzero */
+ trunc |= (ck != 0);
+ break;
+ case 2: /* extension -- ignore the corner (same as 3) */
+ case 3: /* periodic -- ignore the corner */
+ case 4: /* mirror -- ignore the corner */
+ ck = 0;
+ break;
+ default:
+ barf("Unknown boudnary condition in range -- bug alert!");
+ /* Note clever misspelling of boundary to distinguish from other case */
+ break;
+ }
+ }
+
+ /* Find offsets into the child and parent arrays, from the N-D coords */
+ /* Note we only loop over real source dims (prdim) to accumulate -- */
+ /* because the offset is trivial and/or we're truncating for virtual */
+ /* dims caused by permissive ranging. */
+ coff = $CHILD_P(dimincs[0]) * item;
+ for(k2 = $COMP(itdim), poff = k = 0;
+ k < prdim;
+ k++) {
+ poff += coords[k]*$PARENT_P(dimincs[k]);
+ if($COMP(sizes[k]))
+ coff += iter[k] * $CHILD_P(dimincs[k2++]);
+ }
+
+ /* Loop the copy over all the source thread dims (above rdim). */
+ do {
+ PDL_Indx poff1 = poff;
+ PDL_Indx coff1 = coff;
+
+ /* Accumulate the offset due to source threading */
+ for(k2 = $COMP(itdim) + $COMP(ntsize), k = rdim;
+ k < pdim;
+ k++) {
+ poff1 += iter[k] * $PARENT_P(dimincs[k]);
+ coff1 += iter[k] * $CHILD_P(dimincs[k2++]);
+ }
+
+ /* Finally -- make the copy
+ * EQUIVCPTRUNC works like EQUIVCPOFFS but with checking for
+ * out-of-bounds conditions.
+ */
+ $EQUIVCPTRUNC(coff1,poff1,trunc);
+
+ /* Increment the source thread iterator */
+ for( k=$COMP(rdim);
+ k < $PARENT_P(ndims) && (++(iter[k]) >= $PARENT_P(dims[k]));
+ k++)
+ iter[k] = 0;
+ } while(k < $PARENT_P(ndims)); /* end of source-thread iteration */
+
+ /* Increment the in-range iterator */
+ for(k = 0;
+ k < $COMP(rdim) && (++(iter[k]) >= $COMP(sizes[k]));
+ k++)
+ iter[k] = 0;
+ } while(k < $COMP(rdim)); /* end of main iteration */
+ } /* end of item do loop */
+
+}
+
+EOD-EquivCPOffsCode
+
+);
+
+
+=head2 rld
+=cut
+
+pp_def(
+ 'rld',
+ Pars=>'indx a(n); b(n); [o]c(m);',
+ PMCode =><<'EOD',
+sub PDL::rld {
+ my ($a,$b) = @_;
+ my ($c);
+ if ($#_ == 2) {
+ $c = $_[2];
+ } else {
+# XXX Need to improve emulation of threading in auto-generating c
+ my ($size) = $a->sumover->max;
+ my (@dims) = $a->dims;
+ shift @dims;
+ $c = $b->zeroes($size, at dims);
+ }
+ &PDL::_rld_int($a,$b,$c);
+ $c;
+}
+EOD
+ Code=>'
+ PDL_Indx i,j=0,an;
+ $GENERIC(b) bv;
+ loop (n) %{
+ an = $a();
+ bv = $b();
+ for (i=0;i<an;i++) {
+ $c(m=>j) = bv;
+ j++;
+ }
+ %}',
+ Doc => <<'EOD'
+=for ref
+
+Run-length decode a vector
+
+Given a vector C<$a> of the numbers of instances of values C<$b>, run-length
+decode to C<$c>.
+
+=for example
+
+ rld($a,$b,$c=null);
+
+=cut
+
+EOD
+);
+
+=head2 rle
+=cut
+
+pp_def(
+ 'rle',
+ Pars=>'c(n); indx [o]a(n); [o]b(n);',
+ Code=>'
+ PDL_Indx j=0,sn=$SIZE(n);
+ $GENERIC(c) cv, clv;
+ clv = $c(n=>0);
+ $b(n=>0) = clv;
+ $a(n=>0) = 0;
+ loop (n) %{
+ cv = $c();
+ if (cv == clv) {
+ $a(n=>j)++;
+ } else {
+ j++;
+ $b(n=>j) = clv = cv;
+ $a(n=>j) = 1;
+ }
+ %}
+ for (j++;j<sn;j++) {
+ $a(n=>j) = 0;
+ $b(n=>j) = 0;
+ }
+ ',
+ Doc => <<'EOD'
+=for ref
+
+Run-length encode a vector
+
+Given vector C<$c>, generate a vector C<$a> with the number of each element,
+and a vector C<$b> of the unique values. Only the elements up to the
+first instance of C<0> in C<$a> should be considered.
+
+=for example
+
+ rle($c,$a=null,$b=null);
+
+=cut
+
+EOD
+);
+
+# this one can convert vaffine piddles without(!) physicalising them
+# maybe it can replace 'converttypei' in the future?
+#
+# XXX do not know whether the HandleBad stuff will work here
+#
+pp_def('flowconvert',
+ HandleBad => 1,
+ DefaultFlow => 1,
+ Reversible => 1,
+ Pars => 'PARENT(); [oca]CHILD()',
+ OtherPars => 'int totype;',
+ Reversible => 1,
+ # Forced types
+ FTypes => {CHILD => '$COMP(totype)'},
+ Code =>
+ '$CHILD() = $PARENT();',
+ BadCode =>
+ 'if ( $ISBAD(PARENT()) ) {
+ $SETBAD(CHILD());
+ } else {
+ $CHILD() = $PARENT();
+ }',
+ BackCode => '$PARENT() = $CHILD();',
+ BadBackCode =>
+ 'if ( $ISBAD(CHILD()) ) {
+ $SETBAD(PARENT());
+ } else {
+ $PARENT() = $CHILD();
+ }',
+ Doc => 'internal',
+);
+
+
+pp_def(
+ 'converttypei',
+ HandleBad => 1,
+ DefaultFlow => 1,
+ GlobalNew => 'converttypei_new',
+ OtherPars => 'int totype;',
+ P2Child => 1,
+ NoPdlThread => 1,
+ Identity => 1,
+ Reversible => 1,
+# Forced types
+ FTypes => {CHILD => '$COMP(totype)'},
+ Doc => 'internal',
+);
+
+
+
+# XXX Make clump work with optional parameter!
+if(0) {
+# Special-case
+pp_def(
+ 'clump',
+ DefaultFlow => 1,
+ OtherPars => 'int n',
+ P2Child => 1,
+ Priv => 'int nnew; int nrem;',
+ RedoDims => 'int i; PDL_Indx d1;
+ if($COMP(n) > $PARENT(ndims))
+ /* Now with more flavor: truncate overly long clumps to
+ just clump existing dimensions... (CED 17-Mar-2002) */
+
+ $COMP(n) = $PARENT(ndims);
+
+ /* Old croaking code: */
+ /*$CROAK("Too many dimensions %d to clump from %d", */
+ /* $COMP(n),$PARENT(ndims)); */
+
+ $COMP(nrem) = ($COMP(n)==-1 ? $PARENT(threadids[0]) : $COMP(n));
+ $PRIV(nnew) = $PARENT(ndims) - $COMP(nrem) + 1;
+ $SETNDIMS($PRIV(nnew));
+ d1=1;
+ for(i=0; i<$PRIV(nrem); i++) {
+ d1 *= $PARENT(dims[i]);
+ }
+ $CHILD(dims[0]) = d1;
+ for(; i<$PARENT(ndims); i++) {
+ $CHILD(dims[i-$PRIV(nrem)+1]) = $PARENT(dims[i]);
+ }
+ $SETDIMS();
+ $SETDELTATHREADIDS(1-$COMP(nrem));
+ ',
+ EquivCPOffsCode => '
+ PDL_Indx i;
+ for(i=0; i<$CHILD_P(nvals); i++) {
+ $EQUIVCPOFFS(i,i);
+ }
+ ',
+ Reversible => 1,
+);
+} else {
+
+# Affine! Make sure vaffine chaining understands to stop in the right
+# place.
+# the perl wrapper clump is now defined in Core.pm
+# this is just the low level interface
+pp_def(
+ '_clump_int',
+ P2Child => 1,
+ NoPdlThread => 1,
+ DefaultFlow => 1,
+ Reversible => 1,
+ AffinePriv => 1,
+ OtherPars => 'int n',
+ RedoDims => 'int i; PDL_Indx d1;
+ int nrem; int nnew;
+ if($COMP(n) > $PARENT(ndims)) {
+ /* Now with more flavor: truncate clumping in this case to
+ * the total number of dimensions that actually exist...
+ * --CED 17-Mar-2002
+ */
+ $COMP(n) = -1;
+
+#ifdef older_croaking_code
+ $SETNDIMS(0); /* fix to make sure we do not get problems later */
+ $PRIV(offs) = 0;
+ $SETDIMS();
+ $CROAK("Too many dimensions %d to clump from %d",
+ $COMP(n),$PARENT(ndims));
+#endif
+ }
+ nrem = ($COMP(n)< 0 ? $PARENT(threadids[0]) + 1 + ($COMP(n)) : $COMP(n));
+ if(nrem < 0) {
+ $CROAK("Too many dimensions %d to leave behind when clumping from %d",-$COMP(n),$PARENT(ndims));
+ }
+
+ nnew = $PARENT(ndims) - nrem + 1;
+ $SETNDIMS(nnew);
+ $DOPRIVDIMS();
+ $PRIV(offs) = 0;
+ d1=1;
+ for(i=0; i<nrem; i++) {
+ d1 *= $PARENT(dims[i]);
+ }
+ $CHILD(dims[0]) = d1;
+ $PRIV(incs[0]) = 1;
+ for(; i<$PARENT(ndims); i++) {
+ $CHILD(dims[i-nrem+1]) = $PARENT(dims[i]);
+ $PRIV(incs[i-nrem+1]) = $PARENT(dimincs[i]);
+ }
+ $SETDIMS();
+ $SETDELTATHREADIDS(1-nrem);
+ ',
+ Doc => 'internal',
+);
+}
+
+
+=head2 xchg
+=cut
+
+pp_def(
+ 'xchg',
+ OtherPars => 'int n1; int n2;',
+ DefaultFlow => 1,
+ Reversible => 1,
+ P2Child => 1,
+ NoPdlThread => 1,
+ XCHGOnly => 1,
+ EquivDimCheck => 'if ($COMP(n1) <0)
+ $COMP(n1) += $PARENT(threadids[0]);
+ if ($COMP(n2) <0)
+ $COMP(n2) += $PARENT(threadids[0]);
+ if ($COMP(n1) <0 ||$COMP(n2) <0 ||
+ $COMP(n1) >= $PARENT(threadids[0]) ||
+ $COMP(n2) >= $PARENT(threadids[0]))
+ barf("One of dims %d, %d out of range: should be 0<=dim<%d",
+ $COMP(n1),$COMP(n2),$PARENT(threadids[0]));',
+ EquivPDimExpr => '(($CDIM == $COMP(n1)) ? $COMP(n2) : ($CDIM == $COMP(n2)) ? $COMP(n1) : $CDIM)',
+ EquivCDimExpr => '(($PDIM == $COMP(n1)) ? $COMP(n2) : ($PDIM == $COMP(n2)) ? $COMP(n1) : $PDIM)',
+ Doc => <<'EOD',
+=for ref
+
+exchange two dimensions
+
+Negative dimension indices count from the end.
+
+The command
+
+=for example
+
+ $b = $a->xchg(2,3);
+
+creates C<$b> to be like C<$a> except that the dimensions 2 and 3
+are exchanged with each other i.e.
+
+ $b->at(5,3,2,8) == $a->at(5,3,8,2)
+
+=cut
+
+EOD
+);
+
+pp_addpm(<< 'EOD');
+
+=head2 reorder
+
+=for ref
+
+Re-orders the dimensions of a PDL based on the supplied list.
+
+Similar to the L<xchg|/xchg> method, this method re-orders the dimensions
+of a PDL. While the L<xchg|/xchg> method swaps the position of two dimensions,
+the reorder method can change the positions of many dimensions at
+once.
+
+=for usage
+
+ # Completely reverse the dimension order of a 6-Dim array.
+ $reOrderedPDL = $pdl->reorder(5,4,3,2,1,0);
+
+The argument to reorder is an array representing where the current dimensions
+should go in the new array. In the above usage, the argument to reorder
+C<(5,4,3,2,1,0)>
+indicates that the old dimensions (C<$pdl>'s dims) should be re-arranged to make the
+new pdl (C<$reOrderPDL>) according to the following:
+
+ Old Position New Position
+ ------------ ------------
+ 5 0
+ 4 1
+ 3 2
+ 2 3
+ 1 4
+ 0 5
+
+You do not need to specify all dimensions, only a complete set
+starting at position 0. (Extra dimensions are left where they are).
+This means, for example, that you can reorder() the X and Y dimensions of
+an image, and not care whether it is an RGB image with a third dimension running
+across color plane.
+
+=for example
+
+Example:
+
+ pdl> $a = sequence(5,3,2); # Create a 3-d Array
+ pdl> p $a
+ [
+ [
+ [ 0 1 2 3 4]
+ [ 5 6 7 8 9]
+ [10 11 12 13 14]
+ ]
+ [
+ [15 16 17 18 19]
+ [20 21 22 23 24]
+ [25 26 27 28 29]
+ ]
+ ]
+ pdl> p $a->reorder(2,1,0); # Reverse the order of the 3-D PDL
+ [
+ [
+ [ 0 15]
+ [ 5 20]
+ [10 25]
+ ]
+ [
+ [ 1 16]
+ [ 6 21]
+ [11 26]
+ ]
+ [
+ [ 2 17]
+ [ 7 22]
+ [12 27]
+ ]
+ [
+ [ 3 18]
+ [ 8 23]
+ [13 28]
+ ]
+ [
+ [ 4 19]
+ [ 9 24]
+ [14 29]
+ ]
+ ]
+
+The above is a simple example that could be duplicated by calling
+C<$a-E<gt>xchg(0,2)>, but it demonstrates the basic functionality of reorder.
+
+As this is an index function, any modifications to the
+result PDL will change the parent.
+
+=cut
+
+sub PDL::reorder {
+ my ($pdl, at newDimOrder) = @_;
+
+ my $arrayMax = $#newDimOrder;
+
+ #Error Checking:
+ if( $pdl->getndims < scalar(@newDimOrder) ){
+ my $errString = "PDL::reorder: Number of elements (".scalar(@newDimOrder).") in newDimOrder array exceeds\n";
+ $errString .= "the number of dims in the supplied PDL (".$pdl->getndims.")";
+ barf($errString);
+ }
+
+ # Check to make sure all the dims are within bounds
+ for my $i(0..$#newDimOrder) {
+ my $dim = $newDimOrder[$i];
+ if($dim < 0 || $dim > $#newDimOrder) {
+ my $errString = "PDL::reorder: Dim index $newDimOrder[$i] out of range in position $i\n(range is 0-$#newDimOrder)";
+ barf($errString);
+ }
+ }
+
+ # Checking that they are all present and also not duplicated is done by thread() [I think]
+
+ # a quicker way to do the reorder
+ return $pdl->thread(@newDimOrder)->unthread(0);
+}
+
+EOD
+
+=head2 mv
+=cut
+
+pp_def(
+ 'mv',
+ OtherPars => 'int n1; int n2;',
+ DefaultFlow => 1,
+ Reversible => 1,
+ P2Child => 1,
+ NoPdlThread => 1,
+ XCHGOnly => 1,
+ EquivDimCheck => 'if ($COMP(n1) <0)
+ $COMP(n1) += $PARENT(threadids[0]);
+ if ($COMP(n2) <0)
+ $COMP(n2) += $PARENT(threadids[0]);
+ if ($COMP(n1) <0 ||$COMP(n2) <0 ||
+ $COMP(n1) >= $PARENT(threadids[0]) ||
+ $COMP(n2) >= $PARENT(threadids[0]))
+ barf("One of dims %d, %d out of range: should be 0<=dim<%d",
+ $COMP(n1),$COMP(n2),$PARENT(threadids[0]));',
+ EquivPDimExpr => '(($COMP(n1) < $COMP(n2)) ?
+ (($CDIM < $COMP(n1) || $CDIM > $COMP(n2)) ?
+ $CDIM : (($CDIM == $COMP(n2)) ? $COMP(n1) : $CDIM+1))
+ : (($COMP(n2) < $COMP(n1)) ?
+ (($CDIM > $COMP(n1) || $CDIM < $COMP(n2)) ?
+ $CDIM : (($CDIM == $COMP(n2)) ? $COMP(n1) : $CDIM-1))
+ : $CDIM))',
+ EquivCDimExpr => '(($COMP(n2) < $COMP(n1)) ?
+ (($PDIM < $COMP(n2) || $PDIM > $COMP(n1)) ?
+ $PDIM : (($PDIM == $COMP(n1)) ? $COMP(n2) : $PDIM+1))
+ : (($COMP(n1) < $COMP(n2)) ?
+ (($PDIM > $COMP(n2) || $PDIM < $COMP(n1)) ?
+ $PDIM : (($PDIM == $COMP(n1)) ? $COMP(n2) : $PDIM-1))
+ : $PDIM))',
+ Doc => << 'EOD',
+=for ref
+
+move a dimension to another position
+
+The command
+
+=for example
+
+ $b = $a->mv(4,1);
+
+creates C<$b> to be like C<$a> except that the dimension 4 is moved to the
+place 1, so:
+
+ $b->at(1,2,3,4,5,6) == $a->at(1,5,2,3,4,6);
+
+The other dimensions are moved accordingly.
+Negative dimension indices count from the end.
+=cut
+EOD
+);
+
+=head2 onceslice
+=cut
+
+pp_def(
+ 'oneslice',
+ Doc => <<'EOD',
+=for ref
+
+experimental function - not for public use
+
+=for example
+
+ $a = oneslice();
+
+This is not for public use currently. See the source if you have to.
+This function can be used to accomplish run-time changing of
+transformations i.e. changing the size of some piddle at run-time.
+
+However, the mechanism is not yet finalized and this is just a demonstration.
+=cut
+EOD
+ P2Child => 1,
+ NoPdlThread => 1,
+ DefaultFlow => 1,
+ Reversible => 1,
+ OtherPars => 'int nth; int from; int step; int nsteps;',
+ AffinePriv => 1,
+ RedoDims => '
+ int nth = $PRIV(nth);
+ PDL_Indx from = $PRIV(from);
+ PDL_Indx step = $PRIV(step);
+ PDL_Indx nsteps = $PRIV(nsteps);
+ int i;
+ printf("ONESLICE_REDODIMS %d %d %d %d\n",nth,from,step,nsteps);
+ if(nth >= $PARENT(ndims)) {
+ die("Oneslice: too large nthdim");
+ }
+ if(from + step * (nsteps-1) >= $PARENT(dims[nth])) {
+ die("Oneslice: too many, too large steps");
+ }
+ if(from < 0 || step < 0) {
+ die("Oneslice: can only support positive from & step");
+ }
+ $PRIV(offs) = 0;
+ $SETNDIMS($PARENT(ndims));
+ $DOPRIVDIMS();
+ for(i=0; i<$PARENT(ndims); i++) {
+ $CHILD(dims)[i] = $PARENT(dims)[i];
+ $PRIV(incs)[i] = $PARENT(dimincs)[i];
+ }
+ $CHILD(dims)[nth] = nsteps;
+ $PRIV(incs)[nth] *= step;
+ $PRIV(offs) += from * $PARENT(dimincs)[nth];
+ $SETDELTATHREADIDS(0);
+ $SETDIMS();
+ ',
+ FooCode => # This is why we have this stupid function
+ ' $COMP(from) = i1;
+ $COMP(step) = i2;
+ $COMP(nsteps) = i3;
+ printf("ONESLICE_FOOFUNC %d %d %d %d\n",
+ $COMP(nth),$COMP(from),$COMP(step),$COMP(nsteps));
+ ',
+);
+
+
+pp_addhdr << 'EOH';
+#define sign(x) ( (x) < 0 ? -1 : 1)
+EOH
+
+=head2 oslice
+=cut
+
+# I think the quotes in the =item ":" lines
+# confuse the perldoc stuff
+#
+pp_def(
+ 'oslice',
+ Doc => << 'EOD',
+=for ref
+
+DEPRECATED: 'oslice' is the original 'slice' routine in pre-2.006_006
+versions of PDL. It is left here for reference but will disappear in
+PDL 3.000
+
+Extract a rectangular slice of a piddle, from a string specifier.
+
+C<slice> was the original Swiss-army-knife PDL indexing routine, but is
+largely superseded by the L<NiceSlice|PDL::NiceSlice> source prefilter
+and its associated L<nslice|PDL::Core/nslice> method. It is still used as the
+basic underlying slicing engine for L<nslice|PDL::Core/nslice>,
+and is especially useful in particular niche applications.
+
+=for example
+
+ $a->slice('1:3'); # return the second to fourth elements of $a
+ $a->slice('3:1'); # reverse the above
+ $a->slice('-2:1'); # return last-but-one to second elements of $a
+
+The argument string is a comma-separated list of what to do
+for each dimension. The current formats include
+the following, where I<a>, I<b> and I<c> are integers and can
+take legal array index values (including -1 etc):
+
+=over 8
+
+=item :
+
+takes the whole dimension intact.
+
+=item ''
+
+(nothing) is a synonym for ":"
+(This means that C<$a-E<gt>slice(':,3')> is equal to C<$a-E<gt>slice(',3')>).
+
+=item a
+
+slices only this value out of the corresponding dimension.
+
+=item (a)
+
+means the same as "a" by itself except that the resulting
+dimension of length one is deleted (so if C<$a> has dims C<(3,4,5)> then
+C<$a-E<gt>slice(':,(2),:')> has dimensions C<(3,5)> whereas
+C<$a-E<gt>slice(':,2,:')> has dimensions C<(3,1,5))>.
+
+=item a:b
+
+slices the range I<a> to I<b> inclusive out of the dimension.
+
+=item a:b:c
+
+slices the range I<a> to I<b>, with step I<c> (i.e. C<3:7:2> gives the indices
+C<(3,5,7)>). This may be confusing to Matlab users but several other
+packages already use this syntax.
+
+
+=item '*'
+
+inserts an extra dimension of width 1 and
+
+=item '*a'
+
+inserts an extra (dummy) dimension of width I<a>.
+
+=back
+
+An extension is planned for a later stage allowing
+C<$a-E<gt>slice('(=1),(=1|5:8),3:6(=1),4:6')>
+to express a multidimensional diagonal of C<$a>.
+
+Trivial out-of-bounds slicing is allowed: if you slice a source
+dimension that doesn't exist, but only index the 0th element, then
+C<slice> treats the source as if there were a dummy dimension there.
+The following are all equivalent:
+
+ xvals(5)->dummy(1,1)->slice('(2),0') # Add dummy dim, then slice
+ xvals(5)->slice('(2),0') # Out-of-bounds slice adds dim.
+ xvals(5)->slice((2),0) # NiceSlice syntax
+ xvals(5)->((2))->dummy(0,1) # NiceSlice syntax
+
+This is an error:
+
+ xvals(5)->slice('(2),1') # nontrivial out-of-bounds slice dies
+
+Because slicing doesn't directly manipulate the source and destination
+pdl -- it just sets up a transformation between them -- indexing errors
+often aren't reported until later. This is either a bug or a feature,
+depending on whether you prefer error-reporting clarity or speed of execution.
+
+=cut
+
+EOD
+ P2Child => 1,
+ NoPdlThread => 1,
+ DefaultFlow => 1,
+ OtherPars => 'char* str',
+ Comp => 'int nnew; int nthintact; int intactnew; int ndum;
+ int corresp[$COMP(intactnew)]; PDL_Indx start[$COMP(intactnew)];
+ PDL_Indx inc[$COMP(intactnew)]; PDL_Indx end[$COMP(intactnew)];
+ int nolddims;
+ int whichold[$COMP(nolddims)]; int oldind[$COMP(nolddims)];
+ ',
+ AffinePriv => 1,
+ MakeComp => q~
+ int i;
+ int nthnew; int nthold; int nthreal;
+ PDL_Indx dumsize;
+ char *s; char *ns;
+ int nums[3]; int nthnum;
+ $COMP(nnew)=0;
+ $COMP(ndum)=0;
+ $COMP(nolddims) = 0;
+ if(str[0] == '(')
+ $COMP(nolddims)++;
+ else if (str[0] == '*')
+ $COMP(ndum)++;
+ else if (str[0] != '\0') /* handle empty string */
+ $COMP(nnew)++;
+ for(i=0; str[i]; i++)
+ if(str[i] == ',') {
+ if(str[i+1] == '(')
+ $COMP(nolddims)++;
+ else if(str[i+1] == '*')
+ $COMP(ndum)++;
+ else
+ $COMP(nnew)++;
+ }
+ $COMP(nthintact) = $COMP(nolddims) + $COMP(nnew);
+ $COMP(intactnew) = $COMP(nnew)+$COMP(ndum);
+ $DOCOMPDIMS();
+ nthnew=0; nthold=0; i=0; nthreal=0;
+ s=str-1;
+ do {
+ s++;
+ if(isdigit(*s) || *s == '-') {
+ nthnew++; nthreal++;
+ $COMP(inc[nthnew-1]) = 1;
+ $COMP(corresp[nthnew-1]) = nthreal-1;
+ $COMP(start[nthnew-1]) = strtoll(s,&s,10);
+ if(*s != ':') {
+ $COMP(end[nthnew-1]) =
+ $COMP(start[nthnew-1]);
+ goto outlab;
+ }
+ s++;
+ if(!isdigit(*s) && !(*s == '-')) {
+ barf("Invalid slice str ind1 '%s': '%s'",str,s);
+ }
+ $COMP(end[nthnew-1]) = strtoll(s,&s,10);
+ if(*s != ':') {goto outlab;}
+ s++;
+ if(!isdigit(*s) && !(*s == '-')) {
+ barf("Invalid slice str ind2 '%s': '%s'",str,s);
+ }
+ $COMP(inc[nthnew-1]) = strtoll(s,&s,10);
+ } else switch(*s) {
+ case ':':
+ s++;
+ /* FALLTHRU */
+ case ',': case '\0': /* In these cases, no inc s */
+ if ($COMP(intactnew) > 0) {
+ $COMP(start[nthnew]) = 0;
+ $COMP(end[nthnew]) = -1;
+ $COMP(inc[nthnew]) = 1;
+ $COMP(corresp[nthnew]) = nthreal;
+ nthnew++; nthreal++;
+ }
+ break;
+ case '(':
+ s++;
+ $COMP(oldind[nthold]) = strtoll(s,&s,10);
+ $COMP(whichold[nthold]) = nthreal;
+ nthold++; nthreal++;
+ if(*s != ')') {
+ barf("Sliceoblit must end with ')': '%s': '%s'",str,s);
+ }
+ s++;
+ break;
+ case '*':
+ s++;
+ if(isdigit(*s)) {
+ dumsize = strtoll(s,&s,10);
+ } else {dumsize = 1;}
+ $COMP(corresp[nthnew]) = -1;
+ $COMP(start[nthnew]) = 0;
+ $COMP(end[nthnew]) = dumsize-1;
+ $COMP(inc[nthnew]) = 1;
+ nthnew++;
+ break;
+ }
+ outlab:
+ if(*s != ',' && *s != '\0') {
+ barf("Invalid slice str '%s': '%s'",str,s);
+ }
+ } while(*s);
+ $SETREVERSIBLE(1); /* XXX Only if incs>0, no dummies */
+ ~,
+ RedoDims => '
+ int i; PDL_Indx start; PDL_Indx end; PDL_Indx inc;
+ if ($COMP(nthintact) > $PARENT(ndims)) {
+
+ /* Slice has more dims than parent. Check that the extra dims are
+ * all zero, and if they are then give back What You Probably Wanted,
+ * which is a slice with dummy dimensions of order 1 in place of each excessive
+ * dimension. (Note that there are two ways to indicate a zero index: "0" and "-<w>",
+ * where <w> happens to be the size of that dim in the original
+ * piddle. The latter case still causes an error. That is a feature.)
+ * --CED 15-March-2002
+ */
+ int ii,parentdim,ok;
+ int n_xtra_dims=0, n_xtra_olddims=0;
+
+ /* Check index for each extra dim in the ordinary affine list */
+
+ for(ok=1, ii = 0; ok && ii < $COMP(intactnew) ; ii++) {
+ parentdim = $COMP(corresp[ii]);
+/* fprintf(stderr,"ii=%d,parent=%d, ndum=%d, nnew=%d...",ii,parentdim,$COMP(ndum),$COMP(nnew)); */
+ if(parentdim >= $PARENT(ndims)) {
+
+ ok = ( ( $COMP(start[ii]) == 0 ) &&
+ ( $COMP(end[ii]) == 0 || $COMP(end[ii])== -1 )
+ );
+ if(ok) {
+ /* Change this into a dummy dimension, rank 1 */
+ $COMP(corresp[ii]) = -1;
+ $COMP(start[ii]) = 0;
+ $COMP(end[ii]) = 0;
+ $COMP(inc[ii]) = 1;
+ $COMP(ndum)++; /* One more dummy dimension... */
+ $COMP(nnew)--; /* ... one less real dimension */
+ $COMP(nthintact)--; /* ... one less intact dim */
+/* fprintf(stderr,"ok, ndum=%d, nnew=%d\n",$COMP(ndum), $COMP(nnew));*/
+ }
+/* fflush(stderr);*/
+ }
+ }
+
+ /* Check index for each indexed parent dimension */
+ for(ii=0; ok && ii < $COMP(nolddims); ii++) {
+ if($COMP(whichold[ii]) >= $PARENT(ndims)) {
+ ok = ( $COMP(whichold[ii]) < $PARENT(ndims) ) ||
+ ( $COMP(oldind[ii]) == 0 ) ||
+ ( $COMP(oldind[ii]) == -1) ;
+ if(ok) {
+ int ij;
+ /* crunch indexed dimensions -- slow but sure */
+ $COMP(nolddims)--;
+ for(ij=ii; ij<$COMP(nolddims); ij++) {
+ $COMP(oldind[ij]) = $COMP(oldind[ij+1]);
+ $COMP(whichold[ij]) = $COMP(whichold[ij+1]);
+ }
+ $COMP(nthintact)--;
+ }
+ }
+ }
+/* fprintf(stderr,"ok=%d\n",ok);fflush(stderr);*/
+ if(ok) {
+ /* Valid slice: all extra dims are zero. Adjust indices accordingly. */
+/* $COMP(intactnew) -= $COMP(nthintact) - $PARENT(ndims); */
+/* $COMP(nthintact) = $PARENT(ndims);*/
+ } else {
+
+ /* Invalid slice: nonzero extra dimension. Clean up and die. */
+
+ $SETNDIMS(0); /* dirty fix */
+ $PRIV(offs) = 0;
+ $SETDIMS();
+ $CROAK("Too many dims in slice");
+ }
+ }
+ $SETNDIMS($PARENT(ndims)-$COMP(nthintact)+$COMP(intactnew));
+ $DOPRIVDIMS();
+ $PRIV(offs) = 0;
+ for(i=0; i<$COMP(intactnew); i++) {
+ int parentdim = $COMP(corresp[i]);
+ start = $COMP(start[i]); end = $COMP(end[i]);
+ inc = $COMP(inc[i]);
+ if(parentdim!=-1) {
+ if(-start > $PARENT(dims[parentdim]) ||
+ -end > $PARENT(dims[parentdim])) {
+ /* set a state flag to re-trip the RedoDims code later, in
+ * case this barf is caught in an eval. This slice will
+ * always croak, so it may be smarter to find a way to
+ * replace this whole piddle with a "barf" piddle, but this
+ * will work for now. */
+ PDL->changed($CHILD_PTR(), PDL_PARENTDIMSCHANGED, 0);
+ barf("Negative slice cannot start or end above limit");
+ }
+ if(start < 0)
+ start = $PARENT(dims[parentdim]) + start;
+ if(end < 0)
+ end = $PARENT(dims[parentdim]) + end;
+ if(start >= $PARENT(dims[parentdim]) ||
+ end >= $PARENT(dims[parentdim])) {
+ /* set a state flag to re-trip the RedoDims code later, in
+ * case this barf is caught in an eval. This slice will
+ * always croak, so it may be smarter to find a way to
+ * replace this whole piddle with a "barf" piddle, but this
+ * will work for now. */
+ PDL->changed($CHILD_PTR(), PDL_PARENTDIMSCHANGED, 0);
+ barf("Slice cannot start or end above limit");
+ }
+ if(sign(end-start)*sign(inc) < 0)
+ inc = -inc;
+ $PRIV(incs[i]) = $PARENT(dimincs[parentdim]) * inc;
+ $PRIV(offs) += start * $PARENT(dimincs[parentdim]);
+ } else {
+ $PRIV(incs[i]) = 0;
+ }
+ $CHILD(dims[i]) = ((PDL_Indx)((end-start)/inc))+1;
+ if ($CHILD(dims[i]) <= 0)
+ barf("slice internal error: computed slice dimension must be positive");
+ }
+ for(i=$COMP(nthintact); i<$PARENT(ndims); i++) {
+ int cdim = i - $COMP(nthintact) + $COMP(intactnew);
+ $PRIV(incs[cdim]) = $PARENT(dimincs[i]);
+ $CHILD(dims[cdim]) = $PARENT(dims[i]);
+ }
+ for(i=0; i<$COMP(nolddims); i++) {
+ int oi = $COMP(oldind[i]);
+ int wo = $COMP(whichold[i]);
+ if(oi < 0)
+ oi += $PARENT(dims[wo]);
+ if( oi >= $PARENT(dims[wo]) )
+ $CROAK("Cannot obliterate dimension after end");
+ $PRIV(offs) += $PARENT(dimincs[wo])
+ * oi;
+ }
+ /*
+ for(i=0; i<$CHILD(ndims)-$PRIV(nnew); i++) {
+ $CHILD(dims[i+$COMP(intactnew)]) =
+ $PARENT(dims[i+$COMP(nthintact)]);
+ $PRIV(incs[i+$COMP(intactnew)]) =
+ $PARENT(dimincs[i+$COMP(nthintact)]);
+ }
+ */
+ $SETDIMS();
+ ',
+);
+
+
+pp_addpm(<<'EOD'
+
+=head2 using
+
+=for ref
+
+Returns array of column numbers requested
+
+=for usage
+
+ line $pdl->using(1,2);
+
+Plot, as a line, column 1 of C<$pdl> vs. column 2
+
+=for example
+
+ pdl> $pdl = rcols("file");
+ pdl> line $pdl->using(1,2);
+
+=cut
+
+*using = \&PDL::using;
+sub PDL::using {
+ my ($x, at ind)=@_;
+ @ind = list $ind[0] if (ref $ind[0] eq 'PDL');
+ foreach (@ind) {
+ $_ = $x->slice("($_)");
+ }
+ @ind;
+}
+
+EOD
+);
+
+pp_add_exported('', 'using');
+
+pp_addhdr(<<END
+static int cmp_pdll(const void *a_,const void *b_) {
+ int *a = (int *)a_; int *b=(int *)b_;
+ if(*a>*b) return 1;
+ else if(*a==*b) return 0;
+ else return -1;
+}
+END
+);
+
+
+pp_def( 'affine',
+ P2Child => 1,
+ NoPdlThread => 1,
+ DefaultFlow => 1,
+ Reversible => 1,
+ AffinePriv => 1,
+ GlobalNew => 'affine_new',
+ OtherPars => 'PDL_Indx offspar; SV *dimlist; SV *inclist;',
+ Comp => 'int nd; PDL_Indx offset; PDL_Indx sdims[$COMP(nd)];
+ PDL_Indx sincs[$COMP(nd)];',
+ MakeComp => '
+ int i,n2;
+ PDL_Indx *tmpi;
+ PDL_Indx *tmpd = PDL->packdims(dimlist,&($COMP(nd)));
+ tmpi = PDL->packdims(inclist,&n2);
+ if ($COMP(nd) < 0) {
+ $CROAK("Affine: can not have negative no of dims");
+ }
+ if ($COMP(nd) != n2)
+ $CROAK("Affine: number of incs does not match dims");
+ $DOCOMPDIMS();
+ $COMP(offset) = offspar;
+ for (i=0; i<$COMP(nd); i++) {
+ $COMP(sdims)[i] = tmpd[i];
+ $COMP(sincs)[i] = tmpi[i];
+ }
+ ',
+ RedoDims => '
+ PDL_Indx i;
+ $SETNDIMS($COMP(nd));
+ $DOPRIVDIMS();
+ $PRIV(offs) = $COMP(offset);
+ for (i=0;i<$CHILD(ndims);i++) {
+ $PRIV(incs)[i] = $COMP(sincs)[i];
+ $CHILD(dims)[i] = $COMP(sdims)[i];
+ }
+ $SETDIMS();
+ ',
+ Doc => undef,
+);
+
+=head2 diagonalI
+=cut
+
+pp_def(
+ 'diagonalI',
+ P2Child => 1,
+ NoPdlThread => 1,
+ DefaultFlow => 1,
+ Reversible => 1,
+ AffinePriv => 1,
+ OtherPars => 'SV *list',
+ Comp => 'int nwhichdims; int whichdims[$COMP(nwhichdims)];',
+ MakeComp => '
+ int i,j;
+ PDL_Indx *tmp= PDL->packdims(list,&($COMP(nwhichdims)));
+ if($COMP(nwhichdims) < 1) {
+ $CROAK("Diagonal: must have at least 1 dimension");
+ }
+ $DOCOMPDIMS();
+ for(i=0; i<$COMP(nwhichdims); i++)
+ $COMP(whichdims)[i] = tmp[i];
+ qsort($COMP(whichdims), $COMP(nwhichdims), sizeof(int),
+ cmp_pdll);
+ ',
+ RedoDims => '
+ int nthp,nthc,nthd; int cd = $COMP(whichdims[0]);
+ $SETNDIMS($PARENT(ndims)-$COMP(nwhichdims)+1);
+ $DOPRIVDIMS();
+ $PRIV(offs) = 0;
+ if ($COMP(whichdims)[$COMP(nwhichdims)-1] >= $PARENT(ndims) ||
+ $COMP(whichdims)[0] < 0)
+ $CROAK("Diagonal: dim out of range");
+ nthd=0; nthc=0;
+ for(nthp=0; nthp<$PARENT(ndims); nthp++)
+ if (nthd < $COMP(nwhichdims) &&
+ nthp == $COMP(whichdims)[nthd]) {
+ if (!nthd) {
+ $CHILD(dims)[cd] = $PARENT(dims)[cd];
+ nthc++;
+ $PRIV(incs)[cd] = 0;
+ }
+ if (nthd && $COMP(whichdims)[nthd] ==
+ $COMP(whichdims)[nthd-1])
+ $CROAK("Diagonal: dims must be unique");
+ nthd++; /* advance pointer into whichdims */
+ if($CHILD(dims)[cd] !=
+ $PARENT(dims)[nthp]) {
+ $CROAK("Different dims %d and %d",
+ $CHILD(dims)[cd],
+ $PARENT(dims)[nthp]);
+ }
+ $PRIV(incs)[cd] += $PARENT(dimincs)[nthp];
+ } else {
+ $PRIV(incs)[nthc] = $PARENT(dimincs)[nthp];
+ $CHILD(dims)[nthc] = $PARENT(dims)[nthp];
+ nthc++;
+ }
+ $SETDIMS();
+ ',
+ Doc => << 'EOD',
+=for ref
+
+Returns the multidimensional diagonal over the specified dimensions.
+
+The diagonal is placed at the first (by number) dimension that is
+diagonalized.
+The other diagonalized dimensions are removed. So if C<$a> has dimensions
+C<(5,3,5,4,6,5)> then after
+
+=for example
+
+ $b = $a->diagonal(0,2,5);
+
+the piddle C<$b> has dimensions C<(5,3,4,6)> and
+C<$b-E<gt>at(2,1,0,1)> refers
+to C<$a-E<gt>at(2,1,2,0,1,2)>.
+
+NOTE: diagonal doesn't handle threadids correctly. XXX FIX
+=cut
+EOD
+);
+
+=head2 lags
+=cut
+
+pp_def(
+ 'lags',
+ Doc => <<'EOD',
+=for ref
+
+Returns a piddle of lags to parent.
+
+Usage:
+
+=for usage
+
+ $lags = $a->lags($nthdim,$step,$nlags);
+
+I.e. if C<$a> contains
+
+ [0,1,2,3,4,5,6,7]
+
+then
+
+=for example
+
+ $b = $a->lags(0,2,2);
+
+is a (5,2) matrix
+
+ [2,3,4,5,6,7]
+ [0,1,2,3,4,5]
+
+This order of returned indices is kept because the function is
+called "lags" i.e. the nth lag is n steps behind the original.
+
+C<$step> and C<$nlags> must be positive. C<$nthdim> can be
+negative and will then be counted from the last dim backwards
+in the usual way (-1 = last dim).
+=cut
+EOD
+ P2Child => 1,
+ NoPdlThread => 1,
+ DefaultFlow => 1,
+ Reversible => 1, # XXX Not really
+ AffinePriv => 1,
+ OtherPars => 'int nthdim; int step; int n;',
+ RedoDims => '
+ int i;
+ if ($PRIV(nthdim) < 0) /* the usual conventions */
+ $PRIV(nthdim) = $PARENT(ndims) + $PRIV(nthdim);
+ if ($PRIV(nthdim) < 0 || $PRIV(nthdim) >= $PARENT(ndims))
+ $CROAK("lags: dim out of range");
+ if ($COMP(n) < 1)
+ $CROAK("lags: number of lags must be positive");
+ if ($COMP(step) < 1)
+ $CROAK("lags: step must be positive");
+ $PRIV(offs) = 0;
+ $SETNDIMS($PARENT(ndims)+1);
+ $DOPRIVDIMS();
+ for(i=0; i<$PRIV(nthdim); i++) {
+ $CHILD(dims)[i] = $PARENT(dims)[i];
+ $PRIV(incs)[i] = $PARENT(dimincs)[i];
+ }
+ $CHILD(dims)[i] = $PARENT(dims)[i] - $COMP(step) * ($COMP(n)-1);
+ if ($CHILD(dims)[i] < 1)
+ $CROAK("lags: product of step size and "
+ "number of lags too large");
+ $CHILD(dims)[i+1] = $COMP(n);
+ $PRIV(incs)[i] = ($PARENT(dimincs)[i]);
+ $PRIV(incs)[i+1] = - $PARENT(dimincs)[i] * $COMP(step);
+ $PRIV(offs) += ($CHILD(dims)[i+1] - 1) * (-$PRIV(incs)[i+1]);
+ i++;
+ for(; i<$PARENT(ndims); i++) {
+ $CHILD(dims)[i+1] = $PARENT(dims)[i];
+ $PRIV(incs)[i+1] = $PARENT(dimincs)[i];
+ }
+ $SETDIMS();
+ '
+);
+
+=head2 splitdim
+=cut
+
+pp_def(
+ 'splitdim',
+ Doc => <<'EOD',
+=for ref
+
+Splits a dimension in the parent piddle (opposite of L<clump|PDL::Core/clump>)
+
+After
+
+=for example
+
+ $b = $a->splitdim(2,3);
+
+the expression
+
+ $b->at(6,4,x,y,3,6) == $a->at(6,4,x+3*y)
+
+is always true (C<x> has to be less than 3).
+=cut
+EOD
+ P2Child => 1,
+ NoPdlThread => 1,
+ DefaultFlow => 1,
+ Reversible => 1, # XXX Not really
+ OtherPars => 'int nthdim; int nsp;',
+ AffinePriv => 1,
+ RedoDims => '
+ int i = $COMP(nthdim);
+ int nsp = $COMP(nsp);
+ if(nsp == 0) {die("Splitdim: Cannot split to 0\n");}
+ if(i <0 || i >= $PARENT(ndims)) {
+ die("Splitdim: nthdim (%d) must not be negative or greater or equal to number of dims (%d)\n",
+ i, $PARENT(ndims));
+ }
+ if(nsp > $PARENT(dims[i])) {
+ die("Splitdim: nsp (%d) cannot be greater than dim (%d)\n",
+ nsp, $PARENT(dims[i]));
+ }
+ $PRIV(offs) = 0;
+ $SETNDIMS($PARENT(ndims)+1);
+ $DOPRIVDIMS();
+ for(i=0; i<$PRIV(nthdim); i++) {
+ $CHILD(dims)[i] = $PARENT(dims)[i];
+ $PRIV(incs)[i] = $PARENT(dimincs)[i];
+ }
+ $CHILD(dims)[i] = $COMP(nsp);
+ $CHILD(dims)[i+1] = $PARENT(dims)[i] / $COMP(nsp);
+ $PRIV(incs)[i] = $PARENT(dimincs)[i];
+ $PRIV(incs)[i+1] = $PARENT(dimincs)[i] * $COMP(nsp);
+ i++;
+ for(; i<$PARENT(ndims); i++) {
+ $CHILD(dims)[i+1] = $PARENT(dims)[i];
+ $PRIV(incs)[i+1] = $PARENT(dimincs)[i];
+ }
+ $SETDIMS();
+ ',
+);
+
+=head2 rotate
+=cut
+
+pp_def('rotate',
+ Doc => <<'EOD',
+=for ref
+
+Shift vector elements along with wrap. Flows data back&forth.
+=cut
+EOD
+ Pars=>'x(n); indx shift(); [oca]y(n)',
+ DefaultFlow => 1,
+ Reversible => 1,
+ Code=>'
+ PDL_Indx i,j;
+ PDL_Indx n_size = $SIZE(n);
+ if (n_size == 0)
+ barf("can not shift zero size piddle (n_size is zero)");
+ j = ($shift()) % n_size;
+ if (j < 0)
+ j += n_size;
+ for(i=0; i<n_size; i++,j++) {
+ if (j == n_size)
+ j = 0;
+ $y(n=>j) = $x(n=>i);
+ }',
+ BackCode=>'
+ PDL_Indx i,j;
+ PDL_Indx n_size = $SIZE(n);
+ j = ($shift()) % n_size;
+ if (j < 0)
+ j += n_size;
+ for(i=0; i<n_size; i++,j++) {
+ if (j == n_size)
+ j = 0;
+ $x(n=>i) = $y(n=>j);
+ }
+ '
+);
+
+# This is a bit tricky. Hope I haven't missed any cases.
+
+=head2 threadI
+=cut
+
+pp_def(
+ 'threadI',
+ Doc => <<'EOD',
+=for ref
+
+internal
+
+Put some dimensions to a threadid.
+
+=for example
+
+ $b = $a->threadI(0,1,5); # thread over dims 1,5 in id 1
+
+=cut
+
+EOD
+ P2Child => 1,
+ NoPdlThread => 1,
+ DefaultFlow => 1,
+ Reversible => 1,
+ AffinePriv => 1,
+ CallCopy => 0, # Don't CallCopy for subclassed objects because PDL::Copy calls ThreadI
+ # (Wouldn't cause recursive loop otherwise)
+ OtherPars => 'int id; SV *list',
+ Comp => 'int id; int nwhichdims; int whichdims[$COMP(nwhichdims)];
+ int nrealwhichdims; ',
+ MakeComp => '
+ int i,j;
+ PDL_Indx *tmp= PDL->packdims(list,&($COMP(nwhichdims)));
+ $DOCOMPDIMS();
+ for(i=0; i<$COMP(nwhichdims); i++)
+ $COMP(whichdims)[i] = tmp[i];
+ $COMP(nrealwhichdims) = 0;
+ for(i=0; i<$COMP(nwhichdims); i++) {
+ for(j=i+1; j<$COMP(nwhichdims); j++)
+ if($COMP(whichdims[i]) == $COMP(whichdims[j]) &&
+ $COMP(whichdims[i]) != -1) {
+ $CROAK("Thread: duplicate arg %d %d %d",
+ i,j,$COMP(whichdims[i]));
+ }
+ if($COMP(whichdims)[i] != -1) {
+ $COMP(nrealwhichdims) ++;
+ }
+ }
+ $COMP(id) = id;
+ ',
+ RedoDims => '
+ int nthc,i,j,flag;
+ $SETNDIMS($PARENT(ndims));
+ $DOPRIVDIMS();
+ $PRIV(offs) = 0;
+ nthc=0;
+ for(i=0; i<$PARENT(ndims); i++) {
+ flag=0;
+ if($PARENT(nthreadids) > $COMP(id) && $COMP(id) >= 0 &&
+ i == $PARENT(threadids[$COMP(id)])) {
+ nthc += $COMP(nwhichdims);
+ }
+ for(j=0; j<$COMP(nwhichdims); j++) {
+ if($COMP(whichdims[j] == i)) {flag=1; break;}
+ }
+ if(flag) {
+ continue;
+ }
+ $CHILD(dims[nthc]) = $PARENT(dims[i]);
+ $PRIV(incs[nthc]) = $PARENT(dimincs[i]);
+ nthc++;
+ }
+ for(i=0; i<$COMP(nwhichdims); i++) {
+ int cdim,pdim;
+ cdim = i +
+ ($PARENT(nthreadids) > $COMP(id) && $COMP(id) >= 0?
+ $PARENT(threadids[$COMP(id)]) : $PARENT(ndims))
+ - $COMP(nrealwhichdims);
+ pdim = $COMP(whichdims[i]);
+ if(pdim == -1) {
+ $CHILD(dims[cdim]) = 1;
+ $PRIV(incs[cdim]) = 0;
+ } else {
+ $CHILD(dims[cdim]) = $PARENT(dims[pdim]);
+ $PRIV(incs[cdim]) = $PARENT(dimincs[pdim]);
+ }
+ }
+ $SETDIMS();
+ PDL->reallocthreadids($CHILD_PTR(),
+ ($PARENT(nthreadids)<=$COMP(id) ?
+ $COMP(id)+1 : $PARENT(nthreadids)));
+ for(i=0; i<$CHILD(nthreadids); i++) {
+ $CHILD(threadids[i]) =
+ ($PARENT(nthreadids) > i ?
+ $PARENT(threadids[i]) : $PARENT(ndims)) +
+ (i <= $COMP(id) ? - $COMP(nrealwhichdims) :
+ $COMP(nwhichdims) - $COMP(nrealwhichdims));
+ }
+ $CHILD(threadids[$CHILD(nthreadids)]) = $CHILD(ndims);
+ ',
+);
+
+
+=head2 identvaff
+=cut
+
+# we don't really need this one since it can be achieved with
+# a ->threadI(-1,[])
+pp_def('identvaff',
+ P2Child => 1,
+ NoPdlThread => 1,
+ DefaultFlow => 1,
+ Reversible => 1,
+ AffinePriv => 1,
+ RedoDims => '
+ int i;
+ $SETNDIMS($PARENT(ndims));
+ $DOPRIVDIMS();
+ $PRIV(offs) = 0;
+ for(i=0; i<$PARENT(ndims); i++) {
+ $CHILD(dims[i]) = $PARENT(dims[i]);
+ $PRIV(incs[i]) = $PARENT(dimincs[i]);
+ }
+ $SETDIMS();
+ $SETDELTATHREADIDS(0);
+ $CHILD(threadids[$CHILD(nthreadids)]) = $CHILD(ndims);
+ ',
+ Doc => <<'EOD',
+=for ref
+
+A vaffine identity transformation (includes thread_id copying).
+
+Mainly for internal use.
+=cut
+EOD
+);
+
+
+=head2 unthread
+=cut
+
+pp_def(
+ 'unthread',
+ Doc => <<'EOD',
+=for ref
+
+All threaded dimensions are made real again.
+
+See [TBD Doc] for details and examples.
+=cut
+EOD
+ P2Child => 1,
+ NoPdlThread => 1,
+ DefaultFlow => 1,
+ Reversible => 1,
+ AffinePriv => 1,
+ OtherPars => 'int atind;',
+ RedoDims => '
+ int i;
+ $SETNDIMS($PARENT(ndims));
+ $DOPRIVDIMS();
+ $PRIV(offs) = 0;
+ for(i=0; i<$PARENT(ndims); i++) {
+ int corc;
+ if(i<$COMP(atind)) {
+ corc = i;
+ } else if(i < $PARENT(threadids[0])) {
+ corc = i + $PARENT(ndims)-$PARENT(threadids[0]);
+ } else {
+ corc = i - $PARENT(threadids[0]) + $COMP(atind);
+ }
+ $CHILD(dims[corc]) = $PARENT(dims[i]);
+ $PRIV(incs[corc]) = $PARENT(dimincs[i]);
+ }
+ $SETDIMS();
+ ',
+);
+
+
+pp_add_exported('', 'dice dice_axis');
+pp_addpm(<<'EOD');
+
+=head2 dice
+
+=for ref
+
+Dice rows/columns/planes out of a PDL using indexes for
+each dimension.
+
+This function can be used to extract irregular subsets
+along many dimension of a PDL, e.g. only certain rows in an image,
+or planes in a cube. This can of course be done with
+the usual dimension tricks but this saves having to
+figure it out each time!
+
+This method is similar in functionality to the L<slice|/slice>
+method, but L<slice|/slice> requires that contiguous ranges or ranges
+with constant offset be extracted. ( i.e. L<slice|/slice> requires
+ranges of the form C<1,2,3,4,5> or C<2,4,6,8,10>). Because of this
+restriction, L<slice|/slice> is more memory efficient and slightly faster
+than dice
+
+=for usage
+
+ $slice = $data->dice([0,2,6],[2,1,6]); # Dicing a 2-D array
+
+The arguments to dice are arrays (or 1D PDLs) for each dimension
+in the PDL. These arrays are used as indexes to which rows/columns/cubes,etc
+to dice-out (or extract) from the C<$data> PDL.
+
+Use C<X> to select all indices along a given dimension (compare also
+L<mslice|PDL::Core/mslice>). As usual (in slicing methods) trailing
+dimensions can be omitted implying C<X>'es for those.
+
+=for example
+
+ pdl> $a = sequence(10,4)
+ pdl> p $a
+ [
+ [ 0 1 2 3 4 5 6 7 8 9]
+ [10 11 12 13 14 15 16 17 18 19]
+ [20 21 22 23 24 25 26 27 28 29]
+ [30 31 32 33 34 35 36 37 38 39]
+ ]
+ pdl> p $a->dice([1,2],[0,3]) # Select columns 1,2 and rows 0,3
+ [
+ [ 1 2]
+ [31 32]
+ ]
+ pdl> p $a->dice(X,[0,3])
+ [
+ [ 0 1 2 3 4 5 6 7 8 9]
+ [30 31 32 33 34 35 36 37 38 39]
+ ]
+ pdl> p $a->dice([0,2,5])
+ [
+ [ 0 2 5]
+ [10 12 15]
+ [20 22 25]
+ [30 32 35]
+ ]
+
+As this is an index function, any modifications to the
+slice change the parent (use the C<.=> operator).
+
+=cut
+
+sub PDL::dice {
+
+ my $self = shift;
+ my @dim_indexes = @_; # array of dimension indexes
+
+ # Check that the number of dim indexes <=
+ # number of dimensions in the PDL
+ my $no_indexes = scalar(@dim_indexes);
+ my $noDims = $self->getndims;
+ barf("PDL::dice: Number of index arrays ($no_indexes) not equal to the dimensions of the PDL ($noDims")
+ if $no_indexes > $noDims;
+ my $index;
+ my $pdlIndex;
+ my $outputPDL=$self;
+ my $indexNo = 0;
+
+ # Go thru each index array and dice the input PDL:
+ foreach $index(@dim_indexes){
+ $outputPDL = $outputPDL->dice_axis($indexNo,$index)
+ unless !ref $index && $index eq 'X';
+
+ $indexNo++;
+ }
+
+ return $outputPDL;
+}
+*dice = \&PDL::dice;
+
+
+=head2 dice_axis
+
+=for ref
+
+Dice rows/columns/planes from a single PDL axis (dimension)
+using index along a specified axis
+
+This function can be used to extract irregular subsets
+along any dimension, e.g. only certain rows in an image,
+or planes in a cube. This can of course be done with
+the usual dimension tricks but this saves having to
+figure it out each time!
+
+=for usage
+
+ $slice = $data->dice_axis($axis,$index);
+
+=for example
+
+ pdl> $a = sequence(10,4)
+ pdl> $idx = pdl(1,2)
+ pdl> p $a->dice_axis(0,$idx) # Select columns
+ [
+ [ 1 2]
+ [11 12]
+ [21 22]
+ [31 32]
+ ]
+ pdl> $t = $a->dice_axis(1,$idx) # Select rows
+ pdl> $t.=0
+ pdl> p $a
+ [
+ [ 0 1 2 3 4 5 6 7 8 9]
+ [ 0 0 0 0 0 0 0 0 0 0]
+ [ 0 0 0 0 0 0 0 0 0 0]
+ [30 31 32 33 34 35 36 37 38 39]
+ ]
+
+The trick to using this is that the index selects
+elements along the dimensions specified, so if you
+have a 2D image C<axis=0> will select certain C<X> values
+- i.e. extract columns
+
+As this is an index function, any modifications to the
+slice change the parent.
+
+=cut
+
+sub PDL::dice_axis {
+ my($self,$axis,$idx) = @_;
+
+ # Convert to PDLs: array refs using new, otherwise use topdl:
+ my $ix = (ref($idx) eq 'ARRAY') ? ref($self)->new($idx) : ref($self)->topdl($idx);
+ my $n = $self->getndims;
+ my $a = $ix->getndims;
+ barf("index_axis: index must be <=1D") if $a>1;
+ return $self->mv($axis,0)->index1d($ix)->mv(0,$axis);
+}
+*dice_axis = \&PDL::dice_axis;
+
+
+EOD
+
+pp_addpm(<<'EOD-slice');
+
+=head2 slice
+
+=for usage
+
+ $slice = $data->slice([2,3],'x',[2,2,0],"-1:1:-1", "*3");
+
+=for ref
+
+Extract rectangular slices of a piddle, from a string specifier,
+an array ref specifier, or a combination.
+
+C<slice> is the main method for extracting regions of PDLs and
+manipulating their dimensionality. You can call it directly or
+via he L<NiceSlice|PDL::NiceSlice> source prefilter that extends
+Perl syntax o include array slicing.
+
+C<slice> can extract regions along each dimension of a source PDL,
+subsample or reverse those regions, dice each dimension by selecting a
+list of locations along it, or basic PDL indexing routine. The
+selected subfield remains connected to the original PDL via dataflow.
+In most cases this neither allocates more memory nor slows down
+subsequent operations on either of the two connected PDLs.
+
+You pass in a list of arguments. Each term in the list controls
+the disposition of one axis of the source PDL and/or returned PDL.
+Each term can be a string-format cut specifier, a list ref that
+gives the same information without recourse to string manipulation,
+or a PDL with up to 1 dimension giving indices along that axis that
+should be selected.
+
+If you want to pass in a single string specifier for the entire
+operation, you can pass in a comma-delimited list as the first
+argument. C<slice> detects this condition and splits the string
+into a regular argument list. This calling style is fully
+backwards compatible with C<slice> calls from before PDL 2.006.
+
+B<STRING SYNTAX>
+
+If a particular argument to C<slice> is a string, it is parsed as a
+selection, an affine slice, or a dummy dimension depending on the
+form. Leading or trailing whitespace in any part of each specifier is
+ignored (though it is not ignored within numbers).
+
+=over 3
+
+=item C<< >>, C<< : >>, or C<< X >> -- keep
+
+The empty string, C<:>, or C<X> cause the entire corresponding
+dimension to be kept unchanged.
+
+
+=item C<< <n> >> -- selection
+
+A single number alone causes a single index to be selected from the
+corresponding dimension. The dimension is kept (and reduced to size
+1) in the output.
+
+=item C<< (<n>) >> -- selection and collapse
+
+A single number in parenthesis causes a single index to be selected
+from the corresponding dimension. The dimension is discarded
+(completely eliminated) in the output.
+
+=item C<< <n>:<m> >> -- select an inclusive range
+
+Two numbers separated by a colon selects a range of values from the
+corresponding axis, e.g. C<< 3:4 >> selects elements 3 and 4 along the
+corresponding axis, and reduces that axis to size 2 in the output.
+Both numbers are regularized so that you can address the last element
+of the axis with an index of C< -1 >. If, after regularization, the
+two numbers are the same, then exactly one element gets selected (just
+like the C<< <n> >> case). If, after regulariation, the second number
+is lower than the first, then the resulting slice counts down rather
+than up -- e.g. C<-1:0> will return the entire axis, in reversed
+order.
+
+=item C<< <n>:<m>:<s> >> -- select a range with explicit step
+
+If you include a third parameter, it is the stride of the extracted
+range. For example, C<< 0:-1:2 >> will sample every other element
+across the complete dimension. Specifying a stride of 1 prevents
+autoreversal -- so to ensure that your slice is *always* forward
+you can specify, e.g., C<< 2:$n:1 >>. In that case, an "impossible"
+slice gets an Empty PDL (with 0 elements along the corresponding
+dimension), so you can generate an Empty PDL with a slice of the
+form C<< 2:1:1 >>.
+
+=item C<< *<n> >> -- insert a dummy dimension
+
+Dummy dimensions aren't present in the original source and are
+"mocked up" to match dimensional slots, by repeating the data
+in the original PDL some number of times. An asterisk followed
+by a number produces a dummy dimension in the output, for
+example C<< *2 >> will generate a dimension of size 2 at
+the corresponding location in the output dim list. Omitting
+the numeber (and using just an asterisk) inserts a dummy dimension
+of size 1.
+
+=back
+
+B<ARRAY REF SYNTAX>
+
+If you feed in an ARRAY ref as a slice term, then it can have
+0-3 elements. The first element is the start of the slice along
+the corresponding dim; the second is the end; and the third is
+the stepsize. Different combinations of inputs give the same
+flexibility as the string syntax.
+
+=over 3
+
+=item C<< [] >> - keep dim intact
+
+An empty ARRAY ref keeps the entire corresponding dim
+
+=item C<< [ 'X' ] >> - keep dim intact
+
+=item C<< [ '*',$n ] >> - generate a dummy dim of size $n
+
+If $n is missing, you get a dummy dim of size 1.
+
+=item C<< [ $dex, , 0 ] >> - collapse and discard dim
+
+C<$dex> must be a single value. It is used to index
+the source, and the corresponding dimension is discarded.
+
+=item C<< [ $start, $end ] >> - collect inclusive slice
+
+In the simple two-number case, you get a slice that runs
+up or down (as appropriate) to connect $start and $end.
+
+=item C<< [ $start, $end, $inc ] >> - collect inclusive slice
+
+The three-number case works exactly like the three-number
+string case above.
+
+=back
+
+B<PDL args for dicing>
+
+If you pass in a 0- or 1-D PDL as a slicing argument, the
+corresponding dimension is "diced" -- you get one position
+along the corresponding dim, per element of the indexing PDL,
+e.g. C<< $a->slice( pdl(3,4,9)) >> gives you elements 3, 4, and
+9 along the 0 dim of C<< $a >>.
+
+Because dicing is not an affine transformation, it is slower than
+direct slicing even though the syntax is convenient.
+
+
+=for example
+
+ $a->slice('1:3'); # return the second to fourth elements of $a
+ $a->slice('3:1'); # reverse the above
+ $a->slice('-2:1'); # return last-but-one to second elements of $a
+
+ $a->slice([1,3]); # Same as above three calls, but using array ref syntax
+ $a->slice([3,1]);
+ $a->slice([-2,1]);
+
+=cut
+
+
+##############################
+# 'slice' is now implemented as a small Perl wrapper around
+# a PP call. This permits unification of the former slice,
+# dice, and nslice into a single call. At the moment, dicing
+# is implemented a bit kludgily (it is detected in the Perl
+# front-end), but it is serviceable.
+# --CED 12-Sep-2013
+
+*slice = \&PDL::slice;
+sub PDL::slice (;@) {
+ my ($source, @others) = @_;
+
+ # Deal with dicing. This is lame and slow compared to the
+ # faster slicing, but works okay. It uses the same technique
+ # as dice_axis().
+
+ for my $i(0..$#others) {
+ if( ref $others[$i] eq 'PDL' ) {
+ my $idx = $others[$i];
+ if($idx->ndims > 1) {
+ barf("slice: dicing parameters must be at most 1D (arg $i)\n");
+ }
+ my $nlm = $idx->nelem;
+ if($nlm > 1) {
+ my $n = $source->getndims;
+ $source = $source->mv($i,0)->index1d($idx)->mv(0,$i);
+ $others[$i] = '';
+ } elsif($nlm) {
+ # One element - convert to a regular slice.
+ $others[$i] = $idx->flat->at(0);
+ } else {
+ # Zero elements -- force an extended empty.
+ $others[$i] = "1:0:1";
+ }
+ }
+ }
+
+ PDL::sliceb($source,\@others);
+}
+
+EOD-slice
+
+pp_add_exported('', 'slice');
+
+##########
+# This is a kludge to pull arbitrary data out of a single-element PDL, using the Types.pm stuff,
+# to make it easier to slice using single-element PDL arguments inside a slice specifier.
+# The string $sliceb_data_kludge generates some code that physicalizes a PDL, ensures it has
+# only one element, and extracts that element in a type-independent manner. It's a pain because
+# we have to generate the switch statement using information in the Config typehash. But it saves
+# time compared to parsing out any passed-in PDLs on the Perl side.
+#
+use PDL::Types;
+$sliceb_data_kludge = <<'KLUDGE';
+ { pdl *p = PDL->SvPDLV( *svp );
+ int i;
+ PDL->make_physical(p);
+ if(p->nvals==0)
+ barf("slice: empty PDL in slice specifier");
+ if(p->nvals > 1)
+ barf("slice: multi-element PDL in slice specifier");
+ if( !(p->data) ) {
+ barf("slice: no data in slice specifier PDL! I give up.");
+ }
+ switch( p->datatype ) {
+KLUDGE
+
+for my $type(keys %PDL::Types::typehash) {
+ $sliceb_data_kludge .=
+" case $type: nn = *( ($PDL::Types::typehash{$type}->{realctype} *)(p->data) ); break;\n";
+}
+
+$sliceb_data_kludge .= <<'KLUDGE';
+ default: barf("Unknown PDL type in slice specifier! This should never happen."); break;
+ }
+ }
+KLUDGE
+
+
+##############################
+# sliceb is the core of slice. The "foo/foob" nomenclature is used to avoid the argument
+# counting inherent in a PP PMCode section -- "slice" is a front-end that just rolls up a
+# whole variable-length argument list into a single AV reference.
+#
+# (The real reason for foo/foob architecture, as with range/rangeb, is that I'm too stoopid to figure
+# out how to make the PMCode+Code hack work with PP for dataflow operators... --CED)
+#
+
+pp_def(
+ 'sliceb',
+ P2Child => 1,
+ NoPdlThread => 1,
+ DefaultFlow => 1,
+ OtherPars => 'SV *args;',
+#
+# Comp stash definitions:
+# nargs - number of args in original call
+# odim[] - maps argno to output dim (or -1 for squished dims)
+# idim[] - maps argno to input dim (or -1 for squished dims)
+# odim_top - one more than the highest odim encountered
+# idim_top - one more than the highest idim encountered
+# start[] - maps argno to start index of slice range (inclusive)
+# inc[] - maps argno to increment of slice range
+# end[] - maps argno to end index of slice range (inclusive)
+#
+ Comp => 'int nargs;
+ int odim[$COMP(nargs)];
+ int idim[$COMP(nargs)];
+ int idim_top;
+ int odim_top;
+ PDL_Indx start[$COMP(nargs)];
+ PDL_Indx inc[$COMP(nargs)];
+ PDL_Indx end[$COMP(nargs)];
+ ',
+ AffinePriv => 1,
+ MakeComp => <<'SLICE-MC'
+ int i;
+ int idim;
+ int odim;
+ int imax;
+ int nargs;
+ AV *arglist;
+
+ /*** Make sure we got an array ref as input and turn it into an AV ***/
+ if(!( args &&
+ SvROK(args) &&
+ SvTYPE(SvRV(args))==SVt_PVAV )){
+ barf("slice requires an ARRAY ref containing zero or more arguments");
+ }
+
+ arglist = (AV *)(SvRV(args));
+
+ /* Detect special case of a single comma-delimited string; in that case, */
+ /* split out our own arglist */
+
+ if( (av_len(arglist) == 0) ) {
+ /* single-element list: pull first element */
+ SV **svp;
+ svp = av_fetch(arglist, 0, 0);
+
+ if(svp && *svp && *svp != &PL_sv_undef && SvPOKp(*svp)) {
+
+ /* The element exists and is not undef and has a cached string value */
+ char *s,*ss;
+ s = ss = SvPVbyte_nolen(*svp);
+ for(; *ss && *ss != ','; ss++) {}
+
+ if(*ss == ',') {
+
+ /* the string contains at least one comma. ATTACK! */
+ /* We make a temporary array and populate it with */
+ /* SVs containing substrings -- basically split(/\,/), */
+ /* but without the overhead of a perl call */
+
+ AV *al = (AV *)sv_2mortal((SV *)(newAV()));
+
+ do {
+ SV *sv;
+ char *s1;
+ for(s1=s; *s1 && *s1 != ','; s1++);
+
+ av_push(al, newSVpvn(s, s1-s));
+ if(*s1==',')
+ s = ++s1;
+ else
+ s = s1;
+ } while(*s);
+
+ arglist = al; /* al is ephemeral and will evaporate at the next perl gc */
+
+ } /* end of contains-comma case */
+ } /* end of nontrivial single-element detection */
+ }/* end of single-element detection */
+
+ nargs = $COMP(nargs) = av_len( arglist ) + 1;
+ $DOCOMPDIMS();
+
+ /**********************************************************************/
+ /**** Loop over the elements of the AV input and parse into values ****/
+ /**** in the start/inc/end array ****/
+
+ for(odim=idim=i=0; i<nargs; i++) {
+ SV *this;
+ SV **thisp;
+ SV *sv, **svp;
+ char all_flag = 0;
+ char squish_flag = 0;
+ char dummy_flag = 0;
+ char *str;
+ PDL_Indx n0 = 0;
+ PDL_Indx n1 = -1;
+ PDL_Indx n2 = 0; /* n2 is inc - defaults to 0 (i.e. calc in RedoDims) */
+
+ thisp = av_fetch( arglist, i, 0 );
+ this = (thisp ? *thisp : 0 );
+
+ /** Keep the whole dimension if the element is undefined or missing **/
+ all_flag = ( (!this) || (this==&PL_sv_undef) );
+
+ if(!all_flag) {
+ /*
+ * Main branch -- this element is not an empty string
+ */
+
+ if(SvROK(this)) {
+
+ /*
+ * It's a reference - it better be an array ref.
+ * (Note: PDLs are refs too and are allowed (they cause dicing) --
+ * but those are parsed out in the Perl-side preprocessor
+ * (PDL::slice, declared above).
+ */
+ int nelem;
+ AV *sublist;
+
+ if( SvTYPE(SvRV(this)) != SVt_PVAV ) {
+ barf("slice: non-ARRAY ref in the argument list!");
+ }
+
+ /*
+ * It *is* an array ref! Expand it into an AV so we can read it.
+ */
+ sublist = (AV *)(SvRV(this));
+ if(!sublist) {
+ nelem = 0;
+ } else {
+ nelem = av_len(sublist) + 1;
+ }
+
+ if(nelem > 3) {
+ barf("slice: array refs can have at most 3 elements!");
+ }
+
+ if(nelem==0) { /* No elements - keep it all */
+ all_flag = 1;
+
+ } else /* Got at least one element */{
+
+
+ /* Load the first into n0 and check for dummy or all-clear */
+ /* (if element is missing use the default value already in n0) */
+
+ svp = av_fetch(sublist, 0, 0);
+ if(svp && *svp && *svp != &PL_sv_undef) {
+
+ /* There is a first element. Check if it's a PDL, then a string, then an IV */
+
+ if(SvROK(*svp) && sv_isa(*svp, "PDL")) {
+ PDL_Indx nn;
+SLICE-MC
+. $sliceb_data_kludge # Quick and dirty single-element parser (from above)
+. <<'SLICE-MC'
+ n0 = nn;
+ } else if( SvPOKp(*svp)) {
+
+ /* Not a PDL but has associated string */
+
+ char *str = SvPVbyte_nolen(*svp);
+ switch(*str) {
+ case 'X':
+ all_flag = 1; break;
+ case '*':
+ dummy_flag = 1;
+ n0 = 1; /* n0 is 1 so 2nd field is element count */
+ n1 = 1; /* size defaults to 1 for dummy dims */
+ n2 = 1; /* n2 is forced to 1 so ['*',0] gives an empty */
+ break;
+ default: /* Doesn't start with '*' or 'X' */
+ n0 = SvIV(*svp);
+ n1 = n0; /* n1 defaults to n0 if n0 is present */
+ break;
+ }
+ } else /* the element has no associated string - just parse */ {
+ n0 = SvIV(*svp);
+ n1 = n0; /* n1 defaults to n0 if n0 is present */
+ }
+ } /* end of defined check. if it's undef, leave the n's at their default value.
+
+
+ /* Read the second element into n1 and check for alternate squish syntax */
+ if( (nelem > 1) && (!all_flag) ) {
+ svp = av_fetch(sublist, 1, 0);
+
+ if( svp && *svp && *svp != &PL_sv_undef ) {
+
+ if( SvROK(*svp) && sv_isa(*svp, "PDL")) {
+ PDL_Indx nn;
+SLICE-MC
+. $sliceb_data_kludge
+. <<'SLICE-MC'
+ n1 = nn;
+
+ } else if( SvPOKp(*svp) ) {
+ /* Second element has a string - make sure it's not 'X'. */
+ char *str = SvPVbyte_nolen(*svp);
+ if(*str == 'X') {
+ squish_flag = 1;
+ n1 = n0;
+ } else {
+ n1 = SvIV(*svp);
+ }
+ } else {
+ /* Not a PDL, no string -- just get the IV */
+ n1 = SvIV(*svp);
+ }
+ } /* If not defined, leave at the default */
+ } /* End of second-element check */
+
+
+ /*** Now try to read the third element (inc). ***/
+ if( (nelem > 2) && !(all_flag) && !(squish_flag) && !(dummy_flag) ) {
+ svp = av_fetch(sublist, 2, 0);
+ if( svp && *svp && *svp != &PL_sv_undef ) {
+
+ if(SvROK(*svp) && sv_isa(*svp, "PDL")) {
+ PDL_Indx nn;
+SLICE-MC
+. $sliceb_data_kludge
+. << 'SLICE-MC'
+ n2 = nn;
+ } else {
+ STRLEN len;
+ SvPV( *svp, len );
+ if(len>0) { /* nonzero length -> actual value given */
+ n2 = SvIV(*svp); /* if the step is passed in as 0, it is a squish */
+ if(n2==0) {
+ n1 = n0;
+ squish_flag = 1;
+ }
+ }
+ }
+ } /* end of nontrivial third-element parsing */
+ } /* end of third-element parsing */
+ } /* end of nontrivial sublist parsing */
+
+ } else /* this argument is not an ARRAY ref - parse as a scalar */ {
+
+ /****************************************************************/
+ /*** String handling part of slice is here. Parse out each ***/
+ /*** term: ***/
+ /*** <n> (or NV) - extract one element <n> from this dim ***/
+ /*** <n>:<m> - extract <n> to <m>; autoreverse if nec. ***/
+ /*** <n>:<m>:<s> - extract <n> to <m>, stepping by <s> ***/
+ /*** (<n>) - extract element and discard this dim ***/
+ /*** *<n> - insert a dummy dimension of size <n> ***/
+ /*** : - keep this dim in its entirety ***/
+ /*** X - keep this dim in its entirety ***/
+ /****************************************************************/
+
+ if(SvPOKp(this)) {
+ /* this argument has a cached string */
+
+ char *s;
+ IV len;
+ int subargno = 0;
+ int flagged = 0;
+ int squish_closed = 0;
+ char buf[161];
+ char ii;
+ s = SvPVbyte(this, len);
+
+ /* Very stoopid parsing - should probably make some calls to perl string utilities... */
+ while(*s) {
+ if( isspace( *s ) ) {
+ s++; /* ignore and loop again */
+ } else {
+ /* not whitespace */
+
+ switch(*(s++)) {
+ case '*':
+ if(flagged || subargno)
+ barf("slice: Erroneous '*' (arg %d)",i);
+ dummy_flag = flagged = 1;
+ n0 = 1; /* default this number to 1 (size 1); '*0' yields an empty */
+ n1 = 1; /* no second arg allowed - default to 1 so n0 is element count */
+ n2 = -1; /* -1 so we count down to n1 from n0 */
+ break;
+
+ case '(':
+ if(flagged || subargno)
+ barf("slice: Erroneous '(' (arg %d)",i);
+ squish_flag = flagged = 1;
+
+ break;
+
+ case 'X': case 'x':
+ if(flagged || subargno > 1)
+ barf("slice: Erroneous 'X' (arg %d)",i);
+ if(subargno==0) {
+ all_flag = flagged = 1;
+ }
+ else /* subargno is 1 - squish */ {
+ squish_flag = squish_closed = flagged = 1;
+ }
+ break;
+
+ case '+': case '-':
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ switch(subargno) {
+
+ case 0: /* first arg - change default to 1 element */
+ n0 = strtoll(--s, &s, 10);
+ n1 = n0;
+ if(dummy_flag) {
+ n0 = 1;
+ }
+ break;
+
+ case 1: /* second arg - parse and keep end */
+ n1 = strtoll(--s, &s, 10);
+ break;
+
+ case 2: /* third arg - parse and keep inc */
+ if( squish_flag || dummy_flag ) {
+ barf("slice: erroneous third field in slice specifier (arg %d)",i);
+ }
+ n2 = strtoll(--s, &s, 10);
+ break;
+
+ default: /* oops */
+ barf("slice: too many subargs in scalar slice specifier %d",i);
+ break;
+ }
+ break;
+
+ case ')':
+ if( squish_closed || !squish_flag || subargno > 0) {
+ barf("nslice: erroneous ')' (arg %d)",i);
+ }
+ squish_closed = 1;
+ break;
+
+ case ':':
+ if(squish_flag && !squish_closed) {
+ barf("slice: must close squishing parens (arg %d)",i);
+ }
+ if( subargno == 0 ) {
+ n1 = -1; /* Set "<n>:" default to get the rest of the range */
+ }
+ if( subargno > 1 ) {
+ barf("slice: too many ':'s in scalar slice specifier %d",i);
+ }
+ subargno++;
+ break;
+
+ case ',':
+ barf("slice: ',' not allowed (yet) in scalar slice specifiers!");
+ break;
+
+ default:
+ barf("slice: unexpected '%c' in slice specifier (arg %d)",*s,i);
+ break;
+ }
+ } /* end of conditional in parse loop */
+
+ } /* end of parse loop */
+
+ } else /* end of string parsing */ {
+
+ /* Simplest case -- there's no cached string, so it */
+ /* must be a number. In that case it's a simple */
+ /* extraction. Treated as a separate case for speed. */
+ n0 = SvNV(this);
+ n1 = SvNV(this);
+ n2 = 0;
+ }
+
+ } /* end of scalar handling */
+
+ } /* end of defined-element handling (!all_flag) */
+
+ if( (!all_flag) + (!squish_flag) + (!dummy_flag) < 2 ) {
+ barf("Looks like you triggered a bug in slice. two flags set in dim %d",i);
+ }
+
+ /* Force all_flag case to be a "normal" slice */
+ if(all_flag) {
+ n0 = 0;
+ n1 = -1;
+ n2 = 1;
+ }
+
+ /* Copy parsed values into the limits */
+ $COMP(start[i]) = n0;
+ $COMP(end[i]) = n1;
+ $COMP(inc[i]) = n2;
+
+ /* Deal with dimensions */
+ if(squish_flag) {
+ $COMP(odim[i]) = -1;
+ } else {
+ $COMP(odim[i]) = odim++;
+ }
+ if(dummy_flag) {
+ $COMP(idim[i]) = -1;
+ } else {
+ $COMP(idim[i]) = idim++;
+ }
+
+ } /* end of arg-parsing loop */
+
+ $COMP(idim_top) = idim;
+ $COMP(odim_top) = odim;
+
+ $SETREVERSIBLE(1);
+
+ /*** End of MakeComp for slice */
+ /****************************************/
+SLICE-MC
+ ,
+ RedoDims => q{
+ int o_ndims_extra = 0;
+ PDL_Indx i;
+
+ if( $COMP(idim_top) < $PARENT(ndims) ) {
+ o_ndims_extra = $PARENT(ndims) - $COMP(idim_top);
+ }
+
+ /* slurped dims from the arg parsing, plus any extra thread dims */
+ $SETNDIMS( $COMP(odim_top) + o_ndims_extra );
+ $DOPRIVDIMS();
+ $PRIV(offs) = 0; /* Offset vector to start of slice */
+
+ for(i=0; i<$COMP(nargs); i++) {
+ PDL_Indx start, end;
+
+ /** Belt-and-suspenders **/
+ if( ($COMP(idim[i]) < 0) && ($COMP(odim[i]) < 0) ) {
+ PDL->changed($CHILD_PTR(), PDL_PARENTDIMSCHANGED, 0);
+ barf("slice: Hmmm, both dummy and squished -- this can never happen. I quit.");
+ }
+
+ /** First handle dummy dims since there's no input from the parent **/
+ if( $COMP(idim[i]) < 0 ) {
+ /* dummy dim - offset or diminc. */
+ $CHILD( dims[ $COMP(odim[i]) ] ) = $COMP(end[i]) - $COMP(start[i]) + 1;
+ $PRIV( incs[ $COMP(odim[i]) ] ) = 0;
+ } else {
+ PDL_Indx pdsize;
+
+ /** This is not a dummy dim -- deal with a regular slice along it. **/
+ /** Get parent dim size for this idim, and/or allow permissive slicing **/
+
+ if( $COMP(idim[i]) < $PARENT(ndims)) {
+ pdsize = $PARENT( dims[$COMP(idim[i])] );
+ } else {
+ pdsize = 1;
+ }
+
+ /** Regularize and bounds-check the start location **/
+ start = $COMP(start[i]);
+ if(start < 0)
+ start += pdsize;
+ if( (start < 0) || (start >= pdsize) ) {
+ PDL->changed($CHILD_PTR(), PDL_PARENTDIMSCHANGED, 0);
+ if(i >= $PARENT( ndims )) {
+ barf("slice: slice has too many dims (indexes dim %d; highest is %d)",i,$PARENT( ndims )-1);
+ } else {
+ barf("slice: slice starts out of bounds in pos %d (start is %d; source dim %d runs 0-%d)",i,start,$COMP(idim[i]),pdsize-1);
+ }
+ }
+
+ if( $COMP(odim[i]) < 0) {
+
+ /* squished dim - just update the offset. */
+ /* start is always defined and regularized if we are here here, since */
+ /* both idim[i] and odim[i] can't be <0 */
+
+ $PRIV(offs) += start * $PARENT( dimincs[ $COMP(idim[i]) ] );
+
+ } else /* normal operation */ {
+ PDL_Indx siz;
+ PDL_Indx inc;
+
+ /** Regularize and bounds-check the end location **/
+ end = $COMP(end[i]);
+ if(end<0)
+ end += pdsize;
+ if( (end < 0) || (end >= pdsize) ) {
+ PDL->changed($CHILD_PTR(), PDL_PARENTDIMSCHANGED, 0);
+ barf("slice: slice ends out of bounds in pos %d (end is %d; source dim %d runs 0-%d)",i,end,$COMP(idim[i]),pdsize-1);
+ }
+
+ /* regularize inc */
+
+ inc = $COMP(inc[i]);
+ if(!inc)
+ inc = (start <= end) ? 1 : -1;
+
+ siz = (end - start + inc) / inc ;
+ if(siz<0)
+ siz=0;
+ $CHILD( dims[ $COMP(odim[i]) ] ) = siz;
+ $PRIV( incs[ $COMP(odim[i]) ] ) = $PARENT( dimincs[ $COMP(idim[i]) ] ) * inc;
+ $PRIV(offs) += start * $PARENT( dimincs[ $COMP(idim[i]) ] );
+ } /* end of normal slice case */
+ } /* end of non-dummy slice case */
+ } /* end of nargs loop */
+
+ /* Now fill in thread dimensions as needed. idim and odim persist from the parsing loop */
+ /* up above. */
+ for(i=0; i<o_ndims_extra; i++) {
+ $CHILD( dims [ $COMP(odim_top) + i ] ) = $PARENT( dims [ $COMP(idim_top) + i ] );
+ $PRIV( incs[ $COMP(odim_top) + i ] ) = $PARENT( dimincs[ $COMP(idim_top) + i ] );
+ }
+
+ $SETDIMS();
+
+ } # end of RedoDims for slice
+);
+
+
+pp_addpm({At => 'Bot'},<< 'EOD');
+
+=head1 BUGS
+
+For the moment, you can't slice one of the zero-length dims of an
+empty piddle. It is not clear how to implement this in a way that makes
+sense.
+
+Many types of index errors are reported far from the indexing
+operation that caused them. This is caused by the underlying architecture:
+slice() sets up a mapping between variables, but that mapping isn't
+tested for correctness until it is used (potentially much later).
+
+=head1 AUTHOR
+
+Copyright (C) 1997 Tuomas J. Lukka. Contributions by
+Craig DeForest, deforest at boulder.swri.edu.
+Documentation contributions by David Mertens.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+EOD
+
+
+pp_done();
diff --git a/Basic/SourceFilter/Changes b/Basic/SourceFilter/Changes
new file mode 100644
index 0000000..fbaf12a
--- /dev/null
+++ b/Basic/SourceFilter/Changes
@@ -0,0 +1,41 @@
+1.0.0
+ - fix parsing foreach: detect embedded niceslice expressions
+0.99.2
+ - changed to 2 dot version number
+ - fix parsing problems with interspersed
+ whitespace and comments
+0.991
+ - don't translate method invocation via string, e.g.
+ $a->$method(0)
+ - require PDL in Makefile.PL
+0.99
+ - allow more than one modifier
+ - fix modifier parsing
+0.97
+ - nslice updates (indexing with multidim piddles)
+ yet undocumented I think
+0.96
+ - splitprotected interface similar to split's
+0.95
+ - squeeze modifier (;-)
+0.91
+ - leave 'for(each)? (my|our) $y(0,1) {}' alone
+0.9
+ - source filters clobber the DATA file handle unless they are disabled
+ upon encountering __DATA__|__END__ ! Fixed NiceSlice to avoid that.
+ (now uses Filter::Util::Call directly)
+ - doc updates
+ - doc updates
+0.8
+ - CED: leave 'for(each)? $x(...) {}' alone
+ - fix error bug (reported by Doug Burke)
+ - docs clarification
+0.7
+ - fixed a bug that sometimes screwed up error reporting
+ - modifiers: _,?,|
+0.6
+ - doc updates
+ - declare nslice lvalue sub if perl version >= 5.6.0
+ - KGB: fix multiline parsing
+0.5
+ - initial public release
diff --git a/Basic/SourceFilter/FilterSimple.pm b/Basic/SourceFilter/FilterSimple.pm
new file mode 100644
index 0000000..f5686ab
--- /dev/null
+++ b/Basic/SourceFilter/FilterSimple.pm
@@ -0,0 +1,17 @@
+# This is the new Filter::Simple engine for PDL::NiceSlice
+#
+use Filter::Simple;
+
+FILTER_ONLY
+ all => sub { s/\r\n/\n/g if $^V lt v5.14.0 and $^O eq 'MSWin32'; },
+ code_no_comments =>
+ sub {
+ my ($text1,$text2) = ($_,'');
+ ## print STDERR "**************** Input: \n$text1\n";
+ $text2 = perldlpp('PDL::NiceSlice', $text1);
+ ## print STDERR "**************** Output: $text2\n";
+ $_ = $text2;
+ },
+ all => sub { print if $PDL::NiceSlice::debug_filter };
+
+1;
diff --git a/Basic/SourceFilter/FilterUtilCall.pm b/Basic/SourceFilter/FilterUtilCall.pm
new file mode 100644
index 0000000..f24b86b
--- /dev/null
+++ b/Basic/SourceFilter/FilterUtilCall.pm
@@ -0,0 +1,53 @@
+# This original Filter::Util::Call-based
+# PDL::NiceSlice engine.
+#
+use Filter::Util::Call;
+
+##############################
+# If you mess with the import filter, please also change the pdlpp importer
+# just above this comment! They both do similar things, but one to an eval string
+# and one to an import file.
+# --CED 5-Nov-2007
+#
+sub import {
+ my ($class) = @_;
+ ($file,$offset) = (caller)[1,2]; # for error reporting
+ $offset++;
+
+ ## Parse class name into a regexp suitable for filtration
+ my $terminator = terminator_regexp($class);
+
+ filter_add(
+ sub {
+ my ($status, $off, $end);
+ my $count = 0;
+ my $data = "";
+ while ($status = filter_read()) {
+ return $status if $status < 0;
+
+ if (defined($terminator) && m/$terminator/) {
+ $off=1;
+ last;
+ }
+ if (m/^\s*(__END__|__DATA__)\s*$/) {
+ $end=$1; $off = 1;
+ last;
+ }
+ $data .= $_;
+ $count++;
+ $_ = "";
+ }
+ $_ = $data;
+ $_ = findslice $_ unless $status < 0; # the actual filter
+ $_ .= "no $class;\n" if $off;
+ $_ .= "$end\n" if $end;
+ return $count;
+ }
+ );
+}
+
+sub unimport {
+ filter_del();
+}
+
+1;
diff --git a/Basic/SourceFilter/Makefile.PL b/Basic/SourceFilter/Makefile.PL
new file mode 100644
index 0000000..40206a8
--- /dev/null
+++ b/Basic/SourceFilter/Makefile.PL
@@ -0,0 +1,26 @@
+
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ NAME => 'PDL::NiceSlice',
+ VERSION_FROM => 'NiceSlice.pm',
+ PM => {
+ 'NiceSlice.pm' => '$(INST_LIBDIR)/NiceSlice.pm',
+ 'FilterUtilCall.pm' => '$(INST_LIBDIR)/NiceSlice/FilterUtilCall.pm',
+ 'FilterSimple.pm' => '$(INST_LIBDIR)/NiceSlice/FilterSimple.pm',
+ 'ModuleCompile.pm' => '$(INST_LIBDIR)/NiceSlice/ModuleCompile.pm',
+ },
+ PREREQ_PM => {
+ Filter::Util::Call => 0,
+ Text::Balanced => 0,
+ PDL => 2.003000,
+ },
+);
+
+sub MY::postamble {
+"
+README: README.head NiceSlice.pm
+\tcp README.head README
+\tpod2text NiceSlice.pm >> README
+
+";
+}
diff --git a/Basic/SourceFilter/ModuleCompile.pm b/Basic/SourceFilter/ModuleCompile.pm
new file mode 100644
index 0000000..ffdbad5
--- /dev/null
+++ b/Basic/SourceFilter/ModuleCompile.pm
@@ -0,0 +1,11 @@
+## package Foo;
+use Module::Compile -base;
+
+sub pmc_compile {
+ my ($class, $source) = @_;
+ # Convert $source into (most likely Perl 5) $compiled_output
+ my $filtered = perldlpp('PDL::NiceSlice', $source);
+ return $filtered;
+}
+
+1;
diff --git a/Basic/SourceFilter/NiceSlice.pm b/Basic/SourceFilter/NiceSlice.pm
new file mode 100644
index 0000000..95637a3
--- /dev/null
+++ b/Basic/SourceFilter/NiceSlice.pm
@@ -0,0 +1,1124 @@
+BEGIN {
+ my %engine_ok = (
+ 'Filter::Util::Call' => 'PDL/NiceSlice/FilterUtilCall.pm',
+ 'Filter::Simple' => 'PDL/NiceSlice/FilterSimple.pm',
+ 'Module::Compile' => 'PDL/NiceSlice/ModuleCompile.pm',
+ ); # to validate names
+
+ ## $PDL::NiceSlice::engine = $engine_ok{'Filter::Simple'}; # default engine type
+ ## TODO: Add configuration argument to perldl.conf
+ $PDL::NiceSlice::engine = $engine_ok{'Filter::Util::Call'}; # default engine type
+
+ if ( exists $ENV{PDL_NICESLICE_ENGINE} ) {
+ my $engine = $ENV{PDL_NICESLICE_ENGINE};
+ if ( exists $engine_ok{$engine} and $engine_ok{$engine} ) {
+ $PDL::NiceSlice::engine = $engine_ok{$engine};
+ warn "PDL::NiceSlice using engine '$engine'\n" if $PDL::verbose;
+ } elsif ( exists $engine_ok{$engine} and not $engine_ok{$engine} ) {
+ warn "PDL::NiceSlice using default engine\n" if $PDL::verbose;
+ } else {
+ die "PDL::NiceSlice: PDL_NICESLICE_ENGINE set to invalid engine '$engine'\n";
+ }
+ }
+}
+
+no warnings;
+
+package PDL::NiceSlice;
+
+our $VERSION = '1.000_003';
+$VERSION = eval $VERSION;
+
+$PDL::NiceSlice::debug = defined($PDL::NiceSlice::debug) ? $PDL::NiceSlice::debug : 0;
+# replace all occurences of the form
+#
+# $pdl(args);
+# or
+# $pdl->(args);
+# with
+#
+# $pdl->slice(processed_args);
+#
+#
+# Modified 2-Oct-2001: don't modify $var(LIST) if it's part of a
+# "for $var(LIST)" or "foreach $var(LIST)" statement. CED.
+#
+# Modified 5-Nov-2007: stop processing if we encounter m/^no\s+PDL\;:\;:NiceSlice\;\s*$/.
+
+# the next one is largely stolen from Regexp::Common
+my $RE_cmt = qr'(?:(?:\#)(?:[^\n]*)(?:\n))';
+
+require PDL::Version; # get PDL version number
+#
+# remove code for PDL versions earlier than 2.3
+#
+
+use Text::Balanced; # used to find parenthesis-delimited blocks
+
+# Try overriding the current extract_quotelike() routine
+# needed before using Filter::Simple to work around a bug
+# between Text::Balanced and Filter::Simple for our purpose.
+#
+
+BEGIN {
+
+ no warnings; # quiet warnings for this
+
+ sub Text::Balanced::extract_quotelike (;$$)
+ {
+ my $textref = $_[0] ? \$_[0] : \$_;
+ my $wantarray = wantarray;
+ my $pre = defined $_[1] ? $_[1] : '\s*';
+
+ my @match = Text::Balanced::_match_quotelike($textref,$pre,0,0); # do not match // alone as m//
+ return Text::Balanced::_fail($wantarray, $textref) unless @match;
+ return Text::Balanced::_succeed($wantarray, $textref,
+ $match[2], $match[18]-$match[2], # MATCH
+ @match[18,19], # REMAINDER
+ @match[0,1], # PREFIX
+ @match[2..17], # THE BITS
+ @match[20,21], # ANY FILLET?
+ );
+ };
+
+};
+
+
+# a call stack for error processing
+my @callstack = ('stackbottom');
+sub curarg {
+ my $arg = $callstack[-1]; # return top element of stack
+ $arg =~ s/\((.*)\)/$1/s;
+ return $arg;
+}
+sub savearg ($) {push @callstack,$_[0]}
+sub poparg () {pop @callstack}
+
+my @srcstr = (); # stack for refs to current source strings
+my $offset = 1; # line offset
+my $file = 'unknown';
+
+my $mypostfix = '';
+
+sub autosever {
+ my ($this,$arg) = @_;
+ $arg = 1 unless defined $arg;
+ if ($arg) {$mypostfix = '->sever'} else
+ {$mypostfix = ''}
+}
+
+sub line {
+ die __PACKAGE__." internal error: can't determine line number"
+ if $#srcstr < 0;
+ my $pretext = substr ${$srcstr[0]}, 0, pos(${$srcstr[0]})-1;
+ return ($pretext =~ tr/\n/\n/)+$offset;
+}
+
+sub filterdie {
+ my ($msg) = @_;
+ die "$msg\n\t at $file near line ".
+ line().", slice expression '".curarg()."'\n";
+}
+
+# non-bracketed prefix matching regexp
+my $prebrackreg = qr/^([^\(\{\[]*)/;
+
+# split regex $re separated arglist
+# but ignore bracket-protected bits
+# (i.e. text that is within matched brackets)
+sub splitprotected ($$) {
+ my ($re,$txt) = @_;
+ my ($got,$pre) = (1,'');
+ my @chunks = ('');
+ my $ct = 0; # infinite loop protection
+ while ($got && $txt =~ /[({\[]/ && $ct++ < 1000) {
+ # print "iteration $ct\n";
+ ($got,$txt,$pre) =
+ Text::Balanced::extract_bracketed($txt,'{}()[]',$prebrackreg);
+ my @partialargs = split $re, $pre, -1;
+ $chunks[-1] .= shift @partialargs if @partialargs;
+ push @chunks, @partialargs;
+ $chunks[-1] .= $got;
+ }
+ filterdie "possible infinite parse loop, slice arg '".curarg()."'"
+ if $ct == 1000;
+ my @partialargs = split $re, $txt, -1;
+ $chunks[-1] .= shift @partialargs if @partialargs;
+ push @chunks, @partialargs;
+ return @chunks;
+}
+
+# a pattern that finds occurences of the form
+#
+# $var(
+#
+# and
+#
+# ->(
+#
+# used as the prefix pattern for findslice
+my $prefixpat = qr/.*? # arbitrary leading stuff
+ ((?<!&)\$\w+ # $varname not preceded by '&'
+ |->) # or just '->'
+ (\s|$RE_cmt)* # ignore comments
+ \s* # more whitespace
+ (?=\()/smx; # directly followed by open '(' (look ahead)
+
+# translates a single arg into corresponding slice format
+sub onearg ($) {
+ my ($arg) = @_;
+ print STDERR "processing arg '$arg'\n" if $PDL::NiceSlice::debug;
+ return q|'X'| if $arg =~ /^\s*:??\s*$/; # empty arg or just colon
+ # recursively process args for slice syntax
+ $arg = findslice($arg,$PDL::debug) if $arg =~ $prefixpat;
+ # no doubles colon are matched to avoid confusion with Perl's C<::>
+ if ($arg =~ /(?<!:):(?!:)/) { # a start:stop:delta range
+ my @args = splitprotected '(?<!:):(?!:)', $arg;
+ filterdie "invalid range in slice expression '".curarg()."'"
+ if @args > 3;
+ $args[0] = 0 if !defined $args[0] || $args[0] =~ /^\s*$/;
+ $args[1] = -1 if !defined $args[1] || $args[1] =~ /^\s*$/;
+ $args[2] = undef if !defined $args[2] || $args[2] =~ /^\s*$/;
+ return "[".join(',', at args)."]"; # replace single ':' with ','
+ }
+ # the (pos) syntax, i.e. 0D slice
+ return "[$arg,0,0]" if $arg =~ s/^\s*\((.*)\)\s*$/$1/; # use the new [x,x,0]
+ # we don't allow [] syntax (although that's what slice uses)
+ filterdie "invalid slice expression containing '[', expression was '".
+ curarg()."'" if $arg =~ /^\s*\[/;
+
+ # If the arg starts with '*' it's a dummy call -- force stringification
+ # and prepend a '*' for handling by slice.
+ return "(q(*).($arg))" if($arg =~ s/^\s*\*//);
+
+ # this must be a simple position, leave as is
+ return "$arg";
+}
+
+# process the arg list
+sub procargs {
+ my ($txt) = @_;
+ print STDERR "procargs: got '$txt'\n" if $PDL::NiceSlice::debug;
+ # $txt =~ s/^\s*\((.*)\)\s*$/$1/s; # this is now done by findslice
+ # push @callstack, $txt; # for later error reporting
+ my $args = $txt =~ /^\s*$/s ? '' :
+ join ',', map {onearg $_} splitprotected ',', $txt;
+ ## Leave whitespace/newlines in so line count
+ ## is preserved in error messages. Makes the
+ ## filtered output ugly---iffi the input was
+ ## ugly...
+ ##
+ ## $args =~ s/\s//sg; # get rid of whitespace
+ # pop @callstack; # remove from call stack
+ print STDERR "procargs: returned '($args)'\n" if $PDL::NiceSlice::debug;
+ return "($args)";
+}
+
+# this is the real workhorse that translates occurences
+# of $a(args) into $args->slice(processed_arglist)
+#
+sub findslice {
+ my ($src,$verb) = @_;
+ push @srcstr, \$src;
+ $verb = 0 unless defined $verb;
+ my $processed = '';
+ my $ct=0; # protect against infinite loop
+ my ($found,$prefix,$dummy);
+ while ( $src =~ m/\G($prefixpat)/ && (($found,$dummy,$prefix) =
+ Text::Balanced::extract_bracketed($src,'()',$prefixpat))[0]
+ && $ct++ < 1000) {
+ print STDERR "pass $ct: found slice expr $found at line ".line()."\n"
+ if $verb;
+
+# Do final check for "for $var(LIST)" and "foreach $var(LIST)" syntax.
+# Process into an 'slice' call only if it's not that.
+
+ if ($prefix =~ m/for(each)?(\s+(my|our))?\s+\$\w+(\s|$RE_cmt)*$/s ||
+ # foreach statement: Don't translate
+ $prefix =~ m/->\s*\$\w+$/s) # e.g. $a->$method(args)
+ # method invocation via string, don't translate either
+ {
+ # note: even though we reject this one we need to call
+ # findslice on $found in case
+ # it contains slice expressions
+ $processed .= "$prefix".findslice($found);
+ } else { # statement is a real slice and not a foreach
+
+ my ($call,$pre,$post,$arg);
+
+ # the following section got an overhaul in v0.99
+ # to fix modifier parsing and allow >1 modifier
+ # this code still needs polishing
+ savearg $found; # error reporting
+ print STDERR "findslice: found '$found'\n" if $PDL::NiceSlice::debug;
+ $found =~ s/^\s*\((.*)\)\s*$/$1/s;
+ my ($slicearg, at mods) = splitprotected ';', $found;
+ filterdie "more than 1 modifier group: @mods" if @mods > 1;
+ # filterdie "invalid modifier $1"
+ # if $found =~ /(;\s*[[:graph:]]{2,}?\s*)\)$/;
+ print STDERR "MODS: " . join(',', at mods) . "\n" if $PDL::NiceSlice::debug;
+ my @post = (); # collects all post slice operations
+ my @pre = ();
+ if (@mods) {
+ (my $mod = $mods[0]) =~ s/\s//sg; # eliminate whitespace
+ my @modflags = split '', $mod;
+ print STDERR "MODFLAGS: @modflags\n" if $PDL::NiceSlice::debug;
+ filterdie "more than 1 modifier incompatible with ?: @modflags"
+ if @modflags > 1 && grep (/\?/, @modflags); # only one flag with where
+ my %seen = ();
+ if (@modflags) {
+ for my $mod1 (@modflags) {
+ if ($mod1 eq '?') {
+ $seen{$mod1}++ && filterdie "modifier $mod1 used twice or more";
+ $call = 'where';
+ $arg = "(" . findslice($slicearg) . ")";
+ # $post = ''; # no post action required
+ } elsif ($mod1 eq '_') {
+ $seen{$mod1}++ && filterdie "modifier $mod1 used twice or more";
+ push @pre, 'flat->';
+ $call ||= 'slice'; # do only once
+ $arg = procargs($slicearg);
+ # $post = ''; # no post action required
+ } elsif ($mod1 eq '|') {
+ $seen{$mod1}++ && filterdie "modifier $mod1 used twice or more";
+ $call ||= 'slice';
+ $arg ||= procargs($slicearg);
+ push @post, '->sever';
+ } elsif ($mod1 eq '-') {
+ $seen{$mod1}++ && filterdie "modifier $mod1 used twice or more";
+ $call ||= 'slice';
+ $arg ||= procargs($slicearg);
+ push @post, '->reshape(-1)';
+ } else {
+ filterdie "unknown modifier $mod1";
+ }
+ }
+ } else { # empty modifier block
+ $call = 'slice';
+ $arg = procargs($slicearg);
+ # $post = '';
+ }
+ } else { # no modifier block
+ $call = 'slice';
+ $arg = procargs($slicearg);
+ # $post = '';
+ # $call = 'slice_if_pdl'; # handle runtime checks for $self type
+ # $arg =~ s/\)$/,q{$found})/; # add original argument string
+ # in case $self is not a piddle
+ # and the original call must be
+ # generated
+ }
+ $pre = join '', @pre;
+ # assumption here: sever should be last
+ # and order of other modifiers doesn't matter
+ $post = join '', sort @post; # need to ensure that sever is last
+ $processed .= "$prefix". ($prefix =~ /->(\s*$RE_cmt*)*$/ ?
+ '' : '->').
+ $pre.$call.$arg.$post.$mypostfix;
+ }
+
+ } # end of while loop
+
+ poparg; # clean stack
+ pop @srcstr; # clear stack
+ # append the remaining text portion
+ # use substr only if we have had at least one pass
+ # through above loop (otherwise pos is uninitialized)
+ $processed .= $ct > 0 ? substr $src, pos($src) : $src;
+}
+
+##############################
+# termstr - generate a regexp to find turn-me-off strings
+# CED 5-Nov-2007
+sub terminator_regexp{
+ my $clstr = shift;
+ $clstr =~ s/([^a-zA-Z0-9])/\\$1/g;
+ my $termstr = '^\s*no\s+'.$clstr.'\s*;\s*(#.*)*$';
+ return qr/$termstr/o; # allow trailing comments
+}
+
+sub reinstator_regexp{
+ my $clstr = shift;
+ $clstr =~ s/([^a-zA-Z0-9])/\\$1/g;
+ my $reinstr = '^\s*use\s+'.$clstr.'\s*;\s*(#.*)*$';
+ return qr/$reinstr/o; # allow trailing comments
+}
+
+# save eval of findslice that should be used within perldl or pdl2
+# as a preprocessor
+sub perldlpp {
+ my ($class, $txt) = @_;
+ local($_);
+ ##############################
+ # Backwards compatibility to before the two-parameter form. The only
+ # call should be around line 206 of PDL::AutoLoader, but one never
+ # knows....
+ # -- CED 5-Nov-2007
+ if(!defined($txt)) {
+ print "PDL::NiceSlice::perldlpp -- got deprecated one-argument form, from ".(join("; ",caller))."...\n";
+ $txt = $class;
+ $class = "PDL::NiceSlice";
+ }
+
+ ## Debugging to track exactly what is going on -- left in, in case it's needed again
+ if($PDL::debug > 1) {
+ print "PDL::NiceSlice::perldlpp - got:\n$txt\n";
+ my $i;
+ for $i(0..5){
+ my($package,$filename,$line,$subroutine, $hasargs) = caller($i);
+ printf("layer %d: %20s, %40s, line %5d, sub %20s, args: %d\n",$i,$package,$filename,$line,$subroutine,$hasargs);
+ }
+ }
+
+ my $new;
+
+ ##############################
+ ## This block sort-of echoes import(), below...
+ ## Crucial difference: we don't give up the ghost on termination conditions, only
+ ## mask out current findslices. That's because future uses won't be processed
+ ## (for some reason source filters don't work on evals).
+
+ my @lines= split /\n/,$txt;
+
+ my $terminator = terminator_regexp($class);
+ my $reinstator = reinstator_regexp($class);
+
+ my($status, $off, $end);
+ eval {
+ do {
+ my $data = "";
+ while(@lines) {
+ $_= shift @lines;
+ if(defined($terminator) && m/$terminator/) {
+ $_ = "## $_";
+ $off = 1;
+ last;
+ }
+ if(defined($reinstator) && m/$reinstator/) {
+ $_ = "## $_";
+ }
+ if(m/^\s*(__END__|__DATA__)\s*$/) {
+ $end=$1; $off = 1;
+ last;
+ }
+ $data .= "$_\n";
+ $count++;
+ $_="";
+ }
+ $_ = $data;
+ $_ = findslice $_ ;
+ $_ .= "no $class;\n" if $off;
+ $_ .= "$end\n" if $end;
+ $new .= "$_";
+
+ while($off && @lines) {
+ $_ = shift @lines;
+ if(defined($reinstator) && m/$reinstator/) {
+ $off = 0;
+ $_ = "## $_";
+ }
+ if(defined($terminator) && m/$terminator/) {
+ $_ = "## $_";
+ }
+
+ $new .= "$_\n";
+
+ }
+ } while(@lines && !$end);
+ };
+
+ if ($@) {
+ my $err = $@;
+ for (split '','#!|\'"%~/') {
+ return "print q${_}NiceSlice error: $err${_}"
+ unless $err =~ m{[$_]};
+ }
+ return "print q{NiceSlice error: $err}"; # if this doesn't work
+ # we're stuffed
+ }
+
+ if($PDL::debug > 1) {
+ print "PDL::NiceSlice::perldlpp - returning:\n$new\n";
+ }
+ return $new;
+}
+
+BEGIN {
+ require "$PDL::NiceSlice::engine";
+}
+
+=head1 NAME
+
+PDL::NiceSlice - toward a nicer slicing syntax for PDL
+
+=head1 SYNOPSYS
+
+ use PDL::NiceSlice;
+
+ $a(1:4) .= 2; # concise syntax for ranges
+ print $b((0),1:$end); # use variables in the slice expression
+ $a->xchg(0,1)->(($pos-1)) .= 0; # default method syntax
+
+ $idx = long 1, 7, 3, 0; # a piddle of indices
+ $a(-3:2:2,$idx) += 3; # mix explicit indexing and ranges
+ $a->clump(1,2)->(0:30); # 'default method' syntax
+ $a(myfunc(0,$var),1:4)++; # when using functions in slice expressions
+ # use parentheses around args!
+
+ $b = $a(*3); # Add dummy dimension of order 3
+
+ # modifiers are specified in a ;-separated trailing block
+ $a($a!=3;?)++; # short for $a->where($a!=3)++
+ $a(0:1114;_) .= 0; # short for $a->flat->(0:1114)
+ $b = $a(0:-1:3;|); # short for $a(0:-1:3)->sever
+ $n = sequence 3,1,4,1;
+ $b = $n(;-); # drop all dimensions of size 1 (AKA squeeze)
+ $b = $n(0,0;-|); # squeeze *and* sever
+ $c = $a(0,3,0;-); # more compact way of saying $a((0),(3),(0))
+
+=head1 DESCRIPTION
+
+Slicing is a basic, extremely common operation, and PDL's
+L<slice|PDL::Slices/slice> method would be cumbersome to use in many
+cases. C<PDL::NiceSlice> rectifies that by incorporating new slicing
+syntax directly into the language via a perl I<source filter> (see
+L<the perlfilter man page|perlfilter>). NiceSlice adds no new functionality, only convenient syntax.
+
+NiceSlice is loaded automatically in the perldl or pdl2 shell, but (to avoid
+conflicts with other modules) must be loaded explicitly in standalone
+perl/PDL scripts (see below). If you prefer not to use a prefilter on
+your standalone scripts, you can use the L<slice|PDL::Slices/slice>
+method in those scripts,
+rather than the more compact NiceSlice constructs.
+
+=head1 Use in scripts and C<perldl> or C<pdl2> shell
+
+The new slicing syntax can be switched on and off in scripts
+and perl modules by using or unloading C<PDL::NiceSlice>.
+
+But now back to scripts and modules.
+Everything after C<use PDL::NiceSlice> will be translated
+and you can use the new slicing syntax. Source filtering
+will continue until the end of the file is encountered.
+You can stop sourcefiltering before the end of the file
+by issuing a C<no PDL::NiceSlice> statement.
+
+Here is an example:
+
+ use PDL::NiceSlice;
+
+ # this code will be translated
+ # and you can use the new slicing syntax
+
+ no PDL::NiceSlice;
+
+ # this code won't
+ # and the new slicing syntax will raise errors!
+
+See also L<Filter::Simple> and F<example> in this distribution for
+further examples.
+
+NOTE: Unlike "normal" modules you need to include a
+C<use PDL::NiceSlice> call in each and every file that
+contains code that uses the new slicing syntax. Imagine
+the following situation: a file F<test0.pl>
+
+ # start test0.pl
+ use PDL;
+ use PDL::NiceSlice;
+
+ $a = sequence 10;
+ print $a(0:4),"\n";
+
+ require 'test1.pl';
+ # end test0.pl
+
+that C<require>s a second file F<test1.pl>
+
+ # begin test1.pl
+ $aa = sequence 11;
+ print $aa(0:7),"\n";
+ 1;
+ # end test1.pl
+
+Following conventional perl wisdom everything should be alright
+since we C<use>d C<PDL> and C<PDL::NiceSlice> already from within
+F<test0.pl> and by the time F<test1.pl> is C<require>d things should
+be defined and imported, etc. A quick test run will, however, produce
+something like the following:
+
+ perl test0.pl
+ [0 1 2 3 4]
+ syntax error at test1.pl line 3, near "0:"
+ Compilation failed in require at test0.pl line 7.
+
+This can be fixed by adding the line
+
+ use PDL::NiceSlice;
+
+C<before> the code in F<test1.pl> that uses the
+new slicing syntax (to play safe just include the line
+near the top of the file), e.g.
+
+ # begin corrected test1.pl
+ use PDL::NiceSlice;
+ $aa = sequence 11;
+ print $aa(0:7),"\n";
+ 1;
+ # end test1.pl
+
+Now things proceed more smoothly
+
+ perl test0.pl
+ [0 1 2 3 4]
+ [0 1 2 3 4 5 6 7]
+
+Note that we don't need to issue C<use PDL> again.
+C<PDL::NiceSlice> is a somewhat I<funny> module in
+that respect. It is a consequence of the way source
+filtering works in Perl (see also the IMPLEMENTATION
+section below).
+
+=head2 evals and C<PDL::NiceSlice>
+
+Due to C<PDL::NiceSlice> being a source filter it won't work
+in the usual way within evals. The following will I<not> do what
+you want:
+
+ $a = sequence 10;
+ eval << 'EOE';
+
+ use PDL::NiceSlice;
+ $b = $a(0:5);
+
+ EOE
+ print $b;
+
+Instead say:
+
+ use PDL::NiceSlice;
+ $a = sequence 10;
+ eval << 'EOE';
+
+ $b = $a(0:5);
+
+ EOE
+ print $b;
+
+Source filters I<must> be executed at compile time to be effective. And
+C<PDL::NiceFilter> is just a source filter (although it is not
+necessarily obvious for the casual user).
+
+=head1 The new slicing syntax
+
+Using C<PDL::NiceSlice> slicing piddles becomes so much easier since, first of
+all, you don't need to make explicit method calls. No
+
+ $pdl->slice(....);
+
+calls, etc. Instead, C<PDL::NiceSlice> introduces two ways in which to
+slice piddles without too much typing:
+
+=over 2
+
+=item *
+
+using parentheses directly following a scalar variable name,
+for example
+
+ $c = $b(0:-3:4,(0));
+
+=item *
+
+using the so called I<default method> invocation in which the
+piddle object is treated as if it were a reference to a
+subroutine (see also L<perlref>). Take this example that slices
+a piddle that is part of a perl list C<@b>:
+
+ $c = $b[0]->(0:-3:4,(0));
+
+=back
+
+The format of the argument list is the same for both types of
+invocation and will be explained in more detail below.
+
+=head2 Parentheses following a scalar variable name
+
+An arglist in parentheses following directly after a scalar variable
+name that is I<not> preceded by C<&> will be resolved as a slicing
+command, e.g.
+
+ $a(1:4) .= 2; # only use this syntax on piddles
+ $sum += $a(,(1));
+
+However, if the variable name is immediately preceded by a C<&>,
+for example
+
+ &$a(4,5);
+
+it will not be interpreted as a slicing expression. Rather, to avoid
+interfering with the current subref syntax, it will be treated as an
+invocation of the code reference C<$a> with argumentlist C<(4,5)>.
+
+The $a(ARGS) syntax collides in a minor way with the perl syntax. In
+particular, ``foreach $var(LIST)'' appears like a PDL slicing call.
+NiceSlice avoids translating the ``for $var(LIST)'' and
+``foreach $var(LIST)'' constructs for this reason. Since you
+can't use just any old lvalue expression in the 'foreach' 'for'
+constructs -- only a real perl scalar will do -- there's no
+functionality lost. If later versions of perl accept
+``foreach <lvalue-expr> (LIST)'', then you can use the code ref
+syntax, below, to get what you want.
+
+=head2 The I<default method> syntax
+
+The second syntax that will be recognized is what I called the
+I<default method> syntax. It is the method arrow C<-E<gt>> directly
+followed by an open parenthesis, e.g.
+
+ $a->xchg(0,1)->(($pos)) .= 0;
+
+Note that this conflicts with the use of normal code references, since you
+can write in plain Perl
+
+ $sub = sub { print join ',', @_ };
+ $sub->(1,'a');
+
+NOTE: Once C<use PDL::NiceSlice> is in effect (you can always switch it off with
+a line C<no PDL::NiceSlice;> anywhere in the script) the source filter will incorrectly
+replace the above call to C<$sub> with an invocation of the slicing method.
+This is one of the pitfalls of using a source filter that doesn't know
+anything about the runtime type of a variable (cf. the
+Implementation section).
+
+This shouldn't be a major problem in practice; a simple workaround is to use
+the C<&>-way of calling subrefs, e.g.:
+
+ $sub = sub { print join ',', @_ };
+ &$sub(1,'a');
+
+=head2 When to use which syntax?
+
+Why are there two different ways to invoke slicing?
+The first syntax C<$a(args)> doesn't work with chained method calls. E.g.
+
+ $a->xchg(0,1)(0);
+
+won't work. It can I<only> be used directly following a valid perl variable
+name. Instead, use the I<default method> syntax in such cases:
+
+ $a->xchg(0,1)->(0);
+
+Similarly, if you have a list of piddles C<@pdls>:
+
+ $b = $pdls[5]->(0:-1);
+
+=head2 The argument list
+
+The argument list is a comma separated list. Each argument specifies
+how the corresponding dimension in the piddle is sliced. In contrast
+to usage of the L<slice|PDL::Slices/slice> method the arguments should
+I<not> be quoted. Rather freely mix literals (1,3,etc), perl
+variables and function invocations, e.g.
+
+ $a($pos-1:$end,myfunc(1,3)) .= 5;
+
+There can even be other slicing commands in the arglist:
+
+ $a(0:-1:$pdl($step)) *= 2;
+
+NOTE: If you use function calls in the arglist make sure that
+you use parentheses around their argument lists. Otherwise the
+source filter will get confused since it splits the argument
+list on commas that are not protected by parentheses. Take
+the following example:
+
+ sub myfunc { return 5*$_[0]+$_[1] }
+ $a = sequence 10;
+ $sl = $a(0:myfunc 1, 2);
+ print $sl;
+ PDL barfed: Error in slice:Too many dims in slice
+ Caught at file /usr/local/bin/perldl, line 232, pkg main
+
+
+The simple fix is
+
+ $sl = $a(0:myfunc(1, 2));
+ print $sl;
+ [0 1 2 3 4 5 6 7]
+
+Note that using prototypes in the definition of myfunc does not help.
+At this stage the source filter is simply not intelligent enough to
+make use of this information. So beware of this subtlety.
+
+Another pitfall to be aware of: currently, you can't use the conditional
+operator in slice expressions (i.e., C<?:>, since the parser confuses them
+with ranges). For example, the following will cause an error:
+
+ $a = sequence 10;
+ $b = rand > 0.5 ? 0 : 1; # this one is ok
+ print $a($b ? 1 : 2); # error !
+ syntax error at (eval 59) line 3, near "1,
+
+For the moment, just try to stay clear of the conditional operator
+in slice expressions (or provide us with a patch to the parser to
+resolve this issue ;).
+
+=head2 Modifiers
+
+Following a suggestion originally put forward by Karl Glazebrook the
+latest versions of C<PDL::NiceSlice> implement I<modifiers> in slice
+expressions. Modifiers are convenient shorthands for common variations
+on PDL slicing. The general syntax is
+
+ $pdl(<slice>;<modifier>)
+
+Four modifiers are currently implemented:
+
+=over
+
+=item *
+
+C<_> : I<flatten> the piddle before applying the slice expression. Here
+is an example
+
+ $b = sequence 3, 3;
+ print $b(0:-2;_); # same as $b->flat->(0:-2)
+ [0 1 2 3 4 5 6 7]
+
+which is quite different from the same slice expression without the modifier
+
+ print $b(0:-2);
+ [
+ [0 1]
+ [3 4]
+ [6 7]
+ ]
+
+=item *
+
+C<|> : L<sever|PDL::Core/sever> the link to the piddle, e.g.
+
+ $a = sequence 10;
+ $b = $a(0:2;|)++; # same as $a(0:2)->sever++
+ print $b;
+ [1 2 3]
+ print $a; # check if $a has been modified
+ [0 1 2 3 4 5 6 7 8 9]
+
+=item *
+
+C<?> : short hand to indicate that this is really a
+L<where|PDL::Primitive/where> expression
+
+As expressions like
+
+ $a->where($a>5)
+
+are used very often you can write that shorter as
+
+ $a($a>5;?)
+
+With the C<?>-modifier the expression preceding the modifier is I<not>
+really a slice expression (e.g. ranges are not allowed) but rather an
+expression as required by the L<where|PDL::Primitive/where> method.
+For example, the following code will raise an error:
+
+ $a = sequence 10;
+ print $a(0:3;?);
+ syntax error at (eval 70) line 3, near "0:"
+
+That's about all there is to know about this one.
+
+=item *
+
+C<-> : I<squeeze> out any singleton dimensions. In less technical terms:
+reduce the number of dimensions (potentially) by deleting all
+dims of size 1. It is equivalent to doing a L<reshape|PDL::Core/reshape>(-1).
+That can be very handy if you want to simplify
+the results of slicing operations:
+
+ $a = ones 3, 4, 5;
+ $b = $a(1,0;-); # easier to type than $a((1),(0))
+ print $b->info;
+ PDL: Double D [5]
+
+It also provides a unique opportunity to have smileys in your code!
+Yes, PDL gives new meaning to smileys.
+
+=back
+
+=head2 Combining modifiers
+
+Several modifiers can be used in the same expression, e.g.
+
+ $c = $a(0;-|); # squeeze and sever
+
+Other combinations are just as useful, e.g. C<;_|> to flatten and
+sever. The sequence in which modifiers are specified is not important.
+
+A notable exception is the C<where> modifier (C<?>) which must not
+be combined with other flags (let me know if you see a good reason
+to relax this rule).
+
+Repeating any modifier will raise an error:
+
+ $c = $a(-1:1;|-|); # will cause error
+ NiceSlice error: modifier | used twice or more
+
+Modifiers are still a new and experimental feature of
+C<PDL::NiceSlice>. I am not sure how many of you are actively using
+them. I<Please do so and experiment with the syntax>. I think
+modifiers are very useful and make life a lot easier. Feedback is
+welcome as usual. The modifier syntax will likely be further tuned in
+the future but we will attempt to ensure backwards compatibility
+whenever possible.
+
+=head2 Argument formats
+
+In slice expressions you can use ranges and secondly,
+piddles as 1D index lists (although compare the description
+of the C<?>-modifier above for an exception).
+
+=over 2
+
+=item * ranges
+
+You can access ranges using the usual C<:> separated format:
+
+ $a($start:$stop:$step) *= 4;
+
+Note that you can omit the trailing step which then defaults to 1. Double
+colons (C<::>) are not allowed to avoid clashes with Perl's namespace
+syntax. So if you want to use steps different from the default
+you have to also at least specify the stop position.
+Examples:
+
+ $a(::2); # this won't work (in the way you probably intended)
+ $a(:-1:2); # this will select every 2nd element in the 1st dim
+
+Just as with L<slice|PDL::Slices/slice> negative indices count from the end of the dimension
+backwards with C<-1> being the last element. If the start index is larger
+than the stop index the resulting piddle will have the elements in reverse
+order between these limits:
+
+ print $a(-2:0:2);
+ [8 6 4 2 0]
+
+A single index just selects the given index in the slice
+
+ print $a(5);
+ [5]
+
+Note, however, that the corresponding dimension is not removed from
+the resulting piddle but rather reduced to size 1:
+
+ print $a(5)->info
+ PDL: Double D [1]
+
+If you want to get completely rid of that dimension enclose the index
+in parentheses (again similar to the L<slice|PDL::Slices/slice> syntax):
+
+ print $a((5));
+ 5
+
+In this particular example a 0D piddle results. Note that this syntax is
+only allowed with a single index. All these will be errors:
+
+ print $a((0,4)); # will work but not in the intended way
+ print $a((0:4)); # compile time error
+
+An empty argument selects the whole dimension, in this example
+all of the first dimension:
+
+ print $a(,(0));
+
+Alternative ways to select a whole dimension are
+
+ $a = sequence 5, 5;
+ print $a(:,(0));
+ print $a(0:-1,(0));
+ print $a(:-1,(0));
+ print $a(0:,(0));
+
+Arguments for trailing dimensions can be omitted. In that case
+these dimensions will be fully kept in the sliced piddle:
+
+ $a = random 3,4,5;
+ print $a->info;
+ PDL: Double D [3,4,5]
+ print $a((0))->info;
+ PDL: Double D [4,5]
+ print $a((0),:,:)->info; # a more explicit way
+ PDL: Double D [4,5]
+ print $a((0),,)->info; # similar
+ PDL: Double D [4,5]
+
+=item * dummy dimensions
+
+As in L<slice|slice>, you can insert a dummy dimension by preceding a
+single index argument with '*'. A lone '*' inserts a dummy dimension of
+order 1; a '*' followed by a number inserts a dummy dimension of that order.
+
+=item * piddle index lists
+
+The second way to select indices from a dimension is via 1D piddles
+of indices. A simple example:
+
+ $a = random 10;
+ $idx = long 3,4,7,0;
+ $b = $a($idx);
+
+This way of selecting indices was previously only possible using
+L<dice|PDL::Slices/dice> (C<PDL::NiceSlice> attempts to unify the
+C<slice> and C<dice> interfaces). Note that the indexing piddles must
+be 1D or 0D. Higher dimensional piddles as indices will raise an error:
+
+ $a = sequence 5, 5;
+ $idx2 = ones 2,2;
+ $sum = $a($idx2)->sum;
+ piddle must be <= 1D at /home/XXXX/.perldlrc line 93
+
+Note that using index piddles is not as efficient as using ranges.
+If you can represent the indices you want to select using a range
+use that rather than an equivalent index piddle. In particular,
+memory requirements are increased with index piddles (and execution
+time I<may> be longer). That said, if an index piddle is the way to
+go use it!
+
+=back
+
+As you might have expected ranges and index piddles can be freely
+mixed in slicing expressions:
+
+ $a = random 5, 5;
+ $b = $a(-1:2,pdl(3,0,1));
+
+=head2 piddles as indices in ranges
+
+You can use piddles to specify indices in ranges. No need to
+turn them into proper perl scalars with the new slicing syntax.
+However, make sure they contain not more than one element! Otherwise
+a runtime error will be triggered. First a couple of examples that
+illustrate proper usage:
+
+ $a = sequence 5, 5;
+ $rg = pdl(1,-1,3);
+ print $a($rg(0):$rg(1):$rg(2),2);
+ [
+ [11 14]
+ ]
+ print $a($rg+1,:$rg(0));
+ [
+ [2 0 4]
+ [7 5 9]
+ ]
+
+The next one raises an error
+
+ print $a($rg+1,:$rg(0:1));
+ multielement piddle where only one allowed at XXX/Core.pm line 1170.
+
+The problem is caused by using the 2-element piddle C<$rg(0:1)> as the
+stop index in the second argument C<:$rg(0:1)> that is interpreted as
+a range by C<PDL::NiceSlice>. You I<can> use multielement piddles as
+index piddles as described above but not in ranges. And
+C<PDL::NiceSlice> treats any expression with unprotected C<:>'s as a
+range. I<Unprotected> means as usual
+I<"not occurring between matched parentheses">.
+
+=head1 IMPLEMENTATION
+
+C<PDL::NiceSlice> exploits the ability of Perl to use source filtering
+(see also L<perlfilter>). A source filter basically filters (or
+rewrites) your perl code before it is seen by the
+compiler. C<PDL::NiceSlice> searches through your Perl source code and when
+it finds the new slicing syntax it rewrites the argument list
+appropriately and splices a call to the C<slice> method using the
+modified arg list into your perl code. You can see how this works in
+the L<perldl|perldl> or L<pdl2|PDL::Perldl2> shells by switching on
+reporting (see above how to do that).
+
+=head1 BUGS
+
+=head2 Conditional operator
+
+The conditional operator can't be used in slice expressions (see
+above).
+
+=head2 The C<DATA> file handle
+
+I<Note>: To avoid clobbering the C<DATA> filehandle C<PDL::NiceSlice>
+switches itself off when encountering the C<__END__> or C<__DATA__> tokens.
+This should not be a problem for you unless you use C<SelfLoader> to load
+PDL code including the new slicing from that section. It is even desirable
+when working with L<Inline::Pdlpp|Inline::Pdlpp>, see below.
+
+=head2 Possible interaction with L<Inline::Pdlpp|Inline::Pdlpp>
+
+There is currently an undesired interaction between C<PDL::NiceSlice>
+and the new L<Inline::Pdlpp|Inline::Pdlpp> module (currently only in
+PDL CVS). Since PP code generally
+contains expressions of the type C<$var()> (to access piddles, etc)
+C<PDL::NiceSlice> recognizes those I<incorrectly> as
+slice expressions and does its substitutions. This is not a problem
+if you use the C<DATA> section for your Pdlpp code -- the recommended
+place for Inline code anyway. In that case
+C<PDL::NiceSlice> will have switched itself off before encountering any
+Pdlpp code (see above):
+
+ # use with Inline modules
+ use PDL;
+ use PDL::NiceSlice;
+ use Inline Pdlpp;
+
+ $a = sequence(10);
+ print $a(0:5);
+
+ __END__
+
+ __Pdlpp__
+
+ ... inline stuff
+
+
+Otherwise switch C<PDL::NiceSlice> explicitly off around the
+Inline::Pdlpp code:
+
+ use PDL::NiceSlice;
+
+ $a = sequence 10;
+ $a(0:3)++;
+ $a->inc;
+
+ no PDL::NiceSlice; # switch off before Pdlpp code
+ use Inline Pdlpp => "Pdlpp source code";
+
+The cleaner solution is to always stick with the
+C<DATA> way of including your C<Inline> code as
+in the first example. That way you keep your nice Perl
+code at the top and all the ugly Pdlpp stuff etc at
+the bottom.
+
+=head2 Bug reports
+
+Feedback and bug reports are welcome. Please include an example
+that demonstrates the problem. Log bug reports in the PDL
+bug database at
+
+ http://sourceforge.net/bugs/?group_id=612
+
+or send them to the pdl-porters mailing list
+E<lt>pdl-porters at jach.hawaii.eduE<gt>.
+
+
+=head1 COPYRIGHT
+
+Copyright (c) 2001, 2002 Christian Soeller. All Rights Reserved.
+This module is free software. It may be used, redistributed
+and/or modified under the same terms as PDL itself
+(see L<http://pdl.perl.org>).
+
+=cut
+
+1;
diff --git a/Basic/SourceFilter/example b/Basic/SourceFilter/example
new file mode 100644
index 0000000..84e5b54
--- /dev/null
+++ b/Basic/SourceFilter/example
@@ -0,0 +1,44 @@
+use PDL::LiteF;
+use PDL::NiceSlice;
+
+$a = sequence(10);
+
+print "\n",'source $a'.'((4)) translated -> $a((4))',"\n";
+print "Result ",$a((4)),"\n\n";
+
+print 'alternative syntax: $a->'.'((4)) translated -> $a->((4))',"\n\n";
+
+print 'source $a'.'(1:4) .= 2; translated -> $a(1:4) .= 2;',"\n"; # this should be rewritten
+
+($tmp = $a(1:4)) .= 2;
+
+print "Result: $a","\n\n";
+
+print << 'EOP';
+
+The arglist is split at commas but commas within
+matched brackets are protected. That should allow
+function invocations etc within the arglist:
+
+EOP
+
+print '$a'.'(1:end(0,22)) -> $a(1:end(0,22))',"\n\n";
+
+print "recursive invocation is also supported:\n";
+print '$a'.'(1,$b'.'(0:22)) -> $a(1,$b(0:22))',"\n\n";
+
+no PDL::NiceSlice;
+
+
+print << 'EOP';
+
+Now we have switched off source filtering by issuing
+
+ no PDL::NiceSlice;
+
+Therefore, the next slice expression should not be touched:
+
+EOP
+
+# this shouldn't be touched
+print 'Source $a'.'(1:4) translation -> $a(1:4)',"\n\n";
diff --git a/Basic/SourceFilter/local.perldlrc b/Basic/SourceFilter/local.perldlrc
new file mode 100644
index 0000000..d5ec82b
--- /dev/null
+++ b/Basic/SourceFilter/local.perldlrc
@@ -0,0 +1,31 @@
+# some useful functions to experiment with
+# the new PDL source filter within the perldl shell
+
+# report switches translation reporting on/off
+# trans and notrans switch source filtering on/off
+
+# include the perl code below in your standard
+# perldl startup file ($ENV{HOME}/.perldlrc)
+# to have it always available when working
+# in the perldl shell
+
+$PERLDL::report = 0;
+sub report {
+ my $ret = $PERLDL::report;
+ $PERLDL::report = $_[0] if $#_ > -1;
+ return $ret;
+}
+
+use PDL::NiceSlice;
+my $preproc = sub { my ($txt) = @_;
+ my $new = PDL::NiceSlice::perldlpp $txt;
+ print STDERR "processed $new\n" if report && $new ne $txt;
+ return $new;
+};
+
+sub trans { $PERLDL::PREPROCESS = $preproc }
+sub notrans { $PERLDL::PREPROCESS = undef }
+trans; # switch on by default
+
+
+1;
diff --git a/Basic/Test/Makefile.PL b/Basic/Test/Makefile.PL
new file mode 100644
index 0000000..2448b31
--- /dev/null
+++ b/Basic/Test/Makefile.PL
@@ -0,0 +1,19 @@
+
+# Makefile.PL for PDL::IO module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+ at pack = (["tests.pd",Tests,PDL::Tests]);
+
+WriteMakefile(
+ pdlpp_stdargs_int(@::pack)
+);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Basic/Test/tests.pd b/Basic/Test/tests.pd
new file mode 100644
index 0000000..a79efeb
--- /dev/null
+++ b/Basic/Test/tests.pd
@@ -0,0 +1,149 @@
+pp_addpm({At=>Top},<<'EOPM');
+
+=head1 NAME
+
+PDL::Tests - tests for some PP features
+
+=head1 SYNOPSIS
+
+ use PDL::Tests;
+
+ <test code>
+
+=head1 DESCRIPTION
+
+This module provides some PP defined test functions that are
+supposed to test some features/bugs of PDL::PP.
+
+Strictly speaking this module shouldn't be installed with a
+'make install' but I haven't yet worked out how to do it.
+
+=cut
+
+EOPM
+
+# make sure the deprecation mechanism throws warnings
+pp_deprecate_module( infavor => "PDL::Test::Fancy" );
+
+sub pp_deft {
+ my ($name,%hash) = @_;
+## $hash{Doc} = "=for ref\n\ninternal\n\nonly for internal testing purposes\n";
+ $hash{Doc} = undef;
+ $name = "test_$name"; # prepend test_ to name
+ pp_def($name,%hash);
+}
+
+pp_addhdr('
+/* to test the $P vaffining */
+void ppcp(PDL_Byte *dst, PDL_Byte *src, int len)
+{
+ int i;
+
+ for (i=0;i<len;i++)
+ *dst++=*src++;
+}
+');
+
+# test the $P vaffine behaviour
+# when 'phys' flag is in.
+pp_deft('foop',
+ Pars => 'byte [phys]a1(n); byte [o,phys]b(n)',
+ GenericTypes => [B],
+ Code => 'ppcp($P(b),$P(a1),$SIZE(n));',
+);
+
+# now in primitive.pd
+#
+# double qualifier
+#pp_deft(
+# 'dsumover',
+# Pars => 'a1(n); double [o]b();',
+# Code => 'PDL_Double tmp = 0;
+# loop(n) %{ tmp += $a1(); %}
+# $b() = tmp;'
+#);
+
+# float qualifier
+# and also test if numerals in variable name work
+pp_deft(
+ 'fsumover',
+ Pars => 'a1(n); float [o]b();',
+ Code => 'PDL_Float tmp = 0;
+ loop(n) %{ tmp += $a1(); %}
+ $b() = tmp;'
+);
+
+# test GENERIC with type+ qualifier
+pp_deft(
+ 'nsumover',
+ Pars => 'a(n); int+ [o]b();',
+ Code => '$GENERIC(b) tmp = 0;
+ loop(n) %{ tmp += $a(); %}
+ $b() = tmp;'
+);
+
+# test to set named dim with 'OtherPar'
+pp_deft('setdim',
+ Pars => '[o] a(n)',
+ OtherPars => 'int ns => n',
+ Code => 'loop(n) %{ $a() = n; %}',
+);
+
+# according to Karl this segvs with certain pdls
+
+pp_deft('fooseg',
+ Pars => 'a(n); [o]b(n);',
+ Code => '
+ loop(n) %{ $b() = $a(); %}
+');
+
+pp_addhdr << 'EOH';
+
+void tinplace_c1(int n, PDL_Float* data)
+{
+ int i;
+ for (i=0;i<n;i++) {
+ data[i] = 599.0;
+ }
+}
+
+void tinplace_c2(int n, PDL_Float* data1, PDL_Float* data2)
+{
+ int i;
+ for (i=0;i<n;i++) {
+ data1[i] = 599.0;
+ data2[i] = 699.0;
+ }
+}
+
+void tinplace_c3(int n, PDL_Float* data1, PDL_Float* data2, PDL_Float* data3)
+{
+ int i;
+ for (i=0;i<n;i++) {
+ data1[i] = 599.0;
+ data2[i] = 699.0;
+ data3[i] = 799.0;
+ }
+}
+
+EOH
+
+pp_deft('fooflow1',
+ Pars => '[o,nc]a(n)',
+ GenericTypes => ['F'],
+ Code => 'tinplace_c1($SIZE(n),$P(a));',
+ );
+
+pp_deft('fooflow2',
+ Pars => '[o,nc]a(n);[o,nc]b(n)',
+ GenericTypes => ['F'],
+ Code => 'tinplace_c2($SIZE(n),$P(a),$P(b));',
+ );
+
+pp_deft('fooflow3',
+ Pars => '[o,nc]a(n);[o,nc]b(n);[o,nc]c(n)',
+ GenericTypes => ['F'],
+ Code => 'tinplace_c3($SIZE(n),$P(a),$P(b),$P(c));',
+ );
+
+pp_done;
diff --git a/Basic/Ufunc/Makefile.PL b/Basic/Ufunc/Makefile.PL
new file mode 100644
index 0000000..a49e54c
--- /dev/null
+++ b/Basic/Ufunc/Makefile.PL
@@ -0,0 +1,50 @@
+
+# Makefile.PL for PDL::Ufunc module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+ at pack = (["ufunc.pd",Ufunc,PDL::Ufunc]);
+
+if ($^O eq 'dec_osf') {
+ require Config;
+ if ($Config::Config{cc} =~ /^cc/) {
+ my $no_optimize = $::PDL_OPTIONS{OPTIMIZE}
+ || $Config::Config{optimize}
+ || '-g2';
+ $no_optimize =~ s/(\s|^)(-O)\d/$1${2}0/;
+ $no_optimize =~ s/(\s|^)(-g)\d/$1${2}2/;
+ print <<EOT;
+ Digital Unix cc optimizer has a bug that is
+ triggered by primitive.c. Therefore
+EOT
+ # Becaue OPTIMIZE in PASTHRU it can't be overridden so
+ # it gets hard coded in Makefile
+ eval q|
+ sub MY::const_cccmd {
+ package MY;
+ my $defval = shift->SUPER::const_cccmd(@_);
+ $defval =~ s/\$\(OPTIMIZE\)/|
+ . $no_optimize . q|/gs;
+ print "$defval\n";
+ return $defval;
+ };
+ |;
+ }
+}
+
+
+#WriteMakefile(
+# pdlpp_stdargs_int(@::pack)
+#);
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{LIBS}->[0] .= ' -lm';
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Basic/Ufunc/ufunc.pd b/Basic/Ufunc/ufunc.pd
new file mode 100644
index 0000000..2506a85
--- /dev/null
+++ b/Basic/Ufunc/ufunc.pd
@@ -0,0 +1,1461 @@
+use strict; # be careful
+
+pp_addpm({At=>'Top'},<<'EOD');
+
+=head1 NAME
+
+PDL::Ufunc - primitive ufunc operations for pdl
+
+=head1 DESCRIPTION
+
+This module provides some primitive and useful functions defined
+using PDL::PP based on functionality of what are sometimes called
+I<ufuncs> (for example NumPY and Mathematica talk about these).
+It collects all the functions generally used to C<reduce> or
+C<accumulate> along a dimension. These all do their job across the
+first dimension but by using the slicing functions you can do it
+on any dimension.
+
+The L<PDL::Reduce|PDL::Reduce> module provides an alternative interface
+to many of the functions in this module.
+
+=head1 SYNOPSIS
+
+ use PDL::Ufunc;
+
+=cut
+
+use PDL::Slices;
+use Carp;
+
+EOD
+
+# check for bad value support
+use PDL::Config;
+my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
+
+
+# should we use the finite() routine in libm ?
+# (is the Windows version _finite() ?)
+#
+pp_addhdr(<<'EOD');
+#define IsNaN(x) (x != x)
+EOD
+
+# helper functions
+sub projectdocs {
+ my $name = shift;
+ my $op = shift;
+ my $extras = shift;
+ return <<EOD;
+
+=for ref
+
+Project via $name to N-1 dimensions
+
+This function reduces the dimensionality of a piddle
+by one by taking the $name along the 1st dimension.
+
+By using L<xchg|PDL::Slices/xchg> etc. it is possible to use
+I<any> dimension.
+
+=for usage
+
+ \$b = $op(\$a);
+
+=for example
+
+ \$spectrum = $op \$image->xchg(0,1)
+
+$extras
+
+=cut
+
+EOD
+
+} # sub: projectdocs()
+
+sub cumuprojectdocs {
+ my $name = shift;
+ my $op = shift;
+ my $extras = shift;
+ return <<EOD;
+
+=for ref
+
+Cumulative $name
+
+This function calculates the cumulative $name
+along the 1st dimension.
+
+By using L<xchg|PDL::Slices/xchg> etc. it is possible to use
+I<any> dimension.
+
+The sum is started so that the first element in the cumulative $name
+is the first element of the parameter.
+
+=for usage
+
+ \$b = $op(\$a);
+
+=for example
+
+ \$spectrum = $op \$image->xchg(0,1)
+
+$extras
+
+=cut
+
+EOD
+
+} # sub: cumuprojectdocs()
+
+# it's a bit unclear what to do with the comparison operators,
+# since the return value could be bad because all elements are bad,
+# which needs checking for since the bad value could evaluate to
+# true or false (eg if the user has set it to 0)
+#
+# by setting CopyBadStatusCode to '', we stop the output piddle
+# from automatically being set bad if any of the input piddles are bad.
+# - we can set the flag within BadCode if necessary
+#
+# This may NOT be sensible. Only time, and comments, will tell...
+#
+
+my %over =
+ (
+ sumover => { name => 'sum', op => '+=', init => 0, },
+ prodover => { name => 'product', op => '*=', init => 1, },
+ );
+
+foreach my $func ( keys %over ) {
+
+ # creates $func and cumu$func functions
+ # and d$func and dcumu$func functions, which
+ # perform the calculations in double precision
+
+ my $name = $over{$func}{name};
+ my $op = $over{$func}{op};
+ my $init = $over{$func}{init};
+
+ pp_def(
+ $func,
+ HandleBad => 1,
+ Pars => 'a(n); int+ [o]b();',
+ Code =>
+ '$GENERIC(b) tmp = ' . $init . ';
+ loop(n) %{ tmp ' . $op . ' $a(); %}
+ $b() = tmp;',
+ BadCode =>
+ '$GENERIC(b) tmp = ' . $init . ';
+ int flag = 0;
+ loop(n) %{
+ if ( $ISGOOD(a()) ) { tmp ' . $op . ' $a(); flag = 1; }
+ %}
+ if ( flag ) { $b() = tmp; }
+ else { $SETBAD(b()); }',
+ Doc => projectdocs( $name, $func, '' ),
+ );
+
+ # as above, but in double precision
+ pp_def(
+ "d$func",
+ HandleBad => 1,
+ Pars => 'a(n); double [o]b();',
+ Code =>
+ 'double tmp = ' . $init . ';
+ loop(n) %{ tmp ' . $op . ' $a(); %}
+ $b() = tmp;',
+ BadCode =>
+ 'double tmp = ' . $init . ';
+ int flag = 0;
+ loop(n) %{
+ if ( $ISGOOD(a()) ) { tmp ' . $op . ' $a(); flag = 1; }
+ %}
+ if ( flag ) { $b() = tmp; }
+ else { $SETBAD(b()); }',
+ Doc => projectdocs( $name, "d$func",
+"Unlike L<$func|/$func>, the calculations are performed in double\n" .
+"precision." ),
+ );
+
+ my $cfunc = "cumu${func}";
+ pp_def(
+ $cfunc,
+ HandleBad => 1,
+ Pars => 'a(n); int+ [o]b(n);',
+ Code =>
+ '$GENERIC(b) tmp = ' . $init . ';
+ loop(n) %{
+ tmp ' . $op . ' $a();
+ $b() = tmp;
+ %}',
+ BadCode =>
+ '$GENERIC(b) tmp = ' . $init . ';
+ loop(n) %{
+ if ( $ISBAD(a()) ) { $SETBAD(b()); }
+ else {
+ tmp ' . $op . ' $a();
+ $b() = tmp;
+ }
+ %}',
+ Doc => cumuprojectdocs( $name, $cfunc, '' ),
+ );
+
+ # as above but in double precision
+ pp_def(
+ "d$cfunc",
+ HandleBad => 1,
+ Pars => 'a(n); double [o]b(n);',
+ Code =>
+ 'double tmp = ' . $init . ';
+ loop(n) %{
+ tmp ' . $op . ' $a();
+ $b() = tmp;
+ %}',
+ BadCode =>
+ 'double tmp = ' . $init . ';
+ loop(n) %{
+ if ( $ISBAD(a()) ) { $SETBAD(b()); }
+ else {
+ tmp ' . $op . ' $a();
+ $b() = tmp;
+ }
+ %}',
+ Doc => cumuprojectdocs( $name, $cfunc,
+"Unlike L<cumu$func|/cumu$func>, the calculations are performed in double\n" .
+"precision." ),
+ );
+
+} # foreach: my $func
+
+
+%over =
+ (
+ zcover => { def=>'char tmp', txt => '== 0', init => 1, alltypes => 1,
+ op => 'tmp &= ($a() == 0);', check => '!tmp' },
+ andover => { def=>'char tmp', txt => 'and', init => 1, alltypes => 1,
+ op => 'tmp &= ($a() != 0);', check => '!tmp' },
+ bandover => { def=>'$GENERIC(b) tmp', txt => 'bitwise and', init => '~0',
+ op => 'tmp &= $a();', check => '!tmp' },
+ orover => { def=>'char tmp', txt => 'or', init => 0, alltypes => 1,
+ op => 'tmp |= ($a() != 0);', check => 'tmp' },
+ borover => { def=>'$GENERIC(b) tmp', txt => 'bitwise or', init => 0,
+ op => 'tmp |= $a() ;', check => '!~tmp' },
+
+ );
+
+foreach my $func ( keys %over ) {
+
+ my $def = $over{$func}{def};
+ my $txt = $over{$func}{txt};
+ my $init = $over{$func}{init};
+ my $op = $over{$func}{op};
+ my $check = $over{$func}{check};
+
+ my %extra = {};
+ unless ( defined $over{$func}{alltypes} and $over{$func}{alltypes} ) {
+ $extra{GenericTypes} = ['B','S','U','L'];
+ }
+
+ pp_def(
+ $func,
+ HandleBad => 1,
+ %extra,
+ Pars => 'a(n); int+ [o]b();',
+ Code =>
+ $def . '=' . $init . ';
+ loop(n) %{ ' . $op . ' if (' . $check . ') break; %}
+ $b() = tmp;',
+ BadCode =>
+ 'char tmp = ' . $init . ';
+ $GENERIC(b) gtmp = '. $init . ';
+ int flag = 0;
+ loop(n) %{
+ if ( $ISGOOD(a()) ) { ' . $op . ' flag = 1; if (' . $check . ') break; }
+ %}
+ if ( flag ) { $b() = tmp; }
+ else { $SETBAD(b()); $PDLSTATESETBAD(b); }',
+ CopyBadStatusCode => '',
+ Doc => projectdocs( $txt, $func,''),
+ BadDoc =>
+'If C<a()> contains only bad data (and its bad flag is set),
+C<b()> is set bad. Otherwise C<b()> will have its bad flag cleared,
+as it will not contain any bad values.',
+ );
+
+} # foreach: $func
+
+# this would need a lot of work to support bad values
+# plus it gives me a chance to check out HandleBad => 0 ;)
+#
+pp_def(
+ 'intover',
+ HandleBad => 0,
+ Pars => 'a(n); int+ [o]b();',
+ Code =>
+ '$GENERIC(b) tmp = 0;
+ PDL_Indx ns = $SIZE(n), nn;
+ /* Integration formulae from Press et al 2nd Ed S 4.1 */
+ switch (ns) {
+ case 1:
+ threadloop %{
+ $b() = 0.; /* not a(n=>0); as interval has zero width */
+ %}
+ break;
+ case 2:
+ threadloop %{
+ $b() = 0.5*($a(n=>0)+$a(n=>1));
+ %}
+ break;
+ case 3:
+ threadloop %{
+ $b() = ($a(n=>0)+4*$a(n=>1)+$a(n=>2))/3.;
+ %}
+ break;
+ case 4:
+ threadloop %{
+ $b() = ($a(n=>0)+$a(n=>3)+3.*($a(n=>1)+$a(n=>2)))*0.375;
+ %}
+ break;
+ case 5:
+ threadloop %{
+ $b() = (14.*($a(n=>0)+$a(n=>4))
+ +64.*($a(n=>1)+$a(n=>3))
+ +24.*$a(n=>2))/45.;
+ %}
+ break;
+ default:
+ threadloop %{
+ for (nn=3,tmp=0;nn<ns-3;nn++) { tmp += $a(n=>nn); }
+ tmp += (23./24.)*($a(n=>2)+$a(n=>nn));nn++;
+ tmp += (7./6.) *($a(n=>1)+$a(n=>nn));nn++;
+ tmp += 0.375 *($a(n=>0)+$a(n=>nn));
+ $b() = tmp;
+ %}
+ }
+ ',
+ Doc => projectdocs('integral','intover',
+q~Notes:
+
+C<intover> uses a point spacing of one (i.e., delta-h==1). You will
+need to scale the result to correct for the true point delta).
+
+For C<n E<gt> 3>, these are all C<O(h^4)> (like Simpson's rule), but are
+integrals between the end points assuming the pdl gives values just at
+these centres: for such `functions', sumover is correct to C<O(h)>, but
+is the natural (and correct) choice for binned data, of course.
+~)
+); # intover
+
+pp_def(
+ 'average',
+ HandleBad => 1,
+ Pars => 'a(n); int+ [o]b();',
+ Code =>
+ '$GENERIC(b) tmp = 0;
+ if($SIZE(n)) {
+ loop(n) %{ tmp += $a(); %} ;
+ $b() = tmp / ($GENERIC(b)) $SIZE(n);
+ }
+ else { $GENERIC(b) foo = 0.25;
+ if(foo == 0) { /* Cheesy check for floating-pointiness */
+ $b() = 0; /* Integer - set to 0 */
+ } else {
+ $b() = sqrt(-1); /* Cheesy NaN -- CED */
+ }
+ }',
+
+ BadCode =>
+ '$GENERIC(b) tmp = 0;
+ PDL_Indx cnt = 0;
+ loop(n) %{
+ if ( $ISGOOD(a()) ) { tmp += $a(); cnt++; }
+ %}
+ if ( cnt ) { $b() = tmp / ($GENERIC(b)) cnt; }
+ else { $SETBAD(b()); }',
+ Doc => projectdocs( 'average', 'average', '' ),
+ );
+
+# do the above calculation, but in double precision
+pp_def(
+ 'daverage',
+ HandleBad => 1,
+ Pars => 'a(n); double [o]b();',
+ Code =>
+ 'double tmp = 0;
+ if($SIZE(n)) {
+ loop(n) %{ tmp += $a(); %}
+ $b() = tmp / $SIZE(n);
+ }
+ else { $b() = 0; }',
+ BadCode =>
+ 'double tmp = 0;
+ PDL_Indx cnt = 0;
+ loop(n) %{
+ if ( $ISGOOD(a()) ) { tmp += $a(); cnt++; }
+ %}
+ if ( cnt ) { $b() = tmp / cnt; }
+ else { $SETBAD(b()); }',
+ Doc => projectdocs( 'average', 'daverage',
+"Unlike L<average|/average>, the calculation is performed in double\n" .
+"precision." ),
+ );
+
+# Internal utility sorting routine for median/qsort/qsortvec routines.
+#
+# note: we export them to the PDL Core structure for use in
+# other modules (eg Image2D)
+
+for (keys %PDL::Types::typehash) {
+ my $ctype = $PDL::Types::typehash{$_}{ctype};
+ my $ppsym = $PDL::Types::typehash{$_}{ppsym};
+
+ pp_add_boot( " PDL->qsort_${ppsym} = pdl_qsort_${ppsym};" .
+ " PDL->qsort_ind_${ppsym} = pdl_qsort_ind_${ppsym};\n" );
+
+ pp_addhdr(<<"FOO"
+
+ void pdl_qsort_$ppsym($ctype* xx, PDL_Indx a, PDL_Indx b) {
+
+ PDL_Indx i,j;
+
+ $ctype t, median;
+
+ i = a; j = b;
+ median = xx[(i+j) / 2];
+ do {
+ while (xx[i] < median)
+ i++;
+ while (median < xx[j])
+ j--;
+ if (i <= j) {
+ t = xx[i]; xx[i] = xx[j]; xx[j] = t;
+ i++; j--;
+ }
+ } while (i <= j);
+
+ if (a < j)
+ pdl_qsort_$ppsym(xx,a,j);
+ if (i < b)
+ pdl_qsort_$ppsym(xx,i,b);
+
+ }
+
+ void pdl_qsort_ind_$ppsym($ctype* xx, PDL_Indx* ix, PDL_Indx a, PDL_Indx b) {
+
+ PDL_Indx i,j;
+
+ PDL_Indx t;
+ $ctype median;
+
+ i = a; j = b;
+ median = xx[ix[(i+j) / 2]];
+
+ do {
+ while (xx[ix[i]] < median)
+ i++;
+ while (median < xx[ix[j]])
+ j--;
+ if (i <= j) {
+ t = ix[i]; ix[i] = ix[j]; ix[j] = t;
+ i++; j--;
+ }
+ } while (i <= j);
+
+ if (a < j)
+ pdl_qsort_ind_$ppsym(xx,ix,a,j);
+ if (i < b)
+ pdl_qsort_ind_$ppsym(xx,ix,i,b);
+
+ }
+
+
+ /*******
+ * qsortvec helper routines
+ * --CED 21-Aug-2003
+ */
+
+ /* Compare a vector in lexicographic order, returning the
+ * equivalent of "<=>".
+ */
+ signed char pdl_cmpvec_$ppsym($ctype *a, $ctype *b, PDL_Indx n) {
+ PDL_Indx i;
+ for(i=0; i<n; a++,b++,i++) {
+ if( *a < *b ) return -1;
+ if( *a > *b ) return 1;
+ }
+ return 0;
+ }
+
+ void pdl_qsortvec_$ppsym($ctype *xx, PDL_Indx n, PDL_Indx a, PDL_Indx b) {
+
+ PDL_Indx i,j, median_ind;
+
+ $ctype t;
+ i = a;
+ j = b;
+
+ median_ind = (i+j)/2;
+
+ do {
+ while( pdl_cmpvec_$ppsym( &(xx[n*i]), &(xx[n*median_ind]), n ) < 0 )
+ i++;
+ while( pdl_cmpvec_$ppsym( &(xx[n*j]), &(xx[n*median_ind]), n ) > 0 )
+ j--;
+ if(i<=j) {
+ PDL_Indx k;
+ $ctype *aa = &xx[n*i];
+ $ctype *bb = &xx[n*j];
+ for( k=0; k<n; aa++,bb++,k++ ) {
+ $ctype z;
+ z = *aa;
+ *aa = *bb;
+ *bb = z;
+ }
+
+ if (median_ind==i)
+ median_ind=j;
+ else if (median_ind==j)
+ median_ind=i;
+
+ i++;
+ j--;
+ }
+ } while (i <= j);
+
+ if (a < j)
+ pdl_qsortvec_$ppsym( xx, n, a, j );
+ if (i < b)
+ pdl_qsortvec_$ppsym( xx, n, i, b );
+
+ }
+
+ void pdl_qsortvec_ind_$ppsym($ctype *xx, PDL_Indx *ix, PDL_Indx n, PDL_Indx a, PDL_Indx b) {
+
+ PDL_Indx i,j, median_ind;
+
+ $ctype t;
+ i = a;
+ j = b;
+
+ median_ind = (i+j)/2;
+
+ do {
+ while( pdl_cmpvec_$ppsym( &(xx[n*ix[i]]), &(xx[n*ix[median_ind]]), n ) < 0 )
+ i++;
+ while( pdl_cmpvec_$ppsym( &(xx[n*ix[j]]), &(xx[n*ix[median_ind]]), n ) > 0 )
+ j--;
+ if(i<=j) {
+ PDL_Indx k;
+ k = ix[i];
+ ix[i] = ix[j];
+ ix[j] = k;
+
+ if (median_ind==i)
+ median_ind=j;
+ else if (median_ind==j)
+ median_ind=i;
+
+ i++;
+ j--;
+ }
+ } while (i <= j);
+
+ if (a < j)
+ pdl_qsortvec_ind_$ppsym( xx, ix, n, a, j );
+ if (i < b)
+ pdl_qsortvec_ind_$ppsym( xx, ix, n, i, b );
+
+ }
+
+FOO
+ );
+}
+
+# when copying the data over to the temporary array,
+# ignore the bad values and then only send the number
+# of good elements to the sort routines
+#
+
+sub generic_qsort {
+ my $pdl = shift;
+ return '$TBSULNQFD(pdl_qsort_B,pdl_qsort_S,pdl_qsort_U,
+ pdl_qsort_L,pdl_qsort_N,pdl_qsort_Q,pdl_qsort_F,pdl_qsort_D) ($P(' . $pdl . '), 0, nn);';
+}
+
+sub generic_qsortvec {
+ my $pdl = shift;
+ my $ndim = shift;
+ return '$TBSULNQFD(pdl_qsortvec_B,pdl_qsortvec_S,pdl_qsortvec_U,
+ pdl_qsortvec_L,pdl_qsortvec_N,pdl_qsortvec_Q,pdl_qsortvec_F,pdl_qsortvec_D) ($P(' . $pdl . '), '. $ndim.', 0, nn);';
+}
+
+
+# should use threadloop ?
+#
+my $copy_to_temp_good = '
+ PDL_Indx nn, nn1;
+ loop(n) %{ $tmp() = $a(); %}
+ nn = $COMP(__n_size)-1; ' .
+ generic_qsort('tmp');
+
+my $copy_to_temp_bad = '
+ register PDL_Indx nn = 0;
+ loop(n) %{
+ if ( $ISGOOD(a()) ) { $tmp(n=>nn) = $a(); nn++; }
+ %}
+ if ( nn == 0 ) {
+ $SETBAD(b());
+ } else {
+';
+
+my $find_median_average = '
+ nn1 = nn/2; nn2 = nn1+1;
+ if (nn%2==0) {
+ $b() = $tmp(n => nn1);
+ }
+ else {
+ $b() = 0.5*( $tmp(n => nn1) + $tmp(n => nn2) );
+ }';
+
+my $find_median_lower = '
+ nn1 = nn/2;
+ $b() = $tmp(n => nn1);';
+
+pp_def(
+ 'medover',
+ HandleBad => 1,
+ Pars => 'a(n); [o]b(); [t]tmp(n);',
+ Doc => projectdocs('median','medover',''),
+ Code =>
+ "PDL_Indx nn2;\n" . $copy_to_temp_good . $find_median_average,
+ BadCode =>
+ $copy_to_temp_bad .
+ ' PDL_Indx nn1, nn2;
+ nn -= 1; ' .
+ generic_qsort('tmp') .
+ $find_median_average . '}',
+
+ ); # pp_def: medover
+
+pp_def(
+ 'oddmedover',
+ HandleBad => 1,
+ Pars => 'a(n); [o]b(); [t]tmp(n);',
+ Doc => projectdocs('oddmedian','oddmedover','
+
+The median is sometimes not a good choice as if the array has
+an even number of elements it lies half-way between the two
+middle values - thus it does not always correspond to a data
+value. The lower-odd median is just the lower of these two values
+and so it ALWAYS sits on an actual data value which is useful in
+some circumstances.
+ '),
+ Code =>
+ $copy_to_temp_good . $find_median_lower,
+ BadCode =>
+ $copy_to_temp_bad .
+ ' PDL_Indx nn1;
+ nn -= 1; '.
+ $find_median_lower . '}',
+
+); # pp_def: oddmedover
+
+
+pp_def('modeover',
+ HandleBad=>undef,
+ Pars => 'data(n); [o]out(); [t]sorted(n);',
+ GenericTypes=>['B','S','U','L','Q','N'],
+ Doc=>projectdocs('mode','modeover','
+
+The mode is the single element most frequently found in a
+discrete data set.
+
+It I<only> makes sense for integer data types, since
+floating-point types are demoted to integer before the
+mode is calculated.
+
+C<modeover> treats BAD the same as any other value: if
+BAD is the most common element, the returned value is also BAD.
+'),
+ Code => <<'EOCODE',
+ PDL_Indx i = 0;
+ PDL_Indx most = 0;
+ $GENERIC() curmode;
+ $GENERIC() curval;
+
+ /* Copy input to buffer for sorting, and sort it */
+ loop(n) %{ $sorted() = $data(); %}
+ PDL->$TBSULNQ(qsort_B,qsort_S,qsort_U,qsort_L,qsort_N,qsort_Q)($P(sorted),0,$SIZE(n)-1);
+
+ /* Walk through the sorted data and find the most common elemen */
+ loop(n) %{
+ if( n==0 || curval != $sorted() ) {
+ curval = $sorted();
+ i=0;
+ } else {
+ i++;
+ if(i>most){
+ most=i;
+ curmode = curval;
+ }
+ }
+ %}
+ $out() = curmode;
+EOCODE
+ );
+
+
+my $find_pct_interpolate = '
+ np = nn * $p();
+ nn1 = np;
+ nn2 = nn1+1;
+
+ nn1 = (nn1 < 0) ? 0 : nn1;
+ nn2 = (nn2 < 0) ? 0 : nn2;
+
+ nn1 = (nn1 > nn) ? nn : nn1;
+ nn2 = (nn2 > nn) ? nn : nn2;
+
+ if (nn == 0) {
+ pp1 = 0;
+ pp2 = 0;
+ } else {
+ pp1 = (double)nn1/(double)(nn);
+ pp2 = (double)nn2/(double)(nn);
+ }
+
+ if ( np <= 0.0 ) {
+ $b() = $tmp(n => 0);
+ } else if ( np >= nn ) {
+ $b() = $tmp(n => nn);
+ } else if ($tmp(n => nn2) == $tmp(n => nn1)) {
+ $b() = $tmp(n => nn1);
+ } else if ($p() == pp1) {
+ $b() = $tmp(n => nn1);
+ } else if ($p() == pp2) {
+ $b() = $tmp(n => nn2);
+ } else {
+ $b() = (np - nn1)*($tmp(n => nn2) - $tmp(n => nn1)) + $tmp(n => nn1);
+ }
+';
+
+pp_def('pctover',
+ HandleBad => 1,
+ Pars => 'a(n); p(); [o]b(); [t]tmp(n);',
+ Doc => '
+
+=for ref
+
+Project via percentile to N-1 dimensions
+
+This function reduces the dimensionality of a piddle by one by finding
+the specified percentile (p) along the 1st dimension. The specified
+percentile must be between 0.0 and 1.0. When the specified percentile
+falls between data points, the result is interpolated. Values outside
+the allowed range are clipped to 0.0 or 1.0 respectively. The algorithm
+implemented here is based on the interpolation variant described at
+L<http://en.wikipedia.org/wiki/Percentile> as used by Microsoft Excel
+and recommended by NIST.
+
+By using L<xchg|PDL::Slices/xchg> etc. it is possible to use
+I<any> dimension.
+
+=for usage
+
+ $b = pctover($a, $p);
+
+=for example
+
+ $spectrum = pctover $image->xchg(0,1), $p
+
+=cut
+
+
+',
+ Code => '
+ double np, pp1, pp2;
+ PDL_Indx nn2;
+ ' . $copy_to_temp_good .
+ $find_pct_interpolate,
+ BadCode =>
+ $copy_to_temp_bad . '
+ PDL_Indx nn1, nn2;
+ double np, pp1, pp2;
+ nn -= 1; ' . generic_qsort('tmp') .
+ $find_pct_interpolate . '}',
+
+);
+
+
+pp_def('oddpctover',
+ HandleBad => 1,
+ Pars => 'a(n); p(); [o]b(); [t]tmp(n);',
+ Doc => '
+
+Project via percentile to N-1 dimensions
+
+This function reduces the dimensionality of a piddle by one by finding
+the specified percentile along the 1st dimension. The specified
+percentile must be between 0.0 and 1.0. When the specified percentile
+falls between two values, the nearest data value is the result.
+The algorithm implemented is from the textbook version described
+first at L< http://en.wikipedia.org/wiki/Percentile>.
+
+By using L<xchg|PDL::Slices/xchg> etc. it is possible to use
+I<any> dimension.
+
+=for usage
+
+ $b = oddpctover($a, $p);
+
+=for example
+
+ $spectrum = oddpctover $image->xchg(0,1), $p
+
+=cut
+
+
+',
+ Code => '
+ PDL_Indx np;
+ ' . $copy_to_temp_good . '
+ np = (nn+1)*$p();
+ if (np > nn) np = nn;
+ if (np < 0) np = 0;
+ $b() = $tmp(n => np);
+',
+ BadCode => 'PDL_Indx np;
+ ' . $copy_to_temp_bad . '
+ nn -= 1;
+ ' . generic_qsort('tmp') . '
+ np = (nn+1)*$p();
+ if (np > nn) np = nn;
+ if (np < 0) np = 0;
+ $b() = $tmp(n => np);
+ }',
+);
+
+pp_add_exported('', 'pct');
+pp_addpm(<<"EOD");
+
+=head2 pct
+
+=for ref
+
+Return the specified percentile of all elements in a piddle. The
+specified percentile (p) must be between 0.0 and 1.0. When the
+specified percentile falls between data points, the result is
+interpolated.
+
+=for usage
+
+ \$x = pct(\$data, \$pct);
+
+=cut
+
+*pct = \\&PDL::pct;
+sub PDL::pct {
+ my(\$x, \$p) = \@_;
+ my \$tmp;
+ \$x->clump(-1)->pctover(\$p, \$tmp=PDL->nullcreate(\$x));
+ return \$tmp->at();
+}
+
+EOD
+
+pp_add_exported('', 'oddpct');
+pp_addpm(<<"EOD");
+
+=head2 oddpct
+
+=for ref
+
+Return the specified percentile of all elements in a piddle. The
+specified percentile must be between 0.0 and 1.0. When the specified
+percentile falls between two values, the nearest data value is the
+result.
+
+=for usage
+
+ \$x = oddpct(\$data, \$pct);
+
+=cut
+
+*oddpct = \\&PDL::oddpct;
+sub PDL::oddpct {
+ my(\$x, \$p) = \@_;
+ my \$tmp;
+ \$x->clump(-1)->oddpctover(\$p, \$tmp=PDL->nullcreate(\$x));
+ return \$tmp->at();
+}
+
+EOD
+
+
+# Generate small ops functions to do entire array
+#
+# How to handle a return value of BAD - ie what
+# datatype to use?
+#
+for my $op ( ['avg','average','average'],
+ ['sum','sumover','sum'],
+ ['prod','prodover','product'],
+
+ ['davg','daverage','average (in double precision)'],
+ ['dsum','dsumover','sum (in double precision)'],
+ ['dprod','dprodover','product (in double precision)'],
+
+ ['zcheck','zcover','check for zero'],
+ ['and','andover','logical and'],
+ ['band','bandover','bitwise and'],
+ ['or','orover','logical or'],
+ ['bor','borover','bitwise or'],
+ ['min','minimum','minimum'],
+ ['max','maximum','maximum'],
+ ['median', 'medover', 'median'],
+ ['mode', 'modeover', 'mode'],
+ ['oddmedian','oddmedover','oddmedian']) {
+ my $name = $op->[0];
+ my $func = $op->[1];
+ my $text = $op->[2];
+ pp_add_exported('', $name);
+
+ pp_addpm(<<"EOD");
+
+=head2 $name
+
+=for ref
+
+Return the $text of all elements in a piddle.
+
+See the documentation for L<$func|/$func> for more information.
+
+=for usage
+
+ \$x = $name(\$data);
+
+=cut
+
+EOD
+
+ if ( $bvalflag ) {
+ pp_addpm(<<"EOD");
+=for bad
+
+This routine handles bad values.
+
+=cut
+
+EOD
+} # if: bvalflag
+
+ pp_addpm(<<"EOD");
+
+*$name = \\&PDL::$name;
+sub PDL::$name {
+ my(\$x) = \@_; my \$tmp;
+ \$x->clump(-1)->${func}( \$tmp=PDL->nullcreate(\$x) );
+ return \$tmp->at();
+}
+EOD
+
+} # for $op
+
+pp_add_exported('','any all');
+pp_addpm(<<'EOPM');
+
+=head2 any
+
+=for ref
+
+Return true if any element in piddle set
+
+Useful in conditional expressions:
+
+=for example
+
+ if (any $a>15) { print "some values are greater than 15\n" }
+
+=cut
+
+EOPM
+
+ if ( $bvalflag ) {
+ pp_addpm(<<'EOPM');
+=for bad
+
+See L<or|/or> for comments on what happens when all elements
+in the check are bad.
+
+=cut
+
+EOPM
+} # if: bvalflag
+
+pp_addpm(<<'EOPM');
+*any = \∨
+*PDL::any = \&PDL::or;
+
+=head2 all
+
+=for ref
+
+Return true if all elements in piddle set
+
+Useful in conditional expressions:
+
+=for example
+
+ if (all $a>15) { print "all values are greater than 15\n" }
+
+=cut
+
+EOPM
+
+ if ( $bvalflag ) {
+ pp_addpm(<<'EOPM');
+=for bad
+
+See L<and|/and> for comments on what happens when all elements
+in the check are bad.
+
+=cut
+
+EOPM
+} # IF: BVALFLAG
+
+pp_addpm(<<'EOPM');
+
+*all = \∧
+*PDL::all = \&PDL::and;
+
+EOPM
+
+pp_addpm(<<'EOD'
+
+=head2 minmax
+
+=for ref
+
+Returns an array with minimum and maximum values of a piddle.
+
+=for usage
+
+ ($mn, $mx) = minmax($pdl);
+
+This routine does I<not> thread over the dimensions of C<$pdl>;
+it returns the minimum and maximum values of the whole array.
+See L<minmaximum|/minmaximum> if this is not what is required.
+The two values are returned as Perl scalars similar to min/max.
+
+=for example
+
+ pdl> $x = pdl [1,-2,3,5,0]
+ pdl> ($min, $max) = minmax($x);
+ pdl> p "$min $max\n";
+ -2 5
+
+=cut
+
+*minmax = \&PDL::minmax;
+sub PDL::minmax {
+ my ($x)=@_; my $tmp;
+ my @arr = $x->clump(-1)->minmaximum;
+ return map {$_->sclr} @arr[0,1]; # return as scalars !
+}
+
+EOD
+);
+
+pp_add_exported('', 'minmax');
+#pp_add_exported('', 'minmax_ind');
+
+
+# move all bad values to the end of the array
+#
+pp_def(
+ 'qsort',
+ HandleBad => 1,
+ Inplace => 1,
+ Pars => 'a(n); [o]b(n);',
+ Code =>
+ 'PDL_Indx nn;
+ loop(n) %{ $b() = $a(); %}
+ nn = $COMP(__n_size)-1;
+ ' . generic_qsort('b'),
+ BadCode =>
+ 'register PDL_Indx nn = 0, nb = $SIZE(n) - 1;
+ loop(n) %{
+ if ( $ISGOOD(a()) ) { $b(n=>nn) = $a(); nn++; }
+ else { $SETBAD(b(n=>nb)); nb--; }
+ %}
+ if ( nn != 0 ) {
+ nn -= 1;
+ ' . generic_qsort('b') . ' }',
+ Doc => '
+=for ref
+
+Quicksort a vector into ascending order.
+
+=for example
+
+ print qsort random(10);
+
+=cut
+
+',
+ BadDoc =>
+'
+Bad values are moved to the end of the array:
+
+ pdl> p $b
+ [42 47 98 BAD 22 96 74 41 79 76 96 BAD 32 76 25 59 BAD 96 32 BAD]
+ pdl> p qsort($b)
+ [22 25 32 32 41 42 47 59 74 76 76 79 96 96 96 98 BAD BAD BAD BAD]
+',
+ ); # pp_def qsort
+
+sub generic_qsort_ind {
+ return '$TBSULNQFD(pdl_qsort_ind_B,pdl_qsort_ind_S,pdl_qsort_ind_U,
+ pdl_qsort_ind_L,pdl_qsort_ind_N,pdl_qsort_ind_Q,pdl_qsort_ind_F,pdl_qsort_ind_D) ($P(a), $P(indx),
+ 0, nn);';
+}
+
+pp_def(
+ 'qsorti',
+ HandleBad => 1,
+ Pars => 'a(n); indx [o]indx(n);',
+ Code =>
+ 'PDL_Indx nn = $COMP(__n_size)-1;
+ if ($SIZE(n) == 0) return;
+ loop(n) %{
+ $indx() = n;
+ %}
+ ' . generic_qsort_ind(),
+ BadCode =>
+ 'register PDL_Indx nn = 0, nb = $SIZE(n) - 1;
+ if ($SIZE(n) == 0) return;
+ loop(n) %{
+ if ( $ISGOOD(a()) ) { $indx(n=>nn) = n; nn++; } /* play safe since nn used more than once */
+ else { $indx(n=>nb) = n; nb--; }
+ %}
+ if ( nn != 0 ) {
+ nn -= 1;
+ ' . generic_qsort_ind() . ' }',
+ BadDoc =>
+'Bad elements are moved to the end of the array:
+
+ pdl> p $b
+ [42 47 98 BAD 22 96 74 41 79 76 96 BAD 32 76 25 59 BAD 96 32 BAD]
+ pdl> p $b->index( qsorti($b) )
+ [22 25 32 32 41 42 47 59 74 76 76 79 96 96 96 98 BAD BAD BAD BAD]
+',
+ Doc => '
+=for ref
+
+Quicksort a vector and return index of elements in ascending order.
+
+=for example
+
+ $ix = qsorti $a;
+ print $a->index($ix); # Sorted list
+
+=cut
+
+'
+ ); # pp_def: qsorti
+
+
+
+# move all bad values to the end of the array
+#
+pp_def(
+ 'qsortvec',
+ HandleBad => 1,
+ Inplace => 1,
+ Pars => 'a(n,m); [o]b(n,m);',
+ Code =>
+ 'PDL_Indx nn;
+ PDL_Indx nd;
+ loop(n,m) %{ $b() = $a(); %}
+ nn = ($COMP(__m_size))-1;
+ nd = $COMP(__n_size);
+ ' . generic_qsortvec('b','nd'),
+ Doc => '
+=for ref
+
+Sort a list of vectors lexicographically.
+
+The 0th dimension of the source piddle is dimension in the vector;
+the 1st dimension is list order. Higher dimensions are threaded over.
+
+=for example
+
+ print qsortvec pdl([[1,2],[0,500],[2,3],[4,2],[3,4],[3,5]]);
+ [
+ [ 0 500]
+ [ 1 2]
+ [ 2 3]
+ [ 3 4]
+ [ 3 5]
+ [ 4 2]
+ ]
+
+
+=cut
+
+',
+ BadDoc =>
+'
+Vectors with bad components should be moved to the end of the array:
+',
+ ); # pp_def qsort
+
+sub generic_qsortvec_ind {
+ my $pdl = shift;
+ my $ndim = shift;
+ return '$TBSULNQFD(pdl_qsortvec_ind_B,pdl_qsortvec_ind_S,pdl_qsortvec_ind_U,
+ pdl_qsortvec_ind_L,pdl_qsortvec_ind_N,pdl_qsortvec_ind_Q,pdl_qsortvec_ind_F,pdl_qsortvec_ind_D) ($P(' . $pdl . '), $P(indx), '. $ndim.', 0, nn);';
+}
+
+pp_def(
+ 'qsortveci',
+ HandleBad => 1,
+ Pars => 'a(n,m); indx [o]indx(m);',
+ Code =>
+ 'PDL_Indx nd;
+ PDL_Indx nn=$COMP(__m_size)-1;
+ loop(m) %{
+ $indx()=m;
+ %}
+ nd = $COMP(__n_size);
+ ' . generic_qsortvec_ind('a','nd'),
+ Doc => '
+=for ref
+
+Sort a list of vectors lexicographically, returning the indices of the
+sorted vectors rather than the sorted list itself.
+
+As with C<qsortvec>, the input PDL should be an NxM array containing M
+separate N-dimensional vectors. The return value is an integer M-PDL
+containing the M-indices of original array rows, in sorted order.
+
+As with C<qsortvec>, the zeroth element of the vectors runs slowest in the
+sorted list.
+
+Additional dimensions are threaded over: each plane is sorted separately,
+so qsortveci may be thought of as a collapse operator of sorts (groan).
+
+=cut
+
+',
+ BadDoc =>
+'
+Vectors with bad components should be moved to the end of the array:
+',
+ );
+
+
+
+
+# I don't think the old behaviour is correct in the presence of NaN's -
+# surely it will set the min/max values to NaN in this case?
+#
+# I have kept in the check for when Bad value support is not being compiled
+#
+my $nan_check = $bvalflag ? '' : '|| IsNaN(cur)';
+# my $nan_check = 0 ? '' : '|| IsNaN(cur)'; # This seems to work, not tested
+
+for my $which (
+ ['minimum','<'],
+ ['maximum','>']
+ ) {
+ my $name = $which->[0];
+ my $op = $which->[1];
+
+ pp_def(
+ $name,
+ HandleBad => 1,
+ Pars => 'a(n); [o]c();',
+ Code =>
+ '$GENERIC() cur;
+ loop(n) %{
+ if(!n || $a() '.$op.' cur ' . $nan_check . ') {cur = $a();}
+ %}
+ $c() = cur;',
+ BadCode =>
+ '$GENERIC() cur;
+ int flag = 0;
+ loop(n) %{
+ if( $ISGOOD(a()) && (!flag || $a() '.$op.' cur)) {cur = $a(); flag = 1;}
+ %}
+ if ( flag ) { $c() = cur; }
+ else { $SETBAD(c()); $PDLSTATESETBAD(c); }',
+ CopyBadStatusCode => '',
+ Doc => projectdocs($name,$name),
+ BadDoc =>
+'Output is set bad if all elements of the input are bad,
+otherwise the bad flag is cleared for the output piddle.
+
+Note that C<NaNs> are considered to be valid values;
+see L<isfinite|PDL::Math/isfinite> and L<badmask|PDL::Math/badmask>
+for ways of masking NaNs.
+',
+ );
+
+ pp_def(
+ "${name}_ind",
+ HandleBad => 1,
+ Pars => 'a(n); indx [o] c();',
+ Code =>
+ '$GENERIC() cur;
+ PDL_Indx curind;
+ loop(n) %{
+ if(!n || $a() '.$op.' cur ' . $nan_check . ')
+ {cur = $a(); curind = n;}
+ %}
+ $c() = curind;',
+ BadCode =>
+ '$GENERIC() cur;
+ PDL_Indx curind; int flag = 0; /* should set curind to -1 and check for that, then do not need flag */
+ loop(n) %{
+ if( $ISGOOD(a()) && (!flag || $a() '.$op.' cur))
+ {cur = $a(); curind = n; flag = 1;}
+ %}
+ if ( flag ) { $c() = curind; }
+ else { $SETBAD(c()); $PDLSTATESETBAD(c); }',
+ CopyBadStatusCode => '',
+ Doc => "Like $name but returns the index rather than the value",
+ BadDoc =>
+'Output is set bad if all elements of the input are bad,
+otherwise the bad flag is cleared for the output piddle.',
+ );
+
+ pp_def(
+ "${name}_n_ind",
+ HandleBad => 0, # just a marker
+ Pars => 'a(n); indx [o]c(m);',
+ Code =>
+ '$GENERIC() cur; PDL_Indx curind; register PDL_Indx ns = $SIZE(n);
+ if($SIZE(m) > $SIZE(n)) $CROAK("n_ind: m_size > n_size");
+ loop(m) %{
+ curind = ns;
+ loop(n) %{
+ PDL_Indx nm; int flag=0;
+ for(nm=0; nm<m; nm++) {
+ if($c(m=>nm) == n) {flag=1; break;}
+ }
+ if(!flag &&
+ ((curind == ns) || $a() '.$op.' cur || IsNaN(cur)))
+ {cur = $a(); curind = n;}
+ %}
+ $c() = curind;
+ %}',
+ Doc => "Returns the index of C<m> $name elements",
+ BadDoc => 'Not yet been converted to ignore bad values',
+ );
+
+} # foreach: $which
+
+# removed IsNaN handling, even from Code section
+# I think it was wrong, since it was
+#
+# if (!n || ($a() < curmin) || IsNaN(curmin)) {curmin = $a(); curmin_ind = n;};
+# if (!n || ($a() > curmax) || IsNaN(curmax)) {curmax = $a(); curmax_ind = n;};
+#
+# surely this succeeds if cur... is a NaN??
+#
+pp_def(
+ 'minmaximum',
+ HandleBad => 1,
+ Pars => 'a(n); [o]cmin(); [o] cmax(); indx [o]cmin_ind(); indx [o]cmax_ind();',
+ Code =>
+ '$GENERIC() curmin, curmax;
+ PDL_Indx curmin_ind, curmax_ind;
+
+ curmin = curmax = 0; /* Handle null piddle --CED */
+
+ loop(n) %{
+ if ( !n ) {
+ curmin = curmax = $a();
+ curmin_ind = curmax_ind = n;
+ } else {
+ if ( $a() < curmin ) { curmin = $a(); curmin_ind = n; }
+ if ( $a() > curmax ) { curmax = $a(); curmax_ind = n; }
+ }
+ %}
+ $cmin() = curmin; $cmin_ind() = curmin_ind;
+ $cmax() = curmax; $cmax_ind() = curmax_ind;',
+ CopyBadStatusCode => '',
+ BadCode =>
+ '$GENERIC() curmin, curmax;
+ PDL_Indx curmin_ind, curmax_ind; int flag = 0;
+
+ loop(n) %{
+ if ( $ISGOOD(a()) ) {
+ if ( !flag ) {
+ curmin = curmax = $a();
+ curmin_ind = curmax_ind = n;
+ flag = 1;
+ } else {
+ if ( $a() < curmin ) { curmin = $a(); curmin_ind = n; }
+ if ( $a() > curmax ) { curmax = $a(); curmax_ind = n; }
+ }
+ } /* ISGOOD */
+ %}
+ if ( flag ) { /* Handle null piddle */
+ $cmin() = curmin; $cmin_ind() = curmin_ind;
+ $cmax() = curmax; $cmax_ind() = curmax_ind;
+ } else {
+ $SETBAD(cmin()); $SETBAD(cmin_ind());
+ $SETBAD(cmax()); $SETBAD(cmax_ind());
+ $PDLSTATESETBAD(cmin); $PDLSTATESETBAD(cmin_ind);
+ $PDLSTATESETBAD(cmax); $PDLSTATESETBAD(cmax_ind);
+ }',
+ Doc =>
+'
+=for ref
+
+Find minimum and maximum and their indices for a given piddle;
+
+=for usage
+
+ pdl> $a=pdl [[-2,3,4],[1,0,3]]
+ pdl> ($min, $max, $min_ind, $max_ind)=minmaximum($a)
+ pdl> p $min, $max, $min_ind, $max_ind
+ [-2 0] [4 3] [0 1] [2 2]
+
+See also L<minmax|/minmax>, which clumps the piddle together.
+
+=cut
+
+',
+ BadDoc =>
+'If C<a()> contains only bad data, then the output piddles will
+be set bad, along with their bad flag.
+Otherwise they will have their bad flags cleared,
+since they will not contain any bad values.',
+ ); # pp_def minmaximum
+
+
+pp_addpm({At=>'Bot'},<<'EOD');
+
+=head1 AUTHOR
+
+Copyright (C) Tuomas J. Lukka 1997 (lukka at husc.harvard.edu).
+Contributions by Christian Soeller (c.soeller at auckland.ac.nz)
+and Karl Glazebrook (kgb at aaoepp.aao.gov.au). All rights
+reserved. There is no warranty. You are allowed to redistribute this
+software / documentation under certain conditions. For details, see
+the file COPYING in the PDL distribution. If this file is separated
+from the PDL distribution, the copyright notice should be included in
+the file.
+
+=cut
+
+EOD
+
+pp_done();
+
diff --git a/Basic/default.perldlrc b/Basic/default.perldlrc
new file mode 100644
index 0000000..371f54b
--- /dev/null
+++ b/Basic/default.perldlrc
@@ -0,0 +1,39 @@
+
+# default.perldlrc
+
+# Default startup for perldl shell.
+# Note: any $HOME/.perldlrc file overrides this
+
+use PDL;
+use PDL::Dbg; # Enable useful commands
+use PDL::Constants qw(PI E); # add PI and E constants
+#use PDL::Lite; # Alternative to above for hard-core freaks
+
+# These are some PDL::Core parameters that you may wish
+# to set in an interactive PDL session:
+#
+# $PDL::debug When true, PDL debugging information is printed.
+# $PDL::verbose When true, PDL functions provide chatty information.
+# $PDL::use_commas Whether to insert commas when printing pdls
+# $PDL::floatformat The default print format for floats
+# $PDL::doubleformat The default print format for doubles
+# $PDL::undefval The value to use instead of "undef" when creating pdls.
+# $PDL::toolongtoprint The maximal size pdls to print (defaults to 10000 elements)
+
+# PDL waffle options (and pacify -w)
+BEGIN{
+ $PDL::debug = $PDL::debug = 0;
+ $PDL::verbose = $PDL::verbose = 1;
+ $PDL::toolongtoprint = $PDL::toolongtoprint = 10000;
+ $PDL::IO::FlexRaw::writeflexhdr = 1;
+}
+
+if ( $PERLDL::TERM->ReadLine() =~ /::Perl$/ ) {
+ if ( defined $readline::rl_MaxHistorySize ) {
+ $readline::rl_MaxHistorySize = $PERLDL::HISTFILESIZE if defined $PERLDL::HISTFILESIZE;
+ }
+}
+
+use PDL::Doc::Perldl; # online docs module
+
+1;
diff --git a/Bugs.pod b/Bugs.pod
new file mode 100644
index 0000000..6709182
--- /dev/null
+++ b/Bugs.pod
@@ -0,0 +1,177 @@
+package PDL::Bugs;
+
+# How to get help diagnosing PDL problems and
+# how to make and submit a useful bug report
+
+__END__
+
+=pod
+
+=head1 NAME
+
+PDL::Bugs - How to diagnose and report PDL problems
+
+=head1 VERSION
+
+version 1.0000
+
+=head1 DESCRIPTION
+
+This module explains how to get help with a PDL problem
+and how, when, and where to submit a bug report. In the
+future it may be extended to provide some sort of automated
+bug reporting capability.
+
+=head1 IF YOU HAVE A PDL PROBLEM
+
+The primary resource for support for the Perl Data Language
+is via the PDL mailing lists. The perldl list is for general
+use and discussions and is the one to use for questions about
+problems with PDL or PDL use for computation. This
+I<is almost always> the list to post to for PDL problems.
+
+The pdl-porters list is I<specifically> for PDL development
+and often contains discussions of a rather technical nature
+relating to PDL internals. This is I<not> the list for
+general PDL discussion or questions.
+
+ http://pdl.perl.org/?page=mailing-lists
+
+B<NOTE>: Both perldl and pdl-porters are read by the PDL
+developers so you don't save time or increase the probability
+of response by posting to pdl-porters or by cross-posting
+to pdl-porters. Please stick to perldl list posts unless
+you want to talk PDL implementation and development.
+
+B<NOTE>: There is also a PDL IRC channel which can be useful
+for immediate questions if populated. However, it has the
+big disadvantage of not being easily searched or routinely
+read by all PDL developers and users. As a result, if you
+get an answer there, it may be incorrect or incomplete
+depending on who happens to be chatting at the time. It
+is definitely not readily searchable.
+
+=head1 REPORTING BUGS
+
+Please submit bug reports via the sourceforge bug tracker
+interface at
+
+ http://sourceforge.net/p/pdl/bugs/
+
+where you can review the previously submitted bug reports.
+Click on C<Create Ticket> to generate a bug report. If you do not
+already have a sourceforge.net account, you will need to
+get one to submit the report:
+
+ http://sourceforge.net/account/registration/
+
+Please provide a way for the PDL developers to contact you
+regarding the problem.
+
+Try to include any information you think might help someone
+isolate, reproduce, and fix your problem.
+
+At a I<minimum>, include the following information:
+
+=over
+
+=item *
+
+PDL version number (e.g. PDL-2.007)
+
+=item *
+
+Perl version information. Output from C<perl -v> or C<perl -V> (even better!)
+
+=item *
+
+Your operating System. You can run the C<uname -a> command on many unix systems
+
+=item *
+
+The full output of C<perldl -V>
+
+If you are reporting a bug with an already installed PDL. If the PDL
+has compiled and built but not been installed, you may run
+C<perl -Mblib perldl -V> from the top level of the PDL build directory.
+
+=item *
+
+The bug description and how to reproduce it.
+
+Short examples using the PDL shells, C<pdl2> or C<perldl>, are excellent!
+Don't forget to include needed input data (as small as possible) so that
+the code can be run with a cut and paste.
+
+=back
+
+Other things that are often helpful:
+
+=over
+
+=item *
+
+Details about your operating environment that might be related to the problem
+
+=item *
+
+Exact cut and pasted error or warning messages
+
+=item *
+
+The shortest, clearest code you can manage to write which reproduces the bug described.
+
+=item *
+
+A patch against the latest released version of this distribution which fixes this bug.
+
+=back
+
+Alternatively, send an e-mail report with the above
+information (including the output of C<perldl -V>)
+to C<pdl-porters at jach.hawaii.edu>. See
+
+ http://pdl.perl.org/?page=mailing-lists
+
+for info on how to subscribe to this list.
+
+
+=head1 BEFORE YOU SEND A REPORT
+
+BEFORE you report a bug make sure you got the latest
+release version of PDL, always available from CPAN,
+check
+
+ http://search.cpan.org/search?dist=PDL
+
+Also, you can check the FAQ at
+
+ http://pdl.perl.org/?docs=FAQ&title=PDL::FAQ
+
+and the mailing list archives for hints. You can find links to the
+searchable archives at
+
+ http://pdl.perl.org/?page=mailing-lists
+
+and there is a Google enable search box on the top right of
+L<http://pdl.perl.org> which usually gives the best results.
+
+
+=head1 PATCHES
+
+Patches can be sent to the pdl-porters mailing list
+(see above) or can be directly submitted to the
+patch manager
+
+ http://sourceforge.net/p/pdl/patches/
+
+Patches should be made against the latest released
+PDL or, ideally, against the current git sources
+which you can browse and check out at
+
+ git://git.code.sf.net/p/pdl/code
+
+Thanks,
+The pdl-porters team.
+
+=cut
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..77d12dd
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,63 @@
+ Copyright (c) 1997-2006 by the contributors named in the individual files.
+ All rights reserved. This distribution is free software; you can
+ redistribute it and/or modify it under the same terms as Perl itself.
+
+ The demonstration image m51.fits is derived from the Hubble Heritage
+ project archival images; its creation was funded in part by a grant
+ from NASA. The image is in the public domain.
+
+ Inline documentation in any module files (pod format) and documentation
+ files (.pod files) in this distribution are additionally protected by
+ the following statement:
+
+ Permission is granted for verbatim copying (and formatting) of this
+ documentation as part of the PDL distribution. Permission is granted to
+ freely distribute verbatim copies of this documentation only if
+ the following conditions are met: 1. that the copyright notice remains
+ intact 2. the original authors' names are clearly displayed, 3. that
+ any changes made to the documentation outside the official PDL
+ distribution (as released by the current release manager) are clearly
+ marked as such and 4. That this copyright notice is distributed with
+ the copied version so that it may be easily found.
+
+ All the files in the distribution should have a copyright notice
+ according to the following template:
+
+ Copyright (C) 199X Author1, Author2.
+ All rights reserved. There is no warranty. You are allowed
+ to redistribute this software / documentation as described
+ in the file COPYING in the PDL distribution.
+
+ In addition, the following disclaimers apply:
+
+ THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+ OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE CONTRIBUTORS BE LIABLE FOR ANY
+ DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
+ BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+ FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+ OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+ PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
+ EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+ THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS
+ WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+ WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+ REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR
+ DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL
+ DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM
+ (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED
+ INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF
+ THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER
+ OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..87bf60f
--- /dev/null
+++ b/Changes
@@ -0,0 +1,25180 @@
+commit b1d2c53432d954e3ae4a1889b6a0d1dbf7039731
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Oct 12 12:20:54 2013 -0400
+
+ Final updates and Release_Notes for PDL-2.007 release
+
+ DEPENDENCIES | 10 +-
+ Known_problems | 17 +--
+ Makefile.PL | 2 +-
+ README | 2 +-
+ Release_Notes | 553 +++++++-------------------------------------------------
+ 5 files changed, 75 insertions(+), 509 deletions(-)
+
+commit bc864bc43e1d04169d742c5c3c9015d04b75b374
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Fri Oct 11 16:53:33 2013 -0700
+
+ pdl_trans is now properly defined as a flexible array
+
+ pdl_trans was intended to have a variable number of pdl objects in it, but the
+ code defined this number as 1. This causes issues with gcc4.8, which is more
+ aggressive at optimizing the code based on what the programmer tells it. In this
+ case, the pdl[1] that the code had was taken literally. The new flexible array
+ implementation tells the compiler exactly what is happening, and all is well.
+
+ See this thread:
+
+ http://mailman.jach.hawaii.edu/pipermail/perldl/2013-October/008191.html
+
+ Basic/Core/pdl.h.PL | 56 +++++++++++++++++++++++++++++++-------------------
+ 1 files changed, 35 insertions(+), 21 deletions(-)
+
+commit a36eb5dc841ea50f60bad4cab5e8560b6b128820
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Fri Oct 11 15:52:14 2013 -0700
+
+ clarified how _MSC_VER affects PDL_TRANS_START()
+
+ Basic/Core/pdl.h.PL | 20 +++++---------------
+ 1 files changed, 5 insertions(+), 15 deletions(-)
+
+commit 028a725c9ef8b174d645f503a7af2fe254547374
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Fri Oct 11 15:40:29 2013 -0700
+
+ removed needless cast from pointer to (wrong-sized) int
+
+ Basic/Core/pdlapi.c | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 56d6cc355d7585114e4f76ed4bf0d5fb3f6f28bd
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Fri Oct 11 15:39:32 2013 -0700
+
+ PDL_CHKMAGIC...() now uses a pointer-specific printf() format
+
+ Basic/Core/pdl.h.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit cd1a4334d906b3d733973b5b553fc5f189747a87
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Fri Oct 11 15:33:44 2013 -0700
+
+ consolidated the two PDL_CHKMAGIC macros into one
+
+ Basic/Core/pdl.h.PL | 18 ++++++++----------
+ 1 files changed, 8 insertions(+), 10 deletions(-)
+
+commit ed50f5c07faefc5fc9eeda020f91b3ed4d2a3cc9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 11 01:58:37 2013 -0400
+
+ Update DEPENDENCIES and Known_problems
+
+ DEPENDENCIES | 5 +++++
+ Known_problems | 12 ++++++++++++
+ 2 files changed, 17 insertions(+), 0 deletions(-)
+
+commit 5dcbdf268739fd26fa7a009bd2d1620c1d22067c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Oct 10 09:48:54 2013 -0400
+
+ Update VERISON to 2.006_93 for PDL-2.007 release candidate
+
+ Assuming PDL-2.006_92 tests well, the PDL-2.006_93 release
+ will be the release candidate for PDL-2.007. We're in code
+ freeze so work from now to PDL-2.007 should be only documentation
+ and the ilk.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 6 +++++-
+ Release_Notes | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 54 insertions(+), 2 deletions(-)
+
+commit 880a98229711e9e36b6f92c3b74194bbdb09a6c2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Oct 10 09:42:48 2013 -0400
+
+ Update Known_problems and Release_Notes for PDL-2.006_92 release
+
+ Known_problems | 8 --------
+ Release_Notes | 14 +++++++++++++-
+ 2 files changed, 13 insertions(+), 9 deletions(-)
+
+commit b2c4c726cff6f458ed945626c1f99b1832e9b378
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 7 17:01:26 2013 -0400
+
+ Add g to substitute for pod obfuscation fix
+
+ Basic/Gen/PP.pm | 10 ++++++++--
+ 1 files changed, 8 insertions(+), 2 deletions(-)
+
+commit 9f6bd7d0964a64648c586d91c9a4da6d351a5959
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 7 16:57:09 2013 -0400
+
+ Add Bugs.pod to MAN1PODS hash
+
+ Makefile.PL | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 1c30a6f9faa13d2ef8a923b3d31b7a73f6a94650
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 7 12:27:00 2013 -0400
+
+ Put map in list context for pdldoc obfuscation
+
+ Basic/Gen/PP.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 8ae1f0059ef5dfc161d651952d03750cd2b6bad3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 7 10:16:30 2013 -0400
+
+ Add PDL::Doc compatible function refs to PP.pod
+
+ We might want to revisit the PDL::Doc implementation to
+ make it easier to mark items for the pdldoc database.
+
+ Basic/Pod/PP.pod | 140 ++++++++++++++++++++++++++++++++++++++++++++++++++++--
+ 1 files changed, 135 insertions(+), 5 deletions(-)
+
+commit 46468fb511ed5ed9d67905039f227234a3306ffb
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Mon Oct 7 21:33:13 2013 +1100
+
+ Graphics/PLplot/plplot.pd - address portability issue
+
+ Define "c_plwid" to "c_plwidth" iff "plwidth" is
+ defined.
+
+ Graphics/PLplot/plplot.pd | 41 +++++++++++++++++++++++------------------
+ 1 files changed, 23 insertions(+), 18 deletions(-)
+
+commit 69331eedde82efd3a94f88668e377b01757b81e3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 6 16:04:23 2013 -0400
+
+ Obfuscate pod constructs so perldoc doesn't see them
+
+ Some of the PP commands generate POD and the format of
+ the text pieces used to produce the generated POD looked
+ like valid POD since they were in heredocs at the first char.
+ Added a prefix and map command to hide them. Now only PP.pod
+ shows as having docs. Still need to add POD for the various
+ pp_xxx routines in a form so pdldoc (especially with -a will
+ find the references).
+
+ Basic/Gen/PP.pm | 14 +++++++-------
+ 1 files changed, 7 insertions(+), 7 deletions(-)
+
+commit 7ac6a050d4daaf65451de82644495d7edc9b6cc6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 6 15:34:06 2013 -0400
+
+ Move BUGS to Bugs.pod for discoverable documentation
+
+ This should make it easier for non-hand-install PDLers
+ to find instructions for submitting problem reports or
+ where to ask questions.
+
+ BUGS | 99 ---------------------------------
+ Bugs.pod | 177 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ MANIFEST | 2 +-
+ Makefile.PL | 2 +-
+ 4 files changed, 179 insertions(+), 101 deletions(-)
+
+commit 6a2ed5e50019686dd783cf005cb79fb6bb2648c6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 6 10:44:24 2013 -0400
+
+ Make PDL::NiceSlice preserve line numbering (sf.net feature #75)
+
+ Now niceslice processing leaves whitespace (and newlines) in
+ place so that line numbering is preserved by the preprocessor
+ and hence debug messages refer to the correct line in the
+ original, unfiltered code.
+
+ Basic/SourceFilter/NiceSlice.pm | 7 ++++++-
+ 1 files changed, 6 insertions(+), 1 deletions(-)
+
+commit f2b71efe391ecb335d57007eabf8167154de3d66
+Merge: 6872726 8fefb6d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 6 10:43:54 2013 -0400
+
+ Merge branch 'master' of ssh://git.code.sf.net/p/pdl/code
+
+commit 8fefb6da5e599646e0285660176020f1a7f06afc
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sun Oct 6 10:20:51 2013 -0400
+
+ Added simple CLONE_SKIP to PDL.pm
+
+ Basic/PDL.pm | 18 +++++++++++++++++-
+ 1 files changed, 17 insertions(+), 1 deletions(-)
+
+commit 68727266edcadd25866da38897ba7b4f864d0672
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 6 10:08:34 2013 -0400
+
+ Update needed version of Perl OpenGL to 0.6702
+
+ Be sure to add warning of change to Release_Notes so no-one is
+ caught by surprise.
+
+ Basic/SourceFilter/NiceSlice.pm | 1 +
+ Graphics/TriD/POGL/Makefile.PL | 16 ++++++++--------
+ perldl.conf | 2 +-
+ 3 files changed, 10 insertions(+), 9 deletions(-)
+
+commit 9ced359cfe2c569c735636590d4978f18adb3b63
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 1 19:01:38 2013 -0400
+
+ Update typemap.pdl from typemap
+
+ The PP typemap that is used is the typemap.pdl file installed in
+ the PDL/Core directory. This updates that file with the new
+ PDL_Indx type for index data values.
+
+ Basic/Core/typemap.pdl | 10 ++++++++++
+ 1 files changed, 10 insertions(+), 0 deletions(-)
+
+commit 4dbb2444329d141f42aebc89c0a13641d70c73a4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Sep 29 15:04:34 2013 -0400
+
+ Update VERSION to 2.006_092 for more PDL-2.007 final development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 41 +++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 43 insertions(+), 2 deletions(-)
+
+commit f86080a9f8b3083790da09fb025f4827f8d8d5de
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 28 18:28:42 2013 -0400
+
+ Update Known_problems and Release_Notes.
+
+ Known_problems | 10 ----------
+ Release_Notes | 16 +++++++++++++++-
+ 2 files changed, 15 insertions(+), 11 deletions(-)
+
+commit 4409c513f722eac54de1ff601b004e7752fbe9d3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 28 17:48:21 2013 -0400
+
+ Update ExtUtils::MakeMaker required to 6.56
+
+ To enable support for CONFIGURE_REQUIRES option. This allows
+ us to stop having a local copy of Devel::CheckLib in inc/
+
+ MANIFEST.SKIP | 1 +
+ Makefile.PL | 3 ++-
+ 2 files changed, 3 insertions(+), 1 deletions(-)
+
+commit 5214b23d6ecdb690077fcbd59c71c6561d1c40de
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 26 09:01:08 2013 -0400
+
+ Fix some missing int->indx/PDL_Indx conversions in primitive.pd
+
+ vsearch, which, and which_both. Thanks to Edward Baudrez for
+ reporting the problem.
+
+ Basic/Primitive/primitive.pd | 14 +++++++-------
+ 1 files changed, 7 insertions(+), 7 deletions(-)
+
+commit cccb2f201dc7417e478ddf3165ded290ca9f8586
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 25 13:28:42 2013 -0400
+
+ Add some tapprox() to floating point equality tests.
+
+ t/ufunc.t | 20 ++++++++++----------
+ 1 files changed, 10 insertions(+), 10 deletions(-)
+
+commit 6c60172f3ae7e40f1f0f65432dbb3e2135abcf27
+Merge: 0fe3d13 9b6954b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 24 07:02:54 2013 -0400
+
+ Merge branch 'master' of ssh://git.code.sf.net/p/pdl/code
+
+commit 0fe3d138f1def45e5e524ec105caa65eecd0761e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 24 07:02:06 2013 -0400
+
+ Remove ref to previous indx conversion routines: ind and index
+
+ Basic/Gen/PP/PDLCode.pm | 2 --
+ 1 files changed, 0 insertions(+), 2 deletions(-)
+
+commit 9b6954b494f488090ce18f59886aa3278e2b3769
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Tue Sep 24 11:19:14 2013 +0200
+
+ add "afh" option to rfits to allow explicit use of legacy hash
+ parser for performance reasons. (This was possible before but
+ only by localizing the undocumented global variable $PDL::Astro_Fits_Header).
+
+ IO/FITS/FITS.pm | 17 ++++++++++++++---
+ 1 files changed, 14 insertions(+), 3 deletions(-)
+
+commit 83001b7445fe893c7035e14434645bb040c4bb9e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Sep 22 07:18:13 2013 -0400
+
+ Update VERSION to 2.006_91 for finishing PDL-2.007 development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 41 +++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 43 insertions(+), 2 deletions(-)
+
+commit ad25b02188eb877a8ccf6bacc4560205daf9aaf2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 21 21:17:19 2013 -0400
+
+ Update Known_problems for CPAN Developers release 2.006_90
+
+ Known_problems | 5 -----
+ 1 files changed, 0 insertions(+), 5 deletions(-)
+
+commit 13936b313be1571a401b7dedc07b8ac9f4deae6b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 21 21:17:00 2013 -0400
+
+ Fix a few missed modover->modeover changes
+
+ Basic/Ufunc/ufunc.pd | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 40ba95910e61ab74aa59010a2d714572e890ea63
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 21 20:44:38 2013 -0400
+
+ Change modover to modeover in t/ufunc.t
+
+ t/ufunc.t | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 00d436d11f93ae87a8530c4ee81879b69e046b3e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 21 17:45:41 2013 -0400
+
+ Update Release_Notes
+
+ Release_Notes | 12 +++++++++++-
+ 1 files changed, 11 insertions(+), 1 deletions(-)
+
+commit f32707688ec90d8eac96f2884b81768037177645
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 21 17:44:34 2013 -0400
+
+ Use mode/modeover rather than mode/modover
+
+ To avoid confusion---even if it looks a bit odd, rpic() doesn't
+ read like a real word either.
+
+ Basic/Ufunc/ufunc.pd | 12 +++++++-----
+ 1 files changed, 7 insertions(+), 5 deletions(-)
+
+commit ed84ab3d297cf9803d9af0ae3eed35ad53e741e5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 21 10:37:10 2013 -0400
+
+ Minor update to PDL FAQ
+
+ Basic/Pod/FAQ.pod | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit acee3e1925772addf3f66afded29ff48de9419d5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 21 10:26:57 2013 -0400
+
+ More explanation for PDL_Indx type use and meaning
+
+ Basic/Pod/API.pod | 7 ++++---
+ Basic/Pod/QuickStart.pod | 10 +++++++---
+ 2 files changed, 11 insertions(+), 6 deletions(-)
+
+commit f50b4051105fe7bbbdd89cac6a3224cf486a6627
+Merge: 2d1c198 571f925
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Wed Sep 18 18:12:14 2013 -0600
+
+ Merge branch 'master' of ssh://git.code.sf.net/p/pdl/code
+
+commit 2d1c198fc25a49d8f718daa81c71abe1fb03ced8
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Wed Sep 18 18:11:08 2013 -0600
+
+ add mode/modover and appropriate tests; clarify generic ufunc docs slightly.
+
+ Basic/Ufunc/ufunc.pd | 56 ++++++++++++++++++++++++++++++++++++++++++-------
+ t/ufunc.t | 7 +++++-
+ 2 files changed, 54 insertions(+), 9 deletions(-)
+
+commit 571f925226abeb29b0bbb754673a603988fa19c8
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Wed Sep 18 09:32:00 2013 +1000
+
+ Basic/Slices/slices.pd - Fix for MSVC++ 6.0
+
+ VC6 doesn't have either strtoll or _strtoi64. Thankfully,
+ neither is needed for a PDL build using VC6 compiler
+
+ Basic/Slices/slices.pd | 488 ++++++++++++++++++++++++------------------------
+ 1 files changed, 246 insertions(+), 242 deletions(-)
+
+commit 07b3012f36a5b3df228f688e42173baa9f8d11bf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Sep 16 14:23:26 2013 -0400
+
+ Update *.pod files to cover new PDL_Indx and slice support
+
+ Basic/Pod/API.pod | 24 ++++++++++++++----------
+ Basic/Pod/FAQ.pod | 18 +++++++++---------
+ Basic/Pod/Internals.pod | 31 ++++++++++++++++---------------
+ Basic/Pod/QuickStart.pod | 11 ++++-------
+ Basic/Pod/Scilab.pod | 2 +-
+ 5 files changed, 44 insertions(+), 42 deletions(-)
+
+commit 48c5ae54f5214e89a033ba05a4882c1c6c371c9c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Sep 16 13:07:12 2013 -0400
+
+ Replace nslice and mslice refs by new, improved slice()
+
+ Basic/SourceFilter/NiceSlice.pm | 32 +++++++++++++-------------------
+ 1 files changed, 13 insertions(+), 19 deletions(-)
+
+commit bf76feeaaf29a09436121abbcad89bcf060bcb08
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Sep 16 08:51:23 2013 -0400
+
+ Update some items in PDL/TODO
+
+ TODO | 20 +++++++++++++++++---
+ 1 files changed, 17 insertions(+), 3 deletions(-)
+
+commit 88f6b7c9ab77af2b1c5b77d2523b2c35f8e4e7ec
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Sun Sep 15 23:28:13 2013 -0600
+
+ clean up slice tests; add test for ignoring whitespace; add docs about whitespace to slices.pd
+
+ Basic/Slices/slices.pd | 7 +++--
+ t/slice.t | 59 ++++++++++++++++++------------------------------
+ 2 files changed, 26 insertions(+), 40 deletions(-)
+
+commit 956b68bd63dbbfa84315ecf38905da4769c3b941
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 14 12:39:42 2013 -0400
+
+ Update VERSION to 2.006_90 for final PDL-2.007 development
+
+ This release will be PDL-2.007 pre1.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 41 +++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 43 insertions(+), 2 deletions(-)
+
+commit 09a6ab3c7b75d5132e9e1a06f673ad5619fbe4c3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 14 11:55:01 2013 -0400
+
+ Update Known_problems and Release_Notes for CPAN devel release
+
+ Known_problems | 11 ++++++++---
+ Release_Notes | 6 ++++++
+ 2 files changed, 14 insertions(+), 3 deletions(-)
+
+commit e48c63190f113150c7df6d7622e16a401093c8c3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 14 11:28:37 2013 -0400
+
+ Fix OpenBSD pthread build problem for non-threaded perls
+
+ There is an open Feature Request ticket to improve the
+ pthreads detection and build for PDL. For OpenBSD 5.3
+ and non-threaded perls, the current build fails. For
+ that case, I now disable the pthreads building. This
+ can be re-enabled when the pthreads detection is revisited,
+ perhaps during the PDL-2.008 clean-up release.
+
+ Basic/Core/Makefile.PL | 19 ++++++++++++-------
+ 1 files changed, 12 insertions(+), 7 deletions(-)
+
+commit eb26375c3907bfe4bf900f2ad09df2f61c56cd4a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 14 11:27:18 2013 -0400
+
+ Add pp_add_exported for new PDL::slice wrapper
+
+ Basic/Slices/slices.pd | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit 8eb34aa174f3fa7a9434532205b3ba32ecd4874b
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Fri Sep 13 23:34:22 2013 -0600
+
+ multiple-extension writing for FITS; clean up multiple-extension reading in list context.
+
+ IO/FITS/FITS.pm | 723 ++++++++++++++++++++++++++++++-------------------------
+ t/fits.t | 25 ++-
+ 2 files changed, 415 insertions(+), 333 deletions(-)
+
+commit 5512e36f690a5d57c51dd7fe7a41efdf72850ece
+Merge: 7294fae f2a00d8
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Fri Sep 13 16:18:24 2013 -0600
+
+ Merge branch 'master' of ssh://git.code.sf.net/p/pdl/code
+ fell behind due to internet outage (Boulder, CO flooding!)
+
+commit f2a00d87b478b4daa935c282e538cbeb741efa95
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 13 09:15:04 2013 -0400
+
+ Update Release_Notes and Known_problems
+
+ Known_problems | 8 +++++---
+ Release_Notes | 13 ++++++++++++-
+ 2 files changed, 17 insertions(+), 4 deletions(-)
+
+commit 7294fae6fc451f68c31dfebd021ce65f585ed96e
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Sep 12 23:48:40 2013 -0600
+
+ clean slice docs some.
+
+ Basic/Slices/slices.pd | 55 ------------------------------------------------
+ 1 files changed, 0 insertions(+), 55 deletions(-)
+
+commit 47ec8f062578e262f2959b946c7a88da02f1d404
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Sep 12 23:46:09 2013 -0600
+
+ migrate nnslice to replace nslice and slice. move slice to oslice.
+ New documentation, some new tests to handle slightly different error
+ messages and regularized behavior in some odd corner cases.
+
+ Basic/Core/Core.pm.PL | 92 +-
+ Basic/Slices/slices.pd | 3310 +++++++++++++++++++++------------------
+ Basic/SourceFilter/NiceSlice.pm | 2 +-
+ t/croak.t | 2 +-
+ t/niceslice.t | 1 +
+ t/slice.t | 369 +----
+ 6 files changed, 1813 insertions(+), 1963 deletions(-)
+
+commit b3960c3897b6c29f1cbbbe0c06c40e56d953987a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 12 10:42:19 2013 -0400
+
+ Replace PDL_Index by PDL_Indx to fix Types.pm.PL
+
+ NOTE: The choice of the typename is a result of the current hack
+ for generating the various type conversion routines from some of
+ the fields in Types.pm.PL structures. I hope we can clean this
+ up for PDL3 to avoid the confusing mess. Another goal for PDL3
+ might be to collect all the type generation and use code into a
+ real PDL core. Right now it is spread amongst PDL/Basic/Core,
+ PDL/Basic/Gen and PDL/Basic/Slices (at least!).
+
+ Basic/Core/Core.xs.PL | 56 ++++++------
+ Basic/Core/Types.pm.PL | 35 +++++---
+ Basic/Core/pdl.h.PL | 16 ++--
+ Basic/Core/pdl_hfiles.p | 4 +-
+ Basic/Core/pdlapi.c | 26 +++---
+ Basic/Core/pdlconv.c.PL | 2 +-
+ Basic/Core/pdlcore.c.PL | 70 ++++++++--------
+ Basic/Core/pdlcore.h.PL | 80 +++++++++---------
+ Basic/Core/pdlhash.c | 4 +-
+ Basic/Core/pdlsections.g | 40 +++++-----
+ Basic/Core/pdlsimple.h.PL | 4 +-
+ Basic/Core/pdlthread.c | 40 +++++-----
+ Basic/Core/pdlthread.h | 10 +-
+ Basic/Core/typemap | 2 +-
+ Basic/Gen/PP.pm | 8 +-
+ Basic/Gen/PP/Dims.pm | 2 +-
+ Basic/Gen/PP/PDLCode.pm | 18 ++--
+ Basic/Gen/PP/PdlParObj.pm | 6 +-
+ Basic/Primitive/primitive.pd | 38 ++++----
+ Basic/Slices/slices.pd | 190 +++++++++++++++++++++---------------------
+ Basic/Ufunc/ufunc.pd | 88 ++++++++++----------
+ IO/Storable/storable.pd | 2 +-
+ Lib/ImageND/imagend.pd | 46 +++++-----
+ Lib/Minuit/FCN.c | 6 +-
+ 24 files changed, 402 insertions(+), 391 deletions(-)
+
+commit 0e438f0c40e3ca209ecb4d6bc41a520cd0cfa3a4
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Mon Sep 9 10:08:31 2013 -0600
+
+ fix nnslice indexing
+
+ Basic/Slices/slices.pd | 6 +++++-
+ 1 files changed, 5 insertions(+), 1 deletions(-)
+
+commit ef5728b56ed998658c774f3abe8c7598d471f2dd
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Fri Sep 6 17:00:15 2013 -0600
+
+ add index1d; change dice_axis engine and nnslice dicing engine to index1d
+ (greatly speeds up dicing)
+
+ Basic/Slices/slices.pd | 145 ++++++++++++++++++++++++++++++++++++++---------
+ 1 files changed, 117 insertions(+), 28 deletions(-)
+
+commit 18f3a4c71e21994abbda7cefeaa487abfe1d4eb7
+Merge: f1ec747 dfa7a0e
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Fri Sep 6 16:53:48 2013 -0600
+
+ Merge branch 'master' of ssh://git.code.sf.net/p/pdl/code
+ out of sync again...
+
+commit f1ec7474b35a68c2d914e68a426d0f48ab708415
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Fri Sep 6 16:51:43 2013 -0600
+
+ add more permissive parsing to SvPDLV - autopromote array refs to PDLs
+ (so you can say, e.g., "$a->index([2,3])" instead of "$a->index(pdl(2,3))").
+
+ Basic/Core/pdlcore.c.PL | 169 ++++++++++++++++++++--------------------------
+ t/argtest.t | 15 +++--
+ 2 files changed, 84 insertions(+), 100 deletions(-)
+
+commit dfa7a0eb5047aa7bb9df7a0fcc7e49e4497e1944
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Sep 5 23:21:27 2013 -0600
+
+ Convert basic.t to Test::More. Add tests for (x|y|z)(lin|log) vals and axisvals.
+
+ Devel::Cover showed that xlinvals etc were never tested at all. While I was in there, I converted it to Test::More (I think I got all the pieces!).
+
+ t/basic.t | 52 +++++++++++++++++++++++++++++++++++++++-------------
+ 1 files changed, 39 insertions(+), 13 deletions(-)
+
+commit 0845f0f22a08b547253a2f098b486efe859becb8
+Merge: 19f6ed8 449f9a1
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Sep 5 22:29:03 2013 -0600
+
+ Got a little out of sync updating Transform.
+ Merge branch 'master' of ssh://git.code.sf.net/p/pdl/code
+
+commit 19f6ed8d1523ea7fa834509efad9103cf66fe2f9
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Sep 5 22:28:03 2013 -0600
+
+ minor bugfix to new map code
+
+ Lib/Transform/transform.pd | 11 ++++-------
+ t/transform.t | 2 +-
+ 2 files changed, 5 insertions(+), 8 deletions(-)
+
+commit ddc1a46b3a5e9f6b45a530fc11a031ccc9e0cd15
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Thu Sep 5 17:51:25 2013 -0600
+
+ Two bug fixes to transform.pd, and an augmentation:
+
+ - t_fits now parses CDi_j header fields correctly for modern WCS.
+ - apply() and invert() check for undefined fields before trying to execute them.
+ (this works around a perl bug that causes "&$a" to hang if $a is undefined)
+ - map() now has a "rectify" flag that affects whether autoscaling attempts
+ to rectify the coordinate system when autoscaling, or no. This is useful
+ because sometimes you want that (the former default behavior) and sometimes
+ you want to preserve the original skew or rotation of the scientific coordinate
+ system while rescaling an image. (e.g. $a->match([100,100]) formerly rectified $a;
+ now by default it simply rescales $a. map itself keeps the old behavior by default.)
+
+ Lib/Transform/transform.pd | 302 ++++++++++++++++++++++++++++++--------------
+ 1 files changed, 207 insertions(+), 95 deletions(-)
+
+commit 449f9a1afd7dfa51d09646de87cc581556b35834
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 5 09:37:12 2013 -0400
+
+ Update VERSION to 2.006_07 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 39 +++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 41 insertions(+), 2 deletions(-)
+
+commit 201ffef8ecff7db02561bd0a12eeb6f73b8bc9e8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 5 09:34:45 2013 -0400
+
+ Update Release_Notes and Known_problems for CPAN release
+
+ Known_problems | 14 +++++++++-----
+ Release_Notes | 9 ++++++---
+ 2 files changed, 15 insertions(+), 8 deletions(-)
+
+commit 84d21012b371821c0df0d98192c9ec8065f7b30a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 5 09:07:24 2013 -0400
+
+ Clean up t/fits.t, t/iotypes.t and t/ufunc.t
+
+ Put failing PDL_IND vs PDL_L / PDL_LL tests in TODO blocks
+ for t/fits.t and t/iotypes.t. Made diagnostic output from
+ tapprox() in t/ufunc.t conditional on whether the threshhold
+ was exceeded or not.
+
+ t/fits.t | 6 +++++-
+ t/iotypes.t | 9 ++++++---
+ t/ufunc.t | 5 +++--
+ 3 files changed, 14 insertions(+), 6 deletions(-)
+
+commit 30b2b9ca9c4e41763f5f3548616bde61b52f729e
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Wed Sep 4 14:34:25 2013 -0600
+
+ add tests for nnslice boundary case that wasn't caught earlier
+
+ t/slice.t | 7 ++++++-
+ 1 files changed, 6 insertions(+), 1 deletions(-)
+
+commit 0e618d72dd31ff3b27be1e895edf5cbd45283211
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Wed Sep 4 14:23:37 2013 -0600
+
+ update graticule() in Cartography to support NaN-delimited output
+
+ Lib/Transform/Cartography/Cartography.pm | 93 +++++++++++++++++++-----------
+ 1 files changed, 59 insertions(+), 34 deletions(-)
+
+commit 8117c727353cf5c0385ccb9e1b6598c43183e596
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Wed Sep 4 14:19:29 2013 -0600
+
+ Fix edge-case bug in nnslice: $a->nnslice([-1,0,0]) [equiv to $a->((-1))]
+ offset was not being regularized, but is now.
+
+ Basic/Slices/slices.pd | 7 +++++--
+ 1 files changed, 5 insertions(+), 2 deletions(-)
+
+commit 23fad884deebd20893826deba6aec36a6185dc59
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Tue Sep 3 14:27:02 2013 -0600
+
+ add documentation for dicing to nnslice
+
+ Basic/Slices/slices.pd | 7 ++++++-
+ 1 files changed, 6 insertions(+), 1 deletions(-)
+
+commit 5fa25a501c6761f7e01960dc35bf6beefada24a6
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Tue Sep 3 14:21:24 2013 -0600
+
+ add dicing to nnslice (uses current dice_axis mechanism, which is cheesy
+ but proven -- should really be put into the C code...)
+
+ Basic/Slices/slices.pd | 29 ++++++++++++++++++++++++++++-
+ 1 files changed, 28 insertions(+), 1 deletions(-)
+
+commit 6b9654c8575b8cf74e003bcadf7da8684224e347
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Tue Sep 3 13:50:31 2013 -0600
+
+ add nnslice declaration to PDL::Lvalue
+
+ Basic/Lvalue.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 51b80cb9347dad49f00caa12c6e9e1051290de84
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Tue Sep 3 11:32:24 2013 -0600
+
+ update rangeb docs to reflect new dimincs ordering (should break cache less)
+
+ Basic/Slices/slices.pd | 4 ----
+ 1 files changed, 0 insertions(+), 4 deletions(-)
+
+commit 4a566b471bd2a39714f7698872b2dc1ffa5009fb
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Tue Sep 3 11:29:06 2013 -0600
+
+ Potential fix to rangeb bug on 64/32 hybrid systems (convert everything
+ to PDL_IND instead of PDL_LL).
+
+ Basic/Slices/slices.pd | 39 +++++++++++++++++++++------------------
+ 1 files changed, 21 insertions(+), 18 deletions(-)
+
+commit 28805ee28693a2a989812263f9bdd76567d0fcd4
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Fri Aug 30 11:56:43 2013 -0600
+
+ copied all 'slice' tests to also test 'nnslice' as a drop-in replacement.
+ ('nnslice' passes all tests)
+
+ Basic/Slices/slices.pd | 8 +-
+ t/slice.t | 283 +++++++++++++++++++++++++++++++++++++++++++++++-
+ 2 files changed, 287 insertions(+), 4 deletions(-)
+
+commit 32037af2b225e65fd9b63ea230125a2a1ee3d9f9
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Fri Aug 30 01:15:10 2013 -0600
+
+ add slice-like parsing and test suite for nnslice
+
+ Basic/Slices/slices.pd | 217 ++++++++++++++++++++++++++++++++++++++++++------
+ t/slice.t | 71 ++++++++++++++--
+ 2 files changed, 256 insertions(+), 32 deletions(-)
+
+commit d4e67b1e9f4d156d9ebe6d2f40c0d2d65c45c109
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Thu Aug 29 16:43:39 2013 -0600
+
+ remove debugging prints
+
+ Basic/Slices/slices.pd | 13 +------------
+ 1 files changed, 1 insertions(+), 12 deletions(-)
+
+commit 14f3c97c7a892fc96a579397a1656a8e9e30c1f9
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Thu Aug 29 11:16:08 2013 -0600
+
+ add nnslice and nnsliceb for development
+
+ Basic/Slices/slices.pd | 433 ++++++++++++++++++++++++++++++++++++++++++-----
+ 1 files changed, 387 insertions(+), 46 deletions(-)
+
+commit 95ef33692b20d65efc675f9d78f323194fdeb122
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Aug 29 13:06:42 2013 -0400
+
+ Add note about problems with 64bit index support for 32bit perls
+
+ Release_Notes | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit aa3e6795dddd3aa6bc9fa9b097e2c8a4ecbe4fe7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Aug 28 11:13:25 2013 -0400
+
+ Update VERSION to 2.006_06 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 39 +++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 41 insertions(+), 2 deletions(-)
+
+commit 8c814b0416023a87dcb963b593bba7b471fbdf9a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Aug 28 11:07:47 2013 -0400
+
+ Update Known_problems and Release_Notes for 2.00605 release
+
+ Known_problems | 1 +
+ Release_Notes | 2 ++
+ 2 files changed, 3 insertions(+), 0 deletions(-)
+
+commit ce989507756166a7fcc98603ddc7d072e9b32bd1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 27 18:14:36 2013 -0400
+
+ Remove FFTW files from MANIFEST and add t/slice-exceptions.t
+
+ MANIFEST | 5 +----
+ 1 files changed, 1 insertions(+), 4 deletions(-)
+
+commit 9517bd226779286c5580739ea433dda856496339
+Author: William Parker <wparker30 at yahoo.com>
+Date: Tue Aug 27 09:51:54 2013 -0400
+
+ updated test script for Ufunc.pm
+
+ I added in some test cases for the percentile and median calculations.
+ My changes are at the end-all that was modified in the rest was the
+ number of tests planned to reflect those changes.
+
+ t/ufunc.t | 31 +++++++++++++++++++++++++++++--
+ 1 files changed, 29 insertions(+), 2 deletions(-)
+
+commit ffebecab5fbe6e1af966002c3037f513ce00cc68
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Aug 23 14:22:57 2013 -0400
+
+ Tweaked GSL::MROOT and Minuit to mark pdl wrappers as DONTTOUCHDATA
+
+ Lib/GSL/MROOT/FUNC.c | 2 +-
+ Lib/Minuit/FCN.c | 4 ++--
+ 2 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 27bfadcde7f00ccfe566da3097702cab8be80f35
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Aug 23 14:11:05 2013 -0400
+
+ Noted slice stuff in release notes
+
+ Release_Notes | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 00b8d148ce6cbda6d0827562db3fa5ad518d513e
+Merge: 33e4875 cdf8733
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Aug 23 14:06:10 2013 -0400
+
+ Merge Derek's recent docs tweaks with David's slices work
+
+commit 33e4875bc8a3b290dd45a18f104af20b7416597b
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Aug 23 13:53:08 2013 -0400
+
+ Fix inconsistent internal state due to exceptions from out-of-bounds slices.
+
+ Out-of-bounds slices are not caught at creation time, but later during the
+ evaluation of RedoDims. During the RedoDims code, exceptions were thrown
+ after the slice piddle's internal state was partially setup, and usually
+ after it was setup enough to masquerade as a functional piddle. This led
+ to erroneous dimension size reporting, and potentially to segmentation
+ faults. The best solution is probably to magically swap out the slice
+ piddle with a "barf" slice, which would just always barf with the given
+ error message when any of its methods were invoked. As a stop gap, I
+ here reset one of the internal flags so that the RedoDims code is invoked
+ on any other operations on the piddle, ensuring that any data access or
+ dimension calculations retrip the barf.
+
+ Basic/Slices/slices.pd | 12 ++++++++++++
+ t/slice-exceptions.t | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 60 insertions(+), 0 deletions(-)
+
+commit cdf87334b3c6d584d2c8113636abd0e72b0bbe22
+Merge: 02c2a4d 609bed4
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Aug 23 10:38:55 2013 -0600
+
+ Merge branch 'master' of ssh://git.code.sf.net/p/pdl/code
+
+commit 609bed4fee561c2963ea878b26be2df4c10a45c4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 16 13:20:33 2013 -0400
+
+ Remove FFTW subdir reference from Lib/Makefile.PL
+
+ Lib/Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 5287a048343041a80705066e1baee26556866840
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 16 13:19:03 2013 -0400
+
+ Purge PDL::FFTW files and refs from the git repository
+
+ DEPENDENCIES | 11 -
+ Lib/FFTW/Makefile.PL | 199 ---------
+ Lib/FFTW/Readme | 14 -
+ Lib/FFTW/fftw.pd | 1099 --------------------------------------------------
+ t/fftw.t | 137 -------
+ 5 files changed, 0 insertions(+), 1460 deletions(-)
+
+commit bc7f3327de6f990c0b6798cf19ef6083780a1dbe
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 16 13:18:41 2013 -0400
+
+ Update VERSION to 2.006_05 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 9 +--------
+ Release_Notes | 46 ++++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 48 insertions(+), 9 deletions(-)
+
+commit 0c583f9720334f00aceaaf64c1b92dc1a0ef337f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 16 13:03:02 2013 -0400
+
+ Fix sf.net bug #338 PDL::FFT uses backwards sign convention from FFTW
+
+ Also clarified some of the docs, added some signatures for the
+ routines, and a WARNING at the top regarding the change in sign
+ convention between forward and reverse FFTs.
+
+ NOTE: The inverse FFT is normalized so that FFT followed by IFFT
+ are true inverses. This is different from the unnormalized transform
+ calculated by FFTW.
+
+ Lib/FFT/fft.pd | 30 +++++++++++++++++++++++-------
+ 1 files changed, 23 insertions(+), 7 deletions(-)
+
+commit 378da964582a1975cdaa36f84b248b27237a9bb8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 10 09:41:17 2013 -0400
+
+ Update Known_problems and Release_Notes for 2.006_04 relase
+
+ Known_problems | 12 ++++++------
+ Release_Notes | 6 ++++++
+ 2 files changed, 12 insertions(+), 6 deletions(-)
+
+commit 02c2a4db08093ce1fc854a41c362b745e9fc6571
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Aug 8 11:30:20 2013 -0600
+
+ Small spelling, grammar, punctuation changes in Basic.pm and BadValues.pod
+
+ Basic/Core/Basic.pm | 8 ++++----
+ Basic/Pod/BadValues.pod | 6 +++---
+ 2 files changed, 7 insertions(+), 7 deletions(-)
+
+commit 35d719c6deeeeba8574b5c0939fc7a4c34b55842
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 6 17:52:37 2013 -0400
+
+ Partial fix for tempfile problems in t/flexraw_fortran.t
+
+ This is some bullet-proofing that shouldn't be needed but
+ some OSes apparently have trouble cleaning things up in
+ a timely fashion. Work around is to use separate tempfiles
+ to reduce impact of the hangs.
+
+ t/flexraw_fortran.t | 13 +++++++------
+ 1 files changed, 7 insertions(+), 6 deletions(-)
+
+commit 8ccb4d2bced306eb73fee05b3cd39974a5834234
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 6 17:25:12 2013 -0400
+
+ Fix verbose output from mn_init()
+
+ Now it goes to STDERR by default and is prepended by a #
+ which means it won't affect the standard test harness for perl.
+
+ Lib/Minuit/minuit.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2c0dda61eb18507436cc5c0f819ca536461b215d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 6 17:15:08 2013 -0400
+
+ Change PDL_Long usage to PDL_Index to handle 64bit index support
+
+ Lib/Minuit/FCN.c | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit f63f3450d99610b696b8bdae584db11af6c91b83
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 6 17:14:36 2013 -0400
+
+ Add File::Temp for tempfile generation
+
+ t/minuit.t | 4 ++-
+ t/misc.t | 86 ++++++++++++++++++++++++++++-------------------------------
+ 2 files changed, 44 insertions(+), 46 deletions(-)
+
+commit 530cebf7e43503758ce61d815ffee727a25ef7b8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 6 14:35:09 2013 -0400
+
+ Deprecate PDL::FFTW and prepare for removal
+
+ Lib/FFTW/Readme | 6 ++++++
+ Makefile.PL | 1 +
+ perldl.conf | 13 ++++---------
+ 3 files changed, 11 insertions(+), 9 deletions(-)
+
+commit 4e4618a974cf449f58b842672583178c753fff99
+Merge: 6a9ff91 6549191
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 2 13:57:43 2013 -0400
+
+ Merge branch 'master' of ssh://git.code.sf.net/p/pdl/code
+
+commit 6a9ff91087432ba7d73ae3ae6095a3274ef4ca4b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 2 13:56:43 2013 -0400
+
+ Fix PDL_Long usages to PDL_Index
+
+ Still have to deal with all the int usages as well.
+
+ Basic/Primitive/primitive.pd | 12 +++++-----
+ Lib/ImageND/imagend.pd | 47 +++++++++++++++++++++--------------------
+ 2 files changed, 30 insertions(+), 29 deletions(-)
+
+commit 65491919c2e8e35e9f5d108183e3de3d94332803
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 29 17:49:57 2013 -0400
+
+ Update CPAN metadata for git repo on sf.net
+
+ This should make the link from the http://search.cpan.org PDL
+ release page point to the correct location. Thanks to Christian
+ Walde for reporting the problem.
+
+ Makefile.PL | 6 +++++-
+ 1 files changed, 5 insertions(+), 1 deletions(-)
+
+commit 147b9a44f9f295a174d6bc585f050f9ecdd63555
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 28 10:53:02 2013 -0400
+
+ Fix long usage in PP code to PDL_Index type
+
+ This usage was found in the following routines
+ in primitive.pd: interpolate, matmult, vsearch
+
+ Basic/Primitive/primitive.pd | 18 +++++++++---------
+ 1 files changed, 9 insertions(+), 9 deletions(-)
+
+commit 1b8b2bf222b1ecb3f465d5cfe1672350cb723786
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Jul 25 22:08:43 2013 -0600
+
+ Remove the TODOs from gd_oo_tests.t
+
+ It seems that this test failure has been resolved. Commenting out
+ all the TODO lines for BSD, dragonfly, etc and we'll see if anything
+ breaks on next developer release.
+
+ t/gd_oo_tests.t | 32 ++++++++++++++++----------------
+ 1 files changed, 16 insertions(+), 16 deletions(-)
+
+commit be6021d46553e8f20941532086991227eb7ada83
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Jul 25 22:04:59 2013 -0600
+
+ Fix modulo operator to work on PDL_Index piddles.
+
+ Since we handle signed and unsigned datatypes separately, and since
+ there was no N type in the typeloop, modulo was just picking up
+ garbage values. Do we need to also add longlong ('Q') types or longdouble?
+
+ Also added a simple test to ops.t for PDL_Index types.
+
+ Basic/Ops/ops.pd | 2 +-
+ t/ops.t | 8 ++++++--
+ 2 files changed, 7 insertions(+), 3 deletions(-)
+
+commit 9b3dc036bd3a1411438815c96928046f297682e4
+Merge: c7edeb2 28092fb
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Sat Jul 13 22:31:10 2013 -0600
+
+ Merge branch 'master' of ssh://git.code.sf.net/p/pdl/code
+
+commit 28092fbc0863a505d324a82c0d7e1d76bd082a40
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 9 09:34:47 2013 -0400
+
+ Update/Clean-up some readme-type files
+
+ Known_problems | 13 +--------
+ Perldl2/README | 20 ++++++++-----
+ Perldl2/TODO | 26 +++++++++---------
+ Release_Notes | 10 ++++++-
+ TODO | 80 ++++++++++++++++++++++++-------------------------------
+ 5 files changed, 70 insertions(+), 79 deletions(-)
+
+commit 4d7725723eb5cffc04a08f535acad492d732b0ba
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun Jul 7 11:56:02 2013 +0200
+
+ update debian/perldl.conf from perldl.conf
+
+ debian/perldl.conf | 12 +++++++-----
+ 1 files changed, 7 insertions(+), 5 deletions(-)
+
+commit c7edeb27fcf27b6b00bb4fe1c918e39079d61914
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Sat Jul 6 22:06:56 2013 -0600
+
+ Update some links in FAQ.pod.
+
+ Some changes from the SF.net project platform change.
+
+ Basic/Pod/FAQ.pod | 15 +++++++--------
+ 1 files changed, 7 insertions(+), 8 deletions(-)
+
+commit e4de37f8ff4a5aa7b03d5d91db2fe1d4e4884357
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 6 15:41:36 2013 -0400
+
+ Fix sf.net bug #331 "uniq does not always return proper object"
+
+ The problem was that for some combinations of input, the output
+ was generated by calling pdl() directly which uses class PDL by
+ default. I changed the call from pdl([$stuff]) to
+ PDL::pdl(ref($stuff),[$stuff]) and now the appropriate class
+ is obtained. We probably should scrub the PDL sources for any
+ other raw uses of the pdl() constructor that should be made
+ object type safe.
+
+ Basic/Primitive/primitive.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f4fb0672f92fe42c6ad49e5c14952564fa2129c4
+Author: Craig DeForest <zowie at z5.boulder.swri.edu>
+Date: Fri Jul 5 22:54:22 2013 -0600
+
+ Fix fencepost error in coeffs array (apologies if dup - problems with git configuration)
+
+ Lib/Slatec/slatec.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3e7d2227ff085774327c527089135c0190fb3853
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Tue Jul 2 13:29:57 2013 -0600
+
+ more updates to slatec.pd - handle nonbad cases the same as bad ones.
+
+ Lib/Slatec/slatec.pd | 134 +++++++++++++++++++++++++++++++++-----------------
+ 1 files changed, 88 insertions(+), 46 deletions(-)
+
+commit fdb24f6149fa0105d6eef4bf61573a0095283862
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Wed Jun 26 17:11:04 2013 -0400
+
+ Fix fencepost error for edge case with polyfit() in slatec.pd
+
+ Lib/Slatec/slatec.pd | 29 +++++++++++++++++++++--------
+ 1 files changed, 21 insertions(+), 8 deletions(-)
+
+commit fe0a4857460ef2fcaf03756ec846af80e780fd93
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Mon Jun 24 01:10:56 2013 -0600
+
+ Fix BAD bug in polyfit -- BAD values in Y should not make the correspondin
+ values in R (the fitted output) go BAD.
+
+ Lib/Slatec/slatec.pd | 37 ++++++++++++++++++++++++++++++++++++-
+ 1 files changed, 36 insertions(+), 1 deletions(-)
+
+commit 63263141bac37c85d548281084c7bacc56d1a800
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jun 12 16:03:09 2013 -0400
+
+ Refactor subclass*.t to use Test::More
+
+ t/subclass.t | 26 +++++++++-----------------
+ t/subclass2.t | 42 +++++++++++++++++-------------------------
+ t/subclass3.t | 37 ++++++++++++-------------------------
+ t/subclass4.t | 20 ++++----------------
+ 4 files changed, 42 insertions(+), 83 deletions(-)
+
+commit 5a142c42fb6b44137798e866a582c13fa7337e3f
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Jun 4 14:06:50 2013 -0600
+
+ Update some old links in the documentation.
+
+ Some of these links went bad with the website rewrite a few years ago,
+ some went bad (or can now be improved/shortened) with the sf.net
+ project system upgrade from earlier this year.
+
+ BUGS | 14 +++++++-------
+ DEVELOPMENT | 4 ++--
+ Known_problems | 2 +-
+ Makefile.PL | 4 ++--
+ README | 4 ++--
+ Release_Notes | 2 +-
+ 6 files changed, 15 insertions(+), 15 deletions(-)
+
+commit ba6b3abc0a07281314358a3e2b40d09916f3788d
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Mon Jun 3 22:29:27 2013 -0600
+
+ small grammar correction in bad.pd docs
+
+ Basic/Bad/bad.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit c3eaca6210eec0cb4155fc27664134643d2f2a87
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue May 28 20:44:15 2013 +1000
+
+ t/callext.t - include the pdlsimple.h that's in blib.
+
+ Previously Basic/Core/pdlsimple.h was being included.
+ It should be the same as blib/lib/PDL/Core/pdlsimple.h,
+ but it's the *latter* that we really should be testing.
+ I think this is a portable solution. If I'm wrong about
+ that, I'm sure we'll soon find out. (We would then
+ probably have to revert to including the former.)
+
+ t/callext.t | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit a9402af6e8f89708728397f1fbd3119aadcd8597
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue May 28 20:44:15 2013 +1000
+
+ Lib/CallExt/CallExt.pm - In callext_cc(), place $ccflags before installesitelib/PDL/Core
+
+ Otherwise the pdlsimple.h that gets included during the t/callext.t 'make test' stage
+ is one that has been previously intalled - not the one that's about to be installed.
+
+ Lib/CallExt/CallExt.pm | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit 514520e2d3d09ec21eb3d4d88d99d9d3348f9ec8
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Fri May 3 02:32:36 2013 -0700
+
+ added unit test for the pp_deprecate_module() warning
+
+ Basic/Test/tests.pd | 3 +++
+ Makefile.PL | 1 +
+ debian/control | 3 ++-
+ t/pptest.t | 12 ++++++++++--
+ 4 files changed, 16 insertions(+), 3 deletions(-)
+
+commit c1b8b40b55a033b733e18f8387f06d34e2408e75
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Fri May 3 01:37:03 2013 -0700
+
+ added pp_deprecate_module() to PDL::PP
+
+ Basic/Gen/PP.pm | 52 +++++++++++++++++++++++++++++++++++++++++++++++++++-
+ Basic/Pod/PP.pod | 11 +++++++++++
+ 2 files changed, 62 insertions(+), 1 deletions(-)
+
+commit 5bd7ce43ec7ddff8ca5092ddb9a5951833150f4c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 26 10:39:58 2013 -0400
+
+ Prepare to deprecate unix only direct mmap code support
+
+ Adding a warning for now that will be seen if you for some
+ reason are not using the portable File::Map based implementation.
+ The current duplication is confusing and the direct mmap support
+ has not been actively maintained. This is a final nudge in case
+ anyone still uses the legacy/non-portable implementation.
+
+ IO/FastRaw/FastRaw.pm | 3 ++-
+ IO/FlexRaw/FlexRaw.pm | 3 ++-
+ t/fastraw.t | 2 --
+ t/flexraw.t | 2 --
+ 4 files changed, 4 insertions(+), 6 deletions(-)
+
+commit 0d0e8076e00728fef12f19b492519dfac99d4fb2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 26 10:27:42 2013 -0400
+
+ Update File::Map required version to 0.57
+
+ This fixes map_anonymous() support for >2**32 sizes and
+ is needed for true 64bit support.
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 9e26c515f32e0b77a12b03773ae29ca261e257ce
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 19 17:44:06 2013 -0400
+
+ Update VERSION to 2.006_04 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 51 +++++++++++++++++++++++++----------------------
+ MANIFEST.SKIP | 2 +
+ Release_Notes | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
+ 4 files changed, 89 insertions(+), 26 deletions(-)
+
+commit f61c938f9c14fb51bf6b735ce0b6188faf4fd972
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 18 15:21:18 2013 -0400
+
+ Clean out old CPAN developers release notes from Release_Notes
+
+ It is useful to have the notes for current development but
+ once an official release is made, it only makes it difficult
+ to figure out what happened when.
+
+ Release_Notes | 5131 +++++++--------------------------------------------------
+ 1 files changed, 557 insertions(+), 4574 deletions(-)
+
+commit b7985c85374287efee954d2993678215d67887be
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 18 14:58:13 2013 -0400
+
+ Update $pdl_core_version to 10
+
+ This marks the merge of the 64bit-index-support branch
+ into our git master development branch.
+
+ Basic/Core/pdlcore.h.PL | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 1669960c0fa394809abeac334af29f9f5fcbd6dc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 17 09:36:07 2013 -0400
+
+ More int to PDL_Index fixes for ufunc.pd
+
+ Basic/Ufunc/ufunc.pd | 16 ++++++++--------
+ 1 files changed, 8 insertions(+), 8 deletions(-)
+
+commit 9f5201dfca23e774a2eb69745b41af66e824569e
+Merge: bd68e02 baf30c6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 15 22:26:24 2013 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit baf30c665dfb79afb2201fdba5e0750809432baf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 15 22:25:45 2013 -0400
+
+ Update VERSION to 2.006_03 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 31 +++++++++++++++++++++++++++++++
+ 3 files changed, 33 insertions(+), 2 deletions(-)
+
+commit bd68e02f8599fe0112f842e964c7d44b61b0e855
+Merge: 085eb14 b1d627e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 15 22:21:44 2013 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit b1d627ef3edc94d8122737438d4cf4583c9a758f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 15 22:21:07 2013 -0400
+
+ Update Release_Notes for another CPAN devel release
+
+ Release_Notes | 11 ++++++++---
+ 1 files changed, 8 insertions(+), 3 deletions(-)
+
+commit 085eb1447ffae46a11abcb6e05270245476453b3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 15 22:17:10 2013 -0400
+
+ Add some test skips for non-working PDL_Index
+
+ t/gsl_mroot.t | 3 +-
+ t/iotypes.t | 5 ++-
+ t/pdl_from_string.t | 52 ++++++++++++++++++++++++++------------------------
+ 3 files changed, 32 insertions(+), 28 deletions(-)
+
+commit 07121370a3f0481eaea7b4fc51e612a37db2288a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 15 17:56:54 2013 -0400
+
+ Fix problems with missing convertfunc for PDL_Index
+
+ As in it is *not* lc($type=~s/PDL_/) when $type is 'PDL_Index'
+ I think it is coming along but the entire generation and use
+ of the Types.pm and the PDLCode.pm use of same is entirely too
+ hard to follow and needs to be cleaned up for PDL-3 to really
+ go anywhere.
+
+ Basic/Core/Types.pm.PL | 6 ++++--
+ Basic/Gen/PP/PDLCode.pm | 4 +++-
+ Basic/Slices/slices.pd | 10 +++++-----
+ Basic/Ufunc/ufunc.pd | 42 +++++++++++++++++++++---------------------
+ Lib/Slatec/slatec.pd | 2 +-
+ 5 files changed, 34 insertions(+), 30 deletions(-)
+
+commit 4e967900516281e15462bb0fcb780bf862e8d05e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 15 13:00:33 2013 -0400
+
+ Turn off pp_def debug output from Lib/Slatec/slatec.pd
+
+ Lib/Slatec/slatec.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 253542e6af17d9f3b9b6e535d4a57ea023c857c7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 15 12:48:02 2013 -0400
+
+ Add (int) cast to t/callext.c in case PDL_Index is 64bit
+
+ t/callext.c | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit b94c5e8481e59b374150b3b4dbb0510070a39784
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 15 10:34:31 2013 -0400
+
+ More fixes to support PDL_Index as a full type
+
+ Seems to work now but I'm thinking it may make sense
+ that PDL_Index is actually a typesynonym for either
+ PDL_Long or PDL_LongLong rather than having a type of
+ its own. Not sure how that will affect the code gen
+ machinery.
+
+ Basic/Slices/slices.pd | 10 +++++-----
+ Basic/Ufunc/ufunc.pd | 28 ++++++++++++++--------------
+ Lib/Image2D/image2d.pd | 2 +-
+ 3 files changed, 20 insertions(+), 20 deletions(-)
+
+commit a6a69f2140cdff9bb0fd2bc04589d274dc8bd5fd
+Merge: cba1bba 47de79d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 15 09:15:29 2013 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit cba1bba8f73bb96c571300dd00bc04473f64d450
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 15 08:09:49 2013 -0400
+
+ Add PDL_Index type to Types.pm.PL
+
+ And make other mods to support. Making perldl.conf WITH_*
+ to undef to more general testing takes place and to fix
+ the problem with missing ExtUtils::F77 and fortran.
+
+ Basic/Core/Types.pm.PL | 22 +++++++++++-----------
+ Basic/Core/pdl_hfiles.p | 2 +-
+ Lib/Image2D/image2d.pd | 2 +-
+ perldl.conf | 16 ++++++++--------
+ 4 files changed, 21 insertions(+), 21 deletions(-)
+
+commit 47de79da6c288f1cf144977dbc594cd60224ea44
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Mon May 13 14:37:25 2013 -0400
+
+ use _strtoi64 instead of strtoll for MSVC
+
+ Basic/Slices/slices.pd | 8 ++++++++
+ 1 files changed, 8 insertions(+), 0 deletions(-)
+
+commit 5307029ecdb5132db217b6d83ea54f1bda8586e4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 12 17:04:08 2013 -0400
+
+ Skip t/minuit.t unless WITH_MINUIT was true
+
+ t/minuit.t | 22 +++++++++++++---------
+ 1 files changed, 13 insertions(+), 9 deletions(-)
+
+commit b89dd783a6d020a6bc518556110a0a5e034b4159
+Merge: 367a224 1660c0c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 12 16:14:09 2013 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit 1660c0c804601d8f06cfe2a9424a86500fb39415
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 12 16:13:08 2013 -0400
+
+ Update VERSION to 2.006_02 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 44 ++++++++++++++++++++++++++++++++++++++++++--
+ 3 files changed, 44 insertions(+), 4 deletions(-)
+
+commit 367a224778fa335348b3b44870624929dc68edb7
+Merge: b42154e 721d11d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 12 16:04:06 2013 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit b42154ec7f0775ad9c70434a2f1a23982acd389a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 12 15:40:01 2013 -0400
+
+ Mention perldl.conf has options off
+
+ Release_Notes | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit 07a7823353b866b9145965c57f3e72712e9a9007
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 12 15:36:55 2013 -0400
+
+ Update Known_problems and Release_Notes for 2.006_01 release
+
+ This is a CPAN developers release to allow for general
+ testing and exercise of the new 64bit index support code.
+
+ Known_problems | 7 +++----
+ Release_Notes | 8 +++++++-
+ 2 files changed, 10 insertions(+), 5 deletions(-)
+
+commit ce266b85f199e0a65bae67383d5923942d2e9882
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 12 15:26:22 2013 -0400
+
+ Set type of PDL_Index from $Config{ivtype}
+
+ Basic/Core/Types.pm.PL | 27 ++++++++++++++++-----------
+ Basic/Core/pdl_hfiles.p | 8 +++++++-
+ 2 files changed, 23 insertions(+), 12 deletions(-)
+
+commit 721d11d8d51fa5b5e22382b88749896d4f358f7b
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri May 10 11:08:23 2013 -0600
+
+ Fix to make Inline::Pdlpp visible in the docs
+
+ Problem arose because POD for Inline::Pdlpp was in file PP-Inline.pod,
+ which made the doc generator/html linkifier not work too well. Now
+ Inline::Pdlpp shows up in PDL::Index, and links correctly in the HTML
+ documentation.
+
+ Doc/Doc.pm | 4 ++--
+ Doc/mkhtmldoc.pl | 22 ++++++++++++++++++++++
+ 2 files changed, 24 insertions(+), 2 deletions(-)
+
+commit d47eca06ce07d0dfda3e87b6ed0b00ca248573ea
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri May 10 11:06:38 2013 -0600
+
+ Some documentation fixes.
+
+ Basic/Core/Core.pm.PL | 6 +++++-
+ Basic/Ops/ops.pd | 6 +++---
+ Doc/Doc.pm | 6 +++---
+ 3 files changed, 11 insertions(+), 7 deletions(-)
+
+commit 65194303cb7256184bb7dfd2a84ea4c5ae80548d
+Merge: e31cb3a cde0c39
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 6 19:17:20 2013 -0400
+
+ Merge branch '64bit-index-support' of ssh://git.code.sf.net/p/pdl/code into 64bit-index-support
+
+commit cde0c3967c19758546a97745c93c91023cd92753
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 6 13:15:11 2013 -0400
+
+ Replace int by PDL_Index for threadloop code indexing
+
+ Looks like I missed these. There may be more...
+
+ Basic/Gen/PP/PDLCode.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 6003a27f1440853c21a7b31e19f1c6fb0b24bc0d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 6 13:14:49 2013 -0400
+
+ Clean up some warning in t/proj_transform.t
+
+ t/proj_transform.t | 9 ++++++---
+ 1 files changed, 6 insertions(+), 3 deletions(-)
+
+commit e31cb3a0d8d93d5d6b30dfc66a5239f0b4fae560
+Merge: 378252d 05a10e7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 5 20:17:53 2013 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit 378252de6f9d6053ff6df05b382b1d2120c1ed6b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 5 20:15:50 2013 -0400
+
+ Fix use of int for loop with $pdl->nvals
+
+ Should be PDL_Index type since nvals is now of PDL_Index type.
+
+ Basic/Gen/PP.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit a5d4239b7535423f496629a817bb2a4a2d3ae213
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 5 20:15:18 2013 -0400
+
+ Apply Dima fix for int/PDL_Index confusion
+
+ Basic/Slices/slices.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 05a10e766d0af1833a65b981dd3ad57cbe4f598a
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Fri May 3 02:09:27 2013 -0700
+
+ spelling fix
+
+ t/complex.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit cf14c9978aa8e9217b853af6de264df355e872a2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 28 10:25:09 2013 -0400
+
+ Set some options for SLATEC debugging w 64bit
+
+ Lib/Slatec/slatec.pd | 2 +-
+ perldl.conf | 2 +-
+ 2 files changed, 2 insertions(+), 2 deletions(-)
+
+commit af69f3a1534d39fa1b552fdc9533c637ac657063
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 28 10:22:25 2013 -0400
+
+ More PDL_Long to PDL_Index fixes
+
+ Still getting test failures and trying to track them
+ down. What I'm seeing with cygwin/win7 is tests pass
+ when run via 'perl -Mblib t/testname.t' while if run
+ using 'prove -b t/testname.t' then they fail. Probably
+ still some index/datatype that is still not consistent.
+
+ Basic/Gen/PP/Dims.pm | 2 +-
+ Basic/Gen/PP/PdlParObj.pm | 4 ++--
+ 2 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 38ebc589f0503693d2064252a6d7a30434a0973b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 28 10:21:52 2013 -0400
+
+ Clean up some test output for better debugging
+
+ t/limits_ulimits.t | 2 +-
+ t/slatec.t | 40 ++++++++++++++++++++--------------------
+ 2 files changed, 21 insertions(+), 21 deletions(-)
+
+commit 7876fc6405af6a05d943d284980229881720b8b9
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Fri Apr 12 00:01:09 2013 -0700
+
+ fixed incorrect URL in the known problems file
+
+ Known_problems | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit a71300329c88c2ecd2493d1b2a8c966ba25901c3
+Merge: 046745a 9c66b0a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 26 10:47:05 2013 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit 9c66b0a5f9cd90c102654d24c0882b738a8b311f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 26 10:45:52 2013 -0400
+
+ Fix PDL::shape to return vector for 1-D piddles
+
+ Basic/Core/Core.pm.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit e78ef4c02f13171e3108c79f1aae2dc24c2f5c0d
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Sat Apr 13 00:11:24 2013 -0600
+
+ Changed minimum version of PDL in PDL::NiceSlice Makefile.PL
+
+ No change in actual number, just in the representation to agree with the current usage.
+ This was triggering a warning during Makefile.PL
+
+ Basic/SourceFilter/Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 092cd754d5534107a2f83671156989be4cf707aa
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Sat Apr 13 00:10:48 2013 -0600
+
+ Re-add some tests to transform.t that got overwritten recently.
+
+ t/transform.t | 9 ++++++++-
+ 1 files changed, 8 insertions(+), 1 deletions(-)
+
+commit b05be75d2affd589680cd808d0db93e14acb79d0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Apr 11 10:05:24 2013 -0400
+
+ Add PDL::NiceSlice line offset to Known_problems
+
+ Known_problems | 7 +++++++
+ 1 files changed, 7 insertions(+), 0 deletions(-)
+
+commit 85ebb8e4a6909e9047207f5eb47ed3f988054fda
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Wed Apr 10 18:21:54 2013 -0700
+
+ fftw.pd: fixed typo
+
+ Lib/FFTW/fftw.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit c3e2206d40d71998c92c4ebd133b267d00fe6d22
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Wed Apr 10 04:26:45 2013 -0700
+
+ fftw: improved an error message
+
+ Lib/FFTW/fftw.pd | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 535bf65896d00d1bd549cff0c3bd4fdcb243fab8
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Wed Apr 10 04:23:48 2013 -0700
+
+ unduplicated a type check in fftw.pd
+
+ Lib/FFTW/fftw.pd | 45 +++++++++++++++++----------------------------
+ 1 files changed, 17 insertions(+), 28 deletions(-)
+
+commit 3622ff94ac63453547453e80e909bca4fb7e18c6
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Wed Apr 10 02:54:07 2013 -0700
+
+ fixed incorrect docs in PDL::Complex, and added modern example
+
+ Basic/Complex/complex.pd | 56 ++++++++++++++++++++++++++++++++++++++-------
+ 1 files changed, 47 insertions(+), 9 deletions(-)
+
+commit 4746843c81ff0e615749e795dc2ae3d006dbe0f2
+Author: Diab Jerius <djerius at cfa.harvard.edu>
+Date: Wed Apr 10 16:49:55 2013 -0400
+
+ fix rare "Bizarre copy of HASH in scalar assignment"
+
+ On rare occasions Perl would emit a fatal "Bizarre copy of HASH in
+ scalar assignment" error. This is "solved" by lexicalizing the hash
+ passed to WriteMakefile. Makefile.PL now passes strict & warnings.
+
+ Lib/Transform/Proj4/Makefile.PL | 35 ++++++++++++++++++++++-------------
+ 1 files changed, 22 insertions(+), 13 deletions(-)
+
+commit 3c1d64f6991e1cb7989811e0038efd64dd7aaacd
+Author: Diab Jerius <djerius at cfa.harvard.edu>
+Date: Wed Apr 10 16:48:39 2013 -0400
+
+ fix copy&paste error; gis_proj_lib_path => transform_proj4_lib_path
+
+ Lib/Transform/Proj4/Makefile.PL | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 9d8ee08cf29fc20b601d2bd2c3d1c5550f516b0b
+Author: Dima Kogan <dima at secretsauce.net>
+Date: Tue Apr 9 04:24:14 2013 -0700
+
+ PDL::IO::GD->new() is now less picky about it args, and no longer crashes
+
+ Previously PDL::IO::GD->new() accepted ONLY a hashref as an argument. Given
+ anything else, a segfault resulted. With this patch segfaults no longer happen.
+ Also, in addition to accepting a hashref, it is now possible to pass in inline
+ hashes or just a single-argument filename.
+
+ IO/GD/GD.pd | 45 ++++++++++++++++++++++++++++++++++++++++++---
+ t/gd_oo_tests.t | 29 +++++++++++++++++++++++++++--
+ 2 files changed, 69 insertions(+), 5 deletions(-)
+
+commit 046745a99caa8e2ba14d54833061ec2801030fc2
+Merge: 22af89b 12910e7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 5 10:36:57 2013 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit 12910e7f5491836936a00445876373f031d7f205
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Apr 4 22:10:34 2013 -0600
+
+ shut up warning about nonlinear FITS transformations
+
+ Lib/Transform/transform.pd | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 3de9f56dbbf9fc7a81aad6564b4c03dc085f0627
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Thu Apr 4 14:29:27 2013 -0600
+
+ oops - fix merge
+
+ t/transform.t | 11 -----------
+ 1 files changed, 0 insertions(+), 11 deletions(-)
+
+commit fd6f2d2c6832f2983dc029d8a2a74645c1fae92c
+Merge: 4af8e15 6961caa
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Thu Apr 4 14:27:46 2013 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+ Conflicts:
+ t/transform.t
+
+commit 4af8e15a2aec78f388bd96021395d51ab35e2192
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Thu Apr 4 14:25:32 2013 -0600
+
+ fix badvalue-on-truncate support for map and for interpND
+
+ Basic/Primitive/primitive.pd | 10 ++++++-
+ Lib/Transform/transform.pd | 55 ++++++++++++++++++++++++++---------------
+ t/transform.t | 31 +++++++++++++++++++++--
+ 3 files changed, 71 insertions(+), 25 deletions(-)
+
+commit 6961caafb349a78aa163dc7cf1c36f3cb75e00fd
+Merge: a0a9e52 2a14ed6
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Apr 4 11:45:42 2013 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit a0a9e52ff0cb05b597bcc4441f1b5fff2b7023dc
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Apr 4 11:44:56 2013 -0600
+
+ Add a couple no-op tests to t/transform.t
+
+ t/transform.t | 12 +++++++++++-
+ 1 files changed, 11 insertions(+), 1 deletions(-)
+
+commit 22af89bfe1f2189ba9c0f1dab7b62e7e4b57ceda
+Merge: 3c73915 6f97ce0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 28 09:28:56 2013 -0400
+
+ Merge branch '64bit-index-support' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl into 64bit-index-support
+
+commit 3c7391503fde007219165cb32517808e23cf42a9
+Merge: dbdbab8 2a14ed6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 28 09:28:45 2013 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit 2a14ed6276b63c0f9642cc38f5874067775535d7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 28 09:23:18 2013 -0400
+
+ Fix %hash randomization bugs in PDL tests
+
+ It appears that t/hdr.t and t/niceslice.t tests
+ had hash comparison checks assuming (%h1) and (%h2)
+ if the two hashes were equal. This should fix
+ perl 5.17.x failures for PDL-2.006
+
+ t/hdrs.t | 6 +++++-
+ t/niceslice.t | 10 ++++++++--
+ 2 files changed, 13 insertions(+), 3 deletions(-)
+
+commit 30257deb515e1d273414f68ceea2b3e58a05d1e0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 24 12:44:36 2013 -0400
+
+ Fix rcols with colsep and $PDL::undefval
+
+ Missing fields in the middle were being returned
+ as the empty string '' rather than undef which happened
+ if they were at the end. Now mapping them uniformly
+ to undef. This is sf.net bug #3608928
+
+ IO/Misc/misc.pd | 3 +++
+ t/misc.t | 22 +++++++++++++++++++++-
+ 2 files changed, 24 insertions(+), 1 deletions(-)
+
+commit 6f97ce085fc686830f6fd333f6389d56cc1c7ebc
+Merge: a2b8cfc 63d7bc9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 23 19:40:37 2013 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit 63d7bc9ee3307e44c79ce69a3fe4cb03f24cf954
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 23 19:39:22 2013 -0400
+
+ Update VERSION to 2.006_01 for new development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 0fd0d37b2bd8b83cbdbbe2119a3c5bedf2cc2e30
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 23 10:02:31 2013 -0400
+
+ Remove read only Index.pod so scantree.pl works
+
+ Doc/scantree.pl | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 36aa7f2fce87c07899e07413132241d5357851ae
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 23 09:27:57 2013 -0400
+
+ Make sure placeholder Index.pod does not get installed
+
+ Since it was being installed first, the scantree.pl script
+ failed because it couldn't open the destination location.
+
+ Basic/Pod/Makefile.PL | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit bd0abf38431284dfdb4475fe34f8775a19c76c3d
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Fri Mar 22 22:44:29 2013 -0600
+
+ Add a more informative message to Gnuplot demo if PDL:Graphics::Gnuplot is missing.
+
+ Demos/Gnuplot_demo.pm | 20 ++++++++++++++++++--
+ 1 files changed, 18 insertions(+), 2 deletions(-)
+
+commit b6fd1d5a78a9bd5f1c3e43659d2653a94cb8db3c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 22 19:40:22 2013 -0400
+
+ Remove unix-only double check for gnuplot
+
+ The Gnuplot_demo.pm was failing due to a unix-only
+ test for the gnuplot executable. Removed that code
+ and added a bit more downsampling for the last set
+ of 3d images for speed.
+
+ Demos/Gnuplot_demo.pm | 21 +++++----------------
+ 1 files changed, 5 insertions(+), 16 deletions(-)
+
+commit 7078eeacf44cfcf4efe2e09a820dcf95308ad8e2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 22 18:30:35 2013 -0400
+
+ Update permissions on new Index.pod
+
+ 0 files changed, 0 insertions(+), 0 deletions(-)
+
+commit dcbd3f580adc4de86934e86659dc43da263cc961
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 22 18:28:04 2013 -0400
+
+ Add a default Index.pod for online browsing
+
+ Basic/Pod/Index.pod | 615 +++++++++++++++++++++++++++++++++++++++++++++++++++
+ MANIFEST | 1 +
+ 2 files changed, 616 insertions(+), 0 deletions(-)
+
+commit f5db95b64fa6ea6a916679641a6069e04980e294
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 22 18:23:17 2013 -0400
+
+ Finished Release_Notes for PDL-2.006
+
+ Release_Notes | 155 +++++++++++++++++++++++++++++++++++++++++++++++++--------
+ 1 files changed, 133 insertions(+), 22 deletions(-)
+
+commit 3daaafa42a688c3e1dade51a29414710b6fe9aff
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 22 15:46:51 2013 -0400
+
+ Minor tweaks to some INSTALL/READMEs
+
+ cygwin/INSTALL | 2 +-
+ cygwin/README | 17 +++++++++++++++++
+ win32/INSTALL | 2 +-
+ 3 files changed, 19 insertions(+), 2 deletions(-)
+
+commit 7ac83fa02429ad3c7086e14316b0fcfb28f5fbdd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 22 15:46:30 2013 -0400
+
+ Make gnuplot and prima demos in list match perldl ones
+
+ Perldl2/Profile/Perldl2.pm | 7 +++----
+ 1 files changed, 3 insertions(+), 4 deletions(-)
+
+commit ec7ed388e8a11c15090bc2a0c6086e9bf185ba26
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 22 15:36:06 2013 -0400
+
+ Update VERSION to 2.006 for release in readme's
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 11 +----------
+ Release_Notes | 44 ++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 46 insertions(+), 11 deletions(-)
+
+commit 870f5406de6381a5d821edd52e4e12c947d355fc
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Mar 21 22:51:55 2013 -0700
+
+ Fix bug 3608123 -- Diab's topdl bug
+
+ Basic/Core/Core.pm.PL | 1 +
+ Lib/Transform/Cartography/Cartography.pm | 10 +++++-----
+ t/core.t | 6 +++++-
+ 3 files changed, 11 insertions(+), 6 deletions(-)
+
+commit dbdbab88188cce7e9f72db86e4d035e0f574f2a4
+Merge: a2b8cfc d564d3b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 19 08:52:44 2013 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit d564d3b43998ea91e8728943a70647271312db79
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Mar 18 09:50:22 2013 -0500
+
+ Prima demo font size tweaks
+
+ Demos/Prima.pm | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 902c589fefead688effc391c7ff334842086fd3f
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Mar 18 08:40:02 2013 -0500
+
+ Prima demo tweaks
+
+ Demos/Prima.pm | 63 +++++++++++++++++++++++++++++++++++++++++++++++++------
+ 1 files changed, 56 insertions(+), 7 deletions(-)
+
+commit a316441ebe1937d0b7e566e3d41c3b3521ae53c5
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sun Mar 17 12:58:13 2013 -0500
+
+ Minor updates and corrections to Prima demo
+
+ Demos/Prima.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit a23c7a65c968aad948cb75270f868958b1c71e21
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sun Mar 17 12:46:09 2013 -0500
+
+ A few random notes added to PP.pod
+
+ Basic/Gen/PP.pm | 10 +++++++++-
+ 1 files changed, 9 insertions(+), 1 deletions(-)
+
+commit 5be7d5be961c588a9321b9ce78b293a8d69843f5
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sun Mar 17 12:43:52 2013 -0500
+
+ Merged forked work on Prima demo
+
+ Demos/Prima.pm | 22 ++++++++--------------
+ 1 files changed, 8 insertions(+), 14 deletions(-)
+
+commit 5ecfc9c0f443559587d7a9ee30b9419e3c3d7902
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 15 10:15:33 2013 -0400
+
+ Update Known_problems, Release_Notes, and MANIFEST
+
+ Known_problems | 9 +++++++++
+ MANIFEST | 1 +
+ Release_Notes | 8 ++++++++
+ 3 files changed, 18 insertions(+), 0 deletions(-)
+
+commit 066fa91be01b9400e21ed1e835596ce392031816
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Mar 14 23:41:40 2013 -0600
+
+ update gnuplot demo to not specify a particular font
+
+ Demos/Gnuplot_demo.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 7f4057fcbc161083881ee67613dd61cea71fce3d
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Wed Mar 13 17:14:47 2013 -0600
+
+ Fix inplace-with-duplicate-argument bug in PP; trim some dust bunnies in Ops.
+
+ Basic/Gen/PP.pm | 2 +-
+ Basic/Ops/ops.pd | 2 --
+ 2 files changed, 1 insertions(+), 3 deletions(-)
+
+commit 6b193fc1c16fd3b06e2728110647bb1552c1904a
+Merge: 3260b26 202688b
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Wed Mar 13 16:47:47 2013 -0600
+
+ fix inplace related bug in transform (work around core bug)
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 3260b26de273f5b868cc022bea8299513677496f
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Wed Mar 13 16:43:43 2013 -0600
+
+ Transform explicitly clears inplace flag (works around core bug that causes crashes)
+
+ Lib/Transform/transform.pd | 12 +++++++++---
+ t/transform.t | 15 +++++++++++++--
+ 2 files changed, 22 insertions(+), 5 deletions(-)
+
+commit 202688b48d5ba4795da59877f236d838d9d9079e
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Mar 13 11:52:39 2013 -0500
+
+ Stricter Prima detection and more informative fail message for Prima demo
+
+ Demos/Prima.pm | 17 +++++++++++++----
+ 1 files changed, 13 insertions(+), 4 deletions(-)
+
+commit 13dc7e6ec1923ff77c3ec90390e454da1b924e71
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Mar 13 10:47:00 2013 -0500
+
+ Fixed window-not-really-closed issue with the Prima demo
+
+ Demos/Prima.pm | 5 ++++-
+ Perldl2/Profile/Perldl2.pm | 2 ++
+ Release_Notes | 2 +-
+ 3 files changed, 7 insertions(+), 2 deletions(-)
+
+commit 42a6027655b7fa3c807febf112f01ff2e044a639
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Mar 13 02:46:02 2013 -0500
+
+ Added demo for PDL::Graphics::Prima to perldl
+
+ Demos/Makefile.PL | 1 +
+ Demos/Prima.pm | 562 +++++++++++++++++++++++++++++++++++++++++++++++++++++
+ perldl.PL | 2 +
+ 3 files changed, 565 insertions(+), 0 deletions(-)
+
+commit 5883818f07eba34b5922d00bd8bdedd6dce60be4
+Merge: 726ccc0 5b1a4f4
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Mon Mar 11 22:53:19 2013 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+ got a couple of commits behind... (update pic converters so wpic/rpic
+ at least preserves image dimensions for ps images)
+
+commit 726ccc07335004b6578cdd333d23e959ae21de72
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Mon Mar 11 22:50:24 2013 -0600
+
+ Fix ps to/from conversion to at least preserve image dimensions (and use pnmtops instead of gs).
+
+ IO/Pnm/Pic.pm | 5 ++---
+ 1 files changed, 2 insertions(+), 3 deletions(-)
+
+commit 5b1a4f4b1291482170dc5369b6c9d2c715aeeb09
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 11 15:09:17 2013 -0400
+
+ Fix overwrite problem in imag2d/imag2d_update
+
+ Graphics/Graphics2D.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit ba9baed6c86937902ebca11cd7037aa45a4082d9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 10 21:48:30 2013 -0400
+
+ Update version to PDL-2.004_997 for final development
+
+ This is a.k.a. PDL-2.006 rc3
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 34 ++++++++++++++++++++++++++++++++++
+ 3 files changed, 36 insertions(+), 2 deletions(-)
+
+commit a17fb16f1203902e7ae789e8a35a9939154841b2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 10 21:44:32 2013 -0400
+
+ Update readme files and MANIFEST for CPAN
+
+ Known_problems | 6 +-----
+ MANIFEST | 1 +
+ Release_Notes | 17 ++++++++++++++++-
+ 3 files changed, 18 insertions(+), 6 deletions(-)
+
+commit f4204a6de77a61081561671efdd7396f76c96c9a
+Merge: d9e59d0 1709994
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Sat Mar 9 00:36:42 2013 -0700
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit d9e59d005600b5e871b01f660a6b95ed0d32afab
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Sat Mar 9 00:34:31 2013 -0700
+
+ Fix problem with cat not threading properly. Add appropriate tests.
+
+ Basic/Core/Core.pm.PL | 18 ++++++++++++++----
+ t/core.t | 8 +++++++-
+ 2 files changed, 21 insertions(+), 5 deletions(-)
+
+commit 17099949b61baa4f5af0093f74cf0b28dd22cc5c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 7 10:02:01 2013 -0500
+
+ Fix pod for Datatype_conversions so 'apropos types' finds it
+
+ This wouldn't be necessary if we had keywords in the PDL
+ docs database and tools.
+
+ Basic/Core/Core.pm.PL | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit c6004152021f74425508933ffbb30eab3485ab35
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Mar 6 17:52:59 2013 -0600
+
+ Fixed pdl-from-string doc error in QuickStart
+
+ Basic/Pod/QuickStart.pod | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 690b49167db04b659b34c7cc23d506b5c0edfc89
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 6 18:00:04 2013 -0500
+
+ Add $PDL::PREFIX_RE to perldl and pdl2
+
+ This automatically strips prefixes matching the PDL shell
+ prompts so that cutting and pasting from the example output
+ in the PDL Book will just work. In addition to adding that
+ to perldl (already was in pdl2), we now strip out the
+ leading prefix if found from the entries in the history
+ list.
+
+ Perldl2/Plugin/PDLCommands.pm | 11 ++++++++---
+ Perldl2/Profile/Perldl2.pm | 7 ++++---
+ perldl.PL | 12 ++++++++++--
+ 3 files changed, 22 insertions(+), 8 deletions(-)
+
+commit c18dcc1d43de663bab634632d8f26d659099ed5f
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Sun Mar 3 21:36:55 2013 -0700
+
+ Insert friendly warning in case gnuplot isn't present.
+
+ Demos/Gnuplot_demo.pm | 16 +++++++++++++++-
+ 1 files changed, 15 insertions(+), 1 deletions(-)
+
+commit 3794b04e18ee27eed8d2d088a3d5bfefe7935b86
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Sun Mar 3 21:30:04 2013 -0700
+
+ Add Gnuplot demo support - move Gnuplot_demo.pm from PDL::Graphics::Gnuplot to the demos tree; group gnuplot with the other packages.
+
+ Demos/Gnuplot_demo.pm | 313 +++++++++++++++++++++++++++++++++++++++++++++++++
+ Demos/Makefile.PL | 1 +
+ perldl.PL | 4 +-
+ 3 files changed, 316 insertions(+), 2 deletions(-)
+
+commit b513b04f145cbe20e214037c271ef211804ceb20
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 3 11:51:55 2013 -0500
+
+ Add Gnuplot_demo.pm support to perldl and pdl2
+
+ NOTE: the demo loading needs to be made more robust
+ against missing dependencies. PDL::Graphics::Gnuplot
+ needs to install the demo file into the correct install
+ location.
+
+ Perldl2/Profile/Perldl2.pm | 5 ++++-
+ perldl.PL | 5 ++++-
+ 2 files changed, 8 insertions(+), 2 deletions(-)
+
+commit 4de9846dac1df48a66f66f79a5fd31900e8d980e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 2 18:32:27 2013 -0500
+
+ Update version to 2.004_996 for final fixes and docs updates
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 34 ++++++++++++++++++++++++++++++++++
+ 3 files changed, 36 insertions(+), 2 deletions(-)
+
+commit a9d9dffe9f169d62d0070a56aa76082650e8f035
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 2 10:08:15 2013 -0500
+
+ Update readme type files for CPAN developers release
+
+ DEPENDENCIES | 16 +++++++---------
+ Known_problems | 24 +++++++++++-------------
+ Release_Notes | 9 ++++++++-
+ 3 files changed, 26 insertions(+), 23 deletions(-)
+
+commit 7bbab7d7a2a5d05207dd9abb02da11060079f38e
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Mar 1 13:00:24 2013 -0700
+
+ Potential fix for crashing gd_oo_tests (SF.net #3518190).
+
+ The IMG_PTR needed to be a longlong, but was a long. At that made all the difference.
+ I do not have BSD AMD64, but was getting a segfault after "ok 19" when the DESTROY
+ was called. I have not removed the TODO from the gd_oo_tests.t, we should do that
+ after it is certain that this does not break anything for anybody else.
+
+ IO/GD/GD.pd | 15 +++++++++------
+ t/gd_oo_tests.t | 2 +-
+ 2 files changed, 10 insertions(+), 7 deletions(-)
+
+commit e3d159110c14776aac179e687718fad0ba72f363
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Feb 28 23:24:59 2013 -0700
+
+ Add pdl executable to .gitignore
+
+ .gitignore | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 7f8c26570999383c49ebc4dfc309ca8e10ef49b1
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Feb 28 23:22:10 2013 -0700
+
+ Update Known_problems with RAST to PNM conversion error in Netpbm.
+
+ No workaround in the test suite, it seems to be a rare problem.
+
+ Known_problems | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit 726bacdafde2832b10931b5ce2ddfdd526213429
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Feb 28 23:16:41 2013 -0700
+
+ Small tweaks to PLplot Makefile.PL and test file
+
+ In the t/plplot.t, added some logic to skip the final test on darwin.
+ The SVG file PLplot generates is large but valid. Also zero-padded the
+ names of the output files (test2.svg --> test02.svg) so they would be
+ in numerical and lexical order in directory listings, for debugging purposes.
+ In the Makefile.PL, I added some logic to remove the 'temp' executable so
+ that the build directory would stay clean.
+
+ Graphics/PLplot/Makefile.PL | 7 +++++--
+ t/plplot.t | 41 ++++++++++++++++++++---------------------
+ 2 files changed, 25 insertions(+), 23 deletions(-)
+
+commit dd1d3f8a2e01d5266374313cb7ce4e3d8e3d4ab9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 27 10:16:17 2013 -0500
+
+ Update VERSION to 2.004_995 for release candidate 1
+
+ This is the start of code freeze for PDL-2.006.
+
+ Basic/PDL.pm | 3 +--
+ Known_problems | 2 +-
+ Release_Notes | 34 ++++++++++++++++++++++++++++++++++
+ 3 files changed, 36 insertions(+), 3 deletions(-)
+
+commit 51a344147a4b2934412369e6529c1feacf3518ab
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 27 09:53:39 2013 -0500
+
+ Update MANIFEST for PDL-2.004_012 release
+
+ MANIFEST | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit c9894671f48f3b9810f4b2cd60214424ac87a764
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 27 09:31:48 2013 -0500
+
+ Switch to legacy PDL::NiceSlice engine for PDL-2.006
+
+ Also update Release_Notes and Known_problems for the
+ PDL-2.004_012 CPAN developers release.
+
+ Basic/SourceFilter/NiceSlice.pm | 5 +++--
+ Known_problems | 16 +++++-----------
+ Release_Notes | 18 +++++-------------
+ 3 files changed, 13 insertions(+), 26 deletions(-)
+
+commit 4dc269ed971e989a0901a7a8210bf55e28bb5efe
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Tue Feb 26 20:56:15 2013 -0700
+
+ Remove NiceSlicing from FITS and Transform
+
+ IO/FITS/FITS.pm | 22 ++++----
+ Lib/Transform/transform.pd | 117 +++++++++++++++++++++----------------------
+ 2 files changed, 68 insertions(+), 71 deletions(-)
+
+commit ee0e9ef42d79017e618b48f9da16530b1c4bfead
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Tue Feb 26 14:30:41 2013 -0700
+
+ clean up pdl executable on "make clean"
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 379b3e63615bdfcd0e319af1fd7bdc0cbf008243
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Feb 25 13:12:40 2013 -0500
+
+ Update TODO file for consistency
+
+ TODO | 42 +++++++++++++++++++++++++++++++++---------
+ 1 files changed, 33 insertions(+), 9 deletions(-)
+
+commit 155eb1519ca1e71b0ade8cc86f7b311b05abddd2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Feb 24 20:54:16 2013 -0500
+
+ Add Module::Compile engine option to PDL::NiceSlice
+
+ Still looking for the best way to implement the improved
+ PDL::NiceSlice sourcefiltering. Unfortunately, all the
+ options so far all have a gotcha of some sore to them...
+
+ Basic/Core/Makefile.PL | 2 +-
+ Basic/SourceFilter/Makefile.PL | 1 +
+ Basic/SourceFilter/ModuleCompile.pm | 11 +++++++++++
+ Basic/SourceFilter/NiceSlice.pm | 1 +
+ Lib/GIS/Proj/Makefile.PL | 2 +-
+ Makefile.PL | 3 +++
+ 6 files changed, 18 insertions(+), 2 deletions(-)
+
+commit 2a0a46fd450c9a254636fd79b1d2016df1233659
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Feb 23 18:15:58 2013 -0500
+
+ Update PDL::NiceSlice to new standard for $VERSION
+
+ Basic/SourceFilter/NiceSlice.pm | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit a2b8cfc8d8a8e152b8b010d2eed52b40447d1639
+Merge: 0e25005 bf5ddd1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 22 20:51:30 2013 -0500
+
+ Merge branch 'master' into 64bit-index-support
+
+commit bf5ddd1701fb7c69e344cc6505b46bf4c1412ac8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 22 14:02:54 2013 -0500
+
+ Update PDL/IO/IDL/README with license change info
+
+ IO/IDL/README | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++++---
+ 1 files changed, 56 insertions(+), 4 deletions(-)
+
+commit f793b59310d9d8dbfb4987a8dfa3b111d0a5982e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 22 13:06:38 2013 -0500
+
+ Update VERSION to 2.004_012 for more development
+
+ Note the new standard version scheme.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 47 +++++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 49 insertions(+), 2 deletions(-)
+
+commit cf3703dda271e5ac5c47ad8abc460db64f99c4f2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 22 12:24:45 2013 -0500
+
+ Forgot our in Version.pm generated file
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 80ef00ed337f5f72f21b2cabad1328accab00969
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 22 12:22:34 2013 -0500
+
+ More VERSION related fixes.
+
+ Make $PDL::VERSION in Basic/PDL.pm be the new, preferred
+ string format. Put the '$VERSION = eval $VARSION' in
+ top level Makefile.PL when it generates Version.pm.
+
+ Basic/PDL.pm | 1 -
+ Makefile.PL | 1 +
+ Release_Notes | 8 ++++----
+ 3 files changed, 5 insertions(+), 5 deletions(-)
+
+commit 355aff6a9460f63d47ea309958dacedaad0e6f41
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 22 11:02:06 2013 -0500
+
+ Fix instructions for intall with new VERSION numbers
+
+ The filename of development releases don't have the
+ underscore in them.
+
+ Release_Notes | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit d90c6835ff884e4715ea3f4d1f0aa8593a05b3b1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 22 10:50:30 2013 -0500
+
+ Update $VERSION to 2.004011_011 for CPAN developers release
+
+ First attempt with new version string standard
+
+ Basic/PDL.pm | 4 +++-
+ Known_problems | 2 +-
+ Release_Notes | 16 ++++++++++------
+ 3 files changed, 14 insertions(+), 8 deletions(-)
+
+commit 394af852aadbf205ff73d918a850c1d0ccce16f3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 22 10:36:47 2013 -0500
+
+ Update PDL $VERSION to decimal strings
+
+ Per discussion on pdl-porters list, we're moving to standardize
+ version numbers to the single decimal point string representation
+ as discussed here:
+
+ http://www.dagolden.com/index.php/369/version-numbers-should-be-boring/
+
+ Basic/Constants.pm | 3 ++-
+ Basic/Gen/PP.pm | 4 +++-
+ Basic/Matrix.pm | 3 ++-
+ Basic/Options.pm | 3 ++-
+ Graphics/Limits/Limits.pm | 1 +
+ Graphics/TriD/POGL/OpenGL.pm | 1 +
+ IO/FastRaw/FastRaw.pm | 4 +++-
+ IO/HDF/HDF.pm | 3 ++-
+ IO/IDL/IDL.pm | 3 ++-
+ Lib/Transform/Cartography/Cartography.pm | 3 ++-
+ inc/Carp.pm | 1 +
+ inc/Devel/CheckLib.pm | 1 +
+ 12 files changed, 22 insertions(+), 8 deletions(-)
+
+commit 199a460ebe63d731084052e403e0c7ea1a75bced
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Thu Feb 21 18:03:59 2013 +1100
+
+ inc/Carp.pm Make compatible with perl-5.8.x
+
+ Replace "//" operator with "defined() ? :" ternary
+ construct.
+
+ inc/Carp.pm | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 54f824b98228b05a085f839da2b546049c5c166b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 20 15:06:02 2013 -0500
+
+ Avoid spurious output from missing gunzip/gzip
+
+ Now redirect to appropriate NULL device and use diag to
+ report the error.
+
+ t/flexraw_fortran.t | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit a2143fdccaaedbe13e66d42fe234455f87ab8f84
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 20 13:36:59 2013 -0500
+
+ Update Known_problems with sf.net bugs fixed
+
+ Known_problems | 13 +++++++++++--
+ 1 files changed, 11 insertions(+), 2 deletions(-)
+
+commit 5dd653c428d41d320a9a67760bebb0338bb58174
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 20 10:57:24 2013 -0500
+
+ Remove IDL from release notes
+
+ Release_Notes | 3 ---
+ 1 files changed, 0 insertions(+), 3 deletions(-)
+
+commit 8c28a14eea7447346f02622a57b339a731bd7c60
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 20 00:17:21 2013 -0500
+
+ Update VERSION to 2.4.11_011 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 6 +++++-
+ Release_Notes | 44 ++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 50 insertions(+), 2 deletions(-)
+
+commit d6cdb612decf8210e365f5cc6b65ec1a3ecd1ce1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 20 00:14:03 2013 -0500
+
+ Add fallback Carp.pm to work around perl bug
+
+ inc/Carp.pm | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 5e66221c5e64c714347a195e63346ae251f8a4f1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 19 23:46:46 2013 -0500
+
+ Add IDL and work around proj-4.8.0 build problem
+
+ IO/IDL/Makefile.PL | 14 +
+ IO/IDL/README | 4 +
+ Lib/GIS/Proj/Makefile.PL | 34 ++-
+ Lib/GIS/Proj/include/projects.h | 476 ++++++++++++++++++++++++++++++++
+ Lib/Transform/Proj4/Makefile.PL | 22 ++-
+ MANIFEST | 7 +-
+ Release_Notes | 9 +-
+ inc/Carp.pm | 578 +++++++++++++++++++++++++++++++++++++++
+ inc/Carp/Heavy.pm | 10 +
+ 9 files changed, 1142 insertions(+), 12 deletions(-)
+
+commit 826bbeca4bb4034f8f867ae14266a0899d25d140
+Merge: 6cbdb42 0626ce7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 19 09:52:08 2013 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 0626ce7927fce0ae29a78891ecdfd06966903dfa
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Mon Feb 18 21:47:16 2013 -0700
+
+ Added POD description of add_module
+
+ Doc/Doc.pm | 51 +++++++++++++++++++++++++++++++++++----------------
+ 1 files changed, 35 insertions(+), 16 deletions(-)
+
+commit 6cbdb42e3baee1eba9bff01e939436d17eeb8821
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Feb 18 11:02:27 2013 -0500
+
+ Add IDL.pm to build
+
+ IO/IDL/README | 13 -------------
+ IO/Makefile.PL | 2 +-
+ 2 files changed, 1 insertions(+), 14 deletions(-)
+
+commit f8b1f65eb5fc36d903e02c90a20a718fc3798ad8
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Fri Feb 15 14:46:15 2013 -0700
+
+ be less chatty in PDL::Doc::add_module
+
+ Doc/Doc.pm | 1 -
+ 1 files changed, 0 insertions(+), 1 deletions(-)
+
+commit c1532ad1790d7d0bab8fa1591eb0f42dc504f819
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Fri Feb 15 14:12:58 2013 -0700
+
+ add PDL::Doc::add_module for conveneience. Now you can "use PDL::Doc; PDL::Doc::add_module('My::Module').
+ (Thanks to Maggie X, whose install script I cribbed)
+
+ Doc/Doc.pm | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 55 insertions(+), 0 deletions(-)
+
+commit 14db014ce0802ac6cd7910ecd0f2c041fa03788f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Feb 11 16:20:06 2013 -0500
+
+ Fix doc error in PDL::NiceSlice
+
+ Basic/SourceFilter/NiceSlice.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 0e25005d10ff344976a3cd1fe3df1ededa5806b9
+Merge: 9ee953d c3a70d0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Feb 10 09:03:14 2013 -0500
+
+ Merge branch 'master' into 64bit-index-support
+
+commit c3a70d009af415e1fe54c48774484b2bc6251a69
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Feb 7 12:15:16 2013 -0500
+
+ Add PDL::IO::IDL support file
+
+ Still need to add the distribution stuff
+ around it: tests, makefile, etc.
+
+ IO/IDL/IDL.pm | 869 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 869 insertions(+), 0 deletions(-)
+
+commit 704053ee2e7f4cd5d5ee71da349ad48b22cf80ab
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 6 18:28:50 2013 -0500
+
+ Add missing test plan to t/gd_oo.tests.t for BSD systems
+
+ t/gd_oo_tests.t | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 305dda3a2eaafa84c58978dd398b3e56913ceead
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 6 16:34:23 2013 -0500
+
+ Update VERSION to 2.4.11_010 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 13 ++++++++-----
+ Release_Notes | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 64 insertions(+), 6 deletions(-)
+
+commit 06ba255d23002c2a8f22de5520f1514e6f6b42d0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 6 15:46:52 2013 -0500
+
+ Add $PDL::NiceSlice::debug_filter option
+
+ This allows one to output the PDL::NiceSlice
+ filtered sources to help debug any problems
+ with the new source filter engine. Just put
+
+ BEGIN { $PDL::NiceSlice::debug_filter = 1; }
+
+ at the top of your source file, say, source.pm.
+ Then you can run
+
+ perl -c source.pm >source.pmc
+
+ to collect the filtered output into source.pmc.
+
+ Basic/SourceFilter/FilterSimple.pm | 3 ++-
+ Basic/SourceFilter/NiceSlice.pm | 2 +-
+ Release_Notes | 12 ++++++++++++
+ 3 files changed, 15 insertions(+), 2 deletions(-)
+
+commit 8be911e115bfe196fb564d988c12814f82f1b472
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 6 12:24:20 2013 -0500
+
+ Must use latest Filter::Simple
+
+ This has a fix for detecting and filtering out Pod
+ lines.
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit c82a5ad3b4d6e51a5988b352daab2a0e1bd5e7c5
+Merge: c27aa9e ae9382f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 6 10:59:23 2013 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit c27aa9ebe145a29b97605b086862620072642341
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Feb 6 10:57:01 2013 -0500
+
+ Fix PDL::Graphics::PGPLOT::Window POD
+
+ The docs for the lines() method were incorrect
+ which triggered a bug with PDL::NiceSlice. Correcting
+ the docs is a workaround for the bug which will be
+ fixed separately. This should allow tests to pass
+ for all win32 platforms.
+
+ Graphics/PGPLOT/Window/Window.pm | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit ae9382f9a9e82abe37e371ec2e359572a85e8871
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Feb 5 17:45:02 2013 -0600
+
+ bad.pd tweaks and corrections
+
+ Basic/Bad/bad.pd | 46 +++++++++++++++-------------------------------
+ 1 files changed, 15 insertions(+), 31 deletions(-)
+
+commit e9bce84a34b52548db6095ceac47a6acce91faf8
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Feb 5 17:44:27 2013 -0600
+
+ Added auto-head1-FUNCTIONS for FullDoc
+
+ Basic/Gen/PP.pm | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit 13c43638fc59c10ba2a3aaca21e7c837e8a77bb6
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Feb 5 16:58:39 2013 -0600
+
+ Updated Release_Notes with bad.pd work
+
+ Release_Notes | 7 ++++++-
+ 1 files changed, 6 insertions(+), 1 deletions(-)
+
+commit 6559c06b3577573bb4713ee569bd51c5131c5886
+Merge: ef0f648 4adc2be
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Feb 5 16:56:13 2013 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit ef0f6488ef47ca9b52beffd2c826e9b3900a1e4e
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Feb 5 16:55:54 2013 -0600
+
+ Finished transitioning bad.pd to use FullDoc
+
+ Basic/Bad/bad.pd | 282 ++++++++++++++++++++++++++++--------------------------
+ 1 files changed, 146 insertions(+), 136 deletions(-)
+
+commit ea01410e6c98720c85add8c02d63d3a5f04274c9
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Feb 5 16:55:16 2013 -0600
+
+ Changed FullDoc croak to confess: full stack trace is more helpful here
+
+ Basic/Gen/PP.pm | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 4adc2bee5ef1fa8566a0b92214b696541462e7ff
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 5 13:00:35 2013 -0500
+
+ Update Known_problems with Pending fix to PDL::NiceSlice bug
+
+ Known_problems | 6 ++++++
+ 1 files changed, 6 insertions(+), 0 deletions(-)
+
+commit 0bb97b973f98c41f297091cd542ec41c29062bbd
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Feb 5 11:24:13 2013 -0600
+
+ CPANification and doc cleanup for bad.pd
+
+ Basic/Bad/bad.pd | 274 ++++++++++++++++++++++++++++++------------------------
+ 1 files changed, 153 insertions(+), 121 deletions(-)
+
+commit 7554314d0a97df9fd985e90c55b22113c4b1c0f1
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Feb 5 09:35:33 2013 -0600
+
+ Expanded explanation of =for bad in PDL::Doc
+
+ Doc/Doc.pm | 7 ++++---
+ 1 files changed, 4 insertions(+), 3 deletions(-)
+
+commit c57d835aed96ddfb9d3e84d262236a86304bb84d
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Feb 5 09:21:16 2013 -0600
+
+ Removed quasi-internal pod about old PDLs from bad.pd
+
+ Basic/Bad/bad.pd | 5 -----
+ 1 files changed, 0 insertions(+), 5 deletions(-)
+
+commit 06fc12980fba5f12da9abac343fae0e691931398
+Merge: 2a6ea82 cbe55f6
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Feb 5 09:18:59 2013 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit cbe55f6d31e2fc4fec351f933a8064e52ba16572
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 5 10:03:06 2013 -0500
+
+ Update VERSION to 2.4.11_009 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 44 ++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 46 insertions(+), 2 deletions(-)
+
+commit 4a69721d818293e92f0330e05c9b4b9774e00daa
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 5 09:34:32 2013 -0500
+
+ Update Release_Notes for CPAN devel release.
+
+ Release_Notes | 9 ++++++++-
+ 1 files changed, 8 insertions(+), 1 deletions(-)
+
+commit c9e4029d95d0a83346bdd19759fea9116e95478c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 5 09:28:07 2013 -0500
+
+ Fix new PDL::NiceSlice bug on early perls
+
+ The problem was the difference between text and
+ binary mode on loading a file. Recent perls use
+ text mode. Older perls do not---this leaves extra
+ \r in the file that need to be skipped. The fix
+ was a prefilter for MSWin32 and perls older than
+ v5.14.0.
+
+ Basic/SourceFilter/FilterSimple.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit d801ccf2caf509eceba137e16fa1a28a54d0558c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Feb 4 08:56:39 2013 -0500
+
+ Add dragonfly to list of OSes to skip t/gd_oo_test.t
+
+ They are a BSD OS but don't have the letters bsd in the
+ value of $^O.
+
+ t/gd_oo_tests.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2fd48fa961686d1ebe37a044f0e0309732bb725a
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Mon Feb 4 05:13:31 2013 -0700
+
+ fix bug #3603249 (AutoLoader leaks $_ into local context)
+
+ Problem was that $_ was not being localized in NiceSlice.
+
+ Basic/SourceFilter/NiceSlice.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 6cf50449f32e2003e3ff67f025031f79b5e4966e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jan 31 12:39:52 2013 -0500
+
+ Update VERSION to 2.4.11_008 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 44 ++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 46 insertions(+), 2 deletions(-)
+
+commit 157cbd7704487941cc12e2be49e5b9fe9f05ed7c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jan 31 10:20:11 2013 -0500
+
+ Bump minimum version of Filter::Simple to 0.86
+
+ And add warning in Release_Notes on how to use
+ the old engine with the new releases while this
+ test process is underway.
+
+ Makefile.PL | 2 +-
+ Release_Notes | 12 ++++++++++++
+ 2 files changed, 13 insertions(+), 1 deletions(-)
+
+commit 8d59a002807e7dfc2f9e100e75fd42c7e71f806b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jan 30 09:10:14 2013 -0500
+
+ Update VERSION to 2.4.11_007 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 108dec957f33466bf22110046f9a2ddd3a20dce4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jan 30 09:03:55 2013 -0500
+
+ Update Release_Notes for a new CPAN devel release
+
+ Release_Notes | 4 +++-
+ 1 files changed, 3 insertions(+), 1 deletions(-)
+
+commit 7218ac2e8c453ff3113379b3d89ae8d996d1bf6c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jan 30 09:01:51 2013 -0500
+
+ Make Filter::Simple a dependency for PDL
+
+ The new PDL::NiceSlice filter is the basis for the
+ new and improved NiceSlice. Forgot to add it to the
+ Makefile.PL as a dependency.
+
+ Makefile.PL | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 648757414a1977db9675f0c3c809f7d076da3d7c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 29 12:31:31 2013 -0500
+
+ Update version to 2.4.11_006 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 2117e3bf08c72e668c1768772659500e47783487
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 29 12:25:57 2013 -0500
+
+ Make FilterSimple the default engine for PDL::NiceSlice
+
+ ...and update Release_Notes for a new CPAN developers release.
+
+ Basic/SourceFilter/NiceSlice.pm | 3 ++-
+ Release_Notes | 7 ++++++-
+ 2 files changed, 8 insertions(+), 2 deletions(-)
+
+commit 9cca4f8eb31f8fc19c0ef2b773bc174f746e5a06
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jan 24 10:14:06 2013 -0500
+
+ Make t/gd_oo_tests.t skip testing for all BSD OSes
+
+ I plan to leave this skip in until the problem is actually
+ fixed. In the meantime, for automated testing, the tests
+ will be skippped. Otherwise a message about the known
+ problem will be printed.
+
+ t/gd_oo_tests.t | 11 +++++++++--
+ 1 files changed, 9 insertions(+), 2 deletions(-)
+
+commit 9d9faa0c712be8ede40ac8a846f0e6065bf054e4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 22 16:58:38 2013 -0500
+
+ Update VERSION to 2.4.11_005 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 7adf218e451da41efce84a1591c84a75fdcee5c6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 22 16:24:58 2013 -0500
+
+ Update MANIFEST to remove PDL/Doc/Pod stuff
+
+ MANIFEST | 5 -----
+ 1 files changed, 0 insertions(+), 5 deletions(-)
+
+commit fccf1151909980067f0f33879451300beaa003e0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 22 16:21:45 2013 -0500
+
+ Update Known_problems and Release_Notes for CPAN devel release
+
+ Known_problems | 6 +++++-
+ Release_Notes | 13 +++++++++++++
+ 2 files changed, 18 insertions(+), 1 deletions(-)
+
+commit 56fe5e9fdbefe5ceed24f878601803138da807cd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 22 16:01:38 2013 -0500
+
+ Fix problem with multiple imag2d windows active
+
+ Added glutSetWindow() call to ensure that imag2d_update
+ adds a glutPostRedisplay for the updated image data pdl.
+
+ Graphics/Graphics2D.pm | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit 2937ef2501f7bec6b59c8d60859f46af146df239
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 22 15:58:43 2013 -0500
+
+ Skip t/gd_oo_tests.t for OpenBSD systems under AUTOMATED_TESTING
+
+ Since the failing GD tests apparently crash/kill the perl
+ process, TODO doesn't work to quiet them for CPAN Testers.
+ Uncommented code to skip_all for the case of $^O =~ /openbsd/i
+ and the environment AUTOMATED_TESTING is true. The tests
+ will still fail for hand installs but, presumably the user
+ can see that only a small fraction of subtests actually fail.
+
+ t/gd_oo_tests.t | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 9ee953d10749d8d167df53ab53beaafce203f8f1
+Merge: da6d5d6 ce06b35
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 22 10:19:04 2013 -0500
+
+ Merge branch 'master' into 64bit-index-support
+
+commit ce06b35ac340c3893474171c114b7a11063624bb
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Jan 21 00:35:00 2013 -0600
+
+ New FullDoc PDL::PP key and fixed a few minor doc niggles
+
+ Basic/Bad/bad.pd | 102 +++++++------
+ Basic/Gen/PP.pm | 292 +++++++++++++++++++++++++++++++-------
+ Basic/Gen/PP/PdlParObj.pm | 71 +++-------
+ Graphics/PGPLOT/Window/Window.pm | 2 +-
+ Release_Notes | 3 +-
+ 5 files changed, 317 insertions(+), 153 deletions(-)
+
+commit 8a1c920c53812dabd31225d8917359035bb00921
+Merge: c5abfc9 75d71ff
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sun Jan 20 23:00:15 2013 -0600
+
+ Merge branch 'master', remote-tracking branch 'sf/master'
+
+commit 75d71ff441225a7fc5302300f24c0c34bef2160f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jan 20 14:10:22 2013 -0500
+
+ Make perldl skip and warn that -glut/-tk options not supported
+
+ Yet...until I can figure out how to get the event loops
+ to interoperate correctly.
+
+ perldl.PL | 8 ++++++++
+ 1 files changed, 8 insertions(+), 0 deletions(-)
+
+commit 7f357d181b59a52522dd02731c176d1412cf7650
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jan 20 11:10:32 2013 -0500
+
+ Update VERSION to 2.4.11_004 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 33 ++++++++++++++++++++++++++++++++-
+ 3 files changed, 34 insertions(+), 3 deletions(-)
+
+commit a0dfcc0df392461aca778f986ede6e535d7540b4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jan 20 10:46:02 2013 -0500
+
+ Update Known_problems and Release_Notes for CPAN release
+
+ Known_problems | 13 +++++++++----
+ Release_Notes | 8 +++++++-
+ 2 files changed, 16 insertions(+), 5 deletions(-)
+
+commit 411e40b26b3f64cf84c42b6c476ec9c062709b5a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jan 20 10:45:11 2013 -0500
+
+ Add -glut option to perldl pod (now works for non-MSwin platforms)
+
+ perldl.PL | 14 ++++++++++----
+ 1 files changed, 10 insertions(+), 4 deletions(-)
+
+commit 373eda51f11640176c999bfe09b7d8b72fa9920a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 18 07:28:07 2013 -0500
+
+ make t/gd_oo_tests.t TODO to debug
+
+ There is a bug for AMD64 platforms that has not
+ been resolved. The sf.net bug #3518190 is being
+ re-opened to track the issue.
+
+ t/gd_oo_tests.t | 377 ++++++++++++++++++++++++++++---------------------------
+ 1 files changed, 191 insertions(+), 186 deletions(-)
+
+commit 95730525a552f7cd7fa3385a7ed10d9abed00d3f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jan 17 17:16:14 2013 -0500
+
+ Tweak PDL::howbig pod so apropos sizeof will find it
+
+ Basic/Core/Core.pm.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit c5abfc96ac490bc1ed7177a73c71a6ca144f0785
+Merge: 3d9b989 99d747b
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Jan 14 09:27:37 2013 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 99d747b3301a1b247b6bcc06fa304b19c2f698f5
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Mon Jan 14 16:04:59 2013 +1100
+
+ t/argtest.t Escape left brace in regex
+
+ Left brace in regex at line 40 needs to be escaped
+ to avoid deprecation warning with perl-5.17 and
+ later.
+
+ t/argtest.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f7d7f80e8fc48fa023c29b4305111417957ffbfa
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jan 13 11:55:20 2013 -0500
+
+ Update version info to 2.4.11_003 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 96c317fe6b36f1a973817e081cf2d09ed7a698d2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jan 13 11:38:26 2013 -0500
+
+ Update Release_Notes for PDL-2.4.11_002 release
+
+ Release_Notes | 5 ++++-
+ 1 files changed, 4 insertions(+), 1 deletions(-)
+
+commit f2fc6aed72ce3ddb60211fc8d4c9cd4f8bb0369e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jan 13 11:32:29 2013 -0500
+
+ Add test names to t/gd_oo_tests.t
+
+ Maybe this will help figure out what the problem is on
+ some platforms.
+
+ t/gd_oo_tests.t | 64 +++++++++++++++++++++++++++---------------------------
+ 1 files changed, 32 insertions(+), 32 deletions(-)
+
+commit a9fcf18c1de3ee3378ef7d6b205d016d1d4fc4c4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jan 13 11:10:49 2013 -0500
+
+ Add back some TODO block around failing NaN representation tests
+
+ These are platform specific and we don't want PDL failing its
+ build tests just because we haven't debugged the problem on
+ all possible platform combinations...
+
+ t/pdl_from_string.t | 48 ++++++++++++++++++++++++++----------------------
+ 1 files changed, 26 insertions(+), 22 deletions(-)
+
+commit 360ce69e1f9a96c4367e90bc88cf5508971128c1
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sun Jan 13 21:17:58 2013 +1100
+
+ t/pdl_from_string.t - remove some outdated comments
+
+ There were some comments (specific to MS Windows)
+ that should have been removed earlier.
+
+ t/pdl_from_string.t | 6 ------
+ 1 files changed, 0 insertions(+), 6 deletions(-)
+
+commit 3d9b9892625c0f767eccb217089712808b9993dd
+Merge: 2fa430e 0f1f5f2
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Jan 11 14:39:59 2013 -0600
+
+ Merged Release_Notes on PDL::Pod notes
+
+commit 0f1f5f2aaa89d76e4a3c46e716567c9ed8dfd562
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 11 15:37:14 2013 -0500
+
+ Bump VERSION to 2.4.11_002 for more PDL development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 34 ++++++++++++++++++++++++++++++++--
+ 3 files changed, 34 insertions(+), 4 deletions(-)
+
+commit 951d5fed7eac3b577f303c409bf2cfa14fda1867
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 11 15:16:40 2013 -0500
+
+ Fix tempfile race condition in wpnm()
+
+ Resolved by using tempfile() from File::Temp rather
+ than the hand-rolled version. It is tricky to get
+ temporary files right so standardizing on File::Temp
+ is probably the right thing to do.
+
+ IO/Pnm/pnm.pd | 16 +++-------------
+ 1 files changed, 3 insertions(+), 13 deletions(-)
+
+commit 1e61f9b08dc9ce4288c3a50c545d89aec952d5ab
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 11 14:21:36 2013 -0500
+
+ Update MANIFEST for PDL-2.4.11_001 developers release
+
+ MANIFEST | 6 +++++-
+ 1 files changed, 5 insertions(+), 1 deletions(-)
+
+commit 222fc653fb3e362945ca11f03258e31d3141fe59
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 11 13:59:48 2013 -0500
+
+ Update Known_problems and Release_Notes
+
+ Known_problems | 17 ++++++++---------
+ Release_Notes | 28 +++++++++++++++++++++++++++-
+ 2 files changed, 35 insertions(+), 10 deletions(-)
+
+commit 77531a2d6b381531e790ef0ac6ecad97cc725e16
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 11 13:58:26 2013 -0500
+
+ Bump $VERSION to 1.356 for -glut fix to perldl
+
+ perldl.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2fa430e7bce297ccad22470cc3886f14980bf9af
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Jan 7 23:39:08 2013 -0600
+
+ Removed =for ref Internal pod directives
+
+ The pod directive =for ref Internal shows up in many places in
+ Graphics/PGPLOT/Window/Window.pm, but it does not serve much of a
+ purpose. It probably served a useful purpose at some point, but
+ that purpose has been lost. Removing for now, with the expectation
+ of revisiting after devising a better pdldoc keyword system.
+
+ Doc/Doc.pm | 1 +
+ Graphics/PGPLOT/Window/Window.pm | 13 -------------
+ 2 files changed, 1 insertions(+), 13 deletions(-)
+
+commit 97e1f6f8b88fd901cea30c096574538430b85dc4
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Jan 7 23:22:20 2013 -0600
+
+ Updated Release_Notes with Joel's work.
+
+ Release_Notes | 5 ++++-
+ 1 files changed, 4 insertions(+), 1 deletions(-)
+
+commit 0325a95376be1d45f0a85226d134137eaf2e208c
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Jan 7 23:13:01 2013 -0600
+
+ Fixed misspellings of PERL in intro docs
+
+ Basic/Pod/MATLAB.pod | 4 ++--
+ Basic/Pod/Scilab.pod | 4 ++--
+ 2 files changed, 4 insertions(+), 4 deletions(-)
+
+commit a1617d12c63d68bf959fbf97ce36e7e746bfa125
+Merge: bf934bd bdf875c
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Jan 7 23:01:56 2013 -0600
+
+ Merge branch 'master' of github.com:PDLPorters/pdl
+
+commit bf934bd69db2d4ae3fbaac10b8f226d44501a15e
+Merge: ae28aff beb9d53
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Jan 7 23:00:39 2013 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit beb9d53014f6ed5be68859382c8192822ee5e998
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jan 7 21:27:29 2013 -0500
+
+ Make timeout 0 for select call
+
+ This makes the new event_loop support more
+ real time.
+
+ perldl.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 39aec99d81b1113f5ac8e4449dd249be88e46c39
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jan 7 13:33:42 2013 -0500
+
+ Add event_loop support for perldl -glut option
+
+ Now it is possible to have the AppleGLUT or FreeGLUT
+ event loop run while using the command line interface.
+ The new functionality requires Term::ReadLine 1.09 or
+ higher but is transparently enabled if $term->can('event_loop').
+
+ Graphics/Graphics2D.pm | 4 +--
+ perldl.PL | 52 ++++++++++++++++++++++++++++++++++++++---------
+ 2 files changed, 43 insertions(+), 13 deletions(-)
+
+commit bdf875c9c2e43242a11bcbd94450aea56b3a4b2c
+Merge: 964a514 c4117fd
+Author: run4flat <dcmertens.perl at gmail.com>
+Date: Mon Jan 7 08:28:19 2013 -0800
+
+ Merge pull request #3 from PDLPorters/pod
+
+ Remove PDL::Pod:: classes in favor of Perl core modules Pod::
+
+commit ae28affc9af7b95256c07064ffa672c0f3ed91e2
+Merge: eeba80e 54af56e
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sat Jan 5 08:46:45 2013 -0600
+
+ Merge branch 'master', remote-tracking branch 'origin/master'
+
+commit eeba80ebf8c3370e84ebc26181e27b5eab27b42c
+Merge: efb6500 964a514
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sat Jan 5 08:45:07 2013 -0600
+
+ Merge branch 'master' of github.com:PDLPorters/pdl
+
+commit 54af56edcca8e915232515a5cfc7d58106a01a0d
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sat Jan 5 11:44:31 2013 +1100
+
+ Basic/Core/Core.pm.PL - Alteration to pdl('nan') generation.
+
+ In Core.pm.PL, I changed the line:
+ ${$nan->get_dataref} = pack( "d*", "nan" );
+ to:
+ ${$nan->get_dataref} = pack( "d*", (-1.0) ** 0.5 );
+
+ as the former works only if perl numifies the string "nan"
+ to a NaN - which doesn't happen on all perls.
+
+ Basic/Core/Core.pm.PL | 304 +++++++++++++++++++++++++------------------------
+ 1 files changed, 155 insertions(+), 149 deletions(-)
+
+commit 7a6cac66fefd6fb6670490645cd8a1d194a8e2ac
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sat Jan 5 11:44:31 2013 +1100
+
+ t/pdl_from_string.t - Move some tests out of TODO
+
+ Also change the way that pdl_from_string.t generates
+ a pdl('nan') on Windows.
+
+ t/pdl_from_string.t | 11 +++++------
+ 1 files changed, 5 insertions(+), 6 deletions(-)
+
+commit 9899ed00e3302d8eb489461ef3ec8c76766e8d77
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 4 17:40:36 2013 -0500
+
+ Fix twiddle control for imag2d
+
+ Clicking the close widget of the last imag2d window
+ failed to close the last window and you couldn't "twiddle"
+ to make it finish. Now the window should close cleanly.
+
+ Graphics/Graphics2D.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2a6ea82cd421e2deffa66a522125e472414f3324
+Merge: c4117fd 964a514
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Jan 4 11:20:39 2013 -0600
+
+ Merge branch 'master' into HEAD
+
+commit 964a5141060094f8dd6948f187349fb36830312c
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Jan 4 10:46:23 2013 -0600
+
+ Minor doc tweaks to Complex.pm and Core.pm
+
+ Basic/Complex/complex.pd | 2 +-
+ Basic/Core/Core.pm.PL | 4 ++--
+ 2 files changed, 3 insertions(+), 3 deletions(-)
+
+commit c4117fd5bfdaaaf55f3fed565be1cb6f89bb4569
+Author: Joel Berger <joel.a.berger at gmail.com>
+Date: Thu Jan 3 12:34:38 2013 -0600
+
+ removed warning about Pod::Parser incompatibility
+
+ Doc/Doc.pm | 7 -------
+ 1 files changed, 0 insertions(+), 7 deletions(-)
+
+commit 69260d2b87e77f53379f0b413d4ec5e32bf86267
+Author: Joel Berger <joel.a.berger at gmail.com>
+Date: Thu Jan 3 11:55:45 2013 -0600
+
+ removed problematic "last" directive
+
+ Doc/Doc.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 624595479647ca09e8901fe656ebb3b0b816852a
+Author: Joel Berger <joel.a.berger at gmail.com>
+Date: Thu Jan 3 11:44:14 2013 -0600
+
+ removed PDL::Pod:: classes in favor of core modules Pod::
+
+ Further changed calling implementation of overriden functions "command", "textblock" and "verbatim" and a few internal methods
+ Also removed StrHandle and NullHandle classes in favor of opening handles to strings
+
+ Doc/Doc.pm | 71 +---
+ Doc/Doc/Perldl.pm | 5 +-
+ Doc/Pod/Makefile.PL | 18 -
+ Doc/Pod/Parser.pm | 1112 ---------------------------------------------------
+ Doc/Pod/README | 206 ----------
+ Doc/Pod/Select.pm | 128 ------
+ Doc/Pod/Usage.pm | 244 -----------
+ 7 files changed, 25 insertions(+), 1759 deletions(-)
+
+commit 5df755cfeeee4eac723e831ae78c2edec99457fe
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 1 17:10:23 2013 -0500
+
+ Fix sf.net bug #3585811 "conv1d bad value broken"
+
+ Now a warning is generated if conv1d() is used on data
+ with the badflag set. An explicit caution is also added
+ to the documentation.
+
+ Basic/Primitive/primitive.pd | 8 ++++++++
+ 1 files changed, 8 insertions(+), 0 deletions(-)
+
+commit fe5e29221378a1b54aa2614c0a043d6942fa6a12
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 1 16:34:41 2013 -0500
+
+ Fix hist() handling of fractional $step
+
+ This fixes sf.net bug #3588182 by making the $xvals
+ returns in list context alway be double and updates
+ the documentation to reflect this. Also fixes a
+ logic error in the calculation of the value for $step
+ if not provided.
+
+ Basic/Core/Basic.pm | 20 +++++++++++---------
+ 1 files changed, 11 insertions(+), 9 deletions(-)
+
+commit 14a56ef4b59e0e4114707d0a4f457da976aea0fd
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Thu Dec 27 21:40:28 2012 +1100
+
+ Basic/Gen/PP/PDLCode.pm - quiet perl-5.18 deprecation warning
+
+ Escape left brace in regexes - '%{' becomes '%\{'
+
+ Basic/Gen/PP/PDLCode.pm | 126 +++++++++++++++++++++++-----------------------
+ 1 files changed, 63 insertions(+), 63 deletions(-)
+
+commit a5705ed9a66785684a3f1375868eb30ec03e163e
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Thu Dec 27 21:40:28 2012 +1100
+
+ Basic/Gen/PP.pm - quiet perl-5.18 deprecation warning
+
+ Escape left brace in regex - '%{' becomes '%\{'
+
+ Basic/Gen/PP.pm | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 1f0ce8672536bf17efddc4a037e7fdd939373f74
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Thu Dec 27 21:40:28 2012 +1100
+
+ t/pp_croaking.t - quiet perl-5.18 deprecation warning
+
+ Escape left brace in regex - '%{' becomes '%\{'
+
+ t/pp_croaking.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit efb650035909cd98dfdefe4d893ee86741b939c1
+Merge: a76f87b a6fdb8e
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Dec 26 05:08:09 2012 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit a76f87b5b75a2238785736b072a03d0c7f6fb3d8
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Dec 26 05:06:06 2012 -0600
+
+ Fixed minor pod formatting issue in PDL::Transform
+
+ Lib/Transform/transform.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit a6fdb8e7028ea3915cae8e2658d99c26cc24364b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 9 12:12:16 2012 -0500
+
+ add whereND to PDL::Lvalue->subs() @funcs
+
+ And alphabetized the list of functions so it will be
+ easier to inspect. Ideally, we should generate this
+ list from the sources.
+
+ Basic/Lvalue.pm | 7 ++++---
+ 1 files changed, 4 insertions(+), 3 deletions(-)
+
+commit 94fa430141771e5a218d233077e609d4015c0316
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Nov 20 15:48:02 2012 -0700
+
+ Fixed image2d.pd POD error that prevented some funcs from showing up in the docs db
+
+ '=head1 polyfill' changed to '=head2 polyfill'. Also prettified some ccXcompt links.
+
+ Lib/Image2D/image2d.pd | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit e3fca65768a51a5ba57629a7fff5fe10b38686bf
+Author: sisyphus <sisyphus at Owner-PC311012.(none)>
+Date: Wed Nov 14 22:56:01 2012 +1100
+
+ Top level Makefile.PL - nmake-specific fix
+
+ Craig's recent change wrt pdl.PL/pdl.c has
+ necessitated a small tweak for nmake.
+
+ Makefile.PL | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 0e927a40e636e557ab7b072c08bb53f4e2d91a56
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Tue Nov 13 12:46:25 2012 -0700
+
+ more warning elimination
+
+ Basic/Gen/PP.pm | 4 ++--
+ Basic/Slices/slices.pd | 5 +++--
+ 2 files changed, 5 insertions(+), 4 deletions(-)
+
+commit c678279da7a94b4b870567b69d2c72a62fa05012
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Tue Nov 13 11:39:25 2012 -0700
+
+ more warning suppression
+
+ Basic/Core/pdlmagic.c | 14 ++++++++------
+ 1 files changed, 8 insertions(+), 6 deletions(-)
+
+commit 049f8baa3456cee342e0517ddf08d70920c7c424
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Tue Nov 13 11:15:05 2012 -0700
+
+ more clang warning fixes - no functional changes
+
+ Basic/Core/Core.xs.PL | 8 ++++----
+ Basic/Core/pdl.h.PL | 4 ++--
+ Basic/Core/pdlapi.c | 10 +++++-----
+ Basic/Core/pdlcore.c.PL | 7 ++++---
+ Basic/Core/pdlhash.c | 2 +-
+ Basic/Core/pdlthread.c | 1 -
+ 6 files changed, 16 insertions(+), 16 deletions(-)
+
+commit bfdd480243929cea914839335218dbbc865053c2
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Tue Nov 13 10:38:30 2012 -0700
+
+ Basic cleanup of some warnings in the core with newer versions of clang. No functional changes (I hope).
+ A couple more pushes of this type to come.
+
+ Basic/Core/Core.xs.PL | 4 +---
+ Basic/Core/pdl.h.PL | 7 +++----
+ Basic/Core/pdlcore.c.PL | 2 +-
+ Basic/Gen/PP.pm | 9 +++++----
+ Basic/Gen/PP/PDLCode.pm | 2 +-
+ 5 files changed, 11 insertions(+), 13 deletions(-)
+
+commit 168c037d6298e2eecdda6c468586919bc52e44ef
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Nov 13 08:46:50 2012 -0500
+
+ Bump version in perldl for Craig's fix
+
+ Otherwise, you have no easy way to see if
+ you are running the "new/fixed" code.
+
+ perldl.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 16b17c86a976dc0fe34d80eb063bba92b53975a8
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Tue Nov 13 02:03:29 2012 -0700
+
+ Fix non-reported callback bug in perldl. This boneheaded calling scheme
+ (simply appending a "die $@ if($@)" to the end of the eval) seems to work
+ in 5.10,5.12, and 5.14 -- I'm not sure why we didn't do it to start with.
+
+ Since perldl is the only place PDL::Core::myeval() was called, I deleted it
+ from Core.xs.PL as well -- it appears to be cruft at this point, since
+ it no longer works as intended and is also no longer used.
+
+ Basic/Core/Core.xs.PL | 16 ----------------
+ perldl.PL | 8 +++++---
+ 2 files changed, 5 insertions(+), 19 deletions(-)
+
+commit abcf992877ff0bd319d52166cf716ea086d1702e
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Mon Nov 12 17:32:26 2012 -0700
+
+ Fixed warnings in pdl.PL. Fixed up Makefile.PL to actually compile pdl.c into pdl after it is made. (MacOS 10.8 seems to need that).
+
+ Makefile.PL | 23 +++++++++++++++++------
+ pdl.PL | 6 +++---
+ 2 files changed, 20 insertions(+), 9 deletions(-)
+
+commit e8734eb1b303942f3f4dfe683c6cf0c32b209257
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Mon Nov 12 17:00:40 2012 -0700
+
+ fix longstanding problem with three-argument form of rim
+
+ IO/Pnm/Pic.pm | 31 ++++++++++++++++++-------------
+ 1 files changed, 18 insertions(+), 13 deletions(-)
+
+commit f17e251db783f5d45b5e6dae45adb9bc4be6bf16
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Mon Nov 12 16:24:39 2012 -0700
+
+ fix syntax error in transform.pd
+
+ Lib/Transform/transform.pd | 7 ++++++-
+ 1 files changed, 6 insertions(+), 1 deletions(-)
+
+commit fbca747a30442e2954d207db1805270304e4dcbd
+Merge: f2e42e3 dd92350
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Mon Nov 12 15:12:33 2012 -0700
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit f2e42e38f9d2f1e1f4666adf468b220a8e896682
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Mon Nov 12 15:09:39 2012 -0700
+
+ Make Ufunc's POD usage docs agree with function signatures.
+
+ In ufunc.pd, functions had a signature like (a(n); [o]b()), but then
+ had usage lines like $a = func($b). So I just changed the usage lines
+ to $b = func($a), to reduce confusion.
+
+ Basic/Ufunc/ufunc.pd | 14 +++++++-------
+ 1 files changed, 7 insertions(+), 7 deletions(-)
+
+commit dd923502135b714f4f566da359c1e2c3779078f6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Nov 12 10:43:19 2012 -0500
+
+ Fix win32 bsd.dll pattern to only match bsd.dll
+
+ On cygwin 1.7.17, the GD library file is /usr/lib/libgd.dll.a
+ so the string 'bgd.dll' was being found even though the
+ searched for DLL was not.
+
+ IO/GD/Makefile.PL | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 0fecb6c762256565c3553153009d1cadd229d475
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Nov 9 16:43:27 2012 -0700
+
+ Add NOMYMETA tags to most of the rest of the Makefile.PLs.
+
+ This finishes what I started with commit 96700c4, adding the
+ eval'd check on the EU::MM version and adding the NOMYMETA=>1
+ line if appropriate. Now there are only 4 pairs of MYMETA.[yml,json]
+ files created with 'perl Makefile.PL'.
+
+ Basic/Core/Makefile.PL | 1 +
+ Basic/Gen/Makefile.PL | 1 +
+ Basic/Makefile.PL | 1 +
+ Basic/Pod/Makefile.PL | 1 +
+ Demos/Makefile.PL | 3 ++-
+ Doc/Makefile.PL | 1 +
+ Doc/Pod/Makefile.PL | 1 +
+ Graphics/LUT/Makefile.PL | 1 +
+ Graphics/LUT/ramps/Makefile.PL | 3 ++-
+ Graphics/LUT/tables/Makefile.PL | 3 ++-
+ Graphics/Limits/Makefile.PL | 1 +
+ Graphics/Makefile.PL | 1 +
+ Graphics/PGPLOT/Makefile.PL | 3 ++-
+ Graphics/PGPLOT/Window/Makefile.PL | 3 ++-
+ Graphics/TriD/Makefile.PL | 1 +
+ Graphics/TriD/VRML/Makefile.PL | 1 +
+ IO/Dicom/Makefile.PL | 1 +
+ IO/FITS/Makefile.PL | 1 +
+ IO/FastRaw/Makefile.PL | 1 +
+ IO/FlexRaw/Makefile.PL | 1 +
+ IO/HDF/Makefile.PL | 1 +
+ IO/HDF/SD/Makefile.PL | 1 +
+ IO/HDF/VS/Makefile.PL | 3 ++-
+ IO/Makefile.PL | 1 +
+ Lib/CallExt/Makefile.PL | 2 +-
+ Lib/Filter/Makefile.PL | 3 ++-
+ Lib/Fit/Makefile.PL | 1 +
+ Lib/GIS/Makefile.PL | 1 +
+ Lib/GSL/Makefile.PL | 1 +
+ Lib/GSL/SF/Makefile.PL | 1 +
+ Lib/Makefile.PL | 1 +
+ Lib/Opt/Makefile.PL | 1 +
+ Lib/Opt/Simplex/Makefile.PL | 3 ++-
+ Lib/Transform/Cartography/Makefile.PL | 3 ++-
+ Perldl2/Makefile.PL | 2 ++
+ Perldl2/Plugin/Makefile.PL | 1 +
+ Perldl2/Profile/Makefile.PL | 1 +
+ 37 files changed, 47 insertions(+), 10 deletions(-)
+
+commit 8f09bf389b97b28fa10e599b4b94f1bb6a55a7a9
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Nov 9 14:34:48 2012 -0700
+
+ Update the old link to the GSL docs from redhat.com to gnu.org.
+
+ Lib/GSL/DIFF/gsl_diff.pd | 2 +-
+ Lib/GSL/INTEG/gsl_integ.pd | 2 +-
+ Lib/GSL/INTERP/gsl_interp.pd | 2 +-
+ Lib/GSL/MROOT/gsl_mroot.pd | 2 +-
+ 4 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 44902ed9a73f07c54947d8e64afc8d282b796911
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Nov 9 13:59:25 2012 -0700
+
+ Small POD update for PDL::Func
+
+ The description "useful functions" for this module wasn't that useful,
+ so I added more detail. Fixed a syntax error in the docs for
+ PDL::Func::set. Also removed the section "The Future" because
+ obviously that isn't going to happen.
+
+ Lib/Func.pm | 11 +++--------
+ 1 files changed, 3 insertions(+), 8 deletions(-)
+
+commit f914a2554f8621c5ebde8a02f536ff4d00d7d567
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 8 09:46:46 2012 -0500
+
+ Update Known_problems for PDL-2.4.11 status
+
+ Known_problems | 18 +++++-------------
+ 1 files changed, 5 insertions(+), 13 deletions(-)
+
+commit 3bfd7247ae290b8f7319a9df53c0b327aab3770a
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Nov 6 14:50:46 2012 -0700
+
+ Quiet "isn't numeric" warning in a trid Makefile.PL.
+
+ Put an eval around $ExtUtils::MakeMaker::VERSION so that numeric
+ comparisons (>=, etc) don't complain for version strings
+ like '6.57_02'.
+
+ Graphics/TriD/POGL/Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 96700c442b1e1782ff182eaac375f43e62a9acfd
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Nov 6 14:45:40 2012 -0700
+
+ Suppress some of the "Writing MYMETA" messages during 'perl Makefile.PL'.
+
+ This should suppress some of the "Writing MYMETA.yml and MYMETA.json" lines
+ that crop up during the first part of the PDL build. It will not take care
+ of all of them, to do that I'll have to hand edit some Makefile.PL's. Putting
+ this in now to see if it messes up older versions of EU::MM, and if it's OK
+ I'll do the rest by hand later. See pdl-porters thread from 2011-Dec-21.
+
+ Basic/Core/Dev.pm | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit eafe04154fc23edc717d54304c03fc8df16b58c9
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Mon Nov 5 22:01:23 2012 -0700
+
+ Change the example for the "in" function to be less ambiguous.
+
+ Basic/Primitive/primitive.pd | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit da6d5d60645abbd2e133f1d57a3a40a14a00b89a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 1 11:00:08 2012 -0400
+
+ Change offspar type to PDL_Index in affine
+
+ Basic/Slices/slices.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 42063059a0b4dc0b3eb37b6572e0dbf2dd11a7a9
+Merge: b7ab80b a1ab4d7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 1 10:01:18 2012 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+ Conflicts:
+ Basic/Core/pdlcore.c.PL
+
+commit a1ab4d78b10e6a2fb52e42b2767cb641c652460f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 26 14:01:19 2012 -0400
+
+ Update Release_Notes and Known_problems
+
+ I would like to see a CPAN developers release in the
+ next month as we move towards a 2.4.12 release.
+
+ Known_problems | 9 ---------
+ Release_Notes | 38 ++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 38 insertions(+), 9 deletions(-)
+
+commit 7b684e98999a9ffb3bc637244801d09b416996a2
+Author: olpc user <olpc at xo-4a-9c-81.localdomain>
+Date: Sat Oct 6 17:03:05 2012 +0000
+
+ Fix p command in pdl2 shell
+
+ Added back a newline to the p command for
+ the pdl2 shell which fixes the breakage on
+ windows platforms. NOTE: p is a shorthand
+ to display output in the interactive shell.
+ It has never been an alias for print.
+
+ Perldl2/Profile/Perldl2.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 4eeddb3e6304717ba317b81972c2ab826c0ca1a5
+Author: olpc user <olpc at xo-4a-9c-81.localdomain>
+Date: Sat Oct 6 15:22:41 2012 +0000
+
+ Update DEPENDENCIES and Known_problems
+
+ DEPENDENCIES | 16 ++++------------
+ Known_problems | 22 ++--------------------
+ 2 files changed, 6 insertions(+), 32 deletions(-)
+
+commit c8501f9d20b9109d12b75d2cd0ff1bf07bbddd6c
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Fri Sep 21 19:36:25 2012 +1000
+
+ t/rim.t - Some basic testing of PDL::IO::Pic::rim()
+
+ The rim() function was (is still ?) broken. See:
+ http://mailman.jach.hawaii.edu/pipermail/pdl-porters/2012-July/004916.html
+ This script provides some basic testing of the function.
+
+ t/rim.t | 44 ++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 44 insertions(+), 0 deletions(-)
+
+commit 4b51e276e9baf20db7b3ffe03b0cb4bcb8d88516
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Fri Sep 21 19:36:24 2012 +1000
+
+ MANIFEST - add new test script t/rim.t
+
+ MANIFEST | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit fc2fe6d14967e1e6cfc422d4f734f1ecbc08efe8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 12 12:56:31 2012 -0400
+
+ Update inc/Devel/CheckLib.pm to version 0.98
+
+ inc/Devel/CheckLib.pm | 48 ++++++++++++++++++++++++++++++++----------------
+ 1 files changed, 32 insertions(+), 16 deletions(-)
+
+commit 033b59c2ee9292885058a3941fbfd1dc525ae7af
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 12 12:55:38 2012 -0400
+
+ Clean up test for PDLDOC_IGNORE_AUTOLOADER
+
+ pdldoc.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit df61526d565973bc1f0ade8629919c3940094247
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 6 18:54:51 2012 -0400
+
+ Minor edits to PDL::MATLAB pod
+
+ Basic/Pod/MATLAB.pod | 14 +++++++-------
+ 1 files changed, 7 insertions(+), 7 deletions(-)
+
+commit 6a700587296d975221f87a6612f07e836691086e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 6 17:12:46 2012 -0400
+
+ Add Boundary=>'Replicate' option to conv2d/med2d
+
+ Lib/Image2D/image2d.pd | 42 +++++++++++++++++++++++++++---------------
+ t/image2d.t | 10 +++++++---
+ 2 files changed, 34 insertions(+), 18 deletions(-)
+
+commit 513b4a82aee5cb03816481c6ae14abe2c705f87a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Sep 2 17:40:30 2012 -0400
+
+ fix 16-bit PNM raw format handling (sf.net bug #3475075)
+
+ This commit fixes wpnm and rpnm so that they output
+ raw format PNM data in network byte order (i.e., big
+ endian order). This fixes the 16bit pixel issues and
+ is believed to close this bug. Feedback welcome.
+
+ IO/Pnm/pnm.pd | 28 +++++++++++++++++++++++++++-
+ Known_problems | 12 +++++++++++-
+ 2 files changed, 38 insertions(+), 2 deletions(-)
+
+commit 94c463312d90c62fdb3be84ecf170c16c9cf0269
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Sep 2 15:00:57 2012 -0400
+
+ Re-add PNG checks to picrgb.t
+
+ And removed default '-quiet' option from wpic() since
+ the various NetPBM converters don't appear to support
+ that flag any more.
+
+ NOTE: SGI file format is still commented out because
+ of a problem with the converters (at least on cygwin)
+ where the files are not generated/converted correctly.
+
+ IO/Pnm/Pic.pm | 2 +-
+ t/picrgb.t | 4 +++-
+ 2 files changed, 4 insertions(+), 2 deletions(-)
+
+commit 892c5c9e3a524c483e73d3cb7552e5b43ef2ad02
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Sep 2 13:34:06 2012 -0400
+
+ Update unpdl docs a bit, hope it is clearer
+
+ Basic/Core/Core.pm.PL | 14 ++++++++++----
+ 1 files changed, 10 insertions(+), 4 deletions(-)
+
+commit cc634713f56a6428f3ee2a4298471896fc3b51e1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Sep 2 13:11:07 2012 -0400
+
+ Fix dummy() to generate correct slice() call
+
+ Sf.net feature request/bug report #3479009 had a hard to find
+ problem with dummy() because it was generating an underlying
+ call to slice() with an invalid string contruct, e.g. '* 128'
+ rather than '*128'. This fixes dummy() to coerce the ' 128'
+ to a number, i.e. '128' so that the slice string is correct as
+ far as syntax.
+
+ Also made one more failing NaN sign test a TODO one since it
+ was failing on cygwin.
+
+ Basic/Core/Core.pm.PL | 2 +-
+ t/pdl_from_string.t | 94 ++++++++++++++++++++++++------------------------
+ 2 files changed, 48 insertions(+), 48 deletions(-)
+
+commit eb96334c3e8df113638688ddcd8741872812cbc6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Sep 2 11:51:55 2012 -0400
+
+ Add missing binmode for win32 (see sf bug #3563903
+
+ This prevents text mode CR-LF translation on win32
+ platforms from breaking things. There may be an
+ un-binmoded handle in IO/FITS/FITS.pm as well but the
+ maintainers of that module will need to apply the
+ fix if needed.
+
+ IO/Dicom/Dicom.pm | 1 +
+ IO/FlexRaw/FlexRaw.pm | 1 +
+ IO/Pnm/Pic.pm | 1 +
+ 3 files changed, 3 insertions(+), 0 deletions(-)
+
+commit 2da876d38650ac0f342ec2123a7dbee0a5560bc5
+Author: unknown <chm at BELVNB0361NV126.nae.ds.army.mil>
+Date: Thu Aug 23 20:01:31 2012 -0400
+
+ Fit deprecation of "naked" { in regex for perl 5.17.x
+
+ Perldl2/Plugin/CleanErrors.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2d0410fd2eb54eb4f2342723688d84ff6d22919e
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Mon Aug 13 22:36:44 2012 +1000
+
+ Basic/Complex/complex.pd - Fix handling of complex 0.
+
+ 0+0i, when raised to a real power was giving incorrect
+ results. This fix just applies some "special case"
+ handling for x+0i (where x can be either zero or non-
+ zero) when raised to a real power (including 0).
+
+ Basic/Complex/complex.pd | 26 ++++++++++++++++++++------
+ 1 files changed, 20 insertions(+), 6 deletions(-)
+
+commit 55091589dde743b006a4e139c807246d3e274111
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Mon Aug 13 22:36:43 2012 +1000
+
+ t/complex.t Test changes to Basic/Complex/complex.pd
+
+ Test that today's changes Basic/Complex/complex.pd
+ give desired results.
+
+ t/complex.t | 22 +++++++++++++++++++++-
+ 1 files changed, 21 insertions(+), 1 deletions(-)
+
+commit 7bcf2ddc565a4516ad9219499f2179de4cee54a0
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu Aug 9 08:40:09 2012 -0500
+
+ Added documentation for isnull()
+
+ Basic/Core/Core.pm.PL | 22 +++++++++++++++++++---
+ 1 files changed, 19 insertions(+), 3 deletions(-)
+
+commit 17019f6fd2df8c542b5529fa74a1f6d2c8235528
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Jul 26 14:35:22 2012 -0600
+
+ Fix some print statments in pdlcore.c.PL.
+
+ When DEBUG_SETAV_TYPE or DEBUG_KLUDGE_COPY is #define'd there are
+ numerous compiler errors for print statments. This takes care of
+ some of them. Many more are generated because the loop over PDL
+ types does not also take care of different formatting codes (%f vs
+ %d vs %ld etc), so there is still some room for improvement.
+
+ Basic/Core/pdlcore.c.PL | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 52da4d16f1e90ed83c53a26ec4f4bffe18ff2cb4
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Jul 26 13:24:40 2012 -0600
+
+ Deal with an intermittent segfault in pdl_setav_$type.
+
+ Just before pdl_kludge_copy, the index of the pdims array (the
+ dimension list) could sometimes be negative. This caused an intermittent,
+ non-reproducible segfault on my machine. The fix (thanks Craig!)
+ doesn't break any existing tests, and seemed to solve the problem.
+
+ Basic/Core/pdlcore.c.PL | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit 0106d6e82a9f31fb39cc92cadcf4f4ce267c9ac4
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Wed Jul 25 13:37:20 2012 +1000
+
+ Lib/Image2D/image2d.pd Reposition the 'polyfill' definition.
+
+ Microsoft compilers might insist that the 'polyfill' defintion
+ be positioned before the call to that function in the
+ polyfill_pp() function. (At least one of my MS compilers
+ insists on this.)
+ Fixing that also should have eradicated a "conflicting types
+ for 'polyfill'" warning that gcc was emitting.
+
+ Lib/Image2D/image2d.pd | 375 ++++++++++++++++++++++++------------------------
+ 1 files changed, 188 insertions(+), 187 deletions(-)
+
+commit 8fb45960c251edeeb3c4379aae230d97f5d85e25
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Wed Jul 25 13:37:20 2012 +1000
+
+ t/callext.t Unlink callext.pdb.
+
+ With one MS compiler (that I know of) the callext.t
+ tests fail if there exists a 'callext.pdb' from an
+ earlier build of PDL (that was done using a
+ different MS Compiler)
+
+ t/callext.t | 5 ++++-
+ 1 files changed, 4 insertions(+), 1 deletions(-)
+
+commit 0f57385f0dafef3140b37dd971168e322bd08a89
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Wed Jul 25 13:37:19 2012 +1000
+
+ t/pdl_from_string.t "TODO" some tests with ActivePerl/MS Compilers
+
+ Allows PDL to build on ActivePerl without any test failures.
+ (Some of these "TODO" tests already pass with some versions of
+ ActivePerl and some Microsoft compilers.)
+
+ t/pdl_from_string.t | 164 +++++++++++++++++++++++++++++++++++----------------
+ 1 files changed, 112 insertions(+), 52 deletions(-)
+
+commit 335023d70aaa4b82930186e86ee35d16652deb66
+Author: Tim Haines <communist.goatboy at gmail.com>
+Date: Sun Jul 22 19:36:01 2012 -0400
+
+ merge in pnpoly algorithm into PDL::Image2D
+
+ This commit represents the work by Tim Haines to
+ implement a PP version of the pnpoly algorithm and
+ to add that as an optional engine for the polyfill
+ and polyfillv routines.
+
+ Basic/Pod/PP.pod | 24 +++++
+ Lib/Image2D/image2d.pd | 230 ++++++++++++++++++++++++++++++++++++++---------
+ t/image2d.t | 20 ++++-
+ 3 files changed, 229 insertions(+), 45 deletions(-)
+
+commit 3cff6f134cff8e38570822b18d4a02d93b540e39
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 17 19:32:28 2012 -0400
+
+ Add ENVI file format bailout for PDL::IO::FlexRaw
+
+ Since the filename + header file convention is the
+ same for PDL::IO::FlexRaw files and for ENVI format
+ files, I've added a check for ENVI and a bailout if
+ this is not a PDL::IO::FlexRaw format file.
+
+ I expect to replace this by a call to readenvi at
+ some point to smooth things out.
+
+ IO/FlexRaw/FlexRaw.pm | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit 903377a96846adfb946df659a0cdaef3d4452945
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 17 19:23:28 2012 -0400
+
+ Fix confusing wrap in FlexRaw.pm
+
+ IO/FlexRaw/FlexRaw.pm | 3 +--
+ 1 files changed, 1 insertions(+), 2 deletions(-)
+
+commit 966f826a1a88055f1cc88a5b6e03f08fa95f438f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 16 13:46:52 2012 -0400
+
+ Update Known_problems
+
+ Added new sf.net bugs including one re the failure of barf
+ to generate traceback output in perldl. This was due to a
+ change in perl exception handling starting with perl 5.14.0.
+ The work around is to install Devel::REPL so that you can
+ use the new pdl2 shell (NOTE: if you don't have Devel::REPL
+ installed, then pdl2 will run perldl for you instead---with
+ the problem mentioned here).
+
+ Known_problems | 15 ++++++++++++---
+ 1 files changed, 12 insertions(+), 3 deletions(-)
+
+commit 83543cc85c07ae19c6188f3ba3e80306c479e6b6
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sat Jul 14 17:54:01 2012 +1000
+
+ t/pdl_from_string.t Fix some nan tests for Windows
+
+ That is, fix as best I can.
+
+ t/pdl_from_string.t | 36 ++++++++++++++++++++++++++++++------
+ 1 files changed, 30 insertions(+), 6 deletions(-)
+
+commit 7c0ec563f1238fd8172571dae81b592eff850542
+Author: Tim Jenness <t.jenness at jach.hawaii.edu>
+Date: Tue Jul 10 15:11:16 2012 -0700
+
+ Remove PDL::IO::NDF from main distribution
+
+ Now available on CPAN as a separate download. A separate git
+ repository is also available.
+
+ Basic/Pod/BadValues.pod | 2 -
+ Basic/Pod/Modules.pod | 3 +-
+ IO/IO.pod | 3 +-
+ IO/Makefile.PL | 2 +-
+ IO/NDF/Makefile.PL | 21 -
+ IO/NDF/NDF.pm.PL | 1634 -----------------------------------------------
+ MANIFEST | 3 -
+ t/ndf.t | 84 ---
+ 8 files changed, 5 insertions(+), 1747 deletions(-)
+
+commit 05c24fb8b0fde8629bccc6109dbfba59caa6ee13
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 9 10:44:19 2012 -0400
+
+ Add t/unpdl.t to MANIFEST
+
+ MANIFEST | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 5ea80223ba548c87d0c9e6c916c59b9df4b340d0
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Sun Jul 8 15:01:30 2012 -0600
+
+ Add note to OPTIMIZE advising the addition of -O0 to -g.
+
+ This addresses SF bug #3465663. When I set OPTIMIZE to
+ '-O0 -g', built and installed PDL, and examined a
+ segfault-produced core dump in gdb, I get full information
+ for the PDL functions (including line numbers for pdlcore.c),
+ but of course not for the Perl functions because my Perl was
+ not compiled with -g.
+
+ perldl.conf | 10 ++++++----
+ 1 files changed, 6 insertions(+), 4 deletions(-)
+
+commit 4e4e096799509f0b406adbc266bd3fdf84b27d9e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 7 12:53:34 2012 -0400
+
+ Re-enable t/gd_oo_tests.t for AMD/BSD
+
+ This will allow development versions of PDL to
+ show the symptom with the hopes of providing
+ enough info to debug the problem for the developer.
+ Also, replaced print by diag in test output.
+
+ t/gd_oo_tests.t | 24 ++++++++++++------------
+ 1 files changed, 12 insertions(+), 12 deletions(-)
+
+commit 537a00d7b34b332b5b69d3a31d3dcc02255a4b4c
+Merge: cbda0ce 23212d2
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Jul 6 17:00:51 2012 -0500
+
+ Merged Joel's work on the new unpdl method.
+
+commit cbda0cec6ad350f2aa750ea7543f132537990d1e
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Jul 6 17:00:18 2012 -0500
+
+ Merge branch 'master', remote-tracking branch 'origin/master'
+
+commit bdec3fa4b6f4a4e43f71447f362e528dfcda0863
+Merge: 92844b4 a3e4397
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Jul 6 11:56:40 2012 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 92844b4f87362996f5e9f526c3a158f45aa149e3
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Jul 6 11:55:15 2012 -0600
+
+ fix a minor POD formatting issue.
+
+ Basic/Core/Core.pm.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit a3e4397a49c5a16847c228eaacdc8d727e65ab47
+Author: Tim Haines <communist.goatboy at gmail.com>
+Date: Tue Jul 3 14:20:13 2012 -0400
+
+ make qsort[vec] inplace aware
+
+ Applying the patch by Tim Haines. Thanks.
+
+ Basic/Ufunc/ufunc.pd | 2 ++
+ t/ufunc.t | 26 +++++++++++++++++++++++++-
+ 2 files changed, 27 insertions(+), 1 deletions(-)
+
+commit 88a9fff40ad7731d97b499e1e0e13af083f39246
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue Jul 3 20:12:37 2012 +1000
+
+ MANIFEST - add t/lgamma.t
+
+ MANIFEST | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit b67e2e9536ddecbb4e5392700ee115824dd22993
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue Jul 3 18:57:44 2012 +1000
+
+ Add lgamma() implementation for MinGW-built perls.
+
+ The MinGW ports of gcc provide an lgamma() function.
+ Let's make use of it - as has already been done for
+ *nix systems.
+
+ Basic/Math/math.pd | 77 ++++++++++++++++++++++++++++++++-------------------
+ 1 files changed, 48 insertions(+), 29 deletions(-)
+
+commit 3f9928fe4c638aa9d84b89e0087455125134a493
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue Jul 3 18:57:43 2012 +1000
+
+ Provide (basic) testing for lgamma function.
+
+ Previously untested.
+
+ t/lgamma.t | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 49 insertions(+), 0 deletions(-)
+
+commit 000212d92e2acbf24fb6d744be027bed20a636ed
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Jul 2 23:50:24 2012 -0500
+
+ Fixed nan sign issue, as reported by Matthew McGillis
+
+ I had noticed that pdl-from-string always said that 'nan' had a
+ minus sign, but I didn't bother much about it. Matthew McGillis
+ not only knew better, but wrote a patch to fix the situation,
+ which is applied here.
+
+ The only remaining issue is now the sign of -0, which Matthew
+ included in his tentative test suite but which does not appear to
+ work on my machine. Further investigations are needed...
+
+ Basic/Core/Core.pm.PL | 24 ++++++++++++++++++------
+ t/pdl_from_string.t | 12 +++++++++---
+ 2 files changed, 27 insertions(+), 9 deletions(-)
+
+commit 19979b1ca8784cb3c43469cc49e50b30b8710624
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Jul 2 23:19:30 2012 -0500
+
+ Minor cleanups to pdl_from_string.t, inline-comment-test.t
+
+ While working on a few other files in the test suite, I came across
+ the code in inline-comment-test.t that is supposed to ensure that
+ the tests are only run on machines that are configured properly to
+ execute the tests. The code was a bit confusing, so I cleaned it up
+ in a way that I hope makes it easier for others to follow in the
+ future.
+
+ I also expanded the explanation of the test that is given at the
+ top of pdl_from_string, since support for inf and nan values is
+ now one of the goals of the pdl-from-string behavior.
+
+ t/inline-comment-test.t | 45 +++++++++++++++++++++++++--------------------
+ t/pdl_from_string.t | 8 ++++----
+ 2 files changed, 29 insertions(+), 24 deletions(-)
+
+commit 23212d2a48fcab0c9b9efb7fa6e0920017839bda
+Author: Joel Berger <joel.a.berger at gmail.com>
+Date: Sat Jun 30 17:51:54 2012 -0500
+
+ Added unpdl method
+
+ The unpdl method is roughly an inverse of the pdl constructor.
+ It takes a piddle and returns a reference to a Perl array containing
+ a dimensionally equivalent structure of nested arrays. This complements
+ the list method, which returns a flattened list
+ of Perl scalars.
+
+ Basic/Core/Core.pm.PL | 68 ++++++++++++++++++++++++++++++++++++++++++++++--
+ t/unpdl.t | 18 +++++++++++++
+ 2 files changed, 83 insertions(+), 3 deletions(-)
+
+commit 8aabc20852f292f6ca9183c070655708203e50b3
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu Jun 28 23:50:52 2012 -0500
+
+ Fixed and CPANified POD in Basic/Core/Core.pm
+
+ The file Basic/Core/Core.pm.PL generates the text of the Core.pm
+ file. If any errors arose in Core.pm, they were reported from the
+ line number of Core.pm, not Core.pm.PL. Commit db274c02 was
+ supposed to fix that. Unfortunately, it also introduced a few
+ messed up lines in the resulting documentation due to lack of
+ proper pod directives. This commit not only fixes those pod
+ directives, but it also CPANifies Core.pm.PL so that readers on
+ CPAN can read the documentation and get a good facsimile of what
+ they'll read from their own machine.
+
+ Basic/Core/Core.pm.PL | 140 +++++++++++++++++++++++++++++++++++++++++++------
+ 1 files changed, 123 insertions(+), 17 deletions(-)
+
+commit 6210b499241c41510d1961f9a882b5ebba51685b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jun 14 09:14:08 2012 -0400
+
+ Add :lvalue to polyfillv declaration
+
+ Lib/Image2D/image2d.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 646394c9b46c2458e13f1a64a2d8304c86f500de
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 4 16:46:17 2012 -0400
+
+ Apply patch adding more RNG's to PDL::GSL
+
+ Thanks to John Lapeyre.
+
+ Lib/GSL/RNG/gsl_random.pd | 55 +++++++++++++++++++++++++++++++-------------
+ 1 files changed, 39 insertions(+), 16 deletions(-)
+
+commit 5fa882961988b3a7e4933bf0da6cb03ced178999
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu May 31 09:26:10 2012 +0200
+
+ [deb 2.4.11] update changelog up to 2.4.11-4
+
+ debian/changelog | 13 +++++++++++++
+ 1 files changed, 13 insertions(+), 0 deletions(-)
+
+commit cbca21383acb3e2769da7f886f2aec44d3613675
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu May 31 09:24:18 2012 +0200
+
+ [deb 2.4.11] explicitely set -fPIC when compiling fortran code
+
+ debian/f77conf.pl | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit ddc5507ba2f032cbc1ab29882b019c54cb5a362b
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu May 31 09:23:41 2012 +0200
+
+ [deb 2.4.11] fix dh_pdl
+
+ debian/dh_pdl | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit aa5f78a1e4db03b404d18836a7a7220e8f08fc2f
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon May 28 16:20:54 2012 +0200
+
+ update debian/changelog from 2.4.11-2 upload
+
+ debian/changelog | 8 ++++++++
+ 1 files changed, 8 insertions(+), 0 deletions(-)
+
+commit 2b5065921f6429f13e390694b729dd03576940d2
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon May 28 16:20:30 2012 +0200
+
+ override lintian warnings about images in /usr/lib
+
+ debian/pdl.lintian-overrides | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit ecee50031c591854b9ca3678d9a81afb1f46a59c
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon May 28 16:17:46 2012 +0200
+
+ install dh_pdl manpage
+
+ debian/pdl.manpages | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 6913ca40d16702a7653475b1525c37e0521fe317
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Mon May 28 13:26:57 2012 +1000
+
+ win32/INSTALL Update info/instructions
+
+ win32/INSTALL | 109 ++++++++++-----------------------------------------------
+ 1 files changed, 19 insertions(+), 90 deletions(-)
+
+commit 7361148972b6eafdd2e3128dff1499a3df474671
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun May 27 18:09:44 2012 +0200
+
+ call croak always with string literal to silence gcc format-security wanrings
+
+ fix calls to croak in Lib/GIS/Proj/Proj.pd and IO/GD/GD.pd (croak
+ was not called with a format string literal, causing
+ -Werror=format-security to abort the compilation)
+
+ IO/GD/GD.pd | 66 ++++++++++++++++---------------------------------
+ Lib/GIS/Proj/Proj.pd | 42 ++++++++++---------------------
+ 2 files changed, 36 insertions(+), 72 deletions(-)
+
+commit 59b23d51199463df029db5d3173d84a9ac7b008f
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat May 26 13:08:48 2012 +0200
+
+ [deb 2.4.11] update debian/changelog
+
+ debian/changelog | 17 +++++++++++++++++
+ 1 files changed, 17 insertions(+), 0 deletions(-)
+
+commit a9b89de98b9378ac17b7097469ded34348507eeb
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat May 26 13:02:26 2012 +0200
+
+ [deb 2.4.11] avoid double installation of upstream changelogs
+
+ dh_installchangelogs installs Changes now, unlike at the time I
+ introduced it
+
+ debian/pdl.docs | 2 --
+ debian/rules | 2 +-
+ 2 files changed, 1 insertions(+), 3 deletions(-)
+
+commit c362b006bc71f0857190a93b7697098816117b24
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat May 26 13:00:04 2012 +0200
+
+ [deb 2.4.11] honor FFLAGS and LDFLAGS env vars in f77 setup
+
+ debian/f77conf.pl | 8 ++++++--
+ 1 files changed, 6 insertions(+), 2 deletions(-)
+
+commit 99b9e7d6804e57e5a4cac36e2474779dd70ae438
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat May 26 12:53:57 2012 +0200
+
+ [deb 2.4.11] add dh_pdl debhelper script
+
+ packages depending on pdl should use dh_pdl to get the right
+ dependencies on pdl and, in case of XS/PDL::PP packages, on
+ pdlapi-$PDL_CORE_VERSION
+
+ debian/dh_pdl | 127 ++++++++++++++++++++++++++++++++++++++++++++++++++++
+ debian/pdl.install | 1 +
+ debian/rules | 3 +-
+ 3 files changed, 130 insertions(+), 1 deletions(-)
+
+commit 0178db29ef5ebc0510df255b3f71ff5182b2ff43
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat May 26 11:57:44 2012 +0200
+
+ [deb 2.4.11] introduce virtual package pdlapi-$PDL_CORE_VERSION
+
+ Core version is saved to $PDL::Config::Debian::pdl_core_version by
+ an ugly hack using Inline::pdlpp on the pdl instance in 'blib'.
+
+ debian/control | 2 ++
+ debian/rules | 6 +++++-
+ debian/write_config_debian.pl | 23 +++++++++++++++++++++++
+ 3 files changed, 30 insertions(+), 1 deletions(-)
+
+commit a777c5c8c652fec300d0c0644d33aa7709f87ae3
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat May 26 11:47:33 2012 +0200
+
+ [deb 2.4.11] use dh_auto_configure to call Makefile.PL
+
+ Makefiles are written with the correct flags set, as dh_auto_configure
+ maps CFLAGS/LDFLAGS to the correct EU::MM vars.
+
+ debian/rules | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 81bd76595dff0753a94e58432e681ab49faf8c7b
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat May 26 11:47:00 2012 +0200
+
+ [deb 2.4.11] switch to dpkg-buildflags to obtain build flags
+
+ debian/control | 1 +
+ debian/rules | 10 +++++++---
+ 2 files changed, 8 insertions(+), 3 deletions(-)
+
+commit 801fa40457e3a949eba7fe13713ff1ffa35856f3
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat May 26 11:25:44 2012 +0200
+
+ [deb 2.4.11] use 'folded' format for package relations fields
+
+ folded format is a lot easier to diff...
+
+ debian/control | 46 ++++++++++++++++++++++++++++++++++++++++++----
+ 1 files changed, 42 insertions(+), 4 deletions(-)
+
+commit c2683384cf486b892639b43b697b3f015c9c673a
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat May 26 11:20:16 2012 +0200
+
+ [deb 2.4.10] import changes by Jari Aalto <jari.aalto at cante.net>
+
+ * Remove deprecated dpatch and upgrade to packaging format "3.0 quilt".
+ * Update to Standards-Version to 3.9.3 and debhelper to 9.
+ * Add build-arch and build-indep targets; use dh_prep in rules file.
+ * Fix copyright-refers-to-symlink-license (Lintian).
+ * Fix duplicate-in-relation-field libastro-fits-header-perl (Lintian).
+ * Fix unused-override (Lintian).
+
+ debian/README.source | 14 --------------
+ debian/changelog | 14 +++++++++++++-
+ debian/compat | 2 +-
+ debian/control | 8 ++++----
+ debian/copyright | 2 +-
+ debian/patches/00list | 1 -
+ debian/patches/series | 1 +
+ debian/rules | 16 ++++++++--------
+ debian/source.lintian-overrides | 4 ----
+ debian/source/format | 1 +
+ 10 files changed, 29 insertions(+), 34 deletions(-)
+
+commit fd8126a01ca782f6da2c3906e855b749b03829e0
+Author: Henning Glawe <glaweh at debian.org>
+Date: Fri May 25 09:25:28 2012 +0200
+
+ [deb 2.4.10] update debian changelog from 2.4.10+dfsg-1 upload
+
+ debian/changelog | 24 +++++++++++++++++++++++-
+ 1 files changed, 23 insertions(+), 1 deletions(-)
+
+commit 2ec47d788cf35b5f588158a186bd7670fe74c0f5
+Author: Henning Glawe <glaweh at debian.org>
+Date: Fri May 25 09:22:10 2012 +0200
+
+ [deb 2.4.10] update debian/perldl.conf from upstream perldl.conf
+
+ debian/perldl.conf | 66 +++++++++++++++++++--------------------------------
+ 1 files changed, 25 insertions(+), 41 deletions(-)
+
+commit 4daf0bd369f101214acdd8cb80d15798dd6c988f
+Author: Henning Glawe <glaweh at debian.org>
+Date: Fri May 25 09:19:41 2012 +0200
+
+ [deb 2.4.10] silence lintian warning about empty dpatch list
+
+ debian/source.lintian-overrides | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit c82890c79bcdcd1318c2cd653ca12f22b996221e
+Author: Henning Glawe <glaweh at debian.org>
+Date: Fri May 25 09:16:54 2012 +0200
+
+ [deb 2.4.10] ignore lintian warning about too long line in FFT manpage
+
+ debian/pdl.lintian-overrides | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 554d277b2de7b54e2037fd78ebd410a15ada20e9
+Author: Henning Glawe <glaweh at debian.org>
+Date: Fri May 25 09:15:28 2012 +0200
+
+ [deb 2.4.10] include release notes and upstream changes in docs
+
+ debian/pdl.docs | 4 +++-
+ 1 files changed, 3 insertions(+), 1 deletions(-)
+
+commit 6eed699a000c3fa792ed73a80e460f94e62cce15
+Author: Henning Glawe <glaweh at debian.org>
+Date: Fri May 25 09:13:59 2012 +0200
+
+ [deb 2.4.10] comment purpose of patch list
+
+ debian/patches/00list | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 88fce7e87d709d40baf99afbfac246c74c9b7883
+Author: Henning Glawe <glaweh at debian.org>
+Date: Fri May 25 09:11:40 2012 +0200
+
+ [deb 2.4.10] update minimum libopengl-perl requirement
+
+ debian/control | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit b7ab80b580e96cb5ed95dce27691aafecdcd397f
+Merge: ea4224c 26021f0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 21 14:45:07 2012 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit 26021f0c628e4095ea1385bf7409b6d5c865eb70
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 21 14:24:57 2012 -0400
+
+ Add ASCII table load <-> rcols equivalence to MATLAB.pod
+
+ Basic/Pod/MATLAB.pod | 11 ++++++++++-
+ 1 files changed, 10 insertions(+), 1 deletions(-)
+
+commit 4e8cb0e051c956ac79050d4c5617cdb7518d35cd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 20 14:20:45 2012 -0400
+
+ Update $PDL::VERSION to 2.4.11_001 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 4773c96763f3f9450382fe97d951f653eb2ae94c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 20 13:32:17 2012 -0400
+
+ comment out local $TODO in t/limits_trans_err.t
+
+ Commenting out the TODO: block is not enough since the
+ $TODO then applies to the entire file.
+
+ t/limits_trans_err.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2afa1aff0b507ad71888a0367b36444b91128c4b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 20 12:45:07 2012 -0400
+
+ Clean up of Known_problems and Release_Notes for 2.4.11 release
+
+ Known_problems | 25 +++++++++----------------
+ Release_Notes | 39 ++++++++++++++++++---------------------
+ 2 files changed, 27 insertions(+), 37 deletions(-)
+
+commit 99266da83eacccec92b076eb1f327b5e18b53fe2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 20 12:44:27 2012 -0400
+
+ Update pdl2 version and load PDL::Config by default
+
+ Perldl2/Profile/Perldl2.pm | 5 ++++-
+ 1 files changed, 4 insertions(+), 1 deletions(-)
+
+commit e4e331d9b6a46145172c35633fffc23b19d9cd2b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 19 18:29:23 2012 -0400
+
+ Comment out t/inline-comment-test.t in MANIFEST for 2.4.11 release
+
+ Will re-enable as a test after the stable release.
+
+ MANIFEST | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 9d1203ff17eefed2343422d094f5023581b9555a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 19 18:27:37 2012 -0400
+
+ Re-enabling the t/limits_trans_err.t test (not as TODO)
+
+ It looks like the fix to Limits.pm by sisyphus has also fixed
+ the test fails for this set of tests.
+
+ t/limits_trans_err.t | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 52428d52bcd8c58f8067ab8ae43a6f2e1b7d7a13
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 19 18:26:02 2012 -0400
+
+ Update VERSION to 2.4.11 for release and readme's
+
+ Added a few more bugs fixed to Known_problems and Release_Notes.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 4 ++--
+ Release_Notes | 55 +++----------------------------------------------------
+ 3 files changed, 6 insertions(+), 55 deletions(-)
+
+commit 0c800d0860e3c1d94256a07caeed13c3eab12085
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 19 18:24:56 2012 -0400
+
+ Fix some bugs in pdl2 running perldl if Devel::REPL not installed
+
+ Perldl2/pdl2 | 6 +++++-
+ 1 files changed, 5 insertions(+), 1 deletions(-)
+
+commit b02557c6b6bd95977e102d34d424a6b365f7b416
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 18 19:32:06 2012 -0400
+
+ More pre-release updates for Known_problems/Release_Notes
+
+ Known_problems | 1 -
+ Release_Notes | 13 +++++++------
+ 2 files changed, 7 insertions(+), 7 deletions(-)
+
+commit 641ae82dbc64719eb496adecb9ae63e913bbedab
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 18 19:05:07 2012 -0400
+
+ Add better skip condition to t/flexraw_fortran.t if no fortran
+
+ The previous test checked if WITH_SLATEC was true while
+ we now check if PDL::Slatec can actually be used. My
+ guess is we aren't correctly updating the PDL::Config
+ from the PDL::Slatec build time configuration.
+
+ t/flexraw_fortran.t | 40 +++++++++++++++++++++-------------------
+ 1 files changed, 21 insertions(+), 19 deletions(-)
+
+commit f03f497a374e8e866dce54df13bd5fef21366cf0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 18 17:16:18 2012 -0400
+
+ Update Known_problems
+
+ Known_problems | 13 ++++++++-----
+ 1 files changed, 8 insertions(+), 5 deletions(-)
+
+commit 5eb33340d74a42478274dabdd7e7d2104d17490d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 16 07:01:02 2012 -0400
+
+ Update VERSION to 2.4.10_006 for final PDL-2.4.11 fixes
+
+ This is just a place holder version. It will be updated
+ to 2.4.11 when the release distribution is made. Also
+ turned off $PDL::debug in t/flexraw.t to quiet test output
+ and added info to INSTALL and Known_problems regarding the
+ problem building PDL with some MinGW gcc + win32 perl
+ configurations due to gcc crashing.
+
+ Basic/PDL.pm | 2 +-
+ INSTALL | 18 ++++++++++++++
+ Known_problems | 8 +++++-
+ Release_Notes | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ t/flexraw.t | 2 +-
+ 5 files changed, 95 insertions(+), 3 deletions(-)
+
+commit 0dd802d486f8dfdb57a658588ce8c9387ee03995
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 15 17:25:17 2012 -0400
+
+ Fix typo in Release_Notes
+
+ Release_Notes | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f02a4eff321e4f2f9d3f27a6fab4584f6699b0bf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 15 09:42:35 2012 -0400
+
+ Update Known_problems and Release_Notes for PDL-2.4.10_005
+
+ This is PDL-2.4.11 rc2.
+
+ Known_problems | 19 +++++-----------
+ Release_Notes | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++--
+ 2 files changed, 65 insertions(+), 16 deletions(-)
+
+commit 008c94e72fe7e673d497222e5ce8834d451c1152
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue May 15 23:37:26 2012 +1000
+
+ Graphics/Limits.pm - Fix cross-platform inconsistency
+
+ The round_pow was in need of a minor tweak. On some
+ platforms round_pow was returning a value that was
+ *equal* to the given value. I'm assuming that such a
+ value is not allowed. (Certainly none of the tests
+ expect such a value to be returned.)
+
+ Graphics/Limits/Limits.pm | 58 +++++++++++++++++++++++---------------------
+ 1 files changed, 30 insertions(+), 28 deletions(-)
+
+commit c1d747f8309567efc4b4367a2d5c0f36ee902402
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 15 07:19:52 2012 -0400
+
+ Force $eps for approx() in t/limits_round.t
+
+ I think the reason some platforms are failing is that
+ the epsilon for approx() is too small. Since approx
+ remembers the last value used, if this is within a single
+ perl session, that could explain the problem. I've
+ added logic to force a reasonable value, 1.0e-6 or so.
+
+ t/limits_round.t | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 1e147070b8ea7de10f3a44bac714818b35a6709f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 14 17:18:38 2012 -0400
+
+ Update DEPENDENCIES and Known_problems for PDL-2.4.11
+
+ DEPENDENCIES | 4 ++--
+ Known_problems | 3 +++
+ 2 files changed, 5 insertions(+), 2 deletions(-)
+
+commit ea4224cfa2b1ae3a0d87f55aeb7e8de872d8bc7c
+Merge: cce9a44 d90cc14
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 14 15:39:42 2012 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit d90cc142360c32dbd33bdfb39a74b63061fc5841
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 14 15:37:22 2012 -0400
+
+ skip t/inline-comment-test.t on BSD to avoid sf.net #3518190
+
+ TODO skips only work if the test can't cause a SEGFAULT.
+ When building Inline code, that is always possible.
+
+ t/inline-comment-test.t | 4 +++-
+ 1 files changed, 3 insertions(+), 1 deletions(-)
+
+commit d863355d1c30cc0744a4c4e28b5b59f0fca4e802
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 14 15:26:15 2012 -0400
+
+ skip t/gd_oo_tests.t on Dragonfly BSD to avoid sf.net #3518190
+
+ The previous skip pattern failed because $^O for Dragonfly BSD
+ is dragonfly (and not something ending with BSD).
+
+ t/gd_oo_tests.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit cce9a449fbb51ad8777ac4593cf1c9f9030e03eb
+Merge: 375b3aa 8fca2d9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 13 19:36:38 2012 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit 375b3aafecea1628130f830a8f6debd08eb575b5
+Merge: a802570 902b02b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 13 19:33:50 2012 -0400
+
+ Merge branch '64bit-index-support' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl into 64bit-index-support
+
+commit 8fca2d94182d8977cb2065955433c26dd5f872f4
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sun May 13 17:00:22 2012 +1000
+
+ IO/FlexRaw.pm - Remove the "No SIGBUS" warning on Windows
+
+ Simply changed:
+ local $SIG{BUS} = \&myhandler;
+ to
+ local $SIG{BUS} = \&myhandler unless $^O =~ /MSWin32/i;
+ (Doesn't seem to alter the scope of the 'local' call.)
+
+ IO/FlexRaw/FlexRaw.pm | 38 +++++++++++++++++++-------------------
+ 1 files changed, 19 insertions(+), 19 deletions(-)
+
+commit 5beaca70ee002a69f1c0839a3fefe90e14ab7382
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sun May 13 15:45:41 2012 +1000
+
+ Remove deprecation warning in PGPLOT/Window/Window.pm
+
+ With perl-5.16 a deprecation warning was being emitted in
+ relation to a "defined(@array)".
+ At line 4416, changed:
+ if (defined(@{$self->{_env_options}})) {
+ to
+ if (@{$self->{_env_options}}) {
+
+ Graphics/PGPLOT/Window/Window.pm | 650 +++++++++++++++++++-------------------
+ 1 files changed, 325 insertions(+), 325 deletions(-)
+
+commit 902b02bd0e6167858cbbfa00f0fc5b91db8798d3
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sun May 13 14:56:21 2012 +1000
+
+ Remove deprecation warning in PGPLOT/Window/Window.pm
+
+ With perl-5.16 a deprecation warning was being emitted in
+ relation to a "defined(@array)".
+ At line 4416, changed:
+ if (defined(@{$self->{_env_options}})) {
+ to
+ if (@{$self->{_env_options}}) {
+
+ Graphics/PGPLOT/Window/Window.pm | 650 +++++++++++++++++++-------------------
+ 1 files changed, 325 insertions(+), 325 deletions(-)
+
+commit a802570dd6b1b859a615525fdf06f113ed8492de
+Merge: 858df9b 19fd7c2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 12 11:37:44 2012 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit 19fd7c2db9107e59cb2143fa49d76b3df8a23511
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 12 09:18:28 2012 -0400
+
+ Update version to 2.4.10_005
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit b4355398e1d2ac97e69a772ea04a1fb169ca2445
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 12 09:15:14 2012 -0400
+
+ Update MANIFEST for 2.4.10_004 CPAN devel release
+
+ MANIFEST | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 37bd0e04a4a4c82d10b43e3168829d9921f02e0e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 12 08:38:36 2012 -0400
+
+ Update Known_problems and Release_Notes
+
+ Known_problems | 16 ++++++++++------
+ Release_Notes | 6 ++++++
+ 2 files changed, 16 insertions(+), 6 deletions(-)
+
+commit ef70276bfcba38c205d3d6d2f3673e92e2e17283
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 12 08:37:32 2012 -0400
+
+ skip t/gd_oo_tests.t on BSD OS to avoid sf.net #3518190
+
+ t/gd_oo_tests.t | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit 7685fa73c53ab2135ed856c3da79dacdb3ff23c8
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri May 11 15:04:36 2012 -0500
+
+ Paired down some barfing/croaking text in PDL::Core
+
+ Dima's updates a couple of years ago switched PDL's barf to use a stack trace,
+ at least in PDL::Core. This becomes a problem for some functions that re-barf.
+ This minor patch to Core.pm.PL udpates the barfing behavior to use croak where
+ appropriate.
+
+ It also changes the definition of PDL::Core::barf to goto() Carp::confess
+ instead of simply calling it. The latter behavior resulted in an erroneous line
+ at the top of the stack trace pointing (uselessly) to the definition of
+ PDL::Core::barf.
+
+ Basic/Core/Core.pm.PL | 25 +++++++------------------
+ 1 files changed, 7 insertions(+), 18 deletions(-)
+
+commit 858df9bfe3f4173c6cd14974cdb8734542e2c31f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 9 13:40:07 2012 -0400
+
+ Make oldlen cast be PDL_Index in pdlcore.c and add diag() to t/slice.t
+
+ Basic/Core/pdlcore.c.PL | 2 +-
+ t/slice.t | 53 +++++++++++++++++++++++------------------------
+ 2 files changed, 27 insertions(+), 28 deletions(-)
+
+commit 02a2351e2ba29aeb5c079a9f07bc86ca2f9838eb
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 8 09:45:35 2012 -0400
+
+ Change strtol to strtoll in slices.pd
+
+ I hope this will fix some of the failures from
+ slicing operations reported by Ingo. Still have
+ other issues but still no-one able to directly
+ debug on a 64bit system.
+
+ If you have a 64bit system, more than 4GB of memory
+ and are able to perform PDL+XS/PP debugging, your help
+ would be greatly appreciated. It is *very* difficult
+ to make progress without being able to gdb or printf
+ to locate the source of fails. I think we're getting
+ close but until the low level stuff is working, we're
+ not able to merge these hardwired 64bit support mods
+ into the master.
+
+ Basic/Slices/slices.pd | 10 +++++-----
+ 1 files changed, 5 insertions(+), 5 deletions(-)
+
+commit 8de38c3f09814ec93da1cd8d0eefd051b20e6573
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon May 7 12:04:12 2012 -0500
+
+ Marked comment wart test as TODO (bug #3524081)
+
+ t/inline-comment-test.t | 13 +++++++++----
+ 1 files changed, 9 insertions(+), 4 deletions(-)
+
+commit 0c11c4576ceadcaf449ee210455131fa95061792
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon May 7 09:40:25 2012 -0500
+
+ Applied sprout's fix for rt #76577, sf.net bug 3518253
+
+ Basic/Core/Core.pm.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3779ba7f5880de92605342a19889c7e74fba7aef
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 4 14:13:17 2012 -0400
+
+ More PDL_Index fixes to slices.pd
+
+ Progress is being made but I think there are still some
+ declarations that may not be quite right.
+
+ Basic/Slices/slices.pd | 62 ++++++++++++++++++++++++------------------------
+ 1 files changed, 31 insertions(+), 31 deletions(-)
+
+commit f258d4381c5506b1619c3bc69ab6faa2edfcc4af
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu May 3 17:45:12 2012 -0400
+
+ Update pdl_allocdata and pdl_grow to use PDL_Index
+
+ The pdl_allocdata fix is needed to allocate large piddles.
+ The pdl_grow change to use PDL_Index type rather than
+ STRLEN for the element count is appropriate now that
+ we have a PDL_Index type to use.
+
+ Basic/Core/pdlapi.c | 2 +-
+ Basic/Core/pdlcore.h.PL | 4 ++--
+ Basic/Core/pdlhash.c | 2 +-
+ 3 files changed, 4 insertions(+), 4 deletions(-)
+
+commit fd4bb5baa29e898cd0d293dc79e6c769feb70cf4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 2 18:12:40 2012 -0400
+
+ Make rangeb et al coerce index to PDL_Index now instead of long
+
+ Again, this is hardwired for now. Still, it eliminates a couple
+ more test failures....
+
+ Basic/Slices/slices.pd | 14 +++++++-------
+ 1 files changed, 7 insertions(+), 7 deletions(-)
+
+commit 535aab25764153989091acb6e0ec596a8b57e973
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 1 16:19:14 2012 -0400
+
+ More 64bit index fixes: PP, Slices, Ufunc, Storable
+
+ Add more fixes to the PP code generation and to some of the
+ XS/PP modules to introduce the new PDL_Index datatype. The
+ 64bit-index-support branch is currently hardwired for PDL_Index
+ type being 'long long'. Not all tests are passing but if
+ you have a 64bit platform it should build and run (somewhat).
+
+ Basic/Gen/PP.pm | 2 +-
+ Basic/Slices/slices.pd | 102 +++++++++++++++++++++++-----------------------
+ Basic/Ufunc/ufunc.pd | 12 +++---
+ IO/Storable/storable.pd | 2 +-
+ 4 files changed, 59 insertions(+), 59 deletions(-)
+
+commit a4e8dcb8c7ccd67492f53a160716615fee39387e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Apr 30 17:54:25 2012 -0400
+
+ More 64bit index support and PP code generation fixes
+
+ Testing with typedef long long PDL_Index flushed out a bunch
+ more places where indexing type changes affect the PDL code.
+ Once the Core routines built without error, work continued
+ with fixing types in PP code generation. Work is still underway
+ but now a bunch of the tests pass with 77/781 subtests failed!
+
+ Basic/Core/Core.xs.PL | 11 +++++----
+ Basic/Core/pdl_hfiles.p | 2 +-
+ Basic/Core/pdlapi.c | 25 ++++++++++++-----------
+ Basic/Core/pdlcore.c.PL | 2 +-
+ Basic/Core/pdlcore.h.PL | 8 +++---
+ Basic/Core/pdlhash.c | 2 +-
+ Basic/Core/pdlsections.g | 46 ++++++++++++++++++++++++--------------------
+ Basic/Core/pdlthread.c | 44 ++++++++++++++++++++++--------------------
+ Basic/Gen/PP.pm | 4 +-
+ Basic/Gen/PP/PDLCode.pm | 14 ++++++------
+ Basic/Gen/PP/PdlParObj.pm | 2 +-
+ Basic/Ufunc/ufunc.pd | 22 ++++++++++----------
+ MANIFEST | 3 --
+ 13 files changed, 95 insertions(+), 90 deletions(-)
+
+commit 32bc994ac411e102ca1de647fa68b09abb499f10
+Merge: a9c07c9 7576911
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Apr 25 10:58:03 2012 -0400
+
+ Merge branch 'master' into 64bit-index-support
+
+commit a9c07c9db79ac121830bdcb99baf44e976a8b8f2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 24 18:09:23 2012 -0400
+
+ Hardwire typedef for PDL_Index into pdl_hfiles.p
+
+ This is enough to test the new 64bit index support by
+ hand-editing this typedef to the correct type. If that
+ is a 64bit one for your platform, everything should
+ work (eventually). Untested so far.
+
+ Basic/Core/pdl_hfiles.p | 2 +-
+ Basic/Core/pdlcore.c.PL | 2 +-
+ 2 files changed, 2 insertions(+), 2 deletions(-)
+
+commit d1a7734716b55812660160cc2982ffb7149feea4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Apr 23 17:26:31 2012 -0400
+
+ Make perldl.conf with no extensions selected for Core debugging
+
+ After the basic 64bit support is working for the core, then we'll
+ add back the extensions to confirm/fix any issues there.
+
+ perldl.conf | 18 +++++++++---------
+ 1 files changed, 9 insertions(+), 9 deletions(-)
+
+commit 4579b827ba6197572edff3a8aabb637c51f8f806
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Apr 23 17:24:34 2012 -0400
+
+ Minor fixes to get new Core/* to build
+
+ This involved adding an entry for PDL_Index to typemap, making the
+ declaration of pdl_grow consistent (to STRLEN) and hand-adding a
+ typedef for PDL_Index to pdl.h. This needs to be replaced by an
+ automatic configuration eventually.
+
+ Basic/Core/Core.xs.PL | 2 +-
+ Basic/Core/pdlhash.c | 2 +-
+ Basic/Core/typemap | 1 +
+ 3 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 2adb1af3bb41caea2530bf070a360d2540c4c452
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Apr 23 16:22:49 2012 -0400
+
+ Preliminary set of 64bit index support modes to Basic/Core
+
+ The first stage of the conversion of PDL indexing to support 64bit
+ platforms is to replace all usages of int, long, and PDL_Long that
+ are actually indexes into piddles (or the equivalents: dimension
+ lengths, nvals, ...) by a new PDL_Index datatype that is determined
+ at build time to correspond to the supported index/pointer sizes for
+ a given platform.
+
+ This first set of conversions is all by inspection and I expect
+ problems to show up on the first build tests. Specifically, there
+ will need to be defined the printf format appropriate to PDL_Index
+ on a given platform that will need to be used for the built in
+ diagnostics.
+
+ For configuration, the interesting parameters from %Config are:
+ - lseeksize and lseektype for file offsets
+ - sizesize and sizetype for memory offsets/sizes and indexing
+
+ TO CHECK: there are some usages of pdl_packint and pdl_unpackint
+ in the Core files that maybe should be using the PDL_Index type.
+
+ Basic/Core/Core.xs.PL | 49 ++++++++++++++-------------
+ Basic/Core/Types.pm.PL | 17 ++++++++++
+ Basic/Core/pdl.h.PL | 16 ++++----
+ Basic/Core/pdlconv.c.PL | 3 +-
+ Basic/Core/pdlcore.c.PL | 67 +++++++++++++++++++-------------------
+ Basic/Core/pdlcore.h.PL | 79 +++++++++++++++++++++++----------------------
+ Basic/Core/pdlsimple.h.PL | 10 +++---
+ Basic/Core/pdlthread.h | 12 +++---
+ 8 files changed, 137 insertions(+), 116 deletions(-)
+
+commit 757691190bb503aea6e35a98106601974fca11af
+Merge: 4002248 1f32e53
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Apr 16 11:49:27 2012 -0500
+
+ Merge branch 'master' into fix-PP-commentary
+
+commit 40022485a21ed1088de19c3ee795718f99e96eb1
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Apr 16 10:33:29 2012 -0500
+
+ Added a test for now-functional multiline commenting in PP code
+
+ t/inline-comment-test.t | 98 +++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 98 insertions(+), 0 deletions(-)
+
+commit 13291d98f614ab534ea2c40367973d0c9a9d3f31
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Apr 16 10:09:55 2012 -0500
+
+ Fixed PP commentary
+
+ PP generates lots of code. Some of that code is confusing at first
+ blush, so PP added C-style multiline comments to help anybody
+ examining the generated XS. Unfortunately, if a user had a bug in
+ their code's logic and attempted to debug by commenting out large
+ swaths of their PP code, the non-nesting of C-style comments would
+ invariably lead to weird compile failures.
+
+ My proposed solution is to #define the symbol PDL_COMMENT(comment),
+ thus allowing any commentary such as this:
+
+ _internal_var->value /* get some internal thing */
+
+ to be replaced with something like this:
+
+ _internal_var->value PDL_COMMENT("get some internal thing")
+
+ It's a bit more verbose, but it enables users to use multiline
+ comments in the way described above.
+
+ Basic/Gen/PP.pm | 94 +++++++++++++++++++++++++++------------------
+ Basic/Gen/PP/PDLCode.pm | 29 ++++++++------
+ Basic/Gen/PP/PdlParObj.pm | 6 ++-
+ 3 files changed, 77 insertions(+), 52 deletions(-)
+
+commit 1f32e53304e3c1f30383f0daf35495112bef0b6b
+Merge: 53d74fa 8dd65dc
+Author: olpc user <olpc at xo-4a-9c-81.localdomain>
+Date: Mon Apr 16 02:22:04 2012 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 53d74faea0707523008fa9cbe26a1403b5764693
+Author: olpc user <olpc at xo-4a-9c-81.localdomain>
+Date: Mon Apr 16 01:03:42 2012 -0400
+
+ Cleanup odds and ends in PDL/Example dir
+
+ Removed Core/new_from_string.pl since it is in Core now.
+ Renamed some examples so the name will be more descriptive
+ as far as the example program.
+
+ Example/Core/new_from_string.pl | 117 ---------------------------------
+ Example/InlinePdlpp/inlpp.pl | 2 +-
+ Example/Simplex/tsimp.pl | 50 --------------
+ Example/Simplex/tsimp_needs_pgplot.pl | 50 ++++++++++++++
+ Example/TriD/clip.pl | 111 -------------------------------
+ Example/TriD/old_trid_clip.pl | 111 +++++++++++++++++++++++++++++++
+ 6 files changed, 162 insertions(+), 279 deletions(-)
+
+commit 8dd65dc63862db5cd60aef372f1e7536625dca9f
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sun Apr 15 13:17:31 2012 -0500
+
+ Updated tests for pdl-from-string
+
+ t/pdl_from_string.t | 79 ++++++++++++++++++++++++++++++++++++++-------------
+ 1 files changed, 59 insertions(+), 20 deletions(-)
+
+commit 32592bcbab481003cb39f204eb84b71f1ca7ed04
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sat Apr 14 14:04:36 2012 -0500
+
+ Fixed (hopefully) pdl-from-string handling of inf/nan
+
+ Basic/Core/Core.pm.PL | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit 416804854108d5604c2046a145af57d253fc2fb3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 10 16:29:48 2012 -0400
+
+ Forgot the Core.pm.PL changes for previous commit
+
+ This adds some extra diagnostic output if $PDL::debug is set.
+
+ Basic/Core/Core.pm.PL | 15 +++++++++++++++
+ 1 files changed, 15 insertions(+), 0 deletions(-)
+
+commit 45005bee0c216c41e0029cc9cfe0f1a430b0c98b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 10 12:02:06 2012 -0400
+
+ Add some debug info for t/flexraw.t to display
+
+ It is hoped this will help identify the problem with the
+ cleanup reported for 64bit OpenBSDs.
+
+ t/flexraw.t | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 25f464f0af13c38e6fc041790c47f16e691e2d2a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 10 11:38:24 2012 -0400
+
+ Clean up some devel code for whereND tests in t/primitive.t
+
+ t/primitive.t | 4 +---
+ 1 files changed, 1 insertions(+), 3 deletions(-)
+
+commit 7dde9c25fc76535df8feaa552bafb001b916c875
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 10 09:11:35 2012 -0400
+
+ Revert "Revert "Revert "Lib/GIS/Proj/proj.pd - make compatible with proj-4.8.0"""
+
+ This reverts commit 1eec38574b7306328ad158a78b1094bbed3c584a.
+ Per Rob's request, taking the partial Proj.pd code out until
+ the issues with the PROJ4 development strategy can be worked
+ out.
+
+ Lib/GIS/Proj/Proj.pd | 75 +++++++++++++++++++++++--------------------------
+ 1 files changed, 35 insertions(+), 40 deletions(-)
+
+commit 1eec38574b7306328ad158a78b1094bbed3c584a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 8 22:17:37 2012 -0400
+
+ Revert "Revert "Lib/GIS/Proj/proj.pd - make compatible with proj-4.8.0""
+
+ This reverts commit b5b9b1d6da16744ecbcfba191c49f5ecf5c3744f.
+ Re-applying the compatibility fix for proj-4.8.0. It is not
+ clear what the CPAN Testers fails were from before...
+
+ Lib/GIS/Proj/Proj.pd | 75 ++++++++++++++++++++++++++-----------------------
+ 1 files changed, 40 insertions(+), 35 deletions(-)
+
+commit f6726570c65feb80fa19b92fdd8aeb248f10b84c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 7 17:22:19 2012 -0400
+
+ Update VERSION to 2.4.10_004 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit a8b720d9719b3a2af2ef22cb210e3a88d96ecb6b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 7 17:09:58 2012 -0400
+
+ Update Known_problems and Release_Notes for CPAN
+
+ Known_problems | 5 +++++
+ Release_Notes | 8 +++++++-
+ 2 files changed, 12 insertions(+), 1 deletions(-)
+
+commit 007ce76aef0a6494f2b19f681a36fa5758d44808
+Merge: e0c00d2 046f246
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 7 10:45:45 2012 -0400
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit e0c00d27c464a002360354363fa7e6f0e1e19928
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 7 09:33:30 2012 -0400
+
+ Corrected a prototype for add_deletedata_magic()
+
+ It looks like I missed one from the earlier rework
+ and I believe that is the origin of the failures in
+ execution (at all) or the "Could not unmap:..."
+
+ Basic/Core/pdlcore.h.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 046f2461456645f656d9f5fd06c6fb9492a4d2c5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 6 13:43:54 2012 -0400
+
+ Update VERSION to 2.4.10_003 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 32f23a8bf9cc2760152bedf7d63706720f6582e4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 6 13:38:09 2012 -0400
+
+ update Release_Notes and remove File/Map.pm from inc/
+
+ This is for a quick re-release of PDL fixing a broken
+ commit. I hope this allows the desired build and test
+ to work now.
+
+ Release_Notes | 6 +-
+ inc/File/Map.pm | 491 -------------------------------------------------------
+ 2 files changed, 4 insertions(+), 493 deletions(-)
+
+commit b5b9b1d6da16744ecbcfba191c49f5ecf5c3744f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 6 13:23:19 2012 -0400
+
+ Revert "Lib/GIS/Proj/proj.pd - make compatible with proj-4.8.0"
+
+ This reverts commit 98572190667fa4af90d916cf5842d574cb042238.
+ This fix is not working. Reverting for now to release another
+ CPAN Developers release so testing with new File::Map mmap can
+ occur.
+
+ Lib/GIS/Proj/Proj.pd | 75 +++++++++++++++++++++++--------------------------
+ 1 files changed, 35 insertions(+), 40 deletions(-)
+
+commit e232164f924711b1f1bc40b4ae42aa32e3090c3b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 6 10:59:51 2012 -0400
+
+ Update version to 2.4.10_002 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit b4199cbc5ce972c469b59f26f98ad43d9059b1a8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 6 09:39:41 2012 -0400
+
+ Update MANIFEST for PDL-2.4.10_001 developers release
+
+ MANIFEST | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 61bf8a1062602871c7a1c657add93f4375c9a105
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 6 09:35:30 2012 -0400
+
+ Update docs/readme-type info for PDL-2.4.10_001 release
+
+ DEPENDENCIES | 12 ++++++++++++
+ PDLdb.pl | 12 ++++++++----
+ Release_Notes | 31 ++++++++++++++++---------------
+ 3 files changed, 36 insertions(+), 19 deletions(-)
+
+commit 22b8634b01aa7bb039355b235a38d1f539306bb9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Apr 5 14:41:41 2012 -0400
+
+ Update File::Map version required to 0.47
+
+ ...and comment out the pdl_do_sys_map() routine
+ and return to the original sys_map() call for the
+ implementation of memory mapping now that the
+ bug has been fixed upstream.
+
+ Basic/Core/Core.pm.PL | 37 +++++++++++++++++++------------------
+ IO/FastRaw/FastRaw.pm | 2 +-
+ IO/FlexRaw/FlexRaw.pm | 2 +-
+ 3 files changed, 21 insertions(+), 20 deletions(-)
+
+commit b8fc63cdf4eb6092f46e0be9a1eb5f5c6b1ab767
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Apr 4 16:39:23 2012 -0500
+
+ Updated dependency to File::Map v0.47 at Leon's suggestion
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 462d80d665d90e2177dc1f4ffc2de90f18a881b7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Apr 4 17:25:49 2012 -0400
+
+ Add File::Map 0.46 as dependency for CPAN Testers
+
+ After a checkout by PDL developers, this is planned
+ to be released as a CPAN Developers release for the
+ purpose of exercising the new File::Map implementation
+ of mapflex and mapfraw as an official dependency and
+ to determine if there are any portability or availability
+ issues that might need to be addressed.
+
+ Makefile.PL | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit a4e56e6b868850772b70e215c53b4514fb0b78c0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Apr 4 17:23:32 2012 -0400
+
+ Update Release_Notes with sys_map work-around done!
+
+ Release_Notes | 26 ++++++++------------------
+ 1 files changed, 8 insertions(+), 18 deletions(-)
+
+commit 305ef32e72249ae3496949b8f1d47c6db58e949e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Apr 4 17:00:17 2012 -0400
+
+ Implement pdl_do_sys_map() work around sys_map bug
+
+ This is a cut and paste of the original File::Map::sys_map
+ routine with the bug fixed. It should be possible to strip
+ down the dependencies more for this routine if desired.
+ Maybe the File::Map author would be willing to pursue.
+
+ Basic/Core/Core.pm.PL | 23 +++++++++++++----------
+ 1 files changed, 13 insertions(+), 10 deletions(-)
+
+commit 85e1f74963a11daa5738fe05f53730a46540d3f9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Apr 4 15:43:06 2012 -0400
+
+ Make use File::Map conditional on presence
+
+ If 'use File::Map' eval-s ok, then it is used. Otherwise,
+ stubs are added to ensure the PDL::set_data_by_file_map
+ compiles correctly.
+
+ Basic/Core/Core.pm.PL | 22 +++++++++++++++++++++-
+ 1 files changed, 21 insertions(+), 1 deletions(-)
+
+commit e525615501ce229f0ff4095417fe9cd12cc5372f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 3 07:43:17 2012 -0400
+
+ Update Release_Notes re inc/File/Map.pm
+
+ Release_Notes | 7 ++++---
+ 1 files changed, 4 insertions(+), 3 deletions(-)
+
+commit 562d4e5aa67e80fac741cd0b9799a90f3e148adc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 3 07:40:36 2012 -0400
+
+ Add fixed copy of Map.pm v0.46 to git
+
+ You should be able to replace your existing Map.pm
+ file from File-Map-0.46 by this one and things should
+ work.
+
+ inc/File/Map.pm | 491 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 491 insertions(+), 0 deletions(-)
+
+commit baabaf2e4d29ea1bf6cf133c99a9c5a57c062f87
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue Apr 3 13:50:43 2012 +1000
+
+ Basic/Gen/PP.pm - add to croak() message
+
+ Have the croak() in relation to version mismatch
+ (in the BOOT section) output info relating to the
+ versions that were found.
+
+ Basic/Gen/PP.pm | 204 +++++++++++++++++++++++++++---------------------------
+ 1 files changed, 102 insertions(+), 102 deletions(-)
+
+commit 246689173bbe163366a07bebc93752269beaad22
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue Apr 3 13:50:42 2012 +1000
+
+ Basic/Core/Dev.pm - add to croak() message
+
+ Have the croak() message relating to version
+ mismatch (in PDL_BOOT) output some info on
+ versions that were found.
+
+ Basic/Core/Dev.pm | 14 +++++++-------
+ 1 files changed, 7 insertions(+), 7 deletions(-)
+
+commit 98572190667fa4af90d916cf5842d574cb042238
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue Apr 3 13:50:41 2012 +1000
+
+ Lib/GIS/Proj/proj.pd - make compatible with proj-4.8.0
+
+ Inclusion of projects.h no longer permissible with proj-4.8.0.
+
+ Lib/GIS/Proj/Proj.pd | 75 ++++++++++++++++++++++++++-----------------------
+ 1 files changed, 40 insertions(+), 35 deletions(-)
+
+commit f5d7bb06153d4caabcdbcd53aa9e66c0b31690b6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Apr 2 18:17:43 2012 -0400
+
+ Update Release_Notes for mapflex/mapfraw
+
+ Release_Notes | 34 +++++++++++++++++++++++++++++++++-
+ 1 files changed, 33 insertions(+), 1 deletions(-)
+
+commit a0c2b1459b7f2dce394917bf29b5066a7d5c3f56
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Apr 2 17:26:01 2012 -0400
+
+ Use binmode for sysopen, comment out win32 croak
+
+ Basic/Core/Core.pm.PL | 2 ++
+ Basic/Core/pdlmagic.c | 2 +-
+ 2 files changed, 3 insertions(+), 1 deletions(-)
+
+commit 13056747af59fe3bfdfec41551a4cc82fb148d9c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Apr 2 16:58:25 2012 -0400
+
+ Implement PDL::set_data_by_file_map for mmap-ing
+
+ Basic/Core/Core.pm.PL | 48 +++++++++++++++++++++++++++++++++++++++++++++++-
+ IO/FastRaw/FastRaw.pm | 22 ++++++++++++++++------
+ IO/FlexRaw/FlexRaw.pm | 9 ++++++++-
+ 3 files changed, 71 insertions(+), 8 deletions(-)
+
+commit 3dd4cad3f378ea5d8f1780077b8262f47260b4e7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 1 22:00:22 2012 -0400
+
+ Add option to call File::Map version of mmap code
+
+ This is another step towards implementing mapfraw
+ and mapflex via File::Map. The remaining issue is
+ implementing the correct option handling vis a vis
+ Creat, Trunc, and ReadOnly.
+
+ IO/FastRaw/FastRaw.pm | 29 +++++++++++++++++++++--------
+ IO/FlexRaw/FlexRaw.pm | 26 +++++++++++++++++++++-----
+ t/fastraw.t | 2 ++
+ t/flexraw.t | 2 ++
+ 4 files changed, 46 insertions(+), 13 deletions(-)
+
+commit 9cb7286d92cf7f32aacdd6eb584aa356397b24b8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 1 12:14:36 2012 -0400
+
+ Fix t/fastraw.t and t/flexraw.t to handle missing mmap support
+
+ This replaces a hardwired skip for win32 platforms by
+ an eval to catch the error message and then skip any
+ mmap tests. This should change from skips to passes
+ when the File::Map implementation is complete.
+
+ t/fastraw.t | 22 +++++++++++++++-------
+ t/flexraw.t | 14 +++++++-------
+ 2 files changed, 22 insertions(+), 14 deletions(-)
+
+commit 7b368df4e9a98b5467bdc595a07256ae68737e1f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 29 17:51:10 2012 -0400
+
+ Fixed argument order bug in set_data_by_mmap()
+
+ The shared and writable options were reversed. This did not
+ usually cause a problem since the defaults for both were the
+ same. After this correction, the remaining support for win32
+ mapfraw and mapflex can be done at the perl level.
+
+ Basic/Core/Core.xs.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 910a0e8e1bff41f0e30e5d22b044aac2a6af16a9
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Thu Mar 29 10:57:24 2012 +1100
+
+ transform.pd - remove "defined" from "defined(@names)"
+
+ As per the advice of the warning issued when the test
+ suite is run under perl-5.15.
+ (Doesn't lead to breakage with earlier versions of
+ perl that PDL supports.)
+
+ Lib/Transform/transform.pd | 630 ++++++++++++++++++++++----------------------
+ 1 files changed, 315 insertions(+), 315 deletions(-)
+
+commit 709eebd8c22b517f81f36b4e808c2e84f82112a7
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Thu Mar 29 10:57:24 2012 +1100
+
+ complex.pd - fix attempts to overload '<=>=' and '=>'
+
+ sub _gen_biop created an overload entry for '<=>=',
+ which I've removed.
+ And the 'use overload' section passed a '=>' to sub
+ _gen_cpop, which I changed to '>='.
+ (perl-5.15 issued warnings in relation to these during
+ the running of the test suite.)
+
+ Basic/Complex/complex.pd | 60 +++++++++++++++++++++++-----------------------
+ 1 files changed, 30 insertions(+), 30 deletions(-)
+
+commit 217850e71a65e40ace4944374f497a3a8c12ead3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 28 17:39:42 2012 -0400
+
+ Add set_state_and_add_deletedata_magic() to support File::Map
+
+ Since File::Map works at the level of mapping a file into
+ a perl scalar lvalue, I've implemented a routine that does
+ the required state setting and addition of deletedata magic
+ for the pdl.
+
+ For reference, here is a simple sequence using map_file
+ from File::Map to do the memory mapping for an existing
+ PDL::IO::FlexRaw data file:
+
+ use 5.10.1;
+
+ use PDL;
+ use PDL::IO::FlexRaw;
+ use PDL::Core qw(:Internal);
+
+ use File::Map qw(map_file);
+
+ $hdr = PDL::IO::FlexRaw::_read_flexhdr('a_ushort_3_7.dat.hdr');
+ $h = $hdr->[0];
+
+ $amm = PDL->zeros( ushort ); # fix to use $h->{Type} instead
+ $amm->setdims($h->{Dims});
+ $ammdr = $amm->get_dataref;
+ map_file ${$ammdr}, 'a_ushort_3_7.dat', '+<'; # must enable rw
+ $amm->upd_data;
+ $amm->set_state_and_add_deletedata_magic(length(${$ammdr}));
+
+ $amm *= 3;
+ say $amm;
+ undef $amm; # the file should be updated now
+
+ $acheck = readflex 'a_ushort_3_7.dat';
+ say $acheck; # should be the same as from $amm
+
+ Basic/Core/Core.xs.PL | 13 +++++++++++++
+ 1 files changed, 13 insertions(+), 0 deletions(-)
+
+commit 88e6743f71076a33c168a266dd4c1090b56ae763
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Wed Mar 28 11:54:15 2012 +1100
+
+ New file - avoid the fork() call in t/plplot.t for win32 only.
+
+ On win32 fork() uses threads, and plplot is not thread
+ safe. Workaround by calling this separate script iff
+ OS is MS Windows
+
+ t/plplot_no_fork.win32 | 31 +++++++++++++++++++++++++++++++
+ 1 files changed, 31 insertions(+), 0 deletions(-)
+
+commit 380ed95d351bc121e100b7a4a57545c118a2d1ac
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Wed Mar 28 11:54:15 2012 +1100
+
+ Avoid the fork() call in t/plplot.t for win32 only.
+
+ On win32 fork() uses threads, and plplot is not thread
+ safe. Workaround by calling a separate script
+ (plplot_no_fork.win32) iff OS is MS Windows
+
+ t/plplot.t | 45 ++++++++++++++++++++++++++-------------------
+ 1 files changed, 26 insertions(+), 19 deletions(-)
+
+commit caba7a287e2471806184c663d098a894815cee9b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 27 18:04:39 2012 -0400
+
+ Update PDL delete magic for 64bit perls/OSes
+
+ Updated PDL_CORE_VERSION to 9 and replaced int declarations
+ for lengths and offsets by STRLEN, Size_t, and Off_t as
+ appropriate. May need to change some of these a bit but
+ I believe the size of the types is now correct to support
+ memory mapping on 64-bit systems and perls.
+
+ Basic/Core/Core.xs.PL | 4 ++--
+ Basic/Core/pdlcore.h.PL | 1 +
+ Basic/Core/pdlmagic.c | 4 ++--
+ Basic/Core/pdlmagic.h | 8 ++++----
+ 4 files changed, 9 insertions(+), 8 deletions(-)
+
+commit 619564c30d70154a8daa32a04f7b496259bec1c4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 27 13:57:17 2012 -0400
+
+ Change set_data_by_xxx to use STRLEN and not int
+
+ To support 64bit perls and OSes, this changes the len argument
+ type for set_data_by_mmap() and the offset argument type for
+ set_data_by_offset() to STRLEN from int. This is moving towards
+ implementing memory mapping for PDL using the File::Map module
+ which supports both windows and posix platforms.
+
+ Basic/Core/Core.xs.PL | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 519723b8bd3bfe1ddc1cd5e7ed8e82243c0ecda5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 21 13:31:20 2012 -0400
+
+ Update Known_problems
+
+ Known_problems | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 375d3ca4f07d8da31d61b5a6fc134838b00d8c68
+Merge: bf1ef17 a482010
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Mar 6 16:55:28 2012 -0700
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit bf1ef1741ad06ef1f8d720523207c34069d50c9f
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Mar 6 16:44:55 2012 -0700
+
+ Removed some differences between 'p' and 'print' in pdl2 shell
+
+ $| wasn't set anywhere in the pdl2 scripts, so output was being buffered when running the pdl2 shell.
+ Even more confusing, output was only buffered when using the print command, not the p alias.
+ I traced this down to the presence of a \n in the 'p' alias, and removed it. Also added an autoflush
+ command to pdl2. Now print and p behave the same, afaict.
+
+ Perldl2/Profile/Perldl2.pm | 4 +++-
+ 1 files changed, 3 insertions(+), 1 deletions(-)
+
+commit a4820101dc1122eecd124912bb05c6dec4bd83c7
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Mar 6 15:08:43 2012 -0600
+
+ Made pp_line_numbers.t a little more robust
+
+ I noticed that the number of tests in pp_line_numbers.t was hard
+ coded, but it actually depended on the number of types the PDL
+ supports. It now explicitly specifies two types to test (float and
+ double, though it could be anything).
+
+ It also now closes the filehandle to the generated xs file before
+ removing the file. Previously, extraneous copies of foobar.xs were
+ left around, at least on Windows machines and maybe on others.
+
+ t/pp_line_numbers.t | 9 +++++----
+ 1 files changed, 5 insertions(+), 4 deletions(-)
+
+commit 7a3e626d4e3d96efa3b7645c904589c37cbd593a
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Mar 5 22:26:38 2012 -0600
+
+ Fixed backslash complaints on Windows (I hope)
+
+ Basic/Gen/PP.pm | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 182a964107fefef4720b1f408c3c2d101cfd8b8d
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu Feb 23 12:39:59 2012 -0600
+
+ Fixed a bug in cat's error reporting.
+
+ I had code that called PDL::cat(@piddles), but ran into the edge
+ case that @piddles was completely empty. This particular edge case
+ was not properly identified by cat's extensive error processing,
+ so I've added something that correctly diagnoses it.
+
+ I also added proper $arg->isa('PDL') checking. The original code
+ checked if ref($arg) =~ /PDL/, which is not the proper way to
+ check something is an object of a particular kind. The correct
+ way to do this is to say
+
+ if (not eval{$arg->isa('PDL')}) ...
+
+ Basic/Core/Core.pm.PL | 13 ++++++++++---
+ 1 files changed, 10 insertions(+), 3 deletions(-)
+
+commit d552291826e162ce9a38eda94ac7c09b86ab5966
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu Feb 23 09:15:08 2012 -0600
+
+ Added lvalue awareness to whereND
+
+ Basic/Primitive/primitive.pd | 11 ++++++++++-
+ 1 files changed, 10 insertions(+), 1 deletions(-)
+
+commit 40a0bac3badb60e9fcd66cf84800af93631947e3
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu Feb 23 09:09:12 2012 -0600
+
+ Added failing tests for whereND lvalue
+
+ t/primitive.t | 17 +++++++++++++++--
+ 1 files changed, 15 insertions(+), 2 deletions(-)
+
+commit 13d6c12a5ed44674f0a26beadc4a561985aec91e
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Thu Feb 23 18:56:31 2012 +1100
+
+ Doc/mkhtmldoc.pl - Make compatible with perl-5.15 and later
+
+ Changes in perl-5.15 to pod2html necessitated changes
+ to mkhtmldoc.pl
+
+ Doc/mkhtmldoc.pl | 82 +++++++++++++++++++++++++++++++++---------------------
+ 1 files changed, 50 insertions(+), 32 deletions(-)
+
+commit 1af6764aece24b065a5933bf349660b9f17c3cbb
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 21 15:51:40 2012 -0500
+
+ Add comment for enabling hex/oct input for rcols
+
+ Not yet implemented since we need to ensure that
+ the new functionality does not break floating point
+ data type inputs.
+
+ IO/Misc/misc.pd | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit 1297d7c95b4d731a22cd58085efa0f218d893793
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 21 11:13:48 2012 -0500
+
+ Fix changes/Changes target for build
+
+ This is a convenience target to allow folks to
+ generate a new version of the Changes file with git.
+ There was a problem with the syntax and nmake. With
+ luck this fixes it...
+
+ Makefile.PL | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit 2db307b6b31758f7fd6c25fa2a67209664e736cf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 14 10:12:05 2012 -0500
+
+ Apply fix for sf.net bug #3487569 (thanks bperret!)
+
+ IO/Misc/misc.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 79b5a5d9b7b2d97c8cd92ac645a468bc325dd25c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 10 13:14:59 2012 -0500
+
+ Update PDL/IO/Dicom/Dicom.pm pod
+
+ Fixed an error reported by podchecker and a minor
+ cleanup. Need to see if this resolves the missing
+ Dicom docs in pdldoc.
+
+ IO/Dicom/Dicom.pm | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 233115924f0ed83c5b3e890808043a0e4ddac4c6
+Merge: 180854f f4f07b2
+Author: Judd Taylor <judd.t at orbitalsystems.com>
+Date: Wed Feb 8 18:44:36 2012 +0000
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit f4f07b2fb00f75f0415d14a110db836fab48e4d2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 7 13:35:40 2012 -0500
+
+ Fix check for glutRunning logic for imag2d
+
+ Graphics/Graphics2D.pm | 4 +++-
+ 1 files changed, 3 insertions(+), 1 deletions(-)
+
+commit 3db6c34b885ce52e67be1881a0a34af413b9fd9d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Feb 6 16:11:23 2012 -0500
+
+ Minor docs updates and pod fixes
+
+ Basic/Core/Core.pm.PL | 2 +-
+ Basic/Primitive/primitive.pd | 2 +-
+ Basic/Ufunc/ufunc.pd | 3 +++
+ 3 files changed, 5 insertions(+), 2 deletions(-)
+
+commit b27dc165ba45d73fcf014210df0979f2ef761c9c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Feb 6 15:55:10 2012 -0500
+
+ Update VERSION to 2.4.10_001 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 14 ++------------
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 35 insertions(+), 13 deletions(-)
+
+commit 13335adf609a8c48cae9918324ea4475819af14b
+Merge: cd26a5e 99c4411
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Feb 6 15:14:41 2012 -0500
+
+ Merge commit '99c441103f4849792d77ff5cdcd91710be457dab'
+
+ Folding the PDL-2.4.10 release branch back into the
+ git master development branch. NOTE: do not name a
+ tag the same as a branch as you get an ambiguity in
+ checkouts that is a real pain and may lead to git
+ problems.
+
+ Conflicts:
+ Basic/Core/Core.pm.PL
+ Known_problems
+
+commit 99c441103f4849792d77ff5cdcd91710be457dab
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 3 18:44:47 2012 -0500
+
+ Final update to Release_Notes for PDL-2.4.10
+
+ Release_Notes | 44 +++++++++++++++++++++++++++++++++++++++++++-
+ 1 files changed, 43 insertions(+), 1 deletions(-)
+
+commit 180854fd871f9b687fe277fea96897b6a202832e
+Author: Judd Taylor <judd.t at orbitalsystems.com>
+Date: Fri Feb 3 17:10:56 2012 +0000
+
+ Fixed an issue where PDL::IO::GD object are not freeing memory allocated by the C GD library.
+ This fixes bug 3483926.
+
+ IO/GD/GD.pd | 23 ++++++++++++++++++++---
+ 1 files changed, 20 insertions(+), 3 deletions(-)
+
+commit eb2b9081b60610795aba363274a1d1fbc4d83cda
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 3 10:52:08 2012 -0500
+
+ Add OO GD bug and 'x' operator to Known_problems
+
+ Known_problems | 30 +++++++++++++++++++++++++++---
+ 1 files changed, 27 insertions(+), 3 deletions(-)
+
+commit aa79285b82197fa6787465a19aaf5249a000cfff
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 27 17:59:03 2012 -0500
+
+ Update VERSION to 2.4.10 for release
+
+ Also begin final edits of Known_problems and the Release_Notes.
+ Still to do, verify build instructions for cygwin.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 3 ++-
+ Release_Notes | 20 ++------------------
+ 3 files changed, 5 insertions(+), 20 deletions(-)
+
+commit 01045b69ba894a33b5e3284ba55d47b86c5eb27f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 21 16:18:57 2012 -0500
+
+ Add Changes and changes targets to Makefile postable
+
+ Now you can 'make changes' or 'make Changes' to update
+ the Changes file with the latest from the git log.
+ The Changes file is updated for 'make dist' but via
+ PREOP which only works in the distdir being created
+ and not the original Changes file.
+
+ Makefile.PL | 5 +++++
+ 1 files changed, 5 insertions(+), 0 deletions(-)
+
+commit 9a67e753a3f3e1e62cecfb386ba8d4a9a8271ff2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 21 15:44:20 2012 -0500
+
+ Update VERSION to 2.4.9_996 for next RC development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 66 ++++++++++++++++++++++++++++++++++++++++---------------
+ 3 files changed, 50 insertions(+), 20 deletions(-)
+
+commit 9fb0950c5bf4daac2be7586679d6f4c5362b6a85
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 21 14:01:09 2012 -0500
+
+ Reapply: Add imag2d_update to PDL::Graphics2D EXPORTs
+
+ I realized that this had been omitted. I've now
+ added imag2d_update and some documentation to
+ PDL::Graphics2D.
+
+ Graphics/Graphics2D.pm | 24 +++++++++++++++++++++++-
+ 1 files changed, 23 insertions(+), 1 deletions(-)
+
+commit 36017b8de5dfe5f47c8d2ae56f711b067579ef3b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 21 13:56:59 2012 -0500
+
+ Revert "Add imag2d_update to PDL::Graphics2D EXPORTs"
+
+ This reverts commit 90e413cc51812c253357dacbc079e653c2968de2.
+
+ Conflicts:
+
+ Basic/PDL.pm
+ Known_problems
+ Release_Notes
+
+ Basic/Core/Core.pm.PL | 8 +-
+ DEPENDENCIES | 24 +++--
+ Graphics/Graphics2D.pm | 24 +-----
+ IO/FlexRaw/FlexRaw.pm | 27 ++++--
+ IO/Pnm/Pic.pm | 15 ++-
+ IO/Pnm/pnm.pd | 16 ++--
+ Known_problems | 22 ++++-
+ Makefile.PL | 2 +-
+ TODO | 2 +-
+ cygwin/INSTALL | 43 +++++----
+ cygwin/README | 8 +-
+ macosx/README | 10 +-
+ t/inlinepdlpp.t | 4 +-
+ win32/INSTALL | 238 ++++++++++++++++++++++++++++--------------------
+ 14 files changed, 254 insertions(+), 189 deletions(-)
+
+commit c01c22ab0d809539edeba24639d1ca501e4d8967
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 21 11:46:06 2012 -0500
+
+ Update Release_Notes for PDL 2.4.9_995 release
+
+ Release_Notes | 272 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
+ 1 files changed, 271 insertions(+), 1 deletions(-)
+
+commit 31a1732b4d5a10e6caa7532e7b28048914ac6171
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 21 11:37:16 2012 -0500
+
+ Update VERSION for CPAN developers release
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 5 +++--
+ 2 files changed, 4 insertions(+), 3 deletions(-)
+
+commit 94032f84657a7dfa71b2b1acdc646451f46cda2b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 21 11:12:28 2012 -0500
+
+ Add error reporting to system calls in t/flexraw_fortran.t
+
+ t/flexraw_fortran.t | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 5e5c180654c81eb8ede352741ef4b7f4f9cf1e2e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 21 11:00:58 2012 -0500
+
+ Add test names to t/flexraw_fortran.t
+
+ This should help to track down test failures
+ reported by having more detail about which subtest
+ is doing the failing....
+
+ t/flexraw_fortran.t | 28 ++++++++++++++--------------
+ 1 files changed, 14 insertions(+), 14 deletions(-)
+
+commit 4d0c6cd02b89ec7432eb2d201b7f4f00d8f8330c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 20 21:28:01 2012 -0500
+
+ Fix path separators in filenames to forward slash for all
+
+ g77 has problems with the windows backslash separators.
+ This makes the filepath names consistent across all
+ OSes.
+
+ t/flexraw_fortran.t | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 4a07b84abb3533c84b86fb2e23152b859a99332f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 20 15:32:06 2012 -0500
+
+ Add intial values for floatformat and doubleformat to PDL::Core
+
+ Users should not have to guess or read the source code to
+ get at this setting. TODO: add these to the pdldoc and
+ online help/apropos documentation database.
+
+ Basic/Core/Core.pm.PL | 7 ++++++-
+ 1 files changed, 6 insertions(+), 1 deletions(-)
+
+commit 90e413cc51812c253357dacbc079e653c2968de2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 20 13:41:24 2012 -0500
+
+ Add imag2d_update to PDL::Graphics2D EXPORTs
+
+ I realized that this had been omitted. I've now
+ added imag2d_update and some documentation to
+ PDL::Graphics2D.
+
+ Basic/Core/Core.pm.PL | 8 +-
+ Basic/PDL.pm | 2 +-
+ DEPENDENCIES | 24 ++---
+ Graphics/Graphics2D.pm | 24 +++++-
+ IO/FlexRaw/FlexRaw.pm | 27 ++----
+ IO/Pnm/Pic.pm | 15 +--
+ IO/Pnm/pnm.pd | 16 ++--
+ Known_problems | 26 +----
+ Makefile.PL | 2 +-
+ Release_Notes | 218 ++------------------------------------------
+ TODO | 2 +-
+ cygwin/INSTALL | 43 ++++-----
+ cygwin/README | 8 +-
+ macosx/README | 10 +-
+ t/inlinepdlpp.t | 4 +-
+ win32/INSTALL | 238 ++++++++++++++++++++----------------------------
+ 16 files changed, 199 insertions(+), 468 deletions(-)
+
+commit 019c2c9b21d4fb7f539183dfd757bfe751064fec
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 20 13:15:54 2012 -0500
+
+ Improve POGL dependency info and error messages
+
+ perl Makefile.PL will now report the required minimum
+ version of the perl OpenGL module if it fails to
+ detect one.
+
+ DEPENDENCIES | 11 ++++++++---
+ Makefile.PL | 2 +-
+ 2 files changed, 9 insertions(+), 4 deletions(-)
+
+commit bdaa1582e061b010a0a3ccb8e0ecfdff0458c902
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jan 18 10:03:04 2012 -0500
+
+ Add t/pic_16bit.t fail to Known_problems
+
+ There are known problems with 16-bit PNG and
+ TIFF images for wpic/rpic. Please add fixes
+ or other diagnostics to the trouble ticket
+ at http://sourceforge.net/tracker/?func=detail&aid=3475075&group_id=612&atid=100612
+
+ Known_problems | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit d92e74a5c9cabea2ade1fa6412dbd6355b61873c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jan 16 12:34:17 2012 -0500
+
+ Update VERSION to 2.4.9_994 and readmes for RC4
+
+ Basic/PDL.pm | 2 +-
+ DEPENDENCIES | 9 +-
+ Known_problems | 5 +-
+ Release_Notes | 12 ++--
+ cygwin/INSTALL | 43 ++++++----
+ macosx/README | 10 +-
+ win32/INSTALL | 238 ++++++++++++++++++++++++++++++++-----------------------
+ 7 files changed, 184 insertions(+), 135 deletions(-)
+
+commit cd26a5ef4a5fee0f030957fc63ff75c6074dec7d
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Fri Jan 13 12:35:05 2012 +1100
+
+ Document problem with PDL::Graphics::PLplot, MS Windows, perl-5.14
+
+ Add to the Known_problems file:
+ On MS Windows, perl 5.14 (and perhaps later), it is reported that
+ PDL::Graphics::PLplot cannot be sucessfully built as part of the
+ PDL build. It compiles ok, but the resultant binary files are
+ unusable. Workaround is to build PDL first, then build
+ PDL::Graphics::PLplot separately.
+
+ Known_problems | 20 +++++++++++++++-----
+ 1 files changed, 15 insertions(+), 5 deletions(-)
+
+commit cbfdf44605d0a55ac86ea34dedeb2ca10c2192f6
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Fri Jan 13 12:24:39 2012 +1100
+
+ Document problem with PDL::Graphics::PLplot, MS Windows, perl-5.14
+
+ Add to the Known_problems file:
+ On MS Windows, perl 5.14 (and perhaps later), it is reported that
+ PDL::Graphics::PLplot cannot be sucessfully built as part of the
+ PDL build. It compiles ok, but the resultant binary files are
+ unusable. Workaround is to build PDL first, then build
+ PDL::Graphics::PLplot separately.
+
+ Known_problems | 14 ++++++++++----
+ 1 files changed, 10 insertions(+), 4 deletions(-)
+
+commit a83257b563acf3102017a9fa9a614deba193386a
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Jan 12 00:06:53 2012 -0700
+
+ add radians-to-degrees constant to PDL::Constants
+
+ Basic/Constants.pm | 8 ++++++++
+ 1 files changed, 8 insertions(+), 0 deletions(-)
+
+commit 6d8d15d87066a8d0466a65a41d7acf6cf49cee35
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Jan 12 00:06:16 2012 -0700
+
+ Fix new_or_inplace to work according to its documentation. (also required minor tweaking of new_from_specification).
+
+ Basic/Core/Core.pm.PL | 36 ++++++++++++++++++++++++++++++++----
+ t/core.t | 21 ++++++++++++++++++++-
+ 2 files changed, 52 insertions(+), 5 deletions(-)
+
+commit 2ee99d5ce1055efd8fd90232999ab88466e17f0c
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Wed Jan 11 23:59:19 2012 -0700
+
+ Fix PDL::Type::new to accept types by name as well as by (internal representation) integer.
+ Also, fix previously masked bug in FastRaw (ASCII lines were not being properly chomped).
+
+ Basic/Core/Types.pm.PL | 28 +++++++++++++++++++++++++++-
+ IO/FastRaw/FastRaw.pm | 6 +++---
+ 2 files changed, 30 insertions(+), 4 deletions(-)
+
+commit 2562c678384407551ea80f157d563db6267e6576
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jan 11 13:09:09 2012 -0500
+
+ Add better diags in readchunk
+
+ Trying to track down a 1-platform-only failure from CPAN
+ testers for the PDL-2.4.10 rc3. Hope this helps.
+
+ IO/FlexRaw/FlexRaw.pm | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 0cf9054d1481d7b6770428c141cfe89fb03e238d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jan 11 13:03:35 2012 -0500
+
+ Fix "" isn't numeric in... warnings in t/slice.t
+
+ Basic/Core/Core.pm.PL | 8 ++++++--
+ 1 files changed, 6 insertions(+), 2 deletions(-)
+
+commit 00377407461ffc6945370e09c6dde144c51ad3d9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 10 18:08:15 2012 -0500
+
+ Minor pod updates.
+
+ IO/FlexRaw/FlexRaw.pm | 22 ++++++++++++++++------
+ IO/Pnm/Pic.pm | 15 ++++++++++-----
+ IO/Pnm/pnm.pd | 16 ++++++++--------
+ 3 files changed, 34 insertions(+), 19 deletions(-)
+
+commit 649c1b3a54c2418a7afa3edd760382117c82e56e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 10 16:45:30 2012 -0500
+
+ Update Release_Notes and t/inlinepdlpp.t
+
+ First iteration from the CPAN Developers release.
+ The t/inlinepdlpp.t problem was a warning about
+ redefining shape() since we now have PDL::shape
+ to accompany our new standard terminology.
+
+ Release_Notes | 112 +++++++++++++++++++++++++++++-------------------------
+ t/inlinepdlpp.t | 4 +-
+ 2 files changed, 62 insertions(+), 54 deletions(-)
+
+commit 513b69f2ebdf97033af7994d4d04e4fe96e3e508
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 10 16:02:47 2012 -0500
+
+ Fix typo in Release_Notes
+
+ Release_Notes | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f9b28e9a77a6c5cec1808c2b58deb1369bf139fd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 10 13:23:29 2012 -0500
+
+ Update Known_problems and Release_Notes for PDL-2.4.10 RC3 release
+
+ Known_problems | 5 ++
+ Release_Notes | 199 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
+ 2 files changed, 201 insertions(+), 3 deletions(-)
+
+commit 8cceef3fbb02d326cc5ff30a8fa0d1b5101c39f9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jan 9 09:44:38 2012 -0500
+
+ Update readme-type files.
+
+ DEPENDENCIES | 4 +++-
+ Known_problems | 1 -
+ Release_Notes | 3 +++
+ TODO | 2 +-
+ cygwin/README | 8 ++++----
+ 5 files changed, 11 insertions(+), 7 deletions(-)
+
+commit 2b99ad7e924d030172d16378d94f097f1e859a5b
+Merge: d457db5 1eedf7d
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Fri Jan 6 21:02:08 2012 -0700
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit d457db596ee1664a1d2b440ce76edfc3a53db1ca
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Fri Jan 6 20:56:45 2012 -0700
+
+ fixed bug in whichND deprecation warning (oops).
+
+ Basic/Core/Core.pm.PL | 2 +-
+ Basic/Primitive/primitive.pd | 2 +-
+ 2 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 1eedf7df45b574e22b309d72a673a5e3ab4d202d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 6 18:48:26 2012 -0500
+
+ Add shape() to EXPORT_OK stuff in Core.pm.PL
+
+ I think I added it in Core.pm by mistake before...
+
+ Basic/Core/Core.pm.PL | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 3388668b732149044a8644e6ce73721a864624c8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 6 18:04:25 2012 -0500
+
+ Minor POD fix for nullcreate and shape
+
+ Basic/Core/Core.pm.PL | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 8f50e528191d260f1c76277a3256f86b1b1a99db
+Merge: 8152015 8fc6714
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Jan 5 23:31:22 2012 -0700
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 8fc6714c24afe9819333a83506e31dd7d94eaa92
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jan 5 21:47:32 2012 -0500
+
+ Add shape sub/method to PDL::Core
+
+ As a routine, it just returns pdl($pdl->dims) instead of the
+ ($pdl->dims) list. However, I thought it would be good to
+ have an accessor for the new terminolgy.
+
+ Basic/Core/Core.pm.PL | 24 +++++++++++++++++++++++-
+ 1 files changed, 23 insertions(+), 1 deletions(-)
+
+commit 324307d65c578b5e02a5a1a36f4492741b4f7483
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jan 5 21:29:37 2012 -0500
+
+ Update MANIFEST from READMEs cleanup
+
+ IO/HDF/SD/README | 1 -
+ MANIFEST | 5 -----
+ 2 files changed, 0 insertions(+), 6 deletions(-)
+
+commit 815201543c5566e83e779d4e50d3c2db47547ce8
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Thu Jan 5 16:01:32 2012 -0700
+
+ add documentation of the threading engine and Empty PDLs.
+
+ Basic/Core/Core.pm.PL | 138 ++++++++++++++++++++++++++++++++++++++++++++++++-
+ Basic/PDL.pm | 7 +++
+ 2 files changed, 144 insertions(+), 1 deletions(-)
+
+commit 2a1c69e3ccb5233f39e21f00bdf03997d03084db
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu Jan 5 08:59:11 2012 -0600
+
+ REVERTED previous commit.
+
+ My last change resulted in tons of text getting printed to the
+ screen during make test, so I reverted to the original usage of
+ print instead of diag.
+
+ t/slice.t | 54 +++++++++++++++++++++++++++---------------------------
+ 1 files changed, 27 insertions(+), 27 deletions(-)
+
+commit ef252a681304a26a6bc9af6de00b9a4262c54e0e
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu Jan 5 08:36:41 2012 -0600
+
+ Changed print to diag in t/slice.t
+
+ t/slice.t | 54 +++++++++++++++++++++++++++---------------------------
+ 1 files changed, 27 insertions(+), 27 deletions(-)
+
+commit db274c02e21784758b8fe3a9918255f1e1791413
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu Jan 5 08:20:21 2012 -0600
+
+ Improved line number reporting from Core.pm.PL
+
+ I had added a # line directive at one place in Core.pm.PL while I
+ was working on PDL::new_pdl_from_string, but when I encountered
+ a new error much further along in the file, I figured that the
+ line reporting was off. It was. This patch adds a number of
+ additional # line directives to Core.pm.PL so that error reporting
+ now gives the correct line of the underlying source file.
+
+ Basic/Core/Core.pm.PL | 24 ++++++++++++++++--------
+ 1 files changed, 16 insertions(+), 8 deletions(-)
+
+commit 4affbd6778bb502c75b062e11d596ab048e14cba
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Jan 5 01:04:02 2012 -0700
+
+ Modified range() to handle regularized Empty stuff
+
+ Basic/Slices/slices.pd | 14 ++++++++++----
+ t/slice.t | 18 +++++++++++-------
+ 2 files changed, 21 insertions(+), 11 deletions(-)
+
+commit 2f9ae3f2674f7befe32555be199a3bb9ab1b769a
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Jan 5 00:36:57 2012 -0700
+
+ whichND emits regularized empties now
+
+ Basic/Primitive/primitive.pd | 65 ++++++++++++++++++++++++++---------------
+ t/primitive.t | 27 ++++++++++++++---
+ 2 files changed, 63 insertions(+), 29 deletions(-)
+
+commit 18058b0672d164727cce739fe5c3350c810b84ba
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Jan 5 00:36:22 2012 -0700
+
+ change Empty stringification output to include dim string for the empty PDL
+
+ Basic/Core/Core.pm.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f479a164f1f9d9584d8c91d0792811514e0c04b3
+Author: Craig DeForest <zowie at Clio-4.local>
+Date: Thu Jan 5 00:15:03 2012 -0700
+
+ Regularize Empty handling in the constructors pdl() and PDL::new_from_specification
+
+ Basic/Core/Core.pm.PL | 2 +-
+ Basic/Core/Core.xs.PL | 9 ++-
+ Basic/Core/pdlcore.c.PL | 234 +++++++++++++++++++++++++++++-----------------
+ t/constructor.t | 39 +++++---
+ t/core.t | 41 ++++++---
+ 5 files changed, 207 insertions(+), 118 deletions(-)
+
+commit f7f14cfdf79d3c1edc0418f4fc36f1c3f53e3542
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jan 4 13:32:32 2012 -0500
+
+ Clean up deprecated README files
+
+ These files come from the early days for the various
+ PDL component modules but are confusing since they
+ either are not a true README file or are not correct
+ for the current PDL.
+
+ Basic/SourceFilter/README | 655 ---------------------------------------------
+ Graphics/TriD/README | 22 --
+ IO/HDF/README | 1 -
+ IO/HDF/VS/README | 1 -
+ t/README | 2 -
+ 5 files changed, 0 insertions(+), 681 deletions(-)
+
+commit 48f102b5d5eb4c4359a7aa7242ac4af3587039f6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jan 2 18:44:57 2012 -0500
+
+ Add test names to t/complex.t subtests
+
+ t/complex.t | 28 +++++++++++++---------------
+ 1 files changed, 13 insertions(+), 15 deletions(-)
+
+commit b79f70cfc4d97ad4e3cc6c31c50862f3a1759cd6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 28 11:13:05 2011 -0500
+
+ Update VERSION to 2.4.9_993 (a.k.a. PDL-2.4.10 RC3)
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 25 +++++++++++++++++++++++++
+ 3 files changed, 27 insertions(+), 2 deletions(-)
+
+commit 2ab698cabc58b5ae97fa404ed4379b9ef2564d70
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 28 10:12:43 2011 -0500
+
+ Update Known_problems and Release_Notes for RC2
+
+ Known_problems | 12 +-----------
+ Release_Notes | 8 +++++++-
+ 2 files changed, 8 insertions(+), 12 deletions(-)
+
+commit ac91c48b0388f18eb5a28a5ecb786b2c1962e2ea
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 27 15:54:22 2011 -0500
+
+ Fix IO::Browser default logic
+
+ It should not try to build the Browser subdir Makefile
+ now. I thought I had already fixed the problem.
+
+ IO/Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3805ec2e42b6a0e86d2359bd324b175f7765933f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 26 10:10:35 2011 -0500
+
+ Remove WITH_NEW_PDL_FROM_STRING from perldl.conf
+
+ It ended up not being used and is confusing to leave
+ in since it is not being used (and never was used).
+
+ perldl.conf | 8 --------
+ 1 files changed, 0 insertions(+), 8 deletions(-)
+
+commit 14b1788da80d14ee413944784b0c81c52112f1c1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 24 12:12:36 2011 -0500
+
+ Update VERSION to 2.4.9_992 for RC2 checkout
+
+ The focus of RC2 is to ensure that any lingering
+ code issue surprises (not expected) from RC1 are
+ addressed/documented and to allow for any POD or
+ internal doc updates to the source tree. After
+ RC2, the remaining work should be on updates to
+ the web site and on the PDL book.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 25 +++++++++++++++++++++++++
+ 3 files changed, 27 insertions(+), 2 deletions(-)
+
+commit 241720b72d46b318cbd1b5cc53d8f12fb4142b9d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 24 11:58:58 2011 -0500
+
+ Update t/config.t to match perldl.conf changes
+
+ t/config.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 99ce52212d8c2bfc74ecd03bcfab2ab982066eb9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 24 10:53:33 2011 -0500
+
+ Clean up perldl.conf for release candidate 1
+
+ Removed legacy comments for unused features and updated
+ Perl OpenGL module version required.
+
+ perldl.conf | 48 +++++-------------------------------------------
+ 1 files changed, 5 insertions(+), 43 deletions(-)
+
+commit d786c1bf3a7ae571f8ede49fe7cfa38e75b427cf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 23 14:47:42 2011 -0500
+
+ Clean-up TODO and in t/dumper.t from that
+
+ Some TODO items were done, some needed to be added,
+ t/dumper.t edit to clean up from an already fixed bug.
+
+ TODO | 16 ++------
+ t/dumper.t | 115 +++++++++++++++++++++++++++--------------------------------
+ 2 files changed, 57 insertions(+), 74 deletions(-)
+
+commit 6471f8d70d5507452dffdb843e757ac1bc508880
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 23 10:59:02 2011 -0500
+
+ Skip IO::Browser testing for CPAN Testers
+
+ The functionality is there and appears to work but the
+ edge cases still need to resolved for all platforms.
+ The IO::Browser module must be specifically enabled
+ now for the build to be attempted. Will re-open for
+ testing after PDL-2.4.10
+
+ IO/Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3eb17745b27b59a847d43c52af10e9646b17d936
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Dec 22 22:14:00 2011 -0700
+
+ Revert "Add NO_MYMETA=>1 flag to most Makefile.PL's."
+
+ This reverts commit 1b66349abb51020a76e33af7dc8e7671cfc0062c.
+
+ Chris made the point that the NO_MYMETA attribute was introduced
+ in a version of MakeMaker (6.57_02) that is later than our minimum
+ required version (6.31). Seems likely that this would cause even
+ more ugliness for users of older EU::MMs. No time for me to fix
+ properly before holiday and release, so reverting for now. We
+ can fix properly after 2.4.10 (this is just cosmetic anyway).
+
+ Basic/Core/Dev.pm | 2 --
+ Basic/Core/Makefile.PL | 1 -
+ Basic/Gen/Makefile.PL | 1 -
+ Basic/Makefile.PL | 1 -
+ Basic/Pod/Makefile.PL | 1 -
+ Demos/Makefile.PL | 3 +--
+ Doc/Makefile.PL | 1 -
+ Doc/Pod/Makefile.PL | 1 -
+ Graphics/LUT/Makefile.PL | 1 -
+ Graphics/LUT/ramps/Makefile.PL | 3 +--
+ Graphics/LUT/tables/Makefile.PL | 3 +--
+ Graphics/Limits/Makefile.PL | 1 -
+ Graphics/Makefile.PL | 1 -
+ Graphics/PGPLOT/Makefile.PL | 3 +--
+ Graphics/PGPLOT/Window/Makefile.PL | 3 +--
+ Graphics/TriD/Makefile.PL | 1 -
+ Graphics/TriD/VRML/Makefile.PL | 1 -
+ IO/Dicom/Makefile.PL | 1 -
+ IO/FITS/Makefile.PL | 3 +--
+ IO/FastRaw/Makefile.PL | 1 -
+ IO/FlexRaw/Makefile.PL | 1 -
+ IO/HDF/Makefile.PL | 1 -
+ IO/HDF/SD/Makefile.PL | 1 -
+ IO/HDF/VS/Makefile.PL | 1 -
+ IO/Makefile.PL | 1 -
+ IO/NDF/Makefile.PL | 1 -
+ Lib/CallExt/Makefile.PL | 2 +-
+ Lib/Filter/Makefile.PL | 5 ++---
+ Lib/Fit/Makefile.PL | 1 -
+ Lib/GIS/Makefile.PL | 1 -
+ Lib/GSL/Makefile.PL | 3 +--
+ Lib/GSL/SF/Makefile.PL | 1 -
+ Lib/Makefile.PL | 1 -
+ Lib/Opt/Makefile.PL | 1 -
+ Lib/Opt/Simplex/Makefile.PL | 3 +--
+ Lib/Transform/Cartography/Makefile.PL | 3 +--
+ Perldl2/Makefile.PL | 6 ++----
+ Perldl2/Plugin/Makefile.PL | 1 -
+ Perldl2/Profile/Makefile.PL | 1 -
+ 39 files changed, 14 insertions(+), 54 deletions(-)
+
+commit 339b4980ca3793cebf5d836737f2ee768b2e7c69
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Dec 22 08:01:57 2011 -0500
+
+ Fix typo in File::Temp::tempdir()
+
+ Basic/Core/Dev.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 6d50a82796558f6458d74d43e5d461c3d09f0daf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Dec 22 07:32:09 2011 -0500
+
+ Switch to use tempdir function, not OO newdir
+
+ We still need to have robust temporary handling
+ and standardizing around File::Temp seems like
+ a good way forward. It looks like newdir() was
+ a more recent addition. Switching to the function
+ instead.
+
+ Basic/Core/Dev.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 1b66349abb51020a76e33af7dc8e7671cfc0062c
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Wed Dec 21 23:46:02 2011 -0700
+
+ Add NO_MYMETA=>1 flag to most Makefile.PL's.
+
+ ExtUtils::MakeMaker 6.57_02 (2010 Sept 8) introduced the capability to automatically generate MYMETA.yml and MYMETA.json file, in order to provide CPAN metadata. But these files are created for every Makefile.PL, which doesn't make much sense in our case since most of those files were empty. I modified the pdlpp_stdargs(_int) subs in PDL::Core::Dev to include 'NO_MYMETA'=>1, which takes care of most of them, and hand edited the others. Now there are only 4 of those file pairs create [...]
+
+ Basic/Core/Dev.pm | 2 ++
+ Basic/Core/Makefile.PL | 1 +
+ Basic/Gen/Makefile.PL | 1 +
+ Basic/Makefile.PL | 1 +
+ Basic/Pod/Makefile.PL | 1 +
+ Demos/Makefile.PL | 3 ++-
+ Doc/Makefile.PL | 1 +
+ Doc/Pod/Makefile.PL | 1 +
+ Graphics/LUT/Makefile.PL | 1 +
+ Graphics/LUT/ramps/Makefile.PL | 3 ++-
+ Graphics/LUT/tables/Makefile.PL | 3 ++-
+ Graphics/Limits/Makefile.PL | 1 +
+ Graphics/Makefile.PL | 1 +
+ Graphics/PGPLOT/Makefile.PL | 3 ++-
+ Graphics/PGPLOT/Window/Makefile.PL | 3 ++-
+ Graphics/TriD/Makefile.PL | 1 +
+ Graphics/TriD/VRML/Makefile.PL | 1 +
+ IO/Dicom/Makefile.PL | 1 +
+ IO/FITS/Makefile.PL | 3 ++-
+ IO/FastRaw/Makefile.PL | 1 +
+ IO/FlexRaw/Makefile.PL | 1 +
+ IO/HDF/Makefile.PL | 1 +
+ IO/HDF/SD/Makefile.PL | 1 +
+ IO/HDF/VS/Makefile.PL | 1 +
+ IO/Makefile.PL | 1 +
+ IO/NDF/Makefile.PL | 1 +
+ Lib/CallExt/Makefile.PL | 2 +-
+ Lib/Filter/Makefile.PL | 5 +++--
+ Lib/Fit/Makefile.PL | 1 +
+ Lib/GIS/Makefile.PL | 1 +
+ Lib/GSL/Makefile.PL | 3 ++-
+ Lib/GSL/SF/Makefile.PL | 1 +
+ Lib/Makefile.PL | 1 +
+ Lib/Opt/Makefile.PL | 1 +
+ Lib/Opt/Simplex/Makefile.PL | 3 ++-
+ Lib/Transform/Cartography/Makefile.PL | 3 ++-
+ Perldl2/Makefile.PL | 6 ++++--
+ Perldl2/Plugin/Makefile.PL | 1 +
+ Perldl2/Profile/Makefile.PL | 1 +
+ 39 files changed, 54 insertions(+), 14 deletions(-)
+
+commit 2c0617ee7de6d858cf024796a26016245c9a52cc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 21 16:42:01 2011 -0500
+
+ Update version to PDL-2.4.9_991 for RC1 edits
+
+ The focus at this point is not on code changes. We're in
+ feature freeze at this time. Please test build for your
+ various platforms (with and without badvalues if possible).
+ Documentation, web page, and PDL book updates welcome!
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 25 +++++++++++++++++++++++++
+ 3 files changed, 27 insertions(+), 2 deletions(-)
+
+commit 1622cae2a06ed4b489a176bb3b6638d239d39b4f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 21 16:36:59 2011 -0500
+
+ Update Release_Notes for 2.4.9_016 release
+
+ Release_Notes | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 2fb371d448748a51254893f1a0aab7c3443de6e5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 21 16:33:32 2011 -0500
+
+ Add pthread default detection fix
+
+ Now we check for a working pthreads install
+ with check_lib() and if it works, just go
+ with the default. Otherwise, on win32 or cygwin
+ platforms, we don't build.
+
+ Basic/Core/Makefile.PL | 26 +++++++++++++++++++++++---
+ IO/Browser/Makefile.PL | 13 ++++++++-----
+ 2 files changed, 31 insertions(+), 8 deletions(-)
+
+commit 633909c7b087a405709f726fcf30c439fb1be34d
+Merge: 915b36d 33cbd08
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Dec 21 13:04:42 2011 -0600
+
+ Merged Release_Notes
+
+commit 915b36d8f43ea421e629ac4928a10eef71c006bf
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Dec 21 13:03:13 2011 -0600
+
+ Updated Release_Notes for parser news
+
+ Release_Notes | 12 +++++++++++-
+ 1 files changed, 11 insertions(+), 1 deletions(-)
+
+commit 0443e22d5426c80f07adf38793932a4d893b3281
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Dec 21 12:58:57 2011 -0600
+
+ Improved parsing of corner cases in pdl-from-string
+
+ Implemented code (and tests) for edge cases that were bad but
+ previously allowed, including:
+
+ pdl q[ 1 pie 2]
+ pdl q[1 -+2 3]
+
+ and others.
+
+ Basic/Core/Core.pm.PL | 95 +++++++++++++++++++++++++-----------------------
+ t/pdl_from_string.t | 44 ++++++++++++++++------
+ 2 files changed, 81 insertions(+), 58 deletions(-)
+
+commit 33cbd08e9d6b3ba1547b994c0a3cc51545507f49
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 21 13:31:50 2011 -0500
+
+ Fix FFTW detect problem for SPP
+
+ Working code was in the Lib/FFTW/Makefile.PL but
+ the perldl.conf was setting the values explicitly
+ and so overriding the better defaults in the
+ Makefile.PL. This should not affect builds for
+ other platforms.
+
+ Lib/FFTW/Makefile.PL | 2 +-
+ perldl.conf | 4 ++--
+ 2 files changed, 3 insertions(+), 3 deletions(-)
+
+commit a5e5dc6b398ee230abe45dede26b4b1a6c626930
+Merge: 7f879b7 753b79a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 21 13:06:39 2011 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 753b79ab59d1463177de2b600b630b98f264c9a8
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Dec 21 10:57:17 2011 -0600
+
+ Added commented code, to be uncommented after 2.4.10 is released.
+
+ I looked back over the pdl-from-string code and realized that some
+ of the parsing could be made more strict. For example, at the
+ moment, the following input:
+
+ $piddle = pdl q[1 +-2 3];
+
+ will be interpreted as
+
+ $piddle = pdl q[1 -2 3];
+
+ In othe words, the initial plus sign is simply dropped. The new
+ code includes checks for this condition and croaks if it finds it.
+
+ Basic/Core/Core.pm.PL | 20 ++++++++++++++------
+ t/pdl_from_string.t | 8 ++++++++
+ 2 files changed, 22 insertions(+), 6 deletions(-)
+
+commit 7f879b79cc2e15ced00d2b01e265231c660d8b1c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 21 11:47:36 2011 -0500
+
+ Update release notes etc for 2.4.9_016 CPAN release
+
+ This is the final code-change release for PDL-2.4.9.
+ The next release will be RC1 for PDL-2.4.10.
+
+ Known_problems | 12 ++++--------
+ Release_Notes | 20 ++++++++++++++++++--
+ 2 files changed, 22 insertions(+), 10 deletions(-)
+
+commit 9c1b7fa436c946e8aabf65c6386db73f42b2f8b3
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Wed Dec 21 22:35:16 2011 +1100
+
+ win32/INSTALL Update info/instructions
+
+ win32/INSTALL | 105 ++++++++++++++++++++++++++++++++++++++------------------
+ 1 files changed, 71 insertions(+), 34 deletions(-)
+
+commit 02b4a413ff721a15c3f4bc6f41efcc201647ee3a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 20 19:40:31 2011 -0500
+
+ Update IO::Browser detection using Devel::CheckLib
+
+ The default is still *not* to build IO::Browser but
+ I believe the build should now work if the perldl.conf
+ option is set true.
+
+ IO/Browser/Makefile.PL | 65 ++++++++++++++++++++++++++++++++++--------------
+ IO/Browser/browse.c | 12 ++++++---
+ IO/Makefile.PL | 17 +++---------
+ 3 files changed, 59 insertions(+), 35 deletions(-)
+
+commit 39daec216d615094878d5dad99d2d46bd04ad668
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 20 17:50:17 2011 -0500
+
+ Had to move $^W=0 before the pp_line_number stuff
+
+ t/pp_line_numbers.t | 13 +++++++------
+ 1 files changed, 7 insertions(+), 6 deletions(-)
+
+commit 187de8e192b2e954c7048257c78a0e26ef022da2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 20 09:41:06 2011 -0500
+
+ Added TODO to t/limits_trans_err.t
+
+ This will still allow for the tests to run but won't fail
+ if the approx() checks have not yet been implemented...
+
+ t/limits_trans_err.t | 76 +++++++++++++++++++++++---------------------------
+ 1 files changed, 35 insertions(+), 41 deletions(-)
+
+commit 81f8ece24814ba7e5e4c00dfbe1771e7c1061e30
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 20 09:17:54 2011 -0500
+
+ Use approx in limits_round.t, is_deeply in limits_trans_err.t
+
+ It is usually a bad idea to check for floating point
+ equality as platform differences can cause fails that
+ aren't significant. I replaced '==' by approx() in
+ t/limits_round.t and fixed the implementation of approx()
+ which was broken for non-piddle inputs. The method call
+ syntax should not be needed as PDL::LiteF (the smallest
+ possible set of modules to run PDL) does include PDL::Ops.
+
+ Took a look at t/limits_trans_err.t but couldn't think
+ of a good way to fix quickly but did notice that
+ eq_array() has been deprecated in favor of is_deeply()
+ by Test::More and made that change.
+
+ Basic/Core/Core.pm.PL | 3 ++-
+ t/limits_round.t | 7 ++-----
+ t/limits_trans_err.t | 8 ++++----
+ 3 files changed, 8 insertions(+), 10 deletions(-)
+
+commit fa3eca31a2061283d5ae7e0c5e4df105fe9bb2fd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 19 15:18:40 2011 -0500
+
+ Update FAQ 4.4: How can I install PDL in a non-standard location?
+
+ Basic/Pod/FAQ.pod | 267 ++++++++++++++++-------------------------------------
+ 1 files changed, 79 insertions(+), 188 deletions(-)
+
+commit be7ba292179dee6b14fbc6cc38cd6e5c64fe3614
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 19 11:20:40 2011 -0500
+
+ Add pp_croaking.t + pp_line_numbers.t to MANIFEST
+
+ I noticed the tests were missing in the latest CPAN developers
+ release.
+
+ NOTE: If you add code such as tests to the PDL git that
+ needs to be part of the distribution. Please add the
+ appropriate entry in MANIFEST.
+
+ MANIFEST | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 8ebfd804f64e503cb5c077c7c18c17496cfbe7de
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 19 09:47:52 2011 -0500
+
+ Update VERSION to 2.4.9_015 for more development
+
+ It is expected that the next release will actually be
+ the first release candidate for PDL-2.4.10
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit c06185edaa79dc87510c7329a283f8315b6dffb9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 19 09:29:27 2011 -0500
+
+ Fix one too many =cut which broke Core.pm
+
+ Basic/Core/Core.pm.PL | 2 --
+ 1 files changed, 0 insertions(+), 2 deletions(-)
+
+commit e7168826404c0c3944d96fede47ece6a680b9af5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 18 21:41:58 2011 -0500
+
+ Various POD fixes for *.pd and *.PL files
+
+ Basic/Core/Core.pm.PL | 13 ++++++++++---
+ Basic/Ops/ops.pd | 9 +++++++++
+ Basic/Ufunc/ufunc.pd | 30 ++++++++++++++++++++++++++----
+ IO/NDF/NDF.pm.PL | 14 +++++++++-----
+ Lib/FFTW/fftw.pd | 2 --
+ Lib/Fit/Gaussian/gaussian.pd | 20 ++++++++++----------
+ Lib/Slatec/slatec.pd | 42 +++++++++++++++++++++++++++++++-----------
+ 7 files changed, 95 insertions(+), 35 deletions(-)
+
+commit 78fbea042df9a3a9d572098daae64946b862fed3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 18 21:02:06 2011 -0500
+
+ POD cleanup for pdldoc.PL
+
+ pdldoc.PL | 9 +++++++++
+ 1 files changed, 9 insertions(+), 0 deletions(-)
+
+commit 25db7f07876be9941083d23e79ed25ba03a17735
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 18 20:57:52 2011 -0500
+
+ Turn off warnings for t/pp_line_numbers.t
+
+ t/pp_line_numbers.t | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 6fa84f25936a5bd366105521a566319d1fe98746
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 18 20:27:18 2011 -0500
+
+ Add PDL_BUILD_DIR to perldl.conf
+
+ This is a record of the directory where PDL was built.
+ It is useful for determining perl library paths without
+ messy relative ../../.. stuff.
+
+ Makefile.PL | 2 ++
+ perldl.conf | 6 ++++--
+ 2 files changed, 6 insertions(+), 2 deletions(-)
+
+commit 0ce0e8e654fad0540bf1c5bf43b09458db47aceb
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 18 16:09:32 2011 -0500
+
+ Update EU::MM required $VERSION to 6.31
+
+ This is the first release of ExtUtils::MakeMaker that has
+ support for INSTALL_BASE as a location for non-system module
+ repositories. It installs in the same fashion as Module::Build's
+ --install-base option and is *much* easier to comprehend where
+ things will end up. I've added a note to DEPENDENCIES that
+ builds using earlier versions should still be possible with
+ some minor edits.
+
+ We'll need to update the PDL::FAQ related to this.
+
+ DEPENDENCIES | 10 ++++++++++
+ Makefile.PL | 3 ++-
+ Release_Notes | 12 ++++++++++++
+ 3 files changed, 24 insertions(+), 1 deletions(-)
+
+commit e1651df5088ed1f265a50f871a1da0a2e94d202b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 18 14:41:20 2011 -0500
+
+ Add VERSION to PDL::Constants and update MANIFEST.SKIP
+
+ Basic/Constants.pm | 2 ++
+ MANIFEST.SKIP | 52 +++++++++++++++++++++++++++-------------------------
+ 2 files changed, 29 insertions(+), 25 deletions(-)
+
+commit cacd2248d889b036ad4f7f4060e806098f4c8805
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 18 14:13:14 2011 -0500
+
+ Use File::Temp->newdir in trylink
+
+ We've been getting some mysterious fails for some CPAN testers
+ builds that I've tracked down to weak tempfile names and tempdir
+ creation and usage. Switching to File::Temp should fix things.
+
+ Basic/Core/Dev.pm | 16 ++++++++--------
+ Release_Notes | 5 +++++
+ 2 files changed, 13 insertions(+), 8 deletions(-)
+
+commit 2b666feabf0a080e3368115d42fccc6405598fbf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 18 13:53:00 2011 -0500
+
+ Switch tests to use File::Temp::tempdir
+
+ t/fastraw.t | 4 +++-
+ t/flexraw.t | 3 ++-
+ t/gd_tests.t | 3 ++-
+ 3 files changed, 7 insertions(+), 3 deletions(-)
+
+commit eaec209911314f75fd101c8bb35b480f947c9f1b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 17 14:56:45 2011 -0500
+
+ POD cleanup for image2d.pd
+
+ We really should revisit the PDL docs generation so that
+ the docs that are shown on http://search.cpan.org look
+ right. Maybe we could add a step in PP that modifies
+ the docs (e.g., ==head to =head) and so forth so that
+ the only docs visible would be the generated ones.
+
+ Lib/Image2D/image2d.pd | 47 ++++++++++++++++++++++++++++++++++++++++++++++-
+ 1 files changed, 46 insertions(+), 1 deletions(-)
+
+commit 153b93df041303cfb6f69daba9d6add9b9f9a0b4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 16 15:50:13 2011 -0500
+
+ Minor cleanup in Threading.pod
+
+ Basic/Pod/Threading.pod | 22 +++++++++++-----------
+ 1 files changed, 11 insertions(+), 11 deletions(-)
+
+commit c765d8265b069ba869cfea8ce70f9720880b184c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 16 15:32:44 2011 -0500
+
+ Update Known_problems and Release_Notes
+
+ Known_problems | 4 ++++
+ Release_Notes | 12 +++++++++++-
+ 2 files changed, 15 insertions(+), 1 deletions(-)
+
+commit 92dfae3fa638060123cdea1b4561c7acfa1680a9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 16 15:19:37 2011 -0500
+
+ Update version number in Perldl2.pm profile
+
+ Perldl2/Profile/Perldl2.pm | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 485d13c225a7e7a2efb45d965c57f94b892dbf28
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 16 15:16:44 2011 -0500
+
+ Add new pdl2 CleanErrors plugin
+
+ This filters out the eval, Class::MOP, Devel::REPL,
+ Lexical::Persistence, and any other non-PDL related lines from
+ the full (verbose!) error traceback.
+
+ MANIFEST | 1 +
+ Perldl2/Plugin/CleanErrors.pm | 59 +++++++++++++++++++++++++++++++++++++++++
+ Perldl2/Plugin/Makefile.PL | 3 +-
+ Perldl2/Profile/Perldl2.pm | 3 +-
+ 4 files changed, 64 insertions(+), 2 deletions(-)
+
+commit 0adfa89637c16c3e1f3590b817c079ce82b3ba7c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 16 09:48:57 2011 -0500
+
+ Use File::Temp::tempfile in t/flexraw_fortran.t
+
+ With luck this will resolve the erratic test fails due to
+ temp file issues.
+
+ t/flexraw_fortran.t | 27 +++++++++++++--------------
+ 1 files changed, 13 insertions(+), 14 deletions(-)
+
+commit 29366c7a69db4f1527aa4505ddbb6de60a671490
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Dec 15 16:51:25 2011 -0500
+
+ Update PDL_CONFIG_VERSION for perldl.conf addition
+
+ I forgot to bump the version information for the new
+ PDL_BUILD_VERSION key...
+
+ perldl.conf | 3 +--
+ 1 files changed, 1 insertions(+), 2 deletions(-)
+
+commit b88f28b7c29cdeefdcd7494287f6d6d02db4bd0b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Dec 15 16:48:15 2011 -0500
+
+ Add PDL_BUILD_VERSION to perldl.conf keys
+
+ This gives us a way to check that the PDL version being
+ built corresponds to the given Config.pm file in case
+ PDL gets installed into two different locations.
+
+ Makefile.PL | 2 ++
+ perldl.conf | 2 ++
+ 2 files changed, 4 insertions(+), 0 deletions(-)
+
+commit ed9a3e8adb1bee88c0ce9653dbd649527e436425
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Dec 15 16:47:58 2011 -0500
+
+ Update VERSION to 2.4.9_015 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 056057dfc7a61668920cd315ede1924fa8c69dc6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Dec 15 16:05:33 2011 -0500
+
+ Update Known_problems for CPAN dev release
+
+ Known_problems | 3 +++
+ PDLdb.pl | 5 +++--
+ 2 files changed, 6 insertions(+), 2 deletions(-)
+
+commit f9c2f67f617937c5ed8005c8e256085480847324
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 14 18:56:24 2011 -0500
+
+ Candidate fix for PDL::Minuit build on FreeBSD
+
+ Lib/Minuit/Makefile.PL | 18 +++++++++---------
+ Release_Notes | 2 ++
+ 2 files changed, 11 insertions(+), 9 deletions(-)
+
+commit 1256452cb42f186660e4f2f63d4f6e21e905a31a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 14 09:47:00 2011 -0500
+
+ Move no warnings qw(misc) to Basic/Lvalue.pm
+
+ I originally tried to stop the Lvalue warnings from recent perl
+ test reports by putting the directive in the test files. This
+ was incorrect because the warnings pragma has block scope and
+ does not leak across files so the pragma has been added to the
+ eval in Lvalue.pm that declares the PDL lvalue routines and I've
+ removed the previous attempt from all the t/*.t files.
+
+ Basic/Lvalue.pm | 5 +++--
+ t/aaa_load.t | 1 -
+ t/argtest.t | 1 -
+ t/autoload.t | 1 -
+ t/bad.t | 1 -
+ t/basic.t | 1 -
+ t/bess.t | 1 -
+ t/bool.t | 1 -
+ t/callext.t | 1 -
+ t/clump.t | 1 -
+ t/complex.t | 1 -
+ t/config.t | 1 -
+ t/constants.t | 1 -
+ t/constructor.t | 1 -
+ t/conv.t | 1 -
+ t/core.t | 1 -
+ t/croak.t | 1 -
+ t/diskcache.t | 1 -
+ t/dumper.t | 1 -
+ t/erf.t | 1 -
+ t/erfi.t | 1 -
+ t/familyfree.t | 1 -
+ t/fastraw.t | 1 -
+ t/fft.t | 1 -
+ t/fftw.t | 1 -
+ t/fits.t | 1 -
+ t/flexraw.t | 1 -
+ t/flexraw_fortran.t | 1 -
+ t/flow.t | 1 -
+ t/foo.t | 1 -
+ t/func.t | 1 -
+ t/gauss.t | 1 -
+ t/gd_oo_tests.t | 1 -
+ t/gd_tests.t | 1 -
+ t/gis_proj.t | 1 -
+ t/gsl_diff.t | 1 -
+ t/gsl_integ.t | 1 -
+ t/gsl_interp.t | 1 -
+ t/gsl_mroot.t | 1 -
+ t/gsl_rng.t | 1 -
+ t/gsl_sf.t | 1 -
+ t/hdf_sd.t | 1 -
+ t/hdf_vdata.t | 1 -
+ t/hdf_vgroup.t | 1 -
+ t/hdrs.t | 1 -
+ t/hist.t | 1 -
+ t/howbig.t | 1 -
+ t/ica.t | 1 -
+ t/image2d.t | 7 +++----
+ t/imagend.t | 1 -
+ t/imagergb.t | 1 -
+ t/inlinepdlpp.t | 1 -
+ t/interp.t | 1 -
+ t/interp_slatec.t | 1 -
+ t/interpol.t | 1 -
+ t/iotypes.t | 1 -
+ t/limits_00.t | 1 -
+ t/limits_errb.t | 1 -
+ t/limits_keyspecs.t | 1 -
+ t/limits_normalize_dsets.t | 1 -
+ t/limits_range.t | 1 -
+ t/limits_round.t | 1 -
+ t/limits_trans.t | 1 -
+ t/limits_trans_err.t | 1 -
+ t/limits_ulimits.t | 1 -
+ t/linfit.t | 1 -
+ t/lut.t | 1 -
+ t/lvalue.t | 1 -
+ t/magic.t | 1 -
+ t/matmult.t | 1 -
+ t/matrix.t | 1 -
+ t/matrixops.t | 1 -
+ t/minuit.t | 1 -
+ t/misc.t | 1 -
+ t/ndf.t | 1 -
+ t/niceslice.t | 1 -
+ t/nsdatahandle.t | 1 -
+ t/ones.t | 1 -
+ t/opengl.t | 1 -
+ t/ops.t | 1 -
+ t/pdl_from_string.t | 1 -
+ t/pdlchar.t | 1 -
+ t/pgplot.t | 1 -
+ t/physical.t | 1 -
+ t/pic_16bit.t | 1 -
+ t/picnorgb.t | 1 -
+ t/picrgb.t | 1 -
+ t/plplot.t | 1 -
+ t/pnm.t | 1 -
+ t/poly.t | 1 -
+ t/polyroots.t | 1 -
+ t/pp_croaking.t | 1 -
+ t/pptest.t | 1 -
+ t/primitive.t | 1 -
+ t/primitive2.t | 1 -
+ t/proj_transform.t | 1 -
+ t/proj_transform2.t | 1 -
+ t/pthread.t | 1 -
+ t/pthreadBarf.t | 1 -
+ t/pthread_auto.t | 1 -
+ t/reduce.t | 1 -
+ t/refs.t | 1 -
+ t/requiredmods.t | 1 -
+ t/round.t | 1 -
+ t/scope.t | 1 -
+ t/segfault.t | 1 -
+ t/simplex.t | 1 -
+ t/slatec.t | 1 -
+ t/slice.t | 1 -
+ t/storable.t | 1 -
+ t/subclass.t | 1 -
+ t/subclass2.t | 1 -
+ t/subclass3.t | 1 -
+ t/subclass4.t | 1 -
+ t/thread.t | 1 -
+ t/thread_def.t | 1 -
+ t/transform.t | 1 -
+ t/trig.t | 1 -
+ t/ufunc.t | 1 -
+ t/vaffine.t | 1 -
+ t/xvals.t | 1 -
+ 121 files changed, 6 insertions(+), 125 deletions(-)
+
+commit a8274fa4fe40ec3d089de321f42fdfd14f71bcdb
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Dec 13 20:57:25 2011 -0600
+
+ Updated release notes for pp_line_numbers
+
+ Release_Notes | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit 18d00e438839c9d5f770f1745584b6e007bd9066
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Dec 13 20:42:25 2011 -0600
+
+ Finished PDL::PP::pp_line_numbers!
+
+ I've finished work on this by correcting a few minor off-by-ones
+ and by updating the PDL::PP docs. I also took the liberty of
+ changing (fixing, I hope) a few quirky stylistic flourishes in
+ the PDL::PP docs that have always irked me. Hope that doesn't
+ bother anybody.
+
+ Basic/Gen/PP.pm | 4 +-
+ Basic/Pod/PP.pod | 175 +++++++++++++++++++++++++++++++++-----------------
+ t/pp_line_numbers.t | 38 +++++++-----
+ 3 files changed, 139 insertions(+), 78 deletions(-)
+
+commit c4c993571e027ee62143099e7e0e13d09b09e992
+Merge: 3c72a23 e3f37ed
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Dec 13 19:33:57 2011 -0600
+
+ Merge branch 'master' into pp_line_numbers
+
+commit e3f37edb5da2e332a4d4948c9aa5eadadacf82c4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 13 17:57:22 2011 -0500
+
+ Add pnpoly implementation to PDL::Image2D
+
+ This is from the perldl mailing list discussion at
+ http://mailman.jach.hawaii.edu/pipermail/perldl/2010-September/004489.html
+ with some fixes. Still would be nice to have more flexibility
+ in the input piddles (number and shape).
+
+ Lib/Image2D/image2d.pd | 64 ++++++++++++++++++++++++++++++++++++++++++++++++
+ Release_Notes | 4 +++
+ t/image2d.t | 13 +++++++++-
+ 3 files changed, 80 insertions(+), 1 deletions(-)
+
+commit 0cd1eeee8e387d85fdd2c62e7e39b789079e269d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 13 17:56:14 2011 -0500
+
+ minor POD format fixes for PDL::IO::Misc
+
+ IO/Misc/misc.pd | 14 +++++++-------
+ 1 files changed, 7 insertions(+), 7 deletions(-)
+
+commit 3c72a23d4f894c2706badd39ddc12c7e21374e78
+Merge: 95c9fe4 cca456b
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Dec 12 22:49:07 2011 -0600
+
+ Merge branch 'master' into pp_line_numbers
+
+commit 95c9fe489ba039971c58ad05d4510013908656e6
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Dec 12 22:47:50 2011 -0600
+
+ A nearly-working version of pp_line_numbers for PDL::PP.
+
+ I am very close to having a working version of pp_line_numbers. I
+ am not sure about off-by-one errors, though, and it's difficult to
+ write a test for this without being certain that the tests are not
+ off by one. :-)
+
+ Basic/Gen/PP.pm | 18 +++++++++++++++++-
+ t/pp_line_numbers.t | 6 +++---
+ 2 files changed, 20 insertions(+), 4 deletions(-)
+
+commit cca456bd42c5b5e4f2694af2796748fceca20927
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Dec 12 22:38:18 2011 -0600
+
+ Updated Release_Notes
+
+ Release_Notes | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 758c9b211142b95a1414ad1d79e9c0ecd86f7259
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Dec 12 22:31:51 2011 -0600
+
+ Cleaned up a couple of PDL::PP warnings.
+
+ PDL::PP has begun generating warnings when run under the -w flag,
+ which happens these days under Perl 5.14. I've examined the code
+ and cleaned it up as best I can. I'm still not sue how the symbol
+ table class is used, but I'm fairly certain that the setting of
+ the Sym2Id key in add_ids() is useless since that key is never
+ used elsewhere. As it is, these changes don't break the compilation
+ of any of the core modules, so I expect that it didn't do anything
+ important.
+
+ Basic/Gen/PP.pm | 17 ++++++++++-------
+ Basic/Gen/PP/SymTab.pm | 19 ++++++++++++++++++-
+ 2 files changed, 28 insertions(+), 8 deletions(-)
+
+commit 0b6ab203139698f8bcd3750a6338654fcd595ab3
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Dec 12 20:11:13 2011 -0600
+
+ Fixed 'my %ops' warning with PDL::PP::PDLCode.
+
+ Lexical (i.e. 'my') variables have file scope, but they were being
+ used in PDL::PP::PDLCode as if they had package scope. The obvious
+ fix was to declare them all as 'our' variables, giving them the
+ package scope they assumed they had.
+
+ Basic/Gen/PP/PDLCode.pm | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit a08accf216efe7f8d421583fdd5cb7ce3eadf69d
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Mon Dec 12 13:12:12 2011 +1100
+
+ t/pdl_from_string.t Catch perl bug
+
+ ActivePerl 5.8.0 (build 806) asserts that NaN == NaN, and
+ test 29 therefore fails.
+ There may be other 5.8.x builds of perl that do the same.
+ This patch aims to detect that condition and skip test 29.
+ On detection of this condition, appropriate warning messages
+ are also emitted.
+
+ t/pdl_from_string.t | 28 ++++++++++++++++++----------
+ 1 files changed, 18 insertions(+), 10 deletions(-)
+
+commit 0559b36b24e7a9d8dbec872b7606b772a68bdf50
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 10 17:33:27 2011 -0500
+
+ Add sqrt(-1) to PDL::Constants
+
+ Changed to EXPORT_OK all constants to avoid name clashes and
+ updated the docs. Now have the imaginary unit as well, either
+ I (for scientists) or J (for engineers). Note: you can still
+ get i from the PDL::Complex module directly. These are upper
+ case to make it clear that they are *constants*.
+
+ Basic/Constants.pm | 36 ++++++++++++++++++++++++++++++++++--
+ Basic/default.perldlrc | 4 ++--
+ Release_Notes | 4 +++-
+ perldl.conf | 2 +-
+ t/constants.t | 4 +++-
+ 5 files changed, 43 insertions(+), 7 deletions(-)
+
+commit 2940f07383f1c1a676e06b1885139998cb887ed9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 10 12:13:16 2011 -0500
+
+ Update VERSION to 2.4.9_014 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 29f719d4408509c672fca3dca91fefb907c059cb
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 10 12:10:19 2011 -0500
+
+ Update readmes and fix pthread detect for *BSD
+
+ Basic/Core/Makefile.PL | 7 +++++++
+ Release_Notes | 4 ++++
+ cygwin/INSTALL | 28 ++++++++++++----------------
+ cygwin/README | 12 ++----------
+ perldl.conf | 2 +-
+ 5 files changed, 26 insertions(+), 27 deletions(-)
+
+commit b090441c4b3b6acb57e46ce0914a618d0360a11d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 9 15:21:57 2011 -0500
+
+ Update Known_problems and Release_Notes
+
+ Known_problems | 1 -
+ Release_Notes | 13 ++++++++++++-
+ 2 files changed, 12 insertions(+), 2 deletions(-)
+
+commit 5d6f9c07fbc489d70b09f2929722ce5348c76041
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 9 14:59:00 2011 -0500
+
+ Add diags for missing PDL::IO::Pic converters
+
+ This can cause fails in the various t/pic*.t tests since the
+ missing converters are not always appropriately checked for
+ and skipped. Now the tests will print the actual values
+ for the converters in case of fails so that we can try to
+ diagnose the full fix to the problem.
+
+ IO/Pnm/Pic.pm | 4 ++--
+ t/pic_16bit.t | 6 +++---
+ t/picnorgb.t | 12 ++++++++++++
+ t/picrgb.t | 15 ++++++++++++++-
+ 4 files changed, 31 insertions(+), 6 deletions(-)
+
+commit 0038d0855d642912fb41db55d6d1d274302b5dd2
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Dec 8 12:10:03 2011 -0700
+
+ Add a few notes to PP.pod about OtherPars and $COMP().
+
+ Just a note in the OtherPars entry of Appendix A pointing back to
+ $COMP, which is crucial to implementing OtherPars correctly.
+
+ Basic/Pod/PP.pod | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 68a032342dbcf221ff22cd05823e8c7fd84b77f2
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Wed Dec 7 17:14:01 2011 -0700
+
+ Add connected 4-component labeling to PDL::Image2D.
+
+ cc8compt alread existed which provided connected 8-component labeling.
+ I renamed that to ccNcompt, and added two new PDL subs cc8compt and
+ cc4compt, which just use ccNcompt as the underlying engine. The
+ difference between the cc8 and cc4 is just whether the diagonals
+ are used in the image segmentation.
+
+ Lib/Image2D/image2d.pd | 73 ++++++++++++++++++++++++++++++++++++++++++------
+ t/image2d.t | 11 ++++++-
+ 2 files changed, 74 insertions(+), 10 deletions(-)
+
+commit 4a8e99f10efbfe792d8d49491d731c37ad2c893c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 5 10:16:17 2011 -0500
+
+ Fix t/proj_transform.t check values for FITS fix
+
+ Now that the FITS coordinates bug has been resolved,
+ the check values for t/proj_transform.t have changed
+ slightly. Updating with new ones.
+
+ t/proj_transform.t | 198 ++++++++++++++++++++++++++--------------------------
+ 1 files changed, 99 insertions(+), 99 deletions(-)
+
+commit f5ea09b5d3acb02027e7a134098184b456732d2a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 4 12:03:21 2011 -0500
+
+ Update VERSION to 2.4.9_013 for more devel
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 489c6fc346821f8c48cc0dc1a1bd0b0d90ffc0a6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 4 12:01:42 2011 -0500
+
+ Update Release_Notes for 2.4.9_012 release
+
+ Release_Notes | 7 ++++++-
+ 1 files changed, 6 insertions(+), 1 deletions(-)
+
+commit 7b11ef720ca21f46fcd2b53663a56b21e113fea7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 4 11:12:58 2011 -0500
+
+ Fix t/proj_transform2.t to match fix to FITS
+
+ t/proj_transform2.t | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit dcd51f83ad8849cc7bbf205627c5b9bda79c0428
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 4 10:25:57 2011 -0500
+
+ Update VERSION to 2.4.9_012 for more devel
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 89c60d43fd80dc258215f41b0d00b7f543886a62
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 4 10:05:44 2011 -0500
+
+ Skip pthreads build for win32 unless found...
+
+ ...or detected or specified.
+
+ Basic/Core/Makefile.PL | 12 ++++++++----
+ 1 files changed, 8 insertions(+), 4 deletions(-)
+
+commit bcc19144dbddb63b5f5829109f959ddcf1d3552c
+Merge: 90159e2 9ff2161
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Dec 2 18:22:27 2011 -0600
+
+ Merge branch 'master' into pp_line_numbers
+
+commit 4e4f99b98b98066e213b4567abd0a5f83698a37b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 2 13:15:52 2011 -0500
+
+ Add no warnings qw(misc); to tests
+
+ This should quiet warnings introduced in recent perls for
+ lvalue sub usage found in PDL. In the future, we should
+ make the warnings control more specific to the exact code
+ sections/modules with the problem. We'll need someone with
+ the latest version of perl to track these down.
+
+ t/aaa_load.t | 1 +
+ t/argtest.t | 1 +
+ t/autoload.t | 1 +
+ t/bad.t | 1 +
+ t/basic.t | 1 +
+ t/bess.t | 1 +
+ t/bool.t | 1 +
+ t/callext.t | 1 +
+ t/clump.t | 1 +
+ t/complex.t | 1 +
+ t/config.t | 1 +
+ t/constants.t | 1 +
+ t/constructor.t | 1 +
+ t/conv.t | 1 +
+ t/core.t | 1 +
+ t/croak.t | 1 +
+ t/diskcache.t | 1 +
+ t/dumper.t | 1 +
+ t/erf.t | 1 +
+ t/erfi.t | 1 +
+ t/familyfree.t | 1 +
+ t/fastraw.t | 1 +
+ t/fft.t | 1 +
+ t/fftw.t | 1 +
+ t/fits.t | 1 +
+ t/flexraw.t | 1 +
+ t/flexraw_fortran.t | 1 +
+ t/flow.t | 1 +
+ t/foo.t | 1 +
+ t/func.t | 1 +
+ t/gauss.t | 1 +
+ t/gd_oo_tests.t | 1 +
+ t/gd_tests.t | 1 +
+ t/gis_proj.t | 1 +
+ t/gsl_diff.t | 1 +
+ t/gsl_integ.t | 1 +
+ t/gsl_interp.t | 1 +
+ t/gsl_mroot.t | 1 +
+ t/gsl_rng.t | 1 +
+ t/gsl_sf.t | 1 +
+ t/hdf_sd.t | 1 +
+ t/hdf_vdata.t | 1 +
+ t/hdf_vgroup.t | 1 +
+ t/hdrs.t | 1 +
+ t/hist.t | 1 +
+ t/howbig.t | 1 +
+ t/ica.t | 1 +
+ t/image2d.t | 1 +
+ t/imagend.t | 1 +
+ t/imagergb.t | 1 +
+ t/inlinepdlpp.t | 1 +
+ t/interp.t | 1 +
+ t/interp_slatec.t | 1 +
+ t/interpol.t | 1 +
+ t/iotypes.t | 1 +
+ t/limits_00.t | 1 +
+ t/limits_errb.t | 1 +
+ t/limits_keyspecs.t | 1 +
+ t/limits_normalize_dsets.t | 1 +
+ t/limits_range.t | 1 +
+ t/limits_round.t | 1 +
+ t/limits_trans.t | 1 +
+ t/limits_trans_err.t | 1 +
+ t/limits_ulimits.t | 1 +
+ t/linfit.t | 1 +
+ t/lut.t | 1 +
+ t/lvalue.t | 1 +
+ t/magic.t | 1 +
+ t/matmult.t | 3 ++-
+ t/matrix.t | 1 +
+ t/matrixops.t | 1 +
+ t/minuit.t | 1 +
+ t/misc.t | 1 +
+ t/ndf.t | 1 +
+ t/niceslice.t | 1 +
+ t/nsdatahandle.t | 1 +
+ t/ones.t | 1 +
+ t/opengl.t | 1 +
+ t/ops.t | 1 +
+ t/pdl_from_string.t | 1 +
+ t/pdlchar.t | 1 +
+ t/pgplot.t | 1 +
+ t/physical.t | 1 +
+ t/pic_16bit.t | 3 ++-
+ t/picnorgb.t | 1 +
+ t/picrgb.t | 1 +
+ t/plplot.t | 1 +
+ t/pnm.t | 1 +
+ t/poly.t | 1 +
+ t/polyroots.t | 1 +
+ t/pp_croaking.t | 1 +
+ t/pptest.t | 1 +
+ t/primitive.t | 1 +
+ t/primitive2.t | 1 +
+ t/proj_transform.t | 1 +
+ t/proj_transform2.t | 1 +
+ t/pthread.t | 1 +
+ t/pthreadBarf.t | 1 +
+ t/pthread_auto.t | 1 +
+ t/reduce.t | 1 +
+ t/refs.t | 1 +
+ t/requiredmods.t | 1 +
+ t/round.t | 1 +
+ t/scope.t | 1 +
+ t/segfault.t | 1 +
+ t/simplex.t | 1 +
+ t/slatec.t | 1 +
+ t/slice.t | 1 +
+ t/storable.t | 1 +
+ t/subclass.t | 1 +
+ t/subclass2.t | 1 +
+ t/subclass3.t | 1 +
+ t/subclass4.t | 1 +
+ t/thread.t | 1 +
+ t/thread_def.t | 1 +
+ t/transform.t | 1 +
+ t/trig.t | 1 +
+ t/ufunc.t | 1 +
+ t/vaffine.t | 1 +
+ t/xvals.t | 1 +
+ 120 files changed, 122 insertions(+), 2 deletions(-)
+
+commit 9ff2161e320fc3c3bdc3d6571072a7ee7c2fe2ba
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Dec 2 11:42:32 2011 -0600
+
+ Added tests for PDL::PP croaking.
+
+ As I am making an effort to add better error messages, I needed to
+ add tests for those messages. These are they.
+
+ t/pp_croaking.t | 31 +++++++++++++++++++++++++++++++
+ 1 files changed, 31 insertions(+), 0 deletions(-)
+
+commit b110134a21c4ebf2a81e45f5cdb93e016414bbc9
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Dec 2 11:23:28 2011 -0600
+
+ Basic error messages for malformed PDL::PP.
+
+ PDL::PP does a bad job checking for and reporting errors of
+ omission. A simple example that really tripped me up (and delayed
+ my working on something else for about a week) is this:
+
+ loop %{
+ ....
+ %}
+
+ Notice the error there? I forgot to specify the dimension over
+ which to loop. Before these changes, PDL::PP would croak out on an
+ incorrect array access, because it never added the left-hand %{.
+ Talk about confusing, the error wasn't even the start of being
+ useful.
+
+ Now, that particular error gets caught. Certain others can hopefully
+ be added as they arise.
+
+ Basic/Gen/PP.pm | 7 +++++
+ Basic/Gen/PP/PDLCode.pm | 64 ++++++++++++++++++++++++++++++++++++++++++++++-
+ 2 files changed, 70 insertions(+), 1 deletions(-)
+
+commit d8a08242cc6b8de39839871891fa1e97b86cc811
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Dec 2 11:19:43 2011 -0600
+
+ Minor modernization of pptest.t
+
+ t/pptest.t | 34 ++++++++++++++++------------------
+ 1 files changed, 16 insertions(+), 18 deletions(-)
+
+commit 90159e27161c78f4a1cf9fd77e9f43bea21eb66f
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Dec 2 11:17:33 2011 -0600
+
+ First set of code for PDL::PP::pp_line_numbers
+
+ This includes the function along with a set of tests. Most of the
+ tests fail, but they are marked as TODO, so they don't break the
+ test suite.
+
+ Basic/Gen/PP.pm | 14 ++++++++++++-
+ t/pp_line_numbers.t | 52 +++++++++++++++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 65 insertions(+), 1 deletions(-)
+
+commit 1ba5ee69543c263ee8cde76d5cc32107b38df776
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Dec 2 11:10:26 2011 -0600
+
+ Fixed two weird variable interpolations in PDL::PP
+
+ There was some code to generate text in PDL::PP that did not properly
+ escape the variables being interpolated. That is, it *improperly*
+ escaped them, but in a way that worked. Here's an example of the error:
+
+ my $a = 'counter';
+ my $string = " int $a\_int = 0;\n";
+
+ When run with warnings, Perl complains that it doesn't know what you
+ mean by "\_", and it ends up just ignoring the "\" character to
+ give you this string
+
+ " int counter_int = 0;\n"
+
+ The proper way to do this (which does not produce warnings) is like so:
+
+ my $string = " int ${a}_int = 0;\n";
+
+ I fixed that in a couple of places.
+
+ Basic/Gen/PP.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 5b99a323e18b44736ad0b744fdd85dc83fea1477
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu Dec 1 15:43:56 2011 -0600
+
+ Fixed bug in PDL::PP verbose reporting.
+
+ First, a section of code was not clearly indented. I fixed that.
+
+ Second, PDL::PP::Rule defined a function called report() that is
+ meant to simplify the reporting of output when verbose output is
+ requested. (You request verbose output by setting $::PP_VERBOSE to
+ a true value in your .pd file.) However, it was written as a
+ function, not an object method; in other words, PDL::PP::Rule
+ simply called report() with a string to print, like this:
+
+ report('Something useful');
+
+ This meant that subclasses of PDL::PP::Rule could not call the
+ function without explicitly naming the function package.
+ Unfortunately, they were doing just that. PDL::PP::Rule::Returns
+ had code like this:
+
+ $self->report('Something useful');
+
+ Perl correctly resolved the method to the one defined in
+ PDL::PP::Rule, but that function simply printed the first argument,
+ i.e. *the Rule object*. To make matters more confusing, Rules have
+ a method for stringification, so it was not entirely clear where
+ this error had crept in. The only real trigger was the lack of
+ newlines where I expected to see them.
+
+ My solution to this problem is to turn report() into a bona fide
+ method, and to call it as a method wherever it is used. With this
+ change in place, the verbose reporting finally works correctly.
+
+ Basic/Gen/PP.pm | 40 +++++++++++++++++++++-------------------
+ 1 files changed, 21 insertions(+), 19 deletions(-)
+
+commit 5037b713094ef26a0afb9bf8be6158c357b083fb
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Nov 29 10:00:38 2011 -0500
+
+ Update Release_Notes and Known_problems
+
+ Known_problems | 5 +----
+ Release_Notes | 18 ++++++++++++++++++
+ 2 files changed, 19 insertions(+), 4 deletions(-)
+
+commit 5086f3c74824e36f4669291510a351b64b2e54d8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Nov 29 10:00:07 2011 -0500
+
+ Fix syntax error in readenvi.pdl
+
+ IO/ENVI/readenvi.pdl | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 6b3c21478f476119bfc8fcb37378999aafa9fd28
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Nov 29 09:57:24 2011 -0500
+
+ Fix forcebuild option for PROJ4 modules
+
+ The Lib/GIS/Proj/Makefile.PL and Lib/Transform/Proj4/Makefile.PL
+ would set the $forcebuild option if WITH_PROJ was set in the
+ perldl.conf file but then would stop the build if auto-detection
+ failed. That would give the user no way to work around a problem
+ in the library detection. This solution allows the user to
+ force a build no matter what. If the options are correct, the
+ modules will work.
+
+ Lib/GIS/Proj/Makefile.PL | 4 ++--
+ Lib/Transform/Proj4/Makefile.PL | 4 ++--
+ 2 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 65b37a6849122fe6b09978c997b7d52f1cd66dc2
+Merge: be698f0 0d4e3a5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 27 13:53:16 2011 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit be698f06d0fe043940310b447ddb0f7120f6afe4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 27 13:51:12 2011 -0500
+
+ Remove vestigial *.pl files in t/
+
+ These appear to have been from the original development
+ of the corresponding t/picnorgb.t and t/picrgb.t tests
+ but were not cleaned up after the corrected names.
+
+ MANIFEST | 2 -
+ t/picnorgb.pl | 96 ---------------------------------------------------------
+ t/picrgb.pl | 74 --------------------------------------------
+ 3 files changed, 0 insertions(+), 172 deletions(-)
+
+commit 0d4e3a5410d9764d4b943001e9875132016fc0e1
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Fri Nov 25 11:25:48 2011 +1100
+
+ pdlmagic.c - Win32 fix to pdl_pthread_barf_or_warn()
+
+ On Windows, pdl_pthread_barf_or_warn() needs to use
+ system realloc() instead of perl's realloc macro. Fix
+ currently seems to work fine - not guaranteed to do
+ so forever.
+
+ Basic/Core/pdlmagic.c | 8 +++++++-
+ 1 files changed, 7 insertions(+), 1 deletions(-)
+
+commit dd5fa1e72ec55ebf88ec26661445896e55273e61
+Merge: c294ccf d80c895
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Mon Nov 21 15:22:44 2011 -0700
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit c294ccf3452ef88e6f4850e14889ed00bb499be5
+Author: Craig DeForest <zowie at dhcp-10-72.boulder.swri.edu>
+Date: Mon Nov 21 11:25:59 2011 -0700
+
+ add test for bug 3299611.
+
+ t/fits.t | 19 ++++++++++++++++++-
+ 1 files changed, 18 insertions(+), 1 deletions(-)
+
+commit d80c8959e0603dcce12f42800444fdd3cdc652ce
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Nov 21 09:06:41 2011 -0500
+
+ Make t/pic_16bit.t and t/storable.t use strict
+
+ This fixes some test fails for recent perls where apparently
+ 'use strict' was forced by the test harness. The fix was to
+ add the needed my () declarations.
+
+ t/pic_16bit.t | 5 ++++-
+ t/storable.t | 3 ++-
+ 2 files changed, 6 insertions(+), 2 deletions(-)
+
+commit 1fce6d43ac87bca690e8581c6291a55af235020f
+Author: Craig DeForest <zowie at Clio-2.local>
+Date: Sat Nov 19 23:30:04 2011 -0700
+
+ Fixes bug 3299611 - obscure fits I/O bug. Replaced a simple "clump(-1)" operation with
+ a slightly-more-expensive "->copy->reshape($p->nelem)" operation, which forces
+ regularization in memory. Since disk I/O is (thought to be) slower than memory operations,
+ and since clump often copies memory anyway, this seems a small price to pay. The alternative
+ would be to dive into XS and access the dimincs fields of the subject pdl directly, but
+ it is not clear there would be a significant performance advantage in the usual case.
+
+ IO/FITS/FITS.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 6dfce88bd66b88381198381413296d54fb12023d
+Author: Craig DeForest <zowie at Clio-2.local>
+Date: Sat Nov 19 23:12:22 2011 -0700
+
+ Fixes bug 3428356: PDL::Transform::map output FITS header is slightly off
+ The problem was an operation order: a half-pixel coordinate offset (used to
+ find the pixel coordinate of the corner of the outermost image pixels) was
+ happening *before* the subsample scaling operation (a multiplication) rather
+ than *after* it. Fixed.
+
+ Thanks to Derek for finding and reporting this.
+
+ Lib/Transform/transform.pd | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit d5f447263f778abf5dfd16e9dd4ad27d951b85fb
+Author: Craig DeForest <zowie at Clio-2.local>
+Date: Sat Nov 19 22:50:45 2011 -0700
+
+ Fixes bug 3059083 - esoteric problems with writing certain buggy FITS
+ headers straight from a hash. Solution is to detect the condition and
+ generate an Astro::FITS::Header object (where possible).
+
+ IO/FITS/FITS.pm | 41 ++++++++++++++++++++++++++++++++++++++---
+ 1 files changed, 38 insertions(+), 3 deletions(-)
+
+commit de94944d7cb86ddcd11f0a01e44f9e51fdf733c6
+Merge: 6aa6992 403096b
+Author: Craig DeForest <zowie at Clio-2.local>
+Date: Sat Nov 19 22:04:55 2011 -0700
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 403096b84ea8be68fc8a1ed3f1a3503e58d07544
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Nov 18 16:01:50 2011 -0700
+
+ Add note in PGPLOT/Window.pm that default for bin()'s CENTRE option is true.
+
+ Graphics/PGPLOT/Window/Window.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit cad271bc164ae0f5ba8a9e45a1c976f261d53154
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Nov 18 12:05:54 2011 -0700
+
+ Quiet compile-time message for PLplot
+
+ Was getting a warning "PLplot.xs: In function ‘labelfunc_callback’:
+ warning: format not a string literal and no format arguments" referring
+ to the snprintf line. snprintf should be called like:
+ snprintf(dest,length,format,src,...), but we had no format string.
+
+ Graphics/PLplot/plplot.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 93a69142e277b9e11d46a8e3668d303636fcee55
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Nov 18 11:21:26 2011 -0500
+
+ Fix breakage with previous $Config fix
+
+ Reverting the PDL data type line as correct and putting
+ the entries there on the $int_ptr_type line since that is
+ where they should be. We shouldn't be relying on definition
+ or not of non-standard types like I32 or I64.
+
+ Graphics/PLplot/plplot.pd | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 3b719c82a905509617f8b32713eef39f2e209ce3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Nov 18 10:36:18 2011 -0500
+
+ Update ptrsize and ptrtype to use $Config
+
+ There are explicit perl config values for ptrsize, i32size,
+ i64size, i32type, and i64type. I've modified the detection
+ code to use these values rather than hardwired values.
+
+ Graphics/PLplot/plplot.pd | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit ced088bcd01ba59de11329c5e8f389f83c82ab0f
+Merge: 8e9cf2d 4cca587
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Nov 17 15:46:14 2011 -0700
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 4cca58711fcd604b5c27ee0170ff8616b0e282db
+Author: dhunt <dhunt at cosmic-dhcp128.cosmic.ucar.edu>
+Date: Thu Nov 17 15:34:18 2011 -0700
+
+ Fix bug in plplot for Mac. plAllocGrid and plAlloc2dGrid were passing
+ back 32 bit pointers because the pp_def/Pars were 'int', not 'longlong'.
+ I don't know why this did not fail on Linux--likely the memory layout was such
+ that the pointer value was less than 2*32.
+
+ Graphics/PLplot/plplot.pd | 7 ++++---
+ 1 files changed, 4 insertions(+), 3 deletions(-)
+
+commit 8e9cf2d08c1e596c9a76d422dee7f78e10bb81b1
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Nov 17 15:28:24 2011 -0700
+
+ Correction to statsover
+
+ The ADEV calculation had an erroneous sqrt in the good code, the
+ bad code, and the docs. Removed, since the consensus was
+ that that was plain wrong. Changed the label in the docs to AADEV,
+ because what we are really calculating is the _average_ absolute
+ deviation. Also reordered PRMS and RMS in the docs, since they
+ were backwards from the way the function returns them.
+
+ Basic/Primitive/primitive.pd | 26 ++++++++++++--------------
+ 1 files changed, 12 insertions(+), 14 deletions(-)
+
+commit bdc632e72680e4a5c66cf7d79f233638b342c8a5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Nov 16 16:38:14 2011 -0500
+
+ Fix t/pgplot.t to run by default...
+
+ ... when running under Test::Harness which means the driver
+ selected is /NULL which should work for all platforms with
+ PGPLOT installed.
+
+ t/pgplot.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2854d968a72695f717ee2fad7d96a2102b6addc4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Nov 16 16:21:09 2011 -0500
+
+ Update Known_problems and Release_Notes
+
+ Known_problems | 6 ------
+ Release_Notes | 8 +++++++-
+ 2 files changed, 7 insertions(+), 7 deletions(-)
+
+commit 47f123eb754680bcc8c6eb11e100fb6263d7efa5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Nov 16 15:56:17 2011 -0500
+
+ Fix sf.net bug #3410905 re hangs in t/pgplot.t
+
+ Worked around the problem by using /null driver when the
+ test is run in a test harness and the original drivers
+ choice elsewise.
+
+ t/pgplot.t | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 5f15b4217d0cc5f2d13876e7c9a6fe46325278ba
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Nov 15 16:16:52 2011 -0700
+
+ Pod fixes for html-ifying
+
+ In locally-made html docs, a bare link like L<PDL::FAQ> will render as
+ _the_PDL::FAQ_manpage_, which may make sense in context with the surrounding text,
+ but also may not. Fixed a few instances of this not making sense.
+
+ Basic/Pod/FAQ.pod | 20 ++++++++++----------
+ IO/IO.pod | 9 +++++----
+ IO/Pnm/Pic.pm | 13 +++++++------
+ Perldl2/pdl2 | 6 +++---
+ 4 files changed, 25 insertions(+), 23 deletions(-)
+
+commit 646030335aeb3b5903d2ef2c5c70d7395395076d
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Nov 15 12:21:50 2011 -0700
+
+ minor pod changes to FlexRaw
+
+ Bad Value Support section had a =head2 instead of =head1, so it was
+ getting picked up by ??bad. Fixed some link code so the html docs
+ there don't say "try the new _the PDL::IO::FlexRaw manpage_ bad value..."
+
+ IO/FlexRaw/FlexRaw.pm | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit d6c4086fc887c5e42f4fc5d1ead6e6faf522ff17
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Mon Nov 14 16:00:39 2011 -0700
+
+ Perldl2/Script.pm: Wrap qw(...) in parens to deal with Perl 5.13.6 deprecation.
+
+ Loading pdl2 gave warnings that "Use of qw(...) as parentheses is deprecated". See http://search.cpan.org/~miyagawa/perl-5.13.6/pod/perl5135delta.pod#Deprecations
+
+ Perldl2/Script.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit b35d0cd3e418bc0d7315f5b3cfefbe111589c401
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Mon Nov 14 15:09:42 2011 -0700
+
+ Enable hdrpcy in rfits for Rice-compressed images
+
+ Rice-compressed images are stored in FITS files as binary table extensions. The uncompressed image reader did set the hdrcpy flag of the output piddle, but _rfits_unpack_zimage now does as well. Also modified some debugging statements.
+
+ IO/FITS/FITS.pm | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 395d24a7dd34fccf5d5bcb504bb17e4bfc888afd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Nov 14 14:22:21 2011 -0500
+
+ Partial fix to pthread build configuration
+
+ Slight tweak to Basic/Core/Makefile.PL to work when perl
+ is not linked against the pthread library since PDL can
+ be so linked separately from perl. Still need to modify
+ the configure tests to use Devel::CheckLib and actual
+ compile, link, run tests...
+
+ Basic/Core/Makefile.PL | 9 ++++++---
+ 1 files changed, 6 insertions(+), 3 deletions(-)
+
+commit 51be6f89fdbd1b07124f7599f56d1c630af4b7e6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 13 22:16:56 2011 -0500
+
+ Update VERSION to 2.4.9_011 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit b6f38b3f1d2f874507aac36fcb34cc8233df7917
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 13 22:14:23 2011 -0500
+
+ Update MANIFEST for CPAN release
+
+ MANIFEST | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 71ce6dd44c6343227cd1dfa700c6462fcde85747
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Nov 12 13:06:55 2011 -0500
+
+ Update Release_Notes and Known_problems
+
+ Known_problems | 3 +--
+ Release_Notes | 13 +++++++++----
+ 2 files changed, 10 insertions(+), 6 deletions(-)
+
+commit 23d22709b66ab63dbe422825b5098587bd0dfeb0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Nov 12 12:42:36 2011 -0500
+
+ Fix PDL::Core::convert return type confusion
+
+ This was sf.net feature #3396738, "PDL::Core::convert default return
+ type" where the type argument for the convert() routine is a
+ type *number* which caused mysterious results when a string like
+ "long" was passed in (instead of long(), for example). atof on
+ the string gives 0 which is the byte type. This cleans up the
+ documentation and adds a barf if the type is not a number.
+ Later cleanup could include allowing for strings of type names
+ instead.
+
+ Basic/Core/Core.pm.PL | 17 +++++++++--------
+ 1 files changed, 9 insertions(+), 8 deletions(-)
+
+commit cef9be6a77ca5a57b39e74ce42160db6a513a8c1
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sat Nov 12 04:46:12 2011 -0600
+
+ Updated Release_Notes acknowledging printf fixes
+
+ Release_Notes | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit 414c56330c2ed44d932bc510a9f5e25245c5a137
+Author: Tim Haines <communist.goatboy at gmail.com>
+Date: Sat Nov 12 04:20:53 2011 -0600
+
+ Fixed numerous prinft errors.
+
+ The source had many prinft format errors that were causing compilers
+ to spew lots of warning messages. For details, see sf bug #3391645.
+
+ Here is Tim's original email that included the patch:
+
+ --------%<--------
+ Core.xs.PL, pdlapi.c, pdlthread.c, pdlconv.c.PL, pdlmagic.c:
+ updated printf format flags for printing pointers
+
+ pdlcore.c.PL: printf on line 920 had argument specifiers, but no
+ arguments
+
+ Core.xs.PL: ftruncate was compiled with attribute warn_unused_result,
+ but return value was unchecked. I added a capture of the return value,
+ and croaked if it was bad. I didn't parse the errno returned since I
+ didn't want to taint the #include space with errno.h and string.h (I
+ had seen some comments about strndup causing conflicts in one of the
+ other files.)
+
+ I am also getting the following warnings for Lib/Slatec/slatec/snrm2.f.
+
+ snrm2.f:87.72:
+
+ 10 ASSIGN 30 TO NEXT
+ 1
+ Warning: Deleted feature: ASSIGN statement at (1)
+ slatec/snrm2.f:94.19:
+
+ 20 GO TO NEXT,(30, 50, 70, 110)
+ 1
+ Warning: Deleted feature: Assigned GOTO statement at (1)
+ slatec/snrm2.f:96.72:
+
+ ASSIGN 50 TO NEXT
+ 1
+ Warning: Deleted feature: ASSIGN statement at (1)
+ slatec/snrm2.f:106.72:
+
+ ASSIGN 70 TO NEXT
+ 1
+ Warning: Deleted feature: ASSIGN statement at (1)
+ slatec/snrm2.f:112.72:
+
+ ASSIGN 110 TO NEXT
+ 1
+ Warning: Deleted feature: ASSIGN statement at (1)
+
+ I don't know much about Fortran, so I didn't change any of these.
+
+ I did a successful build and test after making the modifications above
+ using gcc 4.5.2 and glibc 2.13 on Ubuntu 11.04.
+ -------->%--------
+
+ Signed-off-by: David Mertens <dcmertens.perl at gmail.com>
+
+ Basic/Core/Core.xs.PL | 21 ++++++++--
+ Basic/Core/pdlapi.c | 104 +++++++++++++++++++++++-----------------------
+ Basic/Core/pdlconv.c.PL | 2 +-
+ Basic/Core/pdlcore.c.PL | 2 +-
+ Basic/Core/pdlmagic.c | 2 +-
+ Basic/Core/pdlthread.c | 16 ++++----
+ 6 files changed, 80 insertions(+), 67 deletions(-)
+
+commit e3b6377a771cc6be639e374553598e1c50fe4703
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Nov 11 14:33:23 2011 -0500
+
+ Add docs for rvals
+
+ The implementation of rvals() shows wraparound for integer
+ data types when the value of r**2 is greater than the capacity
+ of the datatype. Also, if a center is not specified, the one
+ used is rounded down to an exact pixel location. I've
+ documented these features in response to sf.net feature
+ request tracker item 3396761 "fix rvals arithmetic wrap-around
+ for byte types". Modifying the implementation to do differently
+ without costing memory or compatibility was problematic. At
+ some point better diagnostics would help but I'm leary of
+ slowing down fundamental operations for every call to catch
+ the occaisional oops. Maybe we could implement a verbose
+ option that could be conditionally compiled.
+
+ Basic/Core/Basic.pm | 14 +++++++++++++-
+ 1 files changed, 13 insertions(+), 1 deletions(-)
+
+commit 0002d5096bb3ab34e98886df6c2e61418a31bf4e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Nov 11 12:39:42 2011 -0500
+
+ Update Release_Notes bugs fixed list
+
+ Release_Notes | 15 +++++++--------
+ 1 files changed, 7 insertions(+), 8 deletions(-)
+
+commit fbe6e15dcabbfb8033dca445ef64f53fe60b3d0f
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu Nov 10 16:10:05 2011 -0600
+
+ Added release notes for changes to new_pdl_from_string.
+
+ Release_Notes | 12 +++++++++++-
+ 1 files changed, 11 insertions(+), 1 deletions(-)
+
+commit 30ef00f415e99015ee769d57ebe4184cee54e6bf
+Merge: 04c3ff4 7c6c2ef
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Nov 8 06:39:40 2011 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 04c3ff47306c8abee9c975e16586b2fa19d69abf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Nov 8 06:37:55 2011 -0500
+
+ Fix sf.net bug #3434842 in GSL::SF
+
+ Lib/GSL/SF/laguerre/gsl_sf_laguerre.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 7c6c2ef9282b2d04f62502cc60bb106b52ba51c8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Nov 7 15:34:11 2011 -0500
+
+ Minor updates to TODO and Perldl2/TODO
+
+ Perldl2/TODO | 4 ++--
+ TODO | 9 +++++----
+ 2 files changed, 7 insertions(+), 6 deletions(-)
+
+commit 74a5659be167ef28d9e0cbaa61a43da3b86df5b7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Nov 7 15:15:51 2011 -0500
+
+ Update to .gitignore
+
+ .gitignore | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit abc48560ced8aacb3f71f2c8a25c4cd7f7c452dc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Nov 7 14:37:08 2011 -0500
+
+ Add fix for perl-vs-pthreads namespace pollution
+
+ This is a workaround to a perl CORE "feature" where
+ they define a macro PTHREAD_CREATE_JOINABLE with the
+ same name as a POSIX threads identifier which works
+ ok...as long as the implementation of POSIX threads
+ also uses cpp macros. As is, the use of the same
+ names breaks on including the win32 pthreads.h where
+ the identifiers are enums and not #defines
+
+ Basic/Core/pdlmagic.h | 10 ++++++++++
+ 1 files changed, 10 insertions(+), 0 deletions(-)
+
+commit daf8cd025890c3e0f3ba8aa6b9183186e1913103
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 6 20:09:07 2011 -0500
+
+ Add new_pdl_from_string features to Release_Notes
+
+ Release_Notes | 12 ++++++++++++
+ 1 files changed, 12 insertions(+), 0 deletions(-)
+
+commit 4e34a83a493b151c3bb2049467138cba96f025e6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 6 16:13:14 2011 -0500
+
+ Update included Devel::CheckLib to latest
+
+ inc/Devel/CheckLib.pm | 19 +++++++++++++++++--
+ 1 files changed, 17 insertions(+), 2 deletions(-)
+
+commit 770b577e42c3c7bb34c72e828abb0fda727e8e74
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 3 14:20:10 2011 -0400
+
+ Add version and header customization to PDLdb.pl
+
+ PDLdb.pl | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 57b8589a797987b61f91d1ba9575e698714d1e6c
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Nov 1 14:39:35 2011 -0500
+
+ Reverted and improved looks_like_number check.
+
+ Consider the following code:
+
+ $data = pdl '1.234';
+
+ Removing the looks_like_number check to get pdl-from-string to
+ work cross-platform had a huge (x10) impact on the time it takes to
+ execute that code. This was deemed unacceptable, so the
+ looks_like_number check was reinstated. However, a check for the
+ strings 'nan' and 'inf' was added to short-circuit the logic of
+ looks_like_number. The current code is about 4.5% slower than the
+ original code for converting a single numeric string to a piddle,
+ but it gives the correct results for nan and inf strings on all
+ platforms.
+
+ Basic/Core/Core.pm.PL | 12 +++++++++++-
+ 1 files changed, 11 insertions(+), 1 deletions(-)
+
+commit 37f6eadece7602b980e01ca63ff8d8a1c963b31c
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Nov 1 12:57:22 2011 -0500
+
+ Removed looks_like_number check, fixing pdl-from-string issue on Windows
+
+ Basic/Core/Core.pm.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 9abd837f440e849dcc591e23e5d82199a4d6e92b
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Nov 1 12:13:09 2011 -0500
+
+ Clarified another test for pdl-from-string inf
+
+ t/pdl_from_string.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 7ba56f4a7676f8287822027c3a8d7e4e84adb5cc
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Nov 1 12:10:18 2011 -0500
+
+ More and better tests for pdl-from-string inf and nan
+
+ t/pdl_from_string.t | 31 ++++++++++++++++++++-----------
+ 1 files changed, 20 insertions(+), 11 deletions(-)
+
+commit 6dbfa6fe28a0ba9acc634c4abc714124b7b02197
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Nov 1 09:45:57 2011 -0500
+
+ Removed two spurious functions in PDL::Core
+
+ I had introduced PDL::Core::e and PDL::Core::E when I was trying to
+ make the eval version of pdl-from-string more secure. They're not
+ necessary anymore and I've removed them.
+
+ Basic/Core/Core.pm.PL | 9 ---------
+ 1 files changed, 0 insertions(+), 9 deletions(-)
+
+commit 269fd90bd795081707b18587fbfb4b3901f40df8
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Nov 1 09:43:55 2011 -0500
+
+ Fixed annoying warnings with pdl-from-string
+
+ The test suite and the code for PDL::Core::new_pdl_from_string were
+ causing hard-coded warnings (ala fprintf in C code). I've revised
+ the test and the function to avoid those warnings.
+
+ Basic/Core/Core.pm.PL | 14 +++++++-------
+ t/pdl_from_string.t | 9 +++++----
+ 2 files changed, 12 insertions(+), 11 deletions(-)
+
+commit d730bdb80fdef471476f6398fa38df1ae939a708
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sun Oct 30 23:27:00 2011 -0500
+
+ Added proper parser error handling for pdl-from-string.
+
+ The parser assumed that warnings were on, but they were not. I've
+ lexically added them to PDL::Core::parse_basic_string.
+
+ In replacing the string-eval with the parser, I stopped catching
+ exceptions, but parse_basic_string throws them. So, I've wrapped
+ the call to parse_basic_string in an eval *block*, so as to catch
+ those exceptions.
+
+ The error reporting when an exception is caught used to make
+ reference to an eval. Such a reference is no longer necessary.
+
+ Basic/Core/Core.pm.PL | 8 +++++---
+ 1 files changed, 5 insertions(+), 3 deletions(-)
+
+commit cf5637006bdd31027bd22b1fc0d844c86f7cdaf5
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sun Oct 30 23:12:31 2011 -0500
+
+ Wrote parser for pdl-from-string.
+
+ Rather than argue that my eval-based method for pdl-from-string
+ functionality was secure, I decided to replace the eval step with
+ a parser. At this point, the pdl-from-string code is very complex
+ and should be redone. But, at least it is now secure.
+
+ Basic/Core/Core.pm.PL | 136 +++++++++++++++++++++++++++++++++++++++++-------
+ t/pdl_from_string.t | 22 +++++---
+ 2 files changed, 129 insertions(+), 29 deletions(-)
+
+commit efadca1fdbb767f3958c568e660e8bd1b375fa9b
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Oct 26 15:33:12 2011 -0500
+
+ A few semi-cosmetic updates to PDL::Primitive.
+
+ A line in PDL::Primitive said
+
+ ... unless UNIVERSAL::isa($b, 'PDL');
+
+ That's frowned upon because it prevents isa from being overloaded.
+ The correct way to say this is as follows:
+
+ ... unless eval { $b->isa('PDL') };
+
+ That will return false if $b is not a blessed reference or if it is
+ a blessed reference that is not a PDL.
+
+ Basic/Primitive/primitive.pd | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 9b7d4dcc1534778304c70999db14e62ac34267e1
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Oct 26 15:31:46 2011 -0500
+
+ Fixed pdl-from-string typos and errors.
+
+ My last push wouldn't compile because I missed a parenthesis. I've
+ fixed that. I also added tests for the Windows expressions for inf
+ and nan and discovered an ordering problem that I also fixed in
+ PDL::Core.
+
+ Basic/Core/Core.pm.PL | 7 ++++---
+ t/pdl_from_string.t | 34 ++++++++++++++++++++--------------
+ 2 files changed, 24 insertions(+), 17 deletions(-)
+
+commit 748c0700bf34138d7f41aa33e286f698eee3b1c2
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Oct 26 15:13:01 2011 -0500
+
+ Fixed typo in cross-product signature
+
+ Basic/Primitive/primitive.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit dee2d86bcc08ad0d278b1bf43933535a3f104ff0
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Oct 26 15:10:20 2011 -0500
+
+ Fixed pdl-from-string for Strawberry Perl.
+
+ I discovered that Strawberry Perl (and all Windows?) print inf as
+ 1.#INF. Similar strangeness also occurrs with nan. I've added code
+ in PDL::Core::new_pdl_from_string to properly process these strings.
+ Since they're on all platforms, this means that a user can paste
+ the output of their Windows box on a mailing list, and Linux users
+ can paste it into their editors and shells and it should work.
+
+ Basic/Core/Core.pm.PL | 14 ++++++++++++--
+ 1 files changed, 12 insertions(+), 2 deletions(-)
+
+commit 508da690846ac17d71481b4d5b088fe10552c40e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 26 11:16:49 2011 -0400
+
+ Update sf.net bugs list in Known_problems
+
+ Known_problems | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 09f928f5b2d6c2bf9bfa5abf7ddfeecd2ec9e04c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 26 11:05:35 2011 -0400
+
+ Add WITH_NEW_PDL_FROM_STRING to perldl.conf
+
+ And update t/config.t to match. This setting should probably
+ be used as the default value of an internal parameter, like
+ $PDL::with_new_pdl_from_string and then conditionalize on
+ that in the constructor. This allows for users/developers
+ to override the default setting if desired.
+
+ perldl.conf | 10 +++++++++-
+ t/config.t | 2 +-
+ 2 files changed, 10 insertions(+), 2 deletions(-)
+
+commit 6c210f635c24ba54cd0e5bc9987e4c47f2a7e3e7
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Oct 25 15:57:57 2011 -0500
+
+ Improved checking and tests for pdl-from-string.
+
+ Judd Taylor pointed out that functions called e123() could get
+ past the previous checking in PDL::Core::new_pdl_from_strin, so
+ I've added a check for that, as well as checks for various other
+ behaviors.
+
+ Basic/Core/Core.pm.PL | 10 ++++++++--
+ t/pdl_from_string.t | 43 +++++++++++++++++++++++++++++++++++--------
+ 2 files changed, 43 insertions(+), 10 deletions(-)
+
+commit 44aa2808bbfe3cfb637a2cec4347e7734807b478
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Oct 25 12:49:49 2011 -0500
+
+ Better barfing on disallowed characters in pdl-from-string
+
+ Motivated by a cryptic message, I modified the barfing message
+ when an invalid character is sent to PDL::Core::new_pdl_from_string.
+ It now tells you about the first string of invalid characters that
+ it finds so that it's easier to track down your problem.
+
+ Basic/Core/Core.pm.PL | 13 +++++++------
+ t/pdl_from_string.t | 18 +++++++++++++++---
+ 2 files changed, 22 insertions(+), 9 deletions(-)
+
+commit 0643a33c68e17f51aece1af09c4a0312bc888762
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Oct 25 11:46:06 2011 -0500
+
+ Stronger and more flexible PDL:Core::new_pdl_from_string
+
+ The new function *always* installs PDL::Core::E and PDL::Core::e
+ so that there is absolutely no way for other-specified code to be
+ run during the eval portion of the function. I set them up to use
+ exp(1) as the replacement value, and also added support for the
+ strings pi, Pi, PI, and pI, so
+
+ my $pdl = pdl q[ 1 2 pi]
+
+ does what you mean.
+
+ Basic/Core/Core.pm.PL | 79 +++++++++++++++++++++++++++----------
+ t/pdl_from_string.t | 103 ++++++++++++++++++++++++++++++++++++++++++++++--
+ 2 files changed, 155 insertions(+), 27 deletions(-)
+
+commit 36b2c2fce0a60f93ff6424c3228e0d12e60589b5
+Merge: cbfd1cb 364f278
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Oct 25 10:08:32 2011 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit cbfd1cbad1e4f547861fbc8bfbc87322bf04df2e
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Oct 25 10:06:40 2011 -0500
+
+ More tests for PDL::Core::new_pdl_from_string.
+
+ I added some checks for checking inf and -inf, as well as checking
+ that the function croaks when not-allowed symbols are used in the
+ string.
+
+ t/pdl_from_string.t | 16 ++++++++++++++--
+ 1 files changed, 14 insertions(+), 2 deletions(-)
+
+commit 364f2784865dee03a6e2d36a8aa3a6a02f68fe56
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 24 14:32:07 2011 -0400
+
+ Update FAQ, Known_problems, Release_Notes
+
+ Basic/Pod/FAQ.pod | 38 +++++++++++++++++++-------------------
+ Known_problems | 1 -
+ Release_Notes | 6 ++++++
+ 3 files changed, 25 insertions(+), 20 deletions(-)
+
+commit 37792ba9f2a2eea8d5732ada8d1a1ce77b4eeb2f
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Oct 24 11:28:56 2011 -0500
+
+ PDL::Core::pdl_from_string more secure, handles bad/inf
+
+ I've revised how pdl_from_string handles its input. Per the
+ discussion on the PDL porters list, the only characters it accepts
+ now are whitespace, numbers, and
+
+ [ ] . , ; + - e E
+
+ with three important exceptions. The strings 'inf', 'nan', and 'bad'
+ all Do What You Mean now. It even goes so far as to check that
+ your datatype supports inf and croaks if it does not (for integers).
+ It warns if you try to use nan on an integer datatype and converts
+ it to a bad value.
+
+ This patch also includes a few doc updates and added tests. I also
+ took the opportunity to organize the test file in a way that is
+ easier to follow (I hope).
+
+ Basic/Core/Core.pm.PL | 108 +++++++++++++++++++++++++++++++------------------
+ t/pdl_from_string.t | 87 ++++++++++++++++++++++++++++++---------
+ 2 files changed, 136 insertions(+), 59 deletions(-)
+
+commit 3a54fcc6a88833f28ca1e3e0de1adb7ec84c0858
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Oct 22 18:18:56 2011 -0400
+
+ Fix PDL::Doc stuff so pdl2 is found by pdldoc
+
+ Changed the pattern matching shell|script names in Doc/Doc.pm
+ from [a-z]+ to [a-z][a-z0-9]* so that pdl2 would match. Then
+ made sure to install the pdl2.pod in lib/PDL rather than
+ script/PDL so that the scantree would find it...
+
+ Doc/Doc.pm | 4 ++--
+ Perldl2/Makefile.PL | 2 +-
+ 2 files changed, 3 insertions(+), 3 deletions(-)
+
+commit ac9f12582c4d4f0799331bd906a670b3b7b8eaff
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Oct 21 17:51:52 2011 -0500
+
+ Improved pdl_from_string, more secure, handles BAD string.
+
+ I started digging into the just-named function because I thought
+ it would be handy to add support for things like:
+
+ $a = pdl q[1 2 bad 4]
+
+ and have it supply a BAD value instead of zero. I got that working,
+ but then I realized there are some security holes in the
+ constructor. I've added some additional checking and barfing for
+ the most agregious cases, but it's still possible to do damage and
+ we should look more closely into how to properly perform
+ pdl_from_string.
+
+ Basic/Core/Core.pm.PL | 44 +++++++++++++++++++++++++++++++++++++++-----
+ 1 files changed, 39 insertions(+), 5 deletions(-)
+
+commit d37f60faabdda8842474fe84354d10dc45f35d4e
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Oct 21 16:26:41 2011 -0500
+
+ Added docs for PDL::Types::mapfld
+
+ The documentation for mapfld was completely useless. I've added a
+ few more sentences and some working examples that I hope illustrate
+ how to use it. The docs for PDL::Types still need a lot of work,
+ though.
+
+ Basic/Core/Types.pm.PL | 27 +++++++++++++++++++++++----
+ 1 files changed, 23 insertions(+), 4 deletions(-)
+
+commit 03ef9ab4975ff754bf61bb917d0feb53f411bd3d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Oct 20 14:59:14 2011 -0400
+
+ Experimental PDLdb.pl for perl -d support
+
+ Per the request from Karl, I've hacked up a custom
+ version of the perl debugger that supports PDL::NiceSlice
+ syntax. To use, just put the PDLdb.pl file in your
+ perl @INC path somewhere and set the PERL5DB environment
+ variable to 'BEGIN { require "PDLdb.pl" }' or whatever
+ your platform quotes are...
+
+ PDLdb.pl | 9545 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ Release_Notes | 9 +-
+ 2 files changed, 9553 insertions(+), 1 deletions(-)
+
+commit b67993b9d6c8710a170c0dd67fc7581c84417d5d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Oct 15 20:37:44 2011 -0400
+
+ Update pod and add FORMAT opt to wcols
+
+ Some cleanup and (I hope) clarification of the pod
+ for rcols and wcols. Also, added a FORMAT option to
+ wcols as an alternative to the $format_string syntax.
+
+ IO/Misc/misc.pd | 54 ++++++++++++++++++++++++++++++------------------------
+ 1 files changed, 30 insertions(+), 24 deletions(-)
+
+commit 89e48229be2d0f8e1d19c48ea22760d30a4eed9e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 11 13:46:25 2011 -0400
+
+ Update VERSION to 2.4.9_010 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ MANIFEST | 273 ++++++++++++++++++++++++++++----------------------------
+ Release_Notes | 32 +++++++
+ 4 files changed, 171 insertions(+), 138 deletions(-)
+
+commit 50cf216d9a85e13143b99ad7234b81d392ded5b2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 11 13:01:59 2011 -0400
+
+ Update readme-type files for 2.4.9_009 release
+
+ Known_problems | 5 +++++
+ Release_Notes | 10 ++++++----
+ cygwin/INSTALL | 9 ++++++++-
+ cygwin/README | 16 +++++++++++++++-
+ 4 files changed, 34 insertions(+), 6 deletions(-)
+
+commit 6b8777d9adeaedd05e42aa2ae59182c42e14c647
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 10 17:02:53 2011 -0400
+
+ Fix badvalue processing edge case for readflex()
+
+ IO/FlexRaw/FlexRaw.pm | 17 +++++++++--------
+ 1 files changed, 9 insertions(+), 8 deletions(-)
+
+commit e70e158dcbb27bb7068b2048b9bf8526c6b7a1c6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 10 14:06:40 2011 -0400
+
+ Update Release_Notes for PDL::NiceSlice work
+
+ Release_Notes | 5 +++++
+ 1 files changed, 5 insertions(+), 0 deletions(-)
+
+commit 60511d8de8d1fae1e34a0aaac52a0ba7d5f20071
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 9 22:59:03 2011 -0400
+
+ Fix syntax error from typo
+
+ This utility does not appear to work with the new
+ Filter::Simple based PDL::NiceSlice engine. We
+ will need to sort out what is going on before an
+ official release.
+
+ utils/perldlpp.pl | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 1eb1b2d115528d692839e4cfc24c51300696a7bc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 9 22:14:21 2011 -0400
+
+ Improved PDL::NiceSlice filter engine (finally!)
+
+ PDL::NiceSlice has been refactored to use "engines" for
+ the filters and there are now 2 to choose from. The
+ original functionality via Filter::Util::Call and the
+ new and improved version based on Filter::Simple.
+
+ Basic/SourceFilter/FilterSimple.pm | 16 +
+ Basic/SourceFilter/FilterUtilCall.pm | 53 ++
+ Basic/SourceFilter/Makefile.PL | 21 +-
+ Basic/SourceFilter/NiceSlice.pm | 117 ++--
+ Basic/SourceFilter/NiceSlice2.pm | 1105 ----------------------------------
+ Known_problems | 4 +
+ Release_Notes | 17 +
+ 7 files changed, 158 insertions(+), 1175 deletions(-)
+
+commit 71f79d89a4ebfa98500e1980d3aa90e665f439a4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Oct 6 18:03:31 2011 -0400
+
+ Don't call twiddle() in imag2d if glutRunning==1
+
+ If the FreeGLUT/GLUT event loop support is present and enabled
+ in ReadLine::Term then we don't call twiddle after displaying
+ the images since it is not needed.
+
+ Graphics/Graphics2D.pm | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 198b9b56b709ca9acaa1fda1ceff599bd28295f5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 5 18:57:17 2011 -0400
+
+ Fix rcols to use same convention as wcols
+
+ Now dim0 is always the data dimension and dim1 corresponds
+ to the columns read for 2D pdls. This makes rcols now the
+ reverse operation of wcols.
+
+ IO/Misc/misc.pd | 49 +++++++++++++++++++++++++++++++++----------------
+ Known_problems | 1 -
+ Release_Notes | 18 ++++++++++++++++++
+ 3 files changed, 51 insertions(+), 17 deletions(-)
+
+commit c0accab0b98490a80bf48d3d117d03e763f88404
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 4 12:44:34 2011 -0400
+
+ Create pdl2.pod (but pdldoc still doesn't show!)
+
+ I'm not sure why scantree() is not finding the documentation
+ for pdl2 and adding it to the online database.
+
+ Perldl2/Makefile.PL | 20 ++++++++++++++++++--
+ 1 files changed, 18 insertions(+), 2 deletions(-)
+
+commit 794ab90b1f0e62a108f0d59931370056973b25de
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Oct 1 09:31:50 2011 -0400
+
+ Missing fix for whereND zeroes mask bug
+
+ I think I "fixed" the Primitive.pm file and forgot
+ to propagate things to the primitive.pd file.
+
+ Basic/Primitive/primitive.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3407d0d686fb08c3a015f5142fdf9799a53f8a63
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 30 18:52:49 2011 -0400
+
+ Fix wcols to handle 2D pdl data
+
+ Now wcols can write out columns of data from 1D piddles,
+ 2D piddles, or 1D listrefs (pure perl array data). Still
+ need to sort out which "column dimension" to use. The
+ current implementation has wcols using dim(0) and rcols
+ using dim(1) which makes things inconsistent between the
+ two...
+
+ IO/Misc/misc.pd | 29 +++++++++++++++++++++--------
+ 1 files changed, 21 insertions(+), 8 deletions(-)
+
+commit ea80886189430b5118e8da7f3dcbe60ff3bbca70
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 29 18:28:16 2011 -0400
+
+ Fix sf.net bug #3415115, whereND of all-zeros mask
+
+ Added a test to t/primitive.t for the problem and a
+ test for 0 or undef dimensions so splitdim is not
+ called for this case.
+
+ Basic/Primitive/primitive.pd | 3 ++-
+ t/primitive.t | 9 +++++++--
+ 2 files changed, 9 insertions(+), 3 deletions(-)
+
+commit 7a95c9d779e29a925b6ac3522b05d85fa40ffb77
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 29 16:49:20 2011 -0400
+
+ Update bug list in Known_problems
+
+ Known_problems | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit be42308fae53972a146441fd7c683cd3896e564a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 29 16:14:26 2011 -0400
+
+ Tweak fix to empty-file bug for rcols
+
+ With the addition of a check for defined, I was able
+ to keep the original construction while retaining the
+ fix. Thanks, David! This keeps the file-read and pdl
+ extending operations in a contiguous region of code.
+
+ IO/Misc/misc.pd | 14 +++++++-------
+ 1 files changed, 7 insertions(+), 7 deletions(-)
+
+commit bdff5d36ef4c5e977153aaf7c0a1bff90e13a7c2
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu Sep 29 14:07:03 2011 -0500
+
+ Fixed rcols.
+
+ The previous patch included a failing test for rcols. This patch
+ includes a modification of IO/Misc/misc.pd that fixes the problem
+ by moving the edge-condition-checking code to a location *before*
+ the last-line cleanup code.
+
+ IO/Misc/misc.pd | 14 +++++++-------
+ 1 files changed, 7 insertions(+), 7 deletions(-)
+
+commit a9b81eb3e2afc52de7135486b8a469d9e9c0cdf1
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu Sep 29 14:02:09 2011 -0500
+
+ Found a bug with rcols, here's the test.
+
+ This commit includes a test which exposes a bug with rcols. Some code
+ that immediately followed the file-read loop did one last operation,
+ cleaning up the last line, so to speak. The next block of code checked
+ if nothing was read in by the file. Problem is, the code that does the
+ clean-up assumed that some variables had a special structure that
+ required at least a single pass through the while loop, and an empty
+ file handle would never go through the loop. So, if you inadvertently
+ fed an empty file handle to rcols, it would die a sad death saying
+
+ Can't use an undefined value as an ARRAY reference at /path/to/PDL/IO/Misc.pm line 676
+
+ That's a bug if ever I've seen one, and this test checks for it.
+
+ t/misc.t | 13 ++++++++++++-
+ 1 files changed, 12 insertions(+), 1 deletions(-)
+
+commit b3adaf911dc949f39808b731a2478a6c661fe151
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Sep 28 14:26:30 2011 -0500
+
+ More work on describing different rules in PDL::PP.
+
+ I've created an automated doc string for the InsertName rule. I had
+ created an automated doc string for PDL::PP::Rule::Returns, but
+ decided that was either not very helpful (i.e. Returns::One) or
+ had bad edge cases (i.e. an empty hash).
+
+ Basic/Gen/PP.pm | 11 +++++++++--
+ 1 files changed, 9 insertions(+), 2 deletions(-)
+
+commit f9102c50242a78fb579769ff7df4c9a87e7c53c0
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Sep 28 12:14:37 2011 -0500
+
+ Added an appendix to PP.pod with every function from PDL::PP
+
+ PDL::PP exports a lot of functions. I've tried to document all of
+ them in a new Appendix C. I think it mostly gets things right,
+ although some input from others would be helpful.
+
+ I also documented PMCode and PMFunc. I proposed some documentation
+ back in May because I wasn't quite sure about it, but I am now
+ quite confident in my understanding of these.
+
+ Furthermore, I finally updated the copyright policy on this documentation.
+ In my correspondence with Toumas a few years back, he implied that
+ he did not care what kind of copyright we applied to the text. As
+ such, I am changing it. I take full responsibility for this change.
+
+ Basic/Pod/PP.pod | 277 +++++++++++++++++++++++++++++++++++++++++++++++++-----
+ 1 files changed, 251 insertions(+), 26 deletions(-)
+
+commit 5b5462a936fb001329070d60eb9a324d1bc218aa
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed Sep 28 10:38:56 2011 -0500
+
+ Improved and CPANififed some documentation.
+
+ Types.pm is generated from a .pm.PL file which, as is very common,
+ was never formatted to have its pod directly parsed and displayed.
+ This means that, when viewed on CPAN, the badvalue documentation
+ was messed up. I've corrected that.
+
+ Furthermore, I updated PP's documentation to reflect that we have
+ support for a long-long type, with the single-character Q. I also
+ cleaned up PP's examples that used GenericTypes, which used Perl's
+ default bareword-to-string interpretation that croaks under strictures.
+ The modified code makes the processing of GenericTypes clearer, I
+ hope.
+
+ Basic/Core/Types.pm.PL | 73 +++++++++++++++++++++++++++++++++++++----------
+ Basic/Pod/PP.pod | 29 ++++++++++++------
+ 2 files changed, 76 insertions(+), 26 deletions(-)
+
+commit deafde901f45a511a885edb7d8a3ddfd689aea7a
+Author: Doug Hunt <dhunt at ucar.edu>
+Date: Mon Sep 26 09:45:25 2011 -0600
+
+ Added build option for Darwin. Also added fix to plplot.pd which permits building of
+ more plplot functions if pllegend is not found.
+
+ Graphics/PLplot/Makefile.PL | 11 ++++++++++-
+ Graphics/PLplot/plplot.pd | 7 +++----
+ 2 files changed, 13 insertions(+), 5 deletions(-)
+
+commit c663d48e5776d317c4ea0c2432847eb2fefd89a5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 23 18:04:48 2011 -0400
+
+ Edits to DEPENDENCIES and Known_problems
+
+ DEPENDENCIES | 2 +-
+ Known_problems | 5 -----
+ 2 files changed, 1 insertions(+), 6 deletions(-)
+
+commit c58346976deaf78f909ecfd00492d03f72a8c6e7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Sep 18 12:50:25 2011 -0400
+
+ Make use Benchmark :hireswallclock conditional
+
+ Removed it from t/pthread.t and made it conditional
+ on perl version number for t/pthread_auto.t. Skipped
+ for perl versions earlier than 5.8.8 which is documented
+ as having a Core Benchmark module supporting the feature.
+
+ t/pthread.t | 2 +-
+ t/pthread_auto.t | 15 ++++++++++++---
+ 2 files changed, 13 insertions(+), 4 deletions(-)
+
+commit 2c28ad9400f2c2946ddd5f775307328d1a81f4ec
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 17 10:03:41 2011 -0400
+
+ Update bug list in Known_problems
+
+ And added the fixed segfault bugs to the Release_Notes
+ for the next developers release which is planned for
+ when CPAN Testers comes back on-line or when it is
+ requested---whichever comes sooner.
+
+ Known_problems | 12 ++----------
+ Release_Notes | 8 +++++++-
+ 2 files changed, 9 insertions(+), 11 deletions(-)
+
+commit 7962130878aa97423b807660d278b6226c83b526
+Merge: 62ae31d bd8cc55
+Author: Craig DeForest <zowie at z7.boulder.swri.edu>
+Date: Sat Sep 17 01:41:05 2011 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 62ae31d4677a50d874f4e9acd0302fb74f98f4a6
+Author: Craig DeForest <zowie at z7.boulder.swri.edu>
+Date: Sat Sep 17 01:34:32 2011 -0600
+
+ fixes bugs 3307613 and 3294808 (problems with range in the
+ case where the index variable is Empty)
+
+ Basic/Slices/slices.pd | 32 +++++++++++++++-----------------
+ t/slice.t | 10 +++++++++-
+ 2 files changed, 24 insertions(+), 18 deletions(-)
+
+commit bd8cc5558824cda07e7716ef5f5372882cd214ef
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sat Sep 17 17:33:29 2011 +1000
+
+ Make Basic/Core/pdlmagic.c C89-compliant
+
+ Needed for older Microsoft Compilers.
+
+ Basic/Core/pdlmagic.c | 84 +++++++++++++++++++++++++-----------------------
+ 1 files changed, 44 insertions(+), 40 deletions(-)
+
+commit fb79fb7831ea222428334520265d7d9350300859
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 16 20:18:54 2011 -0400
+
+ Make t/pthread_auto.t more computationally intense
+
+ That will make the computation times more representative
+ of the speed up one would get with multiple core CPUs.
+
+ t/pthread_auto.t | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 5b8ff1e8e2436a5ad085feac7c8e5d7a74ff09b9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 14 12:49:45 2011 -0400
+
+ Rearrange POSIX threads params in perldl.conf
+
+ perldl.conf | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit ce1d92c78fb036d2d60d4f63391607fe0e4e4d3a
+Merge: b22dcb1 2429d37
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Sep 13 17:23:42 2011 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit b22dcb149024c789d7f7cba232b6bffe7b5b50e9
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Sep 13 17:22:05 2011 -0500
+
+ Improved variable name parsing with ISBAD, etc.
+
+ I discovered a weak (i.e. erroneous) regex to identify variable
+ names with keys such as $ISBAD, $ISGOOD, etc, but only for the
+ bad-value handling. I've fixed it, so now you can use variables
+ with numbers in your PP code.
+
+ Basic/Gen/PP/PDLCode.pm | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit d6a649f00267f0642738522266ee0b491c4cf561
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Tue Sep 13 16:48:41 2011 -0500
+
+ Improved indentation in seperate_code
+
+ Basic/Gen/PP/PDLCode.pm | 88 +++++++++++++++++++++++-----------------------
+ 1 files changed, 44 insertions(+), 44 deletions(-)
+
+commit 2429d37e4a000a008e521ab9e648d2c61271a4de
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 13 09:40:11 2011 -0400
+
+ Update Inline and pthreads in DEPENDENCIES
+
+ Inline is a CPAN requirement for PDL but is not required
+ for a manual build. Added a note about work towards win32
+ support for pthreads.
+
+ DEPENDENCIES | 14 +++++++++++---
+ 1 files changed, 11 insertions(+), 3 deletions(-)
+
+commit 519832c448588937a6b737e0928185cc67049611
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Sep 12 12:01:22 2011 -0500
+
+ Remove unnecessary HASP2Child key.
+
+ The HASP2Child key was essentially a value for P2Child that had the
+ same boolean evaluation but was guaranteed to be defined as a numeric
+ value of either 0 or 1. However, the value of HASP2Child was never
+ used in any arithmetic, only in boolean context. Since undef evaluates
+ to false, all references to HASP2Child can be replaced by _P2Child
+ with impunity. I believe that is much clearer. It says, "If the user
+ indicated a value for P2Child, pass that, otherwise pass the undefined
+ value." It clearly points back to a user-level key, which I believe
+ is preferable to an internally defined key derived directly from the
+ user-level one.
+
+ Basic/Gen/PP.pm | 40 ++++++++++++++++++++++++----------------
+ 1 files changed, 24 insertions(+), 16 deletions(-)
+
+commit 638fbf5f750462d51e37c7da22464b78b123769b
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Sep 12 12:00:29 2011 -0500
+
+ Added doc strings to some rules.
+
+ I'm working to understand the workings of each of the rules. Adding
+ doc-strings is a good practice, and it helps me build an automated
+ documentation system, too.
+
+ Basic/Gen/PP.pm | 18 ++++++++++++++----
+ 1 files changed, 14 insertions(+), 4 deletions(-)
+
+commit baee6b8830da70898ebb718630217b1cf6360854
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Sep 12 10:33:43 2011 -0500
+
+ Moved PMFunc logic from pp_def into a Rule.
+
+ The handling of PMFunc was inserted by-hand into pp_def. Given that
+ all of the optional argument handling is supposed to be done with
+ Rules, I moved this into its own Rule at the end of the Rule table.
+ Now we are guaranteed that the key PMFunc will have a meaningful
+ value if the user did not supply one.
+
+ Basic/Gen/PP.pm | 18 ++++++++++++------
+ 1 files changed, 12 insertions(+), 6 deletions(-)
+
+commit 3ab2e3f4c30f9eb2af7532712092e7c1720f858d
+Merge: eb75424 6186085
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Sep 12 09:59:52 2011 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit eb75424ff777eee2043618b96a5adc17fed12a8e
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Mon Sep 12 09:51:18 2011 -0500
+
+ Made some PP.pm code more legible.
+
+ The XS C Header variable in mkxscat and mkVarArgsxscat was named
+ chdrs, which made me think "Change Directories", not "C Headers".
+ So, I renamed it to xs_c_headers for clarity. I also renamed prel
+ to prelude. It doesn't tell you what kind of prelude it is, but at
+ least you know it's something that comes before something else,
+ which I hope helps.
+
+ Also, and this may just be a style thing, I revised the code that
+ constructs the prelude string. It may be just me, but joining a
+ bunch of members in an array by surrounding the array with quotes
+ (i.e. $joined = "@seperate") really threw me off. Instead, I used
+ the join operator, with a suggestive use of the fat comma:
+
+ join $with_this_seperator => (@these_items);
+
+ I hope that makes the meaning of the code clearer to anybody else
+ who comes along.
+
+ Basic/Gen/PP.pm | 24 ++++++++++++------------
+ 1 files changed, 12 insertions(+), 12 deletions(-)
+
+commit 61860854b356fccc0b5268861b450cb514416214
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Sep 12 10:27:20 2011 -0400
+
+ Switch to use Benchmark ':hireswallclock' timings
+
+ This allows the total time to be reported with small
+ enough granularity to see whether there is a performance
+ improvement from use of pthreads. It would be nice if
+ there were a Benchmark variant that was more useful for
+ showing speedup information. Thanks to Dima Kogan for
+ sorting this out and the fix.
+
+ t/pthread.t | 2 +-
+ t/pthread_auto.t | 2 +-
+ 2 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 0aafe68eac4bfa6e2fd41a9f2447e9bea11f2ffe
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Sep 11 10:07:47 2011 -0400
+
+ Fix t/pthread_auto.t unthreaded case
+
+ The benchmark between threaded and unthreaded failed
+ to disable the threads for the unthreaded test. Set
+ target to 0 for comparison to unthreaded as in:
+ set_autopthread_targ(0), it used to be 10 here.
+
+ t/pthread_auto.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit a05af9300a0f6ce24efb86ddd2334b6832000ee3
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sat Sep 10 22:43:29 2011 -0500
+
+ Removed unnecessary rule for DefaultFlow in PP.pm.
+
+ The pp_def key DefaultFlow is only used in two rules. The first
+ ensures that DefaultFlow has a default value of zero and the
+ second rule uses that boolean value to set up a code fragment.
+ However, the first rule can be subsumed by the second rule by
+ using the optional-condition syntax (an underscore in front of
+ the condition name). So, I fixed it.
+
+ Basic/Gen/PP.pm | 8 ++------
+ 1 files changed, 2 insertions(+), 6 deletions(-)
+
+commit 64d7802a38d3cba77f51dc5682d41472bbf6d6f9
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sat Sep 10 21:42:48 2011 -0500
+
+ Cleaned up PP.pm's first rule for the BadFlag.
+
+ The original rule passed "_HandleBad" in an array ref. It worked,
+ but was unnecessary and confusing to anybody trying to figure out
+ what the heck rules are and how they work.
+
+ Basic/Gen/PP.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 384165bf48ce6e76c3f6e7889fe07e8241713029
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sat Sep 10 21:35:59 2011 -0500
+
+ Fixed indentation in PDL::PP::Rule::new()
+
+ Basic/Gen/PP.pm | 26 +++++++++++++-------------
+ 1 files changed, 13 insertions(+), 13 deletions(-)
+
+commit 88ae249b395d8b79391d602aba659681ff632b73
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sat Sep 10 21:26:32 2011 -0500
+
+ Made extract_args in PP.pm more legible.
+
+ Some of the function's content was not nicely indented and it was
+ defensive against an auto-vivification that would never occur. It
+ also used substr in an obfuscating fashion rather than a simple
+ s/// regex.
+
+ Basic/Gen/PP.pm | 31 ++++++++++---------------------
+ 1 files changed, 10 insertions(+), 21 deletions(-)
+
+commit 05404d3a2ab19cb3d0306049664e4fead714bd06
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 10 19:05:23 2011 -0400
+
+ Clean up POSIX_THREADS_INC and _LIBS handling
+
+ Now the INC is the string for the include directory to
+ add to the search path and the LIBS string is the one
+ to add the library directory and library option to the
+ build path.
+
+ Basic/Core/Makefile.PL | 11 +++++------
+ perldl.conf | 5 +++--
+ 2 files changed, 8 insertions(+), 8 deletions(-)
+
+commit 65a4af0b4dc90cb5b7db5d57b10380daf492101c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 10 12:25:46 2011 -0400
+
+ Remove attempts to printf pthread_t objects
+
+ I've commented out the incorrect attempts to print pthread_t
+ objects (by definition are to be opaque). For debugging
+ purposes, someone might wish to implement a thread specific
+ variable so we could print the number of the thread from the
+ pthread_t information.
+
+ Basic/Core/pdlmagic.c | 33 +++++++++++++++------------------
+ 1 files changed, 15 insertions(+), 18 deletions(-)
+
+commit 9b73c281e8c47f724aa1e678684e4145d9aff6e9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 10 10:54:18 2011 -0400
+
+ Fix data type for done_pdl_main_pthreadID_init
+
+ The idea was to *not* use pthread_t here. Still to do,
+ fix printf attempts for pthread_t objects.
+
+ Basic/Core/pdlmagic.c | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 28f5347f69098fbabb2ef8a9e97b970be4e150a9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Sep 10 09:28:45 2011 -0400
+
+ Fix whitespace error in generated code
+
+ Editor white space changes affected strings with
+ newlines and tabs. This broke generated Makefiles.
+ It would be nice if we had a less whitespace fragile
+ way to include the makefile content. Thanks for the
+ catch, Rob.
+
+ Basic/Core/Makefile.PL | 329 +++++++++++++++++++++++-------------------------
+ 1 files changed, 160 insertions(+), 169 deletions(-)
+
+commit e3dd3dc548732247370552880b1558b3e42c710a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 9 16:14:51 2011 -0400
+
+ Remove IO/Pnm/converters
+
+ These were old, patched versions of NetPBG TIFF conversion
+ routines. They are not used nor needed with current NetPBM
+ releases.
+
+ IO/Pnm/converters/README | 11 --
+ IO/Pnm/converters/pnmtotiff.c | 372 ----------------------------------------
+ IO/Pnm/converters/tifftopnm.c | 376 -----------------------------------------
+ 3 files changed, 0 insertions(+), 759 deletions(-)
+
+commit 7c836ff58933ebc9d67bd789d1f933f0ff4ae0e9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 9 14:42:44 2011 -0400
+
+ Add support for POSIX_THREADS_(INC|LIBS)
+
+ The new perldl.conf parameters: POSIX_THREADS_INC and
+ POSIX_THREADS_LIBS may now be used to specify the include
+ and library locations to build PDL with pthreads support.
+ This fix works for cygwin but there are a few issues with
+ path separators and possible library format options that
+ would need to be modified to support win32 builds.
+
+ Basic/Core/Makefile.PL | 337 +++++++++++++++++++++++++-----------------------
+ 1 files changed, 178 insertions(+), 159 deletions(-)
+
+commit ea501f9c3382ec73dd9f328a9c3c954e55ca6db6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 9 10:30:05 2011 -0400
+
+ Add t/pgplot.t hang info to Known_problems
+
+ And add directions to read that file if there are build
+ issues to README and INSTALL.
+
+ INSTALL | 4 +++-
+ Known_problems | 5 +++++
+ README | 3 ++-
+ 3 files changed, 10 insertions(+), 2 deletions(-)
+
+commit 6aa6992aa161fc55ad53fcb870c0f25283d024c4
+Merge: 006a548 e2d5ac7
+Author: Craig DeForest <zowie at Clio-2.local>
+Date: Sat Sep 3 23:38:22 2011 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit e2d5ac73121da70357cdd91eeca28a7ea0cade48
+Merge: a0b318d d892049
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 2 22:24:18 2011 -0400
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit a0b318d304c04764f6404a232f39547d801bad99
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 2 22:22:17 2011 -0400
+
+ Update $pdl_core_version for large pdl support
+
+ We've been making a lot of changes to the core
+ PDL code and probably should have been updating
+ the $pdl_core_version all along---at least I know
+ I didn't.
+
+ Basic/Core/pdlcore.h.PL | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit d892049f49d1eea0f3d0edc226f7c16020af4fa7
+Author: Doug Hunt <dhunt at ucar.edu>
+Date: Fri Sep 2 09:18:24 2011 -0600
+
+ Per Sisyphus's suggestion, duplicated $flags before and after temp.c:
+ system "$cc $ccflags $flags temp.c $flags -o temp > $devnull 2>&1";
+ in Makefile.PL. This is done because some systems need $flags in one
+ place, some systems in the other.
+
+ Graphics/PLplot/Makefile.PL | 5 ++++-
+ 1 files changed, 4 insertions(+), 1 deletions(-)
+
+commit b62a0f0ba3760130688a5ae0af20a9de88412235
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 2 09:45:27 2011 -0400
+
+ Add pthreads to DEPENDENCIES
+
+ Make explicit mention of pthreads being needed to support
+ the new PDL::ParallelCPU capability.
+
+ DEPENDENCIES | 5 +++++
+ 1 files changed, 5 insertions(+), 0 deletions(-)
+
+commit 9701049e6287a68580a79720e79d63885395089e
+Merge: 8753d83 0a28652
+Author: Doug Hunt <dhunt at ucar.edu>
+Date: Thu Sep 1 12:38:31 2011 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 8753d83c1a37459228f230a7c3e58a6f14fb1f80
+Author: Doug Hunt <dhunt at ucar.edu>
+Date: Thu Sep 1 12:37:20 2011 -0600
+
+ Added back some of Sisyphus's changes for Windows to plplot.pd and Makefile.PL
+
+ Graphics/PLplot/Makefile.PL | 2 +-
+ Graphics/PLplot/plplot.pd | 10 ++++++----
+ 2 files changed, 7 insertions(+), 5 deletions(-)
+
+commit 0a28652c958482e4553655f4f088ad0aa9c51cb7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 1 14:13:26 2011 -0400
+
+ Add LIBS and INC options for pthreads
+
+ Add the ability to specify POSIX_THREADS_LIBS and POSIX_THREADS_INC
+ in perldl.conf as a way to simplify the correct build of pthreads
+ in PDL. This should not be needed once the full detection is
+ sorted out.
+
+ perldl.conf | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit ea00c841f8e7ca0d54b080016f8672405c1ed0a9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 1 14:00:43 2011 -0400
+
+ Clean up pthread_t access in pdlmagic.c
+
+ This is a partial fix for platform specific coding using the
+ pthreads API. Still to do, fix the detection of the pthreads
+ library in Basic/Core/Makefile.PL and rework the print
+ statements in pdlmagic.c which assume that a pthread_t can
+ be printed out as an integer (not true for all platforms and
+ bad coding style regardless). The good news is if I hardwire
+ the pthreads library and includes on cygwin it all appears to
+ build and test ok....
+
+ Basic/Core/pdlmagic.c | 25 ++++++++++++++-----------
+ 1 files changed, 14 insertions(+), 11 deletions(-)
+
+commit c27168f4fbee1771cb97c7211a1c389be9d2ed72
+Author: Doug Hunt <dhunt at ucar.edu>
+Date: Wed Aug 31 09:22:27 2011 -0600
+
+ Give credit to Sisyphus for the OPTIONS! file processing changes.
+
+ Graphics/PLplot/Changes | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 73a90bdd7687047933afc2a0355bb40ca8295930
+Author: Doug Hunt <dhunt at ucar.edu>
+Date: Tue Aug 30 15:41:08 2011 -0600
+
+ Updated to latest version of PDL::Graphics::PLplot. Merged in David Mertens
+ changes to Makefile.PL and plplot.pd. Added new test to PLplot.t--David's
+ 'nopthreads' failure test.
+
+ Graphics/PLplot/Changes | 14 +
+ Graphics/PLplot/Makefile.PL | 95 +-
+ Graphics/PLplot/plplot.pd | 3882 ++++++++++++++++++++++++++++---------------
+ MANIFEST | 1 +
+ t/plplot.t | 65 +-
+ 5 files changed, 2640 insertions(+), 1417 deletions(-)
+
+commit 1fb573a6454fa580d848b664965c29ee396b469f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Aug 29 17:09:00 2011 -0400
+
+ Fix offs declaration in listref_c
+
+ offs was misdeclared as a (PDL_Long *) rather than (PDL_Long)
+ in PDL/Basic/Core/Core.xs. Also fixed the mismatch between
+ the smalloc in pdl.h and the new prototype for pdl_malloc.
+
+ Basic/Core/Core.xs.PL | 2 +-
+ Basic/Core/pdlcore.h.PL | 2 +-
+ Basic/Slices/slices.pd | 4 ++--
+ IO/Storable/storable.pd | 2 +-
+ Lib/GSL/MROOT/FUNC.c | 2 +-
+ Lib/ImageND/imagend.pd | 6 +++---
+ Lib/Minuit/FCN.c | 2 +-
+ Lib/Transform/transform.pd | 6 +++---
+ 8 files changed, 13 insertions(+), 13 deletions(-)
+
+commit 3d03943a2386e6d92231839fb014b7d83951cdfb
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 28 13:34:51 2011 -0400
+
+ Update VERSION to 2.4.9_009 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit c8335d8e7a8db78e96bf12189be0c2cfc1d4532f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 28 12:19:01 2011 -0400
+
+ Update Release_Notes for PDL-2.4.9_008 release
+
+ This is a roll-up of the PDL bugs fixed to date.
+
+ Known_problems | 10 ++++++++++
+ Release_Notes | 7 ++++++-
+ 2 files changed, 16 insertions(+), 1 deletions(-)
+
+commit a3359f2f33cb5c41801ac0bf03ff7bac0753abc3
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Fri Aug 26 15:06:41 2011 -0500
+
+ Added NoPthread to all low-level PLplot functions
+
+ Graphics/PLplot/plplot.pd | 57 ++++++++++++++++++++++++++++++++++++++++++++-
+ 1 files changed, 56 insertions(+), 1 deletions(-)
+
+commit 59a8e2806870abbf90f2059366134a7706098552
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 26 12:44:37 2011 -0400
+
+ Correct fix to FITS.pm for sf.net bug #3394327
+
+ Need to localize the *output* record separator, and not
+ the input record separator.
+
+ IO/FITS/FITS.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit e94f81e83a5d1d6ff02f76bb52616825dd1e4c3b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Aug 25 18:20:32 2011 -0400
+
+ Fix test count in t/pnm.t
+
+ t/pnm.t | 5 ++++-
+ 1 files changed, 4 insertions(+), 1 deletions(-)
+
+commit bba589f6a6b6794060dcfff94da403cc90e4e8fd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Aug 25 13:52:38 2011 -0400
+
+ More clean-up to pdlcore.c.PL re dSP
+
+ Added some indentation and moved the SV *sv declaration
+ into the same block as the dSP since that is where the
+ pointer is used.
+
+ Basic/Core/pdlcore.c.PL | 87 +++++++++++++++++++++++++---------------------
+ 1 files changed, 47 insertions(+), 40 deletions(-)
+
+commit 8a7484dc42bbcab3ea5aa4b8b07a84ffb4a65a69
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Thu Aug 25 10:06:13 2011 +1000
+
+ Better fix (for MicroSoft Compilers) to pdlcore.c.PL
+
+ Use scope block instead of "#ifdef" to solve the
+ problem re "dSP" declaration.
+
+ Basic/Core/pdlcore.c.PL | 7 ++-----
+ 1 files changed, 2 insertions(+), 5 deletions(-)
+
+commit 0bf6152018c38797e86ac870ba152267db542ac6
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue Aug 23 12:11:29 2011 +1000
+
+ Minor fix (for MicroSoft Compilers) to pdlcore.c.PL
+
+ "dSP;" needs to be declared early for older MS
+ compilers
+
+ Basic/Core/pdlcore.c.PL | 5 +++++
+ 1 files changed, 5 insertions(+), 0 deletions(-)
+
+commit 70f7b22fe14d50bee3238b7d914cbe145ff0a512
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Aug 22 09:15:18 2011 -0400
+
+ Update readme-type files
+
+ Known_problems | 2 --
+ Perldl2/TODO | 2 +-
+ Release_Notes | 5 +++++
+ TODO | 8 ++++++--
+ 4 files changed, 12 insertions(+), 5 deletions(-)
+
+commit aab760e8ccfcc31d875e143c47075e3a56033d80
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 21 15:34:17 2011 -0400
+
+ Enable tests for more converters
+
+ Some of these tests were commented out a while ago because of
+ "buggy" pnmtoxxx converters. I'm not sure that is the case
+ so am enabling these tests to evaluate more fully.
+
+ t/picrgb.t | 14 ++++++++------
+ t/pnm.t | 12 +++++++-----
+ 2 files changed, 15 insertions(+), 11 deletions(-)
+
+commit 81ca9e6613f9c6cd1f994e9fc257b406799c3991
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 21 11:49:25 2011 -0400
+
+ Update VERSION to 2.4.9_008 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 14 +-------------
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 14 deletions(-)
+
+commit 68e92867ef55db36bd7255b5008d0b50652097d1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 21 11:00:12 2011 -0400
+
+ Update readme-type files for 2.4.9_007 release
+
+ Known_problems | 8 ++++++++
+ Release_Notes | 16 +++++++++++++++-
+ TODO | 3 ++-
+ 3 files changed, 25 insertions(+), 2 deletions(-)
+
+commit e3614859dcca4183d4b64080dd6df1c6be275dda
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 21 10:50:37 2011 -0400
+
+ Add fix to FITS.pm for sf.net bug #3394327
+
+ It seems like localizing $/ to undef is the right thing
+ to do. I would feel better if someone who knows FITS and the
+ FITS.pm code could come up with a test to reproduce the original
+ problem.
+
+ IO/FITS/FITS.pm | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit d864f548da7ed02772257ee7f11339fac4c6b4f2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 21 10:48:49 2011 -0400
+
+ Revert to original code
+
+ The quick fix of using the non-badvalue code all the time appears
+ to resolve the min*/max* routines problem with NaNs. Reverting
+ for now. Needs more investigation before assuming as a fix.
+ Mostly, we need to test on a non-badvalue PDL install...
+
+ Basic/Ufunc/ufunc.pd | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit c63222860d99fafdfb86ae4e63f8873a7a13ac6f
+Author: John Cerney <john.cerney at gmail.com>
+Date: Sun Aug 21 09:12:28 2011 -0500
+
+ Fixed bug where t/pthreadBarf.t test case segfaults
+
+ Bug ID 3392972
+ Recent changes (between 2.4.9_004 and 2.4.9_005) caused the pthreadBarf.t
+ test case to fail. Moved the dSP; call in pdl_barf_or_warn to fix the
+ problem.
+
+ Basic/Core/pdlcore.c.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit db635b2584593e154b3e53fc835d336dbe56d6b9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 20 22:37:41 2011 -0400
+
+ Update Release_Notes
+
+ Release_Notes | 40 ++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 40 insertions(+), 0 deletions(-)
+
+commit 4e4cedee2ff80baab2ecadbef010a0704c5d705d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 20 22:30:08 2011 -0400
+
+ Update VERSION to 2.4.9_007 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 22 ++++++----------------
+ 3 files changed, 8 insertions(+), 18 deletions(-)
+
+commit d145a343e046bdcb734431b7975f90f350bcfeff
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 20 21:40:12 2011 -0400
+
+ Update Known_problems/Release_Notes for 2.4.9_006
+
+ Known_problems | 5 +++++
+ Release_Notes | 12 +++++++++++-
+ 2 files changed, 16 insertions(+), 1 deletions(-)
+
+commit b485f30b712b8a426b3f7752bb2429a210bf2ce4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 20 09:30:38 2011 -0400
+
+ Update t/pthreadBarf.t to use Test::More
+
+ Test::More is the standard test package for on-going PDL
+ development (the right combination of features and
+ availability---it is part of the perl Core module set).
+
+ Also, the test should pass with and without pthreads being
+ enabled so I've allowed that with a message output for when
+ pthreads is not enabled.
+
+ t/pthreadBarf.t | 136 +++++++++++++++++++++----------------------------------
+ 1 files changed, 52 insertions(+), 84 deletions(-)
+
+commit 0f40cffc73ae80526ea12487d50b1abc26178bc0
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sat Aug 20 18:21:10 2011 +1000
+
+ Remove 'PDL_Long *' from Basic/Core/typemap
+
+ The 'PDL_Long *' typemapping was introduced to fix
+ breakages reported in SF Bug 3377113.
+ This typemapping was inappropriate, and is hopefully
+ no longer necessary now that Core.xs.PL has been
+ amended.
+
+ Basic/Core/typemap | 1 -
+ 1 files changed, 0 insertions(+), 1 deletions(-)
+
+commit e54b0f0174f2f8f297479cceb38edb7e4cec6880
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sat Aug 20 18:21:09 2011 +1000
+
+ Fix some coding issues in Core.xs.PL (SF Bug 3377113)
+
+ Fixes some breakages caused by poor coding practice, not
+ caught until version 3 of ExtUtils::ParseXS was introduced.
+
+ Basic/Core/Core.xs.PL | 186 +++++++++++++++++++++++++++---------------------
+ 1 files changed, 105 insertions(+), 81 deletions(-)
+
+commit 87dbc8eaccd3e73cbc583e8011718e6c3e0c4f21
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Aug 17 09:38:58 2011 -0400
+
+ Update Known_problems for 2.4.9_006 development
+
+ Known_problems | 11 +++++++----
+ 1 files changed, 7 insertions(+), 4 deletions(-)
+
+commit e308a0311f5deb7f6f7ac01bb1ad13209ac26816
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 16 21:45:42 2011 -0400
+
+ Update VERSION to 2.4.9_006 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 1 -
+ Release_Notes | 34 +++++++++++++++++++++++++++++++++-
+ 3 files changed, 34 insertions(+), 3 deletions(-)
+
+commit d410920521eddd0645cc4e0e89ce791fb022b1ef
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 16 20:08:26 2011 -0400
+
+ Add PDL_Long * typemap for sf.net bug #3377113
+
+ Basic/Core/typemap | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 9e635d72317647320897a8fd62bf1e7ed1601aea
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue Aug 16 13:37:43 2011 +1000
+
+ Rearrange code in Basic/Core/pdlthread.c
+
+ Rearrange the code so that older Microsoft
+ compilers can parse it.
+
+ Basic/Core/pdlthread.c | 114 ++++++++++++++++++++++++-----------------------
+ 1 files changed, 58 insertions(+), 56 deletions(-)
+
+commit cab63972505d5242b2b33d863ed04c74edf0ac91
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue Aug 16 13:37:42 2011 +1000
+
+ Rearrange C code in Basic/Core/pdlcore.c.PL
+
+ Rearrange the code so that older Microsoft
+ compilers can parse it.
+
+ Basic/Core/pdlcore.c.PL | 166 ++++++++++++++++++++++++-----------------------
+ 1 files changed, 84 insertions(+), 82 deletions(-)
+
+commit 7634dc3d0987b15f6b2e99c74f72cd3665ce05b1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Aug 15 14:45:53 2011 -0400
+
+ Docs fix for whereND in primitive.pd
+
+ Basic/Primitive/primitive.pd | 8 +++++---
+ 1 files changed, 5 insertions(+), 3 deletions(-)
+
+commit 1bbd43cc64a2df3ea749f9b5a3ccf2b000efd90b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 14 15:16:16 2011 -0400
+
+ Add MARK BAKER m4ls to demo 3dgal
+
+ Demos/TriDGallery.pm | 9 ++++++++-
+ 1 files changed, 8 insertions(+), 1 deletions(-)
+
+commit b716dbf0b4f0d5c5d7d5d25abd6322a9c2846e8b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 14 14:24:35 2011 -0400
+
+ Add TODO tests for sf.net bug # 3234141
+
+ The problem is an inconsistent treatment of NaN values
+ depending on whether or not it is the first one along
+ the dimension. The results should be the same no matter
+ what order the elements are in.
+
+ t/ufunc.t | 36 ++++++++++++++++++++++--------------
+ 1 files changed, 22 insertions(+), 14 deletions(-)
+
+commit ba94371d501e6f8424b050fe0b1032258d0abc88
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 14 13:07:28 2011 -0400
+
+ Update bugs list in Known_problems
+
+ Known_problems | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 5b1770756a601a1dcefe8fca573e6f7ef690f68a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 14 12:52:07 2011 -0400
+
+ Update VERSION and pod for pdldoc
+
+ pdldoc.PL | 16 ++++++++++++----
+ 1 files changed, 12 insertions(+), 4 deletions(-)
+
+commit 5a86c06d4d4112067a88aa5b2f9fdaece1de6126
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 13 13:57:09 2011 -0400
+
+ Update VERSION to 2.4.9_005 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit e538a2f8b14ab00d0151486b67c0d1d0209e97ad
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 13 13:17:57 2011 -0400
+
+ Update Release_Notes for CPAN devel release
+
+ MANIFEST.SKIP | 1 +
+ Release_Notes | 22 ++++++++++++++++++++--
+ 2 files changed, 21 insertions(+), 2 deletions(-)
+
+commit 5097f70403e8439cbe28a9cec8c041ec27bfc94c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 13 13:05:07 2011 -0400
+
+ Add PDL::AutoLoader support to pdldoc
+
+ Now, by default, it will return the same results
+ as the interactive help/apropos commands within the pdl2
+ and perldl shells. A new perldl.conf option
+ PDLDOC_IGNORE_AUTOLOADER has been added in case a user
+ prefers the previous behavior.
+
+ pdldoc.PL | 9 ++++++++-
+ 1 files changed, 8 insertions(+), 1 deletions(-)
+
+commit f3d74c986baf35bd962a2c6bd63853ec5c75e347
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 13 13:03:32 2011 -0400
+
+ Add new fields to perldl.conf
+
+ Added PDL_CONFIG_VERSION to track PDL-visible changes
+ in the configuration information and PDLDOC_IGNORE_AUTOLOADER
+ to allow users to make pdldoc ignore searching the @PDLLIB
+ path for PDL::AutoLoader file with POD.
+
+ perldl.conf | 16 ++++++++++++++++
+ 1 files changed, 16 insertions(+), 0 deletions(-)
+
+commit 0542cb645af17974385dc191f4775e922a66b147
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 12 19:30:39 2011 -0400
+
+ Fix some typos in POD for FFTW complex stuff
+
+ Lib/FFTW/fftw.pd | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit f08d4de334cae6b58597ee3f6ce4d797966b11f6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 12 15:06:47 2011 -0400
+
+ Update Release_Notes and TODO
+
+ Release_Notes | 4 ++++
+ TODO | 4 ----
+ 2 files changed, 4 insertions(+), 4 deletions(-)
+
+commit c78966001daaa834d763ceee71379c8cc3ee1742
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 12 14:53:55 2011 -0400
+
+ added whereND to PDL::Primitive w tests
+
+ This is sf.net feature #3390043.
+
+ Basic/Primitive/primitive.pd | 84 ++++++++++++++++++++++++++++++++++++++++--
+ t/primitive.t | 9 ++--
+ 2 files changed, 85 insertions(+), 8 deletions(-)
+
+commit bdfdf41a8ac2624df1f02df243de0b05be1af274
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 12 13:15:18 2011 -0400
+
+ Add whereND tests to t/primitive.t
+
+ The tests will be skipped if there is no whereND defined
+ in the current package.
+
+ t/primitive.t | 80 +++++++++++++++++++++++++++++++++++++++------------------
+ 1 files changed, 55 insertions(+), 25 deletions(-)
+
+commit cf1ee2a91917aabcbd356b9c487f1ebd3f3987ed
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 12 11:16:04 2011 -0400
+
+ Convert primitive.t to use Test::More
+
+ t/primitive.t | 84 +++++++++++++++++++++++++++++---------------------------
+ 1 files changed, 43 insertions(+), 41 deletions(-)
+
+commit e4b144690b35181dbe75e20529e08aeffcb40c54
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 12 10:27:10 2011 -0400
+
+ Fix minor syntax issue for f2c conversion
+
+ Lib/Minuit/minuitlib/futils.f | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit c3aaaa2a7e0e699008fad97ffc95c0657c7d149e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Aug 11 13:08:27 2011 -0400
+
+ Fix POD in pp_def() for perldoc
+
+ Lib/FFTW/fftw.pd | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 58 insertions(+), 0 deletions(-)
+
+commit a8b8acf757193b23517abd871e2ac1613f197486
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 9 14:20:40 2011 -0400
+
+ Remove unused Tridiag routine
+
+ This is in response to problem report #3388862 at sf.net.
+ Neither the problem or the fix were able to be reproduced
+ but the code is actually unused. See the routines under
+ 'pdldoc -a solve' to locate current linear equation solvers
+ in PDL.
+
+ Basic/MatrixOps/matrix.c | 28 ----------------------------
+ Basic/MatrixOps/matrix.h | 7 ++-----
+ 2 files changed, 2 insertions(+), 33 deletions(-)
+
+commit 34f77b5c39cc88f163e3db1b26101e19557bbbe3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Aug 8 14:40:07 2011 -0400
+
+ Update inc/Devel/CheckLib.pm to 0.93
+
+ inc/Devel/CheckLib.pm | 8 +++++---
+ 1 files changed, 5 insertions(+), 3 deletions(-)
+
+commit 87967f0d2521fba64ca682763039970363d66be6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Aug 8 14:19:31 2011 -0400
+
+ conditionalize diag() message in t/slice.t
+
+ Now the message is only displayed if the test fails.
+
+ t/slice.t | 3 +--
+ 1 files changed, 1 insertions(+), 2 deletions(-)
+
+commit 54c1111fbbfd52b4945d0cc96ca56e301d236cde
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 7 13:54:33 2011 -0400
+
+ Update Known_problems and Release_Notes
+
+ Known_problems | 4 ++--
+ Release_Notes | 5 +++++
+ TODO | 2 ++
+ 3 files changed, 9 insertions(+), 2 deletions(-)
+
+commit b7319a1c34a0aeb9835fb2dc6855f36f941596c2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 7 13:44:10 2011 -0400
+
+ Add support for pdls larger than 2GiB
+
+ This commit applies the fix from Jarle Brinchmann
+ for pdl_grow() and a similar one for pdl_malloc()
+ replacing the use of int type for nbytes by the
+ use of STRLEN. On 64bit platforms, this allows for
+ pdls larger than 2**31 bytes.
+
+ NOTE: The total number of elements in a piddle
+ is still limited to 2**31.
+
+ NOTE: Eventually we need to change the usage of
+ smalloc (a.k.a. pdl_malloc) and grow (a.k.a. pdl_grow)
+ to use STRLEN arguments instead.
+
+ Basic/Core/pdlconv.c.PL | 2 +-
+ Basic/Core/pdlcore.c.PL | 2 +-
+ Basic/Core/pdlcore.h.PL | 2 +-
+ Basic/Core/pdlhash.c | 6 +++---
+ 4 files changed, 6 insertions(+), 6 deletions(-)
+
+commit bdb08a07c202c14c8dea72fce1f0d77f204e80e7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 6 18:53:00 2011 -0400
+
+ Update perldl POD docs a bit
+
+ perldl.PL | 22 ++++++++++++----------
+ 1 files changed, 12 insertions(+), 10 deletions(-)
+
+commit 5e38a35cffc161f3d992985b30f1ba02007ead8d
+Merge: 4a9c452 dbd0aa0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 6 18:37:53 2011 -0400
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 4a9c452ca3768910d873a48258ce94e4dce090c7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 6 18:35:31 2011 -0400
+
+ Update Perldl2/TODO re error filters
+
+ Errors in the shells can generate *huge* nested
+ reports. Added a list of items that could be
+ filtered out without removing the relevant PDL
+ errors.
+
+ Perldl2/TODO | 15 +++++++++++++++
+ 1 files changed, 15 insertions(+), 0 deletions(-)
+
+commit dbd0aa08821215867e123eee1dd35859ff27c972
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 29 13:45:15 2011 -0400
+
+ Add 'use PDL::Constants' to default.perldlrc
+
+ This is the first step for adding 'use PDL::Constants' to the
+ list of modules loaded by 'use PDL'.
+
+ Basic/default.perldlrc | 3 ++-
+ Release_Notes | 6 ++++++
+ 2 files changed, 8 insertions(+), 1 deletions(-)
+
+commit 367cef28004bcbb5d3979872764241cd7d1d1294
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 23 16:58:18 2011 -0400
+
+ Fix sf.net bug #3375837 "_read_flexhdr ... fails"
+
+ readflex() failed in the _read_flexhdr() routine when
+ a multi-pdl data file was read *and* the first pdl had
+ 2 or mor dimensions.
+
+ IO/FlexRaw/FlexRaw.pm | 152 +++++++++++++++++++++++++------------------------
+ t/flexraw.t | 37 +++++++++---
+ 2 files changed, 105 insertions(+), 84 deletions(-)
+
+commit ce45095457be68779817a3e0aae67189a4068957
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 22 14:46:58 2011 -0400
+
+ Set $PDL::IO::FlexRaw::writeflexhdr=1 in PDL shell
+
+ Enable writeflex() to call writeflexhdr() automatically
+ when a filename is given as the output destination. This
+ matches the behavior of writefraw() but is different than
+ the previous behavior so only enable the new default in
+ the interactive shells for now.
+
+ Basic/default.perldlrc | 1 +
+ IO/FlexRaw/FlexRaw.pm | 7 ++++---
+ 2 files changed, 5 insertions(+), 3 deletions(-)
+
+commit 30f92c90f3af00b72921e9f5854a6d97572f04bc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 20 17:59:51 2011 -0400
+
+ Fix mv() examples in Indexing.pod
+
+ Basic/Pod/Indexing.pod | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit c7f1df6985e88e7be8b3d37d46096600ff738c6c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 20 12:58:15 2011 -0400
+
+ Update Indexing.pod re lvalue subs and slicing
+
+ Basic/Pod/Indexing.pod | 22 +++++++++++++---------
+ 1 files changed, 13 insertions(+), 9 deletions(-)
+
+commit fee11b9ecf2b574e60c6a8205a217eb551501037
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 20 11:10:18 2011 -0400
+
+ Minor doc fixes to QuickStart.pod
+
+ Basic/Pod/QuickStart.pod | 36 ++++++++++++++++++------------------
+ 1 files changed, 18 insertions(+), 18 deletions(-)
+
+commit 14b4834f07a8a4f180f4995529a9943879f647dd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 17 14:54:24 2011 -0400
+
+ Add MYMETA.yml and MYMETA.json to .gitignore
+
+ All of a sudden, the build process is spitting out one
+ of each of these files for each directory with a Makefile.PL
+ in it---or so it appears. This may be related to a recent
+ upgrade to the version of EU::MM to 6.58.
+
+ .gitignore | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 0d215b8c6eeab8311ef1569a99d9e85da3d4cc50
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 17 14:52:58 2011 -0400
+
+ Add diagnostics of system() call to make_Type_pm
+
+ There was a CPAN Testers failure for this call. By printing
+ what the system() call was, it is hoped to determine the cause.
+
+ Makefile.PL | 5 ++++-
+ 1 files changed, 4 insertions(+), 1 deletions(-)
+
+commit 704e0a615e536ce19f1ef7aed1d967df1bc7d87b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 17 14:45:29 2011 -0400
+
+ Fix sf.net bug #3368883 t/opengl.t fails...
+
+ Added a die to the PDL::Graphics::OpenGL::OO->new() constructor
+ and an eval to catch and skip the create window tests if no
+ workable display mode was found.
+
+ Graphics/TriD/POGL/OpenGL.pm | 3 +--
+ t/opengl.t | 8 ++++++--
+ 2 files changed, 7 insertions(+), 4 deletions(-)
+
+commit 63090307e73ac26b1fc366fd37ded88d1b9c5be9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 16 15:34:15 2011 -0400
+
+ Add 16-bit image IO byteorder to Known_problems
+
+ Known_problems | 11 +++++++++++
+ 1 files changed, 11 insertions(+), 0 deletions(-)
+
+commit 35854efe735d1a200bd9a42cc22a2c68702955f1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 16 15:12:55 2011 -0400
+
+ Rm IO/Pnm/converters from MANIFEST
+
+ The current PDL requires 16bit support in the NetPBM routines
+ so these local copies are very out-of-date and redundant to
+ ones that would work. Taking them out of the distribution
+ in preparation for removing them from the release.
+
+ MANIFEST | 3 ---
+ MANIFEST.SKIP | 4 ++++
+ 2 files changed, 4 insertions(+), 3 deletions(-)
+
+commit d4fcf12676d36724370a6c49137e58272a85ca8a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 11 12:26:17 2011 -0400
+
+ Update VERSION info to 2.4.9_004 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit e1b3c25ec58f329df2aa121ed08580391810bcc9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 11 12:23:04 2011 -0400
+
+ Update Release_Notes for 2.4.9_003 release
+
+ Release_Notes | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 5bbc29575c98fb781d65d28a006e6e2ff61b9a36
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 10 14:53:19 2011 -0400
+
+ Update to Known_problems adn Release_Notes
+
+ Known_problems | 1 +
+ Release_Notes | 7 +++++++
+ 2 files changed, 8 insertions(+), 0 deletions(-)
+
+commit 904fb6f1727869f73a4c5e630035e53a9299de61
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 8 17:56:58 2011 -0400
+
+ Minor clean-up to t/slice.t
+
+ Replaced print by diag for message output and added a
+ test name to make it clear that the error was being
+ checked for.
+
+ t/slice.t | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 580a2b31d9d7d1dc7b5b990d9e670d01c3d616b0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jul 7 16:59:25 2011 -0400
+
+ Fix PDL TriD to work with cygwin+w32api POGL
+
+ The bug in the cygwin POGL support for w32api/WGL OpenGL
+ has been fixed, this fixes t/opengl.t to work with that
+ option enabled.
+
+ Graphics/TriD/POGL/OpenGL.pm | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit a39ee9889a32bbbb8aeca0e673bee7524e61c918
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 1 15:27:27 2011 -0400
+
+ add badvalue support to pctover and oddpctover
+
+ This is sf.net feature tracker item #3328001,
+ "add badvalue support to pctover and oddpctover"
+
+ Basic/Ufunc/ufunc.pd | 111 ++++++++++++++++++++++++++++----------------------
+ 1 files changed, 62 insertions(+), 49 deletions(-)
+
+commit 10dceb490e1ad291944e4c521dab2dc698ec7a34
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 28 15:35:21 2011 -0400
+
+ Update Release_Notes for 2.4.9_003...
+
+ ...and clarify the OpenGL requirement (needed only for
+ PDL::Graphics::TriD support, otherwise not a requirement).
+
+ Release_Notes | 9 ++++++++-
+ 1 files changed, 8 insertions(+), 1 deletions(-)
+
+commit b47d8661df0e7b9b560e10b44d2849a446e56125
+Merge: 35ee86b 3945bd5
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sun Jun 26 09:14:41 2011 -0500
+
+ Merge remote-tracking branch 'Dima/better_barf_withthreads'
+
+ Conflicts:
+ Basic/Core/pdlmagic.c
+
+ Finally pulled in Dima's edits. They pass all tests, though
+ we don't have lots of tests of the barfing behavior. Still,
+ there are some barf tests for cat, and they pass. Also the
+ pthreads tests pass.
+
+ The only modification I had to make was in pdlmagic.c, which
+ did not merge cleanly for some reason.
+
+commit 35ee86b89ca27d8c88a2d1b0566a5cfdbe5ede79
+Merge: 39c2c77 12078c6
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sat Jun 25 22:21:48 2011 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 12078c6b6b0ab676cd24f2fcbb27a434f1050abd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jun 24 13:18:59 2011 -0400
+
+ Update pctover and oddpctover re badval status
+
+ Neither routine handles bad values currently.
+ Added the HandleBad => 0 to the pp_def routines
+ and a few TODO tests in t/ufunc.t to show when
+ things a fixed.
+
+ See sf.net feature request #3328001 for details.
+
+ Basic/Ufunc/ufunc.pd | 2 ++
+ t/ufunc.t | 26 +++++++++++++++++++++++++-
+ 2 files changed, 27 insertions(+), 1 deletions(-)
+
+commit b155d2657c3b1decea2b5eefee88018cbeff4a38
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jun 19 16:12:51 2011 -0400
+
+ Update PDL::FAQ
+
+ Bringing things in-line with current PDL-2.4.9 usages.
+ Still to fix:
+ (1) Missing list of inplace-safe functions for Q: 6.6.
+ (2) Is "Q: 6.12 What is a null pdl?" up to date re Empty pdls?
+ (3) What about dataflow and Q: 6.15?
+
+ Basic/Pod/FAQ.pod | 60 ++++++++++++++++++++++++++++------------------------
+ 1 files changed, 32 insertions(+), 28 deletions(-)
+
+commit e51453767a03a2d73c1f40bf7ea8bf991b1ccff2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 14 10:19:41 2011 -0400
+
+ Update TODO and Perldl2/TODO for ref
+
+ Perldl2/TODO | 8 ++++++--
+ TODO | 12 +++++++-----
+ 2 files changed, 13 insertions(+), 7 deletions(-)
+
+commit ad4c25777f104960dd6e4a3218101564704c0b39
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jun 12 20:17:39 2011 -0400
+
+ Quiet warnings from PDL_NICESLICE_ENGINE
+
+ The implementation is simple and generates *lots* of
+ messages if run with warnings on. Added a no warnings
+ directive until things can be sorted out better.
+
+ Basic/SourceFilter/NiceSlice.pm | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit f9b6e8e3c72a4cb5ba61058a9a38f409b347bf8c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jun 12 16:01:56 2011 -0400
+
+ Add PDL_NICESLICE_ENGINE env variable
+
+ If you set PDL_NICESLICE_ENGINE to 'PDL::NiceSlice2' then
+ that module will be loaded to provide niceslice functionality
+ instead of the original one. This should make it easier to
+ try things out...
+
+ Basic/SourceFilter/NiceSlice.pm | 11 +++++++++++
+ 1 files changed, 11 insertions(+), 0 deletions(-)
+
+commit 68a6f4bc993630ee0db213316c8da0696af15b62
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jun 12 13:06:52 2011 -0400
+
+ Appear to have working PDL::NiceSlice2
+
+ With a workaround to a Filter::Simple bug and a hack
+ to workaround a missing feature in Text::Balanced, we
+ now have a trial implementation of an improved
+ PDL::NiceSlice filter. To try out, just replace your
+ exising NiceSlice.pm file with this one.
+
+ NOTE: We will still to implement similar processing for
+ pdl2/perldl as sourcefilters don't work with evals..
+
+ Basic/SourceFilter/NiceSlice2.pm | 58 +++++++++++++++++++++++++++++--------
+ 1 files changed, 45 insertions(+), 13 deletions(-)
+
+commit 3692c9c65e1782e7c6dacd3d2deb36be36bdc628
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jun 12 11:38:56 2011 -0400
+
+ Add =pod to workaround Filter::Simple bug
+
+ The current Filter::Simple regex for $pod_or_DATA has a
+ glitch for =begin =end pod blocks. By adding an =pod before
+ the =begin (which is a no-op as far as pod processing goes)
+ we workaround the problem.
+
+ IO/FITS/FITS.pm | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 1eea47187f667db384b2953c57fe42412b4754f2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jun 12 11:13:58 2011 -0400
+
+ Add comments with nslice_if_pdl() to findslice
+
+ Left these in place but commented out to in case someone
+ wanted to continue down this development line. I assumed
+ that since the modifier syntax is not valid perl that
+ the only place where nslice would need to be changed
+ to nslice_if_pdl would be in the filter section for slices
+ with no modifiers present.
+
+ Basic/SourceFilter/NiceSlice.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 174cabe6b5bfcd60110901f4c66337c8c4aa1c4d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jun 11 19:18:58 2011 -0400
+
+ Fix PDL::nslice_if_pdl to use CODE refs
+
+ This finishes the basic implementation for version of
+ nslice that can call a code reference or the standard
+ PDL::nslice routine depended on whether $self is a
+ CODE ref or a PDL ref. Making a UNIVERSAL::nslice_if_pdl
+ handles other blessed objects but not a raw CODE ref.
+
+ Basic/Core/Core.pm.PL | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit da4d4b3de86097b05b80ba062027f90dc09d747b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jun 11 17:35:31 2011 -0400
+
+ Add nslice_if_pdl variant of nslice
+
+ This routine is the same as nslice but it takes
+ an extra argument from the PDL::NiceSlice filter
+ process, a string of the original args before
+ processing. The idea is to allow a code reference
+ to be called if the $self is not a piddle.
+
+ This works provided $self is a blessed object.
+ Then we could use UNIVERSAL::nslice_if_pdl to
+ catch that. We need to investigate the limitations
+ of method call syntax. Maybe a { } block with
+ the CODE check there could work...
+
+ Only a partial solution since a method call can
+ only be made if the $self is a blessed object.
+
+ Basic/Core/Core.pm.PL | 29 ++++++++++++++
+ Basic/Lvalue.pm | 2 +-
+ Basic/SourceFilter/NiceSlice.pm | 82 +++++----------------------------------
+ 3 files changed, 40 insertions(+), 73 deletions(-)
+
+commit 5918de8737644bfa0503c5167df0988af64d13dc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jun 11 12:36:05 2011 -0400
+
+ Update Known_problems and Release_Notes
+
+ Now include the current sf.net bugs and added
+ the update for the Text::Balanced version to the
+ Release_Notes.
+
+ Known_problems | 1 +
+ Release_Notes | 5 +++++
+ 2 files changed, 6 insertions(+), 0 deletions(-)
+
+commit d9a17f5f22a0801ee88886ebf5fed2c202342a1f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jun 11 12:27:45 2011 -0400
+
+ Update Text::Balanced min version to 1.89
+
+ This is the version in perl 5.8.0 so the change in
+ requirement won't affect any of the current PDL
+ platforms. The version bump is required to enhance
+ the PDL::NiceSlice filter which requires a workaround
+ using the current Text::Balanced implementation.
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 0f4cefe2478543e2d0e9080a5239d9870083bf03
+Merge: ad14f3f 2004d1e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 7 22:12:13 2011 -0400
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit ad14f3f4467bcd12945449c472ca9cfca71491aa
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 7 22:08:41 2011 -0400
+
+ Refactor PDL::NiceSlice to use Filter::Simple
+
+ This allows for nslice() filtering to only be applied outside
+ of POD, comments, and quotelike strings. Unfortunately, running
+ the PDL modules through the Filter::Simple framework exposed
+ a bug in Filter::Simple and in Text::Balanced (which is called
+ by Filter::Simple to do much of its work).
+
+ Basic/SourceFilter/NiceSlice2.pm | 1073 ++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 1073 insertions(+), 0 deletions(-)
+
+commit 2004d1e65e5798025cbed62435dd60c7121692a0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 6 13:37:16 2011 -0400
+
+ Add comment for way forward w code refs and nslice
+
+ Plan to rewrite the nslice() method to detect when
+ we have the CODE ref usage. In that case, UNIVERSAL::nslice()
+ would be called which would construct the desired CODE ref
+ method call using the original pre-NiceSlice version of the
+ nslice() arguments which would be stashed by the source filter
+ during the original processing.
+
+ NOTE: This has potential to collide with another UNIVERSAL::nslice()
+ method declaration.
+
+ Basic/Core/Core.pm.PL | 7 ++++++-
+ 1 files changed, 6 insertions(+), 1 deletions(-)
+
+commit 7b732c23f42e8d6aac0a3696a366c98275fb7bd1
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Jun 4 11:57:31 2011 +0200
+
+ use autodetection for TriD build
+
+ Now, there is only one line different from the usual perldl.conf
+
+ debian/perldl.conf | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit bd248f50e2b5f06939e4e8309058b86a42bb7e15
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Jun 4 11:52:08 2011 +0200
+
+ merge changes to perldl.conf into debian/perldl.conf
+
+ debian/perldl.conf | 149 +++++++++++++++++++++++++++++++++-------------------
+ 1 files changed, 94 insertions(+), 55 deletions(-)
+
+commit 006a5481bd4f797f19004b06b904bd9a7d3d83c9
+Merge: 1e8fb45 353a744
+Author: Craig DeForest <zowie at Clio-2.local>
+Date: Wed Jun 1 23:23:59 2011 -0600
+
+ Merge branch 'master' of ssh://zowie@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 353a74423aabbf3f3205eb44c290dab3045862f0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jun 1 17:50:10 2011 -0400
+
+ Update sf.net bug list in Known_problems file
+
+ Known_problems | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit b611cfd457c4cb0a0118596b6ed908d8c8ee3f3d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 31 16:23:33 2011 -0400
+
+ Add CODE ref detection and barf to PDL::nslice()
+
+ This is in preparation for refactoring the PDL::NiceSlice
+ module to handle this case correctly via runtime detection
+ of CODE reference args. To do so, the source filter needs
+ to be modified to pass through a copy of the original args
+ as a string for later eval.
+
+ Basic/Core/Core.pm.PL | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit cffcc7f10bd6e25a3f01f9a4b1a5cc1050572cbf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 31 14:02:35 2011 -0400
+
+ Update TODO list items
+
+ TODO | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++----
+ 1 files changed, 56 insertions(+), 4 deletions(-)
+
+commit 1c477a90a1bb3808419b95332733efbea789583d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 31 10:22:35 2011 -0400
+
+ Add null SIGPIPE handler to output pipes
+
+ This should make PDL "SIGPIPE safe" by not exiting when a
+ PDL piped IO output process quits. At some point we may
+ wish to add an eval+die handler to report failures better.
+
+ Doc/Doc.pm | 1 +
+ Doc/Doc/Perldl.pm | 2 ++
+ Graphics/TriD/TriD/OOGL.pm | 27 +++++++++++++++++----------
+ IO/Dumper.pm | 1 +
+ IO/FITS/FITS.pm | 4 ++++
+ IO/Pnm/Pic.pm | 5 +++--
+ 6 files changed, 28 insertions(+), 12 deletions(-)
+
+commit ac9b0f924272d8ab4e6b3f7ea75451d47f0e1aa6
+Author: John Cerney <cerney at ntxlt0182636.(none)>
+Date: Mon May 30 11:44:40 2011 -0500
+
+ Fixed segfaults in t/pthreadBarf.t when running with perl 5.13, 5.14
+
+ t/pthreadBarf.t | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 7bdc5b66ebe1f9e302782c77775e86ed767f3b83
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 27 16:59:34 2011 -0400
+
+ quiet whichND deprecation warnings in tests
+
+ Rework t/primitive2.t and t/subclass3.t to not use the
+ planned-to-be-deprecated whichND list context output.
+
+ t/primitive2.t | 4 +++-
+ t/subclass3.t | 7 +++++--
+ 2 files changed, 8 insertions(+), 3 deletions(-)
+
+commit 6f54e1d48030128f659d5c701e0a14569aa50a08
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 27 16:28:28 2011 -0400
+
+ Add $SIG{PIPE} = 'IGNORE' for pipe to ffmpeg
+
+ This should keep perldl/pdl2 from exiting if a SIGPIPE
+ is returned for some reason. This may fix sf.net bug #3307121
+ "wmpeg sometimes kills perldl if file already exists".
+
+ IO/Pnm/Pic.pm | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 26f35983b8630e746fcd99f0e2bcf32609aa1db6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 27 16:27:40 2011 -0400
+
+ Add full package name to isbigendian() call
+
+ Basic/Core/Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3d5d980d49b495fc70992b0984aca5fba89ed09a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu May 26 18:42:39 2011 -0400
+
+ Add note re PERL_SIGNALS=unsafe to Known_problems
+
+ Known_problems | 6 ++++++
+ 1 files changed, 6 insertions(+), 0 deletions(-)
+
+commit 2241bf3b16b2413a263665bddf11e5a3b387618f
+Merge: 9acb63f f02d33c
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue May 24 12:59:32 2011 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 9acb63f27cd1c0e4ae4ec5df358a46a231f55d00
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue May 24 12:57:01 2011 -0600
+
+ Use $Config::Config{usrinc} to search for pthread.h instead of hard-coding /usr/include.
+
+ Basic/Core/Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f02d33c5dc837f744e1443fe0ad5173398fe43e9
+Author: Craig DeForest <zowie at z4.boulder.swri.edu>
+Date: Mon May 23 23:29:59 2011 -0600
+
+ I can't believe I'm still supporting this. Must ... migrate ... to ... PLPlot.
+ Fixed bug with Justify option in fits_imag -- a typo in the Justify logic
+ prevented non-unity aspect ratios with the justify command in _fits_foo.
+
+ Graphics/PGPLOT/Window/Window.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit bfe7d4ed83914ef96ff3497913c4df630f01bb25
+Author: Craig DeForest <zowie at z5.boulder.swri.edu>
+Date: Sun May 22 23:16:11 2011 -0600
+
+ add map() fix for nonlinear FITS headers (remove tags when copying header
+ to output variable)
+
+ Lib/Transform/transform.pd | 12 +++++++++++-
+ 1 files changed, 11 insertions(+), 1 deletions(-)
+
+commit ce7827dead6fc3084f9800e6a0141804f785beba
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 21 10:06:19 2011 -0400
+
+ Update VERSION to 2.4.9_003 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 059697b3a4ae2eda3573a9804ba1d421f92a3a71
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 21 09:11:27 2011 -0400
+
+ Update MANIFEST with new ParallelCPU files
+
+ MANIFEST | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit 3e5e5d21c9cd6823bd9890cd5588e1d09f00f685
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 21 09:08:28 2011 -0400
+
+ Update Release_Notes for CPAN devel release
+
+ Release_Notes | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 701a9bb9a5f5ee31e0bff6fe39f7aebfaa2e6538
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu May 19 22:38:57 2011 -0400
+
+ Fix warning message from File::Temp usage
+
+ It made it sound as if there was something dangerous going
+ on in the PDL test suite. Turned off warnings to quiet.
+
+ t/bad.t | 6 +++++-
+ 1 files changed, 5 insertions(+), 1 deletions(-)
+
+commit 39c2c77cd8404b44a6bf4140613bddabf79ab103
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Thu May 19 16:08:19 2011 -0500
+
+ Added by-line for John Cerney in ParallelCPU docs.
+
+ Daniel pointed out last summer that we have many docs that do not
+ specify any sort of copyright. John didn't add a copyright to his
+ ParallelCPU docs, so I added one for him.
+
+ Basic/Pod/ParallelCPU.pod | 6 ++++++
+ 1 files changed, 6 insertions(+), 0 deletions(-)
+
+commit 1e8fb45a0b14d5e2044c60dfc174e02642c6aafa
+Merge: afdf491 ac63923
+Author: Craig DeForest <zowie at Clio-2.local>
+Date: Thu May 19 09:50:31 2011 -0600
+
+ Merge branch 'master' of ssh://zowie@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit afdf491905c523e61ddfad8056b3e6604382bf60
+Author: Craig DeForest <zowie at Clio-2.local>
+Date: Thu May 19 09:49:50 2011 -0600
+
+ fix parameter parsing for t_cubic
+
+ Lib/Transform/transform.pd | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit cbd95cdbfa4b983396655df71b880a839df7b935
+Author: Craig DeForest <zowie at Clio-2.local>
+Date: Thu May 19 09:49:29 2011 -0600
+
+ fix inverse in perspective
+
+ Lib/Transform/Cartography/Cartography.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit ac639236321cbe5ee9830877085311a916136fec
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu May 19 09:51:53 2011 -0400
+
+ Update Known_problems and Release_Notes
+
+ NiceSlice bugs were closed, new support for
+ parallel CPU computation to improve performance,
+ docs and distribution improvements...
+
+ Known_problems | 3 +--
+ Release_Notes | 11 ++++++++++-
+ 2 files changed, 11 insertions(+), 3 deletions(-)
+
+commit d5ec4edccbe0df0625186b5ea93b30853c1c9944
+Author: John Cerney <cerney at ntxlt0182636.(none)>
+Date: Wed May 18 21:21:27 2011 -0500
+
+ Fixed complilation problems with no pthreads enabled.
+ But was introduced in the ParallelCPU patch.
+
+ Basic/Core/pdlmagic.c | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 4d0eaeafc7c848bd716d068c264e9f773750eca3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 18 16:03:21 2011 -0400
+
+ Fix sf.net #3295544 NiceSlice parsing bug
+
+ This was a failure to call findslice() recursively for
+ the argument for a where modifier (it is possible that
+ the condition could contain NiceSlice constructs).
+
+ Basic/SourceFilter/NiceSlice.pm | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit bdc715bd3a0dea4daeb67568cf91c975330122ee
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 18 15:07:28 2011 -0400
+
+ Fix bug #3300467 NiceSlice asterisk parsing issue
+
+ Improved some of the debug output strings to better
+ show when passed whitespace or empty args and added
+ a pattern to catch leading whitespace for '*' args.
+
+ Basic/SourceFilter/NiceSlice.pm | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 47ed11547e472539935b387edd051a0ae7e2d1ed
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 18 07:06:19 2011 -0400
+
+ Apply Dima Kogan fix for wcols args regression
+
+ This appears to have been introduced with sf.net
+ patch #3287853. Thanks for catching this...
+
+ IO/Misc/misc.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3945bd570f48bb0b67b6f3859e435582920acf29
+Author: Dima Kogan <dkogan at cds.caltech.edu>
+Date: Sun May 15 15:32:58 2011 -0700
+
+ tabified reworked barfing functions for more consistent style. Whitespace-only patch
+
+ Basic/Core/pdlmagic.c | 124 ++++++++++++++++++++++++------------------------
+ 1 files changed, 62 insertions(+), 62 deletions(-)
+
+commit eba3b37d8ae7525e29323446ccb19413a74d58b4
+Author: Dima Kogan <dkogan at cds.caltech.edu>
+Date: Sun May 15 04:02:51 2011 -0700
+
+ Reworked deferred error message storage to remove duplicate code and to simplify the flow
+
+ Basic/Core/pdlcore.c.PL | 2 +-
+ Basic/Core/pdlmagic.c | 201 ++++++++++++++++-------------------------------
+ Basic/Core/pdlmagic.h | 3 -
+ 3 files changed, 69 insertions(+), 137 deletions(-)
+
+commit 4edb173e0cff6c4c1a30c18f809627575e70085a
+Author: Dima Kogan <dkogan at cds.caltech.edu>
+Date: Sun May 15 03:05:07 2011 -0700
+
+ Unified the barfing/warning code. Removed code duplication
+
+ Basic/Core/pdlcore.c.PL | 96 ++++++++++++++------------------------
+ Basic/Core/pdlmagic.c | 117 ++++++++++++++++++----------------------------
+ Basic/Core/pdlmagic.h | 3 +-
+ 3 files changed, 82 insertions(+), 134 deletions(-)
+
+commit c5e9937244131d81f43006b2e0719629ff75412d
+Author: Dima Kogan <dkogan at cds.caltech.edu>
+Date: Sun May 15 02:16:58 2011 -0700
+
+ added PDL::cluck as an analog of Carp::cluck (as PDL::barf is an analog of Carp::confess)
+
+ Basic/Core/Core.pm.PL | 12 +++++-------
+ 1 files changed, 5 insertions(+), 7 deletions(-)
+
+commit cd9886de21a8eb288e3dc20b1bb11684bee01294
+Author: Dima Kogan <dkogan at cds.caltech.edu>
+Date: Mon May 9 00:45:44 2011 -0700
+
+ barf() is now defined in both PDL::Core and in PDL. Moved barf() definition to
+ the top of Core.pm
+
+ Basic/Core/Core.pm.PL | 79 +++++++++++++++++++++++++------------------------
+ 1 files changed, 40 insertions(+), 39 deletions(-)
+
+commit 1d58f618eb43545a6ea86f5844f69b46e8d1ad08
+Author: Dima Kogan <dkogan at cds.caltech.edu>
+Date: Sun May 8 23:56:02 2011 -0700
+
+ removed unneeded extra 'use Carp'
+
+ Basic/Core/Core.pm.PL | 1 -
+ 1 files changed, 0 insertions(+), 1 deletions(-)
+
+commit 8755f7a20f043abf367d28d258d1bc8e65301841
+Author: Dima Kogan <dkogan at cds.caltech.edu>
+Date: Sun May 8 23:19:23 2011 -0700
+
+ pdl_croak_param() cleaned up and rewritten to work with the new barf()
+
+ Basic/Core/pdlcore.h.PL | 2 +-
+ Basic/Core/pdlthread.c | 115 ++++++++++++++++++++++-------------------------
+ 2 files changed, 55 insertions(+), 62 deletions(-)
+
+commit 0caf3f03d7d3f7c693f1f1f35ae086f56ad30207
+Author: Dima Kogan <dkogan at cds.caltech.edu>
+Date: Sat Apr 30 21:29:15 2011 -0700
+
+ PP now generates PDL->pdl_barf() instead of plain barf()
+
+ Basic/Gen/PP.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 6031f27eebdfca23bbfcd7c02f1f78e2492facc7
+Author: Dima Kogan <dkogan at cds.caltech.edu>
+Date: Sat Apr 30 18:27:01 2011 -0700
+
+ barf() now generates a stack trace by hooking into Carp::confess(). This is done on both the perl
+ and C sides
+
+ Basic/Core/Core.pm.PL | 47 ++----------------------
+ Basic/Core/pdlcore.c.PL | 90 ++++++++++-------------------------------------
+ Basic/Core/pdlcore.h.PL | 13 ++-----
+ Basic/Gen/PP.pm | 5 ---
+ 4 files changed, 27 insertions(+), 128 deletions(-)
+
+commit d721f8d76fbcde09eae65708d3085021b2ca139a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu May 12 10:19:57 2011 -0400
+
+ Update Known_problems and cygwin/README
+
+ Add current sf.net bugs and update the cygwin
+ README file with information on HDF5 support.
+
+ Known_problems | 8 +++-----
+ cygwin/README | 8 ++++++--
+ 2 files changed, 9 insertions(+), 7 deletions(-)
+
+commit d46a8a4478e6d6c4adacc76773b67be34f550864
+Author: John Cerney <cerney at ntxlt0182636.(none)>
+Date: Wed May 11 21:23:01 2011 -0500
+
+ Add support for splitting up numerical processing between multiple
+ parallel processor threads (or pthreads) using new functions "set_autopthread_targ"
+ and "set_autopthread_targ". This can improve processing performance (by greater than
+ 2-4X in most cases) by taking advantage of multi-core and/or multi-processor machines.
+
+ See the new file Basic/Pod/ParallelCPU.pod for details.
+
+ Basic/Core/Core.pm.PL | 137 ++++++++++++++++++++-
+ Basic/Core/Core.xs.PL | 55 ++++++++-
+ Basic/Core/pdl.h.PL | 13 ++
+ Basic/Core/pdlapi.c | 4 +-
+ Basic/Core/pdlcore.c.PL | 49 +++++++-
+ Basic/Core/pdlcore.h.PL | 28 +++-
+ Basic/Core/pdlmagic.c | 278 ++++++++++++++++++++++++++++++++++++++++--
+ Basic/Core/pdlmagic.h | 9 ++-
+ Basic/Core/pdlthread.c | 244 +++++++++++++++++++++++++++++++++----
+ Basic/Gen/PP.pm | 15 ++-
+ Basic/Gen/PP/PDLCode.pm | 59 ++++++++--
+ Basic/Pod/API.pod | 16 +++
+ Basic/Pod/PP.pod | 19 +++
+ Basic/Pod/ParallelCPU.pod | 151 +++++++++++++++++++++++
+ Basic/Primitive/primitive.pd | 2 +
+ IO/Pnm/pnm.pd | 1 +
+ Lib/FFT/fft.pd | 2 +
+ Lib/GSL/INTEG/gsl_integ.pd | 4 +
+ t/pthread.t | 89 +++++++++++++-
+ t/pthreadBarf.t | 97 +++++++++++++++
+ t/pthread_auto.t | 117 ++++++++++++++++++
+ 21 files changed, 1326 insertions(+), 63 deletions(-)
+
+commit 47437d7a19a3861fc754f371c558acfc38040a9e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 11 14:06:48 2011 -0400
+
+ Fix inconsistent/missing =for sig in documentation
+
+ I noticed from a recent mailing list post that the clip()
+ routine was missing a signature definition. While I was
+ updating that, it was apparent that there were a number
+ of routines missing the =for sig to mark the Signature
+ information for the PDL::Doc to use. This fixes all the
+ ones that I found.
+
+ Basic/MatrixOps/matrixops.pd | 2 +-
+ Basic/Primitive/primitive.pd | 50 ++++++++++++++++++++++++++++++++++++++++++
+ Lib/Fit/LM.pm | 3 +-
+ Lib/Fit/Linfit.pm | 4 +-
+ Lib/Fit/Polynomial.pm | 4 +-
+ 5 files changed, 56 insertions(+), 7 deletions(-)
+
+commit c16dd1d7effd0e34f4d86c32a530c2c94819935f
+Author: Craig DeForest <zowie at z5.boulder.swri.edu>
+Date: Thu May 5 12:38:09 2011 -0600
+
+ fixed regexp to not get confused when more than one PCi_j system is present in the header
+
+ Lib/Transform/transform.pd | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 01f90e3b5b9fd532463ee091ebfebbb4d270719f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 2 14:54:00 2011 -0400
+
+ Fix CPAN devel instructions in Release_Notes
+
+ Had incorrect capitalization in the cpan shell build
+ instructions which might cause problems when users
+ tried to follow them.
+
+ Release_Notes | 72 ++++++++++++++++++++++++++++----------------------------
+ 1 files changed, 36 insertions(+), 36 deletions(-)
+
+commit 80f19de69fe35090874bf9928ad0652742671864
+Author: Doug Hunt <dhunt at ucar.edu>
+Date: Mon May 2 10:04:42 2011 -0600
+
+ Updated FAQ 6.18 to say that PDL::NetCDF works with the most recent PDL.
+
+ Basic/Pod/FAQ.pod | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 8ca4ad497689ab71e60f0cba92e4341b5a7a8bad
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 1 18:05:04 2011 -0400
+
+ Fix META_MERGE options in Makefile.PL
+
+ I used the documented functionality but search.cpan.org did
+ not appear to understand the syntax. Going back to the original
+ syntax as suggested by kmx.
+
+ Makefile.PL | 10 ++--------
+ 1 files changed, 2 insertions(+), 8 deletions(-)
+
+commit 78c67883162c843ea4f49032219d335880238b1c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 1 15:30:51 2011 -0400
+
+ Update version to 2.4.9_002 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 33 ++++++++++++++++++++++++++++++++-
+ 3 files changed, 34 insertions(+), 3 deletions(-)
+
+commit 269cb0ece73584930a3fc76ac971237d3afa4fcd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 1 15:27:08 2011 -0400
+
+ Apply sf.net patch #3295787 to quiet warnings
+
+ IO/Misc/misc.pd | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit a3792d776522a6022d2e48c75bd2f4562d8a2f39
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 1 14:47:08 2011 -0400
+
+ Update readme-type files for CPAN dev release
+
+ Known_problems | 5 +++++
+ Release_Notes | 14 +++++++++++++-
+ 2 files changed, 18 insertions(+), 1 deletions(-)
+
+commit 5c3420f1efdfe44c0efee08050022bf19bc6f9a9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 1 11:45:33 2011 -0400
+
+ Update Known_problems from sf.net bug list
+
+ Known_problems | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 6cd3314fc890e6e348c316c76543cff9c6e39c49
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 30 15:08:38 2011 -0400
+
+ Fix for IO::Misc for handles that are not files
+
+ This is sf.net patch #3287853. One addition was a
+ check that the result of the Scalar::Utils::reftype test
+ is defined to avoid warnings when run with -w on.
+
+ IO/Misc/misc.pd | 17 ++++++++++++++---
+ t/misc.t | 13 ++++++++++++-
+ 2 files changed, 26 insertions(+), 4 deletions(-)
+
+commit b69a5671fbb137f2952053d5998ab3ad4546391a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 29 14:38:23 2011 -0400
+
+ Fix =begin html/=end html usage in PP.pod
+
+ It looks like an edit was only partially done but the
+ result was that only the HTML docs for PP had the headings
+ for the various pp_xxx routine descriptions. This made
+ normal non-html output difficult to understand or search.
+
+ I just removed the extraneous =begin html/=end html pairs
+ so the pp_xxx function heading appear in all versions of
+ the documentation.
+
+ Basic/Pod/PP.pod | 41 -----------------------------------------
+ 1 files changed, 0 insertions(+), 41 deletions(-)
+
+commit 390363a565a9a8894b7eb8dc3d70ed81f9c9c39f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 29 14:12:47 2011 -0400
+
+ Merge in PP.pod updates from John Lapeyre
+
+ These were posted to the pdl-porters list in Sep 2006
+ but never made it into the PP.pod, thanks John.
+
+ Basic/Pod/PP.pod | 129 ++++++++++++++++++++++++++++++++++++++++++++++++++---
+ 1 files changed, 121 insertions(+), 8 deletions(-)
+
+commit b5eaaf6401bb8a657953e15e0690daf32d85bf3f
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Apr 29 00:58:37 2011 -0600
+
+ A small POD-formatting change in transform.pd
+
+ Lib/Transform/transform.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit a63b8196c1e45c59c749e2856104e83e47a97054
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Apr 29 00:56:38 2011 -0600
+
+ HDF: improve the logic for finding libsz in Makefile.PL
+
+ I didn't know about $Conf{so} when I wrote the original. This is much cleaner.
+
+ IO/HDF/Makefile.PL | 8 ++------
+ 1 files changed, 2 insertions(+), 6 deletions(-)
+
+commit 43ef710fd81063b2a1e06d4a6ae39eac3866c5cd
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Apr 29 00:54:24 2011 -0600
+
+ Make a no-badval-handling warning message a little more helpful.
+
+ Basic/Gen/PP.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 9bc3d74d4d98e88c94650532d301ff4c33a4d146
+Merge: 51774e3 3f58c66
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Apr 29 00:52:27 2011 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 51774e3a8c2757a7046863a10a188691e2f754ce
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Apr 29 00:48:29 2011 -0600
+
+ PLplot: user prefs for library and include file locations take precedence over defaults
+
+ The locations $PDL::Config{WHERE_PLPLOT_LIBS} and {WHERE_PLPLOT_INCLUDES} were at the end of the list of paths to search. I moved them to the beginning of the list so that if there is more than one installed on the system the desired library/includes can be specified.
+
+ Graphics/PLplot/Makefile.PL | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 3f58c664b8b9adcee55016cb1e91be1177bd60b7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 26 15:51:59 2011 -0400
+
+ Update cygwin/INSTALL re rebaseall
+
+ Discusion on the cygwin-xfree mailing list
+ suggests specifying a different (higher) base
+ address might alleviate some of the situations
+ when rebaseall fails to work. This could be
+ a problem though for PDL/perl since there are
+ large numbers of DLLs which could lead to the
+ addresses trampling high memory stuff.
+
+ cygwin/INSTALL | 14 +++++++++++++-
+ 1 files changed, 13 insertions(+), 1 deletions(-)
+
+commit 675f384d7bbb3cb4582303f76b393328c32b2bda
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 19 10:25:37 2011 -0400
+
+ Apply kmx patch for ext detection logic
+
+ This patch by kmx improves the detection logic search
+ locations for a number of the PDL external dependencies.
+ We'll need to incorporate this in the coming Alien::*
+ refactoring. Thanks again, kmx!
+
+ Graphics/PLplot/Makefile.PL | 2 ++
+ IO/GD/Makefile.PL | 3 +++
+ IO/HDF/Makefile.PL | 6 ++++--
+ Lib/FFTW/Makefile.PL | 5 +++--
+ Lib/GIS/Proj/Makefile.PL | 7 +++++--
+ Lib/Transform/Proj4/Makefile.PL | 6 ++++--
+ 6 files changed, 21 insertions(+), 8 deletions(-)
+
+commit 055cbc1066def2e851d8bd457581fbdbe3a86787
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 19 10:13:33 2011 -0400
+
+ Add META.yml information for PDL
+
+ This is based on a patch from kmx. The result is that the
+ PDL distribution META.yml file will now have information
+ on how to submit bugs and where our git repository is...
+
+ Makefile.PL | 13 +++++++++++++
+ 1 files changed, 13 insertions(+), 0 deletions(-)
+
+commit 3d08df88d7ae782a3d429376184e3f6981f5ed7a
+Author: Craig DeForest <zowie at dhcp-10-158.boulder.swri.edu>
+Date: Wed Apr 13 12:07:41 2011 -0600
+
+ fixed double-bscale bug for rice-compressed images
+
+ IO/FITS/FITS.pm | 11 +++++------
+ 1 files changed, 5 insertions(+), 6 deletions(-)
+
+commit b0f9301553e8af562678598ec76942deb5bdd398
+Merge: 1c2a60f d92235d
+Author: Craig DeForest <zowie at dhcp-10-158.boulder.swri.edu>
+Date: Wed Apr 13 11:36:57 2011 -0600
+
+ Merge branch 'master' of ssh://zowie@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit d92235de1897ad558a4658f9db2b4d2fb452a189
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Apr 13 12:52:10 2011 -0400
+
+ Make GSL::MROOT quieter on success...
+
+ This addresses feature request #3285520 "status message from
+ gslmroot_fsolver" with the patch from the original submitter.
+
+ Lib/GSL/MROOT/FUNC.c | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 74945cc2321c4243ff0540e71423ee5a1cc62910
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 12 10:28:26 2011 -0400
+
+ Update TODO with dependency issues
+
+ CPAN Testers are not comprehensive because a number
+ of PDL modules require external libraries to function
+ and, by default, we have no support for installing missing
+ libraries to support the PDL build process.
+
+ TODO | 36 ++++++++++++++++++++++++++++++++++++
+ 1 files changed, 36 insertions(+), 0 deletions(-)
+
+commit e71940e5289898c6dddaf9df5da9f2db013f31df
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 12 09:26:57 2011 -0400
+
+ Use File::Temp::tempfile for t/bad.t filename
+
+ Without a unique, per-process tempfile name, the test can
+ fail if another test is being run at the same time as can
+ happen with CPAN smoke testers.
+
+ t/bad.t | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 3dff9d0cdeea709acd131f47a3ae00c6f23ac7b1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 9 12:24:33 2011 -0400
+
+ Update VERSION and readmes to 2.4.9_001 for devel
+
+ The PDL-2.4.9 distribution is in freeze and is being
+ processed for binary builds. The release is expected
+ to CPAN 10 or 11 April 2011. Development in the main
+ branch can now continue.
+
+ Basic/PDL.pm | 2 +-
+ DEPENDENCIES | 11 +++--------
+ Known_problems | 16 +++-------------
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ TODO | 9 +++++----
+ 5 files changed, 44 insertions(+), 26 deletions(-)
+
+commit 66a4db3f270e3478800850858ad97471e2135468
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 9 10:05:43 2011 -0400
+
+ Fix FAQ version number inconsistency for 2.4.9
+
+ Basic/Pod/FAQ.pod | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit ac8bb0bc983abd99b2ba85fcc911cae948fe8c7f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 9 09:55:28 2011 -0400
+
+ Update INSTALL for 2.4.9 release
+
+ INSTALL | 4 ----
+ 1 files changed, 0 insertions(+), 4 deletions(-)
+
+commit 083a2fdf28a2aa2423f9569a040ca686180d0fe0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Apr 7 16:08:15 2011 -0400
+
+ Update VERSION and readme/notes for 2.4.9
+
+ The PDL-2.4.9 release is planned for 10 April 2011.
+
+ Basic/PDL.pm | 2 +-
+ Basic/Pod/FAQ.pod | 14 +++++-----
+ Known_problems | 2 +-
+ Release_Notes | 77 ++++++++++++++++++-----------------------------------
+ 4 files changed, 35 insertions(+), 60 deletions(-)
+
+commit 8d541744a07d59905b1cc01f1cfc5f3e3eadc2ba
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Apr 6 09:59:18 2011 -0400
+
+ Force Convert::UU for BSD to fix t/dumper.t FAIL
+
+ I think the problem is that the system uuencode/uudecode
+ command is being used for the sdump() call which needs
+ the -s option on some systems. Update Release_Notes and
+ Known_problems to VERSION 2.4.8_004 for development.
+
+ Basic/PDL.pm | 2 +-
+ IO/Dumper.pm | 5 ++++-
+ Known_problems | 2 +-
+ Release_Notes | 36 ++++++++++++++++++++++++++++++++++++
+ 4 files changed, 42 insertions(+), 3 deletions(-)
+
+commit 345350cb5162e1ce36ef0575a97e8af7cf0d3a38
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 5 10:05:45 2011 -0400
+
+ Update Known_problems/Release_Notes for CPAN
+
+ Known_problems | 6 +-----
+ Release_Notes | 12 ++++++++++--
+ 2 files changed, 11 insertions(+), 7 deletions(-)
+
+commit 935cc4fc7dfe3ee267ba58f0f958a3265be51599
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Apr 4 18:47:57 2011 -0400
+
+ Update TODO list post 2.4.8 release
+
+ TODO | 25 +++++++++++++++++++++----
+ 1 files changed, 21 insertions(+), 4 deletions(-)
+
+commit bcc8e650709e0e7299be9413b5e29b92d70f7957
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Apr 4 11:59:09 2011 -0400
+
+ Move new t/slice.t tests out of TODO block
+
+ t/slice.t | 25 ++++++++++---------------
+ 1 files changed, 10 insertions(+), 15 deletions(-)
+
+commit d5a90f99c50c1f9ecbb239be743754759c7ae84c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Apr 4 11:32:47 2011 -0400
+
+ Replace POSIX::tmpnam with File::Temp::tmpnam
+
+ The POSIX::tmpnam failed on a win32 perl (presumably
+ because of an issue with the environment). I just
+ checked and File::Temp is in the Core modules since
+ 5.8.8 (at least) so using it to generate the filenames
+ should not add unavailable dependencies.
+
+ IO/Dumper.pm | 4 ++--
+ Makefile.PL | 1 +
+ t/iotypes.t | 4 ++--
+ 3 files changed, 5 insertions(+), 4 deletions(-)
+
+commit bd8c58615d7a34f540933f0a74a0b630814acc3b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 3 20:00:18 2011 -0400
+
+ Update VERSION to 2.4.8_003 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit b06513a3d80f66e6f719957443dad8f3df66f70f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 3 19:57:38 2011 -0400
+
+ Update Known_problems and Release_Notes for CPAN
+
+ This is the 2.4.8_002 developers release to verify
+ a number of bug fixes since the PDL-2.4.8 official release.
+
+ Known_problems | 3 +++
+ Release_Notes | 7 ++++++-
+ 2 files changed, 9 insertions(+), 1 deletions(-)
+
+commit fb76559e9ba5eb4a3fa30d6951075166f233d6a2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 3 18:49:04 2011 -0400
+
+ use POSIX::tmpnam() to make tempfile for uuencode
+
+ It appears that an invalid temporary file name may
+ be the last issue with the t/dumper.t test. Perhaps
+ we should consider adding File::Temp to the list of
+ PDL dependencies and standardize on that.
+
+ IO/Dumper.pm | 4 +++-
+ t/dumper.t | 14 +++++++-------
+ 2 files changed, 10 insertions(+), 8 deletions(-)
+
+commit 656392920b7f91189cf9b676f2771e875ed12811
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 3 16:18:19 2011 -0400
+
+ Apply Chad Davis patch for 'make -j3 -j3' bug
+
+ This adds a few explicit dependencies in Basic/Core/Makefile.PL
+ that appear to resolve the problem with GNU make parallel options.
+ Thanks, Chad!
+
+ Basic/Core/Makefile.PL | 12 ++++++++++++
+ 1 files changed, 12 insertions(+), 0 deletions(-)
+
+commit 895797a2d50fccd198c4a04dfb2d4f3041014861
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sun Apr 3 20:49:10 2011 +1000
+
+ Makefile.PL - clean up .xfig test files
+
+ The .xfig files written to the top level
+ directory by t/plplot.t were not being
+ cleaned up by 'make clean'.
+
+ Makefile.PL | 53 +++++++++++++++++++++++++++--------------------------
+ 1 files changed, 27 insertions(+), 26 deletions(-)
+
+commit 8a8f64cfacf309738017fe3b76c51ee88918a310
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 2 19:45:28 2011 -0400
+
+ Add Test::More conversion to TODO list
+
+ TODO | 32 ++++++++++++++++++++++++++++++++
+ 1 files changed, 32 insertions(+), 0 deletions(-)
+
+commit 1f9dc165ead2f38f8b95ec495c6e4b32e7cf00f7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 2 19:37:57 2011 -0400
+
+ Remove diag print from t/iotypes.t
+
+ t/iotypes.t | 1 -
+ 1 files changed, 0 insertions(+), 1 deletions(-)
+
+commit 55cf3b1566b21cc039e81296ed45931c81087b93
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 2 19:36:00 2011 -0400
+
+ Update iotypes.t to use real tmpnam() file name
+
+ This should reduce collisions when multiple smokers
+ are running at the same time... Need to look at
+ using File::Temp instead. Is that a Core module now?
+
+ t/iotypes.t | 5 ++++-
+ 1 files changed, 4 insertions(+), 1 deletions(-)
+
+commit 834d8ac0b5e70d472f28bb2847f687f4e687be5c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 2 17:06:46 2011 -0400
+
+ Update tmalloc.pl diagnostic output
+
+ cygwin/tmalloc.pl | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 11b4528674fc2fb6f90755b59586e161617d199f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 2 15:17:54 2011 -0400
+
+ Update VERSION to 2.4.8_002 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit e4812dd30c3d9f11d2b52f990abe46f8f50a3703
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 2 15:14:36 2011 -0400
+
+ Update Release_Notes for 2.4.8_001 devel release
+
+ This includes the fix for the t/slices.t bug causing
+ FAILs in BSD systems.
+
+ Release_Notes | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 5ed9256b6b6d0477b31dbf3077e9b4290ea836b5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 2 13:48:44 2011 -0400
+
+ Update Known_problems
+
+ Known_problems | 1 -
+ 1 files changed, 0 insertions(+), 1 deletions(-)
+
+commit 0d94558c4fece33ec680fdd2b895ea5716e79a9d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 2 13:24:28 2011 -0400
+
+ Fix sf.net bug #3267408 "t/slice.t crashes..."
+
+ Modified the order in a short-circuited conditional
+ in slices.pd for handling Empty piddles at line 784.
+
+ Basic/Slices/slices.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit cf2b0ad070898fd071831fbfbf8f3f01c5b5bf82
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 1 10:15:46 2011 -0400
+
+ Add t/slices.t bug to Known_problems
+
+ This is sf.net #3267408 "t/slice.t crashes in tests 68-70 for BSD"
+ and appears to fail only for BSD systems. Since this is a new
+ test corresponding to some changes in slice.pd, this could be
+ a failure at some edge case.
+
+ Known_problems | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 243aad637a1ab000a4b99a6ace98c3f71f4d71b7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 29 20:22:28 2011 -0400
+
+ Update VERSION to 2.4.8_001 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit ee8df719ee75eebfb2e857cdc75783c5b0091bca
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 29 17:12:41 2011 -0400
+
+ More Release_Notes edits for PDL-2.4.8 release
+
+ Release_Notes | 70 ++++++++++++++++++++++++++++----------------------------
+ 1 files changed, 35 insertions(+), 35 deletions(-)
+
+commit 281e02d0ce77f2d643d6a82a3755b5d05e47272a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 29 14:42:47 2011 -0400
+
+ Update TODO for PDL-2.4.8 release
+
+ TODO | 419 +++++++++++++++++++++++++++++-------------------------------------
+ 1 files changed, 183 insertions(+), 236 deletions(-)
+
+commit 6c207fc7c2a1708af6ceee28fcf1c337199dbab1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 29 12:51:12 2011 -0400
+
+ VERSION bumps for PDL-2.4.8 release
+
+ IO/Dumper.pm, IO/FITS/FITS.pm, and Perldl2/Profile/Perldl2.pm
+ each had changes since PDL-2.4.7 and they have their own
+ version numbering. Increased to indicate that the various
+ modules have changed.
+
+ IO/Dumper.pm | 2 +-
+ IO/FITS/FITS.pm | 2 +-
+ Perldl2/Profile/Perldl2.pm | 4 ++--
+ 3 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 2905370692535fd70e62882119930930700b195c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 29 10:23:32 2011 -0400
+
+ Put new Empty pdl tests in TODO block
+
+ There appears to be a problem in t/slice.t with BSD systems.
+ I'm putting the new tests in a TODO block to mark them for
+ followup after the 2.4.8 release.
+
+ t/slice.t | 26 +++++++++++++++-----------
+ 1 files changed, 15 insertions(+), 11 deletions(-)
+
+commit ffcbecfc943e2581ccebd709b2cf687e4d66163b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 28 11:44:41 2011 -0400
+
+ More wordsmithing the Release_Notes
+
+ Release_Notes | 54 +++++++++++++++++++++++++++++-------------------------
+ 1 files changed, 29 insertions(+), 25 deletions(-)
+
+commit b3555dd9c96072d117c19e141a77c3ddd99aff50
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 27 23:55:28 2011 -0400
+
+ Update cygwin/INSTALL with ffmpeg build notes
+
+ Right now you need to build from the git version
+ because needed fixes have not propagated into the
+ release branch. Also made a couple of minor POD
+ fixes to Graphics2D.pm and perldlpp.pl.
+
+ Graphics/Graphics2D.pm | 6 ++--
+ cygwin/INSTALL | 78 +++++++++++++++++++++++++++++++++---------------
+ utils/perldlpp.pl | 2 +-
+ 3 files changed, 58 insertions(+), 28 deletions(-)
+
+commit 24a2e038fea8ec3bc47477d87ab56a4f0fd21d8d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 27 19:16:34 2011 -0400
+
+ Fix POD error in IO/FlexRaw/FlexRaw.pm
+
+ IO/FlexRaw/FlexRaw.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit e7b17f322eaa4b028fb4045119f34642b75718ce
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 27 18:20:48 2011 -0400
+
+ Fix FAQ.pod typo.
+
+ Basic/Pod/FAQ.pod | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit c4bb881dcc6c22f27fbbedf04a0edf73b5f8db5c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 27 18:16:17 2011 -0400
+
+ Fix POD typo in TriD.pm
+
+ Graphics/TriD/TriD.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f504875f5cc09ba92479b5f4f069e87196563ada
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 27 17:58:52 2011 -0400
+
+ Fix use of $PDL::toolongtoprint in Release_Notes
+
+ Mistakenly called the variable $PDL::toobigtoprint.
+
+ Release_Notes | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 8d24b2c43bd27ce9f4f703112edf054ffe59f30f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 27 17:54:53 2011 -0400
+
+ Fix error wmpeg is in PDL::IO::Pic and not Misc
+
+ Release_Notes | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3c6cc4b37187551dabd6f2468ab04cf104e283c9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 27 17:07:14 2011 -0400
+
+ Update version to 2.4.8 for final prep
+
+ Only documentation and readme/install notes from
+ now until the official PDL-2.4.8 release.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 35 +++++++++++++----------------------
+ 3 files changed, 15 insertions(+), 24 deletions(-)
+
+commit b090be74b3c79d3e133c01422e4a8cda992ac2ee
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 27 16:10:19 2011 -0400
+
+ More updates for PDL-2.4.8 pre-release 1
+
+ Release_Notes | 5 ++---
+ 1 files changed, 2 insertions(+), 3 deletions(-)
+
+commit 302975c1f6c1ded3bad25b4f79667ae85483c673
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 27 16:01:19 2011 -0400
+
+ Finish Release_Notes for 2.4.8 pre-release
+
+ Following this release, we'll have final testing
+ and documentation updates. No more code freezes.
+
+ Release_Notes | 179 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
+ 1 files changed, 177 insertions(+), 2 deletions(-)
+
+commit fb95f2ca0b0a955a9df96c11a2c14bcb60da4160
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sat Mar 26 15:50:54 2011 +1100
+
+ win32/INSTALL - mention mp4 and animated gif cpability
+
+ Enabled by installing ffmpeg
+
+ win32/INSTALL | 25 ++++++++++++++++++++++++-
+ 1 files changed, 24 insertions(+), 1 deletions(-)
+
+commit fc8ebbec8fc0d500d00bcc47a9b2d26f35a065a6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 25 19:47:37 2011 -0400
+
+ Clean up patch for new TriD additions
+
+ Graphics/TriD/TriD/GL.pm | 14 +++++++-------
+ 1 files changed, 7 insertions(+), 7 deletions(-)
+
+commit ae4f1bffdc9be1207b92d56c7320ba9162f8dc9a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 25 17:40:38 2011 -0400
+
+ Update FAQ and perldl/pdl2 POD for 2.4.8
+
+ Basic/Pod/FAQ.pod | 32 +++++++++++++-------------------
+ Perldl2/pdl2 | 13 +++++++++++++
+ perldl.PL | 9 +++++++++
+ 3 files changed, 35 insertions(+), 19 deletions(-)
+
+commit 38c646be50fe1493b94ef73d4ddbad86f6757e86
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 25 17:11:05 2011 -0400
+
+ Update directions and rm checkargs from demo 3d*
+
+ Put the instructions on how to stop twiddling on
+ each page of the TriD demos. Also, modify the
+ checkargs() call to only print output if the
+ $PDL::Graphics::TriD::verbose flag is set.
+
+ Demos/TriD1.pm | 14 ++++++++++++++
+ Demos/TriD2.pm | 9 ++++++++-
+ Graphics/TriD/TriD.pm | 2 +-
+ 3 files changed, 23 insertions(+), 2 deletions(-)
+
+commit 91f121193844e4333a5d78bd69d0c3f210d72579
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 25 16:17:52 2011 -0400
+
+ POD cleanup to matrixops.pd for PDL-2.4.8 release
+
+ Basic/MatrixOps/matrixops.pd | 112 +++++++++++++++++++++---------------------
+ 1 files changed, 56 insertions(+), 56 deletions(-)
+
+commit 7a7f099b53eb86ce47c89452454f5363be820b02
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 25 15:52:53 2011 -0400
+
+ POD updates for upcoming 2.4.8 release
+
+ IO/FlexRaw/FlexRaw.pm | 270 ++++++++++++++++++++++++++++---------------------
+ Perldl2/pdl2 | 53 ++++++++--
+ perldl.PL | 7 +-
+ utils/perldlpp.pl | 12 +-
+ 4 files changed, 206 insertions(+), 136 deletions(-)
+
+commit 8c473d30ac04b56b7891990223fadc4209036833
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Fri Mar 25 22:11:39 2011 +1100
+
+ win32/INSTALL - update for 2.4.8 release
+
+ win32/INSTALL | 68 ++++++++++++++++++++++++++++++--------------------------
+ 1 files changed, 36 insertions(+), 32 deletions(-)
+
+commit 0b238627ee10e26672a6f9a2b0e58eff8fa2b787
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 24 21:23:14 2011 -0400
+
+ VERSION to 2.4.7_991 for pre-release 2.4.8
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 7f095589cbed33a45641ef5863205d06e42b6dd5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 24 20:13:41 2011 -0400
+
+ Fix missing PDL::Core::Dev with Makefile.PL's
+
+ Another problem with the Lib/GIT/Proj/Makefile.PL and the
+ Lib/Transform/Proj4/Makefile.PL. Returned to using import
+ rather than use to enable PDL::Core::Dev to work in the
+ build process. Otherwise the location needs to be added
+ to the @LIB search path.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Lib/GIS/Proj/Makefile.PL | 3 +--
+ Lib/Transform/Proj4/Makefile.PL | 3 +--
+ Release_Notes | 15 ++++++++-------
+ 5 files changed, 12 insertions(+), 13 deletions(-)
+
+commit d1057d7fb80888d8f1685f0c9755becea201f0f3
+Merge: b970575 e47693a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 24 20:02:29 2011 -0400
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit e47693a4759dda351cc01e5752399afc23bf9dd6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 24 11:48:52 2011 -0400
+
+ Update VERSION to 2.4.7_991 for final prep
+
+ This will be the PDL-2.4.8 pre-release 1. If no problems
+ are encountered, it will be pushed again as the official
+ PDL-2.4.8 release. Please test, check docs,... Thanks.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 658fdc402084848422fd3f554eaf9fe6d5e25828
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 24 11:33:12 2011 -0400
+
+ Add t/simplex.t to the MANIFEST
+
+ MANIFEST | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 6dd8330badf137cee84ac16fd464e848b0f94dd3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 24 11:31:10 2011 -0400
+
+ Fix build problem with new Proj detection
+
+ An earlier version of the code had modified a return call
+ to an exit for testing. This removes that change and stops
+ the mysterious failure on win32.
+
+ Lib/GIS/Proj/Makefile.PL | 4 ++--
+ Lib/Transform/Proj4/Makefile.PL | 4 ++--
+ 2 files changed, 4 insertions(+), 4 deletions(-)
+
+commit b9705750f1695bca25e16b6aeb2b24ccd80114a1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 23 21:36:11 2011 -0400
+
+ Add t/simplex.t to MANIFEST
+
+ MANIFEST | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 99e2c0b91d2c9900206ea0b3f1fc67963ef3ddd5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 23 19:07:23 2011 -0400
+
+ Apply PDL::IO::Storable dclone() patch
+
+ Thanks to Chad Davis for the patch. See the perldl list
+ discussion for more information:
+ http://mailman.jach.hawaii.edu/pipermail/perldl/2011-March/004914.html
+
+ IO/Storable/storable.pd | 4 ++--
+ t/storable.t | 18 +++++++++++++++++-
+ 2 files changed, 19 insertions(+), 3 deletions(-)
+
+commit e7c6cdf5ee65e81f45c22e40e0ba2acca2312a18
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 23 18:12:49 2011 -0400
+
+ Update Known_problems and Release_Notes
+
+ Known_problems | 5 +----
+ Release_Notes | 14 ++++++++++++--
+ 2 files changed, 13 insertions(+), 6 deletions(-)
+
+commit e7c259ceca63aaccad25a39262efac9b9fd3d8e1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 23 13:34:52 2011 -0400
+
+ Update to use Test::More
+
+ ...and skip tests if the GSL bindings were not
+ built. NOTE: this tests only whether the various
+ routines can be called. There is no check against
+ the data produced.
+
+ t/gsl_rng.t | 66 +++++++++++++++++++++++++++++-----------------------------
+ 1 files changed, 33 insertions(+), 33 deletions(-)
+
+commit d1071f4725116ec1629d6a5d9a72ac372349477d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 22 22:21:30 2011 -0400
+
+ Fix duplicate declaration for $z in t/slice.t
+
+ The warning showed up in the test harness results.
+
+ t/slice.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2ebb5d6b62b5ab3fec5b1586270c08807422d14b
+Merge: c3b0238 606277c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 22 18:25:17 2011 -0400
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit c3b0238c37a7296608ac969ea51089e84421e9d0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 22 18:21:47 2011 -0400
+
+ Add test for PROJ4 misconfiguration to dep checks
+
+ This resolves sf.net feature request #3045456,
+ "Proj4 test fails when missing datum files" by
+ using Devel::CheckLib to verify that the proj
+ library will initialize correctly before configuring
+ to build the 2 PDL PROJ4 based modules.
+
+ Lib/GIS/Proj/Makefile.PL | 41 +++++-
+ Lib/Transform/Proj4/Makefile.PL | 285 ++++++++++++++++++++++-----------------
+ 2 files changed, 194 insertions(+), 132 deletions(-)
+
+commit 606277c5f6c51fab3e8203f22921dda1c6385d5b
+Author: Judd Taylor <judd at black.qos.loc>
+Date: Tue Mar 22 21:58:49 2011 +0000
+
+ Minor change to get rid of void context string warning in HDF::SD test.
+
+ t/hdf_sd.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 0f1970719b394f074508c8ca8ce7161bcd6c4247
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 22 15:49:47 2011 -0400
+
+ Update Known_problems and cygwin readme's
+
+ Known_problems | 23 +++++++++--------------
+ cygwin/INSTALL | 12 ++++++++----
+ cygwin/README | 21 +++++++++++++--------
+ 3 files changed, 30 insertions(+), 26 deletions(-)
+
+commit c4e2a646980f5986833158f29bb8c94842b827d6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 22 14:59:42 2011 -0400
+
+ Apply sf.net patch # 3209075 IO::HDF square sds
+
+ Still needs testing.
+
+ IO/HDF/Makefile.PL | 1 +
+ IO/HDF/SD/SD.pd | 63 +++++++++++++++++++---------------------
+ t/hdf_sd.t | 82 +++++++++++++++++++++++++++++++++------------------
+ 3 files changed, 84 insertions(+), 62 deletions(-)
+
+commit 1c2a60f1854d01221160266ee9d5e46ce7e90ad7
+Author: Craig DeForest <zowie at Clio-2.local>
+Date: Tue Mar 22 03:42:28 2011 -0600
+
+ Fixed handling of empty and scalar values by whichND (also
+ fixes bug 3234024)
+
+ Basic/Primitive/primitive.pd | 15 ++++++++++++---
+ t/primitive.t | 12 +++++++++++-
+ 2 files changed, 23 insertions(+), 4 deletions(-)
+
+commit d04e98726eb46bc5e2b54f0b455a795940507fa6
+Author: Craig DeForest <zowie at Clio-2.local>
+Date: Tue Mar 22 03:15:15 2011 -0600
+
+ Fixed range() to handle some bizarre corner cases (empty index
+ variable, empty source variable, or both)
+
+ Basic/Slices/slices.pd | 126 +++++++++++++++++++++++++++++------------------
+ t/slice.t | 16 ++++++-
+ 2 files changed, 93 insertions(+), 49 deletions(-)
+
+commit 82afeb423a39e08eeb1c5d0ecc82ed5e9e1b7995
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 21 23:25:18 2011 -0400
+
+ Update VERSION for final development pre-2.4.8
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 4ad092f72fa8abd81ba1a2f3838b4ff9a0eef0e7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 21 23:22:28 2011 -0400
+
+ Clean up a ref to TkTriD demo in Makefile.PL
+
+ ...missed this one.
+
+ Demos/Makefile.PL | 1 -
+ 1 files changed, 0 insertions(+), 1 deletions(-)
+
+commit dba8d97abc94741dde9d88e49e4497e559c17262
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Mon Mar 21 16:43:41 2011 -0600
+
+ Cleanup of PLplot's Makefile.PL
+
+ 'my'd some variables. Also changed the LDDLFLAGS entry so that it works on OS X, and should not impact other systems.
+
+ Graphics/PLplot/Makefile.PL | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit 9107f758dd54f96f435ac4ecd0a4b599cfe3b3a7
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Mon Mar 21 16:12:26 2011 -0600
+
+ Help HDF find libsz on non-linux architectures.
+
+ Newer versions of hdf need libsz. Makefile.PL was hardcoded to look for libsz.so. I added .dylib and .dll suffixes for OSX and mswin32 respectively. The default remains to look for .so, so we're no worse off than before. Probably there is a better way to do that, though.
+
+ IO/HDF/Makefile.PL | 10 ++++++++--
+ 1 files changed, 8 insertions(+), 2 deletions(-)
+
+commit 95162ecb090f75384eecdbc8272bad0228065c4d
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Mon Mar 21 15:01:58 2011 -0600
+
+ Patches for PDL::Opt::Simplex
+
+ InSuk Joung provided some patches for PDL::Opt::Simplex and the second Example back in July 2009 on the mailing list. Just recently also provided a test file simplex.t. Tests pass just fine on my machine.
+ Add test, package patch, and Example patch for PDL::Opt::Simplex, all from InSuk Joung
+
+ Example/Simplex/tsimp2.pl | 14 ++-
+ Lib/Opt/Simplex/Simplex.pm | 201 +++++++++++++++++++++++++------------------
+ t/simplex.t | 51 +++++++++++
+ 3 files changed, 178 insertions(+), 88 deletions(-)
+
+commit 7fe662dd50bc7609f24d15467f109a2102196880
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Mon Mar 21 14:04:25 2011 -0600
+
+ Applied Christian Soeller's patch for FFTW on 64-bit systems.
+
+ Lib/FFTW/fftw.pd | 20 ++++++++++----------
+ 1 files changed, 10 insertions(+), 10 deletions(-)
+
+commit 170e231167ac0bab0957200fb73b4127c65a1c1c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 21 00:02:14 2011 -0400
+
+ Move pdl from string tests to pdl_from_string.t
+
+ We still need some more exhaustive tests but splitting
+ these into a separate file will help clean things up.
+
+ t/core.t | 99 +-------------------------------------------------
+ t/pdl_from_string.t | 100 ++++++++++++++++++++++++++++++++++++++++++++++++++-
+ 2 files changed, 100 insertions(+), 99 deletions(-)
+
+commit 746c9370ca2263a7d3fa4649311f5bce5b0d1393
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 20 23:47:07 2011 -0400
+
+ Update Release_Notes with FlexRaw badvalue support
+
+ Release_Notes | 12 ++++++++++++
+ 1 files changed, 12 insertions(+), 0 deletions(-)
+
+commit 3ccdc66b5421e5355a28788b1b1db63ebf7f77fe
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 20 22:49:15 2011 -0400
+
+ Fix FlexRaw bad value support
+
+ There were some problems in the _read_flexhdr() state machine
+ which failed on t/flexraw_fortran.t. This completes the basic
+ implemenation of feature request on sf.net #3028127,
+ "add badvalue support to FlexRaw". Yet to do: add some tests,
+ documentation, handle/verify works with NaNs for bad values
+ and for float/double badvalue()'s.
+
+ IO/FlexRaw/FlexRaw.pm | 49 ++++++++++++++++++++++++++++++++-----------------
+ 1 files changed, 32 insertions(+), 17 deletions(-)
+
+commit c36b3f92a411f1d08dcfa2e0c3c1e31e06915400
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 20 19:06:14 2011 -0400
+
+ Add bad value support to PDL::IO::FlexRaw
+
+ Still need to add some tests but the idea is that after
+ the Dims in the FlexRaw header, on the same line, if
+ $pdl->badflag then the token 'badvalue' is added. If
+ the $pdl->badvalue is not the $pdl->orig_badvalue then
+ that value is added afterwards. This is a workaround
+ to the problem of uniquely saving and restoring a float
+ or double value from a string. Until that code is
+ in, we just support defaults. NOTE: need to add a
+ test (and possibly code) to handle the NaN as bad value
+ case...
+
+ IO/FlexRaw/FlexRaw.pm | 35 +++++++++++++++++++++++++++--------
+ 1 files changed, 27 insertions(+), 8 deletions(-)
+
+commit 00348bd331a858a01c82ac1a2c4ca875c4ec1a00
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 20 15:12:23 2011 -0400
+
+ Add CPAN Testers information to FAQ
+
+ Still need a 1-click way for folks to test PDL
+ and get their reports sent in but at least the
+ reference is a start.
+
+ Basic/Pod/FAQ.pod | 12 ++++++++++--
+ 1 files changed, 10 insertions(+), 2 deletions(-)
+
+commit 4cf835f53313900f38ec6746e4758afa7f9dcb28
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 20 12:57:22 2011 -0400
+
+ Add cygwin UG ref for memory problems
+
+ The Cygwin users guide has a section on changing the maximum
+ memory limits for cygwin. Added the URL to Known_problems
+ and cygwin/INSTALL to help cygwin users work around the problem.
+
+ Known_problems | 4 +++-
+ cygwin/INSTALL | 4 +++-
+ 2 files changed, 6 insertions(+), 2 deletions(-)
+
+commit 5cbd6693d12dce7737e83b412a13c89285709aad
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 20 12:54:00 2011 -0400
+
+ Add TODO note on how to fix q alias and multiline
+
+ Perldl2/TODO | 6 ++++++
+ 1 files changed, 6 insertions(+), 0 deletions(-)
+
+commit 49495fe4acdda5e68c7033790234ce041667c154
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 20 12:24:25 2011 -0400
+
+ Add $PDL::toolongtoprint to default .perldlrc
+
+ By putting this in the default.perldlrc and including
+ comments for the definitions of the other key parameters
+ from PDL::Core, it is hoped that these will be easier
+ to find when someone needs to change them.
+
+ Basic/default.perldlrc | 12 ++++++++++++
+ 1 files changed, 12 insertions(+), 0 deletions(-)
+
+commit ea8e589cea00352442fec37e4701ccbbad4720b5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 20 12:08:38 2011 -0400
+
+ Remove final Tk refs in PDL modules
+
+ The current Perl OpenGL TriD interface is platform
+ neutral and uses GLUT/FreeGLUT to provide the OS and
+ user interactivity. This does not support specific
+ X11 windows nor the legacy PDL::Graphics::TriD::Tk
+ widget. Following the PDL-2.4.8 release, it is
+ planned to refactor the remaing TriD code to allow
+ for PDL TriD graphics to be embedded in multiple
+ widget sets: Qt4, wxWidgets, Tk, and others.
+
+ This completes the removal of the Tk refs in other
+ code and documentation. The Tk demo source, example
+ program and Graphics/TriD/TriD/Tk.pm files have been
+ added to MANIFEST.SKIP and thus removed from the
+ source distribution. The files remain under PDL git
+ looking toward the next stage of the refactoring.
+
+ Graphics/TriD/POGL/OpenGL.pm | 7 ++-----
+ Perldl2/Profile/Perldl2.pm | 2 --
+ perldl.PL | 2 --
+ 3 files changed, 2 insertions(+), 9 deletions(-)
+
+commit 0b680f2b01a4a5ee25ec5b5399bddc7d69f03cfc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 20 12:01:29 2011 -0400
+
+ Update readmes and MANIFEST for upcoming release
+
+ Trying to keep Known_problems and Release_Notes
+ up to date before the release. Also updated
+ MANIFEST.SKIP and then MANIFEST with the new
+ examples and modules.
+
+ Known_problems | 12 ++++++++++++
+ MANIFEST | 8 ++++----
+ MANIFEST.SKIP | 8 ++++++++
+ Release_Notes | 19 ++++++++++++++++++-
+ 4 files changed, 42 insertions(+), 5 deletions(-)
+
+commit 0dd160bc336734aaab3368e0beb0c8e420d7ca95
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 20 11:09:22 2011 -0400
+
+ Prevent warning message on Ctrl-D exit from shell.
+
+ Perldl2/Plugin/PDLCommands.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 504a771c2a43c4b3fa08e954ac515463d7dc29a6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 20 09:29:05 2011 -0400
+
+ Start to add tile display of thread images
+
+ Added code from PDL::Graphics::TriD::Image to
+ flatten an N-D image to a 2-D one for display.
+ Still need to work on the update strategy and
+ any piddle linkages.
+
+ Graphics/Graphics2D.pm | 92 ++++++++++++++++++++++++++++++++++++++++++++++-
+ 1 files changed, 90 insertions(+), 2 deletions(-)
+
+commit 006eec4fcc96803dea51073c2dda7d3ca9c2748e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 19 12:55:42 2011 -0400
+
+ Implement PDL::Constants module
+
+ This uses the constant pragma to implement
+ PI and E constants. There has been discussion
+ on a number of other constant values that would
+ be of use but it seemed simpler to start with
+ the basics. This addresses sf.net feature request
+ ticket #2787823, "add math constants to PDL: pi, e,.."
+
+ Basic/Constants.pm | 41 +++++++++++++++++++++++++++++++++++++++++
+ Basic/Makefile.PL | 2 +-
+ t/constants.t | 17 +++++++++++++++++
+ 3 files changed, 59 insertions(+), 1 deletions(-)
+
+commit 1bf5dec4ea334d992a57da1d827dbb058fb60cac
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 18 17:51:50 2011 -0400
+
+ Fix comment in IO/GD/Makefile.PL
+
+ IO/GD/Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit a05e7efd6660777b45c2b4e4c6f36cfca9bb304f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 18 11:57:20 2011 -0400
+
+ Add refresh.pdl to Example/PLplot
+
+ This is from the sf.net patches tracker #3024385,
+ for an "imag routine for PLplot". Until/if it is
+ folded into the PDL::Graphics::PLplot module, it
+ seemed to make sense having it as an example.
+
+ Please try it out if you have PLplot and be sure
+ to update or add documentation or usage notes
+ with any issues that arise. I am not able to test
+ the routines since no PLplot on cygwin yet...
+
+ Example/PLplot/refresh.pdl | 190 ++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 190 insertions(+), 0 deletions(-)
+
+commit 5ed84f288edacc246985dbdb4448bce00d4b8d15
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 18 11:38:36 2011 -0400
+
+ Add inplace support for PDL::Complex operations
+
+ Applied sf.net patch #1579745 by "nobody" to complex.pd.
+ It appears that the code was actually inplace-safe but
+ not flagged as such. This patch fixes that problem.
+
+ Basic/Complex/complex.pd | 52 +++++++++++++++++++++++++++++++---------------
+ 1 files changed, 35 insertions(+), 17 deletions(-)
+
+commit 2a6fd3d6e6f907b80fe0fd5669c71eac584ad970
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 16 12:37:53 2011 -0400
+
+ Reduce t/config.t tests since have no WITH_KARMA
+
+ t/config.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit e522cd25d302b8445b3755ffd488699fb306318e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 16 12:01:23 2011 -0400
+
+ Deprecate OPENGL_LIBS, OPENGL_INC, OPENGL_DEFINE
+
+ These are not used for the OpenGL bindings as that is now
+ supported completely via the Perl OpenGL module. Comments
+ have been left in the code for reference. In general,
+ issues relating to the installation and use of OpenGL
+ with PDL should be referred to the Perl OpenGL module
+ "up stream."
+
+ Graphics/TriD/OpenGLQ/Makefile.PL | 7 ++++---
+ perldl.conf | 11 ++++++++---
+ 2 files changed, 12 insertions(+), 6 deletions(-)
+
+commit 6ece4e060665b62c48e8397373ecbc8acf23a1d6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 16 11:46:23 2011 -0400
+
+ Various Karma cleanup in docs and config files
+
+ I left the commented out WITH_KARMA section in the perldl.conf
+ in case someone looks for the module. The plan is to keep it
+ there for a couple of releases just in case. NOTE: it should
+ be straightforward to make a CPAN module of the Karma interface
+ if it is needed again...
+
+ Basic/Pod/BadValues.pod | 2 +-
+ Basic/Pod/QuickStart.pod | 8 +++-----
+ DEPENDENCIES | 4 ++--
+ Lib/Fit/Gaussian/gaussian.pd | 2 --
+ MANIFEST.SKIP | 2 --
+ perldl.conf | 15 ++++++++++-----
+ 6 files changed, 16 insertions(+), 17 deletions(-)
+
+commit 6e7d33cbe0d3bb850d84d84683db4a802c17b259
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 15 18:11:32 2011 -0400
+
+ Implement new TriD STrigrid objects
+
+ New features by John Kirk implementing PDL::Graphics::TriD::STrigrid
+ and PDL::Graphics::TriD::STrigrid_S along with the routines
+ STrigrid_S_imag3d and STrigrid_imag3d.
+
+ Graphics/TriD/TriD.pm | 12 ++++++
+ Graphics/TriD/TriD/GL.pm | 49 +++++++++++++++++++++++
+ Graphics/TriD/TriD/Objects.pm | 86 +++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 147 insertions(+), 0 deletions(-)
+
+commit 6449c716d1e3a0ab627dd1d4dc6cff0c1770f97a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 13 16:15:00 2011 -0400
+
+ Minor POD fixes for Core.pm.PL
+
+ There were some glitches in the CPAN search.cpan.org on-line
+ docs so I fixed the outstanding items in Core.pm.PL in the
+ hopes that it will resolve the problem. The only podchecker
+ error was:
+
+ *** ERROR: unterminated T<...> at line 2480 in file Core.pm.PL
+
+ coming from a line line:
+
+ print OUT<<'!NO!SUBS!';
+
+ where the OUT<< was apparently being interpreted as a OU
+ followed by a T< ... construct.
+
+ Basic/Core/Core.pm.PL | 20 ++++++++++----------
+ 1 files changed, 10 insertions(+), 10 deletions(-)
+
+commit 6ad2923d2d3151287dc90ce0454fcb3a8ab6143f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 13 12:06:41 2011 -0400
+
+ Update VERSION to 2.4.7_013 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit afa5dbcf51e3b167938320b2f10bbbec70b37f9f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 13 11:15:28 2011 -0400
+
+ Update MANIFEST for PDL-2.4.7_012 release
+
+ MANIFEST | 5 +----
+ 1 files changed, 1 insertions(+), 4 deletions(-)
+
+commit 2faff446cb4eaa3bb7f43358070ce42b2cfb1d10
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 13 11:13:07 2011 -0400
+
+ Update Known_problems and Release_Notes for CPAN
+
+ This is the for the CHM/PDL-2.4.7_012.tar.gz developers
+ release.
+
+ Known_problems | 13 +++++++++++++
+ README | 6 ++++--
+ Release_Notes | 40 +++++++++++++++++++++++++++++++++++++++-
+ 3 files changed, 56 insertions(+), 3 deletions(-)
+
+commit 7bc60f05ae2e98445269b3fa41d5f682c354d2c7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 12 14:28:00 2011 -0500
+
+ Mv clip from TriD/OpenGL/examples to Example/TriD/
+
+ Example/TriD/clip.pl | 111 ++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 111 insertions(+), 0 deletions(-)
+
+commit 3e8677ce1905c878ac06cb89ccf93aa86cd7c892
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 12 14:13:53 2011 -0500
+
+ Update MANIFEST with TriD/OpenGL removal
+
+ MANIFEST | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 9d36b0f013e1f58865f244b66050cc7176d50957
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 12 14:08:26 2011 -0500
+
+ Added INTERNATIONALIZATION file with i18n notes
+
+ PDL does not have internationalization support beyond
+ that provided by perl itself. In fact, some of the
+ code may be specific to English and ASCII for file names
+ and strings.
+
+ INTERNATIONALIZATION | 11 +++++++++++
+ 1 files changed, 11 insertions(+), 0 deletions(-)
+
+commit cb3c29ed09232ee4abbc242451237087bd330fc9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 12 14:04:51 2011 -0500
+
+ Remove deprecated TriD OpenGL build code
+
+ The legacy X11+PP build of TriD OpenGL bindings has been
+ removed. You'll need to use the new Perl OpenGL based
+ build which has proven to be more portable and reliable.
+ This prepares TriD graphics development for the next
+ stage of refactoring for support and functionality.
+
+ The t/opengl.t was updated not to run if the TriD graphics
+ had not been built.
+
+ Graphics/Makefile.PL | 189 +------
+ Graphics/TriD/Makefile.PL | 65 +--
+ Graphics/TriD/OpenGL/Makefile.PL | 37 --
+ Graphics/TriD/OpenGL/README | 22 -
+ Graphics/TriD/OpenGL/examples/clip | 116 ----
+ Graphics/TriD/OpenGL/opengl.pd | 1076 ------------------------------------
+ Makefile.PL | 1 -
+ t/opengl.t | 36 +-
+ 8 files changed, 51 insertions(+), 1491 deletions(-)
+
+commit 2a6b211deb18281766182674bad0445cc7bfa67d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 12 01:46:07 2011 -0500
+
+ Skip GSL tests if WITH_GSL=>0
+
+ NOTE: need to update t/gsl_rng.t to use Test::More at some point.
+
+ Lib/GSL/Makefile.PL | 17 ++++++++++-------
+ t/gsl_diff.t | 25 ++++++++++++++-----------
+ t/gsl_integ.t | 26 ++++++++++++++------------
+ t/gsl_interp.t | 20 +++++++++++++-------
+ t/gsl_mroot.t | 25 +++++++++++++------------
+ t/gsl_rng.t | 5 +++--
+ t/gsl_sf.t | 27 +++++++++++++++------------
+ 7 files changed, 82 insertions(+), 63 deletions(-)
+
+commit c974e38b0aeb6019d4eb127cae0213a43eb84b98
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 12 01:45:38 2011 -0500
+
+ Update MANIFEST to remove Karma
+
+ MANIFEST | 2 --
+ 1 files changed, 0 insertions(+), 2 deletions(-)
+
+commit 69eb0c8a23fc2da7218bc9819fa6849ebc50dcaf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 11 20:59:57 2011 -0500
+
+ Remove Karma from PDL distribution
+
+ The last stable CPAN distribution with Karma code
+ in it will be PDL-2.4.7.
+
+ DEPENDENCIES | 7 +-
+ Graphics/Karma/Makefile.PL | 97 -----
+ Graphics/Karma/karma.pd | 836 --------------------------------------------
+ Graphics/Makefile.PL | 2 +-
+ 4 files changed, 3 insertions(+), 939 deletions(-)
+
+commit 5999e96d671b006538c710fc0b55d31949514dd3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 10 14:10:17 2011 -0500
+
+ Update Known_problems, Release_Notes, Perldl2/TODO
+
+ Known_problems | 1 +
+ Perldl2/TODO | 16 +++++++++++-----
+ Release_Notes | 54 +++++++++++++++++++++++++++---------------------------
+ 3 files changed, 39 insertions(+), 32 deletions(-)
+
+commit 5d23fb4ab0059cbfb11b09a6148393b33f6537fb
+Merge: 38deba8 3a9d10d
+Author: Craig DeForest <zowie at dhcp-10-158.boulder.swri.edu>
+Date: Wed Mar 9 16:11:49 2011 -0700
+
+ Merge branch 'master' of ssh://zowie@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 38deba8b92bd1b742e7373d36f43a053699f199c
+Author: Craig DeForest <zowie at dhcp-10-158.boulder.swri.edu>
+Date: Wed Mar 9 16:11:09 2011 -0700
+
+ fix constructor bugs, include a larger and hopefully more-complete set of tests.
+
+ Basic/Core/Core.pm.PL | 7 +-
+ Basic/Core/pdlcore.c.PL | 330 ++++++++++++++++++++++++++++++-----------------
+ t/constructor.t | 194 ++++++++++++++++++++++++++--
+ 3 files changed, 397 insertions(+), 134 deletions(-)
+
+commit 3a9d10df78b122a495ee92824cb2108424d539f8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 7 18:51:20 2011 -0500
+
+ Doc updates to perldl and the FAQ
+
+ Basic/Pod/FAQ.pod | 136 +++++++++++++++++++++++++++--------------------------
+ perldl.PL | 2 +-
+ 2 files changed, 70 insertions(+), 68 deletions(-)
+
+commit 15f0bf528629e70ea5097106ae1f2a6d0bc6b7b9
+Merge: 33628d2 7f92a5b
+Author: Craig DeForest <zowie at dhcp-10-158.boulder.swri.edu>
+Date: Mon Mar 7 14:30:54 2011 -0700
+
+ Merge branch 'master' of ssh://zowie@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 33628d2a7ac7b897f14739008a51758f71ccc2d3
+Author: Craig DeForest <zowie at dhcp-10-158.boulder.swri.edu>
+Date: Mon Mar 7 14:30:27 2011 -0700
+
+ commented out some debugging lines
+
+ Lib/Transform/transform.pd | 159 +++++++++++++++++++++++++++++++++++++++-----
+ 1 files changed, 142 insertions(+), 17 deletions(-)
+
+commit 7f92a5b7f77d8eb38c09604aace73a85a4946ca9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 7 15:37:49 2011 -0500
+
+ Update VERSION to 2.4.7_012 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 74 ++++++++++++++++++++++++++++++++++++++++----------------
+ 3 files changed, 55 insertions(+), 23 deletions(-)
+
+commit bb3b3bba1dd9cb473918c8e82777f461d3ec96db
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 7 15:06:09 2011 -0500
+
+ Update Release_Notes for CPAN 2.4.7_011 release
+
+ Release_Notes | 15 ++++++++++++++-
+ 1 files changed, 14 insertions(+), 1 deletions(-)
+
+commit 77e675967f3865b809ffaa413f2f65a52ff4a2ab
+Author: Judd Taylor <judd at black.qos.loc>
+Date: Mon Feb 28 21:26:07 2011 +0000
+
+ Fixed test library issues when a previous version of PDL is in the path.
+
+ t/gd_oo_tests.t | 22 ++++++++++++-----
+ t/gd_tests.t | 18 ++++++++++----
+ t/gis_proj.t | 21 +++++++++++-----
+ t/hdf_sd.t | 20 +++++++++++----
+ t/hdf_vdata.t | 20 +++++++++++----
+ t/hdf_vgroup.t | 18 ++++++++++----
+ t/proj_transform.t | 64 ++++++++++++++++++++++++++++++++------------------
+ t/proj_transform2.t | 28 +++++++++++++++-------
+ 8 files changed, 143 insertions(+), 68 deletions(-)
+
+commit ea6bb9d44ac0d8cad817a62dfac13dabd0db9f02
+Author: Judd Taylor <judd at black.qos.loc>
+Date: Fri Feb 25 19:19:44 2011 +0000
+
+ See my last commit... I forgot to save the test file before I committed it...
+
+ t/gd_oo_tests.t | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 511cea0633717956e8c41d5dd1659cd38c35a285
+Author: Judd Taylor <judd at black.qos.loc>
+Date: Fri Feb 25 19:14:36 2011 +0000
+
+ Added some new functions to the PDL::IO::GD OO interface. These
+ functions allow you to extract a binary blob of image data in a
+ particular format and use it elsewhere (like Qt::Image, hopefully).
+
+ Also added a new test for this functionality, and merged in some
+ additional changes I found I had laying around on my dev version
+ here. These include some better error handling in new(), as well
+ as a fix for creating the image objects from image blobs.
+
+ IO/GD/GD.pd | 153 +++++++++++++++++++++++++++++++++++++++++++++++++++----
+ t/gd_oo_tests.t | 9 +++-
+ 2 files changed, 149 insertions(+), 13 deletions(-)
+
+commit 0d7c8093903e3f57b14ed683f2b2b5c91c1bba01
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Feb 24 14:18:09 2011 -0500
+
+ Docs clean up and update with clarification
+
+ INSTALL | 7 ++--
+ Known_problems | 36 +++++--------------
+ TODO | 103 +-------------------------------------------------------
+ 3 files changed, 15 insertions(+), 131 deletions(-)
+
+commit fe6a1ddd3c401134195d84565add79e3838a846c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Feb 24 14:17:43 2011 -0500
+
+ Update in/Devel/CheckLib.pm to latest CPAN version
+
+ inc/Devel/CheckLib.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit ab858b1f4155f81b2323ca27b0473d814a676e8f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 18 14:56:40 2011 -0500
+
+ Update MANIFEST and MANIFEST.SKIP
+
+ Removed the unused and unimplemented TriD modules and
+ added some filter lines to MANIFEST.SKIP.
+
+ MANIFEST | 283 ++++++++++++++++++++++++++++-----------------------------
+ MANIFEST.SKIP | 15 +++
+ 2 files changed, 155 insertions(+), 143 deletions(-)
+
+commit 06b9de6cb847bf9e1bb7cd1cd45e96897d30d349
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 18 14:41:29 2011 -0500
+
+ Clean out unimplemented TriD classes
+
+ Geomview.pm, GraphBox.pm and Pyramid.pm were all stubs in
+ the TriD/ directory with no implementation nor any usage
+ elsewhere in PDL. Deleting the PM files to avoid confusion
+ in the future (i.e., rediscovering that they are stubs).
+
+ Graphics/TriD/TriD.pm | 1 +
+ Graphics/TriD/TriD/Geomview.pm | 2 --
+ Graphics/TriD/TriD/GraphBox.pm | 18 ------------------
+ Graphics/TriD/TriD/Pyramid.pm | 13 -------------
+ 4 files changed, 1 insertions(+), 33 deletions(-)
+
+commit 3e55f2c809ea1ee71beabcf5567cedf6982505f6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 18 11:07:57 2011 -0500
+
+ Remove prompt when duplicate PDL is in path
+
+ The Makefile.PL checks for another PDL installation and
+ would ask to continue. The warning message is now formatted
+ to be more visible and the user is not prompted. It was
+ a bit annoying since any PDL upgrade or test would result
+ in the prompt.
+
+ Makefile.PL | 30 +++++++++++++++---------------
+ 1 files changed, 15 insertions(+), 15 deletions(-)
+
+commit b84c25fd652526ec1aedf973ebed5c809a6f9c9d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 18 10:37:38 2011 -0500
+
+ Minor update to Perldl2/README
+
+ Perldl2/README | 12 ++++++------
+ 1 files changed, 6 insertions(+), 6 deletions(-)
+
+commit dc647ebce5bb9ea84b922523627385a55f147c34
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Feb 18 10:28:29 2011 -0500
+
+ Fix sf.net bug #3185864 (bad adev in statsover)
+
+ statsover() gave an incorrect result for ADEV for
+ non-badvalue pdls. This fixes the output to match
+ the bad value code and the documentation.
+
+ Basic/Primitive/primitive.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 65b6ee69ce24959d24e794b5cf5564e8b932e4da
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 15 13:00:36 2011 -0500
+
+ Minor POD cleanup for lu_XXX routines
+
+ Basic/MatrixOps/matrixops.pd | 36 +++++++++++++++---------------------
+ 1 files changed, 15 insertions(+), 21 deletions(-)
+
+commit 06368197ce2b2291bd62efe2464f54b8a7547978
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 15 10:22:46 2011 -0500
+
+ Update DEPENDENCIES, Known_problems, README
+
+ Minor wording changes and updated information
+ regarding Pod::Parser and Pod::Select dependencies.
+
+ DEPENDENCIES | 18 +++++++++---------
+ Known_problems | 6 ------
+ README | 6 +++---
+ 3 files changed, 12 insertions(+), 18 deletions(-)
+
+commit cfbc72e1b33da15c0b46c330de4aa00dcec93e5a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 15 09:05:53 2011 -0500
+
+ Update VERSION to 2.4.7_011 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 35 ++++++++++++++++++++++++++++++++++-
+ 3 files changed, 36 insertions(+), 3 deletions(-)
+
+commit 270825bdabd8c9bcda1e48d8f01927d9dd1c138b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Feb 15 08:44:46 2011 -0500
+
+ Fix sf.net #3171702 re: missing podselect command
+
+ Added Pod::Parser and Pod::Select to the PDL prerequisites
+ (they are in perl5 Core modules since v5.6 so this should
+ not be a problem). Then replaced call to podselect script
+ by calling the podselect() function in Pod::Select directly.
+
+ This should help with the many solaris FAILs on CPAN
+ testers and set the way to port PDL::Doc and others to
+ use the Core Pod modules rather than the PDL::Pod::*
+ snapshot with special fixes.
+
+ Basic/Gen/Makefile.PL | 11 +++--------
+ Basic/Pod/Makefile.PL | 11 +++--------
+ Makefile.PL | 19 ++++++-------------
+ 3 files changed, 12 insertions(+), 29 deletions(-)
+
+commit 9749f58cce8386c14bf4f20bfc2b3afa347593a3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Feb 13 18:35:04 2011 -0500
+
+ Fix many POD errors in *.pd files
+
+ The http://search.cpan.org site processes distribution
+ files for POD to generate their on-line docs. Our PP
+ files actually generate the final POD in the corresponding
+ PM files. However, the POD constructs are detected and
+ processed in the .pd files anyway.
+
+ I ran podchecker on all the .pd files in the PDL
+ source tree and fixed almost all of the errors
+ (mainly =cut and =back without a surrounding blank
+ line). Although the PP generators would produce
+ valid POD in the final PM output, adding the extra
+ newlines in the .pd file makes the search.cpan.org
+ processing work (better).
+
+ The remaining POD errors that were not fixed were
+ from unresolved local links that would be resolved
+ by the generated POD. With luck the search.cpan.org
+ conversion won't complain too much (although there
+ would be dead link in the page).
+
+ Basic/Complex/complex.pd | 2 +
+ Basic/Ufunc/ufunc.pd | 10 ++-
+ Graphics/IIS/iis.pd | 4 +
+ Graphics/Karma/karma.pd | 2 +
+ Graphics/PLplot/plplot.pd | 14 ++++
+ Graphics/TriD/OpenGL/opengl.pd | 1 +
+ Graphics/TriD/OpenGLQ/openglq.pd | 2 +
+ Graphics/TriD/Rout/rout.pd | 8 ++
+ IO/Browser/browser.pd | 6 ++
+ IO/GD/GD.pd | 41 +++++++++++
+ IO/HDF/SD/SD.pd | 48 ++++++++++++
+ IO/HDF/VS/VS.pd | 2 +
+ IO/Pnm/pnm.pd | 8 ++
+ Lib/Compression/compression.pd | 6 ++
+ Lib/FFTW/fftw.pd | 7 ++
+ Lib/GIS/Proj/Proj.pd | 8 ++
+ Lib/GSL/INTEG/gsl_integ.pd | 44 +++---------
+ Lib/GSL/INTERP/gsl_interp.pd | 25 ++-----
+ Lib/GSL/RNG/gsl_random.pd | 2 +
+ Lib/GSL/SF/airy/gsl_sf_airy.pd | 4 +
+ Lib/GSL/SF/bessel/gsl_sf_bessel.pd | 4 +
+ Lib/GSL/SF/clausen/gsl_sf_clausen.pd | 4 +
+ Lib/GSL/SF/coulomb/gsl_sf_coulomb.pd | 4 +
+ Lib/GSL/SF/coupling/gsl_sf_coupling.pd | 4 +
+ Lib/GSL/SF/dawson/gsl_sf_dawson.pd | 4 +
+ Lib/GSL/SF/debye/gsl_sf_debye.pd | 4 +
+ Lib/GSL/SF/dilog/gsl_sf_dilog.pd | 4 +
+ Lib/GSL/SF/elementary/gsl_sf_elementary.pd | 4 +
+ Lib/GSL/SF/ellint/gsl_sf_ellint.pd | 4 +
+ Lib/GSL/SF/elljac/gsl_sf_elljac.pd | 4 +
+ Lib/GSL/SF/erf/gsl_sf_erf.pd | 4 +
+ Lib/GSL/SF/exp/gsl_sf_exp.pd | 4 +
+ Lib/GSL/SF/expint/gsl_sf_expint.pd | 4 +
+ Lib/GSL/SF/fermi_dirac/gsl_sf_fermi_dirac.pd | 4 +
+ Lib/GSL/SF/gamma/gsl_sf_gamma.pd | 4 +
+ Lib/GSL/SF/gegenbauer/gsl_sf_gegenbauer.pd | 4 +
+ Lib/GSL/SF/hyperg/gsl_sf_hyperg.pd | 4 +
+ Lib/GSL/SF/laguerre/gsl_sf_laguerre.pd | 4 +
+ Lib/GSL/SF/legendre/gsl_sf_legendre.pd | 4 +
+ Lib/GSL/SF/log/gsl_sf_log.pd | 4 +
+ Lib/GSL/SF/poly/gsl_sf_poly.pd | 4 +
+ Lib/GSL/SF/pow_int/gsl_sf_pow_int.pd | 4 +
+ Lib/GSL/SF/psi/gsl_sf_psi.pd | 4 +
+ Lib/GSL/SF/synchrotron/gsl_sf_synchrotron.pd | 4 +
+ Lib/GSL/SF/transport/gsl_sf_transport.pd | 4 +
+ Lib/GSL/SF/trig/gsl_sf_trig.pd | 4 +
+ Lib/GSL/SF/zeta/gsl_sf_zeta.pd | 4 +
+ Lib/ImageND/imagend.pd | 10 +++
+ Lib/ImageRGB/imagergb.pd | 2 +
+ Lib/Slatec/slatec.pd | 17 ++++-
+ Lib/Transform/Proj4/Proj4.pd | 7 ++
+ Lib/Transform/transform.pd | 100 +++++++++++++-------------
+ 52 files changed, 384 insertions(+), 104 deletions(-)
+
+commit 652fcc2644234e0a62bd9e8ad443aa1277dad4d3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Feb 13 17:16:09 2011 -0500
+
+ Fix matrixops.pd POD to work with perldoc
+
+ This basically involves adding =cut and a couple
+ of new lines at the end of each string in the
+ Doc section of the pp_def() routines. I also
+ ran podchecker on the file to ensure there were
+ not other problems
+
+ Basic/MatrixOps/matrixops.pd | 29 ++++++++++++++++++++++-------
+ 1 files changed, 22 insertions(+), 7 deletions(-)
+
+commit 47b6083f7274e3e1f4c893859dca9b904bd4f871
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Feb 13 13:39:12 2011 -0500
+
+ Update VERSION to 2.4.7_010 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit b75c8263b0325db2a3ecf775eba2f8cffbb5bd14
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Feb 13 13:18:55 2011 -0500
+
+ Fix plan in t/matrixops.t, update Release_Notes
+
+ Forgot to change the number of tests to match
+ the new ones from the inv() threading bug.
+ Also updated Release_Notes in preparation
+ for a CPAN developers release.
+
+ Release_Notes | 34 +++++++++++++++++++++++++++++++---
+ t/matrixops.t | 2 +-
+ 2 files changed, 32 insertions(+), 4 deletions(-)
+
+commit 8f4c755aa477051be72b066addbadf1c649d6dec
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Feb 12 17:27:54 2011 -0500
+
+ Update Known_problems, Perldl2/TODO, Release_Notes
+
+ Added the latest bug information and updated the TODO
+ and Release_Note regarding the resolved issue of unclosed
+ q{} operators not being detected for multiline entry.
+
+ Known_problems | 6 ------
+ Perldl2/TODO | 8 +-------
+ Release_Notes | 4 ++++
+ 3 files changed, 5 insertions(+), 13 deletions(-)
+
+commit 8ce5dae60367797062e5005a3492ca7bf2a7481e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Feb 12 15:54:52 2011 -0500
+
+ Update docs for lu_decomp, lu_decomp2, lu_backsub
+
+ Partial update to the lu_* routines to document the
+ new threading and capabilities. It would be useful
+ to review all the PDL::MatrixOps documentation to
+ verify that it is clear and matches the implementation.
+
+ Basic/MatrixOps/matrixops.pd | 70 ++++++++++++++++++++++--------------------
+ 1 files changed, 37 insertions(+), 33 deletions(-)
+
+commit c1007c40c025be98c496f4569307e58de6877398
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Feb 10 17:12:04 2011 -0500
+
+ Add comment re anim GIF file output for wmpeg
+
+ Example/IO/wmpeg.pl | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 36190b0f32385bc1de73dc80417f2854b5966219
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Feb 10 16:37:51 2011 -0500
+
+ Add test for inv() threading (sf.net #3172882)
+
+ And clean up another debugging print statement. To view
+ them, just set the $PDL::debug variable.
+
+ Basic/MatrixOps/matrixops.pd | 2 +-
+ t/matrixops.t | 19 +++++++++++++++++++
+ 2 files changed, 20 insertions(+), 1 deletions(-)
+
+commit 036b6b5cd24edcc0fba99be6059b9634f54e8235
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Feb 10 12:49:46 2011 -0500
+
+ Make lu_backsug() diags conditional on $PDL::debug
+
+ Missed one in the original commit...
+
+ Basic/MatrixOps/matrixops.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit fd71fa4d2dc6cbd735e9e26c97faa7cbaecf82ff
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Feb 10 10:15:30 2011 -0500
+
+ Fix sf.net bug #3172882 re broken threading in inv
+
+ Fixes to various other threading issues in the lu_decomp()
+ and lu_decomp2() appear to have cause the threading support
+ in PDL::MatrixOps::inv to break (presumably it relied on
+ some feature of the original threading implementation).
+
+ This fixes the underlying lu_backsub() routine to handle
+ the implicit threading requirements for inv() and, I
+ believe, to correctly handle *fully* specified threading
+ with appropriate dummy dims for the input args.
+
+ Still todo: add test cases, document threading usage, and
+ verify for more complicated combination of array sizes.
+
+ Basic/MatrixOps/matrixops.pd | 69 ++++++++++++++++++++++++++++++++++++++----
+ 1 files changed, 63 insertions(+), 6 deletions(-)
+
+commit 6914c2d4c78139186b7a8fd44658045036de1db9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Feb 6 13:18:26 2011 -0500
+
+ Update Known_problems w sf.net bug #3172882
+
+ lu_backsub() threading is broken when both the LU
+ array and the right hand side columns to solve for
+ have their own threading dimensions. This breaks
+ the threading for the inv() routine in PDL::MatrixOps
+
+ Known_problems | 7 +++++++
+ 1 files changed, 7 insertions(+), 0 deletions(-)
+
+commit 84b86c056d9dc6036655f9b515e82d739465127a
+Merge: 4961d6e 29ddbc1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Feb 3 17:39:19 2011 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 4961d6e0b0ad2598c3f98dfcce86df4c43cc0aa7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Feb 3 17:36:15 2011 -0500
+
+ Fix imag2d not to exit on ESC in pdl2/perldl
+
+ The ESC key makes imag2d() exit by default. This adds
+ a check and just stops twiddling instead if imag2d()
+ is being run from the pdl2 or perldl shell.
+
+ Graphics/Graphics2D.pm | 8 +++++++-
+ 1 files changed, 7 insertions(+), 1 deletions(-)
+
+commit 29ddbc1f59b275348d94d6eb344c252e1cad06b9
+Author: djerius at cfa.harvard.edu <none at none>
+Date: Mon Jan 31 18:08:11 2011 -0500
+
+ clean up tests for PLplot functions
+
+ * common code in tests for PLplot functions has been abstracted
+ * plsfont & plgfont interfaces are now conditional on their existence
+ (otherwise tests fail on Debian Lenny)
+
+ * OPTIONS! file is now Perl code.
+ * all conditional code API code is now based on presence of a feature
+ rather than version
+
+ Graphics/PLplot/Makefile.PL | 101 +++++++++++++++++-------------------------
+ Graphics/PLplot/plplot.pd | 38 +++++-----------
+ 2 files changed, 53 insertions(+), 86 deletions(-)
+
+commit afa2986b45924ffb066686ca9bfdbd9a3e98df71
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jan 30 19:38:47 2011 -0500
+
+ Clean up PAUSE/STEP key controls for imag2d()
+
+ There are preliminary key bindings for the default
+ imag2d() windows to support SPACE to toggle pause,
+ [ . or > ] to step/move forward, and [ , or < ] to
+ move backward through frame data.
+
+ Graphics/Graphics2D.pm | 38 +++++++++++++++++++++++++++++++-------
+ 1 files changed, 31 insertions(+), 7 deletions(-)
+
+commit aef7ecb55f966814e8f086119c9c626a3df45cb0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 29 15:33:48 2011 -0500
+
+ readenvi doc/code cleanup, ignore case in hdr keys
+
+ IO/ENVI/readenvi.pdl | 38 ++++++++++++++++++++++++--------------
+ 1 files changed, 24 insertions(+), 14 deletions(-)
+
+commit efc53c9cb060973601eb3462cd04bf093c11464b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 29 15:30:58 2011 -0500
+
+ Add imag2d_update to EXPORT_OK and fix bug
+
+ Graphics/Graphics2D.pm now has the imag2d() routine in
+ it. Fixed a problem with imag2d_update() and realized
+ that it needed to be added to EXPORT_OK too.
+
+ Graphics/Graphics2D.pm | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit 38aec698b12e5a6deb65714f5c357a9030428c29
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 18 21:35:50 2011 -0500
+
+ Update cygwin/INSTALL with ffmpeg/gifsicle notes
+
+ This is a partial update for the instructions for
+ getting/building these two dependencies for wmpeg.
+ ffmpeg is the encoder. gifsicle can be used to
+ optimized animated GIF file sizes.
+
+ cygwin/INSTALL | 30 +++++++++++++++++++++++++++---
+ 1 files changed, 27 insertions(+), 3 deletions(-)
+
+commit 5604cf01cead59ea53091897907407ded74cd9b0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 18 17:31:26 2011 -0500
+
+ Add uncompressed GIF animations to wmpeg docs
+
+ It turns out that the ffmpeg "engine" will produce
+ animated GIFs if given .gif as the file extension
+ of the output file. Who knew? The GIF is *not*
+ compressed so is very big. Work will need to be
+ done to optimize the file size in this case...
+
+ Example/IO/wmpeg.pl | 7 ++++-
+ IO/Pnm/Pic.pm | 62 ++++++++++++++++++++++++++++----------------------
+ 2 files changed, 40 insertions(+), 29 deletions(-)
+
+commit 1480663584807d820c496dc74d1e997045b67612
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 18 15:42:24 2011 -0500
+
+ Update wmpeg docs re encoding MPEG vs MP4 video
+
+ Windows Media Player has problems displaying MPEG
+ videos. The current wmpeg implementation uses the
+ file extension to determine the encoding used.
+ As a result, it can also generate MPEG-4 files
+ which may be better displayed via WMP. Other
+ extensions supported by ffmpeg may work as well.
+
+ IO/Pnm/Pic.pm | 22 ++++++++++++++++------
+ 1 files changed, 16 insertions(+), 6 deletions(-)
+
+commit 83d737ed8a6451d2cddc5ec07570a2416fb14117
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 4 17:27:24 2011 -0500
+
+ Add notes on PERL_MM_USE_DEFAULT environment var..
+
+ . to INSTALL and Known_problems so folks who wish
+ to always take the default options can do so with
+ less searching.
+
+ INSTALL | 5 +++++
+ Known_problems | 34 +++++++++++++++++++++++-----------
+ 2 files changed, 28 insertions(+), 11 deletions(-)
+
+commit ed355188636c7cdf8513ec7071016e4438549e95
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 24 09:51:07 2010 -0500
+
+ Update VERSION to 2.4.7_009 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit ac6d5f5ae77ed3a17767bc18c3759046b0c7c411
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 24 09:44:54 2010 -0500
+
+ Update Known_problems and Release_Notes
+
+ Known_problems | 1 +
+ Release_Notes | 26 +++++++++++++++++++++++++-
+ 2 files changed, 26 insertions(+), 1 deletions(-)
+
+commit 2e83d6bcd22c0d63c474306bb0ad4347c2447b17
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 18 08:26:12 2010 -0500
+
+ sf.net bug #3139697 fixed imag2d error on Mac OS X
+
+ The imag2d() routine was using FreeGLUT-specific macros:
+ GLUT_ACTION_ON_WINDOW_CLOSE and GLUT_ACTION_CONTINUE_EXECUTION
+ which was a problem on OS X which does not support them.
+ Added check for FreeGLUT to conditionalize their use.
+
+ Graphics/Graphics2D.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2956eab032c3ef5408ad50d9cb248eb1ccc8bb0b
+Author: Doug Hunt <dhunt at arcana.cosmic.ucar.edu>
+Date: Wed Dec 15 14:55:56 2010 -0700
+
+ Merged PDL version of Graphics/PLplot with the stand-alone package from CPAN, version 0.53.
+ Fixed segfault in plplot.t by avoiding the problem: pdl($pdl->sclr). Calls to
+ pdl() with arguments that are themselves PDLs still fails.
+
+ Graphics/PLplot/Changes | 49 +++++++++++++++++++++++++++++++++++++++++++
+ Graphics/PLplot/Makefile.PL | 18 +++++++++++++++-
+ Graphics/PLplot/plplot.pd | 48 +++++++++++++++++++++++++++++++++++++++--
+ t/plplot.t | 38 +++++++++++++++++---------------
+ 4 files changed, 131 insertions(+), 22 deletions(-)
+
+commit b1376a7cb9e1ab315f3b4c5555e4b76dd53e4d46
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 11 15:11:33 2010 -0500
+
+ Update PDL::IO::FlexRaw POD for writeflex
+
+ IO/FlexRaw/FlexRaw.pm | 28 +++++++++++++++++-----------
+ 1 files changed, 17 insertions(+), 11 deletions(-)
+
+commit b44ecaac0efc81aadc66fdff825c6358f142ad7a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 11 14:21:25 2010 -0500
+
+ Add open MODE support to writeflex "filename"
+
+ writeflex is documented to take as argument either a "filename"
+ or a FILEHANDLE however if passed something like ">filename" as
+ the file argument, it would quietly (and unexpectedly) open the
+ file ">$name" which would then be ">>filename" and the data would
+ be appended to the file rather than overwriting it.
+
+ This modifies the "filename" option to be used explicitly if
+ passed a perl open type MODE+filename expression which might
+ avoid someone's utter confusion in the future...
+
+ IO/FlexRaw/FlexRaw.pm | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit f7f49ebb6b7e868b35d43177c5799ad480de54f0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 10 13:44:19 2010 -0500
+
+ Add working Makefile.PL for Alien::Proj4
+
+ This is based on the existing probes for PDL::GIS::Proj
+ and PDL::Transform::Proj4 and is being converted to use
+ Devel::CheckLib as the test engine. Once the tests are
+ working, the plan is to roll it up into an Alien::Proj4
+ module.
+
+ inc/Alien/Proj4/Makefile.PL | 94 +++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 94 insertions(+), 0 deletions(-)
+
+commit 1018f6b6743cc70d45a86b350f49e3ab48eae776
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Dec 9 13:52:22 2010 -0500
+
+ Fix inc/Devel/CheckLib ASPerl issues
+
+ There were problems with Devel::CheckLib and ActiveState Perl.
+
+ (1) require Devel::CheckLib fails with an error about
+ %Config::Confg being a read only value
+
+ (2) backslashes in the windows paths were deleted making
+ the resulting @flags incorrect and unusable.
+
+ This fix makes an explicit working copy of the needed %Config
+ entries in the _findcc() routine which should resolve the
+ compile failure. It also sets the $keep option to the
+ quotewords() routine to true which appears to fix the bad
+ win32 paths in the option @flags. The fixes will be pushed
+ upstream but are here in the local copy so things work.
+
+ inc/Devel/CheckLib.pm | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 976a4615e8df5bfd344efc74ad3f7c905a2b421b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 3 14:00:35 2010 -0500
+
+ Update VERSION to 2.4.7_008 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 3 files changed, 34 insertions(+), 2 deletions(-)
+
+commit 74726314c26b9a906087c7be062d323384e91f68
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 3 13:57:38 2010 -0500
+
+ Update Known_problems and README for CPAN
+
+ Known_problems | 3 ++-
+ README | 1 +
+ 2 files changed, 3 insertions(+), 1 deletions(-)
+
+commit f06102311eeff6b3f274f537845f7c0b099eda1e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Nov 30 10:43:46 2010 -0500
+
+ Create inc/ folder for local module copies
+
+ I ran the use-devel-checklib command to create
+ a PDL/inc folder for local modules used by PDL.
+ It starts with a copy of Devel::CheckLib with
+ the package line munged so it will not be indexed
+ by PAUSE/CPAN indexers.
+
+ The intent is to use this local inc/ folder to
+ develop the needed Alien::XXX modules for PDL
+ portability. We can munge the package lines so
+ that they are not indexed until they are stable
+ and ready for release. The first step will be
+ to implement detection functionality. The next
+ step would be to implement install functionality.
+
+ MANIFEST | 1 +
+ Makefile.PL | 11 ++
+ inc/Devel/CheckLib.pm | 452 +++++++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 464 insertions(+), 0 deletions(-)
+
+commit 73eafc35f8992705f042f5864169449195def8b0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Nov 30 10:38:48 2010 -0500
+
+ Update Perldl2/TODO list for clarity
+
+ Some tasks were done and others were confusing. I
+ hope this rework helps with organizing any PDL-2.4.8
+ release priorities with the pdl2 shell.
+
+ Perldl2/TODO | 204 +++++++++++++++++++++++++--------------------------------
+ 1 files changed, 90 insertions(+), 114 deletions(-)
+
+commit fe981e602557a8ea0e667975c02148b532bc4d71
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Nov 29 10:27:55 2010 -0500
+
+ Update Known_problems and Release_Notes
+
+ Known_problems | 7 -------
+ Release_Notes | 26 +++++++++++++++++++++++++-
+ 2 files changed, 25 insertions(+), 8 deletions(-)
+
+commit 7f2764bae6655564dff4c27d229d178e89e5ea30
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 28 18:58:22 2010 -0500
+
+ Add do_print command to pdl2 shell
+
+ Now you don't have to type $_REPL->do_print to
+ change the print output mode.
+
+ Perldl2/Plugin/PrintControl.pm | 3 +++
+ Perldl2/Profile/Perldl2.pm | 4 ++++
+ Perldl2/TODO | 4 ----
+ 3 files changed, 7 insertions(+), 4 deletions(-)
+
+commit 249a5410ae778df784e5668e0d114ad8511ab01e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 28 02:03:44 2010 -0500
+
+ Update lu_decomp/lu_decomp2 documentation
+
+ Now that lu_decomp is threaded, there is not as much
+ use for lu_decomp2. lu_decomp2 has runs faster but
+ is more likely to fail in the decomposition process.
+
+ Basic/MatrixOps/matrixops.pd | 43 ++++++++++++-----------------------------
+ 1 files changed, 13 insertions(+), 30 deletions(-)
+
+commit e2eed63217830e7e762defba908ec3421237b864
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Nov 27 19:16:06 2010 -0500
+
+ Make pdldoc display all matches
+
+ This changes the default for pdldoc and the help command
+ from showing only the first matching topic to showing
+ them all in order. The numeric selection syntax topic[$n]
+ still works, you can just page through if you want now...
+ without another help command.
+
+ Doc/Doc/Perldl.pm | 71 ++++++++++++++++++++++++++++++----------------------
+ 1 files changed, 41 insertions(+), 30 deletions(-)
+
+commit 77f54aeec496dee35e0b10ce9f935f8a24ef9c04
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Nov 27 17:55:52 2010 -0500
+
+ Fix pdl2 fallback to perldl on win32 systems
+
+ This is sf.net #3056142. The problem appears
+ to be with running exec on win32 and the weak
+ cmd shell environment. The file handles of
+ the original pdl2 script did not seem to get
+ passed to the newly exec-d perldl but opened
+ again instead. That resulted in interleaved
+ IO between the two instances.
+
+ The fix was to replace the exec call by a
+ do filename call instead so perl handles the
+ new program rather than the shell getting
+ involved.
+
+ Perldl2/pdl2 | 11 ++++-------
+ 1 files changed, 4 insertions(+), 7 deletions(-)
+
+commit 5a18339b35b4214ed94a1d3dab258acc492394ae
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Nov 27 16:45:52 2010 -0500
+
+ Fix PDL::hist usage documentation
+
+ The use of unix manpage-style [] for optional arguments
+ is confusing for perl where [] are valid language constructs.
+
+ Basic/Core/Basic.pm | 17 ++++++++++++++---
+ 1 files changed, 14 insertions(+), 3 deletions(-)
+
+commit 9367ca2000f2056bbb43f702e99d73a55ce824ce
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue Nov 16 11:57:12 2010 +1100
+
+ t/plplot.t - fix up line endings
+
+ Were window-ized from last commit
+
+ t/plplot.t | 1048 ++++++++++++++++++++++++++++++------------------------------
+ 1 files changed, 524 insertions(+), 524 deletions(-)
+
+commit 2514a2b059e5e8812e89e34c51ed0963a595a36c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 14 14:36:51 2010 -0500
+
+ Rename $PDL::FlexRaw::writeflexhdr/verbose
+
+ Fixed the case where the $verbose and $writeflexhdr parameters
+ in the PDL::IO::FlexRaw package were actually defined in the
+ PDL::FlexRaw namespace. This looks like legacy from when these
+ routines were at the top level PDL namespace. Now they are
+ proper PDL::IO::FlexRaw variables.
+
+ IO/FlexRaw/FlexRaw.pm | 16 ++++++++--------
+ 1 files changed, 8 insertions(+), 8 deletions(-)
+
+commit ed1d5bef4e2230c10acfc15a5d71d6187d0d3044
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 14 14:04:54 2010 -0500
+
+ Add writeflexhdr() support to writeflex
+
+ If the $PDL::FlexRaw::writeflexhdr is true (false by default)
+ and the file argument to writeflex() is a *file name" and not
+ a handle, writeflexhdr() will be called automatically. I
+ think this should be the default but for back compatability
+ we have the $PDL::FlexRaw::writeflexhdr setting.
+
+ IO/FlexRaw/FlexRaw.pm | 88 +++++++++++++++++++++++++++++++-----------------
+ 1 files changed, 57 insertions(+), 31 deletions(-)
+
+commit 378b97edd477ca065d870ed25548e175df23be6e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Nov 12 17:29:06 2010 -0500
+
+ Change info memory display units to KB and MB
+
+ There was confusion with the previous Kb and Mb since
+ that notation usually means bits or baud rather than
+ bytes. The capital B is clearer.
+
+ Basic/Core/Core.pm.PL | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 8c6b33be717951051f0fa47955df1b29882a2b8a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Nov 12 15:15:18 2010 -0500
+
+ Make t/dumper.t diag output conditional
+
+ Now that the bug appears to be fixed, we don't
+ need the diagnostics to print unless there is
+ a problem...
+
+ t/dumper.t | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit ad0edd267b0370996a7f01f968456c1496e69c11
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Nov 12 10:53:08 2010 -0500
+
+ Update VERSION to 2.4.7_007 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 33 +++++++++++++++++++++++++++++++++
+ 3 files changed, 35 insertions(+), 2 deletions(-)
+
+commit 51f1246eb4eeac9efdcff5140777abea66afb116
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Nov 12 10:49:31 2010 -0500
+
+ Update READMEs for CPAN 2.4.7_006 release
+
+ Known_problems | 19 +++----------------
+ README | 2 +-
+ TODO | 15 ++++++++-------
+ 3 files changed, 12 insertions(+), 24 deletions(-)
+
+commit 5368b77235b6cb8a795d75397dbf5f3f9e1c9f4e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 11 21:41:10 2010 -0500
+
+ Add POD for wmpeg status return values.
+
+ IO/Pnm/Pic.pm | 27 +++++++++++++++------------
+ 1 files changed, 15 insertions(+), 12 deletions(-)
+
+commit 9bdea705cef06c2e788212cae9107e59651d502e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 11 21:32:38 2010 -0500
+
+ Update Known_problems/Release_Notes for #3057542
+
+ Known_problems | 1 -
+ Release_Notes | 4 ++++
+ 2 files changed, 4 insertions(+), 1 deletions(-)
+
+commit c7ed1fb2b46e9b597ce9052fdac1e7e4243efe8e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 11 21:25:56 2010 -0500
+
+ Make wmpeg() return/complain if no ffmpeg
+
+ Now check if an ffmpeg executable is in PATH before
+ trying to open a pipe command to generate the output.
+ I'm not sure what is going on with the error return
+ from the open call but this seems to work ok.
+
+ IO/Pnm/Pic.pm | 8 ++++++++
+ 1 files changed, 8 insertions(+), 0 deletions(-)
+
+commit 027ca9c56ad6a13d1074702094a859b5fd5c413b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 11 18:24:54 2010 -0500
+
+ Move mapflex tests out of TODO in flexraw.t
+
+ Once these tests pass, the problem is resolved.
+ They seem to pass already but just making sure...
+
+ t/flexraw.t | 85 ++++++++++++++++++++++++++++++-----------------------------
+ 1 files changed, 43 insertions(+), 42 deletions(-)
+
+commit d43f2be9213bd10296c8eace9c80b0d092a7fb2c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 11 18:16:46 2010 -0500
+
+ Update Known_problems and Release_Notes w progress
+
+ Known_problems | 11 -----------
+ Release_Notes | 11 ++++++++++-
+ 2 files changed, 10 insertions(+), 12 deletions(-)
+
+commit e28e335bcb841fafbe5bec2c601295e3fb50af9f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 11 18:14:48 2010 -0500
+
+ Create $PDL::toolongtoprint package parameter
+
+ This determines the largest pdl that will be printed
+ by the pdl->string routines. Default is 10000. Added
+ POD to Core.pm for all the PDL global params defined
+ there.
+
+ Basic/Complex/complex.pd | 2 +-
+ Basic/Core/Core.pm.PL | 59 +++++++++++++++++++++++++++++++++++++++++++--
+ 2 files changed, 57 insertions(+), 4 deletions(-)
+
+commit f527679a006136524899f34ffff7d16a9450df8a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 11 18:12:19 2010 -0500
+
+ proj_transform.t skips all if bad PROJ4 detected
+
+ t/proj_transform.t | 6 +++++-
+ 1 files changed, 5 insertions(+), 1 deletions(-)
+
+commit 21b54e604af9e4e6bc7cf0959b90a310054fd4a0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 11 17:02:03 2010 -0500
+
+ proj_transform2.t skips all if bad PROJ4 detected
+
+ Probably should mark the PDL Proj bindings as not correctly
+ built but the warnings here might suggest a solution for
+ users with this problem.
+
+ t/proj_transform2.t | 14 +++++++++-----
+ 1 files changed, 9 insertions(+), 5 deletions(-)
+
+commit 39e64e6182872cbff18f82e8626ce875f69921c2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 11 16:20:47 2010 -0500
+
+ VERSION->2.4.7_006 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 7 ++++++-
+ Release_Notes | 36 ++++++++++++++++++++++++++++++++++--
+ 3 files changed, 41 insertions(+), 4 deletions(-)
+
+commit 706361bd525585480ac5edbb7d395fb5d157cc79
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 11 15:46:17 2010 -0500
+
+ Extend pattern used by IO/Dumper.pm to handle pdls
+
+ It appears that for some systems, in addition to the
+ value being returns as a signed number, there are cases
+ where the value was returned as a '' string rather than
+ a number. Now we catch and translate that as well.
+
+ IO/Dumper.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 51313b9189390f4f6f85a335fd5243725de7b205
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 11 15:42:31 2010 -0500
+
+ Fix mapflex bugs (SF.net #3031068)
+
+ Added ref counting to the base piddle mmapped for mapflew
+ so that when *all* the piddles in the file are freed, *then*
+ the base piddle will be freed. Made working variables in
+ mapflex() lexical to avoid dangling refs. Fixed t/flexraw.t
+ bugs so all tests pass.
+
+ Basic/Core/Core.xs.PL | 2 ++
+ IO/FlexRaw/FlexRaw.pm | 4 ++--
+ t/flexraw.t | 6 ++++--
+ 3 files changed, 8 insertions(+), 4 deletions(-)
+
+commit 5480068c98dd0fade8981958f53610852ddbedc0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 11 13:47:15 2010 -0500
+
+ Fix ReadOnly default to 0 for mapflex (per docs)
+
+ IO/FlexRaw/FlexRaw.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit e20b034b3ced3a6cf299b4b4856820943e617cc9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Nov 9 13:11:13 2010 -0500
+
+ Update VERSION to 2.4.7_005 for development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 34 ++++++++++++++++++++++++++++++++++
+ 3 files changed, 36 insertions(+), 2 deletions(-)
+
+commit 51cc3c07fe986791ed85b04b4b5f4236dd44346b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Nov 9 10:44:38 2010 -0500
+
+ Update Known_problems and Release_Notes for CPAN
+
+ Known_problems | 3 ++-
+ Release_Notes | 18 +++++++++++++++++-
+ 2 files changed, 19 insertions(+), 2 deletions(-)
+
+commit 964018777aa9c45b93a995214f050f5f562921b7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Nov 9 10:43:31 2010 -0500
+
+ Fix PDL::address to use IV rather than int for ptr
+
+ Modify the XS_PDL_address routine in Core.xs to convert
+ the pdl pointer to an IV rather than an int. Adjusted
+ PDL::address in Core.pm to format the resulting value
+ correctly.
+
+ Basic/Core/Core.pm.PL | 5 ++++-
+ Basic/Core/Core.xs.PL | 4 ++--
+ 2 files changed, 6 insertions(+), 3 deletions(-)
+
+commit 9022872101e0e57d509de8a91fc883911c43291a
+Merge: 0856670 3054ab1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Nov 8 22:06:07 2010 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 0856670a69fdcabb525c9cb704ea5e2183843839
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Nov 8 22:04:51 2010 -0500
+
+ Add include <stdlib.h> to declare malloc routine
+
+ Lib/Image2D/resample.h | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 3054ab16d93ae70e9172e71d317d5422d778d631
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Nov 8 11:01:36 2010 -0500
+
+ Fix readenvi.pdl header support
+
+ Fix a bug in the ENVI header list value processing
+ and add support for the header_offset. readenv()
+ now has a imbedded_header key which is a byte piddle
+ of the first header_offset bytes.
+
+ IO/ENVI/readenvi.pdl | 91 +++++++++++++++++++++++++++----------------------
+ 1 files changed, 50 insertions(+), 41 deletions(-)
+
+commit f7ad0228e57597e6b8621ec742c2a4b015f0c140
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Nov 6 23:48:31 2010 -0400
+
+ Refactor t/complex.t to use Test::More
+
+ t/complex.t | 37 +++++++++++++++----------------------
+ 1 files changed, 15 insertions(+), 22 deletions(-)
+
+commit d8980779b41cbb6400d6f0b8941b383629d22d2c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Nov 6 17:44:56 2010 -0400
+
+ Update VERSION and Release_Notes for more devel
+
+ Basic/PDL.pm | 2 +-
+ Release_Notes | 34 ++++++++++++++++++++++++++++++++++
+ 2 files changed, 35 insertions(+), 1 deletions(-)
+
+commit 9af22cefc265de6177a54bef276786f9ff835529
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Nov 6 17:42:28 2010 -0400
+
+ Add type check to FlexRaw.pm headers
+
+ It was passing strings to PDL::howbig for one case
+ which generated an error.
+
+ IO/FlexRaw/FlexRaw.pm | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit e112c2e032b1ed53cb5b84dbb9922a96075c8e6a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Nov 6 17:39:54 2010 -0400
+
+ Update Known_problems and Release_Notes for CPAN
+
+ Known_problems | 23 +++++++----------------
+ Release_Notes | 21 +++++++++++++++++++--
+ 2 files changed, 26 insertions(+), 18 deletions(-)
+
+commit db2b83d1d25b0b9f575e1ec0dc7c81ba50a900a8
+Author: Craig DeForest <zowie at dhcp-10-120.boulder.swri.edu>
+Date: Thu Nov 4 13:50:08 2010 -0600
+
+ re-add changes originally commited to "lib" instead of "Lib" - problems with
+ nonlinear header transform support in t_fits (now announces it's ignoring them),
+ and a typo in PCi_j interpretation.
+
+ Lib/Transform/transform.pd | 9 +++++----
+ 1 files changed, 5 insertions(+), 4 deletions(-)
+
+commit eae79722b9a64d84a0a1422c578025143db7a2c6
+Author: Craig DeForest <zowie at z7.boulder.swri.edu>
+Date: Thu Nov 4 13:43:01 2010 -0600
+
+ Deleted bad commit typo due to evil Mac case-insensitivity
+
+ lib/Transform/Cartography/Cartography.pm | 2909 ------------------------
+ lib/Transform/transform.pd | 3644 ------------------------------
+ 2 files changed, 0 insertions(+), 6553 deletions(-)
+
+commit 06f129f88d72fae13870b50bee3f7f6f827808ba
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 4 09:14:30 2010 -0400
+
+ Minor change to try to fix bad commit
+
+ win32 doesn't have a case sensitive file system so
+ the use of incorrect case for git is a problem.
+ I'm not sure how it worked anyway unless the push
+ was from another case insensitive platform and the
+ path name was corrupted to lower case...
+
+ lib/Transform/transform.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 7f517382c0324a3f6d92f75a0348b95a881e50d1
+Merge: 1327520 7c580b0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Nov 4 08:58:49 2010 -0400
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 7c580b035410f9073b4437dc7e11cedd6aef0425
+Merge: c10f108 de98972
+Author: Craig DeForest <zowie at Clio.local>
+Date: Thu Nov 4 02:54:29 2010 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit c10f1087d09f0e3649b289b7b75aa8bd0a18585c
+Author: Craig DeForest <zowie at Clio.local>
+Date: Thu Nov 4 02:53:42 2010 -0600
+
+ Repair t_fits (oops) - stub for nonlinear transformations was causing it to return 1 instead of the transformation.
+
+ lib/Transform/transform.pd | 3644 ++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 3644 insertions(+), 0 deletions(-)
+
+commit 9cf9e49b396f854aeedd6889cd5a854fa2030e22
+Author: Craig DeForest <zowie at Clio.local>
+Date: Thu Nov 4 01:12:06 2010 -0600
+
+ Add synonym t_zenithal to t_vertical in Cartography.pm
+
+ Lib/Transform/Cartography/Cartography.pm | 9 +++++++--
+ 1 files changed, 7 insertions(+), 2 deletions(-)
+
+commit 6fd867b32707b91f3cc36c814d944a92d0a9b503
+Author: Craig DeForest <zowie at Clio.local>
+Date: Thu Nov 4 01:11:28 2010 -0600
+
+ Correct typo in test description (picky, picky)
+
+ t/core.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 0e2908562177b778df43c6aa1cc3eabcede068dd
+Author: Craig DeForest <zowie at Clio.local>
+Date: Thu Nov 4 01:11:09 2010 -0600
+
+ Add t_cubic to transform.pd; add t_zenithal synonym to t_vertical
+ in Cartography.pm
+
+ Lib/Transform/transform.pd | 181 ++-
+ lib/Transform/Cartography/Cartography.pm | 2909 ++++++++++++++++++++++++++++++
+ 2 files changed, 3082 insertions(+), 8 deletions(-)
+
+commit de989722228d5e6f7e65a0660fe10a7f23fd1770
+Merge: a3a95e4 ff3ca09
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Wed Nov 3 21:43:52 2010 -0600
+
+ Merge branch 'master' of ssh://lambd@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 132752061dd08d92996627ba377fae3570b16cc4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Nov 3 13:13:42 2010 -0400
+
+ Add parens to pdl constructor call
+
+ This makes cut and paste easier into the pdl2 shell
+ as the default multiline support there does not handle
+ continued strings well.
+
+ Example/IO/wmpeg.pl | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit ff3ca09de00f681753c3b8ed62210a8fa41d2765
+Merge: 80db076 5766720
+Author: Craig DeForest <zowie at Clio.local>
+Date: Wed Nov 3 03:00:46 2010 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 80db076828b31c92aba9cef3773b73ca01db9c05
+Author: Craig DeForest <zowie at Clio.local>
+Date: Wed Nov 3 02:58:28 2010 -0600
+
+ Fixed error messages in obscure cases.
+
+ IO/Dumper.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit c1e833bfc3da7e61589c973c077e8c82d6dfc36a
+Author: Craig DeForest <zowie at Clio.local>
+Date: Wed Nov 3 02:57:25 2010 -0600
+
+ Finally fixed the constructor bug -- passes all tests, seems to never crash.
+
+ Basic/Core/pdlcore.c.PL | 356 ++++++++++++++++++++++++++++++++++++----------
+ 1 files changed, 278 insertions(+), 78 deletions(-)
+
+commit a3a95e43ff79d4ec4bd86f7e338f32ed1cce84b7
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Nov 2 23:28:19 2010 -0600
+
+ Fix minor typo in Modules.pod
+
+ Basic/Pod/Modules.pod | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 576672029512eeba861cdfcb374137d24069b531
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Nov 2 22:58:38 2010 -0600
+
+ Fix POD formatting and typos in complex.pd
+
+ Basic/Complex/complex.pd | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit cf573670b5eb6ae3de41c1bbb91458090d12a8dd
+Merge: 7924750 bc637c5
+Author: cosmic operator <cosmicops at arcana.cosmic.ucar.edu>
+Date: Wed Oct 27 12:51:10 2010 -0600
+
+ Merge remote branch 'origin/master'
+
+commit 792475011ec9f5ed73ef8f0a37160c2337342c32
+Author: cosmic operator <cosmicops at arcana.cosmic.ucar.edu>
+Date: Wed Oct 27 11:59:57 2010 -0600
+
+ Jason Lin's change to GSL/INTERP to turn off the default GSL error handler.
+ This permits errors in interpolation codes to be caught by a perl exception
+ handler.
+
+ Lib/GSL/INTERP/gslerr.h | 4 +++-
+ t/gsl_interp.t | 9 ++++++++-
+ 2 files changed, 11 insertions(+), 2 deletions(-)
+
+commit bc637c5ce981b1ce8f0948459110a3813a1b9b02
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 26 17:56:46 2010 -0400
+
+ Update Perldl2/TODO with more issues
+
+ These are mostly some compatability items and nice-to-haves
+ that could be useful in pdl2.
+
+ Perldl2/TODO | 30 +++++++++++++++++++++++++++++-
+ 1 files changed, 29 insertions(+), 1 deletions(-)
+
+commit 4905e4b79819d2217fbe4105364693eb5c7f6a6e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 26 17:56:14 2010 -0400
+
+ Update cygwin tmalloc.pl with optional sleep arg
+
+ cygwin/tmalloc.pl | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 7cdec40665013178ef2a187e7640e9b3cf60b359
+Author: sisyphus <sisyphus1 at optusnet.com.au>
+Date: Fri Oct 15 17:56:06 2010 +1100
+
+ t/plplot.t - replace "perl" with "$^X" in system commands
+
+ Win32 only - makes it easier for my Win32 ppm build script
+ to successfully create ppm packages for the various perl
+ builds ... please pardon the self-indulgence.
+
+ t/plplot.t | 1048 ++++++++++++++++++++++++++++++------------------------------
+ 1 files changed, 524 insertions(+), 524 deletions(-)
+
+commit 8113c93dca843b9bacf0123b10aa8055fb17e351
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 12 19:50:24 2010 -0400
+
+ Update cygwin/INSTALL and README files
+
+ With some information from a clean build for cygwin 1.5.25....
+
+ cygwin/INSTALL | 7 +++++--
+ cygwin/README | 6 ++++++
+ 2 files changed, 11 insertions(+), 2 deletions(-)
+
+commit 047ae5bd137ba89d0590f8ba06308960fa7b7404
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Oct 7 12:43:47 2010 -0400
+
+ Update Perldl2/TODO
+
+ Perldl2/TODO | 39 ++++++++++++++++++++++++++-------------
+ 1 files changed, 26 insertions(+), 13 deletions(-)
+
+commit 91fbba5b956166516da855b8ac6f2c67da0a8c7a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Oct 7 09:17:24 2010 -0400
+
+ Replace print by diag to avoid messing up test
+
+ t/core.t | 10 ++++------
+ 1 files changed, 4 insertions(+), 6 deletions(-)
+
+commit 87d2f486a149197861e9256b26aa1a9699701ab2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 6 10:53:34 2010 -0400
+
+ Add diag to t/dumper.t and update Perldl2/TODO
+
+ Perldl2/TODO | 5 ++++-
+ t/dumper.t | 1 +
+ 2 files changed, 5 insertions(+), 1 deletions(-)
+
+commit 9ec22f7bf228af9220d79d2166794785eb1ab918
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 5 19:20:38 2010 -0400
+
+ Consolidate skip tests for t/flexraw_fortran.t
+
+ Now they are all in one multi-choice conditional. Also
+ added a check for too long $PDL::Config{TEMPDIR} and we
+ give up on this f77-format based test.
+
+ t/flexraw_fortran.t | 22 +++++++++++++---------
+ 1 files changed, 13 insertions(+), 9 deletions(-)
+
+commit b3b9eed214441560f3e797e3abf50cbcbe85085a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 5 10:04:58 2010 -0400
+
+ Missed some fixes for line length problems
+
+ Now all uses of the possibly very long temp
+ file names are on a single fortran line.
+ The remaining work is to add test skips if
+ the fortran files still can't be compiled and
+ run to create the data...
+
+ t/flexraw_fortran.t | 12 ++++++++----
+ 1 files changed, 8 insertions(+), 4 deletions(-)
+
+commit f6e608e221fbf17fa4731065b00724e795a6336b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 5 10:04:33 2010 -0400
+
+ Update Known_problems with t/dumper.t info
+
+ Known_problems | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit 48ce66f2bdf5efe4845870f2f297d7126318d5be
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 5 09:05:21 2010 -0400
+
+ Update Perldl2/TODO with completions stuff
+
+ Recording the various idiosyncracies of Term::ReadLine::Perl
+ completion versus Term::ReadLine::Gnu completion, especially
+ as regards working on win32.
+
+ Perldl2/TODO | 15 ++++++++++++++-
+ 1 files changed, 14 insertions(+), 1 deletions(-)
+
+commit ba381bb024e3554787836b2fe08eef4e4346ef9d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 3 19:21:37 2010 -0400
+
+ Add POD to utils/perldlpp.pl
+
+ At least we document the usage until someone gets around to
+ implementing the make option for install-time filtering...
+
+ utils/perldlpp.pl | 42 ++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 42 insertions(+), 0 deletions(-)
+
+commit a681fc7b11b97639471367b1cf4fb999a7da3c54
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 3 17:00:45 2010 -0400
+
+ Update VERSION and READMEs to 2.4.7_003
+
+ ...for more development.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 3 ++-
+ Release_Notes | 33 +++++++++++++++++++++++++++++++++
+ 3 files changed, 36 insertions(+), 2 deletions(-)
+
+commit bbda12d8bab868e3b5ad3d1e6451568891260bb9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 3 16:39:02 2010 -0400
+
+ Updata Release_Notes for 2.4.7_002 release
+
+ Release_Notes | 16 +++++++++-------
+ 1 files changed, 9 insertions(+), 7 deletions(-)
+
+commit 7b05a3c81c981eeac63b756f37e03b6c516ea6f1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 3 16:30:58 2010 -0400
+
+ Make t/flexraw.t a "TODO" test
+
+ Trying to come up with a standard for using CPAN Testers
+ to help diagnose PDL bugs. The Test::More TODO capability
+ allows one to have tests corresponding to development TODOs.
+ Unless the $TODO is defined, then the test acts as normal.
+
+ By default, $TODO is defined if SKIP_KNOWN_PROBLEMS is set
+ in either the environment or the perldl.conf file. However,
+ it isn't useful to generate fail messages for bugs that are
+ not being worked on (e.g. without a developer assigned to
+ the ticket).
+
+ If no developer is assigned, the default is to set the
+ local $TODO always. If the ticket has an assigned developer,
+ then the setting will obey the SKIP_KNOWN_PROBLEMS options:
+ on for official releases, off for development releases.
+
+ If you are an assigned developer and wish to have test FAILs
+ ignored for your TODO items, just edit the local $TODO line
+ and remove/comment out the test for SKIP_KNOWN_PROBLEMS.
+
+ t/flexraw.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2393740f286f40334fecf9a269859cef0e881f40
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 3 16:13:19 2010 -0400
+
+ Add back SKIP_KNOWN_PROBLEMS detection with TODO
+
+ Using the Test::More TODO capability, you can switch
+ from test mode to todo mode for the Known_problems by
+ setting the SKIP_KNOWN_PROBLEMS environment variable
+ or perldl.conf config option.
+
+ Release_Notes | 6 +++++-
+ t/complex.t | 3 ++-
+ t/config.t | 2 +-
+ t/constructor.t | 2 +-
+ t/core.t | 4 ++--
+ t/flexraw.t | 2 +-
+ 6 files changed, 12 insertions(+), 7 deletions(-)
+
+commit 7175ee0fecd3e0b75d8882f50fb8794c07779af5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 3 15:22:28 2010 -0400
+
+ Replace SKIP with TODO for Known_problems in tests
+
+ Thanks to David Mertens for originally pointing out that
+ Test::More capability. Now that I had time to go back and
+ investigate further, it seems to do exactly what I wanted
+ for the SKIP_KNOWN_PROBLEMS---but better.
+
+ t/complex.t | 9 ++----
+ t/config.t | 8 +----
+ t/constructor.t | 6 ++--
+ t/core.t | 34 +++++++++++++--------
+ t/flexraw.t | 90 ++++++++++++++++++++++++++++---------------------------
+ 5 files changed, 75 insertions(+), 72 deletions(-)
+
+commit 688c93c12169f2ca10399e72a62d4247fa0bbfc7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 3 13:29:12 2010 -0400
+
+ Update VERSION to 2.4.7_002 for more development
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 33 +++++++++++++++++++++++++++++++++
+ 3 files changed, 35 insertions(+), 2 deletions(-)
+
+commit acf0c2c7f1bc1a555d6f151c64cffe52a4ad82d5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 3 12:46:33 2010 -0400
+
+ Update README and prep for 2.4.7_001 release.
+
+ DEVELOPMENT | 2 +
+ Known_problems | 32 +++++++++++++++++++++--------
+ MANIFEST | 1 +
+ README | 20 ++++++++++++------
+ Release_Notes | 57 ++++++++++++++++++++++++++++++++++++++++++++++++----
+ utils/perldlpp.pl | 14 +++++++++++++
+ 6 files changed, 105 insertions(+), 21 deletions(-)
+
+commit e06ca58d121f8d51cc7040802d361e505ad0f540
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Oct 3 09:12:28 2010 -0400
+
+ rm header between separate t/fastraw.t tests
+
+ t/fastraw.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 55cbeaefc4c7b009db123e9bffbd2724d7b226bc
+Merge: 2f72dff d543632
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Oct 2 10:18:18 2010 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 2f72dff24851bf4c2eee42aa8e881d7f4dea5229
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Oct 2 10:05:06 2010 -0400
+
+ Rearrange code to reduce line size
+
+ The current codefold routine fails to correctly continue
+ lines containing quoted strings. I've moved the filename
+ to a line by itself to give it the maximum possible number
+ of characters to work with.
+
+ t/flexraw_fortran.t | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit d543632b0d8ad56e6bbf95888a1cf03f0da27bb6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 1 08:38:40 2010 -0400
+
+ Add PERLDOC_PAGER check for pdldoc pager
+
+ Now the pager used by the pdldoc command is: the value
+ of PERLDOC_PAGER if defined, then the value of PAGER if
+ defined, and finally the value of $Config{pager}.
+
+ NOTE: we should probably add some detection for whether
+ or not the indicated pager program is actually present.
+
+ Doc/Doc/Config.pm.PL | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit f17c6bfdf4c37d1ceb129065dd3b2044d66767b6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 28 12:42:19 2010 -0400
+
+ Fix typo in imag2d docs in Graphics.pm
+
+ Graphics/Graphics2D.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit ac2d45a8b82a47b2b433cb0fc0bee7104db38cc7
+Merge: 39c30ff fa06ea1
+Author: Craig DeForest <zowie at dhcp-10-120.boulder.swri.edu>
+Date: Tue Sep 28 09:18:54 2010 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 39c30ff4a9d3ba03186b9add9e14ec7aa41ec66a
+Author: Craig DeForest <zowie at dhcp-10-120.boulder.swri.edu>
+Date: Tue Sep 28 09:18:25 2010 -0600
+
+ updated FITS.pm to handle BSCALE/BZERO correctly for tile-compressed images
+
+ IO/FITS/FITS.pm | 37 +++++++++++++++++++++++++------------
+ 1 files changed, 25 insertions(+), 12 deletions(-)
+
+commit fa06ea12dfb12a63da25eebb15d36691dd48af91
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Sep 27 10:42:52 2010 -0400
+
+ Fix uniqind bug #3076570
+
+ If uniqind were given a degenerate pdl as input (all the same
+ value), it should return the single value and not Empty.
+
+ Basic/Primitive/primitive.pd | 8 +++++++-
+ t/primitive.t | 13 ++++++++++++-
+ 2 files changed, 19 insertions(+), 2 deletions(-)
+
+commit 2a3f1f716915754571aeb65c851e1b2c493a7c8f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 21 18:09:03 2010 -0400
+
+ Update TODO and Perldl2/TODO
+
+ This is a partial clean up of the current lists in light
+ of the current development status and what is needed or
+ desired.
+
+ Perldl2/TODO | 6 ++-
+ TODO | 99 ++++++++++++++++++++-------------------------------------
+ 2 files changed, 39 insertions(+), 66 deletions(-)
+
+commit cbb82658491fe7302f9231faaae5db432fbbeb83
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Sep 20 18:14:50 2010 -0400
+
+ Add xtra space from TAB completion to known probs
+
+ Known_problems | 6 ++++++
+ 1 files changed, 6 insertions(+), 0 deletions(-)
+
+commit f40a497ef8938d68ed3dbe9d51c23dcc0968c48f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 14 09:02:40 2010 -0400
+
+ Update Known_problems with current bugs
+
+ Known_problems | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 826edf1f913b713adff4c99be24bae28846d69c1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 14 08:09:46 2010 -0400
+
+ Clean up t/fastraw.t files on exit
+
+ t/fastraw.t | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit 287ec94034786db4b86c6402423772f0c12db057
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 14 08:04:32 2010 -0400
+
+ Add $$ to randomize headerfile name
+
+ Some CPAN testers have reported problems with creating
+ the file which may be due to other instances of the
+ smoker being run.
+
+ t/fastraw.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 6b3b856fa96ccd8e41f784754402191abb70de1c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 14 08:03:53 2010 -0400
+
+ Add TODO notes in logo3d.pdl comments
+
+ Perldl2/logo3d.pdl | 10 ++++++++--
+ 1 files changed, 8 insertions(+), 2 deletions(-)
+
+commit 05abb2c89f6402695b6f450fc7bf9b9b9680bf3f
+Merge: ee4ae3d f46596f
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sun Sep 12 15:37:33 2010 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit f46596f6681e37b5000a6cc2e5aa99e523a732e9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 3 12:57:01 2010 -0400
+
+ Fix minor POD glitch in Graphics2D.pm
+
+ Graphics/Graphics2D.pm | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit c7cf78cc37dea525a18bae5406e3234f1151e593
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 3 12:44:17 2010 -0400
+
+ Changed PDL> to pdl> in pdl2 POD for consistency
+
+ Perldl2/Plugin/NiceSlice.pm | 8 ++++----
+ Perldl2/Plugin/PrintControl.pm | 10 +++++-----
+ Perldl2/pdl2 | 4 ++--
+ 3 files changed, 11 insertions(+), 11 deletions(-)
+
+commit 305563b12e96bd71fb6eb263707f4431bc73426d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 31 13:05:43 2010 -0400
+
+ Add win32 workaround for pdl2->perldl exec
+
+ Now win32 just exits pdl2 with a warning to run perldl
+ rather than trying the broken exec.
+
+ Perldl2/pdl2 | 8 ++++++--
+ 1 files changed, 6 insertions(+), 2 deletions(-)
+
+commit c092edacc1806a092c343e62a691e23d20f26b3a
+Merge: b50537d 6d0a15e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 31 10:05:20 2010 -0400
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 6d0a15eb742f460ef79345a219a801ce94d58829
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Aug 30 12:41:20 2010 -0400
+
+ Add pdl2->perldl win32 bug to Known_problems
+
+ On win32, you need to call perldl explicitly since win32
+ exec (i.e. fork) isn't equivalent to the unix exec in perl.
+
+ Known_problems | 12 +++++++++++-
+ 1 files changed, 11 insertions(+), 1 deletions(-)
+
+commit 57caff9d8b35555878f553120cabc06d4fa11154
+Author: sisyphus <sisyphus1 at optusnet.com.au>
+Date: Mon Aug 23 16:05:39 2010 +1000
+
+ Demos/Cartography_demo.pm - /xw replaced by /GW (MS Windows only)
+
+ There were 2 hardcoded occurrences of /xw that need to be
+ replaced with /GW for MS Windows. (There are still problems
+ with this demo as PGPLOT is apparently incapable of opening
+ a second grwnd.exe window - even if the first grwnd.exe
+ window has been closed.)
+
+ Demos/Cartography_demo.pm | 10 +++++++---
+ 1 files changed, 7 insertions(+), 3 deletions(-)
+
+commit d6a9f9af23a1cee6905a725a3b40b6bdabaee029
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun Aug 22 18:59:57 2010 +0200
+
+ fix 2 POD errors (=item outside =over..=back)
+
+ IO/FastRaw/FastRaw.pm | 6 ++++++
+ 1 files changed, 6 insertions(+), 0 deletions(-)
+
+commit ddd75e02ddd6c3d5c02221c6acc035dedf74e262
+Author: sisyphus <sisyphus1 at optusnet.com.au>
+Date: Sun Aug 22 21:18:27 2010 +1000
+
+ Demos/Transform_demo.pm - /xw replaced by /GW (MS Windows only)
+
+ There were 3 hardcoded occurrences of /xw that need to be
+ replaced with /GW for MS Windows. (There are still problems
+ with this demo as PGPLOT is apparently incapable of opening
+ a second grwnd.exe window - even if the first grwnd.exe
+ window has been closed.)
+
+ Demos/Transform_demo.pm | 8 +++++---
+ 1 files changed, 5 insertions(+), 3 deletions(-)
+
+commit b50537dda498b5b86d422247d6581072705a1057
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Aug 19 14:52:40 2010 -0400
+
+ Update Known_problems, etc for development
+
+ Fix references to $PDL::VERSION value and unset the
+ SKIP_KNOWN_PROBLEMS option in the perldl.conf. Now
+ that this is back to a development tree, we want
+ problems to show until fixed.
+
+ Known_problems | 2 +-
+ Release_Notes | 16 ++++++++++++++++
+ perldl.conf | 2 +-
+ 3 files changed, 18 insertions(+), 2 deletions(-)
+
+commit 0a882cbc5e0d02804e0e58d2be0e4ab7db19361d
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu Aug 19 14:05:30 2010 +0200
+
+ debian changelog from 2.4.7+dfsg-1 upload
+
+ debian/changelog | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 5867398315d3c245e059d78b308c9728a11dce6b
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu Aug 19 11:55:39 2010 +0200
+
+ sync old changelog entries with debian pkg
+
+ leave only the most recent version entry without +dfsg suffix
+
+ debian/changelog | 9 +++++----
+ 1 files changed, 5 insertions(+), 4 deletions(-)
+
+commit e8be4ad4a8a0382f4d130142390e6b2c41c06728
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu Aug 19 11:49:52 2010 +0200
+
+ force-set locale to C during the test suite runs
+
+ debian/rules | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit cfbb93ee5e89c787557c11d01082c8e0896586e9
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu Aug 19 11:38:13 2010 +0200
+
+ change testsuite running logic
+
+ - make one non-verbose and one verbose run
+ - mark both runs with begin/end block statements
+ - filter 'make test' output with debian/filter-test.pl
+
+ debian/rules | 7 ++++++-
+ 1 files changed, 6 insertions(+), 1 deletions(-)
+
+commit 0cdf9334b96e902112bef164ca08f04df8e26732
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu Aug 19 10:17:11 2010 +0200
+
+ script filtering relevant parts of test suite runs
+
+ debian/filter-test.pl | 23 +++++++++++++++++++++++
+ 1 files changed, 23 insertions(+), 0 deletions(-)
+
+commit 6ef22feb99ff24234aa3625fe10d8de11a978e73
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu Aug 19 10:16:22 2010 +0200
+
+ unexport DISPLAY in debian/rules
+
+ debian/rules | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 199f87dc2106bddeec2af8e075754b817b6da4f4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Aug 18 21:39:24 2010 -0400
+
+ Modify some files so the CPAN indexer doesn't barf
+
+ There is no easy way to tell the CPAN indexer not to index
+ a package in a distribution. Supposedly, if you split the
+ offending package declaration across 2 lines then the indexer
+ will not index it and thus no warning.
+
+ Basic/Gen/Inline/MakePdlppInstallable.pm | 4 +++-
+ Graphics/TriD/TriD/VRML.pm | 4 +++-
+ 2 files changed, 6 insertions(+), 2 deletions(-)
+
+commit 59dbbd4bf474af1e9aaf48bb575b43ea7e90e4fc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Aug 18 20:57:09 2010 -0400
+
+ Update VERSION to 2.4.7_001 for new development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit fcec32c20bf203239500507672c0c82ab9b95369
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Aug 18 20:55:52 2010 -0400
+
+ Final pre-PDL-2.4.7 edits...
+
+ Basic/PDL.pm | 2 +-
+ Release_Notes | 48 ++++++++++++++++++++++++--
+ TODO | 106 ++++++++++++++++++++++++++-----------------------------
+ cygwin/INSTALL | 27 ++++++++------
+ 4 files changed, 111 insertions(+), 72 deletions(-)
+
+commit 6155d20969a9307ae234e71efa87377d58d400b8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Aug 18 17:48:01 2010 -0400
+
+ Add INSTALL note re bad system clock prob w make
+
+ Per list discussion, it may make sense to bulletproof
+ the Makefile.PL against this issue in future releases.
+
+ INSTALL | 13 +++++++++++++
+ 1 files changed, 13 insertions(+), 0 deletions(-)
+
+commit 55f1a7f0cf09355e9c4b6ee500681526e908ffe6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Aug 18 14:45:01 2010 -0400
+
+ Turn off use of uuencode/decode for win32 Dumper
+
+ There have been some bug reports from win32 systems where
+ the t/dumper.t test fails because of a uuencode or uudecode
+ error. Since uuencode/uudecode are not available on win32,
+ we force use of Convert::UU.
+
+ IO/Dumper.pm | 4 +++-
+ 1 files changed, 3 insertions(+), 1 deletions(-)
+
+commit 28d24a6cffd148ae1372686b08aad3e24e6ce8db
+Author: Henning Glawe <glaweh at debian.org>
+Date: Wed Aug 18 10:59:57 2010 +0200
+
+ disable EU::MM prompts during debian package build
+
+ debian/rules | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 209d168cb8e8d299287afabd9da9b8b317c69852
+Author: Henning Glawe <glaweh at debian.org>
+Date: Wed Aug 18 10:51:55 2010 +0200
+
+ git-ignore vim temp files
+
+ .gitignore | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit cfb18501d7686019db209542b8a166fcc3f3018a
+Author: Henning Glawe <glaweh at debian.org>
+Date: Wed Aug 18 10:50:13 2010 +0200
+
+ add more debian pkg tempfile to .gitignore
+
+ .gitignore | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit 034d2a5948bd7c1651b380f079e7fcab0fc11066
+Author: Henning Glawe <glaweh at debian.org>
+Date: Wed Aug 18 10:47:19 2010 +0200
+
+ bump debian pkg version to pre3
+
+ debian/changelog | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 4eb2760b6dc58c0b9eceaa741c8955e801544ea1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 17 20:46:07 2010 -0400
+
+ Fix some legacy problems with old X11 TriD code
+
+ This is the last time...
+
+ Graphics/TriD/OpenGL/opengl.pd | 9 ++++++---
+ 1 files changed, 6 insertions(+), 3 deletions(-)
+
+commit 5d195653122f1bf36cb6237117abf1a295fa26f8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 17 14:23:42 2010 -0400
+
+ Update FAQ and Makefile.PL docs for 2.4.7 release
+
+ Basic/Pod/FAQ.pod | 363 +++++++++++++++--------------------------------------
+ Makefile.PL | 8 +-
+ 2 files changed, 103 insertions(+), 268 deletions(-)
+
+commit 9ac17378d3c6a38b8c7110d9389364b3dfc4a165
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 17 12:16:46 2010 -0400
+
+ Fix imag2d/twiddle export from PDL::Graphics2D
+
+ And more various doc updates for coming PDL-2.4.7...
+
+ Graphics/Graphics2D.pm | 50 +++++++++++++++++-------------
+ Graphics/TriD/TriD.pm | 4 +-
+ Perldl2/README | 8 ++++-
+ Perldl2/TODO | 12 ++++----
+ TODO | 78 ++++++++++++++++++++++++------------------------
+ 5 files changed, 82 insertions(+), 70 deletions(-)
+
+commit 42bf9d6808f4389ee771b3746ff1162041d6aed2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Aug 16 15:49:58 2010 -0400
+
+ Doc/POD/word-smithing for the PDL-2.4.7 release
+
+ This look to be stable as far as surprise bug reports
+ from PDL-2.4.7_pre2 testing. I anticipate that the
+ PDL-2.4.7_pre3 may not really be necessary. These
+ updates are getting ready for the real PDL-2.4.7 release.
+
+ BUGS | 2 +-
+ DEPENDENCIES | 14 ++--
+ DEVELOPMENT | 2 +-
+ INSTALL | 61 +++++++----------
+ IO/ENVI/readenvi.pdl | 8 +-
+ Known_problems | 2 +-
+ Perldl2/Plugin/NiceSlice.pm | 22 +++---
+ Perldl2/Plugin/PDLCommands.pm | 6 +-
+ Perldl2/Plugin/PrintControl.pm | 16 ++--
+ Perldl2/Profile/Perldl2.pm | 8 +-
+ Perldl2/TODO | 10 ++-
+ Release_Notes | 38 ++++++++----
+ cygwin/INSTALL | 38 +++++------
+ perldl.PL | 139 ++++++++++++++++++++--------------------
+ 14 files changed, 184 insertions(+), 182 deletions(-)
+
+commit 0e8ad23faae3cc806d8ac751286bce9fd076e6a9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Aug 16 14:20:59 2010 -0400
+
+ Fix leading white space in imag2d() POD
+
+ The leading white spaces were missing on some "empty" lines
+ which split up the examples and usage into many separate
+ (ugly) boxes in the online version of the docs.
+
+ Graphics/Graphics2D.pm | 21 ++++++++++-----------
+ 1 files changed, 10 insertions(+), 11 deletions(-)
+
+commit 8fe01ca4307480982b51b0cb47751d477fa94f30
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon Aug 16 09:10:04 2010 +0200
+
+ update debian changelog
+
+ debian/changelog | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 2c9c4270e8bb521ead4174d49a5a284c8e554e6b
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon Aug 16 09:08:31 2010 +0200
+
+ add symlink for manpages
+
+ debian/pdl.links | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 1d8083ea03ec8f242762691d20dd2b46bbedbe24
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun Aug 15 23:30:33 2010 +0200
+
+ update debian Standards-Version
+
+ debian/control | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit bdbd9fe7e48244dc8782ac3d466d347ea75d77d0
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun Aug 15 21:49:45 2010 +0200
+
+ minor debian changelog updates
+
+ debian/changelog | 4 +++-
+ 1 files changed, 3 insertions(+), 1 deletions(-)
+
+commit 7d7cdd2cd9e8c6479e15289a76d8d187892e2bef
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 15 21:48:21 2010 -0400
+
+ Fix missing term in ~ expansion test t/autoload.t
+
+ t/autoload.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit b24825a07afe245d40930fc98608819702927a2b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 15 20:12:06 2010 -0400
+
+ Update VERSION to 2.4.6_993 for final fixes
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ 2 files changed, 2 insertions(+), 2 deletions(-)
+
+commit ca3daaa3c0b94b5561b37ec4782cb88487667855
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 15 19:54:30 2010 -0400
+
+ Update readme-type files for pre2 release
+
+ DEPENDENCIES | 12 ++++++------
+ Known_problems | 2 +-
+ MANIFEST | 1 +
+ Perldl2/README | 23 ++++++++++++-----------
+ Release_Notes | 31 +++++++++++++++++++++++--------
+ 5 files changed, 43 insertions(+), 26 deletions(-)
+
+commit eca3468166b4f0a1b6ec2118ce4eb869eca6eb03
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 15 19:32:55 2010 -0400
+
+ Fix .perldlrc double require bug in perldl
+
+ There was a problem where running 'perl perldl' after building
+ PDL from the source directory would only give you plain perl.
+ The code should have been retrying with 'use blib' so things
+ should have worked since 'perl -Mblib perldl' does work.
+
+ The subtlety was that require caches the names of files that
+ it fails to load in %INC as well as ones that work. To attempt
+ again, you have to delete the previously created hash entry.
+
+ Also updated version for next pre-release and some documenting
+ comments in perldl.conf
+
+ Basic/PDL.pm | 2 +-
+ perldl.PL | 1 +
+ perldl.conf | 5 +++++
+ 3 files changed, 7 insertions(+), 1 deletions(-)
+
+commit 9c668ea42a299564bb70d13aaf1d463443d6738a
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun Aug 15 19:44:45 2010 +0200
+
+ build-depend and suggest libdevel-repl-perl
+
+ debian/control | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit b05cfe6e3e4852254fc97daffb51274d207c963c
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun Aug 15 19:43:47 2010 +0200
+
+ install Changes file only if available
+
+ debian/rules | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 44ea474c9f333f29bf8d9574e1b688f3eab835a5
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sun Aug 15 17:26:56 2010 +0200
+
+ Add PROJ.4 error to "common problems".
+
+ INSTALL | 37 +++++++++++++++++++++++++++++++++++++
+ 1 files changed, 37 insertions(+), 0 deletions(-)
+
+commit 6e754737d3f6ec48b8d915f4c8a2cea077291e00
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 15 10:37:19 2010 -0400
+
+ Fix pdl2 to run perldl if TR::Stub is used
+
+ Devel::REPL is not safe against use of the minimal Term::ReadLine::Stub
+ support in the perl distributions. This works around that limitation
+ until the fixes can be made upstread in the Devel::REPL module.
+
+ Perldl2/Profile/Perldl2.pm | 121 ++++++++++++++++++++++++--------------------
+ 1 files changed, 66 insertions(+), 55 deletions(-)
+
+commit 0fcfd0e38f0562f4cf8c9c46e7d3f91919b81290
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun Aug 15 14:21:23 2010 +0200
+
+ gitignore files specific to debian package build
+
+ .gitignore | 8 ++++++++
+ 1 files changed, 8 insertions(+), 0 deletions(-)
+
+commit 782ba47c6124dca1f24246640f3654a4724ddfb6
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun Aug 15 12:39:34 2010 +0200
+
+ don't set repacked version in upstream git
+
+ debian/changelog | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit a10f5284c856d5c80fd474f483f2a2b8b2ab7647
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun Aug 15 12:33:31 2010 +0200
+
+ start work on new pdl package
+
+ debian/changelog | 9 +++++++++
+ 1 files changed, 9 insertions(+), 0 deletions(-)
+
+commit a0c1aa51e383e3a0574957fe5a31ba4c3a02403b
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun Aug 15 12:33:06 2010 +0200
+
+ suggest proj-bin in binary package
+
+ debian/control | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit ab3743cb769817f609b62f507f61424cae6e2339
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun Aug 15 12:07:38 2010 +0200
+
+ update debian/changelog from my last upload
+
+ debian/changelog | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 76a30064e4d0d9fbab98ae7ccac9d8b0554523d0
+Author: sisyphus <sisyphus1 at optusnet.com.au>
+Date: Sun Aug 15 12:48:24 2010 +1000
+
+ t/proj_transform.t - skip all if no jpegtopnm
+
+ This test script needs the jpegtopnm utility
+ and should be skipped if that utility can't
+ be found - which is what now happens.
+
+ t/proj_transform.t | 39 ++++++++++++++++++++++++---------------
+ 1 files changed, 24 insertions(+), 15 deletions(-)
+
+commit 4f57cb1dea7bd8ef1452435ccb3d24c9107b1cde
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sat Aug 14 15:51:48 2010 +0200
+
+ Update release notes with the lastest changes to documentation.
+
+ Release_Notes | 19 +++++++++++++------
+ 1 files changed, 13 insertions(+), 6 deletions(-)
+
+commit 1b44f2ceec0d69ab8d429ed4b6a97325923ae415
+Merge: a6c0fe6 3bd74f8
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sat Aug 14 15:24:00 2010 +0200
+
+ Merge latest documentation changes with master.
+
+commit a6c0fe6cc3bedee11c7cad7b1811d7b87f0b63ee
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sat Aug 14 15:21:53 2010 +0200
+
+ Add threading tutorial to PDL::Tutorials.
+
+ Basic/Pod/Tutorials.pod | 12 ++++++++++++
+ 1 files changed, 12 insertions(+), 0 deletions(-)
+
+commit 1787a9e5e3a989f85917613f7ca19861279a11f2
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sat Aug 14 15:21:36 2010 +0200
+
+ Add spaces to delineate code blocks correctly.
+
+ Basic/Pod/Threading.pod | 22 +++++++++++-----------
+ 1 files changed, 11 insertions(+), 11 deletions(-)
+
+commit 3bd74f8fc1e1f95a9c4c239f024824d509088c00
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 14 09:19:37 2010 -0400
+
+ Final file fixes before release
+
+ NOTE: perldl.conf SKIP_KNOWN_PROBLEMS option is set
+ for official releases so that test cases entered for
+ unresolved problem tickets do not generate unexpected
+ distribution FAILs. Be sure to change this back for
+ git development so tests will indicate actual status.
+
+ IO/ENVI/readenvi.pdl | 4 ++--
+ MANIFEST | 4 +---
+ TODO | 13 ++++++-------
+ perldl.conf | 2 +-
+ 4 files changed, 10 insertions(+), 13 deletions(-)
+
+commit 4ef39f7950d88656de6145e6916b77d10d6d2ebe
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 14 09:11:09 2010 -0400
+
+ Move imag2d() into Graphics2D and update TODO
+
+ Graphics/Graphics2D.pm | 787 +++++++++++++++++++++++++++++++++++++++++++++++-
+ TODO | 12 +-
+ imag2d.pdl | 787 ------------------------------------------------
+ 3 files changed, 792 insertions(+), 794 deletions(-)
+
+commit 59e5f8f3004704c013fd0a4182f50bd76dbc66c1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 13 20:29:07 2010 -0400
+
+ Add pdl2 docs re filter leading prompt string
+
+ This allows for easier cut-and-paste of PDL shell sessions
+ as examples or demo code into another session. Not supported
+ by perldl at the moment.
+
+ Graphics/TriD/TriD/GL.pm | 2 +-
+ Perldl2/pdl2 | 12 ++++++++++--
+ 2 files changed, 11 insertions(+), 3 deletions(-)
+
+commit 95d13842030ddb488cc32f081205a513d9df64c1
+Merge: 9d13be7 0833506
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 13 20:07:49 2010 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 9d13be76547c2f350b6c779efe1e3f7da882dd02
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 13 20:06:08 2010 -0400
+
+ Add filter for leading 'pdl>' to pdl2 commands
+
+ This allows for convenient cut-and-paste of output from a PDL
+ shell session as input to another session (e.g., for tutorials
+ and other example code).
+
+ Perldl2/Plugin/PDLCommands.pm | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit e853424e6f22b8ca9697fa856aed3302d54186f3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 13 20:05:35 2010 -0400
+
+ Document spheres3d as a preliminary implementation
+
+ Graphics/TriD/TriD.pm | 11 ++++++-----
+ 1 files changed, 6 insertions(+), 5 deletions(-)
+
+commit 0833506d056417f267c1fc16ae615ec4e2c79adf
+Merge: aabc2a7 e26d3f1
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sat Aug 14 01:43:42 2010 +0200
+
+ Merge my recent changes with master.
+
+commit aabc2a7b65ccdea85c1b8046929737376cd6cd24
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sat Aug 14 01:40:01 2010 +0200
+
+ Fix a lot of spelling mistakes and typos.
+
+ Basic/Pod/API.pod | 4 +-
+ Basic/Pod/BadValues.pod | 68 ++++++++++++++--------------
+ Basic/Pod/Course.pod | 16 +++---
+ Basic/Pod/Dataflow.pod | 8 ++--
+ Basic/Pod/Delta.pod | 4 +-
+ Basic/Pod/FAQ.pod | 46 ++++++++++----------
+ Basic/Pod/Indexing.pod | 108 +++++++++++++++++++++++-----------------------
+ Basic/Pod/Internals.pod | 22 +++++-----
+ Basic/Pod/MATLAB.pod | 10 ++--
+ Basic/Pod/Objects.pod | 10 ++--
+ Basic/Pod/PP.pod | 90 +++++++++++++++++++-------------------
+ Basic/Pod/Philosophy.pod | 12 +++---
+ Basic/Pod/QuickStart.pod | 66 ++++++++++++++--------------
+ Basic/Pod/Scilab.pod | 8 ++--
+ Basic/Pod/Threading.pod | 6 +-
+ Basic/Pod/Tips.pod | 9 ++--
+ Basic/Pod/Tutorials.pod | 4 +-
+ 17 files changed, 246 insertions(+), 245 deletions(-)
+
+commit 32f45cda0db9c0e232435c5cd33bd3fd39360287
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sat Aug 14 01:13:53 2010 +0200
+
+ Fix broken link.
+
+ Basic/Pod/Tutorials.pod | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit e26d3f1a64c9b8676b8216da6c14b95d197b09ab
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 13 18:19:54 2010 -0400
+
+ Update Perldl2 README and TODO with demo fix info
+
+ Perldl2/README | 27 ++++++++++++---------------
+ Perldl2/TODO | 13 +------------
+ TODO | 50 +++++++++++++++++++++++++-------------------------
+ 3 files changed, 38 insertions(+), 52 deletions(-)
+
+commit de95d69cf87f80d1f093ed21d4e78193826ddc7e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 13 17:53:22 2010 -0400
+
+ Fix Demos/Screen.pm to work with pdl2 or perldl
+
+ Demos/Screen.pm | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 36a655afdb9868f7645b3dfbdc122c23ed5fcfb5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 13 15:49:50 2010 -0400
+
+ Added draft Release_Notes for 2.4.7
+
+ Release_Notes | 209 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
+ 1 files changed, 208 insertions(+), 1 deletions(-)
+
+commit 658c5807cb9a73c8ffaa4f76f2eaffc7a4708ef4
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 21:29:54 2010 +0200
+
+ Fix 3 typos and change one link.
+
+ INSTALL | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 65e61fb4383f8ef7b8c81daad4fa3f2b60297c38
+Merge: 1b8c7f5 0e2bcaa
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 21:17:00 2010 +0200
+
+ Merge my latest changes with master.
+
+commit 1b8c7f57d39cb6526163770acc956c8f1cf2c6d2
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 21:11:39 2010 +0200
+
+ Typo: broken link.
+
+ Basic/Pod/Modules.pod | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 0e2bcaa66e8cea2e36283ea8f84e13612059268f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 13 13:49:25 2010 -0400
+
+ Fix t/autoload.t test problem when no shell ~
+
+ The test was using the old check as a fallback which
+ breaks in the event of ~ expansion not being enabled in
+ the shell used by qx{}. This updates it to the code
+ used by bash.
+
+ t/autoload.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 76395d5e5d24abbd66a5b85f87028c66ffe63041
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 19:03:04 2010 +0200
+
+ Add Modules.pod to manifest.
+
+ MANIFEST | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 89b57d19fd1ed614943a8127006459f12fff6be1
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 18:26:10 2010 +0200
+
+ Minor edit - shorten one title.
+
+ Basic/Pod/Modules.pod | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit e889192e3a28ce3a7b2964bb02170a4672ef4ab2
+Merge: ecfc596 bf50b41
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 17:13:04 2010 +0200
+
+ Merge my changes with master.
+
+commit ecfc59623e3c4a7b641697c6ee8b655e44e59568
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 17:09:43 2010 +0200
+
+ Add a guidance for PDL reference documentation.
+
+ Basic/PDL.pm | 21 ++
+ Basic/Pod/Modules.pod | 482 +++++++++++++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 503 insertions(+), 0 deletions(-)
+
+commit bf50b41f70d0dafdbdfecf925a806c3745e08620
+Merge: 62eae7e eb48bab
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 13 09:35:47 2010 -0400
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 62eae7e5d3643b3605c4eb48ff9ede366ce6b96f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 13 09:35:00 2010 -0400
+
+ Update VERSION and readme for pre-release
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 18 +++++-----
+ Release_Notes | 9 ++---
+ cygwin/INSTALL | 17 +++++----
+ cygwin/README | 14 +++----
+ win32/INSTALL | 106 ++++++++++++++++++++++++++++++++------------------------
+ 6 files changed, 91 insertions(+), 75 deletions(-)
+
+commit eb48babef733cf84de33469397ec0fe5e83bfda2
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 14:57:47 2010 +0200
+
+ Significantly improve the Tutorials page (more links, better explanations).
+
+ Basic/Pod/Tutorials.pod | 67 ++++++++++++++++++++++++++++++++++++++++------
+ 1 files changed, 58 insertions(+), 9 deletions(-)
+
+commit ec79ed635a43cb6bcfd02b0109cfe066723571ee
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 12:49:37 2010 +0200
+
+ Make FAQ more platform-agnostic by refering to "perldoc" instead of "man".
+
+ Basic/Pod/FAQ.pod | 34 ++++++++++++----------------------
+ 1 files changed, 12 insertions(+), 22 deletions(-)
+
+commit f3d023a6f793a1c1197391f14a38799d6b1f571f
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 12:44:47 2010 +0200
+
+ Present PDL::Guide as a PDL course and add it to the PDL pod page.
+
+ --HG--
+ rename : Basic/Pod/Guide.pod => Basic/Pod/Course.pod
+
+ Basic/PDL.pm | 5 +
+ Basic/Pod/Course.pod | 492 ++++++++++++++++++++++++++++++++++++++++++++++++
+ Basic/Pod/Guide.pod | 507 --------------------------------------------------
+ MANIFEST | 2 +-
+ 4 files changed, 498 insertions(+), 508 deletions(-)
+
+commit fca8547e64da376af0e234d700b155ce208464fd
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 12:41:20 2010 +0200
+
+ Delete Intro.pod and introduce Tutorials.pod in its place.
+
+ Basic/PDL.pm | 23 ++++++----
+ Basic/Pod/FAQ.pod | 3 +-
+ Basic/Pod/Intro.pod | 106 -----------------------------------------------
+ Basic/Pod/Makefile.PL | 1 -
+ Basic/Pod/Tutorials.pod | 70 +++++++++++++++++++++++++++++++
+ Doc/Doc/Perldl.pm | 6 +-
+ MANIFEST | 2 +-
+ 7 files changed, 88 insertions(+), 123 deletions(-)
+
+commit 5bc80dc491f91254889f39f27cb33e3b060e5ed3
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 02:26:20 2010 +0200
+
+ Fix link to QuickStart.
+
+ README | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 998656aacc7694378ca3e7b220a1e94392a0115b
+Merge: 105239f 1d98566
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri Aug 13 02:23:23 2010 +0200
+
+ Merge my last changes with the master branch.
+
+commit 1d98566fcc93b88c8f0301077a4a6da372e77747
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Aug 12 10:39:02 2010 -0400
+
+ Add macosx directory for platform specific info
+
+ README | 4 ++++
+ macosx/README | 7 +++++++
+ 2 files changed, 11 insertions(+), 0 deletions(-)
+
+commit 4fdd735b747d9e277d7329849845e9cc94b7c5b6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Aug 12 10:35:07 2010 -0400
+
+ Update README and perldl.conf for 2.4.7...
+
+ README | 45 +++++++++++------------
+ perldl.conf | 114 ++++++++++++++++++++++++++++++++---------------------------
+ 2 files changed, 84 insertions(+), 75 deletions(-)
+
+commit da6bbbfbf50f140b78e2c79074f590a6d7a28c60
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Aug 12 09:54:52 2010 -0400
+
+ More readme-type file updates for 2.4.7
+
+ BUGS | 24 ++++++-----
+ INSTALL | 130 ++++++++++++++++++++++++++++++++-----------------------
+ Known_problems | 8 +---
+ README | 13 +++---
+ 4 files changed, 96 insertions(+), 79 deletions(-)
+
+commit fdc58176e643548eec64b2d7cd107e523ba94ef6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Aug 12 09:12:06 2010 -0400
+
+ make dist now builds Changes before distdir
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 326935d6d7f89a827708d7fa2d65d6966e73a4ae
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 10 18:19:44 2010 -0400
+
+ Update Known_problems and others for 2.4.7
+
+ Known_problems | 7 +++++++
+ README | 2 +-
+ TODO | 34 +++++++++++++++++-----------------
+ 3 files changed, 25 insertions(+), 18 deletions(-)
+
+commit 4a4905e8a40f5836de95a6fe826f26432e96c966
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 10 16:40:49 2010 -0400
+
+ Add Known_problems skip to t/dumper.t
+
+ This allows the release tests to skip the mysterious failure
+ which occurs for various BSD platforms. It is hoped the problem
+ will be solved if we can get a system to reproduce the problem
+ and developer access.
+
+ t/dumper.t | 113 ++++++++++++++++++++++++++++++++---------------------------
+ 1 files changed, 61 insertions(+), 52 deletions(-)
+
+commit aabe91cad678535ba821255e8c463168f981c797
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 10 16:24:54 2010 -0400
+
+ Fix uuencode/uudecode detection logic
+
+ IO/Dumper.pm was not checking for both uuencode and uudecode
+ which meant sometimes things broke when it was not needed,
+ now that Convert::UU is a PDL dependency.
+
+ IO/Dumper.pm | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 105239ff505830cbf8fe36a25aad84a3abcf2f62
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Tue Aug 10 19:37:54 2010 +0200
+
+ Update descripton of PDL::Indexing.
+
+ Basic/Pod/Indexing.pod | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f9a39dafebdf4293bcb7e06cd1239fd005e0b428
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Tue Aug 10 19:34:02 2010 +0200
+
+ Show the correct path for the modules that were going to be in the "book".
+
+ Basic/Pod/FAQ.pod | 4 ++--
+ Basic/Pod/Indexing.pod | 2 +-
+ Basic/Pod/MATLAB.pod | 2 +-
+ Basic/Pod/Philosophy.pod | 2 +-
+ Basic/Pod/QuickStart.pod | 2 +-
+ Basic/Pod/Scilab.pod | 2 +-
+ Basic/Pod/Threading.pod | 2 +-
+ Basic/Pod/Tips.pod | 2 +-
+ 8 files changed, 9 insertions(+), 9 deletions(-)
+
+commit 2b96acab56eebcc05c988c6606e3fb6e3da5e705
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Tue Aug 10 19:06:44 2010 +0200
+
+ Work on a PDL book is postponed for now. I want to just get a series of
+ tutorials finished and organized first.
+
+ Basic/Pod/make-book.pl | 175 ------------------------------------------------
+ Basic/Pod/pdl-book.css | 8 --
+ 2 files changed, 0 insertions(+), 183 deletions(-)
+
+commit 543bf22c80abedc8bb5ada96c29bf9f5cc9aada4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 10 07:26:49 2010 -0400
+
+ Update PDL/TODO with latest info
+
+ TODO | 30 +++++++++++++-----------------
+ 1 files changed, 13 insertions(+), 17 deletions(-)
+
+commit bfd9268bb4c6e07e120acaa6ddc56fff4a8aa946
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Aug 9 21:01:55 2010 -0400
+
+ Update Known_problems with t/dumper.t bug
+
+ ...and some minor edits to README for the upcoming release.
+
+ Known_problems | 4 ++--
+ README | 19 ++++++++++---------
+ 2 files changed, 12 insertions(+), 11 deletions(-)
+
+commit 75c903f9258bf30f028053a1b34a34da915c7715
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 8 21:56:27 2010 -0400
+
+ Add explicit test count for older Test::More
+
+ t/config.t | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 74642a5e5013d8da1e922ef7e4f089cc29e1bf1d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 8 11:06:31 2010 -0400
+
+ Update VERSION to 2.4.6_019 for development
+
+ This follows another very minor release to CPAN to
+ try to verify a fix for the t/dumper.t failures for
+ some *bsd systems.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 15 +++++++++++++++
+ 3 files changed, 17 insertions(+), 2 deletions(-)
+
+commit cab029b9e0be756c6b578d0f4dabc43914e6cfc5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 8 10:46:55 2010 -0400
+
+ Fix regex for IO/Dumper.pm fix (take 2)
+
+ IO/Dumper.pm | 2 +-
+ Release_Notes | 4 +++-
+ 2 files changed, 4 insertions(+), 2 deletions(-)
+
+commit 7d399b423cd0e9eddb5b530a521d675e9f32337c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 7 23:53:50 2010 -0400
+
+ Update Known_problems after CPAN devel release
+
+ Known_problems | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 0168aee10028f6d536664fa7644eaef4cca1735c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 7 23:52:36 2010 -0400
+
+ Update VERSION to 2.4.6_018 for more development
+
+ This follows a very minimal new CPAN developers release
+ to test a single fix for a mysterious, long-time, difficult
+ to reproduce failure in t/dumper.t.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 2 +-
+ Release_Notes | 19 ++++++++++++++++++-
+ 3 files changed, 20 insertions(+), 3 deletions(-)
+
+commit d0b49090ac10e8c6997a9ad7a220e7ed24bf42a0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Aug 7 23:31:26 2010 -0400
+
+ Possible fix to PDL::IO::Dumper failures
+
+ There have been CPAN tester failures from t/dumper.t where the
+ problem was scalar piddles werer being dumped as the value of the
+ memory location *but* as a signed integer. That resulted in a
+ synthesized variable named '$PDL-12345', for example, which is
+ not valid perl. The problem appears to be some implicit stringify
+ to decimal in IO/Dumper.pm. I think that has been fixed by using
+ sprintf and %u formats.
+
+ IO/Dumper.pm | 4 ++--
+ Release_Notes | 15 +++++++++++++++
+ 2 files changed, 17 insertions(+), 2 deletions(-)
+
+commit 3e0c7dc67eb2055bc310884b1acadd0cf0401140
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 6 22:37:58 2010 -0400
+
+ Update PDL/TODO with progress made so far
+
+ TODO | 22 +++++++++++-----------
+ 1 files changed, 11 insertions(+), 11 deletions(-)
+
+commit 5a6465701878aa5e6df1336fd2aa76b8957cb44c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 6 17:02:00 2010 -0400
+
+ Update VERISON to 2.4.6_017 for more development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit def42c7624d0eb2210c6208ac7aa352371dfc5d5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 6 16:28:10 2010 -0400
+
+ Update Release_Notes for 2.4.6_016 release to CPAN
+
+ Release_Notes | 12 +++++++++++-
+ 1 files changed, 11 insertions(+), 1 deletions(-)
+
+commit df715150381b8c289cb06133df5a33cc66230222
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 6 16:18:32 2010 -0400
+
+ Fix spheres3d to use GL_SMOOTH shading...
+
+ So the result looks more sphere-like. Next need to add
+ control of color and radius. It would be useful to allow
+ for more light sources for TriD geometries. Even an
+ ambient light of some amount would help things from
+ disappearing in shadows.
+
+ Graphics/TriD/TriD/GL.pm | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 234bd400bb0c41e4c1398f67e9f92285369539f8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Aug 6 15:05:44 2010 -0400
+
+ Don't set OpenGL as a PREREQ_PM unless version ok
+
+ This should fix a problem where a cpan build of PDL on a
+ system with an inadequate install of OpenGL would still
+ fail because of the missing dependency---even though we
+ had already decided that it wasn't going to work and so
+ should not be a dependency in this case.
+
+ Makefile.PL | 5 ++++-
+ 1 files changed, 4 insertions(+), 1 deletions(-)
+
+commit fd356ccbfd330615d31767377a363305c088ffcf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Aug 5 17:32:50 2010 -0400
+
+ Add detect previous PDL installs for build
+
+ This was sf.net feature request #2805194, "detect multiple PDL
+ installs on build". The problem was that multiple PDLs in the
+ @INC path sometimes resulted in very mysterious test failures.
+ This was especially when the new PDL was built with different
+ perldl.conf options from the previous install.
+
+ Known_problems | 12 ++++++++----
+ Makefile.PL | 13 +++++++++++++
+ Release_Notes | 9 ++++++++-
+ 3 files changed, 29 insertions(+), 5 deletions(-)
+
+commit 66955d40b2ad2937e6cb2fe4b6eb703312d43311
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Aug 5 14:40:18 2010 -0400
+
+ Fix PDL::AutoLoader to handle win32 PDLLIB env
+
+ The separator is ; rather than :. Also was some cleanup
+ of the logic in general fixing some minor inconsistencies.
+ Please report any issues with PDLLIB env expansions. Need
+ to add tests.
+
+ Basic/AutoLoader.pm | 18 ++++++++++++++----
+ 1 files changed, 14 insertions(+), 4 deletions(-)
+
+commit 0a88792df08d6ccfeab1a3cb63b43ff487ab2158
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Aug 5 09:54:25 2010 -0400
+
+ Update PDL/TODO for PDL-2.4.7 release
+
+ TODO | 333 ++++++++++++++++++++++++++++++------------------------------------
+ 1 files changed, 152 insertions(+), 181 deletions(-)
+
+commit 49c4ad93224b83deb4e4dcbb5f6977e14ae99e32
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Aug 4 17:54:46 2010 -0400
+
+ Re-prioritize Perldl2/TODO list for 2.4.7
+
+ Perldl2/TODO | 165 ++++++++++++++++++++++++++++++++++------------------------
+ 1 files changed, 96 insertions(+), 69 deletions(-)
+
+commit 603313a76c30d36b7a5930429a137a9d14c6fdd1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Aug 3 11:09:02 2010 -0400
+
+ Update DEPENDENCIES re HDF and others
+
+ A clean up pass through the dependency file for the
+ purpose of the coming PDL-2.4.7 release.
+
+ DEPENDENCIES | 339 +++++++++++++++++++++++++++++++++-------------------------
+ 1 files changed, 192 insertions(+), 147 deletions(-)
+
+commit b42a113942895be9411c98a64ca739affef9a467
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Aug 1 15:04:07 2010 -0400
+
+ Add PDL::Config to 'use PDL' modules to load
+
+ I don't know if it makes sense to have this for PDL::Lite
+ or PDL::LiteF but having it pulled in my 'use PDL' will
+ make PDL run time decisions and documentation of configuration
+ information simpler and more transparent.
+
+ Basic/PDL.pm | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit ebd3828005c7d43d388d5ae466f449faea41ea8f
+Author: sisyphus <sisyphus1 at optusnet.com.au>
+Date: Sun Aug 1 19:59:53 2010 +1000
+
+ win32/INSTALL Update Win32 install notes.
+
+ win32/INSTALL | 108 +++++++++++++++-----------------------------------------
+ 1 files changed, 29 insertions(+), 79 deletions(-)
+
+commit ee4ae3db83a2c58a353162518bc627d298bd9620
+Merge: 24e935e 0a1aa5b
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sun Aug 1 02:41:48 2010 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 24e935e8af5f77254bef8ad1f9eb028acc8e8789
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sun Aug 1 02:36:49 2010 -0600
+
+ Finally, a fix to the pdl permissive-constructor bug. Two separate problems:
+ * an off-by-one error in indexing the dim list of the target led to
+ indexing the -1 element of the dim list in certain cases; this generally
+ caused heisenbugs by forcing the null padding loop to wander off into
+ hyperspace;
+ * Most of the time av_fetch returns a valid element; sometimes it
+ returns a pointer to 0, and sometimes it returns 0. We were always
+ dereferencing it, so in the rare cases where it returned 0 we were
+ throwing a bus error.
+
+ Tests:
+
+ The multiple-PDLs-in-a-list bug:
+ $c[0][0] = pdl([1]);
+ $c[1][0] = pdl([2]);
+ $d = pdl(@c);
+
+ The unrelated crash-on-undef-first-element bug:
+ $c[0][0] = pdl([1]);
+ $c[1][0] = pdl([2]);
+ $c[2][2] = 5;
+
+ Basic/Core/pdlcore.c.PL | 59 ++++++++++++++++++++++++++++++----------------
+ 1 files changed, 38 insertions(+), 21 deletions(-)
+
+commit 0a1aa5bbbeeb3e77d7d17d0ba3297e2da5a16eff
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 31 15:12:41 2010 -0400
+
+ Update version and Release_Notes for development
+
+ Basic/PDL.pm | 2 +-
+ Release_Notes | 15 +++++++++++++++
+ 2 files changed, 16 insertions(+), 1 deletions(-)
+
+commit 8fead1083be70fdfb2e2ffff153bea3c6454617a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 31 14:44:03 2010 -0400
+
+ Fix test problems for CPAN devel release
+
+ Several tests were using %PDL::Config values but not
+ use-ing the PDL::Config module. The SKIP_KNOWN_PROBLEMS
+ logic had a bug in t/constructor.t. Also updated the
+ DEPENDENCIES and MANIFEST info for the new release.
+
+ DEPENDENCIES | 26 ++++++++++++--------------
+ MANIFEST | 8 +++++---
+ t/complex.t | 1 +
+ t/constructor.t | 7 ++++---
+ t/gd_oo_tests.t | 1 +
+ t/gd_tests.t | 1 +
+ t/minuit.t | 1 +
+ t/slatec.t | 1 +
+ 8 files changed, 26 insertions(+), 20 deletions(-)
+
+commit 7d18e6dbb0c5f61632c301d99bb81b4e03fb3207
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 30 22:44:24 2010 -0400
+
+ Add pdl2 refs where perldl was referered to
+
+ Updating perldl docs with pdl2 for PDL-2.4.7 release.
+
+ Basic/Core/Dbg.pm | 2 +-
+ Basic/SourceFilter/NiceSlice.pm | 5 +++--
+ Demos/BAD_demo.pm.PL | 6 +++---
+ Demos/Cartography_demo.pm | 3 ++-
+ Demos/General.pm | 6 +++---
+ Example/InlinePdlpp/Module/MyInlineMod.pm | 4 ++--
+ Graphics/PGPLOT/Window/Window.pm | 2 +-
+ Lib/Func.pm | 2 +-
+ Lib/Slatec/slatec.pd | 2 +-
+ 9 files changed, 17 insertions(+), 15 deletions(-)
+
+commit d4baca2a291561d76831fef9bed42d7ca3facfdf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 30 18:35:40 2010 -0400
+
+ Apply patch 3024237 to VS.pd for verification
+
+ I'm applying the patch to VS.pd in order to enable
+ testing of this fix by PDL HDF users (which I am not).
+ Please contact Olivier Archer with any test results
+ from the new code. Thanks.
+
+ IO/HDF/VS/VS.pd | 32 ++++++++++++++++++++++++++++----
+ 1 files changed, 28 insertions(+), 4 deletions(-)
+
+commit e6a8a68f4aea42bed5b171e777fd7bc4ccc4e589
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jul 29 20:06:07 2010 -0400
+
+ Update Release_Notes for cygwin and ffmpeg
+
+ Apparently ffmpeg requires version 1.7.x of cygwin to
+ build (because the older version lacks the llrint(() routine
+ in its C library).
+
+ Release_Notes | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 2dd07702b97fad87bb8976b241af29ca88949fbb
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jul 29 09:20:08 2010 -0400
+
+ fix wmpeg() to use ffmpeg to generate the video
+
+ This resolves sf.net feature request #3010984.
+ Note that ffmpeg supports much more video file functionality
+ and formats than mpeg_encode. I would like to see this as
+ the basis for a general read/write AVI capability in the
+ future. This should work for cygwin and unix/linux/*bsd/macosx
+ but needs to be verified on win32.
+
+ Example/IO/wmpeg.pl | 58 +++++++++++++++++++
+ IO/Pnm/Pic.pm | 159 ++++++++++++++++++++++----------------------------
+ Perldl2/TODO | 6 +-
+ Release_Notes | 9 +++
+ 4 files changed, 141 insertions(+), 91 deletions(-)
+
+commit d215a9c8cb334f00cc37ae08bdf13c5f6b44dbe5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 27 10:48:41 2010 -0400
+
+ Update required perl version to 5.8.x
+
+ And some updates to the readme files and Release_Notes
+ documenting this fact as well as other fixes.
+
+ INSTALL | 6 +++---
+ Lib/Fit/Polynomial.pm | 2 +-
+ Makefile.PL | 2 +-
+ Release_Notes | 10 ++++++++++
+ 4 files changed, 15 insertions(+), 5 deletions(-)
+
+commit 8adb0b9e6e88ded9153563509794ed253d4f50e1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 26 21:54:46 2010 -0400
+
+ Replace matinv() by inv() in PDL::Fit::Polynomial
+
+ This removes the dependency on Slatec (an external, fortran
+ library) which make trouble for portability. This takes
+ advantage of the new, threaded implementation of lu_decomp
+ and lu_backsub where partial pivoting is still supported
+ even in the case of threaded input data.
+
+ This resolves sf.net feature request #2891276.
+
+ Lib/Fit/Polynomial.pm | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit 6d6253e56d8833bf45bbaca2f302b4d2a8b7a4e4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 26 18:47:23 2010 -0400
+
+ Create directory for new PDL::IO::ENVI module
+
+ IO/ENVI/readenvi.pdl | 325 ++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 325 insertions(+), 0 deletions(-)
+
+commit 104f65720b6c3819115316b9e24b8b8459dce647
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 26 13:54:27 2010 -0400
+
+ Update perldl> prompt refs to pdl>
+
+ Trying to make POD and docs consistent with the
+ new PDL shell prompt defaults.
+
+ Basic/AutoLoader.pm | 12 +-
+ Basic/Bad/bad.pd | 6 +-
+ Basic/Complex/complex.pd | 49 +++-------
+ Basic/Core/Basic.pm | 63 +++++++------
+ Basic/Core/Core.pm.PL | 74 +++++++-------
+ Basic/Core/Dbg.pm | 12 ++-
+ Basic/PDL.pm | 3 +-
+ Basic/Pod/BadValues.pod | 58 ++++++------
+ Basic/Pod/Dataflow.pod | 8 +-
+ Basic/Pod/FAQ.pod | 2 +-
+ Basic/Pod/Guide.pod | 2 +-
+ Basic/Pod/Indexing.pod | 110 +++++++++++-----------
+ Basic/Pod/Internals.pod | 10 +-
+ Basic/Pod/MATLAB.pod | 66 +++++++-------
+ Basic/Pod/QuickStart.pod | 19 ++--
+ Basic/Pod/Scilab.pod | 66 ++++++-------
+ Basic/Pod/Threading.pod | 196 +++++++++++++++++++-------------------
+ Basic/Pod/Tips.pod | 6 +-
+ Basic/Primitive/primitive.pd | 91 ++++++++---------
+ Basic/Slices/slices.pd | 64 ++++++------
+ Basic/SourceFilter/NiceSlice.pm | 49 +---------
+ Basic/Ufunc/ufunc.pd | 20 ++--
+ Demos/TriD/test6.p | 2 +-
+ Doc/Doc/Perldl.pm | 16 ++--
+ Graphics/IIS/iis.pd | 10 +-
+ Graphics/Karma/karma.pd | 10 +-
+ Graphics/PGPLOT/PGPLOT.pm | 12 +-
+ Graphics/PGPLOT/Window/Window.pm | 22 ++--
+ Graphics/TriD/TriD.pm | 18 ++--
+ 29 files changed, 506 insertions(+), 570 deletions(-)
+
+commit 0d0a4b8b249df108d74e0a5a576d655c28148eaf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 26 00:00:34 2010 -0400
+
+ Update DEPENDENCIES, Known_problems, Release_Notes
+
+ DEPENDENCIES | 2 +-
+ Known_problems | 1 -
+ Release_Notes | 8 +++-----
+ 3 files changed, 4 insertions(+), 7 deletions(-)
+
+commit b8f251f9f4d2528fb638e4c2eacab37660cac291
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 25 17:33:36 2010 -0400
+
+ Fix q|x|exit alias issue and update Perldl2/TODO
+
+ Perldl2/Plugin/PDLCommands.pm | 2 +-
+ Perldl2/TODO | 13 +++++++------
+ 2 files changed, 8 insertions(+), 7 deletions(-)
+
+commit fa89b6993e713f149f32574f67206c18bd11007a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 25 13:31:15 2010 -0400
+
+ Update TODO with SKIP_KNOWN_PROBLEMS status
+
+ Done!
+
+ TODO | 77 ++++++++++++++++++++++++++++++++++++++++++++++++-----------------
+ 1 files changed, 57 insertions(+), 20 deletions(-)
+
+commit d5baccdb0ee63f9b0c948d68ac9bfb6d10006f90
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 25 12:51:41 2010 -0400
+
+ Add SKIP_KNOWN_PROBLEMS support for build
+
+ This allows stable CPAN releases of PDL to include tests
+ for bugs that have not yet been fixed (i.e., in Known_problems)
+ but pass tests for automated installs and builds.
+
+ Makefile.PL | 5 +++++
+ perldl.conf | 7 +++++++
+ t/complex.t | 2 +-
+ t/config.t | 2 +-
+ t/constructor.t | 2 +-
+ t/flexraw.t | 2 +-
+ 6 files changed, 16 insertions(+), 4 deletions(-)
+
+commit bf32eace3c68e023ebd3da74d7bc29bf5936d348
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 25 09:19:42 2010 -0400
+
+ Add stub tests for new pdl string constructor
+
+ The test cases are their with the expected results.
+ Still need to implement the ok() test machinery.
+ Also updated Perldl2/TODO to diagnose issue with
+ multi-line q[ ] type string support.
+
+ Perldl2/TODO | 6 +++-
+ t/pdl_from_string.t | 96 +++++++++++++++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 101 insertions(+), 1 deletions(-)
+
+commit 34430f1c49f4c76ff72d29459ae692a2587d988c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 24 15:53:08 2010 -0400
+
+ Missed Minuit and Slatec for fix to bug #3030998
+
+ Also updated Known_problems and Release_Notes with the news.
+
+ Known_problems | 4 +---
+ Lib/Minuit/Makefile.PL | 4 +++-
+ Lib/Slatec/Makefile.PL | 4 +++-
+ Release_Notes | 4 ++++
+ 4 files changed, 11 insertions(+), 5 deletions(-)
+
+commit 9ff4bc36b93a91b0e6e4a3cfd9d4ea938b52e5ed
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 24 15:14:44 2010 -0400
+
+ Save built config information in %PDL::Config
+
+ This should close sf.net bug #3030998 where the
+ "PDL::Config does not match actual build configuration"
+
+ Graphics/Makefile.PL | 3 +++
+ IO/GD/Makefile.PL | 2 ++
+ IO/HDF/Makefile.PL | 2 ++
+ Lib/FFTW/Makefile.PL | 4 +++-
+ Lib/GIS/Proj/Makefile.PL | 3 +++
+ Lib/GSL/Makefile.PL | 2 ++
+ Lib/Transform/Proj4/Makefile.PL | 2 ++
+ MANIFEST | 3 +++
+ 8 files changed, 20 insertions(+), 1 deletions(-)
+
+commit a39a855dfc96962b8188d7f7f0059b2206b18384
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 24 12:32:04 2010 -0400
+
+ Fix sf.net bug #2901170 re warnings and TriD
+
+ This fixes the final two messages. It appears that
+ there actually was a true duplicate subroutine definition
+ in TriD.pm which seems to have been a write-o. Also made
+ some updates to PDL/TODO re progress and tasks.
+
+ Graphics/TriD/POGL/OpenGL.pm | 57 +++++++++++++++++---------------
+ Graphics/TriD/TriD.pm | 2 +-
+ TODO | 73 ++++++++++++++++++++++++------------------
+ 3 files changed, 73 insertions(+), 59 deletions(-)
+
+commit 038665ee242faeed5e073688baf72038ccd006e1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 23 22:39:30 2010 -0400
+
+ Update FAQ.pod with pdl2 along side perldl
+
+ Eventually, the references to perldl will be deprecated
+ by the use of the new shell and the pdl2 command may eventually
+ become the pdl command to reduce confusion.
+
+ Basic/Pod/FAQ.pod | 291 +++++++++++++++++++++++++++--------------------------
+ 1 files changed, 146 insertions(+), 145 deletions(-)
+
+commit 69f2ed3d9b9d455f871c200bc9b2feac16fdd382
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 23 21:23:28 2010 -0400
+
+ Change pdl2 and perldl prompts to pdl>
+
+ This matches the new PDL logo work on-going.
+
+ Perldl2/Profile/Perldl2.pm | 4 ++--
+ perldl.PL | 2 +-
+ 2 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 9fee2b10dea434d5f05f4c76065853ceb9dac40c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 23 17:12:35 2010 -0400
+
+ Add some working files for cygwin memory issues
+
+ cygwin/fix-max-memory.txt | 34 ++++++++++++++++++++++++++++++++++
+ cygwin/max_memory.c | 15 +++++++++++++++
+ cygwin/tmalloc.pl | 12 ++++++++++++
+ 3 files changed, 61 insertions(+), 0 deletions(-)
+
+commit d0b2b84969dee4ca6bf6852c48f3a1384d56bed3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 23 16:18:38 2010 -0400
+
+ Fix PDL::Complex::string and sum and sumover
+
+ This commit should close sf.net bug #1176614 by fully
+ installing the patch #1176619. It also fixes a problem
+ that came up with sum and sumover and PDL::Complex piddles.
+
+ Basic/Complex/complex.pd | 512 ++++++++++++++++++++++++----------------------
+ Known_problems | 1 -
+ Release_Notes | 4 +
+ t/complex.t | 2 +-
+ 4 files changed, 272 insertions(+), 247 deletions(-)
+
+commit f3792543451c0a086dc9519fc6e2f4a23e28041f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 23 16:18:15 2010 -0400
+
+ Update cygwin/INSTALL and README files
+
+ cygwin/INSTALL | 10 +++++-----
+ cygwin/README | 9 +++------
+ 2 files changed, 8 insertions(+), 11 deletions(-)
+
+commit 29c13b5bf00536f4877d695293a96e07174046c1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 21 21:39:20 2010 -0400
+
+ Update PDL/TODO more PDL-2.4.7 details
+
+ TODO | 12 ++++++++++--
+ 1 files changed, 10 insertions(+), 2 deletions(-)
+
+commit 4249593775adda438cd95615d30e05d3fe0fa54f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 21 14:35:09 2010 -0400
+
+ Update Perldl2/{README,TODO}
+
+ They have fallen behind the current development status
+ and are missing some of the new items that needed to
+ be addressed in the implementation.
+
+ Perldl2/README | 42 +++++++++++++++++++++++-------------------
+ Perldl2/TODO | 31 ++++++++++++++++++++++++++-----
+ 2 files changed, 49 insertions(+), 24 deletions(-)
+
+commit 51e89abcf9a4aec5a6ebd1861ea04425cd8dba23
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 21 11:25:31 2010 -0400
+
+ Clear up new_pdl_from_string error reporting
+
+ The chatty output was confusing since it was
+ unclear what was going on and what the message
+ actually meant. Hope this is an improvement.
+
+ Basic/Core/Core.pm.PL | 116 +++++++++++++++++++++---------------------------
+ 1 files changed, 51 insertions(+), 65 deletions(-)
+
+commit 019c1302db07f0277e3924edc3dc5e6d1c249a9e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 20 15:29:17 2010 -0400
+
+ Add test file for spheres3d debugging in TriD
+
+ Perldl2/logo3d.pdl | 127 ++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 127 insertions(+), 0 deletions(-)
+
+commit 0cd1c43535faf7ac619a5c2630109ae5df5076e6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 19 16:59:26 2010 -0400
+
+ Add more specifics to pdl2 Ctrl-C fix for win32
+
+ Need to modify the read method to keep EOF from ending the shell.
+ Maybe this should be at a higher level (e.g. Devel::REPL).
+
+ Perldl2/TODO | 7 +++----
+ 1 files changed, 3 insertions(+), 4 deletions(-)
+
+commit 60cdc005f082a0e6de201b367a4b6f97b44e3ac3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 19 16:21:06 2010 -0400
+
+ Update Known_problems/Release_Notes & Perldl2/TODO
+
+ The win32 problem with perldl dying from Ctrl-C
+ has been diagnosed and resolved. Taking the bug
+ off of the list of Known_problems, updating the
+ Release_Notes and adding an item to Perldl2/TODO
+ about work needed to propagate the fix to pdl2.
+
+ Known_problems | 1 -
+ Perldl2/TODO | 5 +++++
+ Release_Notes | 5 +++++
+ 3 files changed, 10 insertions(+), 1 deletions(-)
+
+commit 7b53bf5048226b819dce95fc7ae0ca621fc43f66
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 19 16:02:47 2010 -0400
+
+ Make $PERLDL::NO_EOF=1 default for win32
+
+ This works around an issue with the way windows handles
+ Ctrl-C signals. It appears that a signal in the readline
+ call is caught the first time but the second time it is
+ treated as an EOF which caused perldl to exit.
+
+ perldl.PL | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 585fc7249dbc8e3635053789f5c85d231e86e288
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 19 15:48:06 2010 -0400
+
+ Add EOF termination message to perldl
+
+ perldl.PL | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit c1b6e7b1ddc70c7fa0a2ee1a2e24ea4d4ad4cb98
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 19 15:12:58 2010 -0400
+
+ Add Perldl2/tctrl-c.pl to git for Ctrl-C debugging
+
+ This is an example program for which catching Ctrl-C
+ appears to work. We need to determine why Devel::REPL
+ and perldl don't work. Is this a code error or a bug
+ in perl signal handling...
+
+ Perldl2/tctrl-c.pl | 26 ++++++++++++++++++++++++++
+ 1 files changed, 26 insertions(+), 0 deletions(-)
+
+commit c3210316240b20bf9e8dcad9701717b5d636bdbc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 19 11:04:46 2010 -0400
+
+ Fix oops with t/complex.t and skip
+
+ t/complex.t | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit e4a9d7bb8ffb17bf61aaefea708efc6da2a0eb9e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 19 10:42:41 2010 -0400
+
+ Add support for SKIP_KNOWN_PROBLEMS env var
+
+ If this is set then 'make test' will skip any tests that are
+ currently on the Known_problems list. The tests have to be
+ modified by hand at the moment. We probably need to base the
+ skips on a like generated from the Known_problems file...
+ eventually.
+
+ Perldl2/TODO | 4 ++
+ Release_Notes | 24 +++++++++++++++
+ t/complex.t | 18 +++++++----
+ t/config.t | 19 +++++++++---
+ t/constructor.t | 24 +++++++++------
+ t/flexraw.t | 87 +++++++++++++++++++++++++++++--------------------------
+ 6 files changed, 114 insertions(+), 62 deletions(-)
+
+commit 17895a2ef8251a4a01a3702c3fe12ff484e990c7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 19 08:53:05 2010 -0400
+
+ FAQ updates and spell checking TODO/Known_problems
+
+ Basic/Pod/FAQ.pod | 322 ++++++++++++++++++++++++++---------------------------
+ Known_problems | 4 +-
+ TODO | 18 ++--
+ 3 files changed, 167 insertions(+), 177 deletions(-)
+
+commit fbd761f5848afaad0e6e9a8cd84b9cd23a02c13e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 18 14:55:27 2010 -0400
+
+ Update TODO with PDL-2.4.7 tasks/plans
+
+ TODO | 519 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 519 insertions(+), 0 deletions(-)
+
+commit 4f7d19dfd5187075be2b235a1ce034e7cc6ce54b
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sun Jul 18 09:48:01 2010 +0200
+
+ More minor doc tweaks in rfits()
+
+ IO/FITS/FITS.pm | 9 +++++++--
+ 1 files changed, 7 insertions(+), 2 deletions(-)
+
+commit 94c6f196614ce5017a6e5a03f07e64605209aaf9
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sun Jul 18 09:45:52 2010 +0200
+
+ Updated documentation for FITS compressed format; fixed an edge case in Rice compression.
+
+ IO/FITS/FITS.pm | 7 +++----
+ Lib/Compression/compression.pd | 2 +-
+ 2 files changed, 4 insertions(+), 5 deletions(-)
+
+commit a0a803e9ebe27759e283f4d31bf8430530baef52
+Merge: 95fc475 74c034e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 17 20:38:29 2010 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 95fc475d939970eecb2a6abe5eff4307714e0c8e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 17 20:37:41 2010 -0400
+
+ Add test for pdl() constructor bug #3011879
+
+ t/constructor.t | 22 ++++++++++++++++++++++
+ 1 files changed, 22 insertions(+), 0 deletions(-)
+
+commit 74c034e5b92b5b0c2d0d476c46482c617c04e62e
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Sat Jul 17 17:39:33 2010 -0500
+
+ Added the bug ID for the mapflex troubles.
+
+ Known_problems | 1 +
+ t/flexraw.t | 1 +
+ 2 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 25ffbb5eddf186ad9e5c10e3f3ed2fa26d2767ec
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 17 13:58:00 2010 -0400
+
+ Add test for sf.net bug #3030998 re PDL::Config.pm
+
+ Config.pm needs to reflect the actual build configuration
+ for PDL. That means that any undef options in perldl.conf
+ should have been checked and decided yes/no. The config
+ info needs to show that decision, not the initial undef.
+
+ Known_problems | 1 +
+ t/config.t | 24 ++++++++++++++++++++++++
+ 2 files changed, 25 insertions(+), 0 deletions(-)
+
+commit 0e3bd24be00f0402c550b8fb1ceb591522fac22a
+Merge: f5dca19 702a41f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jul 15 18:07:58 2010 -0400
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit f5dca19c2d1d95041a07c312d1ce9d0ae672c44e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jul 15 18:05:35 2010 -0400
+
+ Fix imag2d() explicit zoom to override default
+
+ The fixes the argument handling so a specific zoom
+ value in the imag2d() call will override the default
+ "smart" zoom setting which tries for 1:1 but makes
+ things bigger if the image would be too small to see.
+
+ imag2d.pdl | 7 ++++---
+ 1 files changed, 4 insertions(+), 3 deletions(-)
+
+commit 702a41fceb4ce2b9da5cfbe5ae4d1745b1d1a0f6
+Author: David Mertens <dcmertens.perl at gmail.org>
+Date: Wed Jul 14 20:25:58 2010 -0500
+
+ Added a whole new flexraw set of tests.
+
+ These are based on the fastraw tests, and much functionality remains
+ to be tested, but it's a start. Among other things, it points out a
+ problem with the mapflex function.
+
+ t/flexraw.t | 727 +++++++----------------------------------------------------
+ 1 files changed, 78 insertions(+), 649 deletions(-)
+
+commit 6cca3822691813b9fd19804367646005e25f2724
+Author: David Mertens <dcmertens.perl at gmail.org>
+Date: Wed Jul 14 20:23:23 2010 -0500
+
+ Fixed a bug in mapflex code (though others remain).
+
+ The mapflex function created a piddle with something that looked like
+
+ '$piddle = byte zeroes(1)'
+
+ This used to be interpreted as a piddle with contents of zero, but
+ with the new piddle-from-string functionality, it was tripping an
+ error. It looks like broken behavior had a default result that the
+ piddle-from-string functionality has effectively removed. So I
+ fixed that.
+
+ IO/FlexRaw/FlexRaw.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 36e48bb9a70d4459e0dc316436165fafd862fdb6
+Author: David Mertens <dcmertens.perl at gmail.org>
+Date: Wed Jul 14 20:22:01 2010 -0500
+
+ Fixed doc typo in FlexRaw that said 'use PDL::IO::FastRaw'
+
+ IO/FlexRaw/FlexRaw.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 10bff9c62595f97f8371039cc9834d1fc2a16218
+Author: David Mertens <dcmertens.perl at gmail.org>
+Date: Wed Jul 14 14:00:59 2010 -0500
+
+ Moved the current flexraw tests to a new test name.
+
+ The tests for flexraw are very confusing and I was loathing grokking
+ them. Instead, I just renamed them to something smart so I can make
+ new tests that are not dependent on a Fotran compiler.
+
+ t/flexraw_fortran.t | 666 +++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 666 insertions(+), 0 deletions(-)
+
+commit 73516ba3d133fab3d820a016a6c7290177c3875d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 13 22:22:06 2010 -0400
+
+ Update VERSION to 2.4.6_015 for more development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit ca9427a203bf187d9923690e9dab4d7f6eb00642
+Merge: 7451ff4 8527c77
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 13 22:20:38 2010 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 8527c7755bd3cc2392fec72dc15c8e5588399d2b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 12 12:57:58 2010 -0400
+
+ Add test for sf.net bug #1176614
+
+ This is broken complex stringification. If you are not using
+ PDL::Complex features, you should be ok forcing an install.
+
+ t/complex.t | 9 +++++++--
+ 1 files changed, 7 insertions(+), 2 deletions(-)
+
+commit 7451ff45c3f2074fc6729d4661a30000372016d5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 11 18:30:57 2010 -0400
+
+ Update Release_Notes and Known_problems for CPAN
+
+ Known_problems | 2 +-
+ Release_Notes | 50 ++++++++++++++++++++++++++++++++++++--------------
+ 2 files changed, 37 insertions(+), 15 deletions(-)
+
+commit f4a51927326c9d21b5ed1ee779c83d8083cea316
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 11 14:47:06 2010 -0400
+
+ pdl2 now runs perldl if Devel::REPL is not found
+
+ With this change it should be possible to use pdl2
+ as the preferred shell name for PDL. If Devel::REPL
+ is not there then the original perldl will be called.
+
+ Perldl2/TODO | 3 ---
+ Perldl2/pdl2 | 8 +++++++-
+ 2 files changed, 7 insertions(+), 4 deletions(-)
+
+commit 030351960f77947ed7e7bcbe0beeb41b7ec5697d
+Merge: 1819dfe c751ef6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 11 10:16:36 2010 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 1819dfe536dcb68255e75aa11fa7fddc14a10757
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 11 10:14:43 2010 -0400
+
+ pdl2 exits with message if Devel::REPL not ok
+
+ A runtime check against the installed Devel::REPL version
+ so that pdl2 exits with a warning rather than with a
+ possibly confusing compiler error if Devel::REPL is
+ not the correct version. Need to set the minimum version
+ from perldl.conf eventually. Hardwired for now.
+
+ Perldl2/pdl2 | 10 +++++++++-
+ 1 files changed, 9 insertions(+), 1 deletions(-)
+
+commit c751ef6bec5254eeb7060e48a44e476032d36140
+Author: Rob <Rob at desktop2.(none)>
+Date: Sun Jul 11 19:58:31 2010 +1000
+
+ t/plplot.t - small change to a warning message
+
+ Existing message (MSWin only) was a little inaccurate
+
+ t/plplot.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 1c72cbb10a2051a291a176d09b1fab1f0bbe650c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jul 10 14:27:51 2010 -0400
+
+ Fix t/opengl.t false fail with no X display
+
+ glutInit exits on failure. This tries opening the X
+ display before calling glutInit just in case. The
+ tests involving glutInit are skipped if the display
+ cannot be open.
+
+ The required version of OpenGL was updated to 0.63
+ in the perldl.conf file. It should be available on
+ a CPAN mirror shortly.
+
+ perldl.conf | 2 +-
+ t/opengl.t | 33 +++++++++++++++++++++------------
+ 2 files changed, 22 insertions(+), 13 deletions(-)
+
+commit 4fcc37ddd1324ea29a943ebfc9bea29f755a51c2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jul 8 09:26:03 2010 -0400
+
+ Add INT2PTR to PP usage for IV to ptr conversion
+
+ The PDL internal code has been fixed for a while but the PP.pod
+ was never updated with the correction. Without this macro
+ you can have mysterious bad pointers resulting from a pointer
+ being converted to an integer and then to a pointer. This
+ only works if int is long enough to hold a pointer value. By
+ construction, IVs are always big enough to hold a pointer.
+
+ Basic/Pod/PP.pod | 12 +++++++-----
+ 1 files changed, 7 insertions(+), 5 deletions(-)
+
+commit 3f7962da74f4fc43871fe57027e82278eff3a175
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 7 18:03:45 2010 -0400
+
+ Update VERSION to 2.4.6_014 for development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 76d27c1e1c19bf535a91e1711acc5a5ecd126af8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 7 18:01:48 2010 -0400
+
+ Minor fix to Graphics/TriD/POGL/OpenGL.pm
+
+ Graphics/TriD/POGL/OpenGL.pm | 3 +--
+ 1 files changed, 1 insertions(+), 2 deletions(-)
+
+commit 1411f5b7c02789cd17eab0b5636baba824599991
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 7 17:10:17 2010 -0400
+
+ Update Release_Notes for CPAN devel release
+
+ This is to test the fix for t/opengl.t fails.
+
+ Release_Notes | 12 +++++++++++-
+ 1 files changed, 11 insertions(+), 1 deletions(-)
+
+commit 26996e17c157144a2051a8693cd22f720d5d4d37
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 7 17:05:06 2010 -0400
+
+ Put fallback code to glutInitDisplay
+
+ There have been CPAN test failures where the Perl OpenGL
+ module built and installed ok but then the t/opengl.t
+ fails for PDL. A look at the two tests shows the main
+ difference is that POGL checks if the GLUT_ALPHA channel will
+ work and if not, tries again without GLUT_ALPHA set.
+
+ Graphics/TriD/POGL/OpenGL.pm | 17 ++++++++++++++++-
+ 1 files changed, 16 insertions(+), 1 deletions(-)
+
+commit 027163ed645d6ae56946fd1b0e0da0e61e72add0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 7 17:04:31 2010 -0400
+
+ Remove unneeded diag print from t/proj_transform.t
+
+ t/proj_transform.t | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit c5e40307b414d4bbf0dcece06153ebe10da53ba7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 6 22:49:01 2010 -0400
+
+ Update Known_Problems and Perldl2/TODO
+
+ Known_problems | 3 +--
+ Perldl2/TODO | 16 ++++++++++------
+ 2 files changed, 11 insertions(+), 8 deletions(-)
+
+commit 97902f8d256770178cd75fc60f4b34e7ce3009ff
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 6 17:29:22 2010 -0400
+
+ Fix rt.cpan.org bug #59126 in isempty pod
+
+ Basic/Core/Core.pm.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 7dbfce79271643ba56cfac5a11110938b2c94fcd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 6 14:04:52 2010 -0400
+
+ Update Release_Notes and Perldl2/TODO
+
+ Perldl2/TODO | 10 +++++++---
+ Release_Notes | 21 +++++++++++++++++++++
+ 2 files changed, 28 insertions(+), 3 deletions(-)
+
+commit dda8ae6dc17675e13df09accdda264b8e7153948
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 6 12:39:23 2010 -0400
+
+ Regenerate Changes from git log output for release
+
+ make dist will now run git log --stat --since="29 Apr 2009" to
+ generate the current Changes file for including in the distribution
+ being made.
+
+ Makefile.PL | 10 +++++++---
+ 1 files changed, 7 insertions(+), 3 deletions(-)
+
+commit 094ecbfdb6ab66c22594520e13bad1a438aaf68a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 6 09:32:59 2010 -0400
+
+ VERSION to 2.4.6_013 for more development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 350d7cd65405b0be3a0ea7b0900e339a49684334
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 6 09:26:27 2010 -0400
+
+ Update readme files for CPAN developers release
+
+ DEPENDENCIES | 11 +--
+ Known_problems | 16 ---
+ MANIFEST | 295 ++++++++++++++++++++++++++++----------------------------
+ Release_Notes | 6 +
+ 4 files changed, 157 insertions(+), 171 deletions(-)
+
+commit a3f0a1c709e527b10d167257bbc2b6e8e8cde4c0
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Mon Jul 5 09:38:07 2010 +0200
+
+ Eliminate Book folder until I undersand how HTML docs are generated.
+
+ Basic/Pod/Book/FAQ.pod | 1872 -----------------------------------------
+ Basic/Pod/Book/Indexing.pod | 1561 ----------------------------------
+ Basic/Pod/Book/MATLAB.pod | 865 -------------------
+ Basic/Pod/Book/Philosophy.pod | 148 ----
+ Basic/Pod/Book/QuickStart.pod | 615 --------------
+ Basic/Pod/Book/Scilab.pod | 815 ------------------
+ Basic/Pod/Book/Threading.pod | 961 ---------------------
+ Basic/Pod/Book/Tips.pod | 129 ---
+ Basic/Pod/Book/make-book.pl | 175 ----
+ Basic/Pod/Book/pdl-book.css | 8 -
+ Basic/Pod/FAQ.pod | 1872 +++++++++++++++++++++++++++++++++++++++++
+ Basic/Pod/Indexing.pod | 1561 ++++++++++++++++++++++++++++++++++
+ Basic/Pod/MATLAB.pod | 865 +++++++++++++++++++
+ Basic/Pod/Philosophy.pod | 148 ++++
+ Basic/Pod/QuickStart.pod | 615 ++++++++++++++
+ Basic/Pod/Scilab.pod | 815 ++++++++++++++++++
+ Basic/Pod/Threading.pod | 961 +++++++++++++++++++++
+ Basic/Pod/Tips.pod | 129 +++
+ Basic/Pod/make-book.pl | 175 ++++
+ Basic/Pod/pdl-book.css | 8 +
+ 20 files changed, 7149 insertions(+), 7149 deletions(-)
+
+commit 2734fdf63c7e78dc7cec79aa8f2ef940db7e5765
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jul 4 12:45:21 2010 -0400
+
+ Fix jpegtopnm problem in proj_transform.t
+
+ The problem arises because the jpegtopnm routine
+ recently started giving a different output from
+ extracting the same input earth_image data file from
+ PDL::Transform::Cartography. That results in test failure
+ because the data does not match but not because the
+ PDL::Transform::Proj4 has an error.
+
+ The fix is in two parts. Modify the original
+ t/proj_transform.t to skip the tests if the image data
+ checksum does not match that for which the tests were
+ written. Second, a new t/proj_transform2.t test was written
+ using a synthetic image in place of the earth_image. This is
+ possible because the image data is only used to compare the
+ test results but it does not contain any explicit content
+ related to the transform beyond the FITS header information.
+
+ This should fix sf.net bug #3013751.
+
+ t/proj_transform.t | 91 +++++++------
+ t/proj_transform2.t | 383 +++++++++++++++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 430 insertions(+), 44 deletions(-)
+
+commit 01a053483036f9bad6aa81d468d3e48ff7da091a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 2 14:08:37 2010 -0400
+
+ Fix threading with lu_decomp and lu_backsub
+
+ This closes sf.net bug #3021567. lu_decomp threaded version was
+ implemented and the fall through to the numerically unstable
+ lu_decomp2 is not done any more. This had some bad consequences
+ for any routines expecting threading and matrix inverses (for
+ example) since the inverse is calculated with lu_decomp which
+ uses the non-pivoting lu_decomp2 if you try to invert more than
+ one matrix at a time.
+
+ lu_backsub now correctly handles thread dimensions from any of
+ its input arguments and returns the appropriately dimensioned
+ results. The signatures have been updated as well.
+
+ Known_problems and Release_Notes have also been updated.
+
+ Basic/MatrixOps/matrixops.pd | 475 ++++++++++++++++++++++--------------------
+ Known_problems | 5 +-
+ Release_Notes | 17 ++
+ 3 files changed, 263 insertions(+), 234 deletions(-)
+
+commit 1a88725bc9966a88984d768453f0cfe8ed03e089
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jun 27 20:35:36 2010 -0400
+
+ VERSION to 2.4.6_012 for more development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 82830d6d22953b545938242698e4747659325678
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jun 27 20:12:01 2010 -0400
+
+ Update Known_problems and Release_Notes for CPAN
+
+ Also updated MANIFEST. This is for a CPAN developer's
+ release to get additional diagnostic output from t/proj_transform.t.
+
+ Known_problems | 9 +++++----
+ MANIFEST | 6 ------
+ Release_Notes | 26 ++++++++++++++++++++++++++
+ 3 files changed, 31 insertions(+), 10 deletions(-)
+
+commit cb823a2ef2096d937eb9cd49e5a8627b98674506
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jun 25 18:13:46 2010 -0400
+
+ Fix sf.net bug #3021578 re missing xtra dummy dims
+
+ dummy() is supposed to add extra dummy dimensions of size 1
+ whenever the position argument requested was past the existing
+ number of dimensions. The problem has been fixed along with
+ modification to t/slice.1 and t/gd_oo_tests.t where the tests
+ used the incorrect dummy behavior.
+
+ Basic/Core/Core.pm.PL | 2 +-
+ t/gd_oo_tests.t | 2 +-
+ t/slice.t | 2 +-
+ 3 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 02632995b160650d1a25c7716fb6df1cbfc4d891
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jun 24 11:00:29 2010 -0400
+
+ Fix typo in doc fix
+
+ Basic/Math/math.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 7bb28cae24b64cb4a0df1de2efae9a28b81514d9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jun 24 10:56:21 2010 -0400
+
+ Update bess[jy][01n] docs in math.pd
+
+ Made it clearer about which Bessel functions are being
+ calculated and reworded slightly.
+
+ Basic/Math/math.pd | 23 ++++++++++++++++++-----
+ 1 files changed, 18 insertions(+), 5 deletions(-)
+
+commit a32026e3ed6df117895683d98b40cf179c763304
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jun 24 08:00:11 2010 -0400
+
+ Fix refs for floor/ceil/rint to use integer
+
+ Now a search for integer will show these as methods
+ to convert to integer values.
+
+ Basic/Math/math.pd | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit e094db608ed86569f88a0985fd0bcdfa07ae60aa
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jun 23 16:34:33 2010 -0400
+
+ Use is() instead of ok() in t/proj_transform.t
+
+ That should give more diagnostic output for failing tests
+ to help debug the recent test failures for cygwin 1.7 and
+ freebsd 8.0.
+
+ t/proj_transform.t | 12 ++++++++----
+ 1 files changed, 8 insertions(+), 4 deletions(-)
+
+commit 778953e1028687227ae637a357749de977336033
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jun 23 13:18:51 2010 -0400
+
+ Add keyboard command shortcuts for imag2d
+
+ Added diagnostic messages and stub entries for existing and
+ new keyboard shortcuts available in the imag2d display
+ windows.
+
+ Currently implemented commands:
+
+ >,. -> Change direction/Step forward
+ <,, -> Change direction/Step backward
+ ESC, Ctrl-C -> Exit program
+ SPACE -> Pause/Run toggle
+ Q,q -> Stop twiddling
+
+ Just stub commands for now:
+
+ 1 -> Zoom to 1:1 image to display pixel ratio
+ = -> Resize all windows to this one
+ H,h -> Toggle image histogram equalization
+ L,l -> Lock window sizes
+ O,o -> Toggle overlay display
+ V,v -> Toggle verbose output
+
+ imag2d.pdl | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++------
+ 1 files changed, 68 insertions(+), 8 deletions(-)
+
+commit 1aa4d7be59e76c0276b937a5e32646a94472512d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 22 22:44:56 2010 -0400
+
+ Update Perldl2/TODO from latest improvements
+
+ Perldl2/TODO | 53 +++++++++++++++++++++++++++++++----------------------
+ 1 files changed, 31 insertions(+), 22 deletions(-)
+
+commit a4e03ecbacd8e22583e5c2abfa220b0e88f52d96
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 22 22:28:29 2010 -0400
+
+ Add stub docs to pdl2
+
+ Now if you try 'apropos shell' you will get the Perldl2 shell,
+ pdl2, listed as one of the topics.
+
+ Perldl2/pdl2 | 29 +++++++++++++++++++++++++++++
+ 1 files changed, 29 insertions(+), 0 deletions(-)
+
+commit 6921bed29ce0c6118b792126a10d8b3bdc020b97
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 22 18:19:12 2010 -0400
+
+ Add error diagnostics to dummy() in PDL::Core
+
+ Basic/Core/Core.pm.PL | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 8aeec65e0add42ed14ee749e566bbd5d326eedca
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 22 18:18:27 2010 -0400
+
+ Fix minor doc issue for Perldl2 POD
+
+ Perldl2/Profile/Perldl2.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 0c3760f08be618b0118e877a5a029534e361dcdf
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 22 13:46:38 2010 -0400
+
+ Update Perldl2 README and demo output
+
+ No quotes needed around the args since autoquoting is
+ implemented for demo et. al.
+
+ Perldl2/Profile/Perldl2.pm | 22 +++++++++++-----------
+ Perldl2/README | 13 ++++++++-----
+ 2 files changed, 19 insertions(+), 16 deletions(-)
+
+commit cb806250064f1bd97ecfc0f1ef9c864beb49d34f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 22 13:12:46 2010 -0400
+
+ Update VERSION to 2.4.6_011 for development
+
+ Basic/PDL.pm | 2 +-
+ Release_Notes | 13 +++++++++++++
+ 2 files changed, 14 insertions(+), 1 deletions(-)
+
+commit b648a012208f983a43ec1f11302cc7d977b65014
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 22 11:00:44 2010 -0400
+
+ Update Release_Notes and MANIFEST for CPAN
+
+ Also make Perldl2 build the default. It won't run without
+ Devel::REPL being installed, but it should build and install
+ ok as it is only perl.
+
+ MANIFEST | 7 ++-----
+ Release_Notes | 11 +++++++++--
+ perldl.conf | 2 +-
+ 3 files changed, 12 insertions(+), 8 deletions(-)
+
+commit 7dff35a6b9b3ec4dc5f13941681d6667e54e1f0e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 22 10:58:03 2010 -0400
+
+ Forgot to add the new plugin to git
+
+ Perldl2/Plugin/PDLCommands.pm | 98 +++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 98 insertions(+), 0 deletions(-)
+
+commit 408229188d7baf39a6ff67e00644fe77a4d66a1e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 22 10:48:58 2010 -0400
+
+ Implement perldl command shortcuts, aliases...
+
+ Implement shortcuts to quit the shell, ?/?? as aliases for the
+ help/apropos commands, autoquoting the arguments to the various
+ interactive doc-type commands, and shell escapes.
+
+ Perldl2/Plugin/Makefile.PL | 1 +
+ Perldl2/Profile/Perldl2.pm | 3 ++-
+ Perldl2/README | 20 +++++++++-----------
+ Perldl2/TODO | 19 +++----------------
+ 4 files changed, 15 insertions(+), 28 deletions(-)
+
+commit 4313a740eae12f764cf150385c82e20234bdeef4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 21 22:26:40 2010 -0400
+
+ +Checks to prevent access to undef $HOME warnings
+
+ Make sure to check that $HOME is defined before testing
+ it in conditionals to prevent warnings.
+
+ Perldl2/Script.pm | 4 +++-
+ Perldl2/pdl2 | 12 ++++++++----
+ 2 files changed, 11 insertions(+), 5 deletions(-)
+
+commit 4995c75f030d21057d87375ea4c5fb6c6380fa0d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 21 21:40:22 2010 -0400
+
+ Update readme-type files re Perldl2 progress
+
+ Now that the .perldlrc and local.perldlrc files are processed,
+ this is some clean up of the docs and readmes in preparation
+ for another CPAN developers release.
+
+ Known_problems | 2 +-
+ Perldl2/README | 36 ++++++++++++++++++++++++------------
+ Perldl2/TODO | 6 +++++-
+ Release_Notes | 17 ++++++++++++++++-
+ 4 files changed, 46 insertions(+), 15 deletions(-)
+
+commit 93db664e457ae16a309f6fa29cd51aafc6c1c8c4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 21 18:08:42 2010 -0400
+
+ Added .pdlrc support to Perldl2 shell
+
+ List discussion supported using pdl as the name of the
+ interactive shell and interpreter for PDL. Looking forward,
+ the new Perldl2 shell also looks for .pdlrc and local.pdlrc
+ in addition to the perldl flavor names.
+
+ Perldl2/Profile/Perldl2.pm | 2 +-
+ Perldl2/README | 19 +++++--------------
+ Perldl2/Script.pm | 17 ++++++++---------
+ Perldl2/TODO | 10 ----------
+ 4 files changed, 14 insertions(+), 34 deletions(-)
+
+commit c82e0e8f81842868d8d625ebf02e68177316f7da
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 21 17:49:43 2010 -0400
+
+ Add processing of local.perldlrc or local.pdlrc
+
+ Perldl2/Script.pm | 9 +++++++++
+ 1 files changed, 9 insertions(+), 0 deletions(-)
+
+commit 7f7bdd80dc11fe19d3fdd599c2586125b84910ac
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 21 17:20:22 2010 -0400
+
+ Add .perldlrc file processing to Perldl2
+
+ This required a subclass of Devel::REPL::Script to override
+ the load_rcfile method call. Minor change to the Makefile.PL
+ for the new file.
+
+ Perldl2/Makefile.PL | 2 ++
+ Perldl2/Profile/Perldl2.pm | 2 +-
+ Perldl2/Script.pm | 39 +++++++++++++++++++++++++++++++++++++++
+ Perldl2/pdl2 | 3 ++-
+ 4 files changed, 44 insertions(+), 2 deletions(-)
+
+commit e1ccee643c288784f1a73fdc727fb3b390919eae
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 21 15:27:49 2010 -0400
+
+ Add VERSION to PDL::Perldl2::Profile::Perldl2
+
+ Note, this is still the Perldl2 Shell with its next generation
+ technologies. Now we can track functionality against VERSION
+ changes for announcements and documentation.
+
+ Perldl2/Profile/Perldl2.pm | 25 +++++++++++++++----------
+ 1 files changed, 15 insertions(+), 10 deletions(-)
+
+commit 620baabad1d7ce259720e7e0795dc363f0c7dcef
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 21 14:31:56 2010 -0400
+
+ Add cls support to Demos/Screen.pm for win32
+
+ Still need to resolve the problem with hanging at the
+ <> input at the end of the demo. Maybe this operation
+ can be replaced by a ReadKey one.
+
+ Demos/Screen.pm | 60 ++++++++++++++++++++++++++++--------------------------
+ 1 files changed, 31 insertions(+), 29 deletions(-)
+
+commit 0f8ed2de9e5f1f405750215eefce16416a49a01b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 21 14:07:30 2010 -0400
+
+ do_print now toggles setting in PrintControl
+
+ Renamed the print settings attribute in the PrintControl
+ plugin to print_by_default and reimplemented do_print()
+ to toggle that value if no new value were passed in the
+ method call. TODO: still would like a function for this
+ so the $_REPL stuff does not need to be exposed.
+
+ Perldl2/Plugin/PrintControl.pm | 30 ++++++++++++++++++++++--------
+ 1 files changed, 22 insertions(+), 8 deletions(-)
+
+commit 8cad7640af6af816f26ed0df372d3ac0eaeb1269
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 21 10:53:03 2010 -0400
+
+ Don't load INC and Keywords completion wo deps
+
+ Now check for required dependencies for CompletionDriver::INC
+ and CompletionDriver::Keywords (File::Next and B::Keywords,
+ respectively) before loading the plugins. Still needs a
+ refactor to simplify and make available for all plugins as
+ a check. Also updated Perldl2/TODO with this information
+ as well as the investigation results into the use of clear
+ to clear the screen for win32.
+
+ Perldl2/Profile/Perldl2.pm | 12 +++++++++++-
+ Perldl2/TODO | 12 ++++++++++--
+ 2 files changed, 21 insertions(+), 3 deletions(-)
+
+commit 94cc2d3aa84f44ffd47ef53e72f9c999c8dd580d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 21 07:39:02 2010 -0400
+
+ Update Perldl2/TODO
+
+ Thanks for the feedback, Rob. I've added the couple of
+ issues to the TODO list to see that they are addressed
+ at some point.
+
+ Perldl2/TODO | 9 ++++++++-
+ 1 files changed, 8 insertions(+), 1 deletions(-)
+
+commit 02c63f400b7719e5f2b6199a65d232ab12b8462b
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sun Jun 20 16:00:41 2010 +1000
+
+ t/plplot.t - win32 portability
+
+ Provide Windows-specific renditions
+ of tests 2 and 35
+
+ t/plplot.t | 48 ++++++++++++++++++++++++++++--------------------
+ 1 files changed, 28 insertions(+), 20 deletions(-)
+
+commit ac864c0811a77f6144877618537e3ed925c5601c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jun 18 12:47:34 2010 -0400
+
+ Update Makefile.PL, browse.c for PDL::IO::Browser
+
+ Had to change stdscr variable name with pdlscr since it
+ is apparently being used in ncurses now. Added notes on
+ improvements needed to curses include/library search.
+ Cygwin 1.7.5 now has the curses.h in /usr/include/ncurses
+ by default with no header file or link at the top level.
+
+ Also did some minor cleanup of MANIFEST.SKIP
+
+ IO/Browser/Makefile.PL | 12 +++++++-----
+ IO/Browser/browse.c | 18 +++++++++---------
+ MANIFEST.SKIP | 5 +++++
+ 3 files changed, 21 insertions(+), 14 deletions(-)
+
+commit e67806472d0dcaca852cc53d867aeef9b2025c96
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jun 17 18:53:56 2010 -0400
+
+ Update POD for uniq/uniqind/uniqvec routines
+
+ Basic/Primitive/primitive.pd | 27 ++++++++++++++++++++-------
+ 1 files changed, 20 insertions(+), 7 deletions(-)
+
+commit 6ed46b4d079f949f399eaf235f51607b8a1b9983
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jun 17 14:28:38 2010 -0400
+
+ Assign a value to $PERLDL::TERM from $_REPL->term
+
+ Perldl2/Profile/Perldl2.pm | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit b37582324d0f3c897c7558c11e68480437959b82
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jun 17 07:30:17 2010 -0400
+
+ Update MANIFEST and MANIFEST.SKIP
+
+ MANIFEST | 282 ++++++++++++++++++++++++++++----------------------------
+ MANIFEST.SKIP | 10 ++-
+ 2 files changed, 148 insertions(+), 144 deletions(-)
+
+commit 3ab30717728784d7122305b13835b3672513498f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jun 16 22:51:24 2010 -0400
+
+ Cleanup Known_Problems and Devel::REPL plugins
+
+ We don't need our own copy of the Devel::REPL latest since the
+ official Devel-REPL-1.003011.tar.gz is out now. Updated
+ Known_Problems from some new status in sf.net bugs list.
+
+ Known_problems | 5 +-
+ Perldl2/Completion.pm | 142 --------------------------------------------
+ Perldl2/History.pm | 77 ------------------------
+ Perldl2/ReadLineHistory.pm | 114 -----------------------------------
+ 4 files changed, 3 insertions(+), 335 deletions(-)
+
+commit f6b877c662512678907ab4262fcff367e594fb9d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jun 16 18:32:24 2010 -0400
+
+ Remove development uniq/uniqind/uniqvec from git
+
+ uniq | 60 ---------------------------------------------
+ uniqind | 59 --------------------------------------------
+ uniqvec | 84 ---------------------------------------------------------------
+ 3 files changed, 0 insertions(+), 203 deletions(-)
+
+commit af51bea78eb913fa9552b7611e5dc183571c8839
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jun 16 14:55:18 2010 -0400
+
+ New NaN/BAD aware uniqvec completed
+
+ Now uniq/uniqind/uniqvec all handle NaNs and BAD values
+ consistenly and consistent with Matlab/Octave conventions.
+ The current implementation does not have a well defined
+ standard for sorting vectors with NaN or BAD values in them.
+ The result looks like this:
+
+ All good, non-NaN vectors, sorted.
+ All non-NaN vectors with BAD values next.
+ All NaN containing vectors last.
+
+ Basic/Primitive/primitive.pd | 140 +++++++++++++++++++++++++++--------------
+ 1 files changed, 92 insertions(+), 48 deletions(-)
+
+commit fc225489f967568f642a0b1efb5b20d8181a38f8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 15 23:04:08 2010 -0400
+
+ Recovered from loss of uniq/uniqind/uniqvec
+
+ Fixed a reversion in the code for uniqvec. Now uniq and uniqind
+ both support BAD and NaN. uniqvec functions but it still does
+ not return the mixed BAD and good value vectors nor all of the
+ NaN containing vectors.
+
+ uniqvec | 30 +++++++++++++++++++-----------
+ 1 files changed, 19 insertions(+), 11 deletions(-)
+
+commit f0c032430f89cfbc5014ce0b7b7bf789a588fc43
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 15 17:55:29 2010 -0400
+
+ uniq/uniqind/uniqvec with NaN/BAD value support
+
+ uniq | 60 +++++++++++++++++++++++++++++++++++++++++++++++++
+ uniqind | 59 ++++++++++++++++++++++++++++++++++++++++++++++++
+ uniqvec | 76 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 195 insertions(+), 0 deletions(-)
+
+commit 4d4d516976b6a4d0552d1afd461114398ca2bca0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 15 06:44:57 2010 -0400
+
+ Update Perldl2 README type files for Devel::REPL
+
+ Now that an official Devel::REPL release has been made, we
+ don't need a hand installed copy in our development tree.
+
+ MANIFEST | 3 ---
+ Perldl2/README | 18 +++---------------
+ Perldl2/TODO | 12 +++++++-----
+ Release_Notes | 6 ++----
+ 4 files changed, 12 insertions(+), 27 deletions(-)
+
+commit 39427d544e6f3cf9b93a223f77183ea73b47f860
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 14 22:44:52 2010 -0400
+
+ Update readme-type files for PDL and Perldl2
+
+ DEPENDENCIES | 12 +++++-------
+ Known_problems | 1 -
+ Perldl2/TODO | 24 ++++++++++--------------
+ Release_Notes | 2 +-
+ 4 files changed, 16 insertions(+), 23 deletions(-)
+
+commit b94930468d98ba948998c6d181903e1b4ebf4675
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 14 15:32:08 2010 -0400
+
+ Set default MinLine to 1 again and update TODO
+
+ Tried to set MinLine required to save history to 2
+ but discovered that it then left out closing braces
+ of a cut-and-pasted sub definition. Added the
+ action for better handling of save/nosave decisions
+ to history w.r.t. multi-line entries.
+
+ Perldl2/ReadLineHistory.pm | 5 ++++-
+ Perldl2/TODO | 4 ++++
+ 2 files changed, 8 insertions(+), 1 deletions(-)
+
+commit 2f3423c9a85cd031e3f5c40772b21d38794dbe8a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 14 15:28:15 2010 -0400
+
+ Fix uniq and uniqind NaN handling re SF bug #3011659
+
+ uniq and uniqind now ignore NaN values in the computation of
+ their result. uniqvec does not handle NaN values yet but now
+ will die if NaN containing input is used---no silent failures
+ due to a wrong result. Still no clear consensus on having the
+ NaN value returned if there are any present.
+
+ Basic/Primitive/primitive.pd | 24 ++++++++++++++++++------
+ 1 files changed, 18 insertions(+), 6 deletions(-)
+
+commit 0b92ef3bd9273893411eaf1d08ae1b0c9f682c41
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 14 10:02:49 2010 -0400
+
+ Put quotes around demo args in usage for Perldl2
+
+ So folks don't get confused when the usage shows no quotes
+ and the actual use requires quotes at the moment. Once the
+ autoquote help support is completed, the message will be changed.
+
+ Perldl2/Profile/Perldl2.pm | 35 ++++++++++++++++++-----------------
+ 1 files changed, 18 insertions(+), 17 deletions(-)
+
+commit c03e0783bdb20698268f7d699bc5a326ed1e13d2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jun 13 22:10:20 2010 -0400
+
+ Fix here doc problem in Perldl2.pm
+
+ The auto indentation of the code resulted in the EOD closing
+ the hear document not being at the beginning of the line which
+ made things screwy. Probably should not use here document for
+ eval text since they are sensitive to indentation.
+
+ Perldl2/Profile/Perldl2.pm | 4 ++--
+ Perldl2/TODO | 6 +++++-
+ 2 files changed, 7 insertions(+), 3 deletions(-)
+
+commit c1021a6214af3350d834290dc092a952338a763c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jun 13 21:40:34 2010 -0400
+
+ Fix README, MANIFEST, TODO for Perldl2 work
+
+ This includes the new completion and history expansion support
+ as well as the availability---if not full integration---of the
+ PERLDL package variables.
+
+ MANIFEST | 3 +
+ Perldl2/Profile/Perldl2.pm | 135 ++++++++++++++++++++++++-------------------
+ Perldl2/TODO | 10 +++-
+ Release_Notes | 14 ++--
+ 4 files changed, 93 insertions(+), 69 deletions(-)
+
+commit 7264b53129416158748ab1f54c115e8826d79ed3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jun 13 18:26:07 2010 -0400
+
+ Add copies of git Devel::REPL plugins for install
+
+ These files allow one to use the latest and greatest
+ Devel::REPL and Perldl2 functionality until the next
+ official Devel::REPL release is made to CPAN. The
+ README for installation was updated accordingly.
+
+ Perldl2/Completion.pm | 95 ++++++++++++++++++++++----------------
+ Perldl2/History.pm | 77 ++++++++++++++++++++++++++++++
+ Perldl2/README | 15 ++++--
+ Perldl2/ReadLineHistory.pm | 111 ++++++++++++++++++++++++++++++++++++++++++++
+ 4 files changed, 254 insertions(+), 44 deletions(-)
+
+commit afc59c565b295ba8442b0d84eba1a23ab537ebea
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jun 13 15:16:50 2010 -0400
+
+ do_readline_filename_completion added to Perldl2
+
+ The default for the Devel::REPL Completion plugin is now to
+ *disable* the fallback Term::ReadLine filename completion.
+ Just setting this attribute to true to enable the desired
+ fallback for pdl2.
+
+ Perldl2/Profile/Perldl2.pm | 5 ++++-
+ Perldl2/TODO | 14 +-------------
+ 2 files changed, 5 insertions(+), 14 deletions(-)
+
+commit 3322cc5621ab5f56afb386aff423233420d0beab
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jun 12 19:12:48 2010 -0400
+
+ Update Perldl2/TODO with status
+
+ History is working for Term::ReadLine::Gnu support and partially
+ working for Term::ReadLine::Perl. Legacy $PERLDL::PREPROCESS support
+ will not be done for the Perldl2 shell and note here.
+
+ Perldl2/TODO | 21 +++++++++++++++------
+ 1 files changed, 15 insertions(+), 6 deletions(-)
+
+commit 47ba19be44717431339adb6f9809030a38ebd041
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jun 12 18:41:59 2010 -0400
+
+ Fix off-by-one for l history and a README typo
+
+ Now the Perldl2 list command gives the correct entry numbers
+ on display, i.e., ones that correspond to the GNU history
+ values. As a result, history expansion appears to now work
+ completely for Term::ReadLine::Gnu.
+
+ Basic/SourceFilter/README | 2 +-
+ Perldl2/Profile/Perldl2.pm | 5 +++--
+ 2 files changed, 4 insertions(+), 3 deletions(-)
+
+commit ab8c0e46dd98a8504a7bc4f134b660b79a2276e0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jun 12 16:14:47 2010 -0400
+
+ Fix default.perldlrc to work with Perldl2
+
+ Basic/default.perldlrc | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 9e741c1117aaec9ade66aabd2801ad0e1197ec87
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jun 12 15:53:06 2010 -0400
+
+ Fix filename completion for Perldl2 shell
+
+ Now you can TAB complete for filenames whenever no other
+ completions are found. Perldl2/README was updated on how
+ to install a copy of the latest Completion.pm from
+ Devel::REPL git until the 1.003011 release. The Globals
+ completion was removed from the default set for Perldl2
+ since if the list was too long, you usually wanted something
+ like filename completion anyway.
+
+ Perldl2/Completion.pm | 127 ++++++++++++++++++++++++++++++++++++++++++++
+ Perldl2/Profile/Perldl2.pm | 6 +-
+ Perldl2/README | 12 +++-
+ Perldl2/TODO | 6 +--
+ Release_Notes | 6 ++
+ 5 files changed, 147 insertions(+), 10 deletions(-)
+
+commit 946414528b681b74dce23e163c7f7f6f728366e8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jun 12 13:08:01 2010 -0400
+
+ Reword package support entry for perldl vs pdl2
+
+ Perldl2/TODO | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 4b2e9df9a330a1c1a63962a4d9eabe1d97ad7b87
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Fri Jun 11 20:47:36 2010 +1000
+
+ t/plplot.t - win32 portability
+
+ Skip tests 2 and 35 on Win32 as fork() is
+ apparently crippled on Windows.
+
+ t/plplot.t | 59 ++++++++++++++++++++++++++++++++++-------------------------
+ 1 files changed, 34 insertions(+), 25 deletions(-)
+
+commit afc649a896eb3fb1894dce8a8e8860a916a9d9b3
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Fri Jun 11 20:32:05 2010 +1000
+
+ Add win32 portability
+
+ Win32 requires the use of New/Newz/Safefree instead of
+ malloc/calloc/free in plAllocGrid/plFreeGrid.
+ Also need to use plFree2dGrid instead of free in plshades.
+
+ Graphics/PLplot/plplot.pd | 41 ++++++++++++++++++++++-------------------
+ 1 files changed, 22 insertions(+), 19 deletions(-)
+
+commit 3552f69c125fbcfa32a6bf5b4d35653217562356
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Fri Jun 11 20:20:11 2010 +1000
+
+ Add Win32 portability
+
+ Currently doesn't cater for Win32 dll
+ build of plplot.
+
+ Graphics/PLplot/Makefile.PL | 30 ++++++++++++++++--------------
+ 1 files changed, 16 insertions(+), 14 deletions(-)
+
+commit b49acbde81979b7cd7d83cf010040a1feee9574f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jun 10 21:59:02 2010 -0400
+
+ Update pdl2 to default 500 lines of history kept
+
+ Perldl2/pdl2 | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 9423fef79712c83bcc1db2b2877b07d3de91a59a
+Merge: 4943472 79b6146
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jun 10 20:08:42 2010 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 79b61469f944ab3463995c011c4722b0f9ecdef9
+Author: David Mertens <dcmertens.perl at gmail.org>
+Date: Thu Jun 10 11:54:23 2010 -0500
+
+ PDL::Doc documentation updates.
+
+ Added documentation for gethash explaining what it returned.
+
+ Also wrote an extensive example using a few of the PDL::Doc functions.
+
+ Doc/Doc.pm | 105 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 105 insertions(+), 0 deletions(-)
+
+commit 030cd6301b9721ab9b2da4d26d08011a995d5fda
+Author: David Mertens <dcmertens.perl at gmail.org>
+Date: Thu Jun 10 09:25:16 2010 -0500
+
+ Fixed very minor white-space issue in PDL::Doc commentary.
+
+ Doc/Doc.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 2670bda63e4c6b7a087a18161827a93c472e7ddb
+Author: David Mertens <dcmertens.perl at gmail.org>
+Date: Thu Jun 10 09:23:09 2010 -0500
+
+ PDL::Doc cleanup.
+
+ I was a bit confused going through some of this code so when I figured
+ stuff out, I made a point of adding comments.
+
+ I also modified the search function for clarity, and made it so it
+ would accept a single scalar as an argument for the field.
+
+ Doc/Doc.pm | 32 ++++++++++++++++++++------------
+ 1 files changed, 20 insertions(+), 12 deletions(-)
+
+commit 5dba524f066b817a27a79d67c3b972cd70418fd4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jun 9 18:15:02 2010 -0400
+
+ Add side-by-side ver1/ver2 compare to Perldl2/TODO
+
+ This is a checklist of features in Perldl and Perldl2
+ as have been implemented. It gives you an idea of the
+ new capabilities and how progress is going in migrating
+ existing perldl features into pdl2.
+
+ Perldl2/TODO | 331 +++++++++++++++++++++++++++++++++-------------------------
+ 1 files changed, 190 insertions(+), 141 deletions(-)
+
+commit a7d3e55ffa3bd83e6e584c5cab58d28b0f397a7b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jun 9 15:20:49 2010 -0400
+
+ Update PDL README-type files to make current
+
+ The usual "quick check" pass through the various
+ PDL README-type files to update and correct anything
+ that sticks out. Just trying to keep the meta data
+ for PDL in closer sync with the development progress.
+
+ DEPENDENCIES | 6 +--
+ INSTALL | 6 +-
+ Known_problems | 5 ++-
+ README | 2 +-
+ Release_Notes | 150 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ cygwin/INSTALL | 5 +-
+ cygwin/README | 28 ++++++-----
+ win32/INSTALL | 4 +-
+ 8 files changed, 181 insertions(+), 25 deletions(-)
+
+commit 0cb6ab632a88f150497bd5a2efc4fd0935a7008e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jun 9 14:23:32 2010 -0400
+
+ Update $PDL::VERSION to 2.4.6_010 for development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit c6f722947a0d280f9582f1422c7fb0b5e2cb29b5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jun 9 09:25:23 2010 -0400
+
+ Update MANIFEST for 2.4.6_009 developers release
+
+ MANIFEST | 285 +++++++++++++++++++++++++++++++-------------------------------
+ 1 files changed, 143 insertions(+), 142 deletions(-)
+
+commit cc9a22d8179d23af848acb29d8202d13b5013069
+Author: David Mertens <david at david-desktop.(none)>
+Date: Mon Jun 7 08:11:59 2010 -0500
+
+ FlexRaw eval tweak.
+
+ FlexRaw had an eval of a string that seemed to me like it should be an
+ eval of a block. Switching to a block should give both compiling and
+ debugging advantages, minor though they may be.
+
+ IO/FlexRaw/FlexRaw.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 4cc81a9e2c87f92711f52012d31d5e33bebb2fac
+Author: David Mertens <david at david-desktop.(none)>
+Date: Mon Jun 7 08:01:12 2010 -0500
+
+ FlexRaw: added some documentation for mapflex and made indentation easier on the eyes.
+
+ IO/FlexRaw/FlexRaw.pm | 161 ++++++++++++++++++++++++++-----------------------
+ 1 files changed, 85 insertions(+), 76 deletions(-)
+
+commit be6c0c4920b55cc93d1a19a0ca14891d8827d4c8
+Author: David Mertens <david at david-desktop.(none)>
+Date: Mon May 31 10:29:34 2010 -0500
+
+ Added more useful debug message to new-piddle-from-string.
+
+ Basic/Core/Core.pm.PL | 42 +++++++++++++++++++++++++-----------------
+ 1 files changed, 25 insertions(+), 17 deletions(-)
+
+commit 4943472a286905da767f6098fdc8dc520ad0d8af
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jun 7 08:07:33 2010 -0400
+
+ Fix spheres3d to work with x11 TriD
+
+ Need more deprecation warnings as this version of
+ TriD is not being supported. Nonetheless, try to avoid
+ unnecessary breakage in the meantime.
+
+ Graphics/TriD/TriD/GL.pm | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit d8d416d04f8f49cc0b9b21517fabd8d6376411e5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Jun 3 15:09:48 2010 -0400
+
+ Fix sf bug #3011143 re whitespace in perl path
+
+ NOTE: Just because we fix the perl path whitespace problem
+ here, please do not assume that PDL (or other perl modules)
+ are "whitespace safe".
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 68e7b117b479463b1e66ad4715872018e182e09d
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Thu Jun 3 19:03:04 2010 +1000
+
+ Perldl2/Makefile.PL - Avoid loading blib and PDL::Core::Dev
+
+ Instead do 'PDL::Core::Dev->import();'.
+
+ Perldl2/Makefile.PL | 6 +-----
+ 1 files changed, 1 insertions(+), 5 deletions(-)
+
+commit 6da87ac6c32cfd0d7b620e72ee6591f061c2dc40
+Merge: 2b812b2 b9cffa4
+Author: Matthew Kenworthy <mattk at Matthew-Kenworthys-MacBook-Pro.local>
+Date: Tue Jun 1 23:33:33 2010 +0200
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 2b812b23f5ab76c05067c71c2758f6f33283d82a
+Author: Matthew Kenworthy <mattk at Matthew-Kenworthys-MacBook-Pro.local>
+Date: Tue Jun 1 23:30:47 2010 +0200
+
+ Rolled in Karl Glazebrook Year Zero chapter
+
+ Basic/Pod/Book/Philosophy.pod | 170 ++++++++++++++++++++++++++++++-----------
+ 1 files changed, 124 insertions(+), 46 deletions(-)
+
+commit b9cffa402ea6eed06a506776c5ca318da21aa241
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 1 14:45:28 2010 -0400
+
+ Cleanup Perldl2/{README,TODO} some
+
+ Perldl2/README | 21 +++++++++++++++------
+ Perldl2/TODO | 3 ++-
+ 2 files changed, 17 insertions(+), 7 deletions(-)
+
+commit cbfb8bfdb54d723da9567b2cc73e4dcc505a6a9a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 1 13:08:58 2010 -0400
+
+ Update DEPENDENCIES with Devel::REPL info
+
+ DEPENDENCIES | 14 ++++++--------
+ 1 files changed, 6 insertions(+), 8 deletions(-)
+
+commit e787154ba94af800bd9e217c2dd1f1e6092b9e18
+Author: David Mertens <dcmertens at gmail.com>
+Date: Tue Jun 1 10:46:27 2010 -0500
+
+ Added write_dummy_make to Perldl2's Makefile.PL.
+
+ I needed Perldl2's Makefile.PL to generate a dummy makefile because I
+ don't have Devel::REPL. The general make process expects a makefile
+ in Perldl2 whether it's going to be installed or not, so I added
+ some stuff to generate the dummy makefile.
+
+ In order for this to work for me, I also had to add a number of lines
+ to load perldl.conf and PDL::Core::Dev. You can now safely run Makefile.PL
+ from Perldl2's directory, and it will Do What You Mean (unlike most other
+ Makefile.PL files scattered throughout the source tree).
+
+ Perldl2/Makefile.PL | 30 +++++++++++++++++++++++++++++-
+ 1 files changed, 29 insertions(+), 1 deletions(-)
+
+commit 633155d91e4f2af1afc9d7b5e3a2f4c9b0943eb9
+Author: David Mertens <dcmertens at gmail.com>
+Date: Tue Jun 1 10:01:34 2010 -0500
+
+ Updated PLplot bindings.
+
+ The most recent updates include updated documentation, better
+ argument handling for stripplots, and badvalue support for
+ y-data in plline (and therefore xyplot).
+
+ Graphics/PLplot/plplot.pd | 128 ++++++++++++++++++++++++++++++++++++--------
+ 1 files changed, 104 insertions(+), 24 deletions(-)
+
+commit 69f705605cbc09f0b4817ce8225a058befab6b49
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jun 1 10:14:06 2010 -0400
+
+ Update Perldl2/TODO and Release_Notes for ! syntax
+
+ There is an inconsistency between the history kept
+ from the History plugin and that from the ReadLineHistory.
+ This adds mention in the Release_Notes and a TODO item
+ for the Perldl2 development.
+
+ Perldl2/TODO | 9 ++++++++-
+ Release_Notes | 4 ++++
+ 2 files changed, 12 insertions(+), 1 deletions(-)
+
+commit 343d0ae7d44f8c01d61dff4df354ff1990921f89
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 31 21:48:41 2010 -0400
+
+ Update Release_Notes for Perldl2 l and demo info
+
+ The 'l' command works for listing history.
+ The 'demo' command works partially. You will need to quote
+ the demo name argument and at the end of the demo, it may
+ hang waiting for input. On unix-type systems, Ctrl-D should
+ exit at that time. For win32, you'll have to exit the shell
+ and restart for now.
+
+ Release_Notes | 7 ++++---
+ 1 files changed, 4 insertions(+), 3 deletions(-)
+
+commit f663dcd773c9c476242f31ce73afa840e8e269f4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 31 21:43:11 2010 -0400
+
+ Mention l and demo support in Perldl2 shell
+
+ Release_Notes | 21 +++++++++++++++++++++
+ 1 files changed, 21 insertions(+), 0 deletions(-)
+
+commit 6f963ef7aa3d4c469038ff886482297bddb54abb
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 31 21:39:04 2010 -0400
+
+ Add support for demo in the Perldl2 shell
+
+ You still have to quote the demo name argument
+ and you may need to type Ctrl-D to exit the demo
+ if it gets stuck at the end waiting for you to
+ (press enter).
+
+ Perldl2/Profile/Perldl2.pm | 60 +++++++++++++++++++++++++++++++++++++++++++-
+ Perldl2/README | 6 +++-
+ Perldl2/TODO | 11 +++++---
+ 3 files changed, 71 insertions(+), 6 deletions(-)
+
+commit 3abfbf37c6ea5487225529717a66e044209ba9e4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 31 20:08:04 2010 -0400
+
+ Add list history 'l' command to Perldl2 shell
+
+ Perldl2/Profile/Perldl2.pm | 8 +++++++-
+ Perldl2/README | 8 +++-----
+ Perldl2/TODO | 6 +-----
+ 3 files changed, 11 insertions(+), 11 deletions(-)
+
+commit e0b733bc5a168b1a93d085d4937a46ca6a5cce5a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 31 18:05:11 2010 -0400
+
+ Split out Perldl2/TODO from Perldl2/README
+
+ I don't want to scare anybody away while things are a bit
+ rough. It would be nice to more easily track what is being
+ done and what still needs doing in case of volunteers.
+
+ Perldl2/README | 180 +++++++++----------------------------------------------
+ Perldl2/TODO | 138 +++++++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 168 insertions(+), 150 deletions(-)
+
+commit 48c1a3efde54dd3cd59b630dc143e103ab09904d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 31 12:44:12 2010 -0400
+
+ Update version to 2.4.6_009 for more development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 81068e90a37842b3aba43268e9cc463984dd8bad
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 31 12:22:16 2010 -0400
+
+ Update MANIFEST for new CPAN dev release
+
+ MANIFEST | 304 +++++++++++++++++++++++++++++++-------------------------------
+ 1 files changed, 151 insertions(+), 153 deletions(-)
+
+commit d736825882d89b7e1d7c3b08fdf25ac8cc719d1c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 31 10:40:43 2010 -0400
+
+ Implement rudimentary spheres3d for TriD
+
+ Per-sphere radius and color not yet implemented but this
+ is a start. Also need to add proper normals with interpolation
+ so the shading comes out smooth.
+
+ Graphics/TriD/TriD.pm | 33 +++++++++++++++++++++++++++++++--
+ Graphics/TriD/TriD/GL.pm | 16 ++++++++++++++++
+ Graphics/TriD/TriD/Objects.pm | 8 ++++++++
+ Release_Notes | 4 ++++
+ 4 files changed, 59 insertions(+), 2 deletions(-)
+
+commit e8ffb02d7b8f232c82410bb02f7a0f976865c345
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 31 00:23:42 2010 -0400
+
+ Update Release_Notes with .perldl_hist support
+
+ Release_Notes | 8 ++++++++
+ 1 files changed, 8 insertions(+), 0 deletions(-)
+
+commit 1cad162e09647dce3adc81dced4e6114e867743a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 31 00:14:51 2010 -0400
+
+ Make Perldl2 use ~/.perldl_hist for history file
+
+ Can't yet do the .perldlrc because still have back compatible
+ features to implement...
+
+ Perldl2/pdl2 | 11 ++++++++++-
+ 1 files changed, 10 insertions(+), 1 deletions(-)
+
+commit aecb52edf519c6ea4758c8227989ec6a705e63ea
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 30 16:10:39 2010 -0400
+
+ Update Release_Notes for Perldl2 install info
+
+ Release_Notes | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit c1e1238f0748c48fddb9cea7f3810edf7f9c13a2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 30 16:09:18 2010 -0400
+
+ Update Perldl2/README now that pdl2 is installed
+
+ Perldl2/README | 18 +++++++-----------
+ Perldl2/pdl2.bat | 21 ---------------------
+ 2 files changed, 7 insertions(+), 32 deletions(-)
+
+commit 44d09061de67e0cce9d744046132776b67d26c54
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 30 15:57:15 2010 -0400
+
+ Add install support for pdl2 script
+
+ Perldl2/Makefile.PL | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit afe6605543fc4b43a51d5614805986100fc1e62e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 30 14:21:20 2010 -0400
+
+ Update Release_Notes for Perldl2
+
+ Release_Notes | 14 ++++++--------
+ 1 files changed, 6 insertions(+), 8 deletions(-)
+
+commit 0b9040810665f1a903f80db4b90301109c443a41
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 30 14:19:19 2010 -0400
+
+ Fix accidental change to perldl.conf
+
+ perldl.conf | 14 +++++++-------
+ 1 files changed, 7 insertions(+), 7 deletions(-)
+
+commit d83179993e7de32587f546a17bbe4127e64ece9d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 30 13:52:42 2010 -0400
+
+ Add rough build/install support for Perldl2
+
+ This should be enough for folks to try things out without
+ having to hand copy install files to hand determined locations.
+
+ Perldl2/Makefile.PL | 16 +
+ Perldl2/NiceSlice.pm | 75 -
+ Perldl2/Perldl2.pm | 162 --
+ Perldl2/Plugin/Makefile.PL | 10 +
+ Perldl2/Plugin/NiceSlice.pm | 75 +
+ Perldl2/Plugin/PrintControl.pm | 77 +
+ Perldl2/PrintControl.pm | 77 -
+ Perldl2/Profile/Makefile.PL | 7 +
+ Perldl2/Profile/Perldl2.pm | 165 +++
+ Perldl2/README | 72 +-
+ Perldl2/TieHash.pm | 38 -
+ Perldl2/pdl2 | 2 +-
+ Perldl2/pdl2.bat | 3 +-
+ Perldl2/pod-plate | 45 -
+ Perldl2/readline-fix/Gnu.xs | 3002 --------------------------------------
+ Perldl2/readline-fix/Makefile | 983 -------------
+ Perldl2/readline-fix/Makefile.PL | 217 ---
+ Perldl2/readline-fix/README | 84 --
+ perldl.conf | 14 +-
+ 19 files changed, 379 insertions(+), 4745 deletions(-)
+
+commit 59d931a365cf1e09bf7526fb085f660757c1b67d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 30 08:39:38 2010 -0400
+
+ Work around perl -d for t/gsl_mroot.t
+
+ Also updated the POD code example in gsl_mroot.pd to
+ include the work around.
+
+ Lib/GSL/MROOT/gsl_mroot.pd | 9 +++++++--
+ t/gsl_mroot.t | 5 +++--
+ 2 files changed, 10 insertions(+), 4 deletions(-)
+
+commit 3b490b620b3e16ea5eb1c3fff8726756925d93f8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 29 19:19:24 2010 -0400
+
+ Update Known_problems and Release_Notes for CPAN
+
+ A new CPAN developers release is planned with the work around
+ for the known perl -d "feature" against PDL usage of lvalue
+ subs. Not a solution, but tests can be run under the debugger.
+
+ Known_problems | 24 ++++++++++++++++++------
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 2 files changed, 50 insertions(+), 6 deletions(-)
+
+commit 353df1776748c0e5d6d4e9cff5770280131994d3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 29 18:54:10 2010 -0400
+
+ Fix transform.pd for perl -d "feature"
+
+ Lib/Transform/transform.pd | 81 ++++++++++++++++++++++++++++---------------
+ 1 files changed, 53 insertions(+), 28 deletions(-)
+
+commit 5ae4e680076641e8012f646053258ded99b16608
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 29 18:27:18 2010 -0400
+
+ Workaround perl -d "feature" for IO/Misc/misc.pd
+
+ IO/Misc/misc.pd | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 945328134dd44d038e6a0fed42013c2bb9208ad3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 29 16:04:03 2010 -0400
+
+ Fix matrixops stuff to avoid lvalue temps
+
+ Basic/MatrixOps/matrixops.pd | 22 +++++++++++++++-------
+ t/matrixops.t | 9 ++++++---
+ 2 files changed, 21 insertions(+), 10 deletions(-)
+
+commit ff633c8ee344ecee550145b8561f686ee9eb825c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 29 15:46:04 2010 -0400
+
+ Add skip to test if run under the perl debugger
+
+ There is a new "feature" in the perl debugger which breaks
+ lvalue subs usage for PDL. This skips the test if it is
+ run under the debugger.
+
+ t/lvalue.t | 4 +++-
+ 1 files changed, 3 insertions(+), 1 deletions(-)
+
+commit 70e7813d9a5fe463349192ec2058a7c47545c9b5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 29 15:45:14 2010 -0400
+
+ Add lvalue temp workaround to ImageND
+
+ Lib/ImageND/imagend.pd | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit b523b7b1693048d9a6ec8e71c4bcdfc3443f8f23
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 29 14:26:38 2010 -0400
+
+ Add Convert::UU to PDL requirements list
+
+ Yes, I know this is yet another dependency but it is an all perl
+ replacement for the uuencode/uudecode needed for PDL::IO::Dumper.
+ This should not affect performance as the faster system calls to
+ uuencode/uudecode will still be made if available. However, now
+ PDL::IO::Dumper should work on every PDL platform.
+
+ DEPENDENCIES | 7 ++++---
+ Makefile.PL | 1 +
+ 2 files changed, 5 insertions(+), 3 deletions(-)
+
+commit c1ae401a1d2d63e673bc2a5f7fafcbaa99aa0f2f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 29 13:54:54 2010 -0400
+
+ Remove skip for win32 platforms
+
+ The problem was that you need a uuencode/uudecode functionality.
+ We check explicitly for uuencode/uudecode or Convert::UU so
+ the platform skip is no longer needed or justified.
+
+ t/dumper.t | 4 ----
+ 1 files changed, 0 insertions(+), 4 deletions(-)
+
+commit 35c519b860cb07eb1834fbba50fdd6b8e45a39cc
+Author: Shlomi Fish <shlomif at iglu.org.il>
+Date: Thu May 27 16:00:21 2010 -0500
+
+ Fixed format string attack errors in GSL, PGPLOT, and Transform.
+
+ See previous commits. For a discussion of why this is considered a
+ problem, see http://en.wikipedia.org/wiki/Format_string_attack
+
+ Graphics/PGPLOT/Window/Window.xs | 2 +-
+ Lib/GSL/INTERP/gslerr.h | 2 +-
+ Lib/GSL/SF/coulomb/gsl_sf_coulomb.pd | 4 ++--
+ Lib/Transform/transform.pd | 20 ++++++++++----------
+ 4 files changed, 14 insertions(+), 14 deletions(-)
+
+commit da8ab6f1fe0a72e4df1bb08014ab6790c1975e0f
+Author: David Mertens <david at david-desktop.(none)>
+Date: Thu May 27 14:00:58 2010 -0500
+
+ Fixed varargs/stdargs issues with barf in slices.pd.
+
+ Reported by shlomi (rindolf) on irc, slices.pd was not compiling because
+ it was giving a non-constant string to barf, which is croak, which
+ behaves a lot like prinft. gcc insists that the specification string
+ to printf and similar functions is a string literal. This fixes that
+ problem in slices.pd.
+
+ It appears that the original code couldn't decide if barf just took
+ a single string argument or a variable number of arguments, so they
+ used sprintf and put the message in a buffer string. I simply
+ copied the contents of the sprintf statement and gave it to
+ the barf function call.
+
+ Basic/Slices/slices.pd | 20 ++++++++++++++------
+ 1 files changed, 14 insertions(+), 6 deletions(-)
+
+commit bc959b287ad4be6c1451c771390a5509527b3982
+Author: David Mertens <david at david-desktop.(none)>
+Date: Thu May 27 13:18:00 2010 -0500
+
+ Added entries to .gitignore.
+
+ Build files for FFTW and HDF were not yet in .gitignore, so I
+ added them.
+
+ .gitignore | 7 +++++++
+ 1 files changed, 7 insertions(+), 0 deletions(-)
+
+commit aaff83688f6797028d050b7cb466f4ed53c56549
+Author: David Mertens <david at david-desktop.(none)>
+Date: Thu May 27 12:44:31 2010 -0500
+
+ Cleaning errors out of pdlcore.c
+
+ .gitignore | 3 +++
+ Basic/Core/pdlcore.c.PL | 6 +++---
+ 2 files changed, 6 insertions(+), 3 deletions(-)
+
+commit 6c5527f1251c0da3cc6a48b4a31b262dee1bed3e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 25 10:46:56 2010 -0400
+
+ Document default 200x200 min imag2d size
+
+ This was missing from the POD and I was puzzled when the
+ image did not seem to be imaged at 1:1 scale. An idea
+ would be to display the current zoom with the image to
+ keep things straight.
+
+ imag2d.pdl | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 5d4bcc830cb58256e2504b7fda1fa7179daf306b
+Author: Craig DeForest <zowie at dhcp-10-120.boulder.swri.edu>
+Date: Mon May 24 16:45:28 2010 -0600
+
+ Fixed rice compression case where the compressed tile size (in bytes) does not
+ divide evenly into the size of the final datatype.
+
+ IO/FITS/FITS.pm | 22 ++++++++++++++++++----
+ 1 files changed, 18 insertions(+), 4 deletions(-)
+
+commit d2c15aff08950a71745aa1474d69d9c70ca61f2e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 23 21:44:40 2010 -0400
+
+ Update MANIFEST with make manifest
+
+ I noticed that it had not been updated when some warning messages
+ were returned from the 2.4.6_007 CPAN developers release. This
+ should fix that problem.
+
+ MANIFEST | 21 ++++++++++++++++++++-
+ 1 files changed, 20 insertions(+), 1 deletions(-)
+
+commit 495018cea8a2151f5bf4e3160cd05e7a0d84237e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 23 12:06:44 2010 -0400
+
+ Update Perldl2/README with new Devel::REPL build
+
+ Now that there is an official Devel::REPL release with the
+ fixes supporting Perldl2 development, we no longer need to
+ bundle a tar file of the distribution with the Perldl2 stuff.
+
+ Perldl2/Devel-REPL-1.003009_02.tar.gz | Bin 47951 -> 0 bytes
+ Perldl2/README | 62 ++++++++++++---------------------
+ 2 files changed, 22 insertions(+), 40 deletions(-)
+
+commit 0eb3dd8196b7d303f8f23cf83ebc484d820eb46d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 22 15:32:45 2010 -0400
+
+ Update $PDL::VERSION to 2.4.6_008
+
+ For development to continue following the PDL-2.4.6_007
+ CPAN developers release.
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit fb0726323a58ba33f5177497e54fcd82ff43fdc1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 22 15:30:56 2010 -0400
+
+ Minor cleanup for PDL-2.4.6_007 developers release
+
+ Removed Graphics/TriD/TriD/Cube.pm as it never had code.
+ Also updated Known_Problems and MANIFEST for the new
+ developers release.
+
+ Graphics/TriD/TriD/Cube.pm | 5 -----
+ Known_problems | 3 ++-
+ MANIFEST | 8 ++++----
+ 3 files changed, 6 insertions(+), 10 deletions(-)
+
+commit 719dd4dade61f66eec2d673c8347bd0e4bcd01f2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 21 18:09:50 2010 -0400
+
+ Add POD to Perldl2 modules
+
+ Also updated Perldl2/README and added a pod-plate file
+ with the template for POD and my copyright information.
+
+ Perldl2/NiceSlice.pm | 48 +++++++++++++++++++++++++++++++++
+ Perldl2/Perldl2.pm | 67 ++++++++++++++++++++++++++++++++++++++++++++++-
+ Perldl2/PrintControl.pm | 56 +++++++++++++++++++++++++++++++++++++++
+ Perldl2/README | 7 +++--
+ Perldl2/pod-plate | 45 +++++++++++++++++++++++++++++++
+ 5 files changed, 219 insertions(+), 4 deletions(-)
+
+commit 8127a7786e11dc1be81cfab4fb6abd66b0ee3443
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 21 10:12:27 2010 -0400
+
+ Move TODO to wiki page for review
+
+ The current TODO file is languishing because of all the dead
+ wood. It has been pointed out in recent mailing list threads
+ that irrelevant and incomplete TODO lists give a poor impression
+ of PDL development to potential new contributers. Also, with
+ all the new interest, we need a way to keep focus on priorities
+ to keep moving forward.
+
+ TODO | 287 +----------------------------------------------------------------
+ 1 files changed, 5 insertions(+), 282 deletions(-)
+
+commit 0188c5895963fac8542b696074be7d58891237dd
+Author: David Mertens <david at david-desktop.(none)>
+Date: Thu May 20 14:03:02 2010 -0500
+
+ Very minor updates to the VS docs.
+
+ IO/HDF/VS/VS.pd | 11 ++++++++---
+ 1 files changed, 8 insertions(+), 3 deletions(-)
+
+commit 09b5d4d582273df39228d8ca8c0f157ad6ae46c0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 19 13:32:15 2010 -0400
+
+ Re-fix the default pdl2 package and no strict
+
+ The two fixes were accidentally removed during
+ an iteration of testing. Back now.
+
+ Perldl2/Perldl2.pm | 5 +++--
+ Perldl2/README | 27 ++++++++++++++-------------
+ 2 files changed, 17 insertions(+), 15 deletions(-)
+
+commit 164432c1e42345e1ca4efb3a15d643f256e15aa8
+Author: David Mertens <david at david-desktop.(none)>
+Date: Wed May 19 11:18:27 2010 -0500
+
+ Linked cat/append/glue references and updated primitive for CPAN viewing.
+
+ Basic/Core/Core.pm.PL | 4 +
+ Basic/Primitive/primitive.pd | 610 ++++++++++++++++++++++++++++++++----------
+ 2 files changed, 471 insertions(+), 143 deletions(-)
+
+commit cbeec05057f741c4b30fcaa0de8bdb44d71df8d0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 18 22:29:12 2010 -0400
+
+ Show loaded Perldl2 plugins on startup
+
+ Perldl2/Perldl2.pm | 16 +++++++++++++++-
+ Perldl2/README | 10 +---------
+ 2 files changed, 16 insertions(+), 10 deletions(-)
+
+commit 276ffdcb917d73ee6cda86c4c59635f9bdc85101
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 18 22:07:36 2010 -0400
+
+ Add ability to toggle default print for Perldl2
+
+ There is an attribute do_print with a like named
+ accessor method which can be used to enable or disable
+ printing by default the result of the REPL loop iteration.
+ $_REPL->do_print(0) turns printing off (Perldl2 default)
+ $_REPL->do_print(1) turns printing on (Devel::REPL default)
+
+ Perldl2/PrintControl.pm | 7 ++++++-
+ Perldl2/README | 13 +++++++------
+ 2 files changed, 13 insertions(+), 7 deletions(-)
+
+commit 6ba2bd11acd93538d43253fb4292c14338cddcd1
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue May 18 16:59:42 2010 -0400
+
+ Minor change to Guide.pod
+
+ Fix typo (RBG->RGB), put head1 NAME on one line for easier perldoc
+ parsing.
+
+ Basic/Pod/Guide.pod | 5 ++---
+ 1 files changed, 2 insertions(+), 3 deletions(-)
+
+commit 9c143a8dcdca72b4b740e051072ba439957368fe
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 18 14:21:58 2010 -0400
+
+ Update Perldl2/README to clarify
+
+ Perldl2/README | 213 ++++++++++++++++++++++++++-----------------------------
+ 1 files changed, 101 insertions(+), 112 deletions(-)
+
+commit 8d938c2fd49de785358ceb083e2868eaf974791f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 18 13:59:12 2010 -0400
+
+ Set $, to space for p alias in Perldl2
+
+ Perldl2/Perldl2.pm | 9 ++++-----
+ 1 files changed, 4 insertions(+), 5 deletions(-)
+
+commit 7f3549fa5a80453be3036aba46c550a5b87a3e8e
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Mon May 17 22:31:40 2010 +0200
+
+ Book: Fix a bug with HTML generator.
+
+ Basic/Pod/Book/make-book.pl | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f1c5b2700eda910a49d618181903d187676f4c3c
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Mon May 17 22:25:05 2010 +0200
+
+ PDL Book: CSS for HTML generator.
+
+ Basic/Pod/Book/pdl-book.css | 8 ++++++++
+ 1 files changed, 8 insertions(+), 0 deletions(-)
+
+commit 72f334dc729c09d1f1bba282b629e51e6802a94b
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Mon May 17 22:20:29 2010 +0200
+
+ Book: First stab at a PDL book HTML generator.
+
+ Basic/Pod/Book/make-book.pl | 175 +++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 175 insertions(+), 0 deletions(-)
+
+commit 5c76b0c79386560e47663432209160c2d531da7a
+Author: David Mertens <dcmertens at gmail.com>
+Date: Mon May 17 09:35:39 2010 -0500
+
+ Another minor change to the wording of the PDL::PP paragraph.
+
+ Basic/Pod/Book/MATLAB.pod | 2 +-
+ Basic/Pod/Book/Scilab.pod | 2 +-
+ 2 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 34927c4631ce5bc8557df6c1616f72f8c2ed9701
+Author: David Mertens <dcmertens at gmail.com>
+Date: Mon May 17 08:21:53 2010 -0500
+
+ A few wording changes to the migration guides.
+
+ Basic/Pod/Book/MATLAB.pod | 4 ++--
+ Basic/Pod/Book/Scilab.pod | 4 ++--
+ 2 files changed, 4 insertions(+), 4 deletions(-)
+
+commit dd8464437ddce839551af9f448d061bd0f291530
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 17 08:59:54 2010 -0400
+
+ Add clean fail as todo to Perldl2/README
+
+ Devel::REPL is very powerful, but the stack trace one gets
+ if something is missing is *horrible*. This was a note to
+ add better error handling with graceful degradation rather
+ than just dying. e.g., if something is missing, don't load
+ it and continue if possible...with a warning message.
+
+ Perldl2/README | 5 ++++-
+ 1 files changed, 4 insertions(+), 1 deletions(-)
+
+commit 825850f3a1e52a56466bd9e449a7437544ba6230
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Mon May 17 13:51:09 2010 +0200
+
+ Book: Move several non-reference document to the new "book" section.
+
+ Basic/Pod/Book/FAQ.pod | 1872 +++++++++++++++++++++++++++++++++++++++++
+ Basic/Pod/Book/Indexing.pod | 1561 ++++++++++++++++++++++++++++++++++
+ Basic/Pod/Book/Philosophy.pod | 70 ++
+ Basic/Pod/Book/QuickStart.pod | 615 ++++++++++++++
+ Basic/Pod/Book/Threading.pod | 961 +++++++++++++++++++++
+ Basic/Pod/Book/Tips.pod | 129 +++
+ Basic/Pod/FAQ.pod | 1872 -----------------------------------------
+ Basic/Pod/Indexing.pod | 1561 ----------------------------------
+ Basic/Pod/Philosophy.pod | 70 --
+ Basic/Pod/QuickStart.pod | 615 --------------
+ Basic/Pod/Threading.pod | 961 ---------------------
+ Basic/Pod/Tips.pod | 129 ---
+ 12 files changed, 5208 insertions(+), 5208 deletions(-)
+
+commit fc5470223b1df7ad4940f3a50135a443f9a943ff
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Mon May 17 13:46:14 2010 +0200
+
+ Book: Replace "PDL::Migration" -> "PDL::Book"
+
+ Basic/Pod/Book/MATLAB.pod | 2 +-
+ Basic/Pod/Book/Scilab.pod | 2 +-
+ 2 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 403ebbe4bd3aa601c726c258b1d94457014e5eb1
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Mon May 17 13:00:17 2010 +0200
+
+ Documentation: First steps toward a PDL book.
+
+ Created a new 'Book' directory where I hope to create a new PDL book.
+
+ Basic/Pod/Book/MATLAB.pod | 865 ++++++++++++++++++++++++++++++++++++++++
+ Basic/Pod/Book/Scilab.pod | 815 +++++++++++++++++++++++++++++++++++++
+ Basic/Pod/Migration.pod | 34 --
+ Basic/Pod/Migration/MATLAB.pod | 865 ----------------------------------------
+ Basic/Pod/Migration/Scilab.pod | 815 -------------------------------------
+ 5 files changed, 1680 insertions(+), 1714 deletions(-)
+
+commit 5789093253079406e974cd391de9900d94e7b6ce
+Merge: 19cbde7 92a971f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 17 06:27:26 2010 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 19cbde762fa9f047295715d3fc706e8983cceaff
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 17 06:25:26 2010 -0400
+
+ Update Perldl2/README with platform support
+
+ Somehow with all the talk about win32, people seem to
+ have gotten the idea that all this work is for that
+ system only. Make explicit that this is for all OS
+ and platforms.
+
+ Perldl2/README | 22 +++++++++++++---------
+ 1 files changed, 13 insertions(+), 9 deletions(-)
+
+commit 92a971f67a12dd107c10f7669a69617d2d719850
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon May 17 08:09:33 2010 +0200
+
+ add descriptions to tests in hdf_st.t
+
+ t/hdf_sd.t | 62 ++++++++++++++++++++++++++++++------------------------------
+ 1 files changed, 31 insertions(+), 31 deletions(-)
+
+commit 947d22199516e62162afa017f6dad83a0daf3d97
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 16 22:46:16 2010 -0400
+
+ Add another missing feature to Perldl2/README
+
+ Perldl2/README | 8 +++++---
+ 1 files changed, 5 insertions(+), 3 deletions(-)
+
+commit 7caf9e417f1e6787e248de31f55609edd310e55c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 16 18:34:11 2010 -0400
+
+ Add "\n" to print lines for Perldl2
+
+ There is some sort of inconsistency between the introduction
+ of newlines from the Term::ReadLine::Gnu and Term::ReadLine::Perl.
+ There seems to be an extra one now for TR::Gnu but at least the
+ lines don't run on for either now.
+
+ Perldl2/Perldl2.pm | 10 +++++-----
+ 1 files changed, 5 insertions(+), 5 deletions(-)
+
+commit 15d78ce70aa721cfd0c670ef8d9e4aa29c78f6ac
+Merge: 0b98645 e3c50c1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 16 15:33:57 2010 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 0b98645eb43006398c01dd4e47558d80e82739ea
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 16 15:32:24 2010 -0400
+
+ Add pdl2, pdl2.bat to run Perldl2 + update README
+
+ Still have to manually install things but it looks a lot
+ more like a perldl replacement/upgrade.
+
+ Perldl2/README | 78 ++++++++++++++++++++++++++++++++++++++---------------
+ Perldl2/pdl2 | 5 +++
+ Perldl2/pdl2.bat | 20 ++++++++++++++
+ 3 files changed, 81 insertions(+), 22 deletions(-)
+
+commit 2907282abcabfb201f2ec7ee8043e0a958058622
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun May 16 15:31:03 2010 -0400
+
+ Enable perldl v1 style no-print of return values
+
+ The PrintControl plugin implements a first version of
+ this and the Perldl2 profile has been updated to load
+ that as well.
+
+ Perldl2/Perldl2.pm | 16 ++++++++++++----
+ Perldl2/PrintControl.pm | 16 ++++++++++++++++
+ 2 files changed, 28 insertions(+), 4 deletions(-)
+
+commit e3c50c11dc278e6ee3457c534138b46bf9a5150d
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sun May 16 14:47:05 2010 +0200
+
+ Changed copyright license in IO.pod with permission from the author.
+
+ With permission from the author (see pdl-porters mailing list) I
+ changed the copyright notice in IO.pod to say that the document can
+ be modified and/or distributed under the same terms as the current
+ Perl license.
+
+ IO/IO.pod | 13 ++++++++-----
+ 1 files changed, 8 insertions(+), 5 deletions(-)
+
+commit ab7f49e1a6946e1632ef1f637d6e7936d47f0966
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sun May 16 14:40:19 2010 +0200
+
+ Changed copyright notice in API.pod with permission from the author.
+
+ With permission from the author (see pdl-porters mailing list) I
+ changed the copyright notice of API.pod to say that the document
+ can be modified and/or distributed under the same terms as the
+ current Perl license.
+
+ Basic/Pod/API.pod | 10 ++++++----
+ 1 files changed, 6 insertions(+), 4 deletions(-)
+
+commit c5980b692452706244f903bf7aca93d6b9659c5a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 15 14:52:14 2010 -0400
+
+ rm REPL.pm and update README
+
+ The relevant code is now in the Devel-REPL-1.003009_02.tar.gz
+
+ Perldl2/README | 7 +-
+ Perldl2/REPL.pm | 427 -------------------------------------------------------
+ 2 files changed, 1 insertions(+), 433 deletions(-)
+
+commit 31e0c88be9a8381da4cf6f978a6642f3d8b7890d
+Merge: a21804a e2001f6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 15 13:37:01 2010 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit a21804a223c701df6556e2a0b1698c2e133f5f09
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 15 13:36:07 2010 -0400
+
+ Update Devel::REPL snapshot and README for Perldl2
+
+ Perldl2/Devel-REPL-1.003009_01.tar.gz | Bin 47600 -> 0 bytes
+ Perldl2/Devel-REPL-1.003009_02.tar.gz | Bin 0 -> 47951 bytes
+ Perldl2/README | 6 +++---
+ 3 files changed, 3 insertions(+), 3 deletions(-)
+
+commit e2001f6e3dee3907956f5dbdde82d3b16f0a8767
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sat May 15 19:26:51 2010 +0200
+
+ Documentation: Use postfix notation for all method calls.
+
+ Replase "foo $A" with "$A->foo". The prefix method looks like a
+ function and invites the use to write "foo($A)" which works
+ inconsistently.
+
+ Basic/Pod/Migration/MATLAB.pod | 26 +++++++++++++-------------
+ Basic/Pod/Migration/Scilab.pod | 18 +++++++++---------
+ 2 files changed, 22 insertions(+), 22 deletions(-)
+
+commit 91bc8eba2f159b61e1d9d9e6078b90c85add86e6
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sat May 15 18:49:30 2010 +0200
+
+ Documentation: Change description of PDL::PP in migration guides.
+
+ Basic/Pod/Migration/MATLAB.pod | 13 +++++--------
+ Basic/Pod/Migration/Scilab.pod | 11 +++++------
+ 2 files changed, 10 insertions(+), 14 deletions(-)
+
+commit ca44a04ece66d61b870d42867debed127dee5ed8
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sat May 15 18:40:06 2010 +0200
+
+ Clarify copyright license for my own files.
+
+ Clearly state that the files can be modified and/or distributed under
+ the same terms as the current Perl license.
+
+ Basic/Pod/Migration/MATLAB.pod | 6 +++---
+ Basic/Pod/Migration/Scilab.pod | 6 +++---
+ 2 files changed, 6 insertions(+), 6 deletions(-)
+
+commit a8c3a14e15635219f010461a422d0aca8fb79cf7
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sat May 15 18:35:00 2010 +0200
+
+ Update Copyright notices.
+
+ With permission from the authors (see list archives) I am updating
+ the copyright notices of three files to clearly state that they can
+ be distributed and/or modified under the current Perl license.
+
+ Basic/Pod/Guide.pod | 9 +++++++++
+ Basic/Pod/Migration.pod | 8 ++++++++
+ Basic/Pod/Threading.pod | 4 +++-
+ 3 files changed, 20 insertions(+), 1 deletions(-)
+
+commit 08e0b80e20e8736165cb64f196a98b8caaa753ef
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 15 11:54:31 2010 -0400
+
+ Rename the Padre directory to Perldl2
+
+ It turns out that the directory has become mostly Perldl2
+ development. The next step is to make a version of the
+ new shell that is built and installed with PDL. This directory
+ rename is the first step. Updated MANIFEST, README, and
+ Release_Notes with the new directory path.
+
+ MANIFEST | 14 +-
+ Padre/Devel-REPL-1.003009_01.tar.gz | Bin 47600 -> 0 bytes
+ Padre/NiceSlice.pm | 27 -
+ Padre/Perldl2.pm | 75 -
+ Padre/README | 267 ---
+ Padre/REPL.pm | 427 -----
+ Padre/TieHash.pm | 38 -
+ Padre/readline-fix/Gnu.xs | 3002 ---------------------------------
+ Padre/readline-fix/Makefile | 983 -----------
+ Padre/readline-fix/Makefile.PL | 217 ---
+ Padre/readline-fix/README | 84 -
+ Perldl2/Devel-REPL-1.003009_01.tar.gz | Bin 0 -> 47600 bytes
+ Perldl2/NiceSlice.pm | 27 +
+ Perldl2/Perldl2.pm | 75 +
+ Perldl2/README | 267 +++
+ Perldl2/REPL.pm | 427 +++++
+ Perldl2/TieHash.pm | 38 +
+ Perldl2/readline-fix/Gnu.xs | 3002 +++++++++++++++++++++++++++++++++
+ Perldl2/readline-fix/Makefile | 983 +++++++++++
+ Perldl2/readline-fix/Makefile.PL | 217 +++
+ Perldl2/readline-fix/README | 84 +
+ README | 2 +-
+ Release_Notes | 21 +
+ 23 files changed, 5149 insertions(+), 5128 deletions(-)
+
+commit e143b805757a4af082cc657c00f7e6bedc89b401
+Author: David Mertens <dcmertens at gmail.com>
+Date: Sat May 15 08:55:53 2010 -0500
+
+ Added tentative PDL::Beta searching to Autoloader.
+
+ The code is presently commented out, pending approval from the porters.
+
+ Basic/AutoLoader.pm | 11 ++++++++++-
+ 1 files changed, 10 insertions(+), 1 deletions(-)
+
+commit e57eec31e9f4483977164d908a0534e21a9fa673
+Author: David Mertens <dcmertens at gmail.com>
+Date: Sat May 15 06:50:31 2010 -0500
+
+ Clarified the migration guides' discussion of PDL::PP.
+
+ Basic/Pod/Migration/MATLAB.pod | 10 ++++++----
+ Basic/Pod/Migration/Scilab.pod | 12 ++++++------
+ 2 files changed, 12 insertions(+), 10 deletions(-)
+
+commit 5b3d9b4aadc7656762e2a16257f59a45160514d0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 14 18:51:19 2010 -0400
+
+ Update Padre/README with TODO list
+
+ Padre/README | 116 +++++++++++++++++++++++++++++++++++++++++++++++++++++++---
+ 1 files changed, 110 insertions(+), 6 deletions(-)
+
+commit b42a4367f186a9845fb3a706fd8c826d2b3a6dee
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri May 14 23:46:35 2010 +0200
+
+ Documentation: Migration guide for Scilab users.
+
+ Initial commit. Based on the migration guide for MATLAB users.
+
+ Basic/Pod/Migration.pod | 2 +-
+ Basic/Pod/Migration/Scilab.pod | 816 ++++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 817 insertions(+), 1 deletions(-)
+
+commit 7c6f36810ce00bfa7d522041ab31ba1df0113d8e
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri May 14 23:45:30 2010 +0200
+
+ Documentation: Fix typo.
+
+ Basic/Pod/Migration/MATLAB.pod | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit c54b7f1e258dfe88b2b501d41402341284796042
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri May 14 23:05:18 2010 +0200
+
+ Documentation: Fix typo. (sorry!)
+
+ Basic/Pod/Migration/MATLAB.pod | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 32c6333363c4da3e8dcc5b67883f0799feaa0729
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri May 14 23:02:30 2010 +0200
+
+ Documentation: Minor edit for MATLAB migration guide.
+
+ Just getting the terminology right: "N-D matrix" -> "N-D array".
+
+ Basic/Pod/Migration/MATLAB.pod | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit a6c1d77ff5502269f0ce4189d2ae4a7060847b0b
+Author: Daniel Carrera <daniel at daniel-lenovo.(none)>
+Date: Fri May 14 22:45:56 2010 +0200
+
+ Documentation: Migration guide index page.
+
+ Just to help orient any user who types "perldoc Migration". In the
+ future this will be an index to all the migration guides.
+
+ Basic/Pod/Migration.pod | 26 ++++++++++++++++++++++++++
+ 1 files changed, 26 insertions(+), 0 deletions(-)
+
+commit b9f186493c08413badbb4b487c9d5202c423dd09
+Author: Daniel Carrera <daniel at daniel-lenovo.(none)>
+Date: Fri May 14 22:44:52 2010 +0200
+
+ Documentation: Migration guide for MATLAB users.
+
+ Initial commit.
+
+ Basic/Pod/Migration/MATLAB.pod | 866 ++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 866 insertions(+), 0 deletions(-)
+
+commit 8b06d99d9b38538c767f211119c57926bb511463
+Author: Daniel Carrera <daniel at daniel-lenovo.(none)>
+Date: Fri May 14 21:30:16 2010 +0200
+
+ Documentation: Edited threading tutorial.
+
+ Basic/Pod/Threading.pod | 166 ++++++++++++++++++++++++-----------------------
+ 1 files changed, 85 insertions(+), 81 deletions(-)
+
+commit 392e4124099294c9dffc282c36d2f96e74e37380
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 14 15:02:29 2010 -0400
+
+ Make main the default Perldl2 package
+
+ This is consistent with the usage from perldl version 1.x
+
+ Padre/Perldl2.pm | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 63f384ea3e53b3dcda953db18b5e861ca4739049
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 14 13:24:40 2010 -0400
+
+ Add quit command support to Perldl2
+
+ This entailed adding an exit_repl attribute to the Devel::REPL
+ shell to support clean exits. The REPL.pm file is the modified
+ version for push to the Devel::REPL git repository.
+
+ Padre/Perldl2.pm | 10 +-
+ Padre/README | 24 +++-
+ Padre/REPL.pm | 427 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 454 insertions(+), 7 deletions(-)
+
+commit 1c43de542caa738dcc1dbf7c7593e856b8cb43d0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 14 10:57:20 2010 -0400
+
+ Add TERM=dumb warning to Perldl2 shell
+
+ If you have a dumb terminal, lots of things
+ won't work right. The original perldl shell
+ had some issues for which using TERM=dumb was a
+ partial work around. Not with v2.
+
+ Padre/Perldl2.pm | 18 ++++++++++++++++--
+ 1 files changed, 16 insertions(+), 2 deletions(-)
+
+commit be17c5ec1382ba7c36ae586e2795af12d677d802
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Fri May 14 07:41:19 2010 -0500
+
+ Added PDL::Threading doc.
+
+ Basic/Pod/Threading.pod | 955 +++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 955 insertions(+), 0 deletions(-)
+
+commit 705af923d14ff5d00250d06f838d5ba040f4ad36
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri May 14 00:04:53 2010 -0400
+
+ Update Padre/README re _plugin_locator
+
+ This is needed to display the banner of shell capabilities
+ on startup. Another issue is how to enable and disable the
+ various features. If that is not directly possible, maybe
+ it is possible to mark features to load, then save state,
+ and start another shell with the desired plugins loaded in
+ place of the existing shell instance.
+
+ Padre/README | 13 ++++++++++++-
+ 1 files changed, 12 insertions(+), 1 deletions(-)
+
+commit 18df01fa5a53c86b236c0ce30162e5112664c77c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu May 13 18:51:00 2010 -0400
+
+ Minor FAQ updates
+
+ Basic/Pod/FAQ.pod | 74 ++++++++++++++++++++++++++++++-----------------------
+ 1 files changed, 42 insertions(+), 32 deletions(-)
+
+commit 9abc806561f4e3dbcba9ac00bcfa93893d3325e4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu May 13 10:19:10 2010 -0400
+
+ Update Padre/README for history file loc
+
+ Padre/README | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit 7350a933e96cba6714ac43fa571bd395f5ab3652
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu May 13 10:10:30 2010 -0400
+
+ Update perldl2 with latest Devel::REPL
+
+ Fixes to Devel::REPL Completion and ReadLineHistory plugins
+ to support Term::ReadLine::Perl have been merged into their
+ development trunk. I've removed the now duplicate files and
+ updated the README directions for installation. Also, the
+ perldl2 prompt default has been changed to 'PDL> ' in response
+ to recent mailing list discussions.
+
+ Padre/Completion.pm | 113 ----------------------------------------------
+ Padre/Perldl2.pm | 23 +++++++---
+ Padre/README | 79 +++++++++++++++++++-------------
+ Padre/ReadLineHistory.pm | 45 ------------------
+ 4 files changed, 63 insertions(+), 197 deletions(-)
+
+commit fb1fdf96c82bb8c50136db55f1b15f521463175b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 12 22:05:04 2010 -0400
+
+ Add test version of Devel::REPL for win32
+
+ This have Term::ReadLine::Perl and Term::ReadLine::Gnu
+ support for the ReadLineHistory plugin of Devel::REPL.
+
+ Padre/Devel-REPL-1.003009_01.tar.gz | Bin 0 -> 47600 bytes
+ 1 files changed, 0 insertions(+), 0 deletions(-)
+
+commit e303073588ce8204ad325282c05c557467d4c733
+Author: David Mertens <dcmertens.perl at gmail.com>
+Date: Wed May 12 14:12:43 2010 -0500
+
+ Removed ill-planned attempts to fix pdl.exe issue
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 22fd040a95d7a43c743ee0a98167c40741c50096
+Author: unknown <Charles at .(none)>
+Date: Wed May 12 12:54:30 2010 -0500
+
+ Trying to unbreak what I just broke, getting pdl to execute on windows.
+
+ Makefile.PL | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit e38a9ad9ca64218844025abb3b90dbdf415d374c
+Author: David Mertens <dcmertens at gmail.com>
+Date: Wed May 12 12:15:17 2010 -0500
+
+ I think I've added 'pdl' as an executable for windows machines.
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 71df03e2b3b19682ebebe6cd00b111a95417f714
+Author: Henning Glawe <glaweh at debian.org>
+Date: Wed May 12 15:05:17 2010 +0200
+
+ build-depend on proj-bin and netpbm
+
+ this fixes two errors during test suite runs
+
+ debian/control | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 15392431cd05acf32b8a726d231d0572cd7e024b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue May 11 12:53:22 2010 -0400
+
+ Mark Karma DEPRECATED in QuickStart.pod
+
+ Basic/Pod/QuickStart.pod | 23 +++++++++++------------
+ 1 files changed, 11 insertions(+), 12 deletions(-)
+
+commit 5df9e244450b07bb118ee25a3f30445c3626c94f
+Merge: 4ff1dcd 25cfae8
+Author: David Mertens <dcmertens at gmail.com>
+Date: Mon May 10 20:54:29 2010 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 4ff1dcd76b38aff5a67273e5ce7ac625f42ced2f
+Author: David Mertens <dcmertens at gmail.com>
+Date: Mon May 10 20:53:55 2010 -0500
+
+ Added references to PDL::IO and the string argument to pdl().
+
+ Basic/Pod/QuickStart.pod | 7 ++++---
+ 1 files changed, 4 insertions(+), 3 deletions(-)
+
+commit 25cfae8947305d67bd9aba9a20518431c0d25de5
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon May 10 10:13:58 2010 +0200
+
+ be clear about the package not being released yet
+
+ debian/changelog | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 8d2c48e4b0b7c2b6c32889d3fcc2d90b897180b5
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon May 10 10:07:16 2010 +0200
+
+ recommend libpgplot-perl instead of pgperl
+
+ debian/changelog | 7 +++++++
+ debian/control | 2 +-
+ 2 files changed, 8 insertions(+), 1 deletions(-)
+
+commit 4b5e6ee86e10db3c5f6b4bc8ef79b2cdc2bdc951
+Author: David Mertens <dcmertens at gmail.com>
+Date: Mon May 10 01:02:05 2010 -0500
+
+ Declared the same variable with 'my' twice in core.t. Fixed.
+
+ t/core.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 7ba4ec537697ee992c07eee87705c8cd94903039
+Author: David Mertens <dcmertens at gmail.com>
+Date: Mon May 10 00:48:46 2010 -0500
+
+ Fixed a couple of bad-doc errors and fixed the compiler warnings from GSL SF.
+
+ Basic/Bad/bad.pd | 4 ++--
+ Lib/GSL/SF/gslerr.h | 2 +-
+ 2 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 9e9ac6adf2533f6be782bd53a8435d690fbfa2b8
+Author: David Mertens <dcmertens at gmail.com>
+Date: Sun May 9 23:14:26 2010 -0500
+
+ Made bad.pd CPAN friendly.
+
+ Basic/Bad/bad.pd | 310 +++++++++++++++++++++++++++++++++++++++++-------------
+ 1 files changed, 239 insertions(+), 71 deletions(-)
+
+commit 1afcd0e996ccd596233e72f2da1ebf1c56e4d633
+Author: David Mertens <dcmertens at gmail.com>
+Date: Sun May 9 21:20:17 2010 -0500
+
+ Fixed invalid pod cuts in slices.pd
+
+ Basic/Slices/slices.pd | 7 +++++++
+ 1 files changed, 7 insertions(+), 0 deletions(-)
+
+commit 1e11d37d2c717c956c39fb60f23ca40cb4879cbc
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sun May 9 17:59:04 2010 -0500
+
+ Daniel's corrections and cleanups to the Autoloader documentation.
+
+ Basic/AutoLoader.pm | 33 ++++++++++++++++-----------------
+ 1 files changed, 16 insertions(+), 17 deletions(-)
+
+commit f33371150dfbd49f125a9590253eaa71b40b3645
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sun May 9 17:50:58 2010 -0500
+
+ Updated PDL.pm documentation.
+
+ Basic/PDL.pm | 74 +++++++++++++++++++++++++++++++++++++++++++---------------
+ 1 files changed, 55 insertions(+), 19 deletions(-)
+
+commit 5a501ea8eb728733781cc5f26bc1531ef93fcb90
+Author: Daniel Carrera <dcarrera at gmail.com>
+Date: Sun May 9 17:49:29 2010 -0500
+
+ Moved PDL::Impatient to PDL::QuickStart.
+
+ Basic/Pod/FAQ.pod | 8 +-
+ Basic/Pod/Guide.pod | 2 +-
+ Basic/Pod/Impatient.pod | 615 ----------------------------------------------
+ Basic/Pod/Intro.pod | 4 +-
+ Basic/Pod/QuickStart.pod | 615 ++++++++++++++++++++++++++++++++++++++++++++++
+ 5 files changed, 622 insertions(+), 622 deletions(-)
+
+commit a0efa3b899e3a13a723f8a8ad089dadb0b45934f
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun May 9 10:22:22 2010 +0200
+
+ detect presence of 'alt' flavour of hdf4
+
+ IO/HDF/Makefile.PL | 11 ++++++++++-
+ IO/HDF/SD/Makefile.PL | 4 ++--
+ IO/HDF/VS/Makefile.PL | 2 +-
+ 3 files changed, 13 insertions(+), 4 deletions(-)
+
+commit 2a4d3ce9a3b846a9efa801480b1a33f8596772ce
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sun May 9 10:20:23 2010 +0200
+
+ update debian packaging to uploaded 2.4.6
+
+ debian/changelog | 18 +++++++++++++++---
+ debian/control | 10 +++++-----
+ debian/pdl.postinst | 1 -
+ debian/rules | 2 +-
+ 4 files changed, 21 insertions(+), 10 deletions(-)
+
+commit ae8d79b8076a3b434067162aa6be9f9f0501748d
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu May 6 20:12:51 2010 +0200
+
+ add dpkg trigger for doc updates
+
+ if dpkg installs a file in and below /usr/lib/perl5/PDL, the pdldoc
+ index is updated, as is the HTML documentation
+
+ debian/pdl.postinst | 2 +-
+ debian/pdl.triggers | 1 +
+ 2 files changed, 2 insertions(+), 1 deletions(-)
+
+commit cc2b9be46ffd3efe72a384f0a0ea30babbf7b4e8
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sat May 8 15:17:20 2010 -0600
+
+ Fixed corner case in new matrix multiply code: sometimes PDL dimincs array isn't valid,
+ even after calling PDL->make_physical or PDL->make_physdims. Now we instead calculate
+ the diminc explicitly.
+
+ Also, subclass3.t had an erroneous test that used matrix multiply as a proxy for inner().
+ Now that inner isn't used by matmult, we had to use an inner check directly.
+
+ Basic/Primitive/primitive.pd | 27 ++++++++++++++++++---------
+ t/matrixops.t | 1 +
+ t/subclass3.t | 3 ++-
+ 3 files changed, 21 insertions(+), 10 deletions(-)
+
+commit 7760030bd6520c606d8d9d5b2cee2c9ac554123c
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sat May 8 07:35:05 2010 -0600
+
+ Even faster matrix multiply - now use dimincs to walk through the data explicitly, rather than calculating each element's offset in memory individually.
+
+ Basic/Primitive/primitive.pd | 28 +++++++++++++++++++++++++---
+ 1 files changed, 25 insertions(+), 3 deletions(-)
+
+commit 8244725170a561f481c70933d057cc8aeb290284
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sat May 8 01:21:50 2010 -0600
+
+ Replaced simple threading expression with a PP tiling loop; yields 2x speedup
+ for large matrices due to better cache hits. -- CED
+
+ Basic/Primitive/primitive.pd | 98 ++++++++++++++++++++++++++++-------------
+ 1 files changed, 67 insertions(+), 31 deletions(-)
+
+commit 5402c258d081efadd8cad0f152947f98405ceb8d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu May 6 23:05:30 2010 -0400
+
+ Update VERSION to 2.4.6_007 post CPAN dev release
+
+ ...for ongoing development to continue.
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit ada71dd3aed4af0a869a7ca55d6b37a47fab8648
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu May 6 21:42:52 2010 -0400
+
+ Update MANIFEST for PDL-2.4.6_006 release
+
+ MANIFEST | 9 +++++++++
+ 1 files changed, 9 insertions(+), 0 deletions(-)
+
+commit e70dbacf9bee498f889d3f45e93752aac95aaf27
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu May 6 21:36:21 2010 -0400
+
+ Final Release_Notes update before CPAN
+
+ Release_Notes | 54 ++++++++++++++++++++++++++++++++++--------------------
+ 1 files changed, 34 insertions(+), 20 deletions(-)
+
+commit 40716375d7015311fc87d7797ba8c9847caa95e1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu May 6 17:45:51 2010 -0400
+
+ Indent Code so POD doesn't wrap
+
+ The mmap for win32 comment in Basic/Core/Core.xs.PL
+ has a code section in it. I've indented the code
+ so that the POD processor does not wrap it. NOTE:
+ since the code is not in a valid chunk type, most
+ POD processors should ignore it.
+
+ Basic/Core/Core.xs.PL | 89 +++++++++++++++++++++++++------------------------
+ 1 files changed, 45 insertions(+), 44 deletions(-)
+
+commit 5bedc6d95e2de55168b60742c219a74ef53300d6
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu May 6 19:59:09 2010 +0200
+
+ start work on 2.4.7 package
+
+ debian/changelog | 6 ++++++
+ 1 files changed, 6 insertions(+), 0 deletions(-)
+
+commit d62cdb99c7f212da8b7e30c1819282ad83a6b103
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu May 6 19:58:44 2010 +0200
+
+ fix path in generated HTML docs
+
+ debian/pdl.postinst | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 5a88d7a7bb8c08c5eb7e9f369bd931906f340610
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu May 6 19:27:31 2010 +0200
+
+ add option '-s' modify href paths
+
+ syntax is '-s "stuff_to_strip[,stuff_to_add]"
+ this way, you can remove e.g. 'PDL/' from the paths referenced in the
+ links (which are thus broken in the debian case)
+
+ Doc/mkhtmldoc.pl | 27 ++++++++++++++++++++++++++-
+ 1 files changed, 26 insertions(+), 1 deletions(-)
+
+commit f5a1aba6ff80c628b8383b0eca9198164f85d819
+Merge: 53f4a4e 31c8016
+Author: David Mertens <david at david-desktop.(none)>
+Date: Thu May 6 11:44:28 2010 -0500
+
+ Merge branch 'master' of ssh://run4flat@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 53f4a4e2b5976393dd4e976b95b074e681ad78bd
+Author: David Mertens <david at david-desktop.(none)>
+Date: Thu May 6 11:43:23 2010 -0500
+
+ Fixed functioning of the new_pdl_from_string so it properly handled implicit bracketing.
+
+ Basic/Core/Core.pm.PL | 20 ++++++++++----------
+ t/core.t | 43 ++++++++++++++++++++++++++++++-------------
+ 2 files changed, 40 insertions(+), 23 deletions(-)
+
+commit 31c8016b006cb60c0fd7219e2bd14d6616c8d7e8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 5 19:15:03 2010 -0400
+
+ Update readmes and VERSION for CPAN release
+
+ Update VERSION to 2.4.6_006 to mark a new CPAN developers
+ release. Various edits to readme-type files for the release.
+
+ Basic/PDL.pm | 2 +-
+ DEPENDENCIES | 9 +++++++++
+ DEVELOPMENT | 34 ++++++++++++++++++++--------------
+ 3 files changed, 30 insertions(+), 15 deletions(-)
+
+commit 484c6f65e864f87a1439a991678fb53bb9449705
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed May 5 06:39:00 2010 -0400
+
+ Minor POD-smithing for PDL::new
+
+ Basic/Core/Core.pm.PL | 39 +++++++++++++++++++++------------------
+ 1 files changed, 21 insertions(+), 18 deletions(-)
+
+commit 7686fd568507e99d0b7176df540a7e1e94900f5f
+Author: David Mertens <dcmertens at gmail.com>
+Date: Tue May 4 00:32:00 2010 -0500
+
+ Added implementation for string input to PDL::new.
+
+ Basic/Core/Core.pm.PL | 122 ++++++++++++++++++++++++++++++++--------------
+ Basic/Pod/Impatient.pod | 26 ++++++++--
+ t/core.t | 104 ++++++++++++++++++++++++++++++----------
+ 3 files changed, 186 insertions(+), 66 deletions(-)
+
+commit 53f41124db2633492597edacbc8cf3534f4a393c
+Author: David Mertens <dcmertens at gmail.com>
+Date: Mon May 3 21:22:37 2010 -0500
+
+ Fixed a documentation typo in bad.pd
+
+ Basic/Bad/bad.pd | 111 ++++++++++++++++++++++++++++++++---------------------
+ 1 files changed, 67 insertions(+), 44 deletions(-)
+
+commit 27fa4e37130f3236f224956865790f888f690806
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 3 15:30:44 2010 -0400
+
+ Fix ReadLineHistory to work with T::R::Perl
+
+ The stifle_history() method is GNU readline specific.
+ Added the alternative code needed for Term::ReadLine::Perl
+ support.
+
+ Padre/README | 10 +++++++---
+ Padre/ReadLineHistory.pm | 45 +++++++++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 52 insertions(+), 3 deletions(-)
+
+commit abecfe219f3a67d314447b7c17c2328772cf0cdd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon May 3 14:04:42 2010 -0400
+
+ Skip broken win32 plugins for Perldl2 profile load
+
+ Interrupt and ReadLineHistory do not work on win32 in Term::REPL.
+ * Interrupt because Sys::SigAction does not work on windows.
+ * ReadLineHistory because it uses a Gnu readline specific function.
+
+ Padre/Perldl2.pm | 9 ++++++++-
+ 1 files changed, 8 insertions(+), 1 deletions(-)
+
+commit f9fa1e6df3a4ef6b48755dba6ead1ac4256d96a8
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sun May 2 22:02:59 2010 +1000
+
+ IO/Pnm/Pic.pm - Fix (MS Windows) portability
+
+ Near the beginning of the file, use
+ File::Spec->path() to split the path portably
+ and add the '.exe' extension to "pnmtojpeg" iff
+ $^O is MS Windows.
+
+ IO/Pnm/Pic.pm | 62 +++++++++++++++++++++++++++++---------------------------
+ 1 files changed, 32 insertions(+), 30 deletions(-)
+
+commit 83c1308d9ccf00f68d17fec19cedcc1cc49dc55b
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sun May 2 20:57:33 2010 +1000
+
+ Lib/Transform/Proj4/Makefile.PL - un-"local"-ise $lib_path
+
+ Replace the"local()" $lib_path with
+ $transform_gis_proj4_lib_path, so that the variable's
+ contents are accessible throughout the Makefile.PL.
+
+ Lib/Transform/Proj4/Makefile.PL | 47 +++++++++++++++++++--------------------
+ 1 files changed, 23 insertions(+), 24 deletions(-)
+
+commit 3d22591dd6f37069e4e961d2ef1388dcf5a13020
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sun May 2 20:44:56 2010 +1000
+
+ Lib/GIS/Proj/Makefile.PL - un-"local"-ise $lib_path
+
+ Replace the"local()" $lib_path with $gis_proj_lib_path,
+ so that the variables contents are accessible
+ throughout the Makefile.PL.
+
+ Lib/GIS/Proj/Makefile.PL | 37 ++++++++++++++++++-------------------
+ 1 files changed, 18 insertions(+), 19 deletions(-)
+
+commit 994ca216768f720021b357daa61a6858d9d6f5c2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 1 16:05:57 2010 -0400
+
+ Add WITH_DEVEL_REPL to perldl.conf
+
+ To support perldl v2 capabilities. In the transition, we don't
+ want to have Devel::REPL as a hard dependency but we want to use
+ it for all the new features if it is there already...
+
+ perldl.conf | 7 +++++++
+ 1 files changed, 7 insertions(+), 0 deletions(-)
+
+commit 98e9c90c34c01bbb2fbaa685c6deac7eac5ee8fa
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 1 15:45:50 2010 -0400
+
+ Add fix for Term::ReadLine::Perl support
+
+ The Term::ReadLine::Perl support for the Attribs method
+ was broken because there was only partial implementation
+ of the TIEHASH capability. This is (should be) a backward
+ compatable replacement that fixes the known problems.
+
+ Padre/README | 22 +++++++++++++++-------
+ Padre/TieHash.pm | 38 ++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 53 insertions(+), 7 deletions(-)
+
+commit 1a9f6eb37d8c9cf0d06eccd4b1fd2cb8c0fa6e90
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 1 14:13:25 2010 -0400
+
+ Add Padre/readline-fix/ to MANIFEST.SKIP
+
+ MANIFEST.SKIP | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 6485d2788a704224633dafeec37c15e48f44ca7a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 1 12:55:47 2010 -0400
+
+ Update Known_problems and Release_Notes for CPAN
+
+ Minor README cleanups in preparation for an upcoming
+ CPAN developer's release.
+
+ Known_problems | 3 ++-
+ Release_Notes | 13 ++++++++++++-
+ 2 files changed, 14 insertions(+), 2 deletions(-)
+
+commit dd9a0c1e1123d78001d9fc86bf1d1890f79cd4bd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat May 1 12:53:33 2010 -0400
+
+ Update Perldl2 and README
+
+ Added a couple of plugins to the Perldl2.pm profile
+ which support more types of completion as well as
+ catching Ctrl-C rather than exiting the shell.
+ A new Completion.pm now supports Term::ReadLine::Perl
+ for TAB completion on win32---finally! Some README
+ update for consistency.
+
+ Padre/Perldl2.pm | 6 ++++--
+ Padre/README | 38 ++++++++++++++++++++++++--------------
+ 2 files changed, 28 insertions(+), 16 deletions(-)
+
+commit cbf21ab20848ee1241930cf3e1fad282093ff02b
+Merge: 071eb86 d4a1fc4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 30 17:36:20 2010 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 071eb866354d74c45c2ff6f15f65b00d250f8499
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 30 17:34:06 2010 -0400
+
+ Fix Perldl2 to work with Term::ReadLine::Perl
+
+ Now completion appears to work for both Term::ReadLine::Gnu
+ and Term::ReadLine::Perl systems.
+
+ Padre/Completion.pm | 113 +++++++++++++++++++++++++++++++++++++++++++++++++++
+ Padre/Perldl2.pm | 4 +-
+ 2 files changed, 115 insertions(+), 2 deletions(-)
+
+commit d4a1fc4f6b224790cb90880931eb0dbfdebf104f
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Apr 30 13:43:21 2010 -0400
+
+ More documentation fixes.
+
+ Found more broken links, etc.
+
+ Basic/Core/Basic.pm | 1 +
+ Basic/MatrixOps/matrixops.pd | 10 +++++-----
+ Basic/Pod/Impatient.pod | 4 ++--
+ Basic/Primitive/primitive.pd | 2 +-
+ Graphics/LUT/LUT.pm | 2 +-
+ IO/Dumper.pm | 2 +-
+ IO/NDF/NDF.pm.PL | 2 +-
+ IO/Pnm/Pic.pm | 2 +-
+ IO/Pnm/pnm.pd | 2 +-
+ Lib/GSL/DIFF/gsl_diff.pd | 2 +-
+ Lib/GSL/INTEG/gsl_integ.pd | 2 +-
+ Lib/Image2D/image2d.pd | 2 +-
+ Lib/ImageND/imagend.pd | 4 ++--
+ Lib/Transform/Proj4/Proj4.pd | 7 ++++---
+ 14 files changed, 23 insertions(+), 21 deletions(-)
+
+commit 2a6e926d596b4e610276b10336d0cd27c2a319c8
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Apr 30 13:38:54 2010 -0400
+
+ Remove redundant Functions head in pod
+
+ The pp_def will insert the FUNCTIONS heading into the pod, so it is not
+ needed explicitly. Also, some files had the incorrect =head1 name,
+ which prevented them from appearing in PDL::Index.
+
+ Lib/GSL/SF/airy/gsl_sf_airy.pd | 2 --
+ Lib/GSL/SF/bessel/gsl_sf_bessel.pd | 2 --
+ Lib/GSL/SF/clausen/gsl_sf_clausen.pd | 2 --
+ Lib/GSL/SF/coulomb/gsl_sf_coulomb.pd | 2 --
+ Lib/GSL/SF/coupling/gsl_sf_coupling.pd | 2 --
+ Lib/GSL/SF/dawson/gsl_sf_dawson.pd | 2 --
+ Lib/GSL/SF/debye/gsl_sf_debye.pd | 2 --
+ Lib/GSL/SF/dilog/gsl_sf_dilog.pd | 2 --
+ Lib/GSL/SF/elementary/gsl_sf_elementary.pd | 4 +---
+ Lib/GSL/SF/ellint/gsl_sf_ellint.pd | 2 --
+ Lib/GSL/SF/elljac/gsl_sf_elljac.pd | 2 --
+ Lib/GSL/SF/erf/gsl_sf_erf.pd | 2 --
+ Lib/GSL/SF/exp/gsl_sf_exp.pd | 2 --
+ Lib/GSL/SF/expint/gsl_sf_expint.pd | 2 --
+ Lib/GSL/SF/fermi_dirac/gsl_sf_fermi_dirac.pd | 2 --
+ Lib/GSL/SF/gamma/gsl_sf_gamma.pd | 2 --
+ Lib/GSL/SF/gegenbauer/gsl_sf_gegenbauer.pd | 2 --
+ Lib/GSL/SF/hyperg/gsl_sf_hyperg.pd | 2 --
+ Lib/GSL/SF/laguerre/gsl_sf_laguerre.pd | 2 --
+ Lib/GSL/SF/legendre/gsl_sf_legendre.pd | 2 --
+ Lib/GSL/SF/log/gsl_sf_log.pd | 2 --
+ Lib/GSL/SF/poly/gsl_sf_poly.pd | 2 --
+ Lib/GSL/SF/pow_int/gsl_sf_pow_int.pd | 4 +---
+ Lib/GSL/SF/psi/gsl_sf_psi.pd | 2 --
+ Lib/GSL/SF/synchrotron/gsl_sf_synchrotron.pd | 4 +---
+ Lib/GSL/SF/transport/gsl_sf_transport.pd | 4 +---
+ Lib/GSL/SF/trig/gsl_sf_trig.pd | 2 --
+ Lib/GSL/SF/zeta/gsl_sf_zeta.pd | 2 --
+ 28 files changed, 4 insertions(+), 60 deletions(-)
+
+commit 31ed9b68203076d17c3dacae10f938208d42795f
+Merge: 266f1f8 19047be
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Apr 30 13:36:09 2010 -0400
+
+ Merge branch 'master' of ssh://lambd@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 19047beba630700b30ecd89fa6e2048859a30ea7
+Merge: bb96a70 ba65d3d
+Author: Craig DeForest <zowie at Clio.local>
+Date: Thu Apr 29 23:59:22 2010 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit ba65d3d016fc9523f0c8c67de840b91a7cc84760
+Author: David Mertens <dcmertens at gmail.com>
+Date: Fri Apr 30 00:58:15 2010 -0500
+
+ Updated the Guide based on Derek's linking suggestions.
+
+ Basic/Pod/Guide.pod | 172 +++++++++++++++++++++++++++-----------------------
+ 1 files changed, 93 insertions(+), 79 deletions(-)
+
+commit bb96a70629fc75e4e1e40cb89aa824924da80f2a
+Merge: 17430ad 7501237
+Author: Craig DeForest <zowie at Clio.local>
+Date: Thu Apr 29 23:51:20 2010 -0600
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 17430adb39b1395f43bfb05df5ba1701c4c1d720
+Author: Craig DeForest <zowie at Clio.local>
+Date: Thu Apr 29 23:49:43 2010 -0600
+
+ Fix rice compression to work with unsigned shorts; add TDIM support to FITS
+
+ IO/FITS/FITS.pm | 4 ++--
+ Lib/Compression/compression.pd | 4 ++--
+ 2 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 75012376d6f5efa1cbcd8e2a0b3bcb3f083351c5
+Author: David Mertens <david at david-laptop.(none)>
+Date: Thu Apr 29 20:07:46 2010 -0500
+
+ Added my guide to PDL.
+
+ Basic/Pod/Guide.pod | 485 +++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 485 insertions(+), 0 deletions(-)
+
+commit 025cdd9ead0bf33568362dddc68fe0bb70e3a448
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Apr 28 22:05:45 2010 -0400
+
+ Got Term::ReadLine::Gnu to compile
+
+ It still needs the init code on startup to be completed.
+ Some functions had to be commented out because they were
+ not actually provided by the win32 readline library used.
+ Still to be determined if the two (now commented out)
+ routines are needed for our PDL/Padre uses...
+
+ Padre/readline-fix/Gnu.xs | 26 +++++++++++++-------------
+ Padre/readline-fix/README | 31 ++++++++++++++++++++++++++++++-
+ 2 files changed, 43 insertions(+), 14 deletions(-)
+
+commit 410e6d97fe0490c7bfc09d05077c88fa231b62e3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Apr 28 13:57:40 2010 -0400
+
+ Add working directory of ReadLine::GNU on win32
+
+ This is a temporary working directory for development
+ of Term::ReadLine::Gnu on win32 to support Perldl v.2
+ development and better win32 command support in general.
+
+ Padre/README | 6 +-
+ Padre/readline-fix/Gnu.xs | 3002 ++++++++++++++++++++++++++++++++++++++++
+ Padre/readline-fix/Makefile | 983 +++++++++++++
+ Padre/readline-fix/Makefile.PL | 217 +++
+ Padre/readline-fix/README | 55 +
+ 5 files changed, 4262 insertions(+), 1 deletions(-)
+
+commit de06e75b06eea4d2b28d7ac3fd2265327332f9a9
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Apr 27 14:03:29 2010 -0400
+
+ Fix dimension numbering in PDL::Transform::t_fits
+
+ Correct some unit offset errors in the labeling of input image dimensions:
+ Image X, Image Y, etc.
+
+ Lib/Transform/transform.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 47d3927dc36e8f66e062807c95a10ff83071e9f2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Apr 26 13:30:15 2010 -0400
+
+ Take tapprox() out of tests that don't use it
+
+ Note also that tapprox is basically approx()->all so tests using
+ the hand-rolled tapprox() routine might be clearer and more
+ portably coded with approx() and all().
+
+ t/argtest.t | 12 ++++++------
+ t/conv.t | 12 ++++++------
+ t/croak.t | 12 ++++++------
+ t/familyfree.t | 12 ++++++------
+ t/ica.t | 14 +++++++-------
+ t/ones.t | 12 ++++++------
+ t/refs.t | 12 ++++++------
+ 7 files changed, 43 insertions(+), 43 deletions(-)
+
+commit 86df7b82bc68de78072aa83063fbd3e9bee61ae4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Apr 26 13:29:53 2010 -0400
+
+ Add Lib/Compression/ stuff to .gitignore
+
+ .gitignore | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit 845873e05334fc01869fe51cdf97973f91fab454
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 25 20:30:16 2010 -0400
+
+ Minor change to perldl2 prompt and README
+
+ Padre/Perldl2.pm | 4 ++--
+ Padre/README | 4 +++-
+ 2 files changed, 5 insertions(+), 3 deletions(-)
+
+commit 74975d04f8ead85f3b32eff8fbbf48a7d9172dda
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 25 18:50:25 2010 -0400
+
+ New and improved perldl2 shell
+
+ Knocked out a few more missing items for the perldl2 shell.
+ See the README in PDL/Padre for how to manually install.
+ You'll need to install Devel::REPL to use.
+
+ Padre/Perldl2.pm | 34 ++++++++++++++++++
+ Padre/README | 102 ++++++++++++++++++++++++++++++++++++++++-------------
+ Padre/pdlrun | 8 ----
+ 3 files changed, 111 insertions(+), 33 deletions(-)
+
+commit ae71cf82210b63e660707db2a044657eda3e1280
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 24 10:41:15 2010 -0400
+
+ Update with 2nd code from DM email
+
+ Changed the zero handling to add a zero after an ending
+ decimal point rather than removing the decimal. That can
+ affect implied type conversions in C and sometimes PDL.
+
+ Example/Core/new_from_string.pl | 20 ++++++++++++++++----
+ 1 files changed, 16 insertions(+), 4 deletions(-)
+
+commit 1367839c3084f78a3b173d75dfe7a1f1c65371f7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 24 09:39:47 2010 -0400
+
+ Commit first new_from_string.pl
+
+ I realized that David had already provided a better
+ first code for this than my do-nothing one...
+
+ Example/Core/new_from_string.pl | 108 +++++++++++++++++++++++++++++++++++++-
+ 1 files changed, 105 insertions(+), 3 deletions(-)
+
+commit 5b721b507aff0fb208c5c27db5e98d46ad5e7c36
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Apr 24 08:51:36 2010 -0400
+
+ Add Example/Core directory
+
+ This can be a home for code examples relating to Core
+ PDL functionality: i.e., the new_pdl_from_string routine.
+
+ Example/Core/new_from_string.pl | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit 81d3b73f93cacb4c2f1969ca8e391dcc2e5223ba
+Merge: 66a90be 47f525d
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sat Apr 24 00:41:10 2010 -0700
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 66a90be32a9f996b0e5e14ef127dfafadeaa0bec
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sat Apr 24 00:40:11 2010 -0700
+
+ Add write support for variable-length arrays in binary tables.
+ Add support for TDIM fields in binary tables.
+
+ IO/FITS/FITS.pm | 224 ++++++++++++++++++++++++++++++++++++++++++++++---------
+ 1 files changed, 189 insertions(+), 35 deletions(-)
+
+commit 266f1f816277e4440f208d9454904980bf3d8916
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu Apr 22 16:48:28 2010 -0400
+
+ Fix html links to PDL::PDL
+
+ pod2html causes pod links like L<PDL|PDL> to point to "../PDL.html", but the correct file is "PDL.html", in the same directory as all the other top-level html docs. PDL::Index correctly points to PDL::PDL. This patch to mkhtmldoc.pl removes one set of '../' from links to PDL.html.
+
+ Doc/mkhtmldoc.pl | 28 +++++++++++++++++++++++++++-
+ 1 files changed, 27 insertions(+), 1 deletions(-)
+
+commit 47f525da34dd9d8318d77a087a9e005af62d1aee
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Apr 22 14:31:19 2010 -0400
+
+ Add POD for writeflexhdr to FlexRaw.pm
+
+ I don't know why writeflex() does not write the header too...
+
+ IO/FlexRaw/FlexRaw.pm | 16 +++++++++++++++-
+ 1 files changed, 15 insertions(+), 1 deletions(-)
+
+commit 4bef4ee7afc61660064d79e012ac94a9efb197ff
+Merge: 94eaa00 4f23e3f
+Author: Craig DeForest <zowie at pcp057117pcs.wireless.calpoly.edu>
+Date: Wed Apr 21 16:21:16 2010 -0700
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 94eaa00967d0e9287a2ca94f5fbcaaeaf99ed14e
+Author: Craig DeForest <zowie at pcp057117pcs.wireless.calpoly.edu>
+Date: Wed Apr 21 16:20:25 2010 -0700
+
+ run-time (not compile-time) load for PDL::Compression.
+
+ IO/FITS/FITS.pm | 100 ++++++++++++++++++++++++++++++++++++++++---------------
+ 1 files changed, 73 insertions(+), 27 deletions(-)
+
+commit a8059f8d481e64ddda95efe3bb47594d4f5c8890
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Wed Apr 21 17:46:54 2010 -0400
+
+ Update POD to fix many broken hyperlinks
+
+ Used the W3C::Checklink module to find broken links in the generated HTML documentation.
+ This commit takes care of (all of?) the broken links that were due to POD typos, etc.
+
+ Basic/Core/Core.pm.PL | 18 +++++++-------
+ Basic/Core/Exporter.pm | 4 +-
+ Basic/Gen/pptemplate.PL | 2 +-
+ Basic/Ops/ops.pd | 2 +-
+ Basic/Pod/API.pod | 2 +-
+ Basic/Pod/Impatient.pod | 6 ++--
+ Basic/Pod/Indexing.pod | 16 ++++++------
+ Basic/Pod/Internals.pod | 2 +-
+ Basic/SourceFilter/NiceSlice.pm | 2 +-
+ Doc/Doc.pm | 12 ++++----
+ Lib/DiskCache.pm | 50 +++++++++++++++++++++++++-------------
+ Lib/FFT/fft.pd | 8 +++---
+ Lib/ImageND/imagend.pd | 2 +-
+ Lib/Transform/transform.pd | 31 ++++++++++++-----------
+ 14 files changed, 87 insertions(+), 70 deletions(-)
+
+commit 4f23e3f72f07be8733b13a2b0432d9d98c94d910
+Author: David Mertens <david at david-desktop.(none)>
+Date: Wed Apr 21 12:51:29 2010 -0500
+
+ Made PP's import function a tad smarter and added useful error messages to FFT.
+
+ Basic/Gen/PP.pm | 6 +++++-
+ Lib/FFT/fft.pd | 38 ++++++++++++++++++++++++++++++++------
+ t/fft.t | 12 +++++++++++-
+ 3 files changed, 48 insertions(+), 8 deletions(-)
+
+commit 0e5bb11fb89f0f6134ecaf53ce6c3cb7e72e08cd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 20 17:22:18 2010 -0400
+
+ Minor fix to test output text for t/pgplot.t
+
+ NOTE: if you have PGPLOT_DEV environment variable set to
+ /xs then the plot window will never go away---even if closed.
+ Use /xw for a cleaner test appearance.
+
+ t/pgplot.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit b8ace26c6b79ae1de0ed270febeeb05d380e9a8f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 20 11:04:22 2010 -0400
+
+ Update pdl() and PDL::new() docs for STRING args
+
+ Added some infomation in the pdl() POD referencing
+ the new STRING capability with a note to check the
+ PDL::new POD if you want to try it. Not the most
+ useful but it should help folks get started with the
+ new support if interested---they'll have a better
+ chance at figuring out what to do...
+
+ Basic/Core/Core.pm.PL | 28 ++++++++++++++++++----------
+ 1 files changed, 18 insertions(+), 10 deletions(-)
+
+commit 674cb390e1235e2957be78b7a030ffcdf2cc7db9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 18 22:41:58 2010 -0400
+
+ Add tests to t/core.t for pdl(STRING) arguments
+
+ These are placeholder tests for now. They need to grow as the
+ STRING constructor interface evolves.
+
+ t/core.t | 28 +++++++++++++++++++++++++++-
+ 1 files changed, 27 insertions(+), 1 deletions(-)
+
+commit 707ef96b4ebb1d4f4ffd86f1206d2373a79cd807
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 18 21:56:00 2010 -0400
+
+ Update $PDL::VERSION to 2.4.6_005 and readme's
+
+ This version increase marks two new additions to PDL: FITS compressed
+ format support with an associated PDL::Compression module and hooks to
+ support support of string data format support to pdl and PDL::new which
+ will lead to matlab/octave style constructor support and cut-and-paste
+ capability between perldl display output and pdl constructor input.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 7 +------
+ Release_Notes | 38 ++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 40 insertions(+), 7 deletions(-)
+
+commit ad7d299b075e133f6b97425f08ca4f01bcb5b17b
+Merge: 3334ff5 4061e08
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 18 17:55:50 2010 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 3334ff5d8a77fc10cbbcf924b64506906be5e599
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 18 17:50:17 2010 -0400
+
+ Add hooks for PDL::new to handle STRING data
+
+ I did not have time to to a full implementation for the
+ new Matlab-style (comma free) string data option for the
+ pdl routine (a.k.a. PDL::new under the hood). I did get
+ a basic dispatch for the new option working which uses
+ a routine PDL::Core::new_pdl_from_string to do its magic.
+
+ If you define that routine, you'll be able to play with
+ options for the STRING input handling for pdl / PDL::new.
+ Type help PDL::new or look at the PDL/Basic/Core/Core.pm
+ source for how it works and what a proper new_pdl_from_string
+ routine needs to do. A free example is included!
+
+ Basic/Core/Core.pm.PL | 46 +++++++++++++++++++++++++++++++++++++++++-----
+ Basic/Core/Core.xs.PL | 9 +++++++++
+ 2 files changed, 50 insertions(+), 5 deletions(-)
+
+commit 4061e08e031ad22d4ba315c000c9c6610deb0493
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sun Apr 18 14:50:23 2010 -0600
+
+ Added tiled compressed image handling to rfits in FITS.pm
+
+ IO/FITS/FITS.pm | 101 +++++++++++++++++++++++++++++++++++-----
+ Lib/Compression/compression.pd | 5 +-
+ 2 files changed, 91 insertions(+), 15 deletions(-)
+
+commit 2a35906d75fb7c13f9c7e2bd953d8a554ffedc9a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Apr 18 16:10:13 2010 -0400
+
+ Update Known_problems from fixed bugs info
+
+ Known_problems | 44 ++++++++++++++++++--------------------------
+ 1 files changed, 18 insertions(+), 26 deletions(-)
+
+commit c0dfa062b87c930f179612a4258cf4510a3831d3
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sun Apr 18 00:55:01 2010 -0600
+
+ Fix up code to not crash on non-lazy linking systems; improve
+ documentation; shut up chatter.
+
+ Lib/Compression/compression.pd | 90 ++++++++++++++++++++++++++++-----------
+ Lib/Compression/ricecomp.c | 21 +--------
+ 2 files changed, 66 insertions(+), 45 deletions(-)
+
+commit 0e56805851dd2fae9faec416f730f4a5cb5bbda6
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sat Apr 17 09:13:54 2010 -0600
+
+ Remove unused .h file reference from ricecomp.c
+
+ Lib/Compression/ricecomp.c | 1 -
+ 1 files changed, 0 insertions(+), 1 deletions(-)
+
+commit c66761d7cb3a7dd7897a664e33db0889d0b51bd2
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sat Apr 17 23:41:32 2010 +1000
+
+ perldl.PL - 'defined %h' is deprecated in 5.12
+
+ Remove the 'defined' from 'defined %PDL::Config'
+ in order to avoid the deprecation warning that
+ perl-5.12 issues wrt this practice.
+
+ perldl.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 69a40d166b6b5d038f4db23b989c98629173deed
+Author: Craig DeForest <zowie at Clio.local>
+Date: Sat Apr 17 02:08:02 2010 -0600
+
+ New compression module in Lib
+
+ IO/FITS/FITS.pm | 5 +-
+ Lib/Compression/Makefile.PL | 14 +
+ Lib/Compression/compression.pd | 213 ++++++++++++
+ Lib/Compression/ricecomp.c | 714 ++++++++++++++++++++++++++++++++++++++++
+ Lib/Makefile.PL | 2 +-
+ 5 files changed, 944 insertions(+), 4 deletions(-)
+
+commit 22e72f69bb07931d5b7503de92357451a596291d
+Author: Craig DeForest <zowie at Clio.local>
+Date: Thu Apr 15 00:54:48 2010 -0600
+
+ Added variable-length record support to binary table extension for rfits;
+ began work on a tile-compressed-image unpacker.
+
+ IO/FITS/FITS.pm | 219 +++++++++++++++++++++++++++++++++++++++++++++------
+ IO/FITS/Makefile.PL | 2 +-
+ 2 files changed, 195 insertions(+), 26 deletions(-)
+
+commit d790370a05e2ad4a7b834f7e33bf691d24c7e470
+Author: Craig DeForest <zowie at dhcp-10-120.boulder.swri.edu>
+Date: Wed Apr 14 10:56:09 2010 -0600
+
+ Added variable-length row support to the FITS bintable reader.
+ This is preparatory to supporting tile-compressed images.
+
+ IO/FITS/FITS.pm | 188 ++++++++++++++++++++++++++++++++++++++++++++++++------
+ 1 files changed, 167 insertions(+), 21 deletions(-)
+
+commit d148add1880d7dac8f200723e07c9c77fac9ae5d
+Author: Craig DeForest <zowie at Clio.local>
+Date: Tue Apr 13 22:50:08 2010 -0600
+
+ Fixes SF bug 2949455 ("demo transform broken"): sign error in FITS header
+ CROTA2 interpretation by PGPLOT libraries.
+
+ Graphics/PGPLOT/Window/Window.pm | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 0234f353fd8d970c3a4a6a550400b17560d4e309
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Apr 13 17:36:18 2010 -0400
+
+ Use s/\r?\n$// instead of chomp for rcols
+
+ This should be more tolerate of mixed unix and dos
+ file environments.
+
+ IO/Misc/misc.pd | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 292a2040bcb76645a9cbd9c62de1161d283af5b9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Apr 8 10:15:02 2010 -0400
+
+ Fix problem with window shrink creep in imag2d()
+
+ Due to round off errors in the constrained resize, some
+ platforms saw the imag2d() windows shrink slowly until
+ the display died. This fixes the problem by not issuing
+ a glutReshapeWindow() call unless the change would be
+ more than 2 pixels.
+
+ imag2d.pdl | 19 +++++++++++++++++--
+ 1 files changed, 17 insertions(+), 2 deletions(-)
+
+commit 07269fd66807ad8fad59129addda02a21c0e6810
+Author: David Mertens <david at david-laptop.(none)>
+Date: Thu Apr 8 07:44:43 2010 -0500
+
+ Added a note about local::lib to the See Also section of the docs.
+
+ Basic/AutoLoader.pm | 5 +++++
+ 1 files changed, 5 insertions(+), 0 deletions(-)
+
+commit 7f12b9e1dc6a3ce040f5a38f62c04e0325946058
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Thu Apr 8 00:28:21 2010 +1000
+
+ Basic/Core/Dev.pm - deprecation warning of 'defined(%h)'
+
+ With 5.12, a deprecation warning is issued when we
+ check for 'defined(%h)'. The solution is to instead
+ simply check that '%h' is true ... let's try that !!
+
+ Basic/Core/Dev.pm | 11 ++---------
+ 1 files changed, 2 insertions(+), 9 deletions(-)
+
+commit 90929e095aea8ec65d02458d12e00faa078e6d58
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 2 10:23:12 2010 -0400
+
+ Add to lib/include paths for IO/HDF/Makefile.PL
+
+ Patch submitted by Olivier Archer, sf patch #2981131
+
+ IO/HDF/Makefile.PL | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 6119c52f51d58614f486968aa552e0996bba4bd7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Apr 2 09:22:11 2010 -0400
+
+ Apply "silliest patch ever" to NiceSlice.pm
+
+ In an April 1st tour de force, avar at cpan.org submitted
+ a patch to pdl-git which should allow just his modules
+ to show up on the first page of search.cpan.org if you
+ type in avar. Made my day, AEvar. Hope this works!
+
+ Basic/SourceFilter/NiceSlice.pm | 10 +++++-----
+ Basic/SourceFilter/README | 6 +++---
+ 2 files changed, 8 insertions(+), 8 deletions(-)
+
+commit 67c72199c38523eebbac2490cb488d166ea5a166
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Apr 1 09:28:03 2010 -0400
+
+ Fix re.cpan.org #53815 in IO/HDF/SD/SD.pd
+
+ There was a typo in the return from the SDgetattributename
+ sub where it should have been returning SDgetattributenames,
+ the method defined immediately above. There is no test
+ for this error but pushing to git in the hopes that the
+ user reporting the problem can verify the fix.
+
+ IO/HDF/SD/SD.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 52af047e353b7039e43316a22abd2426b523df28
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 31 13:40:30 2010 -0400
+
+ Fix minor doc example error for rcols in misc.pd
+
+ IO/Misc/misc.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 49a70e2cbade87256a6254f24b85965253ac8ea5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 29 09:43:16 2010 -0400
+
+ Fix uniqvec bug from SF# 2978576
+
+ uniqvec is documented to always return a 2D output piddle.
+ This was not the case for the case with a single uniq vector
+ of length greater than 2 which got returned in 1D.
+
+ Basic/Primitive/primitive.pd | 2 +-
+ t/primitive.t | 7 +++----
+ 2 files changed, 4 insertions(+), 5 deletions(-)
+
+commit 94746e76138508a34282848562f0d39ffc49a290
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 24 17:30:21 2010 -0400
+
+ Add some more examples of [] syntax for rcols POD
+
+ IO/Misc/misc.pd | 16 ++++++++++++----
+ 1 files changed, 12 insertions(+), 4 deletions(-)
+
+commit 7a2fc1dcddce3a73096206a0c0afc913e9d96fb0
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Wed Mar 24 14:30:44 2010 -0400
+
+ correct typo in PDL::Index description
+
+ dcouments-->documents
+
+ Doc/scantree.pl | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 825425c83ab6c4be6eb904c3a5c282f570b3ee75
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 16 16:08:59 2010 -0400
+
+ Add VERBOSE option to rcols()
+
+ By default it has the value of $PDL::verbose.
+ Other routines in PDL::IO::Misc can be converted
+ once they support more general options as with
+ rcols().
+
+ IO/Misc/misc.pd | 26 +++++++++++++++-----------
+ 1 files changed, 15 insertions(+), 11 deletions(-)
+
+commit c63abd04fa2765843f6c70c66911fd427a1e101f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Mar 16 10:53:36 2010 -0400
+
+ Update Release_Notes and Known_problems
+
+ Known_problems | 16 ++++++++++------
+ Release_Notes | 24 ++++++++++++++++++++++++
+ 2 files changed, 34 insertions(+), 6 deletions(-)
+
+commit 5a063e63be009c7f156af8bf8524ac57929fe938
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 15 23:49:44 2010 -0400
+
+ Fix another rcols edge case
+
+ IO/Misc/misc.pd | 1 -
+ 1 files changed, 0 insertions(+), 1 deletions(-)
+
+commit 07ca5de92ccb4358fe683abce761ebe6249b822d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 15 23:25:48 2010 -0400
+
+ Updated $PDL::VERSION to 2.4.6_004 for new rcols
+
+ Since PDL::IO::Misc does not have its own version, I've
+ incremented the developers version number to mark the
+ fact that this is the first with the multicolumn piddle
+ support in rcols.
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 9d9f2561b8c56752cb444454290b8a086b83173d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 15 23:23:33 2010 -0400
+
+ Finished rcols() multicolumn piddle support
+
+ Updated the rcols() POD with details of the new multicolum
+ specification option via array refs. Finished implementing
+ a few more edge cases of the implicit column number generation
+ for multicolumn piddles.
+
+ IO/Misc/misc.pd | 58 +++++++++++++++++++++++++++++++++++++++---------------
+ 1 files changed, 42 insertions(+), 16 deletions(-)
+
+commit cf362903ed96244b5a9311be8af7e320b8c2cffb
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 15 22:30:20 2010 -0400
+
+ Fix failure to strip PERLCOLS in rcols
+
+ If a column is specified for input with rcols() but also
+ listed in PERLCOLS, then the position of the data in output
+ is as listed in the explicit column specification location
+ but the type is a perl array ref. This fixes an oops where
+ I had failed to stop reading into the piddle.
+
+ IO/Misc/misc.pd | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 9c4708fde643579bdbd74664adf1e6b7e5b07798
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 15 18:48:02 2010 -0400
+
+ Multicol input piddles for rcol()
+
+ This is the first implementation of the new multicolumn
+ syntax supporting multicolumn input data piddles as rcols
+ output. Still needs testing, docs.
+
+ IO/Misc/misc.pd | 498 ++++++++++++++++++++++++++++++-------------------------
+ 1 files changed, 268 insertions(+), 230 deletions(-)
+
+commit 04a3bca1fda0413d8502f4fd7be381c592398d1a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 15 11:03:37 2010 -0400
+
+ Refactor data structure for rcols
+
+ This is a minor change of data structure used for
+ chunking the rcols IO. Originally, this was [ X, a, b, c... ]
+ where X was either a PDL or ARRAY and a, b, c... were the
+ elements being collected. It makes book keeping and access
+ much simpler if I use [ PDL, [] ] or [ [], [] ] since now
+ all the new elements can be directly accessed without shifts
+ or pops. Conveniently, pdl() take either arrays or array
+ refs.
+
+ IO/Misc/misc.pd | 35 +++++++++++++++++------------------
+ 1 files changed, 17 insertions(+), 18 deletions(-)
+
+commit e948e1bbfde04098f53d829d627708e14f7c2120
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 14 20:33:01 2010 -0400
+
+ Add support for qr{} patterns to rcols
+
+ IO/Misc/misc.pd | 18 +++++++++++-------
+ 1 files changed, 11 insertions(+), 7 deletions(-)
+
+commit a99eda0575e7c09262de65a55ac423d3659c7bd5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Mar 14 18:45:07 2010 -0400
+
+ Refactor _ext_1D to _ext_lastD for rcols
+
+ In order to support multiple columns in one piddle
+ with rcols, need to have the extend routine work on
+ the last dim of an arbitrary piddle and not just
+ dim 0 of a 1D piddle.
+
+ A cool thing about the implementation was that I
+ could use ->mv(-1,)->slice()->mv(0,-1) to use the
+ same, simple slice expression as in the original
+ code. Way to go PDL!
+
+ IO/Misc/misc.pd | 19 +++++++++++--------
+ 1 files changed, 11 insertions(+), 8 deletions(-)
+
+commit dd4b2dc1728ec149d29677a456f11f553b22058a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Mar 13 10:14:53 2010 -0500
+
+ Fuse push for loops in rcols
+
+ Minor refactoring only, no algorithm change.
+
+ IO/Misc/misc.pd | 11 +----------
+ 1 files changed, 1 insertions(+), 10 deletions(-)
+
+commit 1b51f653ee4f8de0e68e9a436edea7f233ee8de4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 12 13:19:30 2010 -0500
+
+ Minor cleanup of _burp_1D for rcols performance
+
+ This did not make much difference but it saved
+ a few percent in the overhead.
+
+ IO/Misc/misc.pd | 5 ++---
+ 1 files changed, 2 insertions(+), 3 deletions(-)
+
+commit 91683a97d6608846aa0d621ed0e3b2a5a439a627
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 12 11:25:59 2010 -0500
+
+ Set $PDL::VERSION to 2.4.6_003 to mark new rcols
+
+ Since PDL::IO::Misc takes its version information from
+ PDL, I'm incrementing the sub release to mark the new
+ rcols performance and functionality introduced.
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit bebb0d951db3418f5267952d39a65d910675fa4c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Mar 12 11:23:48 2010 -0500
+
+ Fix problem with default split handling
+
+ I rediscovered that split(' ', $var) is not the
+ same as split($imaspace, $var) where $imaspace eq ' '
+ and fixed the oops.
+
+ IO/Misc/misc.pd | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 850f312e3dd705d0ed37beed9d1fe637792b0f9d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 11 23:02:29 2010 -0500
+
+ Make rcols calculate # of piddle cols more often
+
+ Now rcols will calculate the piddle columns in your
+ data file based on the split of the first data line
+ even if PERLCOLS is specified.
+
+ IO/Misc/misc.pd | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 8218825ef90aa9fe2ed2b975778014dfe3bb67bc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 11 18:21:47 2010 -0500
+
+ Add support for COLUMN ID headings to rcols()
+
+ This adds a new option, COLIDS to rcols() that may be used to
+ return an array of field strings from the first line of the
+ file where the strings are typically used as column IDs for
+ processing purposes.
+
+ IO/Misc/misc.pd | 219 +++++++++++++++++++++++++++++++------------------------
+ 1 files changed, 124 insertions(+), 95 deletions(-)
+
+commit 0f8fa6e742d21c3074aaf23186d9b973eae3879b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 11 14:26:43 2010 -0500
+
+ Improved rcols() IO performance
+
+ By using intermediate perl lists to queue column data
+ the number of calls converting between perl data and
+ PDL data are reduced. Since the per-call latency was
+ the reason for relative slowness, batching these by
+ chunks of 500 reduces the overhead considerably...
+
+ IO/Misc/misc.pd | 27 +++++++++++++++++++--------
+ 1 files changed, 19 insertions(+), 8 deletions(-)
+
+commit 04329123fc016a2e4086b75648d2a86e3a931554
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 10 18:36:44 2010 -0500
+
+ Refactor rcols to support memory-time perf trades
+
+ A profile of PDL::rcols shows that much/most of the
+ time is spent in the PDL set (and internal set_c) calls
+ to update the column piddles with the values as they
+ are read. This refactors the basic data structures for
+ the columns to allow for associated perl arrays for all
+ columns. Then we can call the expensive (in latency)
+ PDL set/assignment routines less often with the hope of
+ speeding up the overall IO performance.
+
+ IO/Misc/misc.pd | 64 +++++++++++++++++++++++++++++++++++++++++-------------
+ 1 files changed, 48 insertions(+), 16 deletions(-)
+
+commit 2fa1c51e2ec289edf3ffc74144fbdc86033a55dd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Mar 10 14:07:39 2010 -0500
+
+ Refactor rcols and improve regex usage
+
+ Clean up the pattern options in rcols() by replacing
+ them with qr{} to avoid re-compiles and to factor out
+ repetitive checks in the inner IO loop split operation.
+
+ IO/Misc/misc.pd | 25 +++++++++++++------------
+ 1 files changed, 13 insertions(+), 12 deletions(-)
+
+commit cd03c1e0e8e704d279c17a46c427302bfbb302d2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Mar 8 18:00:41 2010 -0500
+
+ More PDL/ARRAY clean up for rcols
+
+ Added pass-thru "do nothing" the routine to extend the PDL
+ arrays being read into allowing for symmetric treatment of
+ piddles and perl ARRAY refs.
+
+ Renamed ext1D to _ext_1D since it is an internal routine
+
+ Renamed _at_1d to _at_1D to match the naming scheme
+
+ Changed 1d to 1D in comments and strings throughout to consistency.
+
+ Added some comments/notes to remind us to follow up on possible
+ performance issues with the current rcols() implementation.
+ The hope is to use the feedback from Maggie Xiong re here get_data()
+ routine to set rcols() performance and functionalty goals: where
+ it works with comparable performance to get_data() and provides
+ similar functionality as well (specifically missing is support for
+ column headers).
+
+ IO/Misc/misc.pd | 58 +++++++++++++++++++++++++++++-------------------------
+ 1 files changed, 31 insertions(+), 27 deletions(-)
+
+commit a95815769d889429548a217dea467bbef5a8c9f6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Mar 4 16:57:46 2010 -0500
+
+ Fix minor doc error
+
+ IO/Misc/misc.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3867b9a34e2198a7c2a64f051dbc7916f1a8c6b8
+Author: David Mertens <david at david-desktop.(none)>
+Date: Tue Mar 2 15:37:27 2010 -0600
+
+ Added tentative documentation for PDL::PP's pp_setversion command.
+
+ Basic/Pod/PP.pod | 18 ++++++++++++++++--
+ 1 files changed, 16 insertions(+), 2 deletions(-)
+
+commit 3a6a21811d1c64d76d3a1bb317bd8f4c19f143ff
+Author: David Mertens <david at david-laptop.(none)>
+Date: Wed Feb 24 00:14:59 2010 -0600
+
+ A few more error-handling corrections.
+
+ No tests. Sorry.
+
+ Basic/Core/Core.pm.PL | 9 ++++++---
+ 1 files changed, 6 insertions(+), 3 deletions(-)
+
+commit 38802754fed835c0d8d763c91ae5f65e631a9655
+Author: David Mertens <david at david-desktop.(none)>
+Date: Tue Feb 23 19:26:02 2010 -0600
+
+ Added some handy error checking and messaging for screwy slices.
+
+ Basic/Core/Core.pm.PL | 74 ++++++++++++++++++++++++++++--------------------
+ 1 files changed, 43 insertions(+), 31 deletions(-)
+
+commit 2dbefe331493d6bbdf5dee3ae2dd2808ba5880b0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Feb 18 09:58:42 2010 -0500
+
+ Add subtest names to t/proj_transform.t
+
+ Hope this helps to track down a CPAN test failure for this.
+ Need to isolate the problem first.
+
+ t/proj_transform.t | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 7e814d1cd203cde164c376d677d43fdc6785118f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Feb 18 09:49:58 2010 -0500
+
+ Add subtest names to t/gsl_interp.t
+
+ There have been test failures from CPAN testers and the
+ subtest names may help to locate and diagnose the failures.
+
+ t/gsl_interp.t | 24 ++++++++++++------------
+ 1 files changed, 12 insertions(+), 12 deletions(-)
+
+commit d30b1b2d7921c7c255e92b3adc8e6b13d1fbdaa3
+Author: David Mertens <david at david-laptop.(none)>
+Date: Thu Feb 11 21:47:25 2010 -0600
+
+ Rewrote cat's error processing so that it's faster and more informative.
+
+ The original cat code would barf, but the problem is that it would do so
+ with a retarded message. I revised my first attempts at solving this by
+ putting the original cat code inside an eval. After the eval, if there
+ was an error, I go on a big parsing spree to figure out what all the
+ user may have screwed up.
+
+ Basic/Core/Core.pm.PL | 112 ++++++++++++++++++++++++++++++++++++++++--------
+ t/core.t | 33 ++++++++++++--
+ 2 files changed, 121 insertions(+), 24 deletions(-)
+
+commit 5011f4d63e91d6857b6132e74e9c16afcb07b432
+Merge: 54532da ff8da8b
+Author: David Mertens <david at david-desktop.(none)>
+Date: Thu Feb 11 17:43:20 2010 -0600
+
+ Merge branch 'master' of ssh://run4flat@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 54532da39fabb509a4c41e154bdb69b821e989a8
+Author: David Mertens <david at david-desktop.(none)>
+Date: Thu Feb 11 17:42:24 2010 -0600
+
+ Made cat's bad-argument message easier to read.
+
+ Basic/Core/Core.pm.PL | 4 ++--
+ t/core.t | 2 +-
+ 2 files changed, 3 insertions(+), 3 deletions(-)
+
+commit a06c5b98f1f4853cbd5548d277102026eef0591c
+Author: David Mertens <david at david-desktop.(none)>
+Date: Thu Feb 11 17:27:41 2010 -0600
+
+ Make cat check its arguments for piddleness and give a useful error when they're not.
+
+ Before this, cat wouldn't check it arguments. As a result, if you inadvertently gave
+ cat a non-piddle you would usually get an obscure error message directing you to
+ PDL's Core.pm. Now cat checks its arguments and tells you when they're messed up.
+
+ Basic/Core/Core.pm.PL | 12 ++++++++++++
+ t/core.t | 9 ++++++++-
+ 2 files changed, 20 insertions(+), 1 deletions(-)
+
+commit ff8da8b646c2e969948fb4a14167bcbfb77f41fa
+Author: David Mertens <david at david-laptop.(none)>
+Date: Thu Feb 11 12:50:24 2010 -0600
+
+ Fixed weird parser warning about a bad signature.
+
+ Doc/Pod/Parser.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit edd3668e64379c6a0ad7acbfa471713e7918b3b3
+Merge: 806c75e a6f4018
+Author: David Mertens <david at david-laptop.(none)>
+Date: Thu Feb 11 09:15:34 2010 -0600
+
+ Merge branch 'master' of ssh://run4flat@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 806c75ee89de1719ea47dffcfef6f9be3914ddf4
+Author: David Mertens <david at david-laptop.(none)>
+Date: Thu Feb 11 08:52:47 2010 -0600
+
+ Corrected PDL::Doc::Perldl::usage_string's erroneous no-match behavior.
+
+ usage_string is supposed to return a usage string, but if it didn't match anything the function
+ printed 'no match' rather than returning it. Normally this isn't a problem, but it gave my
+ extraneous output.
+
+ Doc/Doc/Perldl.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit a6f4018fc378499ed4272ac8cd8bb5d40220a52b
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Thu Feb 11 14:29:51 2010 +1100
+
+ perldl.conf - invalid config option fixed.
+
+ 'WITH_GSL => true' changed to 'WITH_GSL => undef'
+
+ perldl.conf | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 4f1e877c52373b10c916db84ee759f14e333f82d
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Wed Feb 10 14:42:39 2010 -0500
+
+ PDL version to 2.4.6_002 for new development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit aa7f2a2bac6e446c99491e4bcf660cad0123ea7d
+Merge: 114701c 7afd98a
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Wed Feb 10 14:41:20 2010 -0500
+
+ Merge branch 'master' of ssh://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 114701cddcade76058d87cc7faa1a1179d75be0f
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Wed Feb 10 14:36:11 2010 -0500
+
+ Added IO/IO.pod to the MANIFEST
+
+ MANIFEST | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 7afd98a9a4be8d0f4c63e3adb46634c88fad48fd
+Author: David Mertens <david at david-laptop.(none)>
+Date: Wed Feb 10 13:09:31 2010 -0600
+
+ Fixed confusing PP documentation about pp_add_exported.
+
+ Basic/Pod/PP.pod | 4 +---
+ 1 files changed, 1 insertions(+), 3 deletions(-)
+
+commit 8d5691c514e71a1d7f849e1f2ddaf83e506b241a
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Wed Feb 10 13:40:19 2010 -0500
+
+ Update readme type files for 2.4.6_001 release
+
+ Known_problems | 3 ++-
+ Makefile.PL | 1 -
+ README | 8 ++++----
+ Release_Notes | 11 +++++++----
+ TODO | 18 ++++++++++++++++++
+ cygwin/INSTALL | 18 +++++++++++++++---
+ cygwin/README | 5 ++---
+ win32/INSTALL | 4 ++--
+ 8 files changed, 50 insertions(+), 18 deletions(-)
+
+commit dc4b1b84b3b352b0df0bfff66133882870943088
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Wed Feb 10 12:53:59 2010 -0500
+
+ Clean up IO::Misc docs for [rw]cols
+
+ IO/Misc/misc.pd | 281 +++++++++++++++++++++++++++----------------------------
+ 1 files changed, 139 insertions(+), 142 deletions(-)
+
+commit 33eee77360ccef0048293d1dcf62493cc8f420ef
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Wed Feb 10 12:19:07 2010 -0500
+
+ Fix WITH_GSL => true to undef
+
+ The only allowed values are 0, 1, or undef and *not* true.
+
+ perldl.conf | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit de95f9ba653c7e3f4d27226f0aecc2091a69d799
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Mon Feb 8 20:28:29 2010 +1100
+
+ t/fastraw.t - fix win32 SKIP
+
+ Need to skip only 1 test (not 4).
+
+ t/fastraw.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f815e92074a930892f1668d6aa59adea01c38eec
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Sun Feb 7 20:49:44 2010 -0500
+
+ Add PERLCOLS support to any rcols output arg
+
+ Now PERLCOLS option syntax may be used to specify whether or
+ not a column to be read is destined for a piddle or a perl
+ array. This allows rcols and wcols to be symmetric on input
+ and output.
+
+ IO/Misc/misc.pd | 96 ++++++++++++++++++++++++++++++++++++++++++++----------
+ 1 files changed, 78 insertions(+), 18 deletions(-)
+
+commit 462ce299da62236d69e307dcdf8f44dac4d388d3
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Sun Feb 7 17:32:42 2010 -0500
+
+ Update Known_problems+Release_Notes for 2.4.6_001
+
+ Known_problems | 13 +++++--------
+ Release_Notes | 26 ++++++++++++++++++++++++++
+ 2 files changed, 31 insertions(+), 8 deletions(-)
+
+commit 3858a934ef8f73f9bfb34d7c0c25c4754c5bd59c
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Sun Feb 7 17:17:09 2010 -0500
+
+ Fix bug in handling of perl array output in wcols
+
+ IO/Misc/misc.pd | 31 ++++++++++++++++++-------------
+ 1 files changed, 18 insertions(+), 13 deletions(-)
+
+commit 66a8b6b04617b8760d19c66f61a67b5756ed2417
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Sun Feb 7 16:43:05 2010 -0500
+
+ Add support for perl array refs to wcols
+
+ Now you can use the input from the PERL_COLS directly in the wcols
+ output list. Still need to make the rcols support symmetric but this
+ is much more CSV file friendly.
+
+ IO/Misc/misc.pd | 38 ++++++++++++++++++++++++++++----------
+ 1 files changed, 28 insertions(+), 10 deletions(-)
+
+commit 9e2b3f201e3852e33f7f727b5befdbae1a1c4a2d
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Sun Feb 7 16:14:52 2010 -0500
+
+ Update docs for COLSEP option to [rw]cols
+
+ IO/Misc/misc.pd | 18 ++++++++++--------
+ 1 files changed, 10 insertions(+), 8 deletions(-)
+
+commit 6d7d13cb0dd272c78d1b01ee6b4e6c7cd482cdc3
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Sun Feb 7 16:10:48 2010 -0500
+
+ Fix dangling colsep after last piddle in wcols
+
+ This is not noticed with the default column separator of space
+ but is noticable and a bit annoying for CSV and other output with
+ printing characters as separators.
+
+ IO/Misc/misc.pd | 25 ++++++++++++++++---------
+ 1 files changed, 16 insertions(+), 9 deletions(-)
+
+commit 45414337c89cec64a1e025def2e5259465587bb2
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Sun Feb 7 15:40:43 2010 -0500
+
+ Fixed extra $, in wcols output with colsep
+
+ Because print was being used "under the hood" there was an extra
+ $, between every column of wcols output---even when the colsep
+ option was specified.
+
+ IO/Misc/misc.pd | 11 +++++++----
+ 1 files changed, 7 insertions(+), 4 deletions(-)
+
+commit 71c159d0ccb0778248fc2447b64cd3431704ff88
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Sun Feb 7 14:42:42 2010 -0500
+
+ Renamed the default colsep to $defcolsep for [rw]cols
+
+ The original global $PDL::IO::Misc::colsep use is preserved in
+ that if you set that value, it will be picked up and used for
+ rcols/wcols as before. However, the initial value of that global
+ is undef now. This change is in preparation for improved support
+ for PERLCOLS in rcols and wcols.
+
+ IO/Misc/misc.pd | 49 +++++++++++++++++++++++++++++++------------------
+ 1 files changed, 31 insertions(+), 18 deletions(-)
+
+commit eb5a3be5df58cc6f3d4cb8a6eb5c10e1f76fc363
+Author: data.collection <data.collection at BELVNB0361NV007.nae.ds.army.mil>
+Date: Sun Feb 7 14:35:57 2010 -0500
+
+ Add image pixel value to output on mouse click
+
+ This should make it easier to investigate data. TODO: support
+ clicking to access the original visualized data values rather
+ than the pixel values required for display.
+
+ imag2d.pdl | 9 +++++----
+ 1 files changed, 5 insertions(+), 4 deletions(-)
+
+commit 0ccf8bc853b90482f19ba1fa6df5034d5f8d45a1
+Author: David Mertens <david at david-laptop.(none)>
+Date: Fri Feb 5 11:11:07 2010 -0600
+
+ PLplot: Fixed a regression and modified .gitignore to include PLplot build files.
+
+ .gitignore | 4 ++++
+ Graphics/PLplot/plplot.pd | 1 +
+ 2 files changed, 5 insertions(+), 0 deletions(-)
+
+commit 1494780a55bd9cdffdb6e8df1ea4dc2b92ab36bb
+Author: David Mertens <david at david-laptop.(none)>
+Date: Fri Feb 5 11:00:58 2010 -0600
+
+ Minor modification to PLplot to use =head1 METHODS for the OO methods.
+
+ This will help make the distinction between the high-level and low-level documentation at least a little clearer.
+
+ Graphics/PLplot/plplot.pd | 4 +++-
+ 1 files changed, 3 insertions(+), 1 deletions(-)
+
+commit 8c68ae915d797232c68bf2b7ff59491f6040700d
+Author: David Mertens <david at david-laptop.(none)>
+Date: Fri Feb 5 10:58:45 2010 -0600
+
+ Corrected the documentation for Doc.pm to include OPERATORS, METHODS, and CONSTRUCTORS.
+
+ The online PDL help scans the POD for sections with head1-headings of FUNCTIONS, OPERATORS, METHODS, and CONSTRUCTORS, but only FUNCTIONS was mentioned in the documentation.
+
+ Doc/Doc.pm | 12 ++++++++++--
+ 1 files changed, 10 insertions(+), 2 deletions(-)
+
+commit 2f3190ab44698b5b72fe4b13e08620ae14306662
+Author: David Mertens <david at david-laptop.(none)>
+Date: Fri Feb 5 10:40:49 2010 -0600
+
+ Updated plplot.pd to version 0.52
+
+ Graphics/PLplot/Makefile.PL | 2 +-
+ Graphics/PLplot/plplot.pd | 405 +++++++++++++++++++++++++++++++++++++++----
+ 2 files changed, 368 insertions(+), 39 deletions(-)
+
+commit 0f0134f5be7df320bd14f7c7294c0c4a155e97dc
+Author: David Mertens <david at david-desktop.(none)>
+Date: Wed Feb 3 21:21:38 2010 -0600
+
+ Added function declaration for PDL::Graphics::TriD::EventHandler::new so TriD could load GL.pm or VRML.pm on the fly.
+
+ Graphics/TriD/TriD/Window.pm | 5 +++++
+ 1 files changed, 5 insertions(+), 0 deletions(-)
+
+commit af710e8e0b40e1fd7c1970a425fe4ca9005a3874
+Author: David Mertens <david at david-laptop.(none)>
+Date: Tue Feb 2 10:44:34 2010 -0600
+
+ Fixed a couple of documentation typos and made slices.pd CPAN friendly!
+
+ Basic/Core/Types.pm.PL | 2 +-
+ Basic/Gen/PP.pm | 2 +-
+ Basic/Slices/slices.pd | 131 ++++++++++++++++++++++++++++++++++-------------
+ 3 files changed, 97 insertions(+), 38 deletions(-)
+
+commit 5f1c99d906ef7bb4c621168e03e767cf5efa0f0c
+Author: David Mertens <david at david-laptop.(none)>
+Date: Tue Jan 26 11:46:01 2010 -0600
+
+ Minor documentation tweaks.
+
+ Basic/Core/Exporter.pm | 12 ++++++++----
+ Basic/Pod/Objects.pod | 3 ++-
+ 2 files changed, 10 insertions(+), 5 deletions(-)
+
+commit a58a300f85c7845f5a90e88a648d64bbe33bfd41
+Author: David Mertens <david at david-desktop.(none)>
+Date: Wed Jan 20 17:47:47 2010 -0600
+
+ Added and clarified som IO documentation, and added a note for mmapping in Windows.
+
+ I noticed DiskCache for the first time. I cleaned up a few niggles in the pod.
+ Having noticed DiskCache, I added a few notes about it to my IO.pod file, since it is very much an IO tool.
+ I've noted before that you can't mmap on Windows with PDL, but I spent a few minutes and found some code discussing mmap on windows. I've included it in a pod comment in Core.xs.PL
+
+ Basic/Core/Core.xs.PL | 54 +++++++++++++++++++++++++++++++++++++++++++++++++
+ IO/IO.pod | 43 +++++++++++++++++++++++++++++++++-----
+ Lib/DiskCache.pm | 4 +-
+ 3 files changed, 93 insertions(+), 8 deletions(-)
+
+commit c396534f97b81cbd1e4e5ecc66f125d7509a857f
+Author: David Mertens <david at david-desktop.(none)>
+Date: Wed Jan 20 16:55:33 2010 -0600
+
+ Fixed an error in my last correction.
+
+ IO/FastRaw/FastRaw.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 312df6adf7a29390388e4d461395d75549761c94
+Author: David Mertens <david at david-desktop.(none)>
+Date: Wed Jan 20 16:42:21 2010 -0600
+
+ Removed Perl 5.10 specific code from FastRaw.
+
+ IO/FastRaw/FastRaw.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 109e4e916e3c3380f6f6bcfff3a9876f92d9826a
+Merge: 812c36e 2e38dad
+Author: David Mertens <david at david-desktop.(none)>
+Date: Wed Jan 20 15:28:05 2010 -0600
+
+ Merge branch 'master' of git://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 812c36ebc83f8b796b7371adda09132a059e658a
+Author: David Mertens <david at david-desktop.(none)>
+Date: Wed Jan 20 15:27:36 2010 -0600
+
+ Updated FlexRaw so that passing and undefined header worked the same as not passing a header.
+
+ IO/FlexRaw/FlexRaw.pm | 45 ++++++++++++++++++++++-----------------------
+ 1 files changed, 22 insertions(+), 23 deletions(-)
+
+commit 2e38dadc8ce6fbc499fbd0db8af570f0efe666f1
+Merge: 7a56efd d34aae6
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Wed Jan 20 15:50:58 2010 -0500
+
+ Merge branch 'master' of ssh://lambd@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 7a56efd0b17437cd9458d521ca4d98ce7fc54d0e
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Wed Jan 20 15:29:02 2010 -0500
+
+ Modify rint algorithm for non-GNU compilers.
+
+ On GNU compilers, PDL::Math::rint uses the system library function. But on Microsoft compilers, there is no rint. The rint that was provided handled half-integer rounding differently than the GNU implementation. This commit implements a simple Banker's rounding algorithm that can be used by Microsoft compilers, updates the docs for rint to describe the calculation being performed (as well as providing some additional rounding guidance), and adds a new test file for this function.
+
+ Basic/Math/math.pd | 16 +++++++++++++++-
+ Basic/Math/rint.c | 28 ++++++++++++++++++----------
+ MANIFEST | 1 +
+ t/round.t | 19 +++++++++++++++++++
+ 4 files changed, 53 insertions(+), 11 deletions(-)
+
+commit d34aae6259c81714fd0705f12fe2561a487f364f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jan 18 00:12:32 2010 -0500
+
+ Fix new problem with POGL test fails
+
+ There were some problems with the compile and strict due to
+ undefined/declare functions. Added a couple of explicit sub
+ call syntax and the problem appears to be resolved.
+
+ Graphics/TriD/POGL/OpenGL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 957bba2659e74f375e8fd1c6de6b4e4878386204
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 16 09:15:49 2010 -0500
+
+ Quiet some of the preproc_oldwarn messages
+
+ perldl.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit a6cb99f672998181b173dd3c337d963004d6b893
+Author: David Mertens <david at david-laptop.(none)>
+Date: Fri Jan 15 15:39:17 2010 -0600
+
+ Cleaned up a little mistake in the TriD docs, and added a big example.
+
+ The example is meant to demonstrate the difference between drawing
+ gridded and non-gridded and drawing non-gridded surfaces.
+
+ Graphics/TriD/TriD.pm | 130 +++++++++++++++++++++++++++++++++++++++++++++++--
+ 1 files changed, 125 insertions(+), 5 deletions(-)
+
+commit 0f03559b4463b56df7ceccbf04b1fccb6bcc2a99
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Jan 15 15:21:23 2010 -0500
+
+ Documentation update for PDL::Transform::map from previous commit.
+
+ Lib/Transform/transform.pd | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 8c13261bba8be3a3390a58db37a4038b5f2a8953
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Fri Jan 15 14:12:44 2010 -0500
+
+ Remove 'p' option to PDL::Transform::map
+
+ The 'p' option was acceptable as an alias for both the 'pix' and 'phot' options. To avoid confusion and favoring one over the other, now map will croak if this is used.
+
+ Lib/Transform/transform.pd | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit 1d978f1ba50cd9db74ebe6b4543dfc55cf963e39
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Wed Jan 13 10:31:05 2010 -0500
+
+ Allow 'wim' to work with arrow operator
+
+ Small fix to allow wim to work with arrow operator [$pdl->wim('file')], like rpic, and like the docs say wim should.
+
+ IO/Pnm/Pic.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 471913f3c6aada339732f38e9a275aadb3fbdbc1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 12 15:47:29 2010 -0500
+
+ Update DEPENDENCIES with pgplot warning info
+
+ Add note to DEPENDENCIES that *both* pgplot library and PGPLOT
+ the perl module are required. This was already documented, just
+ adding some emphasis.
+
+ DEPENDENCIES | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 6573d179ce00ba1c1a0c415de2fc86e970894007
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jan 11 19:40:01 2010 -0500
+
+ Add demo 3d and 3d2 window close to Known_problems
+
+ More than one person has reported the problem.
+
+ Known_problems | 4 ++++
+ perldl.conf | 2 +-
+ 2 files changed, 5 insertions(+), 1 deletions(-)
+
+commit 6f9f3781d6e8488f885ef9f56131d78a4bdafa66
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jan 11 13:07:56 2010 -0500
+
+ Fix use fields problem for VRML driver
+
+ The problem was that Window.pm was use-ing PDL::Graphics::TriD::GL
+ for interactive windows without checking for offline to ensure that
+ incompatible declarations were not introduced. This seems to fix
+ the compile problem. Still need to verify that the operation is
+ correct.
+
+ Graphics/TriD/TriD.pm | 1 -
+ Graphics/TriD/TriD/Window.pm | 6 +++++-
+ 2 files changed, 5 insertions(+), 2 deletions(-)
+
+commit 4cf23d0632b7b3aa28355135c52aac483fce32e3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 9 19:11:47 2010 -0500
+
+ Add use PDL::Graphics::TriD::Labels 2 tmathgraph.p
+
+ Demos/TriD/tmathgraph.p | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 82e6584895edbd56d01f2b244019e5a91e837035
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 9 19:10:29 2010 -0500
+
+ Add no VRML exits to Demos/TriD/tvrml*.p examples
+
+ Demos/TriD/tvrml.p | 8 +++++++-
+ Demos/TriD/tvrml2.p | 10 +++++++++-
+ 2 files changed, 16 insertions(+), 2 deletions(-)
+
+commit d4e89f8009ed911c31463648b50f50ff6fcd766d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 8 11:21:14 2010 -0500
+
+ Added exit and warning to Demo/TriD/test6.p
+
+ This was a Tk demo which is not supported by
+ PDL+POGL TriD and is deprecated. The plan is
+ to replace Tk by some other more OpenGL
+ friendly GUI toolkit: Gtk2 and wxWidgets
+ both provide OpenGL widgets and are supported
+ on multiple platforms.
+
+ Demos/TriD/test6.p | 11 +++++++++++
+ 1 files changed, 11 insertions(+), 0 deletions(-)
+
+commit 066f70f78769909e8265eaabc3a4047daf6868ec
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 8 11:19:50 2010 -0500
+
+ Add sleep to Demo/TriD/mandel.p
+
+ Otherwise the demo completed too quickly to
+ watch. The modification uses Time::HiRes::sleep
+ so pre-perl 5.8 will need to install that module
+ for the code to work.
+
+ Demos/TriD/mandel.pl | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 5dea5c793e92e75cb419746d3d55d4906a60bc62
+Merge: e738fa2 87a1e84
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jan 6 13:31:21 2010 -0500
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit e738fa233207aa3d6445b36b08bb12aa872ca6ee
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jan 6 13:29:44 2010 -0500
+
+ Make help vars list PDLs alphabetically
+
+ It is hoped that this will make it easier to find
+ a given name for reference. Feedback welcome!
+
+ Basic/Core/Dbg.pm | 22 ++++++++++++----------
+ 1 files changed, 12 insertions(+), 10 deletions(-)
+
+commit 87a1e844b5f733058cbfeaf852fd1ed5f23b0a43
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jan 5 20:44:45 2010 -0500
+
+ Fix minor typo in POD for imag2d.pdl
+
+ imag2d.pdl | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit fed00daadec8c69df039bdb892110e8dfc8c89b9
+Author: David Mertens <david at david-laptop.(none)>
+Date: Tue Jan 5 13:42:05 2010 -0600
+
+ Added my by-line to PDL::IO.pod.
+
+ IO/IO.pod | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit 7acbb1a20e4163650b6e62d26cf63f1a4c1b043e
+Merge: 30d1c7b 0ccd029
+Author: David Mertens <david at david-laptop.(none)>
+Date: Tue Jan 5 13:37:00 2010 -0600
+
+ Merge branch 'master' of ssh://run4flat@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 30d1c7b00e54bc24941be89cb5a3e41e13482917
+Author: David Mertens <david at david-laptop.(none)>
+Date: Tue Jan 5 13:35:04 2010 -0600
+
+ Wrote a summary of the PDL::IO modules in PDL/IO.pod.
+
+ I also added some documentation to FlexRaw.
+
+ IO/FlexRaw/FlexRaw.pm | 16 +++
+ IO/IO.pod | 253 +++++++++++++++++++++++++++++++++++++++++++++++++
+ IO/Makefile.PL | 5 +-
+ 3 files changed, 273 insertions(+), 1 deletions(-)
+
+commit 0ccd029e1327060583fcdbdf81667b39b7819c1d
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Jan 5 13:39:54 2010 -0500
+
+ Add documentation to hdrcpy
+
+ Document potentially ambiguous behavior when two piddles with hdrcpy flags set are used in an expression. The hdr of the first piddle is used in the result.
+
+ Basic/Core/Core.pm.PL | 13 +++++++++++++
+ IO/FITS/FITS.pm | 4 +++-
+ 2 files changed, 16 insertions(+), 1 deletions(-)
+
+commit d4956defe886744ce8256cdc09f4725d4f50a83f
+Author: Derek Lamb <dlamb at gs671-rocket.gsfc.nasa.gov>
+Date: Tue Jan 5 12:04:45 2010 -0500
+
+ prevent @t from being defined in main:: after ?, ??, sig, etc
+
+ @t was being defined in main by the perldl shell after help, sig,
+ apropos, etc were called. 'my'-ing @t fixes this.
+
+ perldl.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit d0b54635a76de7e1625f6088445415630da00125
+Merge: a2da5ac 3aaab11
+Author: David Mertens <david at david-desktop.(none)>
+Date: Tue Jan 5 07:48:57 2010 -0600
+
+ Merge branch 'master' of git://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 3aaab11dbd9321de513f42f50bce3591523cc2c8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jan 4 20:38:44 2010 -0500
+
+ Minor clean-up to imag2d() POD
+
+ imag2d.pdl | 39 +++++++++++++++++++++++++++------------
+ 1 files changed, 27 insertions(+), 12 deletions(-)
+
+commit b54e3a68a8ebd207559527b982f4e0cde5cffbbe
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jan 3 12:54:02 2010 -0500
+
+ Set USE_KARMA => 0 in perldl.conf
+
+ Karma is being deprecated. You can still force the build
+ by setting this to 1 but eventually Karma will eventually
+ stop being supported.
+
+ perldl.conf | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 9df065e59cf3d626e2343f3a9341efbc563ddd15
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Jan 3 12:41:02 2010 -0500
+
+ f2c Lib/Slatec/slatec/*.f into f2c subdirectory
+
+ These are the converted Slatec files from our PDL
+ distribution. The next step is to modify the build
+ process to use these for the Slatec bindings. We
+ will need to add some f2c runtime routines eventually
+ to get things working all the way.
+
+ Lib/Slatec/slatec/f2c/chfcm.c | 184 ++++++++
+ Lib/Slatec/slatec/f2c/chfdv.c | 211 +++++++++
+ Lib/Slatec/slatec/f2c/chfev.c | 201 +++++++++
+ Lib/Slatec/slatec/f2c/chfie.c | 142 ++++++
+ Lib/Slatec/slatec/f2c/d1mach.c | 535 +++++++++++++++++++++++
+ Lib/Slatec/slatec/f2c/dasum.c | 125 ++++++
+ Lib/Slatec/slatec/f2c/daxpy.c | 150 +++++++
+ Lib/Slatec/slatec/f2c/dchfcm.c | 184 ++++++++
+ Lib/Slatec/slatec/f2c/dchfdv.c | 216 ++++++++++
+ Lib/Slatec/slatec/f2c/dchfev.c | 205 +++++++++
+ Lib/Slatec/slatec/f2c/dchfie.c | 143 ++++++
+ Lib/Slatec/slatec/f2c/ddot.c | 149 +++++++
+ Lib/Slatec/slatec/f2c/dgeco.c | 313 ++++++++++++++
+ Lib/Slatec/slatec/f2c/dgedi.c | 216 ++++++++++
+ Lib/Slatec/slatec/f2c/dgefa.c | 172 ++++++++
+ Lib/Slatec/slatec/f2c/dgesl.c | 196 +++++++++
+ Lib/Slatec/slatec/f2c/dp1vlu.c | 249 +++++++++++
+ Lib/Slatec/slatec/f2c/dpchbs.c | 265 ++++++++++++
+ Lib/Slatec/slatec/f2c/dpchce.c | 320 ++++++++++++++
+ Lib/Slatec/slatec/f2c/dpchci.c | 235 ++++++++++
+ Lib/Slatec/slatec/f2c/dpchcm.c | 292 +++++++++++++
+ Lib/Slatec/slatec/f2c/dpchcs.c | 333 ++++++++++++++
+ Lib/Slatec/slatec/f2c/dpchdf.c | 150 +++++++
+ Lib/Slatec/slatec/f2c/dpchfd.c | 412 ++++++++++++++++++
+ Lib/Slatec/slatec/f2c/dpchfe.c | 398 +++++++++++++++++
+ Lib/Slatec/slatec/f2c/dpchia.c | 349 +++++++++++++++
+ Lib/Slatec/slatec/f2c/dpchic.c | 423 ++++++++++++++++++
+ Lib/Slatec/slatec/f2c/dpchid.c | 255 +++++++++++
+ Lib/Slatec/slatec/f2c/dpchim.c | 358 ++++++++++++++++
+ Lib/Slatec/slatec/f2c/dpchkt.c | 124 ++++++
+ Lib/Slatec/slatec/f2c/dpchsp.c | 505 ++++++++++++++++++++++
+ Lib/Slatec/slatec/f2c/dpchst.c | 84 ++++
+ Lib/Slatec/slatec/f2c/dpchsw.c | 253 +++++++++++
+ Lib/Slatec/slatec/f2c/dpcoef.c | 121 ++++++
+ Lib/Slatec/slatec/f2c/dpoco.c | 303 +++++++++++++
+ Lib/Slatec/slatec/f2c/dpodi.c | 203 +++++++++
+ Lib/Slatec/slatec/f2c/dpofa.c | 128 ++++++
+ Lib/Slatec/slatec/f2c/dpolft.c | 528 +++++++++++++++++++++++
+ Lib/Slatec/slatec/f2c/dscal.c | 123 ++++++
+ Lib/Slatec/slatec/f2c/dswap.c | 161 +++++++
+ Lib/Slatec/slatec/f2c/ezfft1.c | 159 +++++++
+ Lib/Slatec/slatec/f2c/ezfftb.c | 162 +++++++
+ Lib/Slatec/slatec/f2c/ezfftf.c | 145 +++++++
+ Lib/Slatec/slatec/f2c/ezffti.c | 70 +++
+ Lib/Slatec/slatec/f2c/fdump.c | 47 ++
+ Lib/Slatec/slatec/f2c/i1mach.c | 929 ++++++++++++++++++++++++++++++++++++++++
+ Lib/Slatec/slatec/f2c/idamax.c | 121 ++++++
+ Lib/Slatec/slatec/f2c/isamax.c | 121 ++++++
+ Lib/Slatec/slatec/f2c/j4save.c | 84 ++++
+ Lib/Slatec/slatec/f2c/pchbs.c | 261 +++++++++++
+ Lib/Slatec/slatec/f2c/pchce.c | 320 ++++++++++++++
+ Lib/Slatec/slatec/f2c/pchci.c | 234 ++++++++++
+ Lib/Slatec/slatec/f2c/pchcm.c | 290 +++++++++++++
+ Lib/Slatec/slatec/f2c/pchcs.c | 332 ++++++++++++++
+ Lib/Slatec/slatec/f2c/pchdf.c | 148 +++++++
+ Lib/Slatec/slatec/f2c/pchfd.c | 408 ++++++++++++++++++
+ Lib/Slatec/slatec/f2c/pchfe.c | 394 +++++++++++++++++
+ Lib/Slatec/slatec/f2c/pchia.c | 343 +++++++++++++++
+ Lib/Slatec/slatec/f2c/pchic.c | 418 ++++++++++++++++++
+ Lib/Slatec/slatec/f2c/pchid.c | 251 +++++++++++
+ Lib/Slatec/slatec/f2c/pchim.c | 355 +++++++++++++++
+ Lib/Slatec/slatec/f2c/pchkt.c | 122 ++++++
+ Lib/Slatec/slatec/f2c/pchsp.c | 501 ++++++++++++++++++++++
+ Lib/Slatec/slatec/f2c/pchst.c | 82 ++++
+ Lib/Slatec/slatec/f2c/pchsw.c | 249 +++++++++++
+ Lib/Slatec/slatec/f2c/pcoef.c | 121 ++++++
+ Lib/Slatec/slatec/f2c/polfit.c | 527 +++++++++++++++++++++++
+ Lib/Slatec/slatec/f2c/pvalue.c | 249 +++++++++++
+ Lib/Slatec/slatec/f2c/pythag.c | 70 +++
+ Lib/Slatec/slatec/f2c/r1mach.c | 452 +++++++++++++++++++
+ Lib/Slatec/slatec/f2c/radb2.c | 139 ++++++
+ Lib/Slatec/slatec/f2c/radb3.c | 162 +++++++
+ Lib/Slatec/slatec/f2c/radb4.c | 214 +++++++++
+ Lib/Slatec/slatec/f2c/radb5.c | 232 ++++++++++
+ Lib/Slatec/slatec/f2c/radbg.c | 381 ++++++++++++++++
+ Lib/Slatec/slatec/f2c/radf2.c | 141 ++++++
+ Lib/Slatec/slatec/f2c/radf3.c | 155 +++++++
+ Lib/Slatec/slatec/f2c/radf4.c | 200 +++++++++
+ Lib/Slatec/slatec/f2c/radf5.c | 220 ++++++++++
+ Lib/Slatec/slatec/f2c/radfg.c | 386 +++++++++++++++++
+ Lib/Slatec/slatec/f2c/rfftb.c | 121 ++++++
+ Lib/Slatec/slatec/f2c/rfftb1.c | 224 ++++++++++
+ Lib/Slatec/slatec/f2c/rfftf.c | 122 ++++++
+ Lib/Slatec/slatec/f2c/rfftf1.c | 221 ++++++++++
+ Lib/Slatec/slatec/f2c/rs.c | 133 ++++++
+ Lib/Slatec/slatec/f2c/sasum.c | 124 ++++++
+ Lib/Slatec/slatec/f2c/saxpy.c | 150 +++++++
+ Lib/Slatec/slatec/f2c/sdot.c | 148 +++++++
+ Lib/Slatec/slatec/f2c/sgeco.c | 311 ++++++++++++++
+ Lib/Slatec/slatec/f2c/sgedi.c | 214 +++++++++
+ Lib/Slatec/slatec/f2c/sgefa.c | 171 ++++++++
+ Lib/Slatec/slatec/f2c/sgesl.c | 195 +++++++++
+ Lib/Slatec/slatec/f2c/snrm2.c | 251 +++++++++++
+ Lib/Slatec/slatec/f2c/spoco.c | 302 +++++++++++++
+ Lib/Slatec/slatec/f2c/spodi.c | 202 +++++++++
+ Lib/Slatec/slatec/f2c/spofa.c | 124 ++++++
+ Lib/Slatec/slatec/f2c/srot.c | 133 ++++++
+ Lib/Slatec/slatec/f2c/srotg.c | 144 +++++++
+ Lib/Slatec/slatec/f2c/sscal.c | 122 ++++++
+ Lib/Slatec/slatec/f2c/ssvdc.c | 756 ++++++++++++++++++++++++++++++++
+ Lib/Slatec/slatec/f2c/sswap.c | 161 +++++++
+ Lib/Slatec/slatec/f2c/tql2.c | 297 +++++++++++++
+ Lib/Slatec/slatec/f2c/tqlrat.c | 250 +++++++++++
+ Lib/Slatec/slatec/f2c/tred1.c | 217 ++++++++++
+ Lib/Slatec/slatec/f2c/tred2.c | 260 +++++++++++
+ Lib/Slatec/slatec/f2c/xerbla.c | 100 +++++
+ Lib/Slatec/slatec/f2c/xercnt.c | 77 ++++
+ Lib/Slatec/slatec/f2c/xerhlt.c | 57 +++
+ Lib/Slatec/slatec/f2c/xermsg.c | 469 ++++++++++++++++++++
+ Lib/Slatec/slatec/f2c/xerprn.c | 310 +++++++++++++
+ Lib/Slatec/slatec/f2c/xersve.c | 233 ++++++++++
+ Lib/Slatec/slatec/f2c/xgetua.c | 87 ++++
+ 112 files changed, 26795 insertions(+), 0 deletions(-)
+
+commit 4af280225a635e6ef1ae34bf52ee7318d30fd4b1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 2 14:52:49 2010 -0500
+
+ Fix no more windows hang in imag2d twiddle()
+
+ There was a possible hang with imag2d() and its twiddle() subroutine
+ where closing the image windows via the window manager close widget
+ could leave you with no active windows to receive the Q command to
+ stop twiddling. Now we correctly update the list of imag2d() image
+ windows and check during the twiddle.
+
+ imag2d.pdl | 67 ++++++++++++++++++++++++++++++++++++++++++++---------------
+ 1 files changed, 50 insertions(+), 17 deletions(-)
+
+commit 95adcd60ce0463050e8397d26ad895b923779a36
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 2 12:19:40 2010 -0500
+
+ Update Known_problems (whitespace path bug fixed)
+
+ This is sf.net bug #2924854.
+
+ Known_problems | 5 -----
+ 1 files changed, 0 insertions(+), 5 deletions(-)
+
+commit c48de5a5b4949c967ab02f8e4ae34c1dc6f8b99d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 2 11:38:50 2010 -0500
+
+ Make PDL prompt/warn if space in build path
+
+ This resolves sf.net bug #2924854. The Makefile.PL will check
+ the current directory of the Makefile.PL and warn if white space
+ is detected. A prompt is issued to see if the user wishes to
+ continue anyway.
+
+ Makefile.PL | 20 +++++++++++++++++---
+ 1 files changed, 17 insertions(+), 3 deletions(-)
+
+commit ef612667b1634400f85544e1cb4443295b925e7b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 2 10:09:55 2010 -0500
+
+ Update INSTALL/Known_problems for sf bug #2924854
+
+ PDL build currently breaks if the build directory has
+ white space in it. The work around is to use a build
+ directory without white space in the path.
+
+ INSTALL | 16 ++++++++++++++++
+ Known_problems | 5 +++++
+ 2 files changed, 21 insertions(+), 0 deletions(-)
+
+commit b13bda4cc6513b5699213c407e80c68f630a525f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Jan 2 00:03:29 2010 -0500
+
+ Fix GL.pm compile problem with x11 windows
+
+ If you build TriD with the 'x11' window type option, then some GLUT
+ routines are not declared/defined and GL.pm fails to compile. This
+ puts a string eval around the problem line to fix the compile.
+
+ Graphics/TriD/TriD/GL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 0042f0d7c53f0f574d0bef39347cb616fe82e5f3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 1 15:33:16 2010 -0500
+
+ Add imag2d twiddle hang info to Known_problems
+
+ This is a reminder to fix the problem by checking for
+ any remaining open windows and if the last one closes,
+ return from twiddle(). Also need to refresh the display
+ on a new twiddle() in case the image data has changed.
+
+ Known_problems | 5 +++++
+ 1 files changed, 5 insertions(+), 0 deletions(-)
+
+commit feccc2d81ada0f4ed655a44929cbf1362e00185b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 1 15:32:49 2010 -0500
+
+ Update VERSION to 2.4.6_001 for development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f4d68710abd86a754b86dd0ceed4d101c8fba634
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jan 1 12:05:18 2010 -0500
+
+ Add Padre/pdlrun to MANIFEST
+
+ MANIFEST | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit d378ec2edd2728f008d0ce67f5b26337ac8616f2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Dec 31 23:06:11 2009 -0500
+
+ Update readme-type files for 2.4.6 release
+
+ BUGS | 10 +++++-----
+ DEPENDENCIES | 22 ++++++++++++----------
+ Known_problems | 15 +++++++--------
+ README | 7 +++++--
+ TODO | 16 ++++++++++++++++
+ 5 files changed, 45 insertions(+), 25 deletions(-)
+
+commit fbfa06523b657a643987ccb5a1c0359bd30bc09b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Dec 31 22:22:24 2009 -0500
+
+ Set VERSION to 2.4.6 for release tomorrow
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 873bebb24b9d67c39781110cb289f2ddecd22cfb
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Dec 31 14:26:01 2009 -0500
+
+ Update Release_Notes for 2.4.6 release
+
+ Release_Notes | 136 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 136 insertions(+), 0 deletions(-)
+
+commit d38f9b5d0479d483ddb8c62afb8b2e9239107556
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 30 23:09:00 2009 -0500
+
+ Set $rl_MaxHistorySize to $PERLDL::HISTFILESIZE
+
+ Term::ReadLine::Perl has a default maximum number of lines saved
+ of 100 set by the variable $readline::rl_MaxHistorySize. This
+ fixes default.perldlrc (a.k.a. default.pdl on windows) to set
+ the limit to $PERLDL::HISTFILESIZE.
+
+ Basic/default.perldlrc | 6 ++++++
+ 1 files changed, 6 insertions(+), 0 deletions(-)
+
+commit 117d1cdc9b1efeafd12d063315c3c01dda8d7da8
+Merge: 35321ff bb3d913
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 30 21:30:31 2009 -0500
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit bb3d913decaa6d426213b6faf226003710f7f5fc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 29 12:03:42 2009 -0500
+
+ Add note to install Devel::REPL for Padre shell
+
+ Padre/README | 6 +++++-
+ 1 files changed, 5 insertions(+), 1 deletions(-)
+
+commit 0ed2a1b4ab0a0afd7a3c79d9ea316753e36740ff
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 29 11:23:17 2009 -0500
+
+ Add win32 notes for Devel::REPL shell
+
+ Padre/README | 15 ++++++++-------
+ 1 files changed, 8 insertions(+), 7 deletions(-)
+
+commit b72fcb70122bdb5b8a4373b553502d9c845923b2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 29 11:10:41 2009 -0500
+
+ Update Padre/README with usage info
+
+ This should be enough to get things started with Devel::REPL
+ based shell. Try the TAB completion for PDL methods and enjoy!
+
+ Padre/README | 30 +++++++++++++++++++++++++++++-
+ Padre/pdlrun | 8 ++++++++
+ 2 files changed, 37 insertions(+), 1 deletions(-)
+
+commit 35321ff5103616716b6b02c2cf8ca1258c2559c0
+Merge: 25cf2c6 7c31c35
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 28 20:16:51 2009 -0500
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 7c31c350040d1421f36e9f454eee2d30d0ec1662
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 28 15:44:30 2009 -0500
+
+ VERSION to 2.4.5_009 for final fixes
+
+ We're in code freeze so it is likely that there will not be
+ another intermediate CPAN developers release before 2.4.6
+ on Fri, 01-Jan-2009.
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 79d65a4d4945fc1a6231972bd0a1dfe29cfe7fdd
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 28 15:34:45 2009 -0500
+
+ Update FAQ for PDL-2.4.6 release
+
+ Basic/Pod/FAQ.pod | 85 ++++++++++++++++++++++++++---------------------------
+ 1 files changed, 42 insertions(+), 43 deletions(-)
+
+commit f11bd26d75d4241e9102fabfc64591bfc0c3f77d
+Merge: d0bd1af ae53283
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 28 10:42:32 2009 -0500
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+ Conflicts:
+ DEPENDENCIES
+ Known_problems
+ MANIFEST
+ TODO
+ perldl.conf
+
+commit 25cf2c67641bc58d7e55ad25f95b8a4d0069fcac
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 27 16:28:21 2009 -0500
+
+ Add comment re fix for defined(%hash) usage
+
+ This is apparently not quite correct usage. Searching for the
+ terms 'defined(%hash) is deprecated' on Google yielded the replacement
+ added to the comments.
+
+ Basic/Core/Dev.pm | 9 ++++++++-
+ 1 files changed, 8 insertions(+), 1 deletions(-)
+
+commit ae53283d0f0a97bbdbc1e783faefec04d6e6053b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 27 13:06:00 2009 -0500
+
+ Add Release_Notes for PDL-2.4.5_008 release
+
+ This release is basically PDL-2.4.6 release candidate 2....
+
+ Release_Notes | 14 ++++++++++++++
+ 1 files changed, 14 insertions(+), 0 deletions(-)
+
+commit 9c348c5eb5ffa91343b29c5f7484bca8bec9523d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 27 13:05:29 2009 -0500
+
+ Add sf.net PDL wiki URL to INSTALL file
+
+ INSTALL | 5 +++++
+ 1 files changed, 5 insertions(+), 0 deletions(-)
+
+commit b1910b5e2bed0e6762b42775b79c8f115a02505f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 27 12:58:06 2009 -0500
+
+ Add "how to use" comment to imag2d.pdl
+
+ imag2d.pdl | 10 +++++++++-
+ 1 files changed, 9 insertions(+), 1 deletions(-)
+
+commit 260a2491af88e0ef9c34a38cee92dd1070f8b6a9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 27 12:22:56 2009 -0500
+
+ Update POGL_VERSION and WITH_3D in perldl.conf
+
+ Autoprobe for TriD build now works on all supported
+ platform types so removed WITH_3D special cases. Also
+ set POGL_VERSION to 0.62. Earlier may work mostly but
+ you'll need to edit perldl.conf to change.
+
+ perldl.conf | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 87151fb54b33ecdc197e1c410bf759b9d60d77a8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 27 12:22:16 2009 -0500
+
+ Update VERSION to 2.4.5_008 for development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 001b76543ce97accac986ced29d5336b3dcd09b1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 27 12:21:00 2009 -0500
+
+ Update MANIFEST with Example/TriD files
+
+ MANIFEST | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 811ddff923fb79d9190c93c0ee7e39588ccfbb66
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 26 13:13:08 2009 -0500
+
+ Update readme's for 2.4.5_007 release
+
+ BUGS | 7 ++++---
+ DEPENDENCIES | 3 ++-
+ DEVELOPMENT | 2 +-
+ Known_problems | 15 ++++++---------
+ Release_Notes | 15 +++++++++++++++
+ 5 files changed, 28 insertions(+), 14 deletions(-)
+
+commit 873ab2ca7248e24f25140e22f6a764fffd97efd0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 26 12:52:40 2009 -0500
+
+ Mv 3dtest.pl and line3d.pl to Example/TriD
+
+ 3dtest.pl | 18 ------------------
+ line3d.pl | 19 -------------------
+ 2 files changed, 0 insertions(+), 37 deletions(-)
+
+commit 80e341d92050179475e924e0e9f52f24582d3908
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 26 12:51:11 2009 -0500
+
+ Move TriD example/test progs to Example/TriD
+
+ Clean up top level PDL directory by moving the example/test programs
+ 3dtest.pl and line3d.pl to Example/TriD/ which is probably where they
+ should have been to begin with.
+
+ Example/TriD/3dtest.pl | 18 ++++++++++++++++++
+ Example/TriD/line3d.pl | 19 +++++++++++++++++++
+ 2 files changed, 37 insertions(+), 0 deletions(-)
+
+commit 3ad6b847666f5b66289e406234349abef12807e9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 22 14:35:16 2009 -0500
+
+ Rm unnecessary ${ } around get_dataref in GL.pm
+
+ Graphics/TriD/TriD/GL.pm | 8 ++++----
+ 1 files changed, 4 insertions(+), 4 deletions(-)
+
+commit baf3c96196c2f13ac1000f0777230865e452eb0a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 22 13:52:36 2009 -0500
+
+ Add example to imag2d() documentation
+
+ imag2d.pdl | 14 +++++++++++++-
+ 1 files changed, 13 insertions(+), 1 deletions(-)
+
+commit c86f955a59b3ab95ced604e603e4c5887c132476
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 22 12:39:51 2009 -0500
+
+ Replace GIMME by GIMME_V in Core.xs
+
+ Basic/Core/Core.xs.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 57651a8aa6027ca038de249d45a8f57a3054d316
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 22 10:59:32 2009 -0500
+
+ Add q or Q to Quit message to twiddle
+
+ Also added the GLUT window ID to the Title for reference
+ and changed the minimum dimension to 200 pixels from 100 pixels
+ which seemed a bit small. Probably should handle user override
+ when they specify their own value for $zoom.
+
+ imag2d.pdl | 13 ++++++++-----
+ 1 files changed, 8 insertions(+), 5 deletions(-)
+
+commit 8ed116a4f55443a07b9e1e4333378127dac45528
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Dec 22 10:59:11 2009 -0500
+
+ Update version to 2.4.5_007 for devel
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 4b0bb173adb47db4d5296fa556f536cfd23404d9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 21 16:19:34 2009 -0500
+
+ Update readme type files for 2.4.5_006
+
+ Known_problems | 4 ++++
+ Padre/README | 5 ++++-
+ TODO | 12 ++++++++++++
+ cygwin/INSTALL | 17 ++++++++++++++++-
+ 4 files changed, 36 insertions(+), 2 deletions(-)
+
+commit 7c5bf726f578a9e6e3c4a91aba9fda2d2569d675
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 21 16:05:28 2009 -0500
+
+ Update Known_problems for PDL-2.4.5_006
+
+ Known_problems | 53 ++++++++++++++++++-----------------------------------
+ 1 files changed, 18 insertions(+), 35 deletions(-)
+
+commit 6f5adf14a1ea130517c90ab3307ef0fd0affe3b9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 21 13:05:57 2009 -0500
+
+ Update Release_Notes, Known_problems,...
+
+ and MANIFEST with imag2d.pdl for trial release of new 2D
+ image display functionality.
+
+ Known_problems | 2 +-
+ MANIFEST | 1 +
+ Release_Notes | 21 +++++++++++++++++++++
+ 3 files changed, 23 insertions(+), 1 deletions(-)
+
+commit 7e7bad8e941ac1d77862e650538e9f87317f8216
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 21 13:04:22 2009 -0500
+
+ Fix missing use PDL::Core in VRML.pm
+
+ VRML.pm is not supported but it was missing a use PDL::Core
+ to provide barf. I'm not sure why it was not detected sooner.
+
+ Graphics/TriD/VRML/VRML.pm | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 46dfcc9147588c3749a7f292b05113e58080d22a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 21 13:02:28 2009 -0500
+
+ Add imag2d.pdl
+
+ This implements the basic functionality planned regarding
+ an improved imagrgb() routine.
+
+ imag2d.pdl | 638 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 638 insertions(+), 0 deletions(-)
+
+commit ee2a13e45c5664fef765c039f320c3d0b979928e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Dec 21 13:01:26 2009 -0500
+
+ Update $PDL::VERSION to 2.4.5_006 for devel
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 578deac1c0b61f3f40c4e69c9540f36bb5804c56
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 20 17:00:12 2009 -0500
+
+ Update Known_problems for PDL version
+
+ Known_problems | 9 +++------
+ 1 files changed, 3 insertions(+), 6 deletions(-)
+
+commit 5b7931f3a1ba49780cfb19c9d19fc9cc75dec496
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 20 16:53:12 2009 -0500
+
+ Update Release_Notes w TriD multi-window status
+
+ Release_Notes | 16 ++++++++++++----
+ 1 files changed, 12 insertions(+), 4 deletions(-)
+
+commit 728d7d8bfbd152319a7b97fdd8c3aba2c601dad6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 20 16:36:55 2009 -0500
+
+ Make window the *GLUT* current window for display
+
+ This doesn't make any difference with only one window but
+ with multiple windows, the image was appearing in the
+ wrong windows. Still need a better way to select/set an
+ active figure window. There are currently two globals for
+ the TriD current window:
+
+ $PDL::Graphics::TriD::cur
+ $PDL::Graphics::TriD::current_window
+
+ Need to determine if they are both needed and if not,
+ get rid of one of them.
+
+ Graphics/TriD/TriD/GL.pm | 5 +++++
+ 1 files changed, 5 insertions(+), 0 deletions(-)
+
+commit 1a5793d43ae03081708c78175a079a0588c0c9d1
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 20 16:35:36 2009 -0500
+
+ Add window ID to GLUT TriD window titles
+
+ This allows for easier multi-window support since the user
+ can tell at a glance what ID goes with what window.
+
+ Graphics/TriD/POGL/OpenGL.pm | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 15e098ca2a28be2fa3b468cd3a5b8f3d9c811c25
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 20 15:50:14 2009 -0500
+
+ Fix annoying PGPLOT::HANDLE warning message
+
+ Apparently perl_get_sv() and the non-deprecated version get_sv()
+ will cause a variable used only once message since perl 5.10.
+ Or in GV_ADDMULTI with the create option to quiet the message.
+
+ Graphics/PGPLOT/Window/Window.xs | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit de1a6e5b7c4ecc4e6524964670203869836ae63b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 20 15:48:39 2009 -0500
+
+ Update MANIFEST for Padre
+
+ The Padre directory is experimental for now but we would
+ like to make it available for users to try with releases
+ as well as just git pulls.
+
+ MANIFEST | 269 +++++++++++++++++++++++++++++++-------------------------------
+ 1 files changed, 136 insertions(+), 133 deletions(-)
+
+commit 67bf357263a7ff63ac2bb55193e3f8e52568fd17
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Dec 20 12:46:13 2009 -0500
+
+ Update conv1d pod with math definition
+
+ Added the equation being calculated for the conv1d()
+ routine. Still need to update the general convolution
+ docs.
+
+ Basic/Primitive/primitive.pd | 21 ++++++++++++++++++++-
+ 1 files changed, 20 insertions(+), 1 deletions(-)
+
+commit 5855ee33d6d98c8207a2d09942afa18580e14950
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 19 21:55:38 2009 -0500
+
+ Fix SF bug #2524068 re pp_def() w no piddles
+
+ pp_def() when used to generate bindings to functions with
+ no piddle arguments (numm Pars option) creates invalid C99
+ syntax. The workaround is to use pp_addxs() instead.
+
+ Known_problems | 6 ------
+ Lib/Minuit/minuit.pd | 23 +++++++++++++++++------
+ Release_Notes | 4 ++++
+ 3 files changed, 21 insertions(+), 12 deletions(-)
+
+commit 3972fa71f6c6717cf3c276d656fa442867e3ca54
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 19 18:54:22 2009 -0500
+
+ Update Release_Notes with convolution fixes
+
+ Release_Notes | 19 +++++++++++++++++++
+ 1 files changed, 19 insertions(+), 0 deletions(-)
+
+commit 165a2a692ccbcc9545248fb71c09dcaee716ba01
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 19 18:46:04 2009 -0500
+
+ Fix fftconvolve
+
+ This fixes SF bug #2630369 where fftconvolve() did not give the
+ same results as conv1d, conv2d, or convolveND. This implements
+ fftconvolve at the perl level using the direct calculation the
+ FFT for the each of the input arguments, then complex multiplication
+ of the results followed by iFFT. This implementation uses the
+ full complex FFT and iFFT with all the associated temporaries.
+ The results are returned in place which preserves the original
+ (confusing) behavior.
+
+ Lib/FFT/fft.pd | 29 +++++++++++++++++++++++++++--
+ 1 files changed, 27 insertions(+), 2 deletions(-)
+
+commit a3ca0b0529d7f56b3e79d0a855426f3c57d5d7ef
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 19 16:48:24 2009 -0500
+
+ Fix conv1d to calculate convolution
+
+ The existing code was actually calculating the correlation and
+ not convolution. They are the same for symmetric kernels which
+ may be why this was not recognized until now.
+
+ Basic/Primitive/primitive.pd | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 731e6d5b82548366fc819680e5c0930239586359
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Dec 19 16:46:51 2009 -0500
+
+ Update version to 2.4.5_005 for development
+
+ This is the final "fix" cycle with PDL before a minor
+ bug fix release of PDL-2.4.6 to CPAN with the little fixes
+ since 2.4.5.
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit a2da5ac4c70c66abd7d5205481256ff2aeb98c94
+Merge: 2df55ef 319c72b
+Author: David Mertens <david at david-desktop.(none)>
+Date: Mon Dec 14 12:56:45 2009 -0600
+
+ Merge branch 'master' of git://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit d0bd1af56add57a397e3dd16019bcc3d59dedbc9
+Merge: 9fb93f8 319c72b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Dec 11 10:07:39 2009 -0500
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 319c72b5fab7a36284a89f5794c06348950457cc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Dec 10 22:33:18 2009 -0500
+
+ Make Padre subdir for integration work
+
+ This is a scratch directory for work integrating PDL with Padre.
+ The first file is NiceSlice.pm which is a Devel::REPL::Plugin
+ support perldlpp NiceSlice preprocessing for Devel::REPL.
+ Work continues to implement the rest of existing perldl
+ functionality.
+
+ Padre/NiceSlice.pm | 27 +++++++++++++++++++++++++++
+ Padre/README | 7 +++++++
+ 2 files changed, 34 insertions(+), 0 deletions(-)
+
+commit 9fb93f8980aecc9abf5b6ddf4ace8c6a3fe126b9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 9 17:17:31 2009 -0500
+
+ Update MANIFEST with debian/ changes
+
+ I don't know why "make manifest" did not remove the irrelevant
+ entries.
+
+ MANIFEST | 11 ++++++-----
+ 1 files changed, 6 insertions(+), 5 deletions(-)
+
+commit e2fac04d1352ef034230904dbc08c1fcd9ed6269
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 9 16:44:04 2009 -0500
+
+ Update Known_Problems and TODO for release
+
+ Known_problems | 3 +++
+ TODO | 4 +++-
+ 2 files changed, 6 insertions(+), 1 deletions(-)
+
+commit ed079eddc13d9d82e78d36eea453706f313702b0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 9 16:37:54 2009 -0500
+
+ Update OpenGL version required info
+
+ DEPENDENCIES | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit ea2ea7b7efc162c5535904c4300befa8149337a6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 9 16:36:03 2009 -0500
+
+ Set POGL_VERSION in perldl.conf to 0.61 for CPAN
+
+ CPAN dependencies don't support developers releases so I've
+ added a comment what the unofficial version required is and
+ the official required dependency that CPAN will use is below.
+
+ perldl.conf | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit a85bf7885514fcf17b355746a0bfc8ae4d9fcd2c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 9 16:31:00 2009 -0500
+
+ Update Release_Notes for CPAN 2.4.5_004 release
+
+ Release_Notes | 5 +++++
+ 1 files changed, 5 insertions(+), 0 deletions(-)
+
+commit 2e79ab76b123990c39114182525e65e0f5a0ad41
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 9 16:29:41 2009 -0500
+
+ Update to v3.14 of ppport.h portability
+
+ Basic/Core/ppport.h | 3888 ++++++++++++++++++++++++++++++++++++++++++++++++---
+ 1 files changed, 3731 insertions(+), 157 deletions(-)
+
+commit affe0cc052580600bfc5bd93245fd0d14a9de6a2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Dec 9 16:27:28 2009 -0500
+
+ Permissions cleanup
+
+ 0 files changed, 0 insertions(+), 0 deletions(-)
+
+commit 80688088d54ab8128069b05a701412e59c150bd3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 22 14:03:12 2009 -0500
+
+ Fix OpenGLQ headers for AGL GLUT only build
+
+ This permits a completely non-X11 Apple GLUT TriD to build.
+ Also updated POGL_VERSION => 0.61_002 as a reminder that this
+ prerequisite information will need to be updated for releases.
+
+ Graphics/TriD/OpenGLQ/openglq.pd | 5 +++++
+ perldl.conf | 2 +-
+ 2 files changed, 6 insertions(+), 1 deletions(-)
+
+commit 27d2b07aa500cb5b046991905e0267b3ced9d4a7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Nov 20 13:45:24 2009 -0500
+
+ Update Release_Notes for 2.4.5_004
+
+ Release_Notes | 30 ++++++++++++++++++++++++++++++
+ 1 files changed, 30 insertions(+), 0 deletions(-)
+
+commit dd951a75bf8c7edeaae8d0ff39ddbc02340734a0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Nov 20 13:34:35 2009 -0500
+
+ Set VERSION to 2.4.5_004 for development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit e4ed469076e1a12a1cc2f4343223af3b7ac67282
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Nov 20 13:33:14 2009 -0500
+
+ Make Perl OpenGL 0.61 the minimum version
+
+ OpenGL-0.61 has a needed fix to some FreeGLUT parameters that
+ are required for correct event loop exit handling.
+
+ perldl.conf | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f3a4409d982957a9863f5aa8d9f6f9d9ed515f4a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Nov 20 13:31:45 2009 -0500
+
+ Fix bug with _have_freeglut check
+
+ The new() method was using $OpenGL::_have_freeglut to test
+ rather than the correct OpenGL::_have_freeglut().
+
+ Graphics/TriD/POGL/OpenGL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2a2ab08ea995bcbdcccdd3ac7eedba56c17df376
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon Nov 9 13:38:13 2009 +0100
+
+ add list of symlinks to create in debian package
+
+ debian/pdl.links | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit 12371263640afb8724c87703aa6018842bcdba82
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon Nov 9 13:37:00 2009 +0100
+
+ import changelog from latest debian upload
+
+ debian/changelog | 11 +++++++++++
+ 1 files changed, 11 insertions(+), 0 deletions(-)
+
+commit 7e18a6cb47478d93613e7f56ed4511a03396fb8b
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon Nov 9 13:36:16 2009 +0100
+
+ debian: switch to freeglut window type
+
+ debian/perldl.conf | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 66616037c82bbee4990d7e1d0ff5f552563fd28b
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon Nov 9 13:35:57 2009 +0100
+
+ link against -lgfortran
+
+ debian/f77conf.pl | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit fc2e63b1447d58bf91387133ac41dbf144802416
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon Nov 9 13:35:17 2009 +0100
+
+ build-depend and suggest ExtUtils::F77
+
+ debian/control | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit d3d8e443cac5446894f7ad0c964cfef092a2fa28
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon Nov 9 13:34:41 2009 +0100
+
+ debian: run testsuite in verbose mode
+
+ debian/rules | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2f0ff44a70ff363309a2792f699099c6e054cff0
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon Nov 9 13:22:13 2009 +0100
+
+ report exact slatec load error in verbose mode
+
+ t/limits_00.t | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 3baf3788b33ea3caf2071709f37d66081e4df5cf
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon Nov 9 13:20:49 2009 +0100
+
+ tell if the test was actually skipped
+
+ confusingly, the minuit test was giving 'ok' in case of minuit
+ load errors
+
+ t/minuit.t | 7 ++++---
+ 1 files changed, 4 insertions(+), 3 deletions(-)
+
+commit 2a675f60de5407819f01be178652ccf32a2fd549
+Author: Henning Glawe <glaweh at debian.org>
+Date: Mon Nov 9 13:18:40 2009 +0100
+
+ tell if the test was actually skipped
+
+ confusingly, the slatec test was giving 'ok' in case of slatec
+ load errors
+
+ t/slatec.t | 34 +++++++++++-----------------------
+ 1 files changed, 11 insertions(+), 23 deletions(-)
+
+commit 133a3b714bc981d0f1c60f6fb33973e3c3477a86
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 10:20:17 2009 +0100
+
+ import changelog from debian upload
+
+ debian/changelog | 14 ++++++++++++++
+ 1 files changed, 14 insertions(+), 0 deletions(-)
+
+commit 1a90f28b6585720ba6d177ca374f9d94373eec81
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 10:18:05 2009 +0100
+
+ clean also .inlinepdlpp
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 40410cc6502f48362b7633a4600d2c9b15d7615e
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 10:16:51 2009 +0100
+
+ properly clean minuit
+
+ the library was still there after clean
+
+ Lib/Minuit/Makefile.PL | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 6934ed3a1db64839424a11478a6547463df6fa8a
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 10:06:13 2009 +0100
+
+ move installtime-generated docs to /var/lib/pdl
+
+ debian/pdl.dirs | 1 +
+ debian/pdl.doc-base | 4 ++--
+ debian/pdl.lintian-overrides | 4 ++--
+ debian/pdl.postinst | 6 ++----
+ debian/pdl.prerm | 4 ++--
+ 5 files changed, 9 insertions(+), 10 deletions(-)
+
+commit 779f59ec1b564577d390cee482e16a0e785b5f3a
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 09:56:30 2009 +0100
+
+ do not scan Index.pod
+
+ this is actually the result of the scan, so...
+
+ Doc/Doc.pm | 5 +++--
+ 1 files changed, 3 insertions(+), 2 deletions(-)
+
+commit fc9a1cf00c9711dafae4501ad6e4becba15ef64b
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 09:55:20 2009 +0100
+
+ add 3rd argument to scantree: index location
+
+ Doc/scantree.pl | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit 748386e840b7ec22e65c17788c8dfb9acc4e41bd
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 09:51:01 2009 +0100
+
+ use debhelper for lintian override handling
+
+ debian/rules | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2329f5e6a85faa2e7e1da58e7f3b4e9834df3ddf
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 09:49:48 2009 +0100
+
+ use dh_prep instead of dh_clean -k
+
+ recommended by newer debhelper versions
+
+ debian/rules | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 9b2ffcbc1df014113d90c66690967407d42de120
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 09:48:50 2009 +0100
+
+ debian configure rule should depend on patch-stamp
+
+ debian/rules | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 4fd6df440fa04b5d67bfd7792415e7985b0edc5f
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 09:45:57 2009 +0100
+
+ remove useless postrm script
+
+ debian/postrm | 38 --------------------------------------
+ 1 files changed, 0 insertions(+), 38 deletions(-)
+
+commit 35f25ec3df9669f235eb80cd22a28a3a36708d02
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 09:44:01 2009 +0100
+
+ move package infrastructure into pdl pkg namespace
+
+ debian/dirs | 2 --
+ debian/docs | 5 -----
+ debian/pdl.dirs | 2 ++
+ debian/pdl.docs | 5 +++++
+ debian/pdl.postinst | 46 ++++++++++++++++++++++++++++++++++++++++++++++
+ debian/pdl.prerm | 40 ++++++++++++++++++++++++++++++++++++++++
+ debian/postinst | 46 ----------------------------------------------
+ debian/prerm | 40 ----------------------------------------
+ 8 files changed, 93 insertions(+), 93 deletions(-)
+
+commit b30ef1738ddca8a58f25724602076f0110fe89f1
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 09:41:08 2009 +0100
+
+ update build-depends, bump debhelper/standard
+
+ debian/compat | 2 +-
+ debian/control | 7 +++----
+ 2 files changed, 4 insertions(+), 5 deletions(-)
+
+commit 26bb75208338df325f97118d4eb1d3a6c92257df
+Author: Henning Glawe <glaweh at debian.org>
+Date: Sat Nov 7 09:37:28 2009 +0100
+
+ add readme about the debian source and patches
+
+ debian/README.source | 14 ++++++++++++++
+ 1 files changed, 14 insertions(+), 0 deletions(-)
+
+commit 9e1ea2b80604d429be8276396e016bd74e6cf0c0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 1 11:47:58 2009 -0500
+
+ Update to version 2.4.5_003 for developers release
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 35dd416bd603f21b40c6caf99d368d07ca0e9ef6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sun Nov 1 10:12:22 2009 -0500
+
+ Fix OpenGLQ/Makefile.PL use/require problem
+
+ Had require but with use statement syntax.
+
+ Graphics/TriD/OpenGLQ/Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 300fae29802d2b8a8c3f42808105bf4ae8dc3b8f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 30 19:03:15 2009 -0400
+
+ Update version to 2.4.5_002 to test fix
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 33f84778832582823f8ca054a94b3cb7a14a76dc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 30 19:01:13 2009 -0400
+
+ Fix some TriD OpenGL config and test bugs
+
+ This should help with CPAN automated testers.
+
+ Graphics/TriD/OpenGL/opengl.pd | 2 +-
+ Graphics/TriD/OpenGLQ/Makefile.PL | 6 ++++--
+ t/opengl.t | 2 +-
+ 3 files changed, 6 insertions(+), 4 deletions(-)
+
+commit 29dcd99a806f477bf4f495a5a0e13367c3004889
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 30 14:07:00 2009 -0400
+
+ Removed automated testing USE_POGL=>1 setting
+
+ This and the hardwired 1 in the perldl.conf may have been
+ the origin of a lack of CPAN automated testers reports.
+ It may not have been but this release should check it.
+
+ Makefile.PL | 6 ++----
+ 1 files changed, 2 insertions(+), 4 deletions(-)
+
+commit 032321eadae4a09ad358947960f3d9113e530ec8
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 30 13:28:49 2009 -0400
+
+ Fix perldl.conf to set USE_POGL => undef
+
+ I think this may resolve some of the not appearing test
+ results from CPAN. If this works, then it will be the
+ basis for a PDL-2.4.6 release. Maybe 2.4.61?
+
+ perldl.conf | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 09b657b4b71326fb0c55dbaf056af9ba806fa175
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Oct 24 13:26:54 2009 -0400
+
+ Update VERSION to 2.4.5_001 for development
+
+ The official PDL-2.4.5 release is now available on CPAN and at the
+ PDL sf.net downloads page. The git master branch goes back to
+ development versioning starting with 2.4.5_001. Happy coding!
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit c62a322b1c8648fc0c6c7a7bbcade6bc1b2350ab
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Sat Oct 24 11:56:23 2009 -0400
+
+ Update MANIFEST for PDL-2.4.5 release
+
+ MANIFEST | 5 -----
+ 1 files changed, 0 insertions(+), 5 deletions(-)
+
+commit 55a321ba41a056e1b29bcc606e4080b0fbee7b9b
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sat Oct 24 09:21:55 2009 +1100
+
+ Update win32/INSTALL
+
+ Installation procedures for win32 updated
+
+ win32/INSTALL | 150 +++++++++++++++++++++++++++++++++++++++------------------
+ 1 files changed, 103 insertions(+), 47 deletions(-)
+
+commit 9d75cfa8e32646c47e569e169afaec3a2118d873
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Sat Oct 24 08:46:45 2009 +1100
+
+ Remove obsolete files from win32 folder
+
+ Readme, PDL.ppd, pbmwin32.tar.gz, makeppm.pl,
+ and install.ppm removed from win32 folder.
+
+ win32/PDL.ppd | 12 ----------
+ win32/Readme | 40 ------------------------------------
+ win32/install.ppm | 54 -------------------------------------------------
+ win32/makeppm.pl | 20 ------------------
+ win32/pbmwin32.tar.gz | Bin 258002 -> 0 bytes
+ 5 files changed, 0 insertions(+), 126 deletions(-)
+
+commit 4362c1c77d80d78f51cd37f93ec5e13f2969f32b
+Author: Henning Glawe <glaweh at debian.org>
+Date: Fri Oct 23 16:03:56 2009 +0200
+
+ switch TriD window mode to x11 in debian package
+
+ debian/perldl.conf | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit af381813d13be2e7d6112cde4a371f97fb6450df
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 23 09:24:03 2009 -0400
+
+ Update Known_problems with x64 OpenGL issue
+
+ Known_problems | 10 ++++++++++
+ 1 files changed, 10 insertions(+), 0 deletions(-)
+
+commit 308bdc9dd45a7e12f855b2f3f8bb24199354ccd5
+Author: Henning Glawe <glaweh at debian.org>
+Date: Fri Oct 23 11:43:16 2009 +0200
+
+ remove full path from perl calls in debian/postinst
+
+ debian/postinst | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 6ea299c944e856c6727331797294fd9a4db469c2
+Author: Henning Glawe <glaweh at debian.org>
+Date: Fri Oct 23 11:41:17 2009 +0200
+
+ removed empty debian/preinst script
+
+ debian/preinst | 38 --------------------------------------
+ 1 files changed, 0 insertions(+), 38 deletions(-)
+
+commit bd209c53d51fde9b0a73463657083518b2a6f4bc
+Merge: da9b755 6b71df5
+Author: Henning Glawe <glaweh at debian.org>
+Date: Fri Oct 23 10:57:18 2009 +0200
+
+ Merge branch 'master' of ssh://eartoaster@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit da9b7557bcebc42332c6ade81c7be6fb49591faf
+Author: Henning Glawe <glaweh at debian.org>
+Date: Fri Oct 23 10:55:37 2009 +0200
+
+ fix some POD syntax errors found by lintian
+
+ Basic/Core/Dev.pm | 4 +++-
+ Doc/Doc/Perldl.pm | 3 ---
+ Graphics/PGPLOT/Window/Window.pm | 4 ++--
+ Lib/FFT/fft.pd | 3 ---
+ 4 files changed, 5 insertions(+), 9 deletions(-)
+
+commit 6b71df53ea2e10fbcef1372f6df344df948e6158
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Oct 22 17:29:09 2009 -0400
+
+ Clean up POD for Graphics/TriD/TriD.pm
+
+ Graphics/TriD/TriD.pm | 59 +++++++++++++++++++++++++------------------------
+ 1 files changed, 30 insertions(+), 29 deletions(-)
+
+commit d3ac9a74b727c80f02b3b714eac779580ee36f42
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Oct 22 16:57:20 2009 -0400
+
+ Update Known_problems re Mac OS X TriD font issue
+
+ Known_problems | 7 +++++++
+ 1 files changed, 7 insertions(+), 0 deletions(-)
+
+commit eed356c09baf69dfe6ae35d1227a1342811c9734
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu Oct 22 17:13:04 2009 +0200
+
+ fix typo in minuit Makefile.PL
+
+ Lib/Minuit/Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 36f11d3ab315e5245fed2d1a20c1a15e91e5453e
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu Oct 22 16:59:12 2009 +0200
+
+ import debian packaging info up to 2.4.3-8
+
+ debian/changelog | 25 +++++++++++++++++++++++--
+ debian/control | 7 ++++---
+ debian/pdl.doc-base | 3 +--
+ debian/pdl.remove | 1 +
+ 4 files changed, 29 insertions(+), 7 deletions(-)
+
+commit 58e0e5e16986f5d30bd7794935f420e8ce808a04
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu Oct 22 15:29:15 2009 +0200
+
+ merge new lib options into debian perldl.conf
+
+ debian/perldl.conf | 23 ++++++++++++++++++++++-
+ 1 files changed, 22 insertions(+), 1 deletions(-)
+
+commit 2b62a2a0055104fbb4df682d36d1b9def1a4497e
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu Oct 22 15:25:42 2009 +0200
+
+ import trid/perl-opengl config
+
+ debian/perldl.conf | 11 +++++++++++
+ 1 files changed, 11 insertions(+), 0 deletions(-)
+
+commit 05a265877561abded2766f3b333a59c2f8b7c12d
+Author: Henning Glawe <glaweh at debian.org>
+Date: Thu Oct 22 15:18:19 2009 +0200
+
+ apply whitespace and comment typo changes
+
+ first step of updating debian/perldl.conf
+
+ debian/perldl.conf | 71 ++++++++++++++++++++++++++-------------------------
+ 1 files changed, 36 insertions(+), 35 deletions(-)
+
+commit 82933b9d2707e2dfd59f8c4d6dc02fc5493d22c4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 21 17:59:19 2009 -0400
+
+ Remove bitfont.c from MANIFEST
+
+ MANIFEST | 1 -
+ 1 files changed, 0 insertions(+), 1 deletions(-)
+
+commit 018c1aef44668f8708cebcd6a4ae41b06dd2dc59
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 21 10:12:23 2009 -0400
+
+ Finished PDL-2.4.5 release notes/announcement
+
+ Announce | 157 --------------------------------------------------------
+ Known_problems | 5 ++
+ Release_Notes | 92 ++++++++++++++++++++++++++-------
+ 3 files changed, 77 insertions(+), 177 deletions(-)
+
+commit 03a62ede2ffa851f8015f69846646f7029a9903d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 20 16:14:46 2009 -0400
+
+ Add draft Announce file as working copy
+
+ This is a temporary document only. It will be replaced
+ by the announcements and official release notes when complete.
+
+ Announce | 157 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 157 insertions(+), 0 deletions(-)
+
+commit adaf22b79107a75c30cf7c44e7e8c61f94ff0a96
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 19 16:34:31 2009 -0400
+
+ Add support for USE_POGL => undef to perldl.conf
+
+ NOTE: unless WITH_3D is set to zero, it is possible that
+ TriD will still be built with the legacy build structure
+ even though it will not be using the Perl OpenGL module for
+ the needed graphics bindings.
+
+ Makefile.PL | 26 +++++++++++++++++++-------
+ 1 files changed, 19 insertions(+), 7 deletions(-)
+
+commit 46b4f7d3d4bbfdc80890f318fd650b9517f0c236
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 19 10:57:40 2009 -0400
+
+ Update cygwin README, INSTALL for 2.4.5 release
+
+ cygwin/INSTALL | 50 +++++++++-----------------------------------------
+ cygwin/README | 10 +++++-----
+ 2 files changed, 14 insertions(+), 46 deletions(-)
+
+commit 580195bab6f3c8840fcf72845188633f79b51387
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 19 10:50:51 2009 -0400
+
+ Update readmes and config for PDL-2.4.5 release
+
+ Now requires OpenGL-0.60 or greater. If you need to
+ build with a different version, edit perldl.conf
+ appropriately. Versions 0.59_00x should work for
+ most platforms.
+
+ Basic/PDL.pm | 2 +-
+ INSTALL | 2 +-
+ Known_problems | 24 +++++++---
+ README | 9 +++-
+ Release_Notes | 65 ++++++++++++++++++++++++++++
+ bitfont.c | 130 --------------------------------------------------------
+ perldl.conf | 2 +-
+ 7 files changed, 91 insertions(+), 143 deletions(-)
+
+commit 1c679ad9a22c82758a2f304d6a77bb93f020974f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 19 09:59:06 2009 -0400
+
+ Clarify test skip messages for HDF/NDF
+
+ t/hdf_sd.t | 2 +-
+ t/hdf_vdata.t | 2 +-
+ t/hdf_vgroup.t | 2 +-
+ t/ndf.t | 2 +-
+ 4 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 602024e37fdf4ddadda3742ef3d3035c9a875e80
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 16 17:44:25 2009 -0400
+
+ Update Known_problems with latest fix info
+
+ Known_problems | 13 ++++++++++---
+ 1 files changed, 10 insertions(+), 3 deletions(-)
+
+commit e169bc6f15ea218c98c5af978fd157564826113e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 16 16:58:23 2009 -0400
+
+ Add FAQ entry on clean installs
+
+ This addresses the question/bug/feature request from SF bug #1476324
+
+ Basic/Pod/FAQ.pod | 63 +++++++++++++++++++++++++++++-----------------------
+ 1 files changed, 35 insertions(+), 28 deletions(-)
+
+commit 142065238c0ad8fb0522fdd454c9071fbfb88d80
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 16 16:16:11 2009 -0400
+
+ Fix qsorti(null()) crash bug (SF #2110074)
+
+ Make qsorti() return quietly when given a null() piddle input
+
+ Basic/PDL.pm | 2 +-
+ Basic/Ufunc/ufunc.pd | 2 ++
+ t/ufunc.t | 6 +++++-
+ 3 files changed, 8 insertions(+), 2 deletions(-)
+
+commit 91f56f01580fca19b7baf0c2969b2e331ab759e4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Oct 15 11:19:42 2009 -0400
+
+ Update readme's, VERSION, and manifest for CPAN
+
+ This is likely to be the final PDL developers release
+ before the official PDL-2.4.5
+
+ Basic/PDL.pm | 2 +-
+ DEPENDENCIES | 2 +-
+ DEVELOPMENT | 2 +-
+ Known_problems | 62 +++++++++++++++++--------------------------------------
+ MANIFEST | 1 +
+ Release_Notes | 55 +++++++++++++++++++++++++++++++++++++++++++++++++
+ 6 files changed, 78 insertions(+), 46 deletions(-)
+
+commit 8acbc61f5166537c8040b6e73c2a26a042bbdc0b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Oct 15 10:21:21 2009 -0400
+
+ Turn off TriD debugging output for release
+
+ Now that the TriD code seems to be working, I'm turning
+ off the verbose diagnostics in preparation for the PDL-2.4.5
+ release.
+
+ 3dtest.pl | 6 +++---
+ Graphics/TriD/POGL/OpenGL.pm | 4 +---
+ Graphics/TriD/TriD/GL.pm | 14 ++++++++------
+ Graphics/TriD/TriD/SimpleScaler.pm | 2 +-
+ line3d.pl | 4 ++--
+ 5 files changed, 15 insertions(+), 15 deletions(-)
+
+commit 0c12b4208905787275c8970253e28c07b7b2de1b
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 14 18:24:00 2009 -0400
+
+ Adding a GLUT font example code for debugging
+
+ There have been multiple reports of GLUT failures on
+ linux machines with the symptom being font not found.
+ This is a C program that users can try to build to see
+ if the problem is in the bindings or in their local
+ FreeGLUT install. I plan to move this to utils and
+ put in some sort of build information.
+
+ bitfont.c | 130 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 1 files changed, 130 insertions(+), 0 deletions(-)
+
+commit ea227ea812c094aabadf2e3b413bd85603f946a3
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 14 18:11:45 2009 -0400
+
+ Add Stefan Evert patch to twiddle for Mac OS X
+
+ Apparently calling glutMainLoopEvent() every twiddle loop
+ caused resize events not to be correctly processed on Mac
+ OS X with Apple GLUT (not FreeGLUT). This patch only
+ calls glutMainLoopEvent() if there are no unprocessed
+ events in the fake XEvent queue. This problem and the
+ confusion may eventually go away if we move away from
+ the pseudo-X11 event processing to a native GLUT callback
+ framework.
+
+ Graphics/TriD/TriD/GL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit b1378933cf948006286b533c9ed4a92adcb06cf4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 14 18:09:53 2009 -0400
+
+ Add clean option to IO/Browser/Makefile.PL
+
+ It was leaving Browser.* files behind. Also added those
+ files to .gitignore since they were left out in the original
+ list since PDL::IO::Browser was completely broken. It is
+ not robust but it does compile with cygwin and ncurses.
+
+ .gitignore | 3 +++
+ IO/Browser/Makefile.PL | 3 ++-
+ 2 files changed, 5 insertions(+), 1 deletions(-)
+
+commit 2df55ef32ba5b858841dea766e91b99a033c7e17
+Merge: dd4e079 e93558b
+Author: David Mertens <david at david-desktop.(none)>
+Date: Wed Oct 14 17:06:24 2009 -0500
+
+ Merge branch 'master' of git://pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit dd4e079a8c91d93674f57475d190d9fdf560b21d
+Author: David Mertens <david at david-desktop.(none)>
+Date: Wed Oct 14 17:04:27 2009 -0500
+
+ I've updated FastRaw to allow for arbitrary header files. This is mostly useful for
+ using the same header file for many data sets. I updated the tests accordingly.
+
+ I also poked around with perldl.conf, but I didn't think I had done anything to it.
+
+ IO/FastRaw/FastRaw.pm | 160 ++++++++++++++++++++++++++++++++++++++++++++---
+ perldl.conf | 4 +-
+ t/fastraw.t | 166 ++++++++++++++++++++++++++-----------------------
+ 3 files changed, 241 insertions(+), 89 deletions(-)
+
+commit eaaa13411748ffb30cc42f76373478bbedea0526
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 14 10:14:53 2009 -0400
+
+ Change prompt to perl> if no PDL loaded in perldl
+
+ This will give visual feedback that there is no PDL
+ capabilities if PDL was not loaded. Don't know if
+ will help much but might reduce duration of confusion...
+
+ perldl.PL | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit e93558be16073549cae881e3a428f7ebccb4c009
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Oct 13 11:50:16 2009 -0400
+
+ Add glutPostRedisplay to ConfigNotify
+
+ Graphics/TriD/POGL/OpenGL.pm | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 562383301c7f6ffc429e12b7e223d601bdb62372
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Mon Oct 12 18:31:29 2009 -0400
+
+ Another undef fix for display() as sub
+
+ Graphics/TriD/POGL/OpenGL.pm | 4 +++-
+ 1 files changed, 3 insertions(+), 1 deletions(-)
+
+commit 31fc6e615b8f2c88d0c7c9b45b3b858f63c8f397
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Mon Oct 12 18:23:35 2009 -0400
+
+ Fix problem with undefined window object
+
+ Graphics/TriD/POGL/OpenGL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f3d4332165c074757eb2e7ea2b0ac70b3cd2a3ee
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Mon Oct 12 18:17:44 2009 -0400
+
+ Make sub version of display() for GLUT callbacks
+
+ See if this resolves the blank image problems for Mac GLUT
+ systems.
+
+ Basic/PDL.pm | 2 +-
+ Graphics/TriD/POGL/OpenGL.pm | 125 ++++++++++++++++++++++--------------------
+ Graphics/TriD/TriD/GL.pm | 5 ++
+ 3 files changed, 72 insertions(+), 60 deletions(-)
+
+commit b601580cfb768c9c28aa7d3a55d2f1068d1adf8b
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sat Oct 10 17:53:03 2009 -0400
+
+ POGL_WINDOW_TYPE now sets OpenGL window type
+
+ If you have the the needed X11 bindings
+ in your POGL then you can use the
+ $PDL::Config{POGL_WINDOW_TYPE} to select
+ which flavor of OpenGL window is created.
+
+ The X11 interface has been preserved to
+ enable the use of PDL::Graphics::TriD::Tk
+ which provides a Tk widget interface to
+ PDL::Graphics::TriD. The existing widget
+ implementation only works for X11.
+
+ It appears that Gtk+ may actually have a
+ supported OpenGL widget which might make
+ better sense for a full featured widget set
+ to support.
+
+ Graphics/TriD/POGL/OpenGL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f0733514160bd0050ae50969297eaf87a015bbd3
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sat Oct 10 14:45:29 2009 -0400
+
+ Update POGL_VERSION to 0.59
+
+ perldl.conf | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3e0f2427a4751d1dec3f05e5b87b05105e2dd113
+Author: sisyphus <sisyphus1 at optusnet.com.au>
+Date: Thu Oct 8 16:39:00 2009 +1100
+
+ Remove 'D:/gd/gdwin32/include' from @inc_locations in IO/GD/Makefile.PL
+
+ Was a nuisance on Win32 boxes where 'D:' is the CD drive.
+ (Having gd in that location is very rare, anyway.)
+
+ IO/GD/Makefile.PL | 1 -
+ 1 files changed, 0 insertions(+), 1 deletions(-)
+
+commit 6dd6bb86661c1a84f391900148047adfdd28c36c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 7 17:45:43 2009 -0400
+
+ Add browse.exe to clean for PDL::IO::Browser
+
+ IO/Browser/Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 6ded129679883ead13525027aca72a91630e0b72
+Merge: 246324f b5243ae
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 7 17:35:09 2009 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 246324f72396ca27e48262c7d053a01a5de56f4d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 7 17:19:56 2009 -0400
+
+ Update Known_problems file for 1button mouse
+
+ Known_problems | 6 ++++++
+ 1 files changed, 6 insertions(+), 0 deletions(-)
+
+commit d2d5c4eb16fe2dca8e7fb1ecfc000b71a0f062a2
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Oct 7 17:16:33 2009 -0400
+
+ Partial fix to PDL::IO::Browser
+
+ Only tested with cygwin/XP. The Makefile.PL logic to determine
+ if curses/ncurses are present and to use them needs to be verified
+ and extended to support win32 (e.g. if PDcurses is installed).
+
+ There appears to be functionality relating to setting values in
+ the piddle being viewed. This needs to be cleaned up and
+ documented. As is, it can get pretty confusing. Also need
+ to add redraw (via Ctrl-L), and Page Up, Page Down, etc.
+
+ IO/Browser/browse.c | 47 +++++++++++++++++++++++++++++++++++++----------
+ 1 files changed, 37 insertions(+), 10 deletions(-)
+
+commit b5243ae84ca25c84442c484ada3d7f81107bb547
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Wed Oct 7 20:25:59 2009 +1100
+
+ Remove 'D:/gd/gdwin32' from @lib_locations in IO/GD/Makefile.PL
+
+ Was a nuisance on Win32 boxes where 'D:' is the CD drive.
+ (Having gd in that location is very rare, anyway.)
+
+ IO/GD/Makefile.PL | 1 -
+ 1 files changed, 0 insertions(+), 1 deletions(-)
+
+commit fb422be56311b42457b4e6374cc3b587fa19233e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 5 17:13:15 2009 -0400
+
+ Add POGL_WINDOW_TYPE parameter to perldl.conf
+
+ perldl.conf | 78 ++++++++++++++++++++++++++++++----------------------------
+ 1 files changed, 40 insertions(+), 38 deletions(-)
+
+commit b1b22628daf752b2f6654105398975a6c9e7786d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 5 17:08:50 2009 -0400
+
+ Add some MinGW cruft to .gitignore
+
+ .gitignore | 6 ++++++
+ 1 files changed, 6 insertions(+), 0 deletions(-)
+
+commit 438a342222485708caf09ea869d14a14e5312314
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 5 15:27:10 2009 -0400
+
+ Update $PDL::VERSION and POGL_VERSION
+
+ Prepare to push this to sf.net PDL git for wider spread testing.
+
+ Basic/PDL.pm | 2 +-
+ perldl.conf | 2 +-
+ 2 files changed, 2 insertions(+), 2 deletions(-)
+
+commit f0ae54dd912715686e1721b153cefde8d74a8af0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 5 15:06:03 2009 -0400
+
+ Add $PDL::Config{POGL_VERSION} to the CPAN prereqs
+
+ I don't know if this will work for CPAN installs and
+ indexing. It depends on how things are done.
+
+ Makefile.PL | 3 ++-
+ 1 files changed, 2 insertions(+), 1 deletions(-)
+
+commit a26515d622d7d7e9c3a87d8e6c4c964bb3319757
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Oct 5 14:59:51 2009 -0400
+
+ Use POGL_VERSION in perdl.conf to use OpenGL
+
+ This allows the value of POGL_VERSION to set the requirements
+ for the minimum OpenGL version to support PDL+POGL TriD. It
+ also reduces the amount of hand editing required when the
+ prerequisites change.
+
+ Graphics/TriD/OpenGLQ/Makefile.PL | 2 +-
+ Graphics/TriD/POGL/OpenGL.pm | 7 ++++++-
+ Graphics/TriD/TriD/GL.pm | 11 +++++++----
+ Graphics/TriD/TriD/GoBoard.pm | 3 ++-
+ Graphics/TriD/TriD/GraphBox.pm | 3 ++-
+ Graphics/TriD/TriD/Labels.pm | 3 ++-
+ Graphics/TriD/TriD/Lines.pm | 3 ++-
+ Graphics/TriD/TriD/MathGraph.pm | 3 ++-
+ Graphics/TriD/TriD/Mesh.pm | 3 ++-
+ Graphics/TriD/TriD/OOGL.pm | 6 +++++-
+ Graphics/TriD/TriD/Surface.pm | 3 ++-
+ Graphics/TriD/TriD/Tk.pm | 3 ++-
+ Makefile.PL | 4 ++--
+ 13 files changed, 37 insertions(+), 17 deletions(-)
+
+commit bb9f00e4743ce8cc9d9e051eb5738d96707d5d6f
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Oct 4 23:22:16 2009 -0400
+
+ Add some default consistency check to display()
+
+ Just in case the routine is called with an inconsistent
+ object, print out a warning message.
+
+ Graphics/TriD/TriD/GL.pm | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit e6919d27f87860f711d73c2200bcea9a35ab9812
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Oct 4 22:51:44 2009 -0400
+
+ Update PDL version for develop reference
+
+ Trying to keep Basic/PDL.pm VERSION and Graphics/TriD/POGL/OpenGL.pm
+ VERSION values incrementing so we can tell things apart in problem
+ reports.
+
+ Basic/PDL.pm | 2 +-
+ Graphics/TriD/POGL/OpenGL.pm | 6 +++---
+ 2 files changed, 4 insertions(+), 4 deletions(-)
+
+commit 2d30a0c20f4aa9acdf1e2de0d44479daf3c09c9a
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Oct 4 22:36:14 2009 -0400
+
+ Return original verbose flag control on EH: output
+
+ Graphics/TriD/TriD/GL.pm | 3 +--
+ 1 files changed, 1 insertions(+), 2 deletions(-)
+
+commit ef98ad783c62b5bc31646da62cf82c8e1518892b
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Oct 4 21:48:43 2009 -0400
+
+ Add GLUT init stuff to new for cleaner exits
+
+ Graphics/TriD/POGL/OpenGL.pm | 7 +++++--
+ 1 files changed, 5 insertions(+), 2 deletions(-)
+
+commit 88658a16daeb690363f3229bb6d79380ab0a8498
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Oct 4 21:15:49 2009 -0400
+
+ Fix problem with extra glClear() calls
+
+ This resulted in blank displays on systems with acceleration,
+ particularly ones without X11 at all. The origin of the problem
+ appears to the the fact that the display() routine being called
+ by the TriD graphics is not callable as a subroutine which is
+ what glutDisplayFunc() actually needs. This partial fix to
+ display just returns immediately if called with no arguments.
+ It is hoped that a more complete solution to the problem can
+ wait for a more thorough refactoring to use GLUT functionality
+ directly rather than mimic the X11 interface.
+
+ Graphics/TriD/TriD/GL.pm | 6 +++++-
+ 1 files changed, 5 insertions(+), 1 deletions(-)
+
+commit c86a563c1d2d754f149013554fd30e02c70349cb
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Oct 4 12:37:46 2009 -0400
+
+ Add PDL_INT check for t/opengl.t
+
+ If PDL_INT is set then the GUI tests will be run. This allows
+ systems without X11 installed to enable the live display tests.
+
+ t/opengl.t | 36 +++++++++++++++---------------------
+ 1 files changed, 15 insertions(+), 21 deletions(-)
+
+commit aadda99de64a01222cf395587cf3132dfa1448f8
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Oct 4 11:52:14 2009 -0400
+
+ Fix t/flexraw.t to skip compress tests on MSWin32
+
+ The current t/flexraw.t has a test for the compress code in
+ readflex but does not check that it can actually has compress
+ or gzip with which to create the test data file. This adds
+ a check for MSWin32 to skip the test if needed.
+
+ t/flexraw.t | 60 ++++++++++++++++++++++++++++++++--------------------------
+ 1 files changed, 33 insertions(+), 27 deletions(-)
+
+commit ba049f7b779d792f40a64d272a68517df7200037
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Oct 4 10:14:56 2009 -0400
+
+ Fix default TriD device to GL
+
+ With the new PDL+POGL TriD, GL works everywhere. Still need to
+ fix the VRML output driver so we can do cool stuff with web browsers...
+
+ Graphics/TriD/TriD.pm | 15 ++++++++-------
+ 1 files changed, 8 insertions(+), 7 deletions(-)
+
+commit e9ca29dac2228f5237ef7e4ade2f2afdae933da1
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Oct 4 09:12:17 2009 -0400
+
+ Put Filter::Util::Call in DEPENDENCIES
+
+ The distribution is Filter, the module is Filter::Util::Call
+ I hope using the exact module will be clearer here.
+
+ Basic/PDL.pm | 2 +-
+ DEPENDENCIES | 2 +-
+ 2 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 4ffdeb3943938bc46e2ad0865469d980e74f95d5
+Author: C.Soeller <c.soeller _at_ auckland_dot_ ac _dot_ nz>
+Date: Sun Oct 4 11:13:21 2009 +1300
+
+ Change PP typemap finding code again, ensure Makefile.PL honours USE_POGL setting
+
+ The new PP typemap finding logic was broken. Realised this on OS X after upgrading MakeMaker, which installs the new MakeMaker in an update directory. There is no 'typemap' file in that update dir, BOOM... PP falls flat on its face. The latest attempt is based on what I found in MM_Unix.pm, although way less general in terms of checking for special cases. If this does not work portably, we should consult a site like Perl Monks or similar and split this code out.
+
+ The Open_GL test in toplevel Makefile.PL did not honour the USE_POGL config setting. I thought it should.
+
+ Basic/Gen/PP.pm | 26 ++++++++------------------
+ Makefile.PL | 10 ++++++----
+ 2 files changed, 14 insertions(+), 22 deletions(-)
+
+commit a89aab943aa9929acf66fe6b9833fc6a023e6165
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sat Oct 3 13:13:14 2009 -0400
+
+ More README/doc cleanups prep for 2.4.5 release
+
+ Basic/Pod/FAQ.pod | 392 ++++++++++++++++++++++++++++-------------------------
+ DEPENDENCIES | 13 +-
+ Known_problems | 53 +++++---
+ Release_Notes | 11 +-
+ cygwin/INSTALL | 2 +-
+ cygwin/README | 10 +-
+ 6 files changed, 262 insertions(+), 219 deletions(-)
+
+commit ac016b5d4fd855724b7fa1e12755181895d7c8f8
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sat Oct 3 11:56:50 2009 -0400
+
+ Update perldl VERSION to 1.351 from 1.35 for CPAN
+
+ No major changes, just some docs tweaked, but this will help
+ people keep track of which PDL release they are using from the
+ interactive shell.
+
+ perldl.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit fad22b96cf566a6639d50a1088861395e7a6980e
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sat Oct 3 10:35:11 2009 -0400
+
+ Change prototype of StructureNotifyMask
+
+ The definition of StructureNotifyMask in Graphics/TriD/POGL/OpenGL.pm
+ was inconsitent with the usage in OpenGL. This makes them the same.
+ Eventually, we need a cleanup pass for these constants rather than
+ overriding them in PDL::Graphics::OpenGL::Perl::OpenGL.
+
+ Basic/PDL.pm | 2 +-
+ Graphics/TriD/POGL/OpenGL.pm | 2 +-
+ 2 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 6641895f72fa1b98dde8359eb49c3ba54478c970
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Fri Oct 2 21:00:13 2009 -0400
+
+ Update MANIFEST and Release_Notes for CPAN
+
+ MANIFEST | 1 +
+ Release_Notes | 5 +++++
+ 2 files changed, 6 insertions(+), 0 deletions(-)
+
+commit 7b52e162bb8408f8df5f84b1902851341d8287f3
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Fri Oct 2 20:56:11 2009 -0400
+
+ VERSION to 2.4.4_13 for a CPAN developers release
+
+ Also updated Known_problems and Release_Notes. The purpose
+ of this releas is to make the latest git available via CPAN
+ for more general testing.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 6 ++++++
+ Release_Notes | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 56 insertions(+), 1 deletions(-)
+
+commit e0cf2d1917bb9482264b883410ebaf97d9007689
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 2 17:57:39 2009 -0400
+
+ Update VERSION to 2.4.4_122 for git push
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f5c68cca0528669a896c9a6054269c87d31c1a90
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 2 17:49:42 2009 -0400
+
+ Add a default glutDisplayFunc()
+
+ This makes no difference on cygwin but maybe it will help with
+ the Mac OS X hang. Also some minor code cleanup in GL.pm
+
+ Graphics/TriD/POGL/OpenGL.pm | 29 +++++++++++++++--------------
+ Graphics/TriD/TriD/GL.pm | 14 ++++++++------
+ 2 files changed, 23 insertions(+), 20 deletions(-)
+
+commit 53fda0cae73727da96e93a438217831b84e69125
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 2 15:40:01 2009 -0400
+
+ Fix error msg in Makefile.PL POGL version check
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit ba70542ff5fd81bab61edbeb3e104ff71cfadab0
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 2 15:29:37 2009 -0400
+
+ Fix typo in perldl.conf for POGL_VERSION
+
+ Was missing a comma!
+
+ perldl.conf | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 1ee68d6bc728c8e1735d62e567117c3554667374
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 2 15:24:32 2009 -0400
+
+ Add POGL_VERSION option to perldl.conf
+
+ This will be used to automate the correct use OpenGL version strings
+ for TriD compatibility with POGL.
+
+ perldl.conf | 3 +++
+ 1 files changed, 3 insertions(+), 0 deletions(-)
+
+commit cedbc8e20495e091e491ddac89cb9d4c43e1c9e6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 2 15:20:08 2009 -0400
+
+ Make OpenGL 0.58_007 the required version
+
+ git releasees pushed to the general repository for
+ testing have their versions incremented and PDL
+ has the associated POGL version updated if needed.
+ It is hoped that this will avoid the problem of
+ failures due to mismatch between PDL+POGL modules
+ being tested.
+
+ Graphics/TriD/OpenGLQ/Makefile.PL | 2 +-
+ Graphics/TriD/POGL/OpenGL.pm | 2 +-
+ Graphics/TriD/TriD/GL.pm | 8 ++++----
+ Graphics/TriD/TriD/GoBoard.pm | 2 +-
+ Graphics/TriD/TriD/GraphBox.pm | 2 +-
+ Graphics/TriD/TriD/Labels.pm | 2 +-
+ Graphics/TriD/TriD/Lines.pm | 2 +-
+ Graphics/TriD/TriD/MathGraph.pm | 2 +-
+ Graphics/TriD/TriD/Mesh.pm | 2 +-
+ Graphics/TriD/TriD/Surface.pm | 2 +-
+ Graphics/TriD/TriD/Tk.pm | 2 +-
+ Makefile.PL | 2 +-
+ Release_Notes | 31 ++++++++++++++++++++++++-------
+ t/opengl.t | 4 ++--
+ 14 files changed, 41 insertions(+), 24 deletions(-)
+
+commit 96eaffbc596fc0764e4fdce913c4caae1ce7ffd9
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 2 13:49:46 2009 -0400
+
+ Change VERSION to 2.4.4_121 for git devel
+
+ Having confusion between git pushes being tested by other
+ users. Will change VERSION numbers to hundreds and increment
+ for each push for testing to PDL git.
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f5185c95f40255ac83e116f33dff972220156aa7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 2 13:48:29 2009 -0400
+
+ Undo "Update version to 2.4.4_12_1 for development"
+
+ This reverts commit 591a9cca7904515e65dc7d36f0a904a12ccb0fbc.
+ Two underscores is not allowed
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 66a117f64eabcabd9316d7471626a6ff9c6fb751
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 2 12:50:39 2009 -0400
+
+ Apply Stefan Evert's Mac OS X patch for PP typmaps
+
+ Still having issues with typemap finding on some
+ platforms. Need to have some cross checks here...
+
+ Basic/Gen/PP.pm | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit 591a9cca7904515e65dc7d36f0a904a12ccb0fbc
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Oct 2 12:48:34 2009 -0400
+
+ Update version to 2.4.4_12_1 for development
+
+ With the rapid releases, we need a unique identifier for
+ each git push to try. See if adding one more digit rather
+ than git works. The plan is to update the last digit for
+ each push to sf.net so there is a version "paper trail"
+ for reference and debugging.
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 12bd6606984e327377ffd7b63c0ac4da66b92ec9
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Thu Oct 1 22:50:17 2009 -0400
+
+ Edit to OpenGL::glutMainLoopEvent POGL/OpenGL.pm
+
+ Fixed an unadorned glutMainLoopEvent() in PDL::Graphics::TriD::POGL/OpenGL.pm
+ by adding explicit OpenGL:: specifier. Don't know if this will help the
+ hang problem seen in Mac OS X testing---but at least is now consistent.
+
+ Graphics/TriD/POGL/OpenGL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 784e320e4d82d6d3ba28a8cbcf879a94e163b9b4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Oct 1 17:05:40 2009 -0400
+
+ Add better error handling for missing X11 fonts
+
+ There was a mysterious failure when the X font used for PDL
+ axis labels did not exist. This adds an eval {} to catch the
+ failure and a diagnostic message that suggests how to fix the
+ problem.
+
+ N.B. The new TriD immplementation with GLUT does not have
+ this problem.
+
+ Graphics/TriD/TriD/GL.pm | 11 +++++++++--
+ 1 files changed, 9 insertions(+), 2 deletions(-)
+
+commit 58d35d3a38db67412b5dd65e8b97c85a01e9fcb4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Oct 1 15:33:47 2009 -0400
+
+ Update README type files for coming releases.
+
+ DEPENDENCIES | 2 +-
+ INSTALL | 2 +-
+ Known_problems | 13 +++----------
+ README | 16 ++++++++--------
+ Release_Notes | 32 ++++++++++++++++++++++++++++++++
+ 5 files changed, 45 insertions(+), 20 deletions(-)
+
+commit a91bd84be17a692a121e50fff77a4871a06bc5fa
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Thu Oct 1 07:30:36 2009 -0400
+
+ Make fake XEvent parameters match existing protos
+
+ This quiets some warning for folk with GLX and X11 but using
+ the GLUT inteface code. Should not affect other platforms.
+
+ Graphics/TriD/POGL/OpenGL.pm | 54 +++++++++++++++++++++---------------------
+ 1 files changed, 27 insertions(+), 27 deletions(-)
+
+commit cce93c61ea25f6c755101c4e9fba3fc53e758968
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Wed Sep 30 20:33:45 2009 -0400
+
+ Add unless OpenGL::done_glutInit to new
+
+ This prevents illegal glutInit() re-initialization attempt.
+ NOTE: this is why a "safe" glutInit() and other GLUT functions
+ are on the TODO list. While it may be ok from C, it is a pain
+ to have the perl process die as a result of calling glutInit()
+ twice.
+
+ Graphics/TriD/POGL/OpenGL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit fb5e6d05fe4c03262e69f03c9325679fd074dab8
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Wed Sep 30 20:27:34 2009 -0400
+
+ Adding ButtonMotionMask and PointerMotionMask
+
+ More #defines from X11 needed for the fake XEvent processing.
+
+ Graphics/TriD/POGL/OpenGL.pm | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit b9de52cc269c8cb2bd9fd8ff664630bdbc8e0e27
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 30 19:15:21 2009 -0400
+
+ Add KeyPress* and KeyRelease* to GLUT defines
+
+ Graphics/TriD/POGL/OpenGL.pm | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit cab38844095e7f0ddbb2c17772ffded2d58e80b4
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 30 18:01:30 2009 -0400
+
+ Fix missing GLUT_DEPTH option on GLUT windows
+
+ This resolved the visual artifacts for PDL+POGL and GLUT!
+
+ Graphics/TriD/POGL/OpenGL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 50c8136b2972bc42f4c4f7548c312e3b2d130b2a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 30 17:40:11 2009 -0400
+
+ Fix missing GLX and X11 constanst for GLUT
+
+ Need to define various GLX and X11 constants, even if X11 and
+ GLX are not being used in order to create the fake XEvent queue.
+ Added a few I missed and defined in OpenGL rather than
+ PDL::Graphics::OpenGL::Perl::OpenGL.
+
+ Graphics/TriD/POGL/OpenGL.pm | 36 +++++++++++++++++++++---------------
+ 1 files changed, 21 insertions(+), 15 deletions(-)
+
+commit 84e91525afb9f06dd6d949f00afd095a99a785eb
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 30 15:55:28 2009 -0400
+
+ Finished fake XEvent stuff for GLUT
+
+ Using cygwin and FreeGLUT with USE_POGL the perldl 3d and 3d2
+ now "work" in the sense of the basic keyboard controls and
+ mouse operations. The rendering appears out of order for the
+ complex scenes using hold3d so some debugging is needed there.
+
+ win32+freeglut should work
+
+ macos+glut should work provided one edits the code replacing
+ calls to glutMainLoopEvent() by glutCheckLoop(), and calls to
+ glutCloseFunc() by glutWMCloseFunc().
+
+ Graphics/TriD/POGL/OpenGL.pm | 38 ++++++++++++++++++++++++++++++++------
+ Graphics/TriD/TriD/GL.pm | 3 ++-
+ 2 files changed, 34 insertions(+), 7 deletions(-)
+
+commit c3ad8066292f7acf36e081ccc44d0cacc743e035
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 30 11:47:34 2009 -0400
+
+ Fixed 'x11' window type with USE_POGL
+
+ Had GLUT window support in but need to debug the XEvent
+ packet types for mouse motion and button presses to complete
+ the fake XEvent emulation. This fixes the new code to work
+ with the 'x11' window type which had been broken by the new
+ GLUT functionality. Also added another diagnostic test
+ program line3d.pl.
+
+ 3dtest.pl | 2 +-
+ Graphics/TriD/POGL/OpenGL.pm | 10 ++++++----
+ Graphics/TriD/TriD/GL.pm | 35 +++++++++++++++++++++++++----------
+ line3d.pl | 19 +++++++++++++++++++
+ 4 files changed, 51 insertions(+), 15 deletions(-)
+
+commit 461eb0418856ba32c0a212d826962f64526d9efc
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Tue Sep 29 23:16:32 2009 -0400
+
+ Add Keyboard events and mouse/motion events
+
+ This adds the rest of the GLUT callbacks required to implement
+ a fake XEvent processing stream for TriD window control. The
+ hooks are there, now need to figure out what the actual events
+ being simulated should look like and do that. The last step
+ will be to clean out any remaining GLX items and verify correct
+ operation.
+
+ Graphics/TriD/POGL/OpenGL.pm | 44 +++++++++++++++++++++++++++++++++++------
+ 1 files changed, 37 insertions(+), 7 deletions(-)
+
+commit 558ee2b0654c0947dcf1db564b82f2cc4733707c
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Tue Sep 29 23:13:52 2009 -0400
+
+ Changed glutPrintString to glutBitmapString
+
+ This fixes a minor confusion between the names of glpPrintString()
+ and glutBitmapString() which do pretty much the same thing but the
+ names are not symmetric. Now Labels on TriD work with GLUT.
+
+ Graphics/TriD/TriD/GL.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit c4f424eef02739652a94190d01d95a2c8c0e4d8e
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 29 18:37:08 2009 -0400
+
+ Added ConfigureNotify and CloseWindow to GLUT
+
+ The implementation of the TriD refactoring to use
+ POGL OpenGL is complete. This commits the fake XEvent
+ queue handling for resize events and clicking on the
+ window close widget (X in top right on windows).
+
+ Graphics/TriD/POGL/OpenGL.pm | 45 +++++++++++++++++++++++++++++++++++++----
+ 1 files changed, 40 insertions(+), 5 deletions(-)
+
+commit 9c0431ce27ecffa6fdc4d86feeb33d7cfc233315
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Tue Sep 29 16:26:59 2009 +1000
+
+ Win32-specific fix to linking specs in Graphics/TriD/OpenGLQ/Makefile.PL
+
+ Because the linking info for Win32 is containedin
+ 'LDFROM', instead of the usual 'LIBS' we need to
+ insert the following:
+
+ if($^O eq 'MSWin32') {
+ $hash{LDFROM} .= ' '. $OpenGL::Config->{LDFROM};
+ $hash{LDFROM} =~ s/\-lfreeglut//g;
+ }
+
+ (The freeglut import library won't be locatable,
+ so therefore '-lfreeglut' needs to be removed.)
+
+ Graphics/TriD/OpenGLQ/Makefile.PL | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit 720a15db7cf2ed7cdf62d8e6587d5bb8d711f385
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Sep 28 16:49:10 2009 -0400
+
+ Added GLUT support to OO window creation
+
+ Partial work towards implementing a fake XEvent queue
+ for the twiddle loop handling. Still need callback
+ support for the queue.
+
+ Graphics/TriD/POGL/OpenGL.pm | 26 +++++++++++++++++++-------
+ Graphics/TriD/TriD/GL.pm | 27 +++++++++++++++++++++------
+ 2 files changed, 40 insertions(+), 13 deletions(-)
+
+commit 07c47775e2091b53854a07283769da1e4c42abb1
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sat Sep 26 18:15:13 2009 -0400
+
+ Set version to 2.4.4_12git for development
+
+ Getting ready for a quick PDL-2.4.4_12 release if the build logic
+ fix checks out...
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit ee8f439de83fda38b6ab41400362cd30e5a85109
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sat Sep 26 18:12:51 2009 -0400
+
+ Enable TriD builds when USE_POGL is enabled
+
+ Otherwise, the TriD never gets built even though the OpenGL part
+ using POGL is. Also change the WITH_3D default to undef for
+ Mac OS X and win32.
+
+ Graphics/Makefile.PL | 3 +++
+ perldl.conf | 2 +-
+ 2 files changed, 4 insertions(+), 1 deletions(-)
+
+commit 43897e6eeeac4d458a2b60e8642b513be05a89ee
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 25 16:54:16 2009 -0400
+
+ Add support for 3d window types
+
+ Need to support x11 and glut window types to enable consistent
+ use of the correct event/callback framework for GUI operations.
+ This adds a 3d_window_type field in the OO object returned.
+ The 3 possible values are pdl-legacy-x11, x11, and glut.
+
+ Graphics/TriD/OpenGL/opengl.pd | 6 ++++--
+ Graphics/TriD/POGL/OpenGL.pm | 40 +++++++++++++++++++++++++++++-----------
+ 2 files changed, 33 insertions(+), 13 deletions(-)
+
+commit 4e3c0b22ee2f56fa38420eb607cdd202a67846ab
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 25 14:13:01 2009 -0400
+
+ Check for POGL with USE_POGL and fix opengl.t
+
+ Now Makefile.PL will explicitly exit if an appropriate
+ version of POGL is not available when the USE_POGL option
+ is set. Also cleaned up t/opengl.t to work with and
+ without USE_POGL set.
+
+ Makefile.PL | 7 ++++
+ t/opengl.t | 95 ++++++++++++++++++-----------------------------------------
+ 2 files changed, 36 insertions(+), 66 deletions(-)
+
+commit 76d5b7925489363ca453cdbb876b029287f8e8ad
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Thu Sep 24 23:55:23 2009 -0400
+
+ VERSION to 2.4.4_11git for development
+
+ The next stage of TriD refactoring is to change the window/context
+ creation from X11+GLX to the corresponding GLUT routines. XEvent
+ processing also needs to be replaced with callbacks for GLUT. The
+ tricky part about the whole thing is maintaining the X11+GLX
+ capability to support Tk OpenGL widgets. I hope to figure out
+ a way to work with the GLUT windows directly rather than maintaining
+ X11+GLX. TBD. Maybe the Perl/Tk authors have some ideas...
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3d5c7f4c7554b2efca08229f591f335ec7a45164
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Thu Sep 24 23:53:04 2009 -0400
+
+ Minor POGL support modifications
+
+ Added comment to 3dtest.pl identifying it as a test program.
+ Wording cleanup and cruft removal in Graphic/TriD/POGL files.
+
+ 3dtest.pl | 3 +++
+ Graphics/TriD/POGL/MANIFEST | 2 --
+ Graphics/TriD/POGL/OpenGL.pm | 7 +++----
+ Graphics/TriD/POGL/README | 2 +-
+ 4 files changed, 7 insertions(+), 7 deletions(-)
+
+commit 5f6a1190c91478b74dae7e54e6957d7f7f4babaa
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Thu Sep 24 20:37:56 2009 -0400
+
+ Fix perldl.conf defaults and VERSION to 2.4.4_10
+
+ Need another developers release with the expected defaults
+ in perldl.conf for better test coverage.
+
+ Basic/PDL.pm | 2 +-
+ perldl.conf | 14 +++++++-------
+ 2 files changed, 8 insertions(+), 8 deletions(-)
+
+commit d0fa53907dbd0317dd99d4c2888fabd36487aa6d
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Wed Sep 23 22:22:04 2009 -0400
+
+ Set VERSION to 2.4.4_09 and prep for CPAN release
+
+ This is the first CPAN release offering the option of using
+ the new POGL code for TriD and USE_POGL is enabled by default
+ for testing coverage.
+
+ Basic/PDL.pm | 2 +-
+ Known_problems | 4 ++--
+ MANIFEST | 7 +++++++
+ Release_Notes | 5 +++++
+ perldl.conf | 4 ++--
+ 5 files changed, 17 insertions(+), 5 deletions(-)
+
+commit 3e8cccf159c866a45c5e17857d5fc85ec8d33bfa
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 23 20:56:30 2009 -0400
+
+ Merge in use of POGL for basic TriD functions
+
+ These changes allow one to toggle between the legacy TriD
+ PP OpenGL bindings and the OpenGL module bindings (a.k.a. POGL)
+ by setting the USE_POGL option appropriately in perldl.conf.
+
+ After some testing of the new code on various platforms, the
+ final stage of the refactoring is to replace the X11 + GLX
+ event and window code with GLUT based code.
+
+ Graphics/TriD/POGL/Makefile.PL | 3 +-
+ Graphics/TriD/POGL/t/00-load.t | 2 -
+ Graphics/TriD/TriD/GL.pm | 95 ++++++++++++++++++++++++++------------
+ Graphics/TriD/TriD/GoBoard.pm | 13 ++++-
+ Graphics/TriD/TriD/GraphBox.pm | 13 ++++-
+ Graphics/TriD/TriD/Labels.pm | 14 +++++-
+ Graphics/TriD/TriD/Lines.pm | 13 ++++-
+ Graphics/TriD/TriD/MathGraph.pm | 12 ++++-
+ Graphics/TriD/TriD/Mesh.pm | 13 ++++-
+ Graphics/TriD/TriD/Surface.pm | 13 ++++-
+ Graphics/TriD/TriD/Tk.pm | 13 ++++-
+ 11 files changed, 146 insertions(+), 58 deletions(-)
+
+commit f8408074f5be3beed09ed4b49d43be79f67c1591
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 23 16:51:26 2009 -0400
+
+ Adding USE_POGL handling to TriD build
+
+ Graphics/TriD/Makefile.PL | 82 ++++++++++++++++++++---------------
+ Graphics/TriD/OpenGL/examples/clip | 4 +-
+ Graphics/TriD/OpenGLQ/Makefile.PL | 29 +++++++-----
+ Graphics/TriD/POGL/t/boilerplate.t | 48 ---------------------
+ Graphics/TriD/POGL/t/pod.t | 12 -----
+ perldl.conf | 8 ++--
+ 6 files changed, 69 insertions(+), 114 deletions(-)
+
+commit 1f9a74d944f8fcf09e3d8bbf5f87133bf1d0867b
+Merge: 5fedb91 2e3fcf6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 23 16:44:00 2009 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 2e3fcf6d5b26d44016aa906cc1ab25de52fd7043
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Wed Sep 23 16:36:20 2009 -0400
+
+ Fix Minuit fortan URL in DEPENDENCIES
+
+ DEPENDENCIES | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 5fedb919b3b95e42b0acb39b62df45d25693a3e0
+Merge: dd01556 7677f77
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 23 16:10:48 2009 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 7677f77a4ddf5ef3575bba672b50b00a8ce74142
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Wed Sep 23 16:07:08 2009 -0400
+
+ Added Minuit lib info to DEPENDENCIES
+
+ This is one of the two external library bindings in PDL that use
+ a fortran compiler.
+
+ DEPENDENCIES | 13 +++++++++++++
+ 1 files changed, 13 insertions(+), 0 deletions(-)
+
+commit dd01556cd99467dba79c1c4f24456e2e8dd91627
+Merge: 9b6b1f9 3084dba
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 23 14:27:36 2009 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl/pdl
+
+commit 3084dba190b2392e29b5adbd0bbcd40085d7618b
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Wed Sep 23 14:26:42 2009 -0400
+
+ Make OpenGL a prerequisit for testing
+
+ Makefile.PL | 13 +++++++------
+ Release_Notes | 2 +-
+ perldl.conf | 3 ++-
+ 3 files changed, 10 insertions(+), 8 deletions(-)
+
+commit 9b6b1f9d1f4a2880ab179e430211af2856f71dab
+Merge: 205d5b9 6743108
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 23 14:24:21 2009 -0400
+
+ Merge branch 'pogl-merge' into pdl and check
+
+ This is a preliminary fold in of pogl-merge work into
+ the main pdl branch for testing.
+
+ Conflicts:
+ Release_Notes
+ perldl.conf
+
+commit 205d5b9445fe3c4bab0d0863614b72cfbf65aca2
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Tue Sep 22 16:59:59 2009 -0400
+
+ Add 3dtest.pl as simple imagrgb() test program
+
+ 3dtest.pl | 15 +++++++++++++++
+ 1 files changed, 15 insertions(+), 0 deletions(-)
+
+commit 8cf19024667c67ed263b64cff669c65b4c85eff2
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Tue Sep 22 16:55:25 2009 -0400
+
+ Start folding POGL changes into PDL master branch
+
+ Now have OpenGL-0.58_004 as a prerequisite. A new USE_POGL
+ option is in the perldl.conf file. I expect that the next
+ few releases may be destabilized over the previous bugfix type
+ developers releases.
+
+ DEPENDENCIES | 6 ++++--
+ Makefile.PL | 7 ++++---
+ Release_Notes | 20 ++++++++++++++++++++
+ perldl.conf | 10 ++++++++--
+ 4 files changed, 36 insertions(+), 7 deletions(-)
+
+commit 6743108ed374e3c221975fc5c94fd2b0b2e53a39
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 22 16:29:05 2009 -0400
+
+ Some changes from the master branch
+
+ Basic/Gen/PP.pm | 19 ++++++++++++++++++-
+ Basic/Pod/FAQ.pod | 4 ++--
+ DEPENDENCIES | 2 +-
+ 3 files changed, 21 insertions(+), 4 deletions(-)
+
+commit 94598b90937447ea419090da587af86e34c1d171
+Author: C.Soeller <c.soeller _at_ auckland_dot_ ac _dot_ nz>
+Date: Fri Sep 18 13:06:20 2009 +1200
+
+ New approach to find typemap
+
+ Tries to locate the ExtUtils folder and looks for typemap in there. Warns if no typemap found.
+ This needs testing on many platforms
+
+ Basic/Gen/PP.pm | 19 ++++++++++++++++++-
+ 1 files changed, 18 insertions(+), 1 deletions(-)
+
+commit 249e65dd9d0b2beb7df1bb52ca5692ae2d51af61
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 17 17:03:40 2009 -0400
+
+ OpenGL now replaces PDL::Graphics::OpenGL!
+
+ With a bit of hardwiring, this version of PDL builds on
+ cygwin using the POGL module rather than the internal PP
+ one (PDL::Graphics::OpenGL). All the 3d demos run and
+ the Tk3d does as well although it crashes the cygwin X
+ server. Need to check on additional platforms.... The
+
+ 3dtest.pl in the top directory is a simple imagrgb test
+ program for debugging.
+
+ 3dtest.pl | 15 +++++++++++++++
+ Graphics/TriD/POGL/OpenGL.pm | 2 +-
+ Graphics/TriD/TriD/GL.pm | 19 ++++++++++---------
+ Graphics/TriD/TriD/Tk.pm | 2 +-
+ 4 files changed, 27 insertions(+), 11 deletions(-)
+
+commit 58ae1222538a80607eaf37ce44ab4152e634ed15
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 15 17:58:25 2009 -0400
+
+ COB 15-Sep-2009 on POGL integration to TriD
+
+ This is the stopping point for the day. So far things
+ are working as far as not bombing out immediately. Still
+ have not been able to create a basic PDL::Graphics::OpenGL::OO
+ object from TriD. Debugging continues...
+
+ Graphics/TriD/OpenGL/examples/clip | 4 +-
+ Graphics/TriD/POGL/OpenGL.pm | 178 +++++++++++++++++++++++++++++++++++-
+ Graphics/TriD/TriD/GL.pm | 163 +++++++++++++++++----------------
+ Graphics/TriD/TriD/GoBoard.pm | 4 +-
+ Graphics/TriD/TriD/GraphBox.pm | 4 +-
+ Graphics/TriD/TriD/Labels.pm | 4 +-
+ Graphics/TriD/TriD/Lines.pm | 4 +-
+ Graphics/TriD/TriD/MathGraph.pm | 5 +-
+ Graphics/TriD/TriD/Mesh.pm | 7 +-
+ Graphics/TriD/TriD/OOGL.pm | 4 +-
+ Graphics/TriD/TriD/Surface.pm | 4 +-
+ Graphics/TriD/TriD/Tk.pm | 4 +-
+ 12 files changed, 295 insertions(+), 90 deletions(-)
+
+commit 708efe08694f2d39519987a010e8e390595bddeb
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Tue Sep 15 15:06:11 2009 -0400
+
+ Update git commands in FAQ
+
+ SF now allows more than one git repo per project.
+
+ Basic/Pod/FAQ.pod | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 02f1b1c686b4e04c65ba663c87d446b8ff910380
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 15 11:14:39 2009 -0400
+
+ Don't need POD coverage check for POGL stuff
+
+ Graphics/TriD/POGL/t/pod-coverage.t | 18 ------------------
+ 1 files changed, 0 insertions(+), 18 deletions(-)
+
+commit fb446b4a459e43887c71806c6b567345b76feb54
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 15 10:59:30 2009 -0400
+
+ Fix PDL::Graphics::OpenGL::Perl::OpenGL POC info
+
+ Graphics/TriD/POGL/Makefile.PL | 2 +-
+ Graphics/TriD/POGL/OpenGL.pm | 3 ++-
+ 2 files changed, 3 insertions(+), 2 deletions(-)
+
+commit 3c2cfba147166ba3d19aece91f89a6cc43d0f77f
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 15 10:50:09 2009 -0400
+
+ Created stub Graphics/TriD/POGL dir
+
+ Started with the module-starter output for
+ PDL::Graphics::OpenGL::Perl::OpenGL . The
+ next step is to integrate the build into the
+ existing TriD build process.
+
+ Graphics/TriD/POGL/MANIFEST | 8 +++
+ Graphics/TriD/POGL/Makefile.PL | 1 +
+ Graphics/TriD/POGL/OpenGL.pm | 92 +++++++++++++++++++++++++++++++++++
+ Graphics/TriD/POGL/README | 40 +++++++++++++++
+ Graphics/TriD/POGL/ignore.txt | 10 ++++
+ Graphics/TriD/POGL/t/00-load.t | 9 +++
+ Graphics/TriD/POGL/t/boilerplate.t | 48 ++++++++++++++++++
+ Graphics/TriD/POGL/t/pod-coverage.t | 18 +++++++
+ Graphics/TriD/POGL/t/pod.t | 12 +++++
+ 9 files changed, 238 insertions(+), 0 deletions(-)
+
+commit 8b4cc98710428c19d4640e032cd74b400a30feb6
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Sep 14 17:41:13 2009 -0400
+
+ Start PDL/Graphics/TriD/POGL build stuff
+
+ Created PDL/Graphics/TriD/POGL as the in-tree build directory
+ for PDL::Graphics::OpenGL::Perl::OpenGL which contains the interface
+ between the PDL::Graphics::TriD and POGL.
+
+ Graphics/TriD/Makefile.PL | 2 +-
+ Graphics/TriD/POGL/Makefile.PL | 19 +++++++++++++++++++
+ 2 files changed, 20 insertions(+), 1 deletions(-)
+
+commit 7a07b2183eb6d6a1de3250a1a3da1746f862353a
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Sep 11 13:13:49 2009 -0400
+
+ Make POGL an official prerequisite for PDL
+
+ This is for testing purposes mainly. We'll change to
+ a smart build for the official release.
+
+ DEPENDENCIES | 6 ++++--
+ Makefile.PL | 7 ++++---
+ Release_Notes | 21 +++++++++++++++++++++
+ 3 files changed, 29 insertions(+), 5 deletions(-)
+
+commit 2b6dd8fbcb4daa22d4ed715990710b99a42ab722
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Thu Sep 10 17:14:43 2009 -0400
+
+ Add USE_POGL option to perldl.conf
+
+ This option enables building PDL::Graphics::TriD using
+ the Perl OpenGL module to provide the external library
+ interface rather than rolling our own via PP.
+
+ perldl.conf | 10 ++++++++--
+ 1 files changed, 8 insertions(+), 2 deletions(-)
+
+commit b8c223226769639806158d6f030473eb9b2f8ae7
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Sep 9 17:19:27 2009 -0400
+
+ Fix OpenGLQ to use OpenGL::Config for compile opts
+
+ This is a hardwired test of using the %{$OpenGL::Config} for
+ the INC, DEFINE, and LIBS args for Graphics/TriD/OpenGLQ/Makefile
+ generation.
+
+ Graphics/TriD/OpenGLQ/Makefile.PL | 16 +++++++++++++---
+ 1 files changed, 13 insertions(+), 3 deletions(-)
+
+commit 19c4c6f6dbe2e5903ae8cb1f1bec3f4ae68ece6d
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Sep 8 16:09:47 2009 -0400
+
+ Modify perldl.conf to skip all but TriD
+
+ perldl.conf | 18 +++++++++---------
+ 1 files changed, 9 insertions(+), 9 deletions(-)
+
+commit 83036dbfb7c2301518b6c2749425ecb190e59e9b
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Fri Sep 4 20:13:36 2009 +1000
+
+ Accommodate ActiveState's change to $Config{make}
+
+ In top level Makefile.PL, Basic\Core\Makefile.PL
+ and Basic\Gen\Makefile.PL replace:
+ $Config{make} eq 'dmake'
+ with
+ $Config{make} =~ /\bdmake/i
+ and replace:
+ $Config{make} eq 'nmake'
+ with
+ $Config{make} =~ /\bnmake/i
+
+ Basic/Core/Makefile.PL | 8 ++++----
+ Basic/Gen/Makefile.PL | 4 ++--
+ Makefile.PL | 4 ++--
+ 3 files changed, 8 insertions(+), 8 deletions(-)
+
+commit ba04659a24eb7610cb0ac36d112d80dfdd5c8288
+Author: Chris Marshall <marshallch at sourceforge.net>
+Date: Fri Aug 28 12:12:26 2009 -0700
+
+ Clean up some lvalue sub usage
+
+ Although PDL is moving towards making perl 5.8+
+ a requirement, the lvalue subroutine usage is a
+ convenience only. This replaces internal usage
+ with the equivalent temp variable assignments
+ to avoid unnecessary breakage for early perls.
+
+ Basic/Primitive/primitive.pd | 7 ++++---
+ t/matrixops.t | 3 ++-
+ 2 files changed, 6 insertions(+), 4 deletions(-)
+
+commit ff76743e0d5f50a99ccad14b448735f002f4e7aa
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Fri Aug 21 15:51:15 2009 -0400
+
+ $PDL::VERSION to 2.4.4_09git for development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 10177bab465a0d6034d7d1dd3059d66a1722723c
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Fri Aug 21 15:14:43 2009 -0400
+
+ Push out 2.4.4_08 developers release
+
+ Updated the various README type files, changed $PDL::VERSION
+ to 2.4.4_08 for a developers release containing the cygwin
+ fixes for TriD.
+
+ Basic/PDL.pm | 2 +-
+ INSTALL | 6 +++---
+ Known_problems | 29 ++++++++++++++++++++++-------
+ Release_Notes | 19 +++++++++++++++++++
+ cygwin/README | 9 +++++----
+ 5 files changed, 50 insertions(+), 15 deletions(-)
+
+commit 573b2ff8bf35de6b1c1953bd6a8d04d78698b133
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Fri Aug 21 14:34:20 2009 -0400
+
+ Removed include dependency on GL/glx.h
+
+ OpenGLQ implements some high performance OpenGL visualization
+ operations, none of which depend on X11 or GLX. This cleans
+ up the dependencies for refactoring. The only change here should
+ be to use the OpenGL::Config information to set the correct
+ compile and link arguments.
+
+ Graphics/TriD/OpenGLQ/openglq.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit c6676638c835c9679cc05c98bd24492a595224c9
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Fri Aug 21 14:06:59 2009 -0400
+
+ Fix TriD build problems on cygwin
+
+ This is a needed first step for verifying that the refactoring
+ to use POGL rather than PDL::Graphics::OpenGL as its OpenGL
+ library perl binding.
+
+ Graphics/Makefile.PL | 24 +++++++++++++++---------
+ Graphics/TriD/OpenGL/opengl.pd | 7 ++++++-
+ Graphics/TriD/OpenGLQ/Makefile.PL | 20 +++-----------------
+ 3 files changed, 24 insertions(+), 27 deletions(-)
+
+commit 0a1e5146fcf14b2da2710ed660a000c9afffdbd0
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Fri Aug 21 14:06:23 2009 -0400
+
+ Update PDL version to 2.4.4_08git for development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit be353c8e7bb257c91f04ab2499efd2f555147d2b
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sat Aug 15 13:42:39 2009 -0400
+
+ Set $PDL::VERSION and notes for 2.4.4_07 release
+
+ Basic/PDL.pm | 2 +-
+ DEPENDENCIES | 3 +++
+ Makefile.PL | 5 +++--
+ Release_Notes | 25 +++++++++++++++++--------
+ 4 files changed, 24 insertions(+), 11 deletions(-)
+
+commit 8e7bfa344e83c9d54e87dda430ee6c549a9b348f
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Aug 2 15:59:45 2009 -0400
+
+ Avoid lvalue sub syntax requirements
+
+ For perl 5.6.x perls, we have occaisional test failures in PDL
+ due to lvalue sub errors. This fixes a number of occurances where
+ we were using the lvalue syntax when we do not officially require
+ it---maybe we should. In the meantime, this cleans up a number of
+ refs and updates the FAQ entry to be more correct.
+
+ Basic/MatrixOps/matrixops.pd | 3 ++-
+ Basic/Pod/FAQ.pod | 7 +++----
+ Basic/Primitive/primitive.pd | 5 +++--
+ IO/FITS/FITS.pm | 6 +++---
+ Lib/Transform/transform.pd | 3 ++-
+ t/imagend.t | 9 ++++++++-
+ 6 files changed, 21 insertions(+), 12 deletions(-)
+
+commit 53e139899ae0571041d6d27d4feee7d1a9807b1b
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Aug 2 15:58:04 2009 -0400
+
+ Make Data::Dumper v 2.121 the minimum required
+
+ The earlier 2.122 was too aggressive. It appears that the
+ needed fix was in version 2.121.
+
+ DEPENDENCIES | 2 +-
+ IO/Dumper.pm | 2 +-
+ Makefile.PL | 2 +-
+ Release_Notes | 2 +-
+ 4 files changed, 4 insertions(+), 4 deletions(-)
+
+commit de06edf416963aa919a072aac17bc3b3a3d51fed
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 29 10:47:19 2009 -0400
+
+ Require Data::Dumper 2.122 in IO/Dumper.pm
+
+ IO/Dumper.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 7b0845e9d81cdc8dc579430d8c9de524330cd8ac
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 29 10:38:09 2009 -0400
+
+ Rework storable test to use Test::More
+
+ Updated t/storable.t to check for Storable version 1.03
+ rather than 1.0 since the comments in PDL::IO::Storable
+ suggested that that was the version required. While at
+ it, updated the test to use Test::More.
+
+ t/storable.t | 75 +++++++++++++++++++++++----------------------------------
+ 1 files changed, 30 insertions(+), 45 deletions(-)
+
+commit bac1dc64c30c94e2123712d09bb4185ef4d05b25
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Tue Jul 28 22:21:27 2009 -0400
+
+ Updated files with Data::Dumper info
+
+ Updated DEPENDENCIES, Release_Notes, and cygwin/INSTALL with
+ information about the Data::Dumper prerequisite requirement.
+
+ DEPENDENCIES | 4 ++++
+ Release_Notes | 25 +++++++++++++++++++++++++
+ cygwin/INSTALL | 18 +++++++++++++-----
+ 3 files changed, 42 insertions(+), 5 deletions(-)
+
+commit 5110524ac155b55c07b2dc5d29230e995b4f6af1
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Tue Jul 28 21:23:29 2009 -0400
+
+ Fix t/autoload.t test when echo ~ gives ~
+
+ On some systems, the shell returns '~' as the result of qx{echo ~}
+ which causes a spurious test failure. In that case, check against
+ the original reference value of (getpwnam(getpwuid(\$<)))[7] .
+ This is more permissive but is a correct answer for tilde expansion
+ so works as a pass check.
+
+ t/autoload.t | 18 +++++++++++-------
+ 1 files changed, 11 insertions(+), 7 deletions(-)
+
+commit 475c8433fd2f0649138d0444ef34fa7ce091ad24
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 28 16:16:00 2009 -0400
+
+ Set minimum Data::Dumper version to 2.122
+
+ This is the first version of Data::Dumper that looks
+ like it addresses the problem I found. Since Data::Dumper
+ was "used" by PDL::IO::Dumper, it should have been listed
+ as a dependency for PDL. Requiring this version prevents
+ testing with the broken ones.
+
+ Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit b5c911482b026e02df11ecc074efff120a456bc5
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Tue Jul 28 14:22:42 2009 -0400
+
+ Added Data::Dumper to the prerequisites
+
+ We were using it to implement PDL::IO::Dumper so it should
+ have been listed. By listing it, the automated testers
+ will report version numbers with failing test reports which
+ might help resolve the current FAILs with t/dumper.t
+
+ Makefile.PL | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit f4a569d1ec3301692516fbc5b0c3f839d84395c6
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Mon Jul 27 07:32:07 2009 -0400
+
+ Update $PDL::VERSION to 2.4.4_07git for devel
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 6eeca045e56faab5f8b0bc1c16110ea1ce8009ff
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Jul 26 21:40:09 2009 -0400
+
+ Update VERSION and readme files for release
+
+ Updates to $PDL::VERSION, and top level user readme
+ type files for 2.4.4_06 developers release of PDL.
+
+ Basic/PDL.pm | 2 +-
+ DEVELOPMENT | 14 +++------
+ Known_problems | 16 ++++++++++-
+ MANIFEST.SKIP | 2 +-
+ Release_Notes | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-
+ 5 files changed, 107 insertions(+), 13 deletions(-)
+
+commit dcdf90ac236996e945d04767ca48355608056757
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Jul 26 17:23:03 2009 -0400
+
+ Added Changes_CVS to the MANIFEST file
+
+ Need to make sure this is generated correctly at some point.
+ Just use the existing one for now.
+
+ MANIFEST | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 100199514b1c9310a5f302984a939d9e70361d97
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Jul 26 17:16:23 2009 -0400
+
+ Add Changes to the .gitignore
+
+ Telling git to ignore the Changes file for now since we'll
+ be automatically generating it from the output of a "git log --stat"
+ for each CPAN distribution. Anyone who is doing actual development
+ with PDL can just use the git log command directly. Any official or
+ developers release on CPAN will have a generated log file.
+
+ For now, the old logs pre-git are now in Changes_CVS and the Changes
+ file will include git log since the changeover. At some point, we
+ could deprecate the Changes_CVS file and just go to the git logs.
+
+ .gitignore | 6 ++++++
+ 1 files changed, 6 insertions(+), 0 deletions(-)
+
+commit 795ef9aa8a223049b14d7840b8fddc28cbb73147
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun Jul 26 17:09:49 2009 -0400
+
+ Move Chages to Chances_CVS to prep for git log
+
+ We plan to move from a manual Changes file to an automatically
+ generated one extracted from the git log messages. The initial
+ command is "git log --stat" and will be added to the make dist
+ command eventually. For now, just generate by hand before making
+ a CPAN distribution.
+
+ Changes | 3983 -----------------------------------------------------------
+ Changes_CVS | 3983 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 3983 insertions(+), 3983 deletions(-)
+
+commit 762871346e6ce8de9f15ce35c701f6c7330d1a09
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 22 13:50:00 2009 -0400
+
+ Added PERL5OPT unset for podselect command
+
+ Missed the podselect in Basic/Gen/Makefile.PL.
+ This unsets PERL5OPT before running podselect
+ in the generated Makefile. That should prevent
+ false failures due to Devel::Autoflush not being
+ available...
+
+ Basic/Gen/Makefile.PL | 12 +++++++++---
+ 1 files changed, 9 insertions(+), 3 deletions(-)
+
+commit bc0f8efeb105754c0a0037250962ac74bce7f4fa
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Mon Jul 20 07:27:27 2009 -0400
+
+ Make tilde test check against `echo ~` result
+
+ Since the goal is to give the same result as the
+ shell (i.e. bash) expansion of ~, and since all the
+ false test failures had the PDL::AutoLoader giving
+ the same result as `echo ~`, I've just made that
+ the result to check against.
+
+ t/autoload.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 494e151b73df0de71dcbd8b6c576813974483b46
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Mon Jul 20 13:48:03 2009 +1000
+
+ Win32 - MSVC-specific fix for setvaltobad() for PDL_Float
+
+ In Basic/Bad/bad.pd:
+ Provide special handling for setvaltobad() wrt PDL_Float piddles.
+ Applies only to MSVC++ compilers prior to version 8.0.
+ Thanks to creamygoodness, BrowserUk, ig and ELISHEVA:
+ http://www.perlmonks.org/index.pl?node_id=781347
+
+ Basic/Bad/bad.pd | 26 +++++++++++++++++++++++++-
+ 1 files changed, 25 insertions(+), 1 deletions(-)
+
+commit 081038b048f69e5b467f54764ea89f244dcd43b7
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Mon Jul 20 13:22:54 2009 +1000
+
+ Win32 - Reduce scope of MSVC-specific bugfix
+
+ Some MS compiler bugs have been fixed in later
+ versions of the compiler.
+ This allows us to change each occurrence of:
+ #ifdef _MSC_VER
+ to:
+ #if defined _MSC_VER && _MSC_VER < 1400
+
+ Basic/Core/pdlcore.c.PL | 6 +++---
+ 1 files changed, 3 insertions(+), 3 deletions(-)
+
+commit 1faadeec55cd3c1dd21339bd50331eb8983c0347
+Author: sisyphus_ <sisyphus1 at optusnet.com.au>
+Date: Mon Jul 20 13:14:13 2009 +1000
+
+ Basic/Core/Dev.pm - tweak setting of WriteMakefile() LIBS
+
+ Instead of specifying LIBS=>[] (on those occasions when LIBS
+ should be empty) pdlpp_stdargs_int() and pdlpp_stdargs() would
+ have LIBS=>[''] and LIBS=>[' '] respectively.
+ Minor rewrite to pdlpp_stdargs_int() and pdlpp_stdargs() to fix this.
+
+ Basic/Core/Dev.pm | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 3895fdf00591a26575af8b24084f011e7e7dd15b
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sat Jul 18 14:18:38 2009 -0400
+
+ Added $! to another Basic/Core/Dev.pm die message
+
+ Basic/Core/Dev.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2a720756b87d77f061f2a09aeffa2d789c06246c
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 17 09:21:16 2009 -0400
+
+ Added $! to Basic/Core/Dev.pm tempfile error
+
+ The die when trylink failed to open its temporary
+ output file did not include the system error reported.
+ That has been added to the output to improve debugging.
+
+ IDEA: Maybe we should grep die() in the source and make
+ sure all errors actually include $! if relevant.
+
+ Basic/Core/Dev.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3094252e25685d57e48674d250ffc3ca4ffe0601
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Fri Jul 17 09:01:27 2009 -0400
+
+ Added diag print for t/dumper.t small sdump()
+
+ There have been persistent t/dumper.t failures
+ on some BSD platforms. Adding a diag() to print
+ the result of the first sdump() string to give
+ a clue as to what the problem is.
+
+ t/dumper.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 262b36dbdcd998e07a1497b0e99f1196dd7a2f59
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Wed Jul 15 20:11:19 2009 -0400
+
+ Minor tweakws to .gitignore and MANIFEST.SKIP
+
+ .gitignore | 7 ++++++-
+ MANIFEST.SKIP | 5 +++++
+ 2 files changed, 11 insertions(+), 1 deletions(-)
+
+commit fb61e3296b8b867952eb19dba3c77b368ebc8213
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Wed Jul 15 20:03:17 2009 -0400
+
+ Fix readflex() to work with File::LinearRaid
+
+ readflex() in IO/FlexRaw/FlexRaw.pm use method syntax for
+ read with an input file handle. This failed with a tied
+ file handle as is used by File::LinearRaid. Replacing the
+ usage $d->read(...) by read($d, ...) fixed the incompatibility.
+ I don't know if it should have worked the other way or not.
+
+ IO/FlexRaw/FlexRaw.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 3b58ac761e72df3366e5e9a5f5a81cc6785bc425
+Author: Chris Marshall <devel.chm.01 at gmail.com>
+Date: Wed Jul 15 08:44:32 2009 -0400
+
+ Fold in [dn]make correction to PERL5OPT fix
+
+ The "fix" for the -MDevel::Autoflush did not
+ work with dmake or nmake (presumably because of
+ the non-sh command shell). Here is a fix from
+ Sisyphus. Thanks, Rob.
+
+ Basic/Pod/Makefile.PL | 10 ++++++++--
+ Makefile.PL | 11 ++++++++++-
+ 2 files changed, 18 insertions(+), 3 deletions(-)
+
+commit 6142d6296241f77cb72973434db41475889c9d5a
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Mon Jul 13 18:06:23 2009 -0400
+
+ Cleaning up and updating README-type files
+
+ General wordsmithing in:
+
+ BUGS: reordering the information needed to clarify things
+ DEPENDENCIES: minor cleanup
+ DEVELOPMENT: minor cleanups and update for git
+ Release_Notes: updated with stub for PDL-2.4.4_06
+
+ BUGS | 59 +++++++++++++++++++++++++++++----------------------------
+ DEPENDENCIES | 5 +--
+ DEVELOPMENT | 58 +++++++++++++++++++++++++++++++------------------------
+ Release_Notes | 17 ++++++++++++++++
+ 4 files changed, 82 insertions(+), 57 deletions(-)
+
+commit 93f62cd6af55505254c2458f0c37fbb488adcd24
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Mon Jul 13 09:05:06 2009 -0400
+
+ Updated version to 2.4.4_06git for development.
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit d94b896d32562303175926760c5a418c45971a5c
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sat Jul 11 19:08:50 2009 -0400
+
+ Update Release_Notes for 2.4.4_05 release
+
+ Release_Notes | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit a7a0653382b5abb339d4cc8143669eb6ef87b8b6
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sat Jul 11 19:06:34 2009 -0400
+
+ Set $PDL::VERSION to 2.4.4_05 for re-release
+
+ There was a missing tab in the earlier release.
+ This fixes that oops. Rereleaseing to CPAN.
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit ea7498273c90f120b3c0e0665319c3475c5dc772
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sat Jul 11 18:58:19 2009 -0400
+
+ Fix missing tab in Basic/Pod/Makefile.PL
+
+ That breaks the "fix" for the podselect problem.
+
+ Basic/Pod/Makefile.PL | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit c5a417b7a8cbcf56bd747daeb3b6d5ccb82fe323
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Fri Jul 10 16:10:44 2009 -0400
+
+ Modified Release_Notes for 2.4.4_05git
+
+ Copied the basic section leaving space
+ for additions as the release progresses.
+
+ Release_Notes | 17 +++++++++++++++++
+ 1 files changed, 17 insertions(+), 0 deletions(-)
+
+commit 2e37777a700ecffe4f7412ba5a0553db9e861635
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Fri Jul 10 16:00:48 2009 -0400
+
+ Changed VERSION to 2.4.4_05git
+
+ The $PDL::VERSION is changed to 2.4.4_05git for more
+ development. The pattern I've decided to try is the
+ development release for a given version, say 2.4.4_05
+ is the same base with the string 'git' added on the
+ end. When the release is made, the git suffix is
+ removed and the distribution gnerated from there.
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 537d4d7f0d3d286b730cac453ea30d1e96228119
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Fri Jul 10 15:30:43 2009 -0400
+
+ Change $PDL::VERSION to 2.4.4_04 for release
+
+ Another developer's snapshot with more bug fixes
+ on a CPAN near you soon...
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 80620964e4d30b7d99cb6e006ee942aaeadf57a9
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Fri Jul 10 15:29:49 2009 -0400
+
+ Update Release_Notes for PDL-2.4.4_04 release
+
+ Release_Notes | 6 +++++-
+ 1 files changed, 5 insertions(+), 1 deletions(-)
+
+commit 6966b3131c474313473822133394768d396d9da5
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Fri Jul 10 15:27:16 2009 -0400
+
+ Unset PERL5OPT for podselect in Makefile.PL
+
+ Makefile.PL | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
+
+commit 100a3114b05e4afeb156485d94f89320861b697a
+Merge: 1401619 2146da8
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Fri Jul 10 11:25:57 2009 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl
+
+commit 14016191b5bd805ecc1bba6ca57e8d532f166418
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Fri Jul 10 11:22:36 2009 -0400
+
+ Unset PERL5OPT for podselect in Basic/Pod
+
+ The podselect command is a perl script and is
+ affected by the PERL5OPT environment variable.
+ Unfortunately, the CPAN Testers environment
+ sets PERL5OPT to load Devel::AutoFlush which
+ is a problem if that module is not in the
+ default, system perl @INC.
+
+ Basic/Pod/Makefile.PL | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 2146da8709eb37ccaefd5baf4c7f610d609560e7
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Thu Jul 9 22:11:39 2009 -0400
+
+ Added warning about parallel make to INSTALL file
+
+ Parallel make builds fail on some (all?) platforms.
+ I've added a warning to the INSTALL file not to use
+ -j # options for parallel builds. Ideally we would
+ detect the condition but I have found no clean way
+ to do so at the moment.
+
+ INSTALL | 6 ++++--
+ 1 files changed, 4 insertions(+), 2 deletions(-)
+
+commit 822c0e08c0243b054d6f87dcd61841083d745c46
+Merge: b1270b4 5b15c19
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Thu Jul 9 21:53:00 2009 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl
+
+commit 5b15c1942df0ac3fcb03a18fad82e1d545f04b65
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Thu Jul 9 13:59:18 2009 -0400
+
+ Update readme type files for PDL
+
+ Updated the BUGS, INSTALL, Known_problems, README, and
+ Release_Notes files to clean up references to cvs,
+ add info on current bugs, and correct URLs to sf.net.
+
+ BUGS | 16 ++++++++--------
+ INSTALL | 2 +-
+ Known_problems | 5 +++++
+ README | 2 +-
+ Release_Notes | 35 +++++++++++++++++++++--------------
+ 5 files changed, 36 insertions(+), 24 deletions(-)
+
+commit 8fa0c9830a02943125dbebbeee2bb5bd541c2995
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Thu Jul 9 13:09:16 2009 -0400
+
+ Fix t/autoload.t bug in tilde expand test
+
+ The AutoLoader module code for tilde expansion was corrected
+ but this test was using the previous method to check. This
+ makes the test consistent with the new code.
+
+ t/autoload.t | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit b1270b46b05019ab859b7e730eeef8a5cde34a09
+Merge: b1c7bd8 479e8a3
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Tue Jun 30 23:17:12 2009 -0400
+
+ Merge branch 'master' of ssh://marshallch@pdl.git.sourceforge.net/gitroot/pdl
+
+commit 479e8a3d2d9472e31768c143d788373d786601a2
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Thu Jun 18 15:04:59 2009 -0400
+
+ Update the various top level PDL readmes
+
+ Updated DEPENDENCIES, Known_problems, README and Release_Notes
+ in preparation for a coming developers release.
+
+ DEPENDENCIES | 16 ++++++++--------
+ Known_problems | 7 ++++---
+ README | 8 ++++----
+ Release_Notes | 24 +++++++++++++++++++++++-
+ 4 files changed, 39 insertions(+), 16 deletions(-)
+
+commit b1c7bd8ffa91fdfc181aa8ceba4b01672110c43a
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Tue Jun 16 21:12:28 2009 -0400
+
+ Added friendly .perldlrc suggsetion to perldl docs
+
+ A user suggested recommending documentation for new perldl
+ users on starting from the default.perldlrc file. This
+ avoids some mistakes such as forgetting to "use PDL;" etc.
+
+ perldl.PL | 4 +++-
+ 1 files changed, 3 insertions(+), 1 deletions(-)
+
+commit 16058ffa1a5621d1e57ed1e83e63c39c4ce63613
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Tue Jun 9 21:31:14 2009 -0400
+
+ Add cast toe $GENERIC(a) for setvaltonan()
+
+ This fixes the case where it was not possible to
+ set the value to bad for a non-double piddle since
+ it was difficult/impossible to create the exact
+ floating point representation of some floats starting
+ from default doubles. This make the implementation
+ symmetric with that of setbadtoval().
+
+ Basic/Bad/bad.pd | 2 +-
+ t/bad.t | 7 ++++++-
+ 2 files changed, 7 insertions(+), 2 deletions(-)
+
+commit a28c0a44f80d471a94fa001d929bf379f48ce041
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Tue Jun 9 21:30:17 2009 -0400
+
+ Add some more intermediate files to ignore.
+
+ .gitignore | 18 ++++++++++++++++++
+ 1 files changed, 18 insertions(+), 0 deletions(-)
+
+commit 3f225b92dc76c204a8d62da484dee63eb173c86b
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Thu Jun 4 13:05:33 2009 -0400
+
+ Make PDL require perl 5.6.2 or above.
+
+ CPAN Testers have *no* PASS's on record for any
+ version of PDL for perl 5.6.0 or 5.6.1. This
+ modification makes that more explicit in the
+ configuration process. This is effectively a NO-OP.
+
+ DEPENDENCIES | 2 +-
+ Makefile.PL | 2 +-
+ Release_Notes | 18 ++++++++++++++++++
+ 3 files changed, 20 insertions(+), 2 deletions(-)
+
+commit 23463ebfc2bc40098106ac8b865145cad4195525
+Author: Derek Lamb <lambd at users.sourceforge.net>
+Date: Thu May 28 12:03:23 2009 -0400
+
+ Update FAQ for CVS->Git migration
+
+ Removed references to CVS repos except for auxiliary repositories. Included basi
+ c git instructions, which I'll see if are correct during this push.
+
+ Basic/Pod/FAQ.pod | 97 ++++++++++++++++++++++++-----------------------------
+ 1 files changed, 44 insertions(+), 53 deletions(-)
+
+commit cb8f83e41a27fdcc44600c4ed0d438a39c14f357
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Fri May 22 15:14:40 2009 -0400
+
+ Change $PDL::VERSION to 2.4.4_03git for devel
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit eb60aabbf51831e42d78521db341296caa348bf0
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Fri May 22 15:10:33 2009 -0400
+
+ Fix t/proj_transform to skip when no earth_image()
+
+ Missing jpegtopnm functionality in NetPBM or other
+ causes earth_image() to fail on some platforms.
+ This modifies the test to skip the remaining tests
+ if earth_image() can not be loading. NOTE: we should
+ add better config and tests for the Pic and Pnm
+ image routines.
+
+ t/proj_transform.t | 5 ++---
+ 1 files changed, 2 insertions(+), 3 deletions(-)
+
+commit aec6bc506a26f1f2f093cb7d98775e3d2de18cc6
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Tue May 19 13:09:13 2009 -0400
+
+ Updated Release_Notes and version for PDL-2.4.4_03
+
+ This release includes fixes to date and additional
+ diagnostics for tracking down remaining CPAN
+ testers failures. See the Release_Notes for
+ outstanding problems and path forward. -chm
+
+ Basic/PDL.pm | 2 +-
+ Release_Notes | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ 2 files changed, 62 insertions(+), 1 deletions(-)
+
+commit 5bcc5c51cecdc8636bf969cec6ba934c63eefc53
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Mon May 18 12:02:09 2009 -0400
+
+ Added a few more entries to .gitignore
+
+ .gitignore | 10 +++++++++-
+ 1 files changed, 9 insertions(+), 1 deletions(-)
+
+commit c99ab05fa7153e644287499adf9c057d8c8b90b9
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Mon May 18 10:54:10 2009 -0400
+
+ Added ../Basic/Core to @INC for BAD demo builds
+
+ The build process for the bad value demos used
+ PDL::Config to determine if badvals were enabled.
+ Since Config.pm is not installed until after the
+ compiles, this caused build failures on some systems.
+ I'm not sure why it didn't happen more often.
+ Now we have "use lib '../Basic/Core'" which should
+ make things work here.
+
+ Demos/BAD2_demo.pm.PL | 1 +
+ Demos/BAD_demo.pm.PL | 1 +
+ 2 files changed, 2 insertions(+), 0 deletions(-)
+
+commit c9f86423d5b825d6b06cb7e7ffa6e61325c8e093
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Mon May 18 10:19:52 2009 -0400
+
+ Fixed trylink() error on temp file failure
+
+ Added 'trylink: ' to the file open error message
+ in trylink() from Basic/Core/Dev.pm to allow for
+ better debugging. There may be a problem with
+ $PDL::Config{TEMPFILE} generation that gives bad
+ results for some configurations.
+
+ Basic/Core/Dev.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 6714c8ea95b5c3a7391222de89a99bfd3017bfce
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Mon May 18 10:02:37 2009 -0400
+
+ Added .dll and .dll.a skip patterns in t/
+
+ MANIFEST.SKIP | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 8ec8c134349c8425b52824dbe0a44b5c90600de5
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Mon May 18 10:00:40 2009 -0400
+
+ Added filename diags to rpnm subroutine
+
+ Added the filename tried when rpnm() gives an
+ error about being unable to open a file. I
+ hope this will allow me to track down an ongoing
+ earth_image() failure in CPAN testing.
+
+ IO/Pnm/pnm.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit f20f31ba877faa078bd186817d0afa0855c23f85
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Sun May 17 14:14:12 2009 -0400
+
+ $PDL::VERSION to 2.4.4_02git for development
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit 7f187641b623644c498bc374134e2a683cc5c14e
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Fri May 15 13:15:40 2009 -0400
+
+ Added .git and .inlinepdlpp to MANIFEST.SKIP
+
+ MANIFEST.SKIP | 326 +++++++++++++++++++++++++++++----------------------------
+ 1 files changed, 164 insertions(+), 162 deletions(-)
+
+commit 61334cdf93253905cb72e8912a1c58d139f96172
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Fri May 15 10:12:54 2009 -0400
+
+ Set version to 2.4.4_02 for CPAN devel release
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit e2cb69aeb0fca86f896811f2dc6288cb7f4dffe9
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Fri May 15 09:59:59 2009 -0400
+
+ Turn on diagnostics for 16bit pic tests
+
+ Added notes about need for current NetPBM to
+ get pass with 16bit pic tests. Enabled debug
+ output for t/pic_16bit to get more info on
+ build tests.
+
+ DEPENDENCIES | 7 +++++--
+ IO/Pnm/Pic.pm | 2 +-
+ t/pic_16bit.t | 4 +++-
+ 3 files changed, 9 insertions(+), 4 deletions(-)
+
+commit ded8990f28af63fd8e8aa545f047cbbaad3b409e
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Thu May 14 17:05:56 2009 -0400
+
+ Fixed earth_image() test to make plan count ok
+
+ t/proj_transform.t | 2 ++
+ 1 files changed, 2 insertions(+), 0 deletions(-)
+
+commit b3f8bb88e530bae243841ead026f627fad0d5f8b
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Thu May 14 15:48:17 2009 -0400
+
+ Improved diagnostics and granularity of tests
+
+ This was in response to a failure of this test
+ in CPAN automated testing. It was unclear from the
+ test output what or from where the problem was
+ coming. This adds a couple more checks that should
+ help us locate the problem.
+
+ t/proj_transform.t | 122 +++++++++++++++++++++++++++++-----------------------
+ 1 files changed, 68 insertions(+), 54 deletions(-)
+
+commit be8c0cf0491ffb7f4cc02453bdecedeed56e6d84
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Thu May 14 15:45:21 2009 -0400
+
+ Fix params parsing in load_projection_information
+
+ Removing a spurious comma that resulted in an
+ invalid parameter name. Someone familiar with
+ the PROJ4 binding internals needs to review
+ this function as it looks like there may be
+ other problems here.
+
+ Lib/GIS/Proj/Proj.pd | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit b6143bf6aaff0452e2c6218782130661677109f5
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Thu May 14 15:43:51 2009 -0400
+
+ Change version to 2.4.4_02git
+
+ Basic/PDL.pm | 2 +-
+ 1 files changed, 1 insertions(+), 1 deletions(-)
+
+commit dc3526dd7498a1154f7559fe4139f4fcf0e3eb9d
+Author: Chris Marshall <chm at alum.mit.edu>
+Date: Wed May 13 14:37:14 2009 -0400
+
+ Changes to PDL-2.4.4git for PDL-2.4.4_01 release
+
+ Updated some of the PDL install documents and modified
+ the VERSION for upload to CPAN.
+
+ Basic/PDL.pm | 2 +-
+ DEVELOPMENT | 123 +++++++------------------------------------------------
+ Known_problems | 7 ++-
+ README | 2 +-
+ Release_Notes | 20 +++++++++
+ 5 files changed, 42 insertions(+), 112 deletions(-)
+
+commit d40e805b5964e90742721f017d274333a7ea29fa
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Tue May 5 22:20:49 2009 -0400
+
+ Add arg check for empty piddle to hist function
+
+ The hist routine fails if given an empty piddle to
+ work with. This adds a check for the case where
+ the number of elements in the piddle is zero and
+ barfs appropriately.
+
+ Basic/Core/Basic.pm | 1 +
+ 1 files changed, 1 insertions(+), 0 deletions(-)
+
+commit 4a4059f3813c5e2128dd57e3a7e23f5faf33c280
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Wed Apr 29 18:51:04 2009 -0400
+
+ Added the Changes for the t/pic_16bit.t commit.
+
+ Changes | 4 ++++
+ 1 files changed, 4 insertions(+), 0 deletions(-)
+
+commit 9e239ffb1eb0e52cc67ab2a1c6aff677b3dcb17d
+Author: Chris Marshall <marshallch at users.sourceforge.net>
+Date: Wed Apr 29 18:44:35 2009 -0400
+
+ Fix sf.net bug 2784016
+
+ This fixes sourceforge.net bug number 2784016 originally reported
+ via rt.cpan.org where the t/pic_16bit.t test checked for pnmtopng
+ with a very english specific test. The test has been modified to
+ be less english specific. This is still far from full i8n of PDL.
+
+ t/pic_16bit.t | 4 ++--
+ 1 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/Changes_CVS b/Changes_CVS
new file mode 100644
index 0000000..7928e8b
--- /dev/null
+++ b/Changes_CVS
@@ -0,0 +1,3983 @@
+CHM 29-Apr-2009
+ Fixed bug number 2784016 in t/pic_16bit.t reported via
+ rt.cpan.org. I note that the Changes file might be replaced
+ by the log list from git commits at some point.
+CHM 23-Apr-2009
+ Fixed test 17 in t/plplot.t to use a magnitude difference test
+ rather than equality for the floating point quanitities.
+CHM 22-Apr-2009
+ Applied fix to t/autoload.t per the bug report sf bug #2339726
+ by zowie.
+CHM 22-Apr-2009
+ Fixed bug #2753869 in the interpolation part of the pctover()
+ routine in ufunc.pd. The computation of pctover() and
+ oddpctover() were corrected to improve consistency and
+ agreement with other apps (e.g. MS Excel).
+ and fixed the calculations of the pctover() and oddpctover()
+CED 11-3-2009
+ mkhtmldoc.pl: suddenly stopped making docs, preventing me from
+ executing "Make install". Traced the problem down to a nonexistent
+ directory in the POD scan path (".../HtmlDocs/pdl/PDL"), which for
+ some reason is now crashing the POD builder stuff that came with
+ my MacOS-standard Perl. Since .../pdl/PDL seems like a silly place to
+ look (the docs are build into just .../pdl), I dked out the "PDL" from
+ the pod path, fixing the problem.
+CED 10-3-2009
+ Fix problem with reorder() - formerly required that all dimensions
+ be set; now allows specification of a leading subset of dims in
+ the target. Additional dims are threaded over (i.e. ignored).
+SIS 25-2-2009
+ Amend Basic/Math/math.pd so that Math.xs contains a prototype for
+ the (distro version of) the rint function when (and only when) a
+ Microsoft Compiler is being used. (Rev 1.17 of math.pd)
+ This ifxes sourceforge bug 2630402.
+CHM 13-Nov-2008
+ PDL/Basic/PDL.pm: updated VERSION to 2.4.4cvs for
+ post release development.
+CHM 13-Nov-2008
+ PDL/Basic/PDL.pm: updated VERSION to 2.4.4 for release
+ Known_Problems: updated for release
+ This is PDL-2.4.4 as released to CPAN
+CHM 06-Nov-2008
+ Basic/PDL.pm: changed version to 2.4.3_06 for quick
+ check release of final Makefile.PL mods.
+DAL 05-Nov-2008
+ In top-level Makefile.PL: removed debugging print statement; moved
+ @podpms back to 'pm' so tht the perldl and pdldoc script manuals
+ appear in PDL::Index.
+DCH 03-Nov-2008
+ Added code to XS for PDL::Graphics::PLplot::plParseOpts to
+ avoid a segfault when it is called with no options. Also added
+ test case to plplot.t.
+DCH 03-Nov-2008
+ Took out MY::test subroutine in top-level Makefile.PL.
+ This should restore the complete 'make test' functionality
+ which now works properly after Craig Deforest's fix of
+ 28-Oct-2008.
+CHM 01-Nov-2008
+ perldl.conf: changed default build options to enable bad
+ value support and updated the Release_Notes to advertise
+ the new capability.
+ Basic/PDL.pm: updated VERSION to 2.4.3_05 which will be
+ the official 2.4.4 release once the final updates are
+ complete. Changes updated to reflect these changes.
+CHM 01-Nov-2008
+ Updated Known_Problems and Release_Notes for PDL-2.4.4
+ release to come.
+CHM 01-Nov-2008
+ Graphics/IIS/iis.pd: fixes from patch #1908629 to quiet
+ some gcc udefined operations warnings.
+CHM 01-Nov-2008
+ t/ufunc.t: fixed typo in conversion from is() to ok()
+CHM 01-Nov-2008
+ Basic/Core/pdlcore.c.PL: added case to support creation of
+ longlong piddles with pdl_from_array from patch #2107905
+ on the SF PDL site. Thanks to Pete Ratzlaff.
+CHM 01-Nov-2008
+ Added dragonfly OS to list of BSD flavors requiring the
+ -s flag to uudecode in IO/Dumper.pm.
+CHM 31-Oct-2008
+ Modified t/ufunc.t to use ok() and approximate numerical
+ equality rather than string eq via is() for the tests.
+DAL 29-Oct-2008
+ Graphics/PLplot: changed Makefile.PL and plplot.pd so new 5.9.0
+ (devel release) funcs aren't linked if older PLplot is installed.
+SIS 29-Oct-2008
+ Added a "sub MY::postamble{return ''}" to IO/Dicom/Makefile.PL
+ to prevent the writing of a postamble section which was sometimes
+ happening (with dmake only).
+CED 28-Oct-2008
+ Removed "Gen/pm_to_blib" dependence in Dev.pm - this should fix the
+ Makefile repeated-compile woes. Added some explanatory notes in other
+ Makefile.PL's.
+CED 27-Oct-2008
+ Update Autoload.pm to match bash's (advertised) ~ expansion:
+ - "~+" now expands to current working directory;
+ - "~" now expands to $ENV{HOME} if present, *then* system-advertised
+ home directory;
+ - "~name" expands to system home dir for user "name" (previous behavior).
+ No support for "~-", since Perl doesn't keep an $OLDPWD around.
+SIS 27-Oct-2008
+ Small fix to autoload.t so that it passes on Win32. (Only
+ 2 tests were planned for Win32, but 3 were being run.)
+CHM 26-Oct-2008
+ Modified t/bad.t test to use like() with a regexp rather
+ than is() for some tests where the value returned had
+ -0 and the test was checking with 0.
+ Basic/PDL.pm: updated VERSION to 2.4.3_04
+CHM 25-Oct-2008
+ Basic/PDL.pm: update VERSION for PDL-2.4.4 pre-release 3
+CHM 25-Oct-2008
+ Makefile.PL: enabled bad value options when built within an
+ automated testing framework such as used by CPAN Testers.
+ This should improve the test coverage and allow us to better
+ evaluate whether BADVAL can be enabled by default.
+CHM 25-Oct-2008
+ Lib/GIS/Proj/Makefile.PL: added trylink to verify PROJ4 version is
+ recent enough, skip build otherwise.
+ Makefile.PL: explicitly require 5.6.x or above perl version now.
+CHM 25-Oct-2008
+ t/autoloader.t, t/dumper.t: switched code from Test to Test::More and
+ added better diagnostic messages in the hopes of tracking down the
+ problems on darwin and freebsd.
+CHM 22-Oct-2008
+ t/inlinepdlpp.t: use non-standard Inline working directory for testing
+ and force builds to fix problem with out-of-synch Inline cache and config
+CHM 22-Oct-2008
+ IO/Dumper.pm: the fix to use 'uudecode -s' with *bsd coming from bug #1573217
+ does not apply to NetBSD as that uudecode does not strip leading slashes.
+ Removed the "fix" code for the case of netbsd
+DCH 22-Oct-2008
+ Made change to MY::test to only run toplevel tests for 'make test'
+ Do not attempt to build all of PDL, or attempt to look for and run subdirs tests.
+ Also commented out some debug print statements in t/storable.t which caused warnings
+ during 'make test'.
+CHM 19-Oct-2008
+ Basic/PDL.pm: change VERSION to 2.4.3_02 to indicate mods beyond
+ the PDL-2.4.3_01 developers release just posted to CPAN
+CHM 19-Oct-2008
+ Basic/PDL.pm: change VERSION to 2.4.3_01 for developers release
+CHM 19-Oct-2008
+ TODO: this file is out-of-date and is so noted for PDL-2.4.4
+ README: added pointers for bug reporting via sf.net for PDL-2.4.4
+ Known_Problems: updated for PDL-2.4.4 release
+ INSTALL: updated general install notes and added bug report info
+ DEVELOPMENT: fixed reference to mailing lists locations
+ DEPENDENCIES: updated list of dependencies for PDL-2.4.4.
+ BUGS: updated the bug reporting information.
+CHM 19-Oct-2008
+ PDL/Graphics/TriD{TriD.pm,TriD/{ButtonControl.pm,Control3D.pm,GL.pm,Object.pm}}
+ Removed explicit return calls in TriD constructors fixed to use
+ fields::new() construction. This was the original coding style
+ and may be required for Lvalue subroutine support. Tests still
+ passed but in returning to the original usage without a return
+ just in case for 2.4.4.
+SIS 19-Oct-2008
+ Switch off 3D in perldl.conf for Win32 (rev 1.49). Otherwise, the latest
+ changes to Graphics/Makefile.PL break the build process for some versions
+ of File::Find.
+CHM 19-Oct-2008
+ t/proj_transform.t: added test skip if PDL not configured with bad value
+ support since the test appears to require bad value processing to succeed.
+ This addresses sourceforge bug #2022265.
+CHM 18-Oct-2008
+ PDL::Graphics::Makefile.PL: folded in patch from rt.cpan.org PDL bug
+ #30276 reporter which improves the logic for finding the xdpyinfo command
+ for TriD configuration. The sourceforge bug corresponding is #1994614.
+CHM 18-Oct-2008 EDT
+ PDL/Graphics/TriD{TriD.pm,TriD/{ButtonControl.pm,Control3D.pm,GL.pm,Object.pm}}
+ Replaced direct FIELDS access in field based constructors with fields::new() to
+ fix problem with 5.10 where the pseudohash implementation has been eliminated.
+SIS 19-Oct-2008
+ In Basic/Core/pdlthread.c, replace the few remaining malloc calls with Newx.
+ (Rev 1.8)
+DCH 17-Oct-2008
+ Updated PLplot: Added several new low-level functions, added the
+ 'stripplots' high level function. Also enhanced the Makefile.PL
+ to make the stand-alone version of PDL::Graphics::PLplot work better
+ for CPAN installs. Finally, applied a patch to Basic/Primitive/Makefile.PL
+ to allow proper srand behavior, permitting the primitive.t tests to work.
+CHM 14-Oct-2008
+ perldl: Added FreeGLUT event loop support to perldl in analogy with
+ the existing Tk event loop support.
+SIS 12-Oct-2008
+ Addition of link to bufferoverflowu.lib in CallExt.pm's callext_cc()
+ for Windows x64 builds only (rev 1.9).
+SIS 11-Oct-2008
+ In top level Makefile.PL remove EU::F77 from PREREQ_PM, and fix
+ $PDL::Config{TEMPDIR}, which I broke for non-Windows systems with the
+ changes made on 8 Oct.(This latest change is rev 1.68 )
+ Also a Windows-only change to Basic/Core/Dev.pm (rev 1.33) as part of the
+ change to $PDL::Config{TEMPDIR}.
+SIS 09-Oct-2008
+ Amend Lib/Slatec/Makefile.PL (rev 1.17) so that '*make realclean' doesn't
+ clobber libg2c.a and libgcc.a when a Microsoft compiler is in use.
+ Amend Lib/Minuit/Makefile.PL (rev 1.5), Basic/Core/pdl.h.PL (rev 1.13)
+ and Basic/Gen/PP.pm (rev 1.49) to enable Minuit to build with Microsoft
+ compilers. (All of these changes should be invisible to other compilers.)
+SIS 08-Oct-2008
+ Amend top-level Makefile.PL so that File::Temp->tmpdir() is assigned to
+ Config.pm's $PDL::Config{TEMPDIR}. (This is so that Windows PPM packages
+ will function correctly). Rev 1.67
+CHM 07-Oct-2008
+ Basic/Core/Core.pm.PL: fixed alias creation to avoid compile warnings
+CHM 07-Oct-2008
+ Basic/Core/Core.pm.PL: Added zeros convenience aliases for zeroes.
+ This is matches common American English and Matlab usages and is
+ one letter shorter to type.
+SIS 06-Oct-2008
+ ExtUtils::F77->runtime not providing the required format for MSVC compilers.
+ A minor fix put in place in Lib/Slatec/Makefile.PL to correct this. Rev 1.16
+CHM 18-Sep-2008
+ Lib/GSL/INTEG/FUNC.c, Lib/GSL/INTERP/gsl_interp.pd, Lib/GSL/MROOT/FUNC.c
+ Quieted pointer cast compiler warnings by replacing with calls to the
+ INT2PTR() macro of the Perl API. This fixes sf.net tracker bug #1356282.
+CHM 17-Sep-2008
+ Lib/GSL/RNG/gsl_random.pd, Lib/GSL/RNG/typemap - added INT2PTR() macros
+ to prevent typecast warnings (sourceforge bug tracker #1356282)
+CHM 14-Sep-2008
+ perldl.PL - added $PERLDL::HISTFILESIZE to control the number of lines
+ history saved. Updated docs and incremented VERSION to 1.34.
+CHM 10-Sep-2008
+ t/pic_16bit.t - Added test for pnmtopng with corresponding skips to prevent
+ PDL test failure due to NetPBM not being installed with a diagnostic to
+ point out the possible problem.
+CHM 27-Jul-2008
+ t/matrixops.t - Added tests for SF bug #2023711 as an active placeholder for
+ the problem. It was threading that allowed two piddles such as: [5,2] and
+ [[5,2],[5,2]] to test as equal with a check such as abs($a - $b) since the
+ result was [[0,0],[0,0]] with all elements suitably small...
+CHM 20-Jul-2008
+ IO/GD/GD.pd - Fixed warning messages about 'cast to pointer from integer
+ of different size' by use of INT2PTR() and PTR2IV() Perl API macros rather
+ that a raw typecast. No warnings now and all tests still pass on cygwin.
+CHM 19-Jul-2008
+ Basic/Ufunc/ufunc.pd - Fixed bug #2019651 in the pctover() routine, some minor
+ changes to the index calculations and some bounds checks to avoid out-of-range
+ indexing problems. Added a doc ref to the algorithm used.
+ t/ufunc.t - added new test to verify the reported bug
+CHM 19-Jul-2008
+ Fixed Basic/Pod/FAQ.pod: updated version to 0.8 and added an entry on
+ installing PDL into non-standard locations. Yes, it is just a standard
+ perl module in that respect but this should make it easier for first
+ time perl users to configure.
+CHM 19-Jul-2008
+ Fixed VERSION in Basic/PDL.pm to indicate cvs
+CHM 18-Jul-2008
+ Proj.pd, Lib/GIS/Proj/Proj.pd, fix undefined reference to _pj_list.
+SIS 18-Jul-2008
+ Minuit Makefile.PL (for Microsoft compilers only) now uses LDFROM instead of OBJECT. (rev 1.4)
+DAL 09-Jul-2008
+ pdl.PL - manually create blib/bin directory. Old EU::MM's don't make it.
+ pdlcore.h.PL - update prototypes for pdl_setav_$type.
+CED 09-Jul-2008
+ Makefile.PL, Basic/Gen/Makefile.PL - fix bug #1994598 - circular dependency problems.
+CED 09-Jul-2008
+ Basic.pm - update documentation for xvals, yvals, zvals, allaxisvals. Merge allaxisvals and ndcoords. Fixes bug 1968382.
+CED 08-Jul-2008
+ update pdlcore.c.PL - fix the pdl_setav_$type and pdl_kludge_copy routines to fix bug 1540548. Add appropriate tests.
+CED 07-Jul-2008
+ update matrixops.pd - simple switcher to semi-broken SSL eigens function in non-symmetric case,
+ together with a warning message.
+DAL 03-Jul-2008
+ Lib/Minuit/minuit.pd - fix call to mn_cierra (close) which prevented the log file from being closed.
+DAL 02-Jul-2008
+ t/minuit.t - fix to get around win32 logfile unlinking problem.
+DAL 27-Jun-2008
+ Lib/Func.pm - fixed small typo in documentation
+ Basic/Ops/ops.pd - re-fixed spaceship operator docs. Also added BU_MOD macro for byte, ushorts to squash compile warnings (bug 1998037).
+ pdl.PL - use $Config{cc} to compile, output now goes to blib/bin
+ Makefile.PL - modified @exe_files and $cleanup to account for new pdl binary executable build location (bug 1747307)
+DAL 17-Jun-2008
+ Lib/Slatec/slatec.pd - avoided namespace collision with PDL::FFT.
+ Basic/Matrix.pm - commented out buggy vcrossp & crossp functions.
+ Built-in crossp works fine for PDL::Matrix objects.
+ Basic/Core/Basic.pm, Basic/Pod/Impatient.pod - finally removed docs error which said '~' overloaded transpose.
+ Basic/Ops/ops.pd - fixed documentation for spaceship operator
+ t/minuit.t - output goes to temp (deleted) file instead of log.out
+ Lib/Gaussian.pm - Added note to Bugs section calling the module unusable.
+ MANIFEST, MANIFEST.SKIP - removed, added Lib/Gaussian.pm
+CED 15-Jun-2008
+ Lib/Gaussian.pm - updated sumover calling (bug 166107)
+CED 15-Jun-2008
+ Graphics/Makefile.PL - hacked openGL search path for (net|open|free)bsd, following Chris Marshall's path in bug 1573215.
+CED 15-Jun-2008
+ IO/Dumper.pm: fixed uudecode flags for (net|open|free)bsd, following 1573217.
+CED 15-Jun-2008
+ Graphics/Makefile.PL; Lib/Transform/Proj4/Makefile.PL; Lib/GIS/Proj/Makefile.PL: added references to lib64 directories... (bug 1465414)
+CED 15-Jun-2008
+ pdlcore.c.PL: fix comment style (fix bug 1339530)
+CED 10-Jun-2008
+ Minor fix to boundary conditions in transform.pd; stand by for more fixes to a bug Derek just discovered.
+DAL 12-Jun-2008
+ Prevent PDL::IO::Storable from clobbering %PDL::Config.
+DAL 09-Jun-2008
+ Incorporated Doug Hunt's 02-Apr-2008 Perldl.pm patch (bug 1552208).
+SIS 09-Jun-2008
+ Some minor win32-specific changes to t/pic_16bit.t (rev 1.2)
+DAL 08-Jun-2008
+ Incorporated Hazen Babcock's 18-May-2007 PLplot patch for drawing
+ several windows simultaneously.
+CED 19-Apr-2008
+ Added basic table-inversion to t_lookup. It's craptacularly slow but
+ it works.
+SIS 10-Apr-2008
+ In Basic/Core/Core.xs.PL, create $PDL::SHARE multiply defined.
+ Changed:
+ sv_setiv(Perl_get_sv("PDL::SHARE",TRUE), PTR2IV(&PDL));
+ to:
+ sv_setiv(get_sv("PDL::SHARE",TRUE|GV_ADDMULTI), PTR2IV(&PDL));
+ (rev 1.32)
+DAL 07-Apr-2008
+ IO/FITS/FITS.pm: Fixed rfits so if NAXIS3!=0 && NAXIS==2 it
+ doesn't create an empty dim. Fixed wfits so if writing a slice of
+ a pdl it doesn't create header fields for the extra dims.
+ t/fits.t: added test numbers to help in debugging
+DAL 05-Apr-2008
+ Lib/FFT/fft.pd: fixed overflow error for integer input data.
+ t/fft.t: Uncommented a test that was a victim of this problem.
+ Added Lib/Minuit/.cvsignore
+CED 3-Apr-2008
+ Basic.pm: transpose() is nicer now (fixed bug 1750912)
+ complex.pd: fixed several dependency issues to other modules (3 bugs).
+DAL 08-Feb-2008
+ Small fix to lines in Graphics/PGPLOT/Window/Window.pm if the
+ run-length-encoded pen piddle was as long as the piddle itself.
+DAL 13-Jan-2008
+ Fixed bug in Basic/Primitive/primitive.pd that caused uniqvec to
+ fail if all the input vectors were the same. Fixes bug #1869760,
+ which duplicated bug #1544352, which was resolved by CHM patch
+ #1548824. Added test case to t/primitive.t to test for this bug.
+SIS 17-Dec-2007
+ In Lib/Minuit/Makefile.PL remove the MYEXTLIB assignment (for win32 only) - rev 1.3
+CHM 14-Dec-2007
+ Fixed IO/Pnm/pnm.pd to support 16-bit image format IO with rpic()
+ and wpic(). Added basic t/pic_16bit.t to test the functionality
+ with PNM and PNG grayscale images.
+DAL 11-Dec-2007
+ Removed print statement in Lib/FFT/fft.pd that crept in during debugging.
+SIS 10-Dec-2007
+ Some versions of EU::MM want to write a postamble in Lib/Makefile that kills dmake.
+ Add a sub MY::postamble to Lib/Makefile.PL that takes care of the issue. (rev 1.9)
+AJ 30-Nov-2007
+ syntax update in minuit.t
+CED & DAL 29-Nov-2007
+ Lib/FFT - fixed problem with floating-point ffts
+AJ 27-Nov-2007
+ Fixes to PDL::Minuit
+DAL 12-Nov-2007
+ Inserted logic to suppress warnings from PDL::Transform during 'make test'.
+ Updated the FAQ with new mailing list info.
+CED 6-Nov-2007
+ PDL::AutoLoader - changed goto to a pass-through sub call, to avoid problems with
+ autoload files that leave stuff on the stack (e.g. subs with Inline or XS definitions).
+ By not goto'ing, we avoid scrozzling the stack in such cases.
+ PDL::NiceSlice - add some (masked-out) debug prints in perldlpp()
+ perldl - make the acquire/filter/execute loop $_-safe by using $lines instead of $_
+ for all the central modifications. Avoids problems with some AUTOLOAD
+ functions that leaked $_.
+CED 5-Nov-2007
+ PDL::NiceSlice - fixed use/no problems, both in eval and non-eval cases (I think).
+HG 16-Oct-2007
+ Lib/GSL/Makefile.PL: fix the gsl version check for minor versions bigger than 10
+ Lib/Fit/Gaussian/gaussian.pd: include "use PDL;" in synopsis
+DAL 30-Aug-2007
+ slices.pd: Fixed bug in range's negative size handling for ND piddles.
+CED 23-July-2007
+ slices.pd: Fixed negative-range problem (bug 1758614): disallow negative
+ sizes in ranges.
+ transform.pd: fixed bug in t_lookup table declaration
+CED 13-Jun-2007
+ Fixed sign error in t_fits (transform.pd) CROTA interpretation
+AJ 21-Jun-2007
+ Added PDL::Minuit
+ Modified recovery mechanism in PDL::GSL::INTEG
+DAL 13-Apr-2007
+ Fixed subtraction error (previously introduced by me) in t/primitive.t.
+CED 12-Apr-2007
+ Add qsortveci to ufunc.pd, to round out the complement of qsort
+ methods.
+DJB 18-Mar-2007
+ Internal clean up of Basic/Core/pdlthread.c; v1.6 used its own copy
+ of strndup to copy arrays whereas we now (v1.7) use the Perl C API
+ (Newx/CopyD/Safefree). This should be invisible to the user.
+ + changed dates below from 2006 to 2007:-)
+DAL 14-Mar-2007
+ Fixed previous (09-Mar) fix; t_identity was not the right solution.
+DAL 09-Mar-2007
+ PDL::Transform::t_fits now returns t_identity if there is no good xform.
+DAL 06-Mar-2007
+ Fixed bug in setops (Basic/Primitive/primitive.pd) which broke 'OR'. Added
+ support for sets with non-unique elements, which broke all set operations.
+ Added tests in t/primitive.t for setops.
+ Fixed t/pgplot.t interactive tests.
+ Fixed typo in cat docs (Basic/Core/Core.pm.PL).
+SIS 30-Dec-2006
+ Skip the second test in autoload.t on Microsoft Windows (autoload.t rev 1.4)
+DAL 28-Nov-2006
+ Fixed AutoLoader tilde expansion bug, added test to t/autoload.t
+DAL 21-Nov-2006
+ Fixed window-closing bug in the regular PGPLOT demo. Small documentation fix for convolveND in Lib/ImageND/imagend.pd.
+CED 24-Oct-2006
+ fix inverted logic bug in t_perspective inplace access (Transform/Cartography)
+DAL 23-Oct-2006
+ Fixed annoying operator precedence warning in Cartography.pm
+CED 13-Oct-2006
+ Fix Transform off-by-1/2 bug with pixel addressing; add transform.t
+ Fix uniqvec bug in primitive.pd
+DAL 11-Oct-2006
+ Minor PGPLOT/PGPLOT.pm and PGPLOT/Window/Window.pm documentation fixes.
+SIS 24-Sep-2006
+ Minor re-arrangement to the code in Lib/GSL/MROOT.c required for
+ Microsoft compilers (rev 1.2).
+SIS 17-Sep-2006
+ Enable 'BUILD_NOISY' in Pdlpp.pm on Win32 (rev 1.10).
+ Small cleanup of the code that sets the temp directory in the top level
+ Makefile.PL (rev 1.64).
+HG 15-Sep-2006
+ Extend the 64bit-architecture test in t/flexraw.t and include ia64 in
+ the blacklist
+SIS 11-Sep-2006
+ Enable building of GSL on Win32.
+ Changes to Lib/GSL/DIFF/Makefile.PL (rev 1.3), Lib/GSL/INTEG/Makefile.PL
+ (rev 1.3), Lib/GSL/INTERP/Makefile.PL (rev 1.3), Lib/GSL/RNG/Makefile.PL
+ (rev 1.5), Lib/GSL/SF/Makefile.PL (rev 1.5), Lib/GSL/MROOT/Makefile.PL rev 1.2.
+ Also needed a slight tweak to Basic/Core/Dev.pm's pdlpp_stdargs_int (rev 1.32).
+DJB 07-Sep-2006
+ Continued work on Basic/Gen/PP.pm (revision 1.48). This deals with the old
+ subst_makecomp routine moving to PDL::PP::Rule::MakeComp.
+ Added an explicit test of assgn to t/bad.t
+ Converted t/gsl_interp.t to use Test::More.
+DJB 06-Sep-2006
+ Converted t/gsl_mroot.t to use Test::More and fixed a bug that
+ caused it to fail when PDL::GSL::MROOT is not installed.
+DJB 02-Sep-2006
+ Continued work on Basic/Gen/PP.pm (revision 1.47)
+AJ 01-Sep-2006
+ Added PDL::GSL::MROOT
+SIS 1-Sep-2006
+ Remove dmake clause from pdlpp_postamble() in Basic/Core/Dev.pm.
+ Revision 1.31.
+DJB 31-Aug-2006
+ Re-worked Basic/Gen/PP.pm to use objects for the $PDL::PP::deftbl
+ array rather than array references, since using objects just has
+ to make things easier to read :-) There should be purely an internal
+ change. This is revision 1.46.
+ Basic/Gen/PP/PDLCode.pm has also seen a few minor changes (again
+ purely internal). This is revision 1.7
+CHM 24-Aug-2006
+ Fix qsortvec function resolving bug #1544590 on sourceforge.
+ Really need to add tests corresponding to bugs with the fixes.
+ TBD.
+SIS 25-Aug-2006
+ Remove the 'goto' in Graphics/IIS/Makefile.PL - was causing a problem
+ on some builds of Win32 perl. (Revision 1.2)
+DJB 24-Aug-2006
+ Changed Basic/Gen/PP.pm so that it is now all run under ;use strict'.
+ There should only be an internal change (this is revision 1.45)
+DAL 22-Aug-2006
+ Fixed a minor typo in FAQ.pod and a small doc change to Fit::Gaussian.
+DJB 22-Aug-2006
+ Cleaned up t/slice.t to use Test::More. This was in an attempt
+ to help track down the message reported during 'make test':
+ "(in cleanup) index out-of-bounds in range during global destruction."
+ However, the conversion seems to have removed this message...
+CHM 20-Aug-2006
+ Merged 2.4.3 development fixes into main CVS trunk.
+CHM 17-Aug-2006
+ Updated rel_2_4_3pre_branch with debian fixes by HG and
+ added the decided upon fix for HDF/Makefile.PL for the
+ PM location.
+CHM 16-Aug-2006
+ perldl.conf, IO/FITS/FITS.pm
+ - fixes for $PDL::Config{FITS_LEGACY} to turn off all
+ the zillion Astro::FITS::Header warning messages
+ Graphics/Makefile.PL
+ - fix GLX test not to ignore user forced WITH_3D=>1
+ cygwin/INSTALL, cygwin/README
+ - update some of the cygwin/ install notes based on
+ recent testing and module fixes
+ will be tagging these fixes as rel_2_4_3pre2
+CHM 14-Aug-2006
+ Touch up top level documentation files and add some config
+ files to PDL/cygwin/. Files changed: BUGS, COPYING,
+ DEPENDENCIES, DEVELOPMENT, INSTALL, Known_problems, README,
+ Release_Notes, cygwin/INSTALL, cygwin/README.
+CED 13-Aug-2006
+ Fixed typo with CI_J matrix declaration in t_fits code
+ (transform.pd); allows use of CI_J matrices in FITS headers as per
+ the newer WCS standard)
+CED 13-Aug-2006
+ - Minor fixes to Transform -- t_fits CI_J header notation;
+ also: dims copied between params and main object in
+ t_spherical and t_projective.
+CHM 11-Aug-2006
+ - Added Astro::FITS::Header as a PREREQ_PM in main Makefile.PL
+ - Added to DEPENDENCY file list
+ - Put preliminary notes on how to migrate an externally
+ developed PDL module into the source tree for distribution
+ with PDL
+CHM 11-Aug-2006
+ Fix Graphics/Makefile.PL be more conservative in deciding to
+ build OpenGL and TriD when WITH_3D => undef. Now choose not
+ to build if the xdpyinfo command does not indicate available
+ GLX extensions for the current X server display. This
+ should prevent test failures due to some OpenGL X config
+ problems.
+DCH 10-Aug-2006
+ Changed slatec.t test from:
+ ## Test: chia
+ $x = float( sequence(11) - 0.3 );
+ to
+ ## Test: chia
+ $x = double( sequence(11) - 0.3 );
+ This allows this test to work on a 64 bit machine (AMD x86_64)
+ Also, skip the flexraw.t tests for x86_64 (these tests only
+ apply to 32 bit machines)
+DCH 10-Aug-2006
+ Changed from $ENV{HOSTTYPE} to $Config{archname} for x86_64 check
+ in order to set -fPIC compiler flag.
+CHM 09-Aug-2006
+ Updated Known_problems and minor doc fix.
+CHM 08-Aug-2006
+ Fixed t/proj_transform.t to skip_all if WITH_BADVAL not set so
+ with Judd Taylor fixes from earlier today all PROJ4 modules
+ now build and test on PDLrc1. Thanks all for testing a fixes!
+DAL 01-Aug-2006
+ Fixed typo in t_spherical of transform.pd (closes bug 1530666).
+CHM 30-Jul-2006
+ Updated release notes in preparation for 2.4.3 release.
+ Known_Problems will follow.
+CHM 27-Jul-2006
+ Created cygwin/ directory with first drafts of README and
+ INSTALL files for Cygwin users.
+CHM 26-Jul-2006
+ Minor wording changes to skip_all messages for test output
+ to improve readability.
+DJB 24-Jul-2006
+ Fix for valgrind-detected error when WITH_BADVAL option selected.
+ There was an invalid read due to $PRIV(bvalflag) being checked after
+ $PRIV() was invalidated (by a call to PDL->make_trans_mutual).
+ The code changes (e.g. see copybadstatus in PP.pm) indicate there is
+ some future code cleanup/optimisations that could be made, but leave
+ for post 2.4.3 work.
+
+ Stop the "re-defining PERL_UNUSED_DECL" warnings from perl 5.8.8 by
+ updating the ppport.h from the latest Devel::PPPort (v3.09). Removed
+ ppport.h copy in Graphics/PGPLOT/Window/.
+DJB 22-Jul-2006
+ Fix to pdlcore.h.PL to avoid valgrind warning: rev1.26 put the
+ setting of the debug_flag inside an ifdef but the variable is used
+ to decide whether to print out a warning about pdl_setav_<type>
+ converting undef's to $PDL::undefval. Easiest solution is to remove
+ the ifdef (could have removed the use of debug_flag in the if statement
+ instead).
+CED 18-Jul-2006
+ - PDL.pm: added help cross-reference to pdl()
+ - t/core.t: add three constructor tests
+ - pdlcore.c.PL: Fix a more obscure problem with constructor
+ - pdlcore.c.PL: Fix problem with constructor
+ (pdl( zeroes(100), ones(10)) case)
+DJB 10-Jul-2006
+ Fix up compile warnings in Core/ seen on Solaris
+ - moved pdl_freedata from pdlhash.c to Core.xs.PL
+ - added pdl__print_magic to pdlmagic.h (for pdlapi.c)
+ - include sys/mman.h for pdlmagic.c (if USE_MMAP defined)
+ Minor pod fixes to primitive.pd
+CHM 09-Jul-2006
+ Fix skip_all output for t/fftw.t and plplot.t.
+CHM 08-Jul-2006
+ Update flexraw.t, gd_oo_tests.t, gd_tests.t,
+ gis_proj.t, hdf_sd.t, hdf_vdata.t, hdf_vgroup.t,
+ inlinepdlpp.t, ndf.t, pgplot.t, and proj_transform.t
+ test scripts to use Test:More and skip_all to report
+ when a test is completely skipped due to major
+ functionality missing or not available.
+ The original skip method was to reduce the number
+ of planned tests to 1 and then to skip that *single*
+ test (subtest, actually). It was not possible to
+ tell from the "make test" harness output that the
+ functionality being tested was not available at
+ all or even installed!
+ These changes set the plan output for these
+ missing functionality tests being skipped to "1..0"
+ which is reported as "<testfile>...skipped" followed
+ by "all skipped: <explanation>" The output from
+ "make test" now indicates if something is missing
+ from the build/install.
+DJB 29-Jun-2006
+ Updated $pdl_core_version in pdlcore.h.PL to 6 since the code for the
+ experimental BADVAL_PER_PDL feature added fields to the Core struct
+ (see 'pdldoc Internals' for info on why the variable needs to be
+ updated).
+ *** Warning: this means that - once this change is built and
+ installed - any external module that uses the C interface of PDL will
+ have to be re-built/installed (they'll complain and refuse to run until
+ you do so).
+DAL (24-Jun-2006)
+ Added FAQ question (#6.22) showing how to get PGPLOT to write PNG files.
+ Also updated the CVS commands in the FAQ.
+HG (22-Jun-2006)
+ Fix the TriD::OpenGL build issue with newer X installations by
+ importing Bill Coffman's patch for Graphics/TriD/OpenGL/opengl.pd
+ (closes bug #1505132)
+DJB 20-Jun-2006
+ Attempt to clean up building of Basic/MatrixOps:
+ - fix a nan issue on Solaris (use atof("NaN") ratehr than nan(""))
+ - moved source code from ssl/ sub-directory into parent so that
+ we do not have to try and write our own Makefile for these
+ files (with attendant OS/system complexities) but let Perl
+ worry about it all
+DJB 19-Jun-2006
+ The experimental BADVAL_PER_PDL feature can not (currently) be
+ combined with BADVAL_USENAN. The build now detects this conflict
+ and turns off BADVAL_USENAN. The docs need updating to discuss
+ this option!
+CED (16-Jun-2006)
+ Work around -0 problem on macOS 10.4 PPC: some numbers (notably
+ constructions of the form "pdl( 5 ) % 5") yield a value of
+ "-0" rather than "0" under that OS. Fix is in the pdl_at routine
+ in core/pdlsections.g: forces 'c'-false values to be truly 0 during
+ export to perl. The hack is accomplished via -DMACOS_MZERO_BRAINDAMAGE,
+ so the (infinitesimal) CPU cost doesn't affect other platforms.
+CHM (12-Jun-2006)
+ Fix to GD portion [only] re sourceforge bug #1493056:
+ - Replace pdlpp_postamble() call in PDL/IO/GD/Makefile.PL with the
+ same call to pdlpp_postamble_int(). Don't know the details but this
+ puts the right blib path includes for PDL::IO::GD to build on clean
+ perl (no previous PDL install).
+ - Removed "use PDL;" from GD.pd which broke the GD build process
+ without a pre-existing PDL install.
+ - Removed cygwin workaround for WITH_GD setting in perldl.conf.
+CED (6-Jun-2006)
+ (finally) fix TriD rotation bug. What an evil crock that module is!
+CED (4-Jun-2006)
+ Fix Makefile.PL for Proj -- now doesn't attempt to build proj modules
+ when proj is not present on the system.
+CHM (30-May-2006)
+ Fix t/flexraw.t to use eval to prevent a missing IO::String module
+ from preventing the test to run. IO::String is required for perls
+ before 5.8.0. The perlio for 5.8.0 and later perls supports the
+ same functionality with the native open call.
+CHM (29-May-2006)
+ Fix perl Makefile.PL build process to allow TriD (OpenGL) to build on
+ cygwin.
+ - Graphics/Makefile.PL -- set OPENGL_LIBS, OPENGL_DEFINE, OPENGL_INC
+ - Graphics/TriD/Makefile.PL -- add *.dll.a to @patterns to test
+ Cygwin now builds out of the box with base modules and TriD(OpenGL)
+ and PLplot (need to have plplot bin directory in PATH for tests to
+ pass).
+CHM (28-May-2006)
+ Fix Graphics/PLplot/Makefile.PL to allow plplot to build on cygwin.
+Chris Marshall-a.k.a. CHM or marshallch (28-May-2006)
+ Updated Changes file to reflect CVS submissions on 22-May-2006 to
+ incorporate accumulated patches to allow PDL to build on cygwin
+ unix environment. The patches close bug 1093510 and affect the
+ following files:
+ - Makefile.PL (fixed to specify .exe extension for binary file installs)
+ - Lib/GSL/SF/coulomb/gsl_sf_coulomb.pd (fixed typo)
+ - Lib/GSL/SF/poly/gsl_sf_poly.pd (fixed typo)
+ - t/flexraw.t (added line wrap into f77 continuation lines to handle cases
+ where lines longer than 72 chars were being generated; worked around a
+ problem with a subtest using the compress command---on cygwin this is a
+ non-functional "reminder" script---gzip was used instead)
+ - perldl.conf (set cygwin default to skip new GD and Proj modules until a
+ build issue can be investigated, a bug report has been submitted)
+ Base PDL now builds with the default CVS code. Work continues to fix issues
+ with TriD(OpenGL), PLplot, FFTW, and PGPLOT.
+JT (12-Apr-2006)
+ Added the PDL::IO::GD module, and tests.
+JT (5-Apr-2006)
+ Added the PDL::GIS::Proj and PDL::Transform::Proj4 modules and
+ matching tests to t/ directory.
+DAL (5-Apr-2006)
+ FAQ update. Perl/PDL versions, links, etc. No new questions added.
+ Fixes bug 88964.
+SIS (2-Apr-2006)
+ Fix bug that in Lib/Slatec/Makefile.PL that could prevent the
+ Makefile from being written.
+ Have Basic/Core/Dev.pm's pdlpp_postamble() return nothing for dmake.
+ (A call to pdlpp_postamble() was breaking dmake - but dmake has not yet
+ needed such a postamble anyway.)
+JT (29-Mar-2006)
+ Added in the PDL::IO::HDF module, version 2.0, which has been
+ extensively reworked (see the Changes doc in that dir for more
+ info on those changes). Added new entries to the perldl.conf file,
+ modified some of the Makefile.PL's to have that build, and added
+ test files to the t/ directory.
+ This also fixes bugs 1432707 and 1432720.
+
+JLC (23-Mar-2006)
+ Fixed bug in PDL::Complex::initialize that caused problems when
+ using PDL->cat with PDL::Complex objects. Added to the complex.t
+ test case to check for this condition.
+SIS (21-Mar-2006)
+ 'use blib;' added to Demos/BAD_demo.pm.PL and Demos/BAD2_demo.pm.PL to work around
+ EU::MM-6.30 bug.
+SIS (19-Mar-2006)
+ Alteration to Basic/Core/Makefile.PL to enable proper inclusion
+ of badvalues on nmake-built PDL (Win32 only).
+SIS (18-Mar-2006)
+ Small change to Basic/Core/Core.xs.PL's at_bad_c function so
+ it will compile with Microsoft compilers.
+CED (17-Mar-2006)
+ Test & Incorporate patch 1093515 - Marshall's fits.t mod
+ Test & Incorporate patch 1095517 - Klein's badval support
+ Test & Incorporate patch 1099405 - Klein's per-PDL badval support.
+ (per-PDL badval support currently breaks the test suite and should be
+ considered experimental only.)
+ Remove debugging lines from 1151418 fix (yesterday)
+CED (16-Mar-2006)
+ Fix bug 1176634 (zeroes/ones from derived classes, e.g. Complex)
+ Test & Incorporate patch 1176619 (formatting of Complex values)
+CED (15-Mar-2006)
+ Fix bug 1151418, problems with bad values in matrix multiplication (actually inner).
+ Also: try to debug slatec under 64 bits...
+CED (14-Mar-2006)
+ IO/Dumper.pm: Fix bug in dumper.t in UU:convert-only case
+ t/slatec.t: instrument Slatec test
+DAL (14-Mar-2006)
+ In Primitive.pd, the uniq family of functions now behave properly when
+ the input piddle has bad values.
+CED (10-Mar-2006)
+ 1338982 (obscure bug reading a FITS file)
+ 1220830 (problems with $#$-type scalars in SvPDLV)
+ - take 2
+CED (10-Mar-2006)
+ Fixed bugs:
+ 1435138 (problems with compress on Suse 9.3)
+ 1386260 (installation fixes for 64bit linux)
+ 1350149 (fatal typo in Graphic::TriD::Rout)
+ 1350130 (conflicting defines in Graphics/IIS)
+ 1262194 (bad quoting in Core/Dev.pm require statment)
+ 1209924 (range() truncate is not setting values bad when truncating)
+CED (9-Mar-2006)
+ Finished fixing the TriD code. The problem had to do with the
+ codewalker that harvests function definitions and typedefs from the
+ GL header files. The solution involves passing the header files through
+ the C preprocessor to handle compile-time switching, autogenerating
+ simple typemap declarations from typedefs, and fencing the header
+ files so that function definitions from included files are not
+ detected by the harvester. Blech. Someone really needs to overhaul
+ this stuff. I really hope it's not me.
+CED (8-Mar-2006) Added -fPIC to Makefile.PL on 64-bit platforms;
+ attempted to make TriD work on 64 bit platforms (not yet successful --
+ will check in fix later).
+SIS (14-Feb-2006) Changes to top level Makefile.PL, Core/Basic/Makefile.PL, and
+ Core/Gen/Makefile.PL to override EU::MM's processPL() which is continually being
+ broken on Win32.
+ Also rewrite limits_normalize_dsets.t so that it's not broken by Test::More bug.
+DAL (12-Jan-2006) Set correct x-y bounds for circle in PGPLOT/Window.pm.
+ Added function tcircle based on tpoints and tline.
+ Fixed convolveND method selection, bug #1323973.
+ Fixed docs (usage and signature) bug in statsover to show correct number and order of returned quantities.
+SIS (8-SEP-2005) Enter Chris Marshall's patched version of t/limits_keyspecs.t.
+ Fixes one of the #1221742 bugs.
+CED (1-Aug-2005) update docs for PDL.pm; re-fix recursion error message
+HG (2-June-2005) Fix PLplot's Makefile.PL to clean up temporary files
+HG (2-June-2005) add 'clean' and 'realclean' targets to the non-windows version
+ of Basic/MatrixOps/ssl/Makefile
+HG (2-June-2005) remove the now unneeded debian/patches/10_fix_clean_target.dpatch
+HG (1-June-2005) Apply most of the 'make clean' from
+ debian/patches/10_fix_clean_target.dpatch
+HG (1-June-2005) Apply debian/patches/50_relative_paths_in_htmldoc.dpatch, which
+ changes paths in HTML docs to relative instead of absolute ones.
+HG (1-June-2005) Apply debian/patches/20_dont_overwrite_pdl_1p.dpatch, which prevents
+ pdl.1p (generated from Basic/Pod/Intro.pod) being overwritten by autogenerated
+ pdl.1p from pdl.PL
+DCH (31-May-2005) Added limited bad value support to gsl_interp.pd. Added badval
+ test case to t/gsl_interp.t
+CED (19-May-2005) Fixed minor bug in Windows.pm, updated MANIFEST to
+ remove Debian patches (so "make dist" works), smoothed demos
+ a bit.
+AJ (10-May-2005) Modified gsl_interp.pd and gsl_random.pd to pass pointers
+ as IVs in OtherPars following Judd Taylor's suggestion.
+JB (9-May 2005) Added set operation routines - setops in primitive.pd as well as
+ intersect which is just an alias. Also updated the docs so that apropos threshold
+ will bring up clip..
+JB (6-May-2005) Improved version of typemap handling in OtherPars in PP.pm checked in and
+ documentation for PP updated to include a discussion of typemap handling
+ in OtherPars. I also realised I forgot a few updates earlier: I fixed a
+ problem in the FITS reader which kept you from reading in only the header
+ from files with empty primary arrays. And a few other small bug fixes around.
+ I am awful at Changelogs....
+HG (3-May-2005)
+ Apply some of the 'make clean' fixes from debian/patches
+SIS (2-May-2005)
+ Fix Slatec/Makefile.PL so that it doesn't break for Win32 users
+ building with MS compilers and f2c.
+HG (1-May-2005)
+ Remove debian-patches which are already in PDL cvs
+HG (1-May-2005)
+ Fix MANIFEST to include the current debian/* files
+HG (30-Apr-2005)
+ Apply debian/patches/60_remove_obsolete_upstream_debian_files.dpatch
+ and remove the file
+CED (19-Apr-2005)
+ Checked in Alexey Tourbin's patch in rout.pd
+SIS (9-Apr-2005)
+ In perldl.PL, set $HOME more appropriately for Win32.
+CED (7-Apr-2005)
+ Added warning message to FITS module load, if Astro::FITS::Header is not
+ available.
+AJ (01-Apr-2005)
+ Modified PDL::GSL::INTEG to enable the calculation of nested integrals
+DJB 9-Mar-2005
+ Fixed dumn mistake in wfits docs I made; it is TTYPE<n> and not
+ TFORM<n> that are used to specify the order of columns in FITS tables!
+CED 9-Mar-2005
+ pdl.h, pdlapi.c: Added guardrails to the dependency-loop
+ detector. (1) error message is now more explanatory.
+ (2) the detector now resets its counter when tripped, so that
+ you can continue to use PDL once it has been activated. (formerly,
+ every operation following a trip caused another error message).
+SIS 28-Feb-2005
+ At last - a fix for the MakeMaker bug affecting dmake (Win32). No
+ longer any need for the ugly hack that enabled PDL to be built with
+ dmake. Deleted one line of code from the top level Makefile.PL.
+ Deleted several lines from Basic/Core/Makefile.PL and added a sub
+ MY::processPL and a sub MY::postamble for dmake. Fix supplied
+ by Steve Hay.
+DJB 23-Feb-2005 (EST)
+ t/pgplot.t now uses $PGPLOT_DEV to set the output device, falling
+ back to "/xw", rather than forcing "/xw".
+ Cleaned up t/pgplot.t (no new real functionality) other than above.
+CS 24-Feb-2005
+ Remove 'use UNIVERSAL' for Core.pm.PL; shouldn't be needed anyway
+ and gave strange import problems when using PDL with Net::SSH::Perl;
+ also needed a change of isa to UNIVERSAL::isa in Dbg.pm
+SIS 23-FEB-2005
+ Another small tweak to Basic/Core/Makefie.PL to improve the hack that
+ enables PDL to be built using dmake (Win32).
+ Amend Basic/Core/pdlcore.c.PL to cater for "finite" with Microsoft
+ compilers. This correction pointed out by Vanuxem Gregory - thanks Greg.
+SIS 14-FEB-2005
+ Minor alteration Basic/Core/Makefile.PL to address a MakeMaker bug.
+ (Users now don't need to edit MM_Win32.pm.) Minor alterations regarding
+ definition and usage of TESTTYPE() macro with Microsoft compilers
+ in pdlcore.c.PL. Update win32/INSTALL to reflect changes.
+SIS 12-FEB-2005
+ Tidy up some things relating to Win32. All alterations of a minor nature.
+ Files affected were Makefile.PL, Basic/Core/Dev.pm, Basic/Core/Makefile.PL,
+ Basic/MatrixOps/ssl/Makefile.PL and win32/INSTALL.
+SIS 10-FEB-2005
+ Another change to Basic/Core/Makefile.PL to simplify build procedure
+ on Win32.
+SIS 6-FEB-2005
+ Minor changes to Basic/Core/Makefile.PL, Basic/Core/Dev.pm, and the
+ top level Makefile.PL to simplify build requirements/procedures
+ on Win32.
+SIS 5-FEB-2005
+ Provide an alternative TESTTYPE() macro (in pdlcore.c.PL)for
+ Microsoft compilers. (Addresses failures in conv.t and matrixops.t
+ tests.)
+SIS 4-FEB-2005
+ Enact some minor changes in the following files so that PDL will
+ build on Win32:
+ pdl.PL, Makefile.PL
+ Basic/MatrixOps/matrixops.pd
+ Basic/MatrixOps/ssl/Makefile.PL
+ Lib/CallExt/CallExt.pm
+ Lib/Slatec/Makefile.PL
+ t/callext.t, t/croak.t, t/flexraw.t, t/matrixops.t
+ win32/INSTALL (Rewrite to reflect changes in build procedure)
+CED 1-Feb-2005
+ Fixed minor bug in convolveND with kernel threading
+CED 18-Jan-2005
+ pdlcore.c.PL: fixed a pointer arithmetic issue that was causing
+ trouble under Windows. Thanks, Sisyphus!
+CED 18-Jan-2005
+ - added segfault.t to test suite
+CED 16-Jan-2005
+ - pdlcore.c.PL: Following Alexey Tourbin's awesome research,
+ removed a segfault problem when foreign blessed objects are pdlified.
+ Now, SvPDLV croaks if a foreign blessed object is detected
+ (avoiding a segfault); but stay tuned: there might be a better
+ answer in this case.
+CED 13-Jan-2005
+ - transform.pd: remove typo introduced in removal of C double types
+ (thanks, Henning!)
+CED 09-Jan-2005
+ - Core.pm.PL: Restored original barf behavior: reports error where
+ it occured in user code, not within PDL.
+ - primitive.pd: Matrix multiplication now requires that the second
+ argument's second dim equal the first argument's first dim
+ (as required for matrix multiplication; previous threading case
+ made no sense).
+ - Core.pm.PL: restored barf() to its documented behavior (had been
+ commented out and replaced with Carp::croak()...)
+ - t/matmult.t, t/misc.t: added more matrix multiplication tests;
+ fixed test in misc.t to accept error messages with "PDL:" in front.
+
+CED 07-Jan-2005
+ - Updated PDL version to '2.4.2cvs'
+ - In a fit of insomnia, lifted code for non-symmetric eigenvalue
+ problems from Kenneth Geisshirt. (http://kenneth.geisshirt.dk).
+ Resolves bug 1098245 and gets a long-standing annoyance off my back.
+DJB 06-Jan-2005
+ - Fixed norm() to correctly handle bad values. Added test case to bad.t
+ (and changed to use Test::More rather than Test module and
+ PDL::Core::approx).
+DJB 28-Dec-2004
+ - Clean up of t/fftw.t (use Test::More and PDL::Core::approx()). Small
+ increase in the tolerance used for checks (1.1e-4 to 1.2e-4) to avoid
+ occasional test failures seen on Solaris.
+
+2.4.2 released 28-Dec-2004
+
+CED 27-Dec-2004
+ - Window.pm: fixed bug 1091534 (problem with rect())
+DJB 23-Dec-2004
+ - Set the WITH_3D option in perldl.conf to be 0 rather than undef on OS-X
+ since there are still problems with the build. Also added a path to the
+ GL headers to Graphics/Makefile.PL and opengl.pd for OS-X (in case the
+ problem gets fixed). I think the whole build process for the 3D stuff
+ should be re-worked if anyone has enough tuit's.
+CED 17-Dec-2004
+ - PDL 5.6 is now deprecated by the Makefile.PL
+ - Fix problems with test suite when Astro::FITS::Heder is not installed.
+CED 13-Dec-2004
+ - uninitialized memory patch 1083663 (thanks, Miloslav!)
+
+CED 11-Dec-2004
+ - transform.pd: added projective transforms (t_projective)
+ - slices.pd: added Miloslav's patch (patch #1083663)
+
+CED 4-Dec-2004
+ - DiskCache.pm: Fixed problem with syncing to disk on store (typo in code)
+ - Lib/Opt/Simplex.pm: Fixed bug 1057022 (Opt::Simplex bug; thanks, Marcus)
+ - slatec.pd: Fixed bug 1076817 (matinv doesn't thread).
+ Fixed bug 1075203 (trailing underscores; thanks, Luc).
+ - Makefile.PL: Made bad- at INC problems more apparent when found.
+ ('.' at front of @INC causes trouble for build; this is now detected
+ and the user gets warned.)
+DJB 28-Oct-04
+ - removed some header comments which caused problems with (presumably older)
+ versions of Astro::FITS::Header (for PDL::IO::FITS::wfits)
+DJB 27-Oct-04
+ - fixed wfits() to write out ushort columns as Int4 (J) format
+ (ideally we should write out as Int4 (I) and use TSCALE/ZERO).
+ Added tests for this and other column types. Removed support for
+ writing out PDL::Complex piddles for this release.
+ - cleaned up the limits* tests so that they are skipped if PDL::Slatec
+ is not installed.
+DJB 21-Oct-04
+ - clean up of code to fix remaining validation errors reported by fverify
+ (the Type value passed to Astro::FITS::Header::Item must be in upper
+ case to get correct format for each card). Not 100% convinced caught all
+ cases.
+DJB 20-Oct-04
+ - PDL::IO::FITS::wfits updates for table writing: BITPIX must be the second
+ card (or else fverify from FTOOLS throws a wobbly); fixed writing a
+ comment card (caused messages under use strict/-w); the data area is
+ now filled with \0 rather than " " (both tables and images).
+ Note that fverify still complains that the keywords are not written
+ out correctly (the comments do not start in column #32 I think).
+ Removed the use of the FITS file handle from the whole module (now uses
+ IO::File throughout).
+ Added some very basic table tests to t/fits.t.
+CED 15-Oct-04
+ - fix a few oddball cases in permissive constructor
+CS 07-Oct-04
+ - fix warnings in some test scripts
+DJB 06-Oct-04
+ - PDL::Graphics::PLplot doc. updates: include internal and external links;
+ use of head3 elements for options; added blank lines between pod
+ statements (if not included these statements are treated as text);
+ addition of "extra" markup (C<> and F<> items).
+CED 17-Sep-04
+ - primitive.pd: stats updated to use statsover for better agreement
+ - statsover modified to promote mean etc. to floating-point.
+ - removed "$temp" magic variable from perldl -- now it's only available in
+ the "PERLDL" package. (assigning to $temp crashed perldl; this fixes that.)
+CS 15-Sep-04
+ - complex.pd: applied Vanuxem Grgory's patch and added some tests;
+ should close bug 1010164
+CED 15-Sep-04
+ - primitive.pd: Fix to statsover
+ - Makefile.PL, etc.: Added HTML_DOCS configuration option
+ - Fixed non-portability issue in t/diskcache.t
+CS 07-Sep-04
+ - make the reduce function a bit more flexible: reduce over
+ list of dims and allow code references
+CED 19-Aug-04
+ - Fixed OpenGL build to work with Mandrake 10 (this will need
+ better fixing later, but should work OK with all current distros).
+DCH 30-Jul-04
+ - Cleaned up plplot.t a bit. Made compilation of plplot routines
+ plsvect and plvect dependent upon a recent enough version of plplot.
+DCH 29-Jul-04
+ - Cleanup in plplot.d. Fixed documentation bug 959902. Fixed line
+ width specification (LINEWIDTH option). Fixed test bug in
+ limits_ulimits.t (floating point comparison error in array_eq)
+CED 29-Jul-04
+ - Fixed Makefile.PL for PLPlot, to pay attention to $PDL::Config hash
+ (was checking $PDL_CONFIG instead). Ditto plplot.t
+DJB 29-Jul-04
+ - added tests to t/core.t for $PDL::undefval fix (bug#886263 fixed
+ by Craig) and cleaned up the test to use Test::More (was Test).
+CED 28-Jul-04
+ - updated constructor and conversion routines to handle
+ $PDL::undefval properly. Since I don't like
+ action-at-a-distance, I also added tripwires to this activity
+ if $PDL::debug is set -- hopefully that mitigates the horror
+ somewhat.
+CED 21-Jul-04
+ - changes to perldl.PL to allow script handling.
+ - introducing "pdl", a byte-compiled trampoline that spawns off a perldl.
+ "pdl"'s advantages: (a) it's two characters shorter to type,
+ and (b) you can use in in a shebang.
+CED 15-Jul-04
+ - Modified flexraw.t test to not overrun 80-column card images
+ for reasonably sized file names (it will still break if fed a file
+ name that is unreasonable).
+CED 07-Jul-04
+ - Modified Pic.pm to look for alternate JPEG converters where
+ appropriate. This allows use of netpbm instead of pbmplus.
+DJB 01-Jul-04
+ - pdlcore.c.PL/pdl_kludge_copy_<>() issues: changed \n to \\n in some error
+ messages (would not compile otherwise) and a switch statement is now
+ auto-generated from %PDL::Types::typehash rather than hard-coded
+CED 17-Jun-04
+ - pdlcore.c.PL: av_ndcheck and pdl_setav_$type now support PDLs thrown
+ into the mix.
+
+ I noticed that PDL::undefval doesn't seem to function (see
+ "help pdl[2]") but left it that way for philosophical reasons.
+CED 16-Jun-04
+ - perldl.PL: comment lines are filtered out before passing through
+ Text::Balanced, and quotelike operators (e.g. "s/foo/bar/" or
+ "qq/foo/") are ignored for line parsing. Those constructs
+ rarely cross lines in common usage, and they cause lots of trouble
+ with Text::Balanced.
+CED 1-Jun-04
+ - PP.pm: fixed deep header copying -- now neither crashes nor leaks memory.
+ - slices.pd - added a paragraph to the range() documentation
+ - FITS.pm - added a couple of minor notes to the rfits() documentation.
+CED 28-May-04
+ - primitive.pd: fixes to glue()
+DJ 21-May-04
+ - added Graphics::Limits, which determines display ranges for
+ multiple concurrent data sets
+ - Primitive: fix to which/which_both bad value code to make it work when
+ BADVAL_USENAN = 1
+CED 30-Apr-04
+ - perldl: warns if AutoLoader is not loaded by perldlrc; avoids
+ a suite of installation follies.
+ - FITS.pm: rfits() clears hdrcpy flag by default
+ - pdlapi.c, PP.pm: minor readability cleanup
+ - Core.pm.PL: introducing hcpy, a pass-through hdrcpy clone. Also,
+ minor fixes to deep copying. Deep header copying still leaks
+ memory; it's not (yet) obvious why. [ Removing the refcnt increment
+ in PP.pm causes crashes, so, er, that's not it. ]
+CED 15-Apr-04
+ - FITS.pm: minor fix for all-BAD case.
+CED 08-Apr-04
+ - NiceSlice.pm, Core.pm.PL: added dummy syntax to NiceSlice.
+ - slices.pd: minor improvements to documentation
+CED 04-04-04 (heh).
+ - slices.pd: range - Added extra speedbump to avoid common programming error
+ (more than five implicit dims throws a warning)
+ - transform.pd: map - Added some extra dimensionality checks
+CED 26-Mar-04
+ - Primitive: which() now ignores bad-value entries (before it always
+ selected the BAD value).
+ - Primitive: uniqvec() now works properly if you feed in a lone vector.
+ - added tests for these cases.
+CED 17-Mar-04
+ - Transform: added match() convenience routine
+ - Demos: added a rotating-coordinate-system demo to "demo transform"
+ - Window.pm: fixed up _fits_tr to actually line up right with the FITS
+ coordinate system.
+ - Doc::Perldl.pm: fix for perl 5.8.0 compatibility (string interpolation
+ is a little more agressive in the earlier versions)
+DJB 17-Mar-04
+ - Updated PLplot build so that it works on OS-X, and will automatically
+ pick up the library if installed via FINK [currently only in unstable]
+CS 17-Mar-04
+ - Basic.pm: add (x|y|z)logvals
+CED 16-Mar-04
+ - IO::Pnm::Pic.pm: added wim() and rim() for more uniform RGB handling.
+ - Doc::Perldl.pm: help module now gracefully handles multiple matches,
+ and also ignores SIGPIPE if you quit the pager.
+ - Graphics/PGPLOT/Window/Window.pd: added DirAxis option to initenv().
+RL 16-Mar-04
+ - Graphics/PLplot/plplot.pd: Defined low-level interfaces for plmesh,
+ plmeshc, plot3d and plscmap1l in which the size arguments are deduced
+ from the piddles. Example x11.pl in the PLplot sources is completely
+ ported to PerlDL now.
+RL 15-Mar-04
+ - Graphics/PLplot/plplot.pd: Implemented the low-level PLplot API
+ functions pltr0, pltr1, pltr2, and plcont. Added some 'Doc' place
+ holders in the pp_def's.
+RL 13-Mar-04
+ - Graphics/PLplot/plplot.pd: Define our own plstyl subroutine, where the
+ first argument of c_plstyl (the length of the mark and space vectors)
+ is deduced from the piddle.
+RL 11-Mar-04
+ - Graphics/PLplot/plplot.pd: Use the here-document operator (<<) for
+ multi-line strings. This makes the style of code more close to Doug's
+ original style.
+RL 8-Mar-04
+ Graphics/PLplot/plplot.pd:
+ - Implement the #define'd constants in plplot.h as functions in Perl,
+ whose pp_def's are automatically generated by the
+ create_low_level_constants function.
+ - Added interface for the PLplot function plsurf3d. This has been tested
+ with the example x08.pl, recently added to the PLplot CVS sources.
+RL 5-Mar-04
+ - Graphics/PLplot/plplot.pd, t/plplot.t: Define our own plfill and plsym
+ subroutines, where the first argument of c_plfill and c_plsym (the
+ length of the data vector) is deduced from the piddle.
+RL 4-Mar-04
+ - Graphics/PLplot/plplot.pd, t/plplot.t: Define our own plhist perl
+ subroutine, where the first argument of c_plhist (the length of the
+ data vector) is deduced from the piddle.
+CED 4-Mar-04
+ Minor fixes to PDL::Transform - slightly better handling of hanning and
+ gaussian cases; tweaks to documentation.
+RL (for DH) 2-Mar-04
+ - New version of Graphics/PLplot/Makefile.PL that allows build of PDL
+ on a totally fresh system.
+RL 1-Mar-04
+ - Graphics/PLplot/plplot.pd, t/plplot.t: Define our own plpoin perl
+ subroutine, where the first argument of c_plpoin (the length of the x
+ and y vectors) is deduced from the piddle.
+CED 1-Mar-04
+ Minor fixes to PDL::IO::FITS
+CED 29-Feb-04
+ PDL::IO::FITS
+ - Some more refinements to rfits (see docs).
+ - wfits now allows write of binary tables.
+ primitive.pd: fix to glue() makes it properly permissive with dims.
+CED 25-Feb-04
+ - Further changes to PDL::IO::FITS:
+ * More cleanup of header handling code
+ * Split out image-reading code into its own XTENSION handler
+ [part of transition to more modular FITS handling]
+ * No test cases yet.
+DJB 24-Feb-04
+ - 'use strict' fix for PDL::IO::FITS::rfits (when reading a binary table)
+ (needs test cases added to t/fits.t)
+ - FITS checks moved from t/misc.t into t/fits.t (new file)
+ - t/misc.t and t/fits.t now use the Test module
+CED 12-Feb-04
+ - FITS.pm: Applied patches 881870 and 880507 from Kaj Wiik -- zero size
+ field fix, and 'A' and 'X' type fixes.
+CED 5-Feb-04
+ - Window.pm: fits_imag accepts CROTA if CROTA2 is not defined.
+ - m51.fits: moved CRPIX1 to agree better with the galaxy center
+CED 4-Feb-04
+ - Frestore again returns the eval'ed value rather than TRUE
+CS 28-01-04
+ - win32 fixes in several testfiles
+ and updated INSTALL instructions for win32
+DJB 15-01-04
+ - Hack to get fits_imag($img) to look like fits_imag($img,{j=>0}) when
+ the RA axis is in descending order [+ internal changes to make the two
+ go through the same code when setting limits].
+DJB 14-01-04
+ - moved FITS-header messages from IO/Misc/Makefile.PL to
+ IO/FITS/Makefile.PL since rfits/wfits are no longer in IO/Misc
+ - added WCS as an option to the fits_imag/fits_rgbi routines in
+ PDL::Graphics::PGPLOT[::Window]. This allows you to use any alternate
+ WCS mappig stored in the FITS header. Only tested using images from the
+ Chandra X-ray satellite, so you can now say
+ fits_imag($img,{j=>1,wcs=>'p'});
+ to display the 'physical' coordinate system of the image
+ - added docs for fits_cont() [essentially just copied fits_rgbi]
+ - added fits_cont and fits_vect to PDL::Graphics::PGPLOT + internal updates
+ to reduce replicated code.
+DJB 13-01-04
+ - t/dumper.t now passes on OS-X (10.3.2); needed to add '-s' option to
+ uudecode call otherwise the directory name was being ignored.
+CS 13-01-04
+ - Basic/Makefile.PL: override MakeMaker clean to *not* delete
+ files named 'core' (problem on case insensitive platforms)
+DJB 12-01-04 [merge of config-variable-cleanup branch]
+ - Clean up the use of config values in the build
+ process. We no longer use %PDL_CONFIG but use %PDL::Config in
+ Makefile.PL's and *.pm's (it unifies the code since we do not need
+ to check for one or the other). The config files (e.g. perldl.conf)
+ still use the PDL_CONFIG variable.
+ - added a TEMPDIR config entry which defines the location of the
+ temporary directory to use during the build and testing phases;
+ updated code to use this where spotted (may be other locations
+ lurking around, particularly in the tests)
+ - Moved configuration of MALLOCDBG-related variables into the top-level
+ Makefile.PL since the same bit of code was seen in several Makefile.PL's
+2.4.1 released
+CS 6-01-04
+ - PDL.pm: version to 2.4.1
+CED 12-31-03
+ - Cleared out cruft from MatrixOps build process.
+CED 12-29-03
+ - PLPlot Makefile.PL prints more informative messages during configure
+ - Added crash test to t/plplot.t
+ - 'yes'/'no' -> 1/0 conversion added to bottom of perldl.conf
+DJB 12-23-03
+ - fix small bug in PDL::Graphics::PGPLOT::Window::initenv() revealed
+ by perl 5.8.2 and test 11 of t/pgplot.t (Use of uninitialized value...)
+CS 12-19-03
+ - small release notes change
+ - t/primitive.t: test empty piddle handling
+CED 12-16-03
+ - ufunc.pd: average() returns 0 when given an integer empty piddle
+ and nan when given a floating-point empty piddle (unless badvals
+ are compiled, in which case you get BAD back).
+ - Fixed broken vector coastline (when did that happen?)
+ - Minor documentation fix to NDF.pm.PL
+CS 12-16-03
+ - t/plplot.t: redirect stderr to get rid of silly messages
+ - update Release_Notes
+CED 12-15-03
+ - primitive.pd: change statsover to use population standard deviation for
+ rms term -- solves bug #852359
+ - transform.pd: changed call to nan("") to sqrt(-1) for cross-system
+ compatibility (Slowlaris has no nan() call)
+ - Fixed typo in FITS.pm; shut up precedence complaints from t/func.t and
+ slatec.t
+ - Shut up v-strings warning in NiceSlice.pm
+ - Numerous other warnings from perl 5.8.2 suppressed.
+CS 12-12-03
+ - Lvalue.pm: change v-strings to backwards compatible version numbers
+CED 09-Dec-2003
+ - m51.fits: Replaced non-free NOAO image with free Hubble Heritage image
+CS 08-Dec-2003
+ - Core.pm.PL: fix nslice to handle empty piddles
+CED 07-Dec-2003
+ - ufunc.pd: average() and daverage() return 0 when given an empty piddle
+ in a non-bad-value environment. [One might argue that this should be
+ nan; I'm open to changing it...]
+ - ufunc.pd: andover, orover, etc. no longer convert arguments to
+ integer types before performing the operation. bandover and borover
+ work as before, since bitwise and makes no sense on floating-point
+ types.
+CED 05-Dec-2003
+ - Clean up axis labeling code in imag(); should eliminate spurious
+ doubled titles.
+CS 04-Dec-2003
+ - add code to Makefile.PL that tries to detect
+ broken redhat installations
+CS 03-Dec-2003
+ - PGPLOT::Graphics::Window: activate autolog for the 'points'
+ command and add some brief docs about autologging (see docs
+ for AXIS option)
+CED 25-Nov-2003
+ - Fixed eigens; eigenvectors are now in the columns of the output
+ eigenvector matrix, rather than in the rows.
+CED 21-Nov-2003
+ - Fixed bug 755563 (I hope) in the OpenGL configuration
+ - Fixed bug 793195; some random doc improvements for Image2D and Transform.
+DH 21-Nov-2003
+ - Upgraded PLplot interface for plplot-5.2.1 and perl 5.8.2. Improved
+ test suite. Also fixed two small bugs which give warnings during
+ 'make test' under perl 5.8.2: One in primitive.pd and the other in misc.pd.
+CED 19-Nov-2003
+ - Several minor fixes and improvements to rfits(). Notably, it now
+ works in array context, pulling all extensions and returning as list.
+CED 17-Nov-2003
+ - Split FITS IO into its own module.
+CS 13-Nov-2003
+ - GSL version check (>= 1.3) in Lib/GSL/Makefile.PL
+ related to bug 806229 which might be caused by a version
+ mismatch(?)
+CED 11-Nov-2003
+ - Added FITS BINTABLE reading to PDL::IO::Misc.
+CED 04-Nov-2003
+ - Updated Matrix.pm
+ - Removed null tests from trans code in PP.pm - to enable better handling
+ of null piddles. (fixes bug 779312, I hope)
+CED 16-Oct-2003
+ - Added whatis() function to perldl
+CED 15-Oct-2003
+ - Added PDL::IO::IDL.
+CED 15-Sep-2003
+ - Added easier access to local web documentation ("help www").
+ - Help searches are case-insensitive.
+CED 01-Sep-2003
+ - Moved Transform.pm to PP; wrote C version of map() algorithm.
+ - Revamped Window.pm documentation a bit.
+ - Fixed bg bug in text().
+CED 23-Aug-2003
+ - Added uniqvec() to primitive.pd
+CED 22-Aug-2003
+ - Added 'mirror' boundary condition to range()
+ - Added qsortvec() to ufunc -- lexicographically sort a bunch of vectors.
+CED 8-Aug-2003
+ - DiskCache now accepts a "bless" option that blesses the tied array
+ into the PDL::DiskCache class for easier access to the "sync" and
+ "purge" methods.
+ - Some fixes to Transform.
+CED 5-Aug-2003
+ - Several minor fixes (bugs 777000, 783104, and 772492)
+CED 27-Jul-2003
+ - Minor fix to Transform.pm (t_quadratic)
+CED 26-Jul-2003
+ - Fixed test for complex.t
+ - Fixed documentation for primitive.t
+CED 24-Jul-2003
+ - Online documentation works for autoload files
+ - Fixed regexp bug in searcher (special characters broke searching, as
+ in "? /tmp/foo")
+JC 22-Jul-2003
+ - Fixed bug in polar to re-im conversion routine (Cp2r) in
+ PDL::Complex. Added test case in complex.t to check that
+ re-im to polar conversion followed by polar to re-im ends
+ up with the same value we started with.
+CED 12-Jul-2003
+ - interpND: added cubic and FFT interpolation schemes.
+CED 5-Jul-2003
+ - imagend.pd: convolveND is ready to roll: fixed off-by-1 errors,
+ added tests and documentation.
+CED 3-Jul-2003
+ - imagend.pd: add optimized "convolveND". Still needs a bit of offset-by-1
+ work, but runs 3x faster than convolve() for direct convolution.
+CED 29-Jun-2003
+ - slices.pd: clump allows "-n" to mean "keep n dimensions".
+CED 28-Jun-2003
+ - Transform.pm: fix autoranging of map()
+ - primitive.pd: fix negative-index case in linear interpolation
+ (floor is required to prevent round *up* for negative indices)
+CS
+ - fix NiceSlice foreach bug; v to 1.0.0
+ - fix fftwconv
+2.4.0 released
+CED 22-May-2003
+ - Better fallbacks for RGB images if PGPLOT-RGB support isn't installed
+ (Window.pm)
+ - pgplot.t test cleans up its own window.
+CED 21-May-2003
+ - Revamped tranforms demo
+ - Added cartography demo
+ - Fixed justification logic in Graphics::PGPLOT::Window::fits_foo
+ - Fixed a bunch of documentation
+ - Removed debugging prints from Cartography.pm
+CED 20-May-2003
+ - "arbitary" -> "arbitrary" in Window.pm
+ - Fixed-up Transform demo
+JC 19-May-2003
+ - Updated Release Notes
+CED 19-May-2003
+ - Fixed FlexRaw to use binmode() on file handles. Also fixed flexraw.t
+ to use binmode() in its byte-swapper.
+CS 170503
+ - Makefile.PL cleanup + restrict tests when vital modules missing
+CS 140503
+ - further Makefile.PL fiddling
+CED 12-05-2003
+ - Lib/Transform now doesn't complain with -w (addressing DJB's objection)
+ - wfits now corrects the size of the output header.
+ - Shrunk Cartography sample data
+CS 080503
+ - Makefile.PL now absolutely requires Filter::Util::Call &
+ Text::Balanced for PDL::NiceSlice
+DJB 060503
+ - Makefile.PL now enforces Perl >= v5.6.0 (+ removal of old code)
+CS 060503
+ - set OPTIMIZE via perldl.conf
+ - PDL.pm: version @ 2.4.0
+ - Inline::Pdlpp: new NOISY flag (show compilation output)
+CS 030503
+ - is_inplace: allow testing and unsetting inplace flag in one statement
+ - complex.pd: fiddling with namespaces and other bits
+ - add 'reshape' to lvalue funcs
+CS 190403
+ - export pdl_changed, pdl_children_changesoon and pdl_vaffinechanged
+ into PDL::Core struct (for usage in external modules)
+ bumped up pdl_core_version to 5
+ - use those funcs to fix inplace ffts in PFL::FFTW (fix bug #716449)
+ - pdlapi.c, pdlthread.c, pdl.h.PL: changes to help debugging the
+ PDL Core; all pointers are now dumped in hex in the pdl_dump_XX
+ routines
+ - pdlapi.c: delete one statement in pdl_changed that broke, for
+ example, calling fft with certain kind of slices (see comments)
+ fixes bug #716447 (but note that I wasn't sure what this statement
+ was required for in the first place; so breakages in other places
+ as a result are not inconceivable)
+ - disabled foomethod tests (foo.t) since foomethod broke as a result of
+ removing the statement in pdlapi.c (see above). I assume that the
+ statement in question was only introduced to make the foomethod work
+CED 15-Apr-2003
+ - Cleaned up a lot of documentation
+CED 14-Apr-2003
+ - By request, headers are now deep-copied recursively.
+ - Removed a debugging printf in PP.pm
+CED 12-Apr-2003
+ - Various: Modified header copying to be quasi-deep, rather than
+ by reference only. Changes to PP.pm, Core.pm.PL, and some
+ test files.
+CED 9-Apr-2003
+ - slice.pd : Added permissive ranging to, er, range(). Missing source dims
+ are treated as if they dummy dims of order 1.
+DJB 09-Apr-2003
+ - Fixed PDL::Graphics::PGPLOT::Window::legend to correctly handle
+ synonyms (confusion between PDL::Option's synonyms()/add_synonym())
+CED 8-Apr-2003
+ - Minor fix to Transform::map: if you supply a destination FITS header it
+ replaces the original FITS header in the remapped output.
+CS Dev.pm: apply Michael Schwern's fix for ExtUtils::LibList
+ Makefile.PL, Types.pm.PL: fix race where Types.pm.PL tries to use
+ PDL::Config before it is written
+ discovered bug in FFTW inplace code: breaks inplace routines with
+ slices; added TODO test to fftw.t
+DJB 02-Apr-2003
+ - moved code from Basic/Bad/bad.pd to Basic/Core/Types.pm.PL: should
+ never really have been adding to the PDL::Type namespace from a
+ different module! (no change to the user)
+CED 30-Mar-2003
+ - range now allows using the empty piddle as an index; the resulting
+ range is the empty piddle.
+DJB 28-Mar-2003
+ - removed TYPES_LONGLONG hack from perldl.conf
+CS
+ - changed handling of bad values to accommodate longlong types
+ general infrastructure overhaul to improve type handling
+CED 27-Mar-2003
+ - Added XRange,YRange keys to image handling in Graphics::PGPLOT::Window.
+CED 25-Mar-2003
+ - Fixed pgplot.t test to not use broken asynchronous I/O in perl5.
+ Switches interactivity on an environment variable instead.
+CS 25/03/03
+ - karma.pd: added 'kvis' command to start new kvis app
+CS 22/03/03
+ - renamed det in slatec.pd to detsclatec; avoids name clash with
+ PDL::MatrixOps::det; I tried to make the change backwards compatible
+ - PDL::ImageND, PDL::FFT, PDL::FFTW: moved kernctr from PDL::FFT into
+ PDL::ImageND so it can be used by both PDL::FFT and PDL::FFTW; both
+ PDL::FFT and PDL::FFTW export it now by default
+CED 20-March-2003
+ - pdlhash.c: if PDL::BIGPDL is true, then ignore the 1-Gb limit on PDLs.
+ - Window.pm:
+ - Fix labeling bug that affected some output devices (titles
+ were doubled in ppm device due to a pgplot buffering bug).
+ - Fix handling of FITS headers in _fits_foo -- let PDL dimensions
+ override NAXIS<n>.
+ - PP.pm:
+ - hdrcpy bit is sticky, so that headers make their way down
+ pipelines of operations.
+CED 18-March-2003
+ - Core.pm.PL: fix '.=' closure (closes bug #630793)
+ - pdlapi.c: Check that a dimension is nonzero before dividing by it,
+ in pdl_make_physvaffine. This bug might exist elsewhere too,
+ causing random crashes with Empty and Null piddles. But at
+ least this closes bug #671891.
+ - perldl.PL: Put code to execute inside a trivial block (diverts
+ runaway 'last' and 'next' commands, closes bug #573841)
+ - ufunc.pd: Minmax now returns (0,0) when handed the null piddle,
+ unless bad values are supported in which case it returns (bad,bad).
+ (closes bug #659130)
+ - Window.pm: fix bug #626344 (retain old cursor position)
+CS 17/03/03
+ - Core.pm.PL: fix topdl method (closes bug #681015)
+ - gsl_integ.pd: fix for compliance with gcc
+AJ (17-March-2003)
+ - Added PDL::GSL::INTEG
+CED (15-March-2003)
+ - perldl: Added multi-line string processing (using Text::Balanced)
+ and EOF protection to the shell.
+CED (14-March-2003)
+ - Obscure bugfixes and improvements to Lib::Transform
+ - t/pgplot.t Avoid a perl bug (setting an alarm from inside
+ the alarm handler sometimes fails!).
+ - Primitive: uniq now always returns a PDL.
+AJ (12-March-2003)
+ - Minor changes to PDL::GSL::INTERP
+Doug Hunt (3-Mar-2003)
+ - Added PLplot interface to PDL/Graphics area. This
+ had been a separate CPAN module (PDL-Graphics-PLplot)
+CED (25-Feb-2003)
+ - Added 'piddle' constructor synonym :-)
+CED (24-Feb-2003)
+ - slices.pd:
+ - range(), indexND, & interpND now accept multiple boundary conditions
+ - fixed up indexNDb and indexND documentation
+ - portability fix to whichdatatype_double mod
+CED (21-Feb-2003)
+ - Modified whichdatatype and whichdatatype_double to represent nan with
+ a double, rather than barfing.
+ - Myriad small fixes to Transforms::Cartography
+ - Perspective works properly
+ - Changes to the documentation of Window.pm: axis() is better documented.
+CED (5-Feb-2003)
+ - Window.pm:
+ - ctab() selects window focus now (as it should).
+ - lines() doesn't barf on trivial vector
+ - pgwin() is much more forgiving in its syntax. In particular,
+ you can say "pgwin(xs,J=>1)" and it'll know what you mean.
+ - Basic:
+ New ->fhdr method makes a tied FITS header if possible
+CED (30-Jan-2003)
+ - Modified interpND linear method (30% faster!).
+ - Added PNG interpretation to ::IO::Pic.
+ - Cleaned up RGB support in Transform/Cartography; fixed many bugs.
+ in threaded transforming (mv(<n>,-1) is deprecated!)
+ - Added FITS header support to transformations.
+ - Added automagic RGB recognition to ->imag.
+AJ (29-Jan-2003)
+ - Added PDL::GSL::INTERP and PDL::GSL::DIFF and corresponding
+ tests t/gsl_interp.t and t/gsl_diff.t
+CED (28-Jan-2003)
+ - Added fits_vect method to Window
+ - Improved Transform demo (whizzy despiraling demo at end)
+ - Fixed MANIFEST.
+CED (27-Jan-2003)
+ - Rearranged Lib/Transform to be more like the rest of the source tree.
+ - Several bug fixes in Transform code
+ - Improvements to ->map() method
+ - Added truncation to ->range operator
+ - Switched ->indexND to use ->range (for better data flow)
+ - Added EQUIVCPTRUNC macro to PP, for permissive slicing operators
+ (like ->range) that can extend out-of-bounds.
+CED (20-Jan-2003)
+ - Added rgbi to Window.pm (requires newer pgplot & PGPLOT).
+ - Added earth_image() to PDL::Transform::Cartography::Earth
+ (this may not be the Right Way to do it)
+CED (17-Jan-2003)
+ - PDL::IO::Dumper uses more standard uuencode/uudecode than before,
+ and uses external uuencode/uudecode by preference (faster than
+ Convert::UU)
+CED (16-Jan-2003)
+ - Minor fixes to Transform.
+ - PDL::IO::Pic is auto-used.
+CED (15-Jan-2003)
+ - fix to Dumper -- uses Convert::UU (instead of uudecode) if available.
+ - Transform::Cartography::Earth -- update dumped info
+CED (3-Jan-2003)
+ - primitive: added glue() method -- arbitrary-dimension append
+ - Transform:
+ - renamed Projection.pm to Cartography.pm
+ - Added operator overloads to Transform.pm
+ - Added "dual-method" functionality to map() and apply()
+ - Reversed sense of map() and unmap() to make them more intuitive.
+ - Added many map projections and helper routines to Cartography.pm
+ - Added Transform::Cartography::Earth with local earth-map
+ (autoloaded by "earth_coast" helper in Transform::Cartography)
+ - Window:
+ - Several minor fixes to lines
+CS - NiceSlice parser updates, see Changes in NiceSlice dir
+ - .cvsignore files for the dist (autogenerated so hopefully
+ no screwups, please let me know if you notice any problems)
+CED (19-Dec-2002)
+ - window.pm: Fixed off-by-one bug in ->lines
+ - Transform.pm: Fixed some stuff in t_linear
+ - Added Lib/Transform/Projection.pm
+CED (17-Dec-2002)
+ - Minor fixes to Transform.pm
+ - Added "lines" to Window.pm
+ - Added Earth map data file to the top level of the distro.
+ - temporarily added "earth-interp.pl" to the top level of the distro.
+ - Allowed "Methods" as well as "Functions" for func list in Doc.pm
+CED (11-Dec-2002)
+ - Minor fix to Windows.pm in _FITS_tr.
+CED (10-Dec-2002)
+ - Minor fixes to Windows.pm
+ - First cut at pgplot.t -- test suite for pgplot windowing stuff.
+ - Fixed up some Transform documentation.
+CED (09-Dec-2002)
+ Fixes to Windows.pm:
+ - all Pix/Scale/Pitch parsing is now in initenv() (so, e.g.,
+ those options work on ->line and ->points).
+ - initenv() knows about self->held for more convenient wrapping
+ (and fixing of the old doesn't-switch-windows-when-held bug)
+ - _fits_foo implements generic fits_<foo> processing for easier
+ addition of fits stuff.
+ - fits transformations are in _fits_tr
+ - image range finding is in _fits_xyvals
+ - justify works in a generalized way. Justify=>1 works like you
+ expect, but Justify=><r> also sets the pixel aspect ratio,
+ for more juicy flavor.
+CED (06-Dec-2002)
+ - Minor fix to range documentation
+ - Shut up warnings in Window.pm sig handler and fix fits_imag (bug #649630)
+ - Fixed bugs #633385, #634257
+ - attempted to regularize justify option (in progress)
+CED (05-Dec-2002)
+ - Numerous fixes to PDL::Transform
+ - Minor tweak to MatrixOps
+ - Some cosmetic improvements to InterpND (better option control)
+CED (03-Dec-2002)
+ - Completely rewrote range code -- it's more elegant, faster, and
+ more general now.
+CED (02-Dec-2002)
+ - added ndcoords (new index piddle constructor) to Basic.pm
+ - indexND now uses range call instead of index call (works faster)
+ - many mods to Transform
+CED (21-Nov-2002)
+ - PDL::Math loads PDL::MatrixOps by default for backwards compatibility.
+CED (19-Nov-2002)
+ - PDL::Slices::identity -> s_identity; identity is now
+ exported from MatrixOps and constructs an identity matrix.
+ - Ported MatrixOps to PP; moved to subdir of Basic; split the
+ matrix ops from math.pd and moved into matrixops.pd MatrixOps
+ is now autoloaded by "use PDL;".
+ - Minor mods & cross-refs added to documentation in several modules
+CED (18-Nov-2002)
+ - Transform: improvements to t_lookup
+CED (17-Nov-2002)
+ - MatrixOps: improved inv and det can thread using lu_decomp2
+ - Transform:
+ - use svd to characterize the jacobian in integrative mapping
+ - integrative ('jacobian') mapping works reasonably quickly and
+ is correct. Some changes to options.
+ - Better documentation for svd in math.pd
+CS - yet another special case for NiceSlice, see NiceSlice Changes
+CED (15-Nov-2002)
+ - photometric distortion appears to be correct -- but hogs memory like
+ crazy. One more iteration to make it usable!
+CED (14-Nov-2002)
+ - interpND defaults to 'sample' if its input is an integer type
+ - Math::eigens is quiet about symmetrizing unless PDL::debug is set
+ - photometric distortion (not correct yet but functional) in PDL::Transform
+ - updates to MatrixOps.pm
+DJB (14-Nov-2002)
+ - Added 'demo transform' to perldl to showcase PDL::Transform
+CED (14-Nov-2002)
+ - Math::eigens is now threadable.
+DJB (12-Nov-2002)
+ - Added the TYPES_LONGLONG option to perldl.conf: by default it is set to 1
+ which means that PDL will try and compile support for a 64 bit type. Set
+ to 0 if make fails (or fix the code to work with PDL_LongLong types!)
+CS - NiceSlice doc additions
+ - PDL::Core: squeeze as reshape(-1) alias
+CED (11-Nov-2002)
+ - Transform.pm updates - conformal radial expansion, better
+ documentation, better composition, several minor bug fixes
+CS - NiceSlice.pm v0.99: fix modifier parsing + allow several modifiers
+CED (7-Nov-2002)
+ - Several updates to Transform.pm -- wrap() method, rot option to Linear,
+ and improved composition -- but NOT (just yet) jacobian support.
+ - Updated documentation for index() method in slices.pd
+ - Minor tweaks to MatrixOps.
+CED (6-Nov-2002)
+ - Added MatrixOps.pm version 0.5
+ - Added t/matrixopt.t
+CED (30-10-2002)
+ - Added Transform.pm version 0.5
+CED (29-10-2002)
+ - m51.fits: hand-edited the file to fix bad NAXIS tag (was 0)
+CED (25-10-2002)
+ - IO/Misc.pm: removed not-so-spurious warnings from rfits (bug #626342)
+ - PGPLOT/Window.pm: fixed spinlocks for PGPLOT -- now faster,
+ clearer, and actually functional (see bug #615277).
+ - Primitive/primitive.pd: fix to interpND behavior -- it now threads
+ correctly in the bilinear dual-threading case.
+ - Lib/Slatec/slatec.pd: added nonsquare-array check to matinv.
+ Similar checks are probably needed throughout to keep FORTRAN
+ from dying.
+CS - PDL::IO::FlexRaw now understands all types
+ - uncommented type longlong -- let's see how many installations
+ break ;)
+ - added t/iotypes.t
+CS ******** merged in type extension stuff
+ - example of extending data types: add longlong type (64bit integer)
+ - that type is disabled by default but you can uncomment the
+ section in Types.pm.PL to try it out
+ *** no modification of IO modules yet
+ *** just the core changes to add the type + other changes to
+ *** make all modules compile
+ *** may serve as a testbed for type extensions
+ *** needs testing with BADVALUE support
+CS - preparations for type extension: concentrate all type-dependent info
+ in Types.pm.PL
+CS - cpoly.c: try to fix values.h problem on BSDs etc
+CS - patch for cygwin by Christopher Marshall (Bugs item #597985)
+CS - fix box2d threading bug
+CS (25/9/2002)
+ - 2.3.4 release branch merged into trunk
+TJ (13-Sep-02)
+ - Basic/Core/Core.xs hdr and gethdr XS functions did not strictly
+ adhere to XS syntax. (5.005_03 xsubpp complains loudly)
+DJB/CS (11-Sep-02)
+ - 'make clean' now removes _Inline/ as does t/inlinepdlpp.pl when its
+ run (to make sure that we're testing the latest&greatest code)
+TJ (09-Sep-02)
+ - Fix valgrind warning in pdlapi.c (use of uninitialised variable in dump)
+ - PDL::IO::Storable now uses PTR2IV
+TJ/CS (09-Sep-02)
+ - Fix memory leak associated with magic
+CED (30-Aug-02)
+ - Fix to Window.pm documentation -- explains wart about panel()
+CED (29-Aug-02)
+ - minor fix to fits_imag -- axis labels
+ - Added TightLabels (boolean) and TitleSize (float) standard options
+ to control window labeling.
+CED (28-Aug-02)
+ - minor fix to rangeb - physicalize index before checking its size
+CED (27-Aug-02)
+ - range() is now an lvalue, as are indexND and indexNDb.
+ - pdl_malloc call is now via PDL Core structure, avoiding
+ complete failure of the test suite :-)
+ - extra debugging fprintf() calls deleted.
+ - range() is a front-end to rangeb(), allowing omission of optional
+ arguments.
+ - rangeb handles boundary conditions.
+CED (26-Aug-02)
+ - slices.pd: added range (PP implementation)
+ - Incremented core_version in pdlcore.h.PL
+ - ->range doesn't spew debugging now (commented out)
+CED (20-Aug-02)
+ - slices.pd: added rangeND (first-cut implementation)
+---- 2.3.4 release merged into trunk on 25/9/2002 (see above)
+2.3.4
+JC (23 Sep 02)
+ - Changes to Release_Notes associated
+ with making release 2.3.4
+Frederic Magnard (2002-09-20)
+ - Fix NAXIS in fits writer with Astro::FITS::Header
+TJ (2002-09-20) - wfits should now write SIMPLE as logical with
+ Astro::FITS::Header
+TJ - wfits now works correctly with Astro::FITS::Header
+TJ - Paper over weirdness in PDL::GSL build when Slatec is disabled.
+TJ - func.t was failing if Slatec was not available. This was because
+ PDL::Func was loaded before PDL::Slatec in t/func.t. Now fixed
+ (and include an additional croak in PDL::Func).
+TJ - Compatibility fixes for perl 5.005_03
+ + updated ppport.h from perl 5.8.0
+ + lvalue problems with slices.pd and primitive.pd
+ + Graphics/PGPLOT/Window/Window.xs now uses ppport.h
+TJ - Core.xs.PL used invalid XS for hdr and gethdr
+DJB - Backported "_Inline removal to Makefile.PL & t/inlinepdlpp.t"
+CS - version to 2.3.4
+CS - backported a number of patches from the main branch
+ DB 9/11: Lite.pm typo
+ TJ 9/02: PDL::IO::Storable now uses PTR2IV
+ Fix valgrind warning in pdlapi.c
+ (use of uninitialised variable in dump)
+ Fix memory leak associated with magic
+----- branched off 2.3.4 release at this point
+CED (19-Aug-02)
+ - Window.pm spinlock includes special release_and_barf to unlock signals.
+ (the Right Answer is to fix barf() to throw a __DIE__ signal;
+ but that opens other cans of worms.)
+ - documentation for some of the inplace-flag handlers
+CED (16-Aug-02)
+ - indexND: runs faster; doesn't check boundaries at all
+ - indexNDb: includes "forbid" boundary condition (which barfs on violation)
+ - interpND: skips trivial cases for bilinear interpolation (factor-of-2
+ speedup for each dimension that is indexed by an integer)
+ - Window.pm:
+ * ->imag labels axes, if you pass in label fields as options.
+ * isolated initenv() viewport setup, so imag() can use it in pix code
+
+CED (15-Aug-02)
+ - PGPLOT::Window fixes:
+ - ticks default to outside for images; inside for everyone else
+ - cleaned up pixel scaling code (used initenv() now) in imag
+ - Image alignment code - you can choose how the image fits within
+ the box if you explicitly set the scaling (or use fits_imag)
+ - fits_imag automagically draws wedges rather than modifying the title.
+ - draw_wedge position defaults to 1.5 rather than 2 (avoids cropping of
+ wedge labels in the default case).
+CED (12-Aug-02)
+ - Minor speed increase to InterpND (still needs work!)
+ - PGPLOT::Window::(imag1|imag|fits_imag) now does pixel scaling correctly
+ (I hope) -- substituded pgqvp (viewport dims) for pgqvsz (window dims)
+ - Axes now default to having tick marks outside the box instead of inside
+ the box. That prevents scrozzling by images.
+ - pgwin() convenience function is a little more convenient
+ - Fix to spinlocks in Window.pm.
+ - gethdr() can return undef again; new method hdr() is always defined.
+CED (9-Aug-02)
+ - Signal-deferral mechanism for PDL::Graphics::PGPLOT::Window should
+ avoid many pgplot-related weirdnesses
+CED (8-Aug-02)
+ - Minor fixes to fits_imag, also in PDL::Graphics::PGPLOT::Window
+ - Minor fix to IndexND, in slice.pd
+ - now fits_imag doesn't attempt to reconcile different CTYPE units.
+DJB (8-Aug-02)
+ - changed behaviour of TextWidth option in PDL::Graphics::PGPLOT::Window
+ It is now only applied if specified (ie doesn't default to 1 and so
+ clobber the LineWidth/HardLW settings). Added a little documentation
+ but it needs to be improved.
+CED (7-Aug-02)
+ - Slightly cleaner MOD in ops.pd
+ - added interpND (to primitive.pd) and indexNDb (to slices.pd).
+CED (6-Aug-02)
+ - New % operator follows (mathematically correct) perl % operator behavior
+ - AutoLoad throws an error if foo.pdl doesn't declare foo(). (used
+ to loop endlessly).
+ - AutoLoad error messages are more informative.
+CS - hopefully fixed bug with new pdl(arrayref) implementation
+CED (2-Aug-02)
+ - Add IndexND to slices.pd
+ - Add pdl output for scalar context to WhereND in primitive.pd
+CED (1-Aug-02)
+ - Incorporate FITS into rpic/wpic interface (allow conversion code
+ to recognize drop-in replacement functions for rpic/wpic)
+ - Minor fix to FITS I/O version checking
+CS - add PDL::IO::Storable and PDL::GSL::SF hierarchy
+ - fast pdl method! please test heavily
+ - don't do opengl tests unless opengl is actually built!
+ - mute annoying warnings from PP::PDLParObj
+CS - explicitly load PDL::Core in PP boot section
+ - examples: make modules with Inline::Pdlpp!
+CED (26-Jun-02)
+ PDL::Graphics::PGPLOT::Window::line() autoranging avoids infinity
+CED (25-Jun-02)
+ Changes to PDL::Graphics::PGPLOT::Window:
+ - Added pgwin() -- exported constructor (less typing)
+ - Added =>Size option to constructor (less typing)
+ - Added =>Units option to constructor (PGPLOT units only at the moment)
+ - Interactive windows appear at the size you ask for. (less annoyance)
+DJB - quoted "PDL::Type" in byte/short/.. fns in Core.pm to fix
+ problem seen with using 'use strict' with perl 5.6.0
+CS - patch by Ken Williams to improve speed of 'pdl $perl_array_ref'
+CS - check for Astro::FITS::Version >= 1.12
+CED (17-Jun-02)
+ - add fits_imag to PGPLOT interface
+CS - allow niceslice to use the syntax
+ $pdl($greater_1D_piddle)
+ which indexes into flattened $pdl; result has same shape
+ as $greater_1D_piddle
+CS - allow PP Code to handle constructs like
+ $arr(n => 3*i+1)
+ if Text::Balanced is installed
+ - fix included Benchmark suite
+ - NiceSlice.pm: make splitprotected interface similar to split's
+CS - fix PP.pm: bug #564937 (needed a check for sv_isobject(...) )
+ - make sure pp_done is called automatically if user forgets!
+CS - applied Diab's patch #559860: improve trylink, Math/Makefile.PL
+ - applied Diab's patch #559885: overload 'eq'
+ - Inline::Pdlpp: fix join-bug, add MakePdlppInstallable to allow
+ installation of modules with Inline Pdlpp calls, update test
+ and INFO method
+ - allow to set trylink 'Hide' behaviour from perldl.conf (suggested
+ by Diab)
+DJB (04 Jun 02)
+ - minor fixes to the build highlighted by warnings from perl 5.8.0
+TJ (31 May 02)
+ - Use INT2PTR/PTR2IV to fix compiler warnings
+ when the IV size does not match the pointer size
+ (eg linux with -Dusermorebits). This will break compatibility
+ with perl 5.005 unless we add some of our own macros
+ - Fix prototype warning in rout.pd with PerlIO_print
+ - Apply CS's patch to CallExt.pm to prevent spurious
+ failure of DynaLoader in perl 5.8.0
+2.3.3
+JC (22 May 02)
+ - Changes to Release_Notes, PDL.pm associated
+ with making release 2.3.3
+CS - bump up NiceSlice version
+ - gsl_random rng destructor!
+ - improve PDL::Exporter doc (I never remember the darn syntax)
+CS - reshape behaviour like idl when no dim args are given
+ - niceslicing gets a new modifier: $a(;-) drops dims of size 1
+CED (16 May 02)
+ - Several minor changes to Dumper and RandVar for compatibility with
+ BSD and perl 5.005
+CS - Makefile.PL: warning if mods for NiceSlice missing
+ - IO/Misc: print warning at the end of the make output
+ - Graphics/PGPLOT: small change to the (still undocumented) autolog func
+CED (15 May 02)
+ - Added Astro::FITS::Header recognition to PDL::IO::Dumper.
+CED (14 May 02)
+ - Removed NiceSlicing from RandVar and Dumper (they use slice only now)
+CED (from the distant past)
+ - Added PDL::IO::Dumper, which provides deep data structure storage
+ and retrieval in armored-ASCII format. Requires Data::Dumper
+ (from CPAN), FITSIO (also from CPAN), and uuencode(1).
+CED (13 May 02)
+ - Modified legacy rfits/wfits support to handle strings more cleanly
+ (more like Astro::FITS::Header)
+ - Moved missing-module message to IO/Misc/Makefile.PL
+ - Added stringification test to t/misc.t
+CED (10 May 02)
+ - Modified rfits/wfits to support Astro::FITS::Header as an underlying
+ FITS header driver. The fallback (to the more-or-less original KGB
+ code) is probably Wrong as string handling now changes depending
+ on the presence of Astro::FITS::Header;
+ whether Astro::FITS::Header is present; but ultimately everyone
+ just uses Astro::FITS::Header and the problem goes away.
+CS - folded PDL-2_3-gimp-fix branch into main trunk
+ - typos
+DJB (09 May 02)
+ - removed *.P files from Lib/Slatec/slatec/ (no longer needed)
+CS - fix wcols bug #541847
+ - remove $Config{libs} from callext_cc to make callext work on
+ recent debian systems
+ **** possible source of incompatibility ******
+ - dumper.t: test only if uuencode/decode present
+ - lmfit example
+ - add diskcache.t to MANIFEST
+CS - remove remaining call to pdl_family funcs in pdlapi.c
+ - apply perldl patch for -M switch (bug #530441)
+CS - perldl v1.32: changed preprocess interface -> pipeline
+ - Pic.pm: make option parsing case insensitive
+ - Lvalue.pm : use attributes interface (fixes lvalues with bleadperl)
+ - Core: remove pdlfamily.c dependencies and delete the file
+ pdlapi.c: make_now noop, future_me etc stuff in pdl_destroy
+ - PP: make_now is really a noop with above family changes - removed
+ - doc updates
+DJB (09 Apr 02)
+ - added 'use PDL::Math' to PDL.pm (but not Lite/LiteF versions)
+ (22 Apr 02)
+ - added Kaj Wiik's patch to use pgtbox in PGPLOT/Window.pm (#538831)
+ -- this needs documentation!
+JB (07 Apr 02)
+ - Moved $CTAB to become part of the $self object in PGPLOT/Window.pm
+ This fixes the error that caused the second image plotted to hard-
+ copy devices to become blank.
+DJB (02 Apr 02)
+ - added Ben Gertzfield's patch for bug #538283 (pptemplate.pod location)
+CS - doc updates
+ - box2d in image2d.pd
+ - some more PGPLOT tline fixes
+ - PGPLOT autolog stuff (as yet undocumented)
+ - perldl -V (version info)
+ - remove 'use PDL::Core' from PdlParObj.pm (static linking)
+ - Makefile.PL: fix PDL::Config formatting,
+ make solaris/usemymalloc/gcc message even more verbose
+ - misc.pd: fix rasc bug (|| vs or)
+ - add BUGS file
+DJB (27 Feb 02)
+ - added finite fix for HP-UX systems to math.pd (by Albert Chin)
+CS - slice fix
+ - pdlcore.h.PL: gimp fix
+ - perldl Ctrl-C handling (Ken Williams tip!)
+ - polyfillv: make lvalue sub
+DJB
+ - PDL::IO::NDF::rndf() now accepts NDF sections (01/08/02)
+ - added fft prototype to slatec.pd (from Jonathan Scott Duff, 01/17/02)
+CS - INSTALL & DEPENDENCIES update (bug #488867)
+ - FlexRaw: read/write from open file handles (by Dov Grobgeld)
+ - IO::Misc: fix filehandle code for rcols etc.
+ add file handle awareness to rasc
+ - slices.pd: improve 'index' error message
+CS - remove the defunct t/quat.t
+ - fix PDL::GSL to work with libgsl 1.X
+CS - fix for #474736 (sym with points), needed that feature
+ - applied symsize patch #474853
+CS - fix for Dev.pm: load PDL::Types only once
+ - stop PDL::IO::Pic warning by default
+2.3.2
+CS - change pdlcore.h.PL so that gimp-perl compiles
+ again
+ - Changes to Release_Notes, PDL.pm associated
+ with making release 2.3.2
+2.3.1
+John Cerney (11/21/01)
+ - Changes to Release_Notes, PDL.pm associated
+ with making release 2.3.1
+DJB - added WITH_IO_BROWSER to perldl.conf (default 0) to
+ control whether PDL::IO::Browser is made. Will now compile
+ on MacOS X 10.1.
+CS - get rid of Perl_die etc dependencies and other barfisms
+ - make sure t/inlinepdlpp.t has a full search path to PDL::Core
+ - Basic/Pod : podselect only when Pod::Select available
+CS - fix Makefile/Dev.pm bugs (that break build on PDL-free
+ systems)
+ - bump version to 2.3.1
+2.3
+John Cerney (11/13/01)
+ - Changes to Release_Notes, PDL.pm, TODO associated
+ with making release 2.3
+ - |= &= bug fix
+CS - inline fixes
+ - dim & ndims aliases for getdim & getndims
+ - perldl doc updates
+ - reverting perldl.conf changes introduced in CVS
+ - Makefile.PL: detect buggy solaris+gcc+mymalloc combination
+CS - fix Dev.pm warnings (triggered by Inline::Pdlpp tests)
+ - Inline::Pdlpp docs
+CS - fix bug in Dev.pm that I introduced
+ - change misleading topdl docs (fooled me!)
+ - macosx patch
+CS - Tim's TERM patch
+ - Stefan's Matrix patch
+ - added PDL::API manpage
+ - PDL::Core::Dev helper functions for work with
+ Inline
+ - pictests only for internal PNM format
+DJB (23/Oct/01)
+ - changes to bad.pd in order to clean up build slightly (for
+ instance we longer need to create pdlapi.c from pdlapi.c.PL)
+ - added Diab Jerius' patch [ #469110 ] for rvals/options
+ - added a test for this [and fixed a bug I'd introduced]
+DJB (15/Oct/01)
+ - minor fix to ellipse (no longer requires options array) and to
+ imag (will correctly handle transforms for axes with "-ve" pixel
+ size, such as RA in Astronomy)
+CS - Xrange, Yrange for PGPLOT, fix tline and tpoints
+CS - niceslice docs, class methods for PDL::Options,
+ perldl: enable niceslicing at startup (if available)
+ Lvalue: add sever method
+CS - Inline::Pdlpp docs addittions, test script added
+CS - NiceSlice modifiers + bug fix
+CS - Inline::Pdlpp !!!
+DJB (23/Aug/01)
+ - you no longer need to surround options by {} for
+ PDL::Graphics::PGPLOT::Window->new()
+JB - Added a recording feature to the PGPLOT interface.
+CS - NiceSlice doc update
+JB (14/Aug/01)
+ - Added a package wide store for options for env. This allows the
+ next device to reuse the most recent set of env options.
+CS - minmax: return scalars!
+ - PDL::Options for PDL::Graphics::Karma
+ - disable PDL::PP SIG{__DIE__} overload by default
+DJB (07/Aug/01)
+ - added VertSpace to ...PGPLOT::Window's legend()
+CS - make sure perldl works with NiceSlice
+ - add nslice to lvalue funcs
+ - new 'sclr' method
+ - enhanced clump interface
+ - pdlapi: backport pdl_get vaffine
+ - experimental 'autosever' for PDL::NiceSlice
+ - quieter 'mkhtmldocs'
+ - fix OpenGL docs screwing up online help
+DJB (05/Aug/01)
+ - applied wfits patch from Diab Jerius
+ ([ #443431 ] wfits outputs illegal FITS keywords)
+ - added test for whist to t/hist.t from DIAB Jerius (patch #443438)
+ - added 'demo ooplot' to demonstrate "new" interface to PGPLOT
+CS - PDLCode.pm: fix bug #441586: PDL::PP cant handle pars with numerals
+CS - primitive.pd: fix random funcs so that they work with Perl's srand
+ * does it work on pre-5.6 perls? *
+ - update Lvalue documentation
+CS - slices.pd: fix lags bug #436823
+ - Fit/Polynomial.pm: normalization wasn't threaded (bug #438335)
+ - PP.pm: make CoreSv linkage static (MacOSX)
+ - Basic.pm: apply whist patch
+ - PDL::SFilter renamed to PDL::NiceSlice
+CS - fix MANIFEST
+ - fix 'reduce' docs
+ - SFilter improvements
+ - which and which_both now auto-flatten the input piddle
+ to match 'where' behaviour
+ - Core.pm: 'flat' change and added 'nslice'
+ - pdlcore.h : compatibility with C++ compilation
+ **** required renaming 'new' member of struct Core to 'pdlnew' !! ****
+CS - Makefile.PL: Filter::Simple, Text::Balanced dependencies
+ - bad.pd: fix for win32
+ - Lib/Slatec/Makefile.PL: win32 fix
+ - t/flexraw.t: remove extraneous 'use ExtUtils::F77'
+ - t/poly.t: win32 needs larger error threshold ?:(
+ - t/sfilter.t: script broke on platforms without prereqs
+ - win32: general update for latest build; add slatec support
+DJB (20/Jun/01)
+ - make bad.pd compile with PDL::Type changes and fix minor bug
+CS - fix rvals bug (annoying one!)
+ - syntactical sugar: convenience operators for PDL::Type
+CS - Basic/SourceFilter (see also L<PDL::SFilter>)
+ - generate PP templates with pptemplate
+ - PP: pp_boundscheck (see PP.pm)
+CS - PP.pm: remove first '$this' arg from pp_add_exported!
+ - LM.pm: fix implementation bug; still not sure if it works properly
+ need more tests!
+ - apply Raul's debian patch
+DJB (7/Jun/01)
+ - minor fix for rfits() with bad-value support
+John Cerney (6/4/01)
+ - Doco fix in complex.pd
+CS - image2d.t skip fix
+ - mslice update
+ - numeric for PDL::Char
+DJB (24/May/01)
+ - fixed bug in Image2D::centroid2d when (x+box/2) > m (ditto for the y
+ axis). Added bad-value support to centroid2d and max2d_ind
+DJB (8/May/01)
+ - OpenBSD doesn't seem to have values.h, which causes Basic/Math to fail:
+ see http://testers.cpan.org/search?request=dist&dist=PDL#2.2.1
+ Now using limits.h in Basic/Math/mconf.h for GNU systems - only tested
+ on solaris and i386-linux.
+ - fixed typo in debian/rules
+John Cerney (5/3/01)
+ - Simple change to primitive.pd so that interpol sub
+ makes it into the PDL namespace, and not just the
+ PDL::Primitive namespace. Also added a simple test
+ case for this routine.
+CS - F77CONF variable for debian build (see INSTALL)
+2.2.1
+John Cerney (4/25/01)
+ - Changes to Release_Notes, PDL.pm, TODO associated
+ with making release 2.2.1
+CS - PDL::Lvalue -- PDL lvalue subs (added to loaders)
+ - PDL::Matrix -- added docs
+ - doc tidbits
+ - don't test raster and SGI formats any more (pic(no)*rgb.t)
+John Cerney (4/11/01)
+ - Modified t/opengl.t to turn-off the PERL_DL_NONLAZY env variable
+ when running this test. Due to some inconsistencies in the opengl
+ headers (gl.h, glu.h) and what functions are actually in the opengl
+ libs, PDL's OpenGL.so sometimes (When using Mesa 3.3 for instance)
+ gets built with interfaces to functions that aren't there. Setting
+ PDL_DL_NONLAZY=0 prevents the test case from failing in these
+ cases.
+DJB (10/Apr/01)
+ - hacked Core/Dev.pm to work with perl 5.6.1 (ExtUtils::Liblist has
+ changed although its documentation has not)
+CS - applied Christopher Marshall's minimum_n_ind patch (bug #413184) + test
+CS - fix mem leak patch so that core struct version croaking works
+ * NOTE: recent patches will require recompilation of any external
+ * modules that use PDL::PP; PDL will tell you when using such
+ * modules *
+ - barf is now really only an alias for croak; this is a test if we
+ can live with the original croak; we should be able to!
+ - update COPYING for the 21st century ;)
+John Cerney (4/3/01)
+ - Modified Makefile.PL in Graphics to add '-lm' to the libs.
+ This fixes a 'Can't locate auto/PDL/Graphics/OpenGL/glpcOpenWin.al'
+ error in make test during opengl.t for some platforms.
+ Shouldn't hurt otherwise.
+CS
+ - make_physvaffine is now a member of the core struct
+ - pdl_get is now vaffine aware (must be preceded by call to make_physvaffine)
+ - worke around bug in the core logic (pdl_make_physical et al.) that
+ cause index and others to leak memory; not the perfect solution yet
+ but core logic is just way too confusing to make sense of it!!!!!!
+ for details see comments in pdl_make_physical (pdlapi.c.PL) and
+ pdl_initthreadstruct (pdlthread.c)
+ - slatec: document the 'det' function
+DJB (26/Mar/01)
+ - PDL::Func now sets bc => 'simple' as the default for Hermite
+ interpolation.
+DJB (14/Mar/01)
+ - PGPLOT::Window changes: addressed "undefined window size" part
+ of bug #406858; added PosReference option + minor bug fix
+ to transform()
+ - renamed PosReference to RefPos. close() will print a message if
+ a hardcopy device and $PDL::verbose is set, hack to fix bug
+ #408589 (draw_wedge() erasing plot) for simple cases (15/Mar/01)
+DJB (27/Feb/01)
+ - addressed PDL::Func bugs/doc issues as reported by
+ HalldBBBBBBBBsr Olafsson and Vince McIntyre (bug #233484)
+CS - fix bug in pow in math.pd (reported on perldl mailing list)
+CS - fixed bug in writing pnms (bug #127696)
+ - Core.pm: temporary fix to work around core bug (see comments
+ in pdl_make_physical in pdlapi.c) that made convert
+ leak memory (related to bug #116501)
+CS - fixed diagonal bug that caused apparently random errors
+ (bug #116502)
+CS
+ - changes for win32 compatibility:
+ pdlcore.c: avoid die_where & co, use Perl_croak instead
+ Math/cpoly.c: win32 doesn't know about values.h
+ Lib/Image2D/resample.h: win32 doesn't know about M_PI
+ t/fastraw.t: skip mmap tests on win32
+ - slices.pd: possible rotate segfault fixed
+ - fix slight mslice problem (didn't make sure its inputs were
+ converted to int)
+ - new functions 'in' and 'uniq' in primitive.pd -> need tests
+ - image2d: a slightly faster median: med2df
+ - new function approx in Core.pm
+ **** attention: possible name clash; test scripts should *****
+ **** use tapprox from now on *****
+2.2
+John Cerney (20/12/00)
+ - Minor changes to Makefile.PL and Reduce.pm for compatibility with
+ perl 5.005
+John Cerney (6/12/00)
+ - Added new curve fitting routine: Linfit. Finds
+ a linear-combination of specified functions
+ that best fits data. (Similar to Polynomial.pm)
+Marc Lehmann (5/!2/00)
+ - Don't add artificial newlines in PdlParObj.pm, you never know what the
+ surrounding code might look like. Makes PDL compile with perl-5.7 again.
+John Cerney (5/12/00)
+ - Updated log10 in ops.pd to have consistent
+ copy behavior for subclassed objects as discussed
+ in Objects.pod.
+ - Expanded the tests in t/subclass4.t to test for log10
+ and other simple functions.
+
+CS - added some features to dice
+Doug Burke
+ - rcols(): do not read an extra line with LINES option (Frank Samuelson)
+ - added draw_wedge() (& DrawWedge option to imag()) to PGPLOT
+CS - fix call of Perl_croak in pdlthread.c for threading perls (reported
+ by Diab Jerius)
+Doug Burke (03/11/00)
+ - removed $_ from shorttype method: fixes $_->info() bug
+ - perldl/pdldoc now list other matches to a help query (not wonderful)
+ - fixed 0.5 pixel shift in imag()
+CS - fix bug in splitdim (didn't check nthdim) that can lead to coredumps
+ - Dev.pm: malloc debugging support
+ - Core.pm.PL: flat as clump(-1) alias
+ bug in mslice: cast indices to int added
+Jarle Brinchmann (22/10/00)
+ - Further bug fixes to PGPLOT added (courtesy of Kaj Wiik). Also a
+ convenience function to calculate transforms (transform, courtesy
+ of Kaj Wiik).
+ - Examples/tests for the PGPLOT interface added in Example/PGPLOT
+Jarle Brinchmann (21/10/00)
+ - Considerable re-write of PGPLOT. This now uses PDL::Option to
+ set options. There is also now a OO interface
+ PDL::Graphics::PGPLOT::Window which PDL::Graphics::PGPLOT now uses.
+
+ - New functionality includes:
+
+ - Interactive cursors (cursor)
+ - Text on plots (text)
+ - Legends (legend)
+ - Circles, Rectangles, Ellipses
+ - Multiple plot windows, oone can jump from panel to panel when
+ the window is divided in several.
+ - More control over options - see PDL::Graphics::PGPLOTOptions for
+ details.
+ This is not tested under Windows - and possibly not all functions work
+ as they used to..
+Doug Burke (18/10/00)
+ - added warp2d (+ supporting fns) to PDL::Image2D. This allows
+ images to be resampled using 2D polynomials as basis functions.
+ - (19/10/00) bug fixes & clean up of documentation for above
+ - rfits() now sets hdrcpy flag of piddle (so that the FITS header is
+ copied to new piddles).
+Doug Burke
+ - moved PDL::Type object from PDL::Core to PDL::Types. This shouldn't
+ affect most people.
+CS
+ - split primitive.pd into primitive.pd and ufunc stuff (ufunc.pd)
+ - changed loaders to reflect this split (PDL.pm, Lite.pm, LiteF.pm)
+ - moved 'assgn' to PDL::Ops (since it's primarily used for
+ overloading '.=')
+ - added conv1d to primitive.pd -> this one was dropped
+ from the dist at some stage but it makes sense to have it
+ - Pic.pm: print conversion message only when debugging
+ - fixed a problem with TriD: APIENTRY not defined when
+ processing glu.h (since include files are ignored)
+ - added sever docs
+ - a reduce function for PDL (Reduce.pm)
+ - percentile projections patch applied to primitive.pd
+ - fix some thread_define problems
+Doug Burke
+ - improved support for bad values in r/wfits and r/wndf
+ - added setbadtonan() to PDL::Bad.
+ - moved log10() entirely over to Basic/Ops/ops.pd (so it's no longer
+ defined in PDL::Core.
+CS
+ - moved trylink to Dev.pm (L<PDL::Core::Dev>)
+ - modified Graphics/Makefile.PL accordingly
+Doug Burke
+ - cleaned up endian support. Threw out my check_endian stuff since perl
+ already knows - there's a isbigendian fn in Dev.pm (eg see
+ IO/Misc/misc.pd)
+ - added setvaltobad() and setnantobad() to PDL::Bad, renamed replacebad()
+ to setbadtoval() (perhaps should keep it as an alias?)
+ setnantobad doesn't work (yet) if $PDL::Bad::UseNaN == 1
+CS
+ - added Matrix.pm (suggestion by Stephan Heuel)
+ - Core.xs.PL: getdim, at and set now support the 'infinite dim'
+ piddle behaviour discussed on pdl-porters
+ - perldl: $bflag incorrect due to low 'and' precendence
+ - PDL.pm: the version was still far behind ;-(
+ - Basic.pm: PDL->null breaks inheritance
+ - Core.pm.PL: allow <2D piddles as arguments in creating functions
+ (not yet reflected in the docs). Another step on the way
+ to improve the balancing act between scalar and 1D piddles
+ and normal perl scalars
+ - Core.xs.PL, pdlcore.h.PL: PDL.malloc -> PDL.smalloc renamed
+ - Core/Makefile.PL: endian stuff only when WITH_BADVAL (reduce
+ likelihood of build problems); don't assume that '.' is in the
+ PATH (good distributions like DEBIAN avoid that ;)
+ - Doc/Perldl.pm: new (undocumented) aproposover function -- do
+ your own thing with returned matches
+ - karma.pd: PDL->malloc -> PDL->smalloc
+
+Doug Burke (09/06/00-09/07/00)
+ - Core and pdl_trans structure are now the same, whatever the choice of
+ WITH_BADVAL and BADVAL_USENAN. The version number of the core has been
+ bumped to 2 (removing the need for Christian's recent patch) since this
+ is binary incompatible with PDL 2.1.1
+ - clean up of build process - both because of above change and also to
+ stop problems when switching between WITH_BADVAL = 1 and 0.
+ - exported several routines in PDL::Bad
+Jim Edwards
+ - improved OpenGL detection during 'perl Makefile.PL'
+Doug Burke (09/05/00)
+ - minor clean-up to the build process. Now creates Basic/Core/badsupport.p
+ in top-level Makefile.PL for when PDL::Config hasn't been created - fixes
+ setting BADVAL options in ~/perldl.conf
+Doug Burke
+ - Bad value support integrated into the main branch. Set WITH_BADVAL to 1 in
+ perldl.conf to use. See Basic/BadValues.pod for more information and try
+ the two demos (demo bad, bad2).
+ Many of the internals have been tweaked (eg many more files are created at
+ compile time in Basic/Core - including Dev.pm; m51.fits is now installed
+ for the bad2 demo ...)
+ - Basic/Core now contains isbigendian.p - this is created at compile time.
+ IO::Misc::isbigendian uses this.
+ - IO::NDF now saves byte piddles as "_UBYTE", rather than "_BYTE", NDFs
+ - log10 is now in Ops (using C-library version), although a version is
+ left in Core.pm.PL so that log10(2.3) returns a perl scalar, not a 0D piddle
+ - removed 1-argument form of where() since been deprecated long enough
+Jim Edwards
+ - swcols added to IO::Misc - like wcols but to a string, not a file
+Jim Edwards (08/25/00)
+ - minor bugfix in TriD contour3d
+ - added Labels to TriD contour3d options
+Doug Burke (08/12/00-08/13/00; 08/17/00)
+ - minor bugfix to Graphics/Karma/Makefile.PL
+ - made qsort and qsort_ind C routines in primitive.pd available to all
+ modules via the PDL Core structure (pdlcore.h is now created by pdlcore.h.PL)
+ and updated image2d.pd to use this (+ bug fix to patch2d)
+ - added double precision versions of sum, sumover, cumusumover (same for prod)
+ and average (eg dsum, daverage). Added prodover routine
+ Changed stats to use this (+ changed PDL::Tests to avoid name clashes)
+ - revamped Types.pm.PL
+ - made Inplace option for pp_def a bit more sensible
+ - marked several functions in math.pd as inplace (needs documenting)
+ - fixed rndf() so that can use rndf('../bob')
+Jim Edwards (08/08/00)
+ - Major changes to the TriD code (requires perl 5.6.0)
+Doug Burke (08/02/00)
+ - 'bool' to 'boolvar' in cpoly.c to get it to compile under Linux
+ - added 'Inplace' rule to PP.pm to flag a routine as inplace (see ops.pd)
+ - minor improvement to PP output if $::PP_VERBOSE is set
+CS - ops.pd: fix inplace problem (reported by Tim Conrow)
+Doug Burke (07/27/00)
+ - some minor changes to PP.pm & PDLCode.pm (no longer generates
+ 'THISISxxx' macros in xs code unless they're required.
+CS - PP: don't use copy method when HASP2Child
+ - Makefile.PL: no .3 manpages
+CS - Core: pdl.h dependencies
+ - pdlapi.c: comments and debugging
+ - ops.pd: docs fixes
+ - PGPLtw.pd: doc fOT_demo: choose /GW on MSwin32
+ - mkpdlfuncpod: some experimentation
+ - Karma/Makefile.PL: malloc debugging support
+ - CallExt/Makefile.PL: malloc debugging support
+ - fftw.pd: doc fixes, exports and convolution
+ - slatec: error handler now calls croak (instead of being fatal)
+ - VRML: fix problem with prototype registration
+Doug Burke (7/02/00 - 7/9/00)
+ - stopped some excess code generation & improve legibility of some code
+ in Basic/Gen/PP.pm and Basic/Gen/PP/PdlParObj.pm
+ - minor doc cleanup in Graphics/TriD/Rout/rout.pd (lack of head3 in pod)
+ - added a test to t/hdrs.t to pick up a bug I'd introduced
+ - replaced Basic/Core/mkpdlconv.p by Basic/Core/pdlconv.c.PL, removed
+ mention of pdlbasicops in Basic/Core/Makefile.PL
+Tim Jenness (6/30/00)
+ - PDL::CallExt now works on WinNT with VC++
+Doug Burke (6/29/00)
+ - added methods to PDL::Type - enum, symbol, ctype, ppsym, realctype
+ and shortctype - which provide access to information in PDL::Types
+ eg print byte->ctype prints "PDL_Byte".
+ Changed info in Core and rcols in IO/Misc to use these methods.
+ Currently un-documented.
+Tim Jenness (6/28/00)
+ - miscellaneous patches for Win32 support
+ Make Callext.pm and callext.t more generic
+ Lib/Image2D check for presence of rint()
+ Add ABSTRACT and AUTHOR to top level Makefile.PL
+ - conv.t now uses the Test module
+Doug Burke (6/21/00; 6/22/00)
+ - mkhtmldoc.pl should now handle links to scripts in Index.pod for
+ perl < 5.6.0. Removed link hacking for perl >= 5.6.0.
+2.1.1
+CS - fix Perl_croak problem with 'usethreading'
+Doug Burke (6/15/00)
+ - hand-rolled podselect (podsel) created if perl version earlier than
+ 5.6.0
+Doug Burke (6/9/00)
+ - added Christian's changes to online documentation to support scripts
+ (eg see Index.pod or Index.html)
+Jim Edwards (5/19/2000) TriD (cvs brance trid_experimental) (merged 6/7/00)
+ - several changes in TriD including a new Tk widget,
+ see the file PDL/Graphics/TriD/README
+ - added TkTriD demo to perldl.PL
+2.1
+Marc Lehmann (6/7/00)
+ - enable sincos optimization only for glibc >= 2.1
+CS - warn if 5.004 that next version will require 5.005
+ - PL_na issue in PGPLOT.xs
+ - disable sincos optimization in complex.pd until glibc issues sorted
+John Cerney (6/2/00)
+ - Updated FAQ to match the Jarle's version at
+ http://www-astro.physics.ox.ac.uk/~jarle/PDLfaq/pdlfaq_new.html
+Doug Burke (5/31/00)
+ - more minor doc patches
+John Cerney (5/26/00)
+ - Applied patch to fix reflect options in conv2d (image2D
+ function) not being symmetric. Ref sourceforge Patches 100287,
+ 100359, and Bug 104614.
+Doug Burke (5/25/00)
+ - added 'pdldoc' shell command to provide access to PDL documentation
+ without having to start up perldl
+ - cosmetic changes to output of usage + minor doc change to PDL::Basic
+John Cerney (5/25/00)
+ - Modified PP.pm to call $arg1->copy for subclassed
+ objects in some simple cases, otherwise call
+ $class->initialize. See Basic/Pod/Objects.pod
+ for a detailed discussion.
+Doug Burke (5/23/00,5/24/00)
+ - corrected faulty t/interp.t and t/interp_slatec.t scripts
+ - minor doc changes to Indexing.pod, image2d.pd, fft.pd & NDF.pm
+ - added FRAME option to iis (Graphics::IIS)
+CS - hopefully the PDL::Filter modules will work now
+ a proper test should be added
+Doug Burke (5/22/00)
+ - Graphics::IIS - now works with new PP code + minor doc changes
+ - Func - changed gradient() to work as described + added PDL::Func::
+ to method names in the documentation so they do not get picked up
+ by perldl's help (eg 'help set')
+ - \s to \\s in getfuncdocs() to avoid warning in Doc/Doc.pm
+John Cerney (5/21/00)
+ - Minor Changes to Basic/Gen/PP.pm to fix error reporting, and
+ to get rid of some warning messages when run with the -w
+ switch
+Doug Burke (5/19/00)
+ - Amalgated Interpolate & Interpolate::Slatec into PDL::Func (found
+ in Lib/). I've left the old files in the distribution, although they're
+ no longer made/installed, in case anyone wants to do a better job.
+ - minor doc changes to Image2D
+zowie - Changed PGPLOT::im to PGPLOT::imag1 (1:1 aspect ratio shortcut).
+ Avoids conflict with the imaginary-component sub by the same name.
+
+CS - fix for sever mem-leak -> ultimate source seems to be
+ a problem in destroytransform on un-physvaffined
+ piddle -- needs proper tracking down!!!!
+ - more types for Otherpars (PP.pm)
+Doug Burke
+ - added PDL::Interpolate and PDL::Interpolate::Slatec which provide
+ a (hopefully) simple, OO interface to interpolation methods
+CS - correct PDL::Ops docs
+ - fix problem in pdl_croak_param (pdlthread.c) due to changes
+ in Perl_mess in perl 5.6
+ - update TODO
+zowie - Autoloader update (handles '+' for entire dir trees)
+ - Graphics::PGPLOT::imag update (includes options for image scaling)
+ - perldl update (minor fix to avoid null code ref bug in PDL::myeval)
+
+CS - debian stuff
+ - image rotation (rot2d)
+ - karma kimagergb renamed to krgb
+ krgb -> can send 3d RGB piddles now (i.e. [3,x,y,z] piddles)
+CS - quick (and semi-dirty) inplace fix for ops.pd
+ - slices.pd: fix xchg,mv not catching negative dims,
+ treat neg dim indices like neg perl array indices
+Doug Burke (4/29/00)
+ - fixed interpol failing to recognise extrapolation at 'high' x +
+ added interpolate with slightly different error handling
+ - commented out 'use PDL::Lib::LLSQRout' in PDL/Lib/Gaussian.pm
+Tim Jenness (4/26/00)
+ - Patch mconf.h so that it works on Alphas running Linux
+Doug Burke
+ - fixed apropos command to work with perl 5.6.0
+ - t/poly.t failed on solaris 2.7 with new PP code. Changed check
+ from < 200 to < 210.
+ - added PDL:getdim to Core.pm documentation
+Doug Hunt (4/26/2000)
+ - Merged fast-xswrapper branch back to main PDL tree.
+ - Left Ops thus:
+ All ops are are overloaded to call XS as directly as possible, but
+ the direct call of ops such as : $a->plus($b, 0) requires the '0' argument
+ which tells the XS routine 'plus' not to swap the arguments.
+CS
+ - slight ops.pd changes
+ - match prototypes with original ones in complex.pd
+ - some more work on PP.pm (yet unfinished)
+Doug Hunt (4/19/2000)
+ - Cleaned up Ops to take advantage of new fast XS wrappers
+
+Doug Burke
+ - changes to pod to HTML conversion. Links between modules - eg
+ L<PDL::Graphics::PGPLOT|PDL::Graphics::PGPLOT> - should now work.
+ See Doc/mkhtmldoc.pl and Doc/scantree.pl
+ - minor doc changes to a number of files
+ - Improved output from apropos (aka ??) in the perldl shell:
+ 1) ref string is now cleaned of any pod directives (eg C<$a> -> '$a')
+ 2) the formatting has been improved, so that it fills the screen,
+ word-wraps, and indents the ref string if printed on new lines
+ 3) better handling of long names
+ As an example, try 'perldl> ?? str' before and after.
+ However, it's a *horrible* hack - using undocumented parts of
+ Pod::Text to do 1 and 2, and calculation of screen width is poor.
+ Needs testing on perl 5.6.0 for a start!
+CS
+ - applied vaffine leak fix to main branch
+ - new polyfill function (image2d.pd)
+ - some (unfinished) preparations for easier leak debugging, see perldl.conf
+Doug Burke
+ - Added PCHIP routines tp PDL::Slatec (interpolation,
+ differentiation, and integration of functions).
+ Also moved creation of SlatecProtos.h from Makefile.PL
+ to slatec.pd
+ - stop wfits() from complaining when reading in the header
+ of FITS files from the DSS server at STScI
+ - minor clean up of write_dummy_make() Basic/Core/Dev.pm
+ - minor doc updates for PDL::Primitive and PDL::Basic
+ - converted FFTW and GSL to use write_dummy_make() in Makefile.PL
+Tim Jenness
+ - Update PDL::IO::NDF to v1.02, enhance reading of axis errors
+ plus some bug fixes.
+ - Add test for PDL::IO::NDF
+ - Added polynomial fitting routines to PDL::Slatec (polfit,
+ pvalue and pcoef)
+
+John Cerney
+ - Added (psuedo)-support for variable-size strings in PDL::Char
+
+2.005
+CS - version to 2.005
+ - finally try to fix 5.6.0 problem correctly
+Doug Burke (4/4/00)
+ - Changed to Basic/Makefile.PL to install man pages for PDL,
+ PDL::Lite, PDL::LiteF, and PDL::Options.
+ - Changed Makefile.PL to allow installation of documentation if
+ INSTALLDIRS=perl (rather than site) is used
+CS - applied Karl's 5.6 patch to pdlcore.c
+ - typo in Doug's error message fixed
+Doug Hunt (3/23/00)
+ - Improved error messages in PDL::Graphics::PGPLOT for the case when the
+ correct version of PGPLOT (v2.16 or later) is not installed.
+
+
+2.004
+John Cerney (3/16/00)
+ - Added -lm to the Lib/Image2D/Makefile.PL suggested by Doug Burke
+ to fix a compile problem on Solaris 2.7.
+John Cerney (3/15/00)
+ - Added Christian Pellegrin's bilinear and image scaling patch.
+ with cleaned up docs and test cases.
+ - Update Version to 2.004
+Doug Hunt (3/8/00)
+ - Added 'use PDL::Graphics::PGPLOT' to Demos/PGPLOT_demo.pm. Now it works.
+ This bug was introduced in my 3/2 and 3/3/00 changes.
+
+John Cerney (3/5/00)
+ - Modified Basic/Complex/Complex.pd to not generate warning messages
+ when re-defining the PDL overloaded operator subs.
+Doug Burke
+ - IO::Misc - default type for DEFTYPE (rcols option) is now definable
+ using the $PDL::IO::Misc::deftype variable.
+
+Doug Hunt (3/3/00)
+ - Removed PDL::Graphics::PGPLOT from PDL.pm. This had been causing
+ troubles due to the previous change which took away autoloading
+ in PGPLOT.
+
+Doug Hunt (3/2/00)
+ - Updated Graphics/IO/PGPLOT, adding a typemap and a PGPLOT.xs file.
+ This change added capability to PDL::Graphics::PGPLOT::line, allowing
+ one to use the 'MISSING' option. When this option is specified, 'line'
+ will draw many disconnected polylines (delimited by the value specified
+ as 'MISSING') instead of just one. This is useful in drawing maps with
+ line.
+
+Marc Lehmann
+ - Patch to Basic/Core/Dev.pm fix Parallel build bug. (Ref PDL-Porters Messages
+ dated 1/8/00 and 1/5/00.)
+ - Small Patch to Graphics/Karma/karma.pd. Change 'na' to 'PL_na';
+ (PDL-P msg 1/15/00)
+
+Robin Williams:
+ - Patch to Graphics/TriD/OpenGL/generate.p to get
+ OpenGL working on OSF (it crunched because
+ perlxs interprets the #ifs as comments
+ if they're indented).
+
+Karl Glazebrook:
+ - Patch to Perldl.PL to improve readlines handling:
+ - tells you which module it is using
+ - correctly informs whether editing is available or not
+
+John Cerney
+ - Documentation fix for FlexRaw.pm (Based on change submitted
+ by Francois Primeau.)
+ - Updated Makefile in FFTW to correct a build problem that occurs
+ when both single and double FFTW libs are present. (suggested
+ by Diab Jurius).
+ - Updated TriD Makefile to find openGL libs specified in the
+ perldl.conf file.
+ - Updated Graphics/TriD/OpenGL/generate.p to include patch by
+ Diab Jerius (ref PDL-Porters message dated 11/9/99).
+ This fixes compilation problems with native openGL on solaris.
+ Note: Patch to Graphics/TriD/TriD/GL.pm was not applied. (Risk
+ of breaking GL on other platforms)
+
+CS
+ - added function 'det' to PDL::Slatec -> calculate determinant
+
+Doug Burke
+ - Graphics::LUT - added several intensity ramps, instead of just
+ using a linear scale.
+ - internal changes to Graphics::LUT - now stores data in external
+ FITS files rather than within the module to improve speed and
+ reduce use of disk-space.
+ - first attempt at improving installation of OpenGL stuff
+ - Graphics/IIS/iis.pd: minor change (re Christian's PP changes)
+ - Graphics/PGPLOT/PGPLOT.pm: add CENTRE option [bin()], doc update
+ - minor code cleanup for IO/NDF/NDF.pm and IO/Misc/misc.pd
+ - added docs for sethdr to Basic/Core/Core.pm
+
+Marc Lehmann
+ - small changes to complex.pd: remove bogus Cneg, streamline docs.
+
+Doug Burke
+ - added TYPES/DEFTYPE options to PDL::IO::Misc::rcols()
+ to specify the type of the piddles
+ NOTE: (!!!)
+ different from patch to 2.003 sent to perldl list
+ (http://www.xray.mpe.mpg.de/mailing-lists/perldl/2000-01/msg00037.html),
+ as you now specify the types directly, rather than as strings.
+ - added HEADER option to PDL::IO::Misc::wcols()
+ - added BORDER option to PDL::Graphics::PGPLOT
+ - added examples of new PGPLOT options to 'demo pgplot'
+ - added t/lut.t to test PDL::Graphics::LUT, and
+ added tests of options in rcols() to t/misc.t
+ - minor doc update for PDL::Primitive - example for whichND()
+ now works
+
+CS
+ - introduced switch for automatic hdr copying, off by default
+ - PP: added pp_addbegin, pp_beginwrap and pp_setversion
+ pp_addxs now adds to the current module's namespace by default,
+ !not! to PDL anymore (patch by Marc Lehmann)
+ pp_addisa now really works as advertised (i.e. adds to
+ @ISA and doesn't split on whitespace anymore)
+ - misc.pd: bswap functions work always inplace, remove
+ [o] from sigs
+ - added PDL::Complex to the dist (first try of a derived class),
+ does remarkly many things already but needs some testing,
+ donated by Marc Lehmann
+
+Doug Hunt
+ - added PDL::Char, a subtype of PDL which allows manipulation
+ of byte type PDLs as N dimensional arrays of fixed length
+ strings
+
+Doug Burke
+ - added AXIS option to PDL::Graphics::PGPLOT + doc changes
+ - added PDL::LUT module to provide colour tables - useful for
+ PGPLOT's ctab() function (note: plan, in near future, to
+ change to a binary format to reduce size of this module)
+
+CS
+ - Levenberg-Marquardt fitting module
+ - added required additional slatec functions + some docs
+ - some handy bits for PDL::Options function interface
+ - bool.t didn't make it into 2.002 (touch problem?)
+ - fftw.t test shouldn't rely on another module
+ - PDL::Doc: support input from more than one file
+ - Slatec/Makefile.PL: #include "g2c.h" seems unneccesary (and
+ leeds to trouble on my debian 2.1 system)
+ - PGPLOT patch from pdl-porters
+ - Robin's Basic/Math patches
+
+2.003
+Christian Pellegrin
+ - Patch to add an interface to the GSL
+ (GNU Scientific Library) package.
+ - Patch to compile under perl5.005_57
+ - Patch to add an interface to the FFTW
+ library. (A free C FFT library including
+ multi-dimensional, real, and parallel transforms)
+
+Christian Soller
+ - Patch to add 'any' and 'all' functions to use for comparison
+ operations. (e.g. This enables things like any($pdl == 3.2)
+ or all($pdl > 0) )
+ - Patch to picnorgb test to fix greyscale and rgb
+ generation on some platforms.
+ - Misc Patch: Make Image.pm return 1.
+ Make the gaussian fit routines use the correct
+ xvals.
+
+Karl Glazebrook:
+ - Patch to Basic/Core/Basic.pm to fix bug in
+ centre=> when operating on pre-existing array.
+
+John Cerney:
+ - Put File::Spec in the PREREQ_PM list. (PDL now
+ requires File::Spec since PDL2.002)
+ - Removed of ExtUtils::F77 from the distribution.
+ Added ExtUtils::F77 to the PREREQ_PM list.
+ (ExtUtils::F77 is already on CPAN separately.
+ Having it also distributed with PDL causes
+ confusion.)
+ - Fixed cumuprodover docs to be similar to
+ cumusumover.
+ - Fixed typo in squaretotri function. (na
+ changed to mna)
+ - Fixed IO/FlexRaw to find properly find the
+ howbig function.
+ - Fixed export of rasc and rcube in IO/misc/
+ misc.pd.
+
+Brian Craft:
+ - Patch to FastFaw.pm to fix sysread problems when
+ reading from fifos.
+
+Lupe Christoph:
+ - Patch to OpenGL.xs to compile with perlio/sfio.
+
+
+Brain Warner:
+ - Patch so t/poly.t doesn't fail if Slatec not
+ installed.
+
+
+Robin Williams:
+ - Added Singular Value Decomposition (SVD) function.
+ - Patch to IO/Browser/hists/dec_osf.pl to fix
+ small syntax in -D_XOPEN_SOURCE_EXTENDED
+ define flag.
+ - Patch to Basic/Core/pdlthread.c to clarify
+ error messages when barfing.
+ - Patch to fix problems with generate.p and
+ OpenGL on Solaris.
+
+
+Helmut Jarausch:
+ - Change to pldcore.c to fix problem compiling on
+ a IRIX6.5.3 box using perl 5.005_57
+
+
+Mark Lehmann:
+ - Patch to pdlcore.h and PP.pm to overwrite
+ croak() via PP and not in pdlcore.h
+
+Joshua Pritikin:
+ - Fix to Basic/Core/mkpldconv.p to change na
+ variable to n_a.
+
+Al Danial:
+ - Patch to fix compilation on RS/6000
+ running AIX 4.3.2 and perl 5.004_04.
+
+Doug Burke:
+ - Patch to iis.pd to allow the user
+ to change the title of an image
+ displayed with iis().
+ - Patch to IO/Misc/misc.pd:
+ 1) Added option PERLCOLS so you can now read
+ in columns into perl arrays at the same
+ time as reading in data into piddles.
+
+ 2) Changed the meaning of the 'c' parameter
+ in the LINES option. It will only affect
+ you if you use LINES together with
+ INCLUDE/EXCLUDE.
+
+ 3) It now complains if you forget to surround
+ patterns by //
+
+ 4) It will also warn you (if $PDL::verbose is true)
+ if no data is read in from a file.
+ - Patch to PP.pod docs to clearup PRIV/CODE usage.
+
+
+Tim Pickering
+ - Patch to Basic/Math/Makefile.PL to get the bessy0
+ and bessyn working again in glibc 2.1 systems.
+ (glibc 2.0 as in RH 5.2 or
+ debian 2.1 is not affected)
+
+2.002
+John Cerney:
+ - Modified Basic/Core/Makefile.Pl so that ppport.h
+ gets properly installed.
+ - Removed Version.pm from distribution. This file now
+ gets auto-generated during the build process.
+ - Fixed permissions of Known_Problems file.
+ - Misc Changes to Doc/mkhtmldoc.pl and Doc/scantree.pl
+ to make html links work correctly.
+ - Minor documentation fixes.
+
+Christian Soeller:
+ - Fixed documentation build problems. Install process
+ now builds a index html file.
+ - Changes to get the win32 activestate port
+ going. (available from
+ ftp://ftp.aao.gov.au:/pub/perldl/dev/Win32)
+ - Changes to compile under cygwin32.
+
+Doug Burke:
+ - Modification to slices.pd docs clarifying the
+ usage of -1 to indicate the last element when
+ slicing.
+ - misc.pd doc modification to indicate that rcols()
+ will ignore lines beginning with a # character
+ if no pattern is specified.
+ - misc.pd patch to rcols where options can now
+ be given to:
+ only include lines matching a pattern
+ exclude lines matching a pattern
+ only use a specified range of line numbers
+ - Patch to Graphics/IIS/iis.pd to fix warning messages
+ when running with the perl -w flag.
+
+
+Karl Glazebrook:
+ - Updated F77.pm to match version 1.10 of ExtUtils-F77.
+ - Added polynomial fit package Polynomial.pm
+ - Patch to Lib/Slatec/Makefile.Pl to fix problems
+ compiling on sparc/solaris
+ - Patch to Basic/Primitive/primitive.pd to make matmult
+ thread properly and to make matmult an exported function.
+ - Patch to Makefile.PL that allows PDL to be built and
+ installed conveniently away from it's final destination.
+ This is useful for making RPMs.
+
+Joshua Pritikin:
+ - Patch to pdlcore.c moving some #defines around
+ to improve portability between perl versions.
+
+Kristian Nielsen
+ - Patch to Basic/Primitive/primitive.pd to fix
+ whistogram and whistogram2d problems and updates
+ documentation.
+
+Robin Williams
+ - Update to Basic/Math/Makefile.PL.
+ - Update to Basic/Primitive/Primitive.pd to
+ include new functions. zcover, andover, etc.
+ - Patch to FFT to fix but with single-column/row
+ kernels
+
+Tim Jenness
+ - Patch to IO/NDF/NDF.pm that updates the
+ POD documentation and makes sure that the reader
+ skips any array extensions (like those generated
+ by Starlink CCDPACK).
+ - Patch to Lib/Slatec/Makefile.PL
+ to fix problems compiling slatec with g77 on Redhat
+ linux
+ - Patch to t/argtest.t, t/scope.t to get rid of
+ warning messages.
+ - Patch to perldl.PL that allows a user supplied
+ subroutine to be called to pre-process all perldl
+ strings.
+
+James Williams:
+ - Patch to mkhtmldoc.pl to fix problem with not
+ generating all html files.
+
+2.001
+John Cerney:
+ - Added reference to the CPAN testers results page
+ to the README file.
+ - Fixed improper comments (causing warning messages)
+ for '#endif _pdlmagic_h' in pdlmagic.h
+ - Removed reference to PDL being only at 'alpha release'
+ in Indexing.pod.
+ - Updated Christian Soeller's email address in all files.
+ - Clarified docs on the RMS element returned by the stats
+ function.
+ - Changed how $PDL::VERSION is set so CPAN will pick it
+ up correctly:
+ * PDL::VERSION is now set directly in PDL.pm
+ * Makefile.PL reads $PDL::VERSION from PDL.pm and
+ auto-generates Basic/Version.pm
+
+Joshua Pritikin: Changes for compatibility with PDL-Objstore.
+ Includes all the fairly conservative changes. More radical
+ changes to come.
+ - Deals with portability between perl versions using Devel-PPPort.
+ - Adds a version number to the PDL API.
+ - Optional bounds checking for PP.
+ - Simplistic support for C++ comments in PP code.
+ - Much improved searching for the Solaris math library.
+
+
+Jarle Brinchmann:
+ - Added 'isempty' function.
+
+Robin Williams:
+ - Doc tidying in Basic/Math together with a
+ wrapper routine for eigens and the start of a test set.
+
+Karl Glazebrook:
+ - Patch to where function in primitive.pd to fix
+ bug in ($i,$j,$k) = where($x,$y,$z, $x+5>0)
+ - Added PDL::Fit-Gaussion Module
+ - Patch to Core.pm so you can say $a = float(3,4,5)
+ just as you can say $a = pdl(3,4,5).
+ - Patch to slices.pd to export the dice and dice_axis
+ functions.
+
+Robert Schwebel
+ - Patch for the "perldl" shell that does the following:
+ 1.) Print out usage information if non-valid option is given.
+ 2.) Introduce "quit" equivalent to "exit"
+ 3.) some linebreaks to fit comments into 80 char terminals
+
+Christian Soeller:
+ - Commented out the close(STDERR) lines in pnd.pd to fix a
+ problem where the output from a 'die' is not seen for
+ certain test cases after using rpic/wpic from PDL::IO::Pic.
+ - Misc Patch:
+ - negative positions for dummy
+ - matmult now also supports promotion to sig dims
+ - PDL::matmult naming corrected
+ - MathGraph: call PDL::random
+ - Pic.pm: use PDL::Options -> minimum matching now supported
+ removed 'close STDERR' calls
+ - tifftopnm converter: added -nolut option
+ - pnm.pd: get rid of 'uninitialized...' warning
+ - flexraw.t: fix for broken linux dists that don't have compress (but gzip)
+ - picnorgb.t: hopefully got rid of error with SGI format
+ - slice.t/matmult.t: tests for new features.
+
+ - Patch to
+ - fix a bug when using pthreads and output argument creation
+ - new function PDL::Core::pthreads_enabled
+ - updated pthread.t
+ - Fixed a problem in pdlapi.c where some vaffine optimizations
+ had been broken by in a previous version. (Karl also added
+ a test case to complain if this is broken again.)
+
+Doug Burke:
+ - Patch to clean up some of the PGPLOT documentation.
+
+Harry Felder:
+ - Patch to Basic/Math/Makefile.PL to not depend on PWD
+ environment variable.
+
+Doug Hunt:
+ - Patch to Core.pm to add '$PDL::undefval' variable,
+ which controls how undefs are treaded when a PDL
+ is created from a perl structure using
+ pdl(), float(), double(), etc.
+
+Tim Jenness:
+ - Change to perldl to accept -w flag. This runs perldl
+ with the perl warnings (i.e. the perl -w flag) enabled.
+
+
+2.0 (1.99990 with very minor changes)
+John Cerney
+ - Fixed duplicate entry of PDL::IO::NDF information in the DEPENDENCIES file.
+ - Added more items to Known_Problems file.
+1.99990
+John Cerney:
+ - Renamed reorderDims method to reorder to slices.pd
+
+Christian Soeller:
+ - Dimension promotion of 0-d PDLs patch.
+ - Patch to pnm.pd to fix bug reported to the list by Karl.
+
+Tuomas Lukka:
+ - Allow mmapping of null piddles (i.e. zero-length vectors: dims = (0))
+ - Fix Math spelling mistake: PI0 -> PIO
+ - Fix Math compilation error: add ++
+ - Added close(fd) at the end of set_data_by_mmap in Core.xs
+
+Karl Glazebrook
+ - Added Rcube to IO/Misc.pd Reads list of files directly
+ into a large data cube (for efficiency).
+ - Corrected spelling error in the README file.
+
+Pete Ratzlaff
+ - Fix to imag() in PGPLOT.pm to set the world plotting
+ coordinates to a more sensible result when specifying
+ a translation.
+
+Jarle Brinchmann
+ - Added FITS header support for comments & history.
+
+Joshua Pritikin
+ - Patch to pdlapi.c to fix obvious memory leak.
+ - Patch to PP.pm to workaround @_ bugs in perl5.005.
+
+Robin Williams
+ - Fix for some reported compliation problems with Math
+ library.
+
+1.99989
+Tuomas Lukka:
+ - Added Fractal Mountain range to Tri-d demos
+ - Corrected error in impatient.pod. ('top right'
+ to 'top left' in 'Sections' section.)
+
+Tim Jenness
+ - Updated dependency file to reflect the addition
+ of PDL::IO::NDF to the distribution.
+
+Anton Berezin
+ - Modified Basic/Math/Makefile.PL to fix potential
+ conflicts with temp files in the /tmp directory
+
+John Cerney:
+ - Added reorderDims method to slices.pd
+ - Modified subclass2/3.t tests to be more representative
+ of how a functional object would be subclassed.
+ - Added '-I/usr/X11R6/include' to the default OPENGL_INC in
+ perldl.conf
+
+Robin Williams
+ - Cosmetic patch to TriDGallery
+ - Addition of intover (integral) to Primitive.pm
+ - Changes to Basic/Math files so that nan and
+ infinity handling are now in a consistent interface.
+
+Pete Ratzlaff
+ - Fixes typo in Gaussian.pm
+
+Karl Glazebrook
+ - Patch to IO/Misc/misc.pd to fix a minor bug
+ - Patch to IO/Misc/misc.pd to be more memory efficient.
+ - Update to Simplex.pm docs to be more clear to mere
+ mortals. Addition of tsimp2.pl example.
+
+Joshua Pritikin
+ - Patch to pdlmagic.h to fix problems compliling with
+ SunPro 4.2 C++.
+
+Christian Soeller:
+ - Added a quick/simple ascii file reader (rasc) to
+ IO/Misc.pd
+1.99988
+Christian Soeller:
+ - patch to make the picrgb/picnorgb tests fail more gracefully
+ with the commonplace 'maxval too large' problem.
+ - Corrections for docs in PGPLOT.pm
+ - Fix for pnm.pd to revert the STDERR redirection after
+ a file is opened.
+
+Karl Glazebrook:
+ - Updated Slatec's F77.pm from version 1.07 to 1.08
+ - Added qsorti function.
+ - Added Karma text overlays
+ - Added new indexing function dice_axis
+
+Robin Williams:
+ - Fix for browser warnings appearing on finicky systems.
+
+Jarle Brinchmann:
+ - Updated to PGPLOT.pm so that if you input a (100,1,100) image
+ to imag, the 1-element dimensions will be ignored. It also
+ checks that the piddle doesn't get too small, so that
+ if you input a (100, 1, 1, 1) image, it will be
+ treated as a (100,1) image by PGPLOT.
+
+John Cerney:
+ - Modified PP.pod to get rid of 'head3' errors from the pod2man
+ converters
+ - Modified PDL.pm PDL::Lite.pm , PDL::LiteF.pm so that the $VERSION would
+ be picked up correctly. 'use PDL 2.0' now correctly checks the version.
+ - Fixed dead links in pod documentation.
+ - Added dice and dice axis indexing functions in slice.pd
+ (Cerney and Glazeblook)
+ - Modified PdlParObj.pm to clarify 'too few dimemsions' errors.
+
+1.99987
+Karl Glazebrook:
+ - Fix for minor array bounds bug in image2d.pd
+ - Addition of PDL->create and PDL->destroy to pdlcore
+ Core.xs
+ - Change to perldl.conf to (a) Makes Karma find X better,
+ (b) finds MesaGL as well as GL by default
+ - Modification of the pic*rgb.t tests to fail more
+ gracefully with bad converters.
+ - Patch to Graphics/Karma/karma.pd to sort out some non-
+ standard options casing.
+ - Patch to Basic/Math/mconf.h to conditionally define
+ INFINITY
+ - Fix to IO/Misc/misc.pd so you can use pipes, + minor doc fix/update
+
+Jarle Brinchmann:
+ - Minor Demos/PGPLOT_demo fix.
+
+Tim Jenness:
+ - Patch to Core to get PDL->new() etc working.
+ (pdlapi.c, pdlcore.h and Core.xs )
+ - Patch to perldl.PL so that $string, $code
+ and $coderef can be used by the user.
+ - Changes made to directory structure so
+ NDF.pm would be installed correctly.
+
+Kaj Wiik
+ - Minor syntax fix to PG_PLOT.pm
+
+1.99986
+Robin Williams:
+ - Test for fft and fftconvolve and
+ fix for fft.pd
+
+Karl Glazebrook:
+ - Fix for PGPLOT to work more like
+ it should
+
+Anton Berezin:
+ - F77 Fixes for freebsd
+
+Anton Berezin
+ - Fix to Pnm/pnm.pd to work under perl5.005
+
+John Cerney
+ - Fixes for subclassing to work properly
+ - Addition of more test cases.
+ - PP.pm and PP.pod additions for subclassing.
+ - Minor Change to Html.pm to correct problem with it
+ creating false html references from .pod text that contained
+ '=head' as examples.
+ - Updates to Doc/mkhtmldoc.pl to fix most problems with html documents
+ not referencing each other correctly. In order to not change multiple
+ .pod documents and documentation in .pm files, html docs will now be
+ installed in ..../site_perl/PDL/htmldocs/PDL instead of
+ ..../site_perl/PDL/htmldocs. (If installing over a previous version,
+ the html files in .../site_perl/PDL/htmldocs should be deleted to
+ avoid confusion.
+
+Robin Williams:
+ - FFT test file addition (t/fft.t)
+ (Test number 2 fails... commented-out for now)
+
+Andy Dougherty, John Cerney
+ - Changes to compile with perl5.005
+
+Anton Berezin:
+ - Change for Browser to compile with freebsd
+
+Robin Williams:
+ - Change behavior of overloaded bool operator
+ to not stringify. This was causing a major
+ slowdown in cases where a PDL object was
+ being tested in a boolean context. (e.g.
+ if($PDL){ ...} )
+
+1.99985 (2.0 one half to go )
+Karl:
+ - PGPLOT_demo.pm was hosed by Tjl. Fixed
+ - same put in Makefile.PL and perldl.PL
+ - perldl.PL: syntax error.
+ - fft.pd: remove printf
+Tjl:
+ - (noticed by Robin Williams) Whitespace removals
+ - removed ops.pd SYNOPSIS
+Robin:
+ - fix to browse building
+Dov Grobgeld:
+ - the two pnm.pd one-liner for 5.005 (wpnm, rpnm)
+
+1.9998 (2.0 try 7, one more to go ;)
+Robin:
+ - spelling updates
+ - PP.pm: silence xsubpp about prototypes
+ - TriDGallery fixes
+ - perldl: use pager, accept sub as prompt (added to by Achim)
+ - PS to pnm in IO/Pnm/Pic.pm
+ - MPEG border
+ - ninterpol (n-dim regular grid interpolation), Lib/ImageND
+ - badmask
+ - fft.pd minimal patch
+ - "using"
+ - MPEG writing into stdin - save tmp files
+ - fft new version
+ - PP fixes: $P and cosmetics
+ - rebin (N-dim rebinning algorithm)
+ - rotate
+ - curses.h include
+ [ didn't include index() patch - incompatible. Maybe new name? ]
+Karl:
+ - ExtUtils/F77.pm new version
+ - debug/verbose patch
+ - shift_elements (but supplanted by Robin's rotate later)
+ - new Karma
+ - NAN shall not spoil minimum/maximum
+ - Make list() listindices do the right thing with nulls
+Tim Jenness:
+ - fix misc problem when trying to write complicated headers to fits
+ files
+ - NDF writing/reading using the perl NDF module
+ - MAIN__ into slatec.pd to avoid linkage errors
+ - PDL::Options
+ - minmax docpatch (modified by Tjl)
+Jarle:
+ - PGPLOT update
+Joshua Pritikin:
+ - -M, -m, -I arguments to perldl
+schinder at pobox.com:
+ - use -f in Makefile.PL
+Tuomas:
+ - Fix strndup in pdlthread.c
+ - error if RAND_MAX not defined
+ - cumu* (cumulative sum,product
+
+1.9908 (2.0 try 6)
+Tjl:
+ - memleak patch (idea by Robin)
+ - pdl_destroytransform so that it doesn't core dump easily any more.
+
+1.9907 (2.0 try 5)
+Christian:
+ - major patch containing stuff from other people.
+Joshua:
+ - dTHR -> errno if not defined
+Tjl:
+ - quaternion rotate routine was totally hosed.
+ added tests (probably will cause bad things where TriD
+ doesn't exist :(..
+
+1.9906 (2.0 try 4)
+Robin:
+ - patch Tjl's botched edit to his game of life
+ - perldl.PL: do paging with page() and nopage().
+Achim:
+ - doc_install, pure_perl_install.. hopefully these now work
+Joshua Pritikin:
+ - rename 'thr', 'op' and fix fftn.c error message for non-sick compilers
+ - fix NAN on suns
+Tjl:
+ - add #ifdef dTHR to be compatible with 5.004_*
+
+
+1.9905 (2.0 try 3)
+Someone (lost the mail):
+ - realclean Basic/Core/Config.pm
+Achim:
+ - don't install pod2usage, pod2select in script dir
+ - Lib/ImageRGB -> ImageRGB (!!!)
+ - DEBUGGING => PDL_DEBUGGING
+ - install patches for 5.005
+Tjl:
+ - remove gotos from str2D to not tickle bug in 5.004_64,
+ which I couldn't reproduce at smaller scale :(
+ - at Karl's prompting, removed the other mandelbrots for now :(
+ - Fix memory leak (reported by Kaj Wiik)
+ - change sin, cos, asin, acos, log, exp and the like to be [F,D]
+ GenericTypes only.
+Robin:
+ - TriDGallery: game of life! (edited by Tjl)
+Karl:
+ - new karma.pd
+ - reshape patch
+ - callext patch
+
+1.9904 (2.0 try 2)
+Tjl:
+ - (Andreas Heitmann): rename rs in the rest of places
+ - (Robin): openglq.pd: make COLORSAD not to warn for nonconstant init
+Karl:
+ - histogram fix (which earlier fell through Tjl's fingers)
+ - new ExtUtils::F77
+ - "aargh" patch
+Robin:
+ - Demos/TriD2.pm: fix state at end
+ - fix stupid Makefile.PL blooper by Tjl
+ - patch Perldl.pm to do 'help $a'
+
+1.9903 (2.0 try 1)
+Tjl:
+ - PDL::Lib::FFT -> PDL::FFT (Robert Schwebel)
+ - MathGraph stuff (same)
+ - tiny TriD tweaks for VRML::Browser
+ - strdup -> malloc(strlen+1)+strcpy
+ - rename 'rs'
+Karl:
+ - (finally applied) pdlcore.c datatype patch
+Jarle:
+ - minmax + which_two
+ - one2nd, whichND
+Robin:
+ - PGPLOT fixes
+Achim:
+ - Install fixes
+
+1.9902
+Tjl:
+ - fix pdlcore.c to work with MAGIC hashes, to enable really
+ wild constructions to come
+ - twiddle with flexraw.t
+ - PP cleanup: let 'SIZE' be used in RedoDimsCode. (needs to be cleaned
+ up from the other kind of access to this.. also need '$PDL(a)')
+ - null = just flag, so 0-dimensions are now allowed.
+ - allow which to take other types for mask as well... - required
+ cleaning PP to make RedoDimsCode be parsed just like Code, except
+ without threadloop. Seems to work nicely.
+ (I needed to take ($a == byte 5)->which for a large byte $a and
+ was horrified to find that my program grew to dozens of Mb)
+ !!! Note: possible incompatibility: before a floating value 0<v<1
+ would be interpreted as false, now true - but more logical this
+ way.
+ - where to take multiple arguments before the mask,
+ to map them all through the mask.
+ - add 'isnull' to Core.xs
+ - Basic/Gen/PP/PDLCode.pm to 'use strict', just in case...
+ - add 'Config.pm' to help with tests
+ - flexraw.t to use this
+ - Makefile.PLs to set the results of the tests.
+ - Maybe add PDL::Config_user later to store original
+ config hash values from user.
+ - threadover to clear NOMYDIMS flag.
+Raphael:
+ - Callext fixes for hp-ux, required an interface change !!!
+TODO:
+ - patch integration
+ - Makefile.PL should check for f77, store information and other
+ places just use that, especially the tests..
+
+1.9901
+Christian:
+ - new faq
+ - few changes to the demos (especially replaced
+ 'output ' with 'print' in the printouts; beginners might be confused
+ by the 'output' abstraction)
+ - new demo '3dgal' for the TriD Gallery
+ - install PDL::Graphics::VRML::Protos in the correct place
+ - fixed picrgb test to generate a warning when broken
+ tiff converters are encountered (patched source now included)
+ those who reported errors with this test please check again
+ after patch has been included
+ - make slatec clean rule more complete
+Raphael:
+ - fix Slatec Makefile.PL to work with more stringent makes
+ - provide 'rint'
+Tjl:
+ - change Copyright + files' copyrights
+ - new 3dgal stuff
+ - undo Slatec return -> exit: if slatec is not built, Lib/Makefile
+ didn't get built
+Robin:
+ - fix typo in Makefile.PL
+ - add C<> in PG.pm
+Jarle:
+ - better barf message for pdl((pdl 0), (pdl 1))
+Gerald:
+ - typo in PP.pod
+
+1.9900
+ - make perldl-documentation startup not depend on verbose
+ - '??' = apropos
+ - wcols (with Robin)
+ - fix the TriD demos a little bit...
+ - clip
+ - [xyz]linvals
+ - TriD doc bug fix: grabPIC3d
+ - vsearch
+ - FastRaw doc bug
+ - add to DEPENDS
+ - misc.pd typos
+Karl:
+ - deprecate where($a), multidim $a->where($b)
+
+1.98_02
+
+Tjl:
+ - add maptextfraw
+ - allow even more flexible PDL::Type::new: let it be a scalar piddle.
+ - made stringize use listref_c for additional speed & avoiding
+ stack overflows and other nasty stuff.
+ - add scope.t to finally test for export stuff working and fix PDL.pm
+ to use $pkg (from Karl).
+ - undid the stupid glPolygonOffsetEXT fix, now it should finally work.
+ - default.perldlrc: set verbose=0 to stop too much waffling!
+Karl [via Gerald]
+ - Makefile.PL: -I patch
+
+1.98_00 [ was 1.98_01 originally ]
+
+
+Tjl:
+
+ - Various typos - for copyright notices, find ... | xargs perl -p -i.bak RULEZ!
+ - remake Demos subdirectory with reasonable content.
+ - new TriD demos in Demos/TriD
+ - keeptwiddling3d etc. into TriD exported, NAME CHANGE !!!
+ - hold3d parameter
+ - POLAR2D context for TriD
+ - document TriD::MathGraph briefly
+ - fix TriD/Graph.pm to not barf when several graphs were removed
+ - Fix mmapped piddle freeing for fastraw - now magickable.
+ - Fix howbig, zeroes, Types stuff to accept PDL::Type objects
+ instead of numbers in more places, e.g. FastRaw. fastraw.t updated
+ - Removed TriD/Vertices.pm Lib/DataPresenter.pm
+ - removed some of the old crud in Core.pm
+ - Made Pod scanner not look into Pod::Parser.
+ - lots of doc fixes, moving docs into the new format.
+ - mkhtmldoc.pl: emulate "mkdir -p" when installing
+ - Doc/Doc/Perldl.pm: allow e.g. 'new' to get 'PDL::new' to save typing.
+ - standardize "3-d", "3-D" and "3d" into "3D".
+ - Die on errors in evals in Basic/*.pm!!! (e.g. dynaloader unresolved
+ symbols are now brought to light).
+ - fix "GetHistory" bug by checking for "can".
+ - Remove PCARout & PCA, as not really useful in present form !!!
+Robin:
+ - mconf.h osf warnings patch
+
+1.96_01
+
+ - TJL's jumbo patch
+ - stuff into Basic/Math
+ - TriD/MathGraph, for display of graphs in three
+ dimensions, by finding an appropriate representation
+ via a molecular dynamics-type search
+ - Christian's clipping patch
+ - set -ve indice patch
+ - added my wcols() to PDL::IO::Misc
+ - Lite.pm bug (Shawn)
+ - Robin's mconf.h patch and Kaj's erfi.t test inserted
+ - Christians type() patch
+ - Christians const.c patch for IRIX
+ - added Christian's COPYING suggestion
+ - heroically went through and changed all the copyright messages
+ on the docs to conform to the new standard
+ - fixed (c) notice in Core.pm docs, others still need to be
+ done
+ - better explanation of GenericTypes and Pars in PP.pod
+ - improved scantree.pl (portable cwd).
+ - HTML docs!! - thanks to Christian's mkhtmldoc.pl (some changes)
+ into the distribution. included a hacked Pod::Html (from perl
+ 5.004) as PDL::Pod::Html Still not great but gives us something
+ to work from. Some links still broken - patches welcome. See
+ file:/usr/local/lib/perl5/site_perl/PDL/HtmlDocs
+ for docs after 'make install'
+ - TJL's average() patch and primitive.t patch
+ - Docs now only built during 'make install' or 'make doctest'
+ (which builds them under ./blib), this saves them being built
+ unnecessarily during 'make'
+ - PDL::Slatec now works on any system with a f77 compiler.
+ All unused slatec functions were got rid of which fortunately
+ removed all the ones with COMPLEX arguments. Also changed
+ prototype generation which removes warnings on build.
+ Added local copy of ExtUtils::F77 back into dist and WITH_SLATEC
+ option to perldl.conf (undef by default for auto-decision).
+ - removed Example/PP - out of date
+
+
+1.95_07
+
+ - applied Christian's mega-patch - but there were problems
+ I had to fix manually.
+ (a) his maga-patch didn't include the patch to pdl.h he had
+ already made.
+ (b) the change should have been made to pdl.h.PL in any case.
+ - fixed NAME in Indexing.pod
+ - may have fixed executable install problem of 'perldl' shell
+ - fixed PDL.pm being lost from docs db
+ - Robin's problems 'compiling pdl 1.54_06 Basic/Math' patch 17/12/97
+
+ Rejected because of following error (Linux/gcc)
+
+ const.c:80: parse error before `3.14159265358979323846'
+ const.c:99: parse error before `__extension__'
+ const.c:99: parse error before `}'
+
+ Can the patch be revised?
+
+ - Robin's at() accepts -ve indices patch. Can we have set() to?
+ - removed 'docscan' and 'pdlhead2item' from MANIFEST - OK ?
+
+1.95_06
+
+ KGB
+
+ - FITS patch
+ - restored cc8compt fibonacci from pdl-porters archive (!)
+ - fixed misc module name problems in tests (thanks Bob!)
+ - Robin and Christian's help patches
+ - Robin's Object.pod patch
+ - Achim: chmod 0755 on Doc/*.PL,
+ - Achim wanted pdldoc.db in archlib, ignored this (don't understand
+ why)
+ - put fudge in ops.pd to get rid of that stupid compiler warning
+ with abs() and byte/ushort types
+ - rebuilt MANIFEST hope it is OK now
+
+ - introduced new barf(...) routine in Core.pm and pdlcore.c
+ [see help barf]
+
+ we should use barf(...) in C and Perl code instead of croak etc.
+
+ Note the barf engine is written in Perl, so is easy to customize!
+
+ - changed references to 'croak' in pd/xs/c code to barf(..)
+ or Perl_croak where appropriate
+ - changed references to 'croak' in various .pm files to barf()
+ where appropriate
+ - croak #defined to barf() in pdlcore.h to catch the use in
+ xsubpp (..fingers crossed..). Perhaps future xsubpp will allow
+ an override of this.
+
+ - renamed PDL::Io:: heirarchy PDL::IO:: for consistency with Perl IO::
+
+1.95_05
+
+ KGB
+
+ - Renamed PDL.pdl_make_physical PDL.make_physical (woops!) - ditto
+ physdims().
+
+ - Changed type config. Now Types.pm pdl.h pdlsimple.h are generated
+ AUTOMATICALLY from Types.pm.PL pdl.h.PL and pdlsimple.h.PL
+ files using perl Config information. int size issue is now handled
+ from perl config information. Lots of potential for more flexibility.
+ Hope this doesn't break Alpha stuff by mistake!
+
+ - Revised PDL::CallExt. Now uses make_physical rather than PP and allows
+ unlimited args in the same way as PDL-1.11. Ought to be more compiler
+ friendly too! Put callext.t back.
+
+ - Added 'dog' and 'cat'
+
+1.95_04
+
+ KGB
+
+ - Added glEnable/DisableClientState to dontfunc in OpenGL
+ - Doug: added fake MAIN_ to cfft.f in Slatec for old g77s
+ - Achim's patches of 4/12
+ - my IIS changes
+ - Robin's random and Inf/NaN patches of 4/12
+ - Christian: 'minor doc polishing Core.pm+primitive.pd'
+ - Christian: INSTALL patches.
+ - Christian: 'docs in Doc/Doc/Perldl.pm'
+ - Robin's minor perldl docs patch
+ - Restored my missing hist() patch and test of Oct 10th (sic)
+ - Achim's suggestions on help 'help' and help 'perldl', '?' and
+ allow no quotes (with warning)
+ - Added solaris_2 hints file for OpenGL
+ - Robins perldl pod patches but NOT 'l' as a synonym for 'last'
+ (I don't like this as 'last' is a perl keyword)
+
+1.95_03
+
+ KGB:
+
+ - Various small changes to TriD/test*.pl scripts. Renamed as *.p
+ - minor TriD changes to comply with new zeroes() etc.
+ - moved tests all into one top level t/ directory.
+ - corrected PDL::initialise and convert (Christian)
+ - Robin's primitive.pd patch
+ - callext.t temporarily disabled - I will rewrite the module.
+ - Minor changes to 'Doc'.
+ - TriD renamed to PDL::Graphics::TriD
+
+1.95_02 [emergency bug fixing release]
+
+ KGB:
+
+ - Redid all the zeroes/ones/[xyrz]vals/[g]random/sequence stuff
+ someone please please give me some objective advice :-)
+ - Added Robin's new FFT
+ - 3 byte change to Pnm.pm for new zeroes()
+ - added make_physical and make_physdims to PDL struct
+
+1.95_01
+
+KGB:
+
+ - Added Cephes code to PDL::Math as backup, changed signature of
+ jn, yn.
+ - changed scalar convesion in pdlcore.c SvPDLV() - '2.0' is now
+ double, '2' is now int. [Uses SvNOK SvIOK etc] - changed
+ Basic/t/conv.t to comply.
+ - Added magic {PDL} = code ref hook. And put test/example in
+ subclass.t
+ - random() is now like zeroes() and both allow type/dim and
+ $x template arguments. New arg proc. method to support this.
+ - Added grandom().
+ - Ressurected PDL::Exporter (q.v.). Much simpler than bizarrity
+ in PDL-1.11. Now 'use PDL::Mod' defaults to loading ':Func'.
+ Provision for noimports. Less typing!!!! Modified docs too.
+ - Renamed PDL::Graphics::PG PDL::Graphics::PGPLOT
+ - Reverted to manpages named PDL::FAQ.1, PDL::Dataflow.1, etc.
+ This is simpler and maintains consistence between manpage
+ and pod browsers. Fixed all the text links to comply.
+ - small changes to Pod/ docs.
+ - shut PP the hell up! Much less scary build now.
+ - added Pods to files scanned in building doc database.
+ - [xvyz]rvals now act like zeroes - but they now act like
+ constructos so $derived->xvals does not give you what
+ you expect. Need to think about this some more.
+
+1.94_09
+
+KGB: NOTE ONE MAJOR INCOMPATIBLE CHANGE [random]
+
+ - removed PDL_OPTIONS - PDL_CONFIG for everything. I think this is
+ better, e.g. if we want debugging we can add Debugging=>1 to
+ %PDL_CONFIG.
+ - changed use of PDL_CONFIG - see INSTALL. I think this is simpler.
+ - made Karma conform with above - and simplified.
+ - changed Callext arg limit to 10 to avoid compiler explosions.
+ - integrated PDL::Doc, created PDL::Doc::Perldl.
+ - manifying is now back from the .pm file rather then the .pd
+ (this is a better design now pod are semi-generated from PP)
+ - Christian's patches of 25/11/97:
+ 'Core.xs and pdlapi.c'
+ 'test' for Io::Pic
+ - added docs for Doc field in PP.pod and made one-line a special case
+ - Moved statistical functions from Basic.pm to Primitive.pm
+ - Lots and lots and lots and lots and lots and lots and lots and
+ lots and lots and lots and lots and lots and lots and lots and
+ lots and lots and lots and lots and lots and lots and lots and
+ lots and lots and lots and lots and lots and lots and lots and
+ lots and lotsof miscellaneous docs.
+ - Robin's browser patch of 26/11
+ - Core now completely OO - i.e. none of the stuff below Basic/ export
+ routines to each other and it still works!
+ - changed occurences of foo(sig) to use '=for sig' as this seems to
+ work better with Pod::Parser.
+ - made random $x=random($y), i.e. to get inplace now random(inplace $y)
+ OK?????????? This is because I think it is natural to say
+ $r = random(zeroes(10,20,2)), etc.
+ If this is a major headache let me know and I will change it back.
+ - Docs => undef allowed - no PP docs at all (not even the sig)
+ - Various changes to Docs.pm and Docs::Perldl.pm - apropos text searches
+ now include module names and one-line desriptions. God I love this
+ language.
+ - Renamed Iutil module as ImageRGB - hope this is OK???
+ - changed name of 'inv' to 'matinv' in Slatec for consistency
+ with matmult in Primitive.
+
+1.94_06
+
+Christian:
+ - lots of things.
+Robin:
+ - add type to PdlParObj.pm
+Achim (req):
+ - Version to Core.pm
+Tjl:
+ - New configuration.
+
+1.94_05
+... Not recorded. Real threading for example.
+
+1.94_02
+
+Lots of changes by everyone, e.g. FFT, Browser, ...
+
+1.94_01
+
+Christian:
+ - simplescaler
+ - VRML !!!
+
+Achim:
+ - misc.t patch
+ - Browser hints
+
+Karl:
+ - autocreation memleak patch
+
+Robin:
+ - flexraw test correction
+
+Jarle:
+ - Ops.pd: prevent creation of -0
+
+Tuomas:
+ - Core bug fixes for e.g. $a->slice("...")->index(...) .= foo,
+ originally reported by Christian.
+ - mandel.pl demo
+
+Others??
+
+1.94
+
+Kgb:
+ - Autoload patch
+ - subclass fixes: pdl_destroy + test.
+ - sethdr + gethdr ref counts
+ - rfits/wfits update
+
+Christian:
+ - where etc.
+ - imag3d without lines
+
+Kaj Wiik:
+ - tsimp.pl use correction
+
+Achim:
+ - Tk patch
+
+Tjl:
+ - Change PP.pm to really allow Pars => 'a(tri=>3)' to happen.
+ Embarrassingly, this was a one-liner.
+ - OpenGL libs changed to take both GL and MesaGL.
+ - openglq.pd: use tri=3
+ - rout.pd ditto
+ - TriD.pm: documentation updates & 'LINE' as context
+ - Graph.pm: coordinate axes labels!
+ - test7.pl: some niceties.
+ - make the thread incs etc. into register variables.
+ this should, with a good compiler, result in some speedup.
+ - primitive.pd: histogram -> histogram + whistogram,
+ more thread-friendly.
+ - correct foo.t
+ - TriD: add imag3d_ns (no surface) and minor twiddling.
+
+1.93_06
+
+Kgb:
+ - PP: use PDLOBJ for the stub subs.
+ - Basic.pm: sec, ins fixes - use "int" to ensure type of coords.
+ - PG.pm fixes
+ - IIS fixes
+
+Achim:
+ - ws fixes for docs, pptest.t
+ - "small perldl fixes"
+
+Tjl:
+ - start making support for piddle-controlled (e.g. affine)
+ transformations by using magic.
+ - Core.xs: setdims should now work with dataflow properly.
+ - Core.xs, pdl.h, pdlapi.h, PP.pm: add support for
+ foofunctions and PDL::Trans objects. These are a very basic way
+ of accessing the internals of transformations so that
+ in the future, as the mechanism is improved,
+ you can e.g. change your slice from outside.
+ The current level of support is enough to make a routine
+ that takes a slice of one dimension and is given offset and
+ increment and n in that.
+ - TriD:
+ - add test8.pl to demonstrate an use of foofunctions.
+ - document OpenGLQ and Rout
+ - add gl_triangles_n for shaded triangles
+ - TriD.pm:
+ - realcoords: add more contexts
+ - make the default routines all plot a graph
+ - GL.pm:
+ - add glPolygonOffset call to GL::Window in order to
+ get good-looking imag3d always
+ - change the colors to somewhat lighter ones.
+ - delete_viewports -> clear_viewports (like clear_objects)
+ - new argument to twiddle
+ - Graph.pm:
+ - default names for dataseries
+ - waffle less
+ - support changed dataseries
+ - Image.pm:
+ - use realcoords COLOR context
+ - Lines.pm:
+ - start deprecation by renaming package
+ - Objects.pm:
+ - realcoords support better by r_type
+ - waffle less
+ - SLattice_S to draw shaded lattices
+ - tests changed somewhat.
+ - Core.xs: remove pdl_unpackint unnecessarity
+ - Basic.pm: make axisvals return zeroes if not enough dimensions.
+ - Opt/Simplex/Simplex.pm: add support for temperature a la
+ Numerical Recipes.
+ - (Christian) - remove Data::Dumper from FastRaw.
+
+1.93_05
+
+Tjl:
+ - PP: several changes, basically inline *size and *incs into
+ register variables to speed up execution.
+ - TriD:
+ - add TriD/Rout for misc C routines for TriD
+ - add a routine to do flowing combination of 3 piddles into
+ coordinates or colours
+ - this makes the test3.pl data_changed stuff work again.
+ - imagrgb now defaults to a whole-window image - no reason
+ to make it rotatable with the mouse.
+
+1.93_04
+
+Tjl:
+ - TriD: add stuff for Tk
+ - OpenGL: ConnectionNumber
+ - ButtonPress + Release: more info back
+ - TriD.pm: add export imagrgb
+ - Control3D: small changes + TriD::Tk::post_menu
+ - GL.pm: ConnectionNumber support for Tk eventloop
+ - Graph.pm: minor changes
+ - Image.pm: major changes, make multi-D images actually work.
+ also, support for different multi-D background color.
+***** NOTE: calling convention now same as with coordinates!
+ this means an incompatible change.
+ - added Tk.pm, rudimentary support for a menu of actions
+ associated with the displayed 3D graph. Currently, can save
+ the image.
+ - test3.pl: change to new imagrgb calling sequence.
+ - GoBoard.pm: ditto
+ - test6.pl: test the Tk functionality.
+ - testimg.pl: really test the multidimensional picture facility
+ with an 8-D tricolor picture.
+ - Io/Pnm/Pic.pm: use the new 'Func' convention
+ - perldl.PL: new '-tk' option to use Tk and the Tk event loop.
+
+1.93_03
+
+Tjl:
+ - TriD:
+ - Change default controller to ArcCone
+ - Graphs with axes!
+ - PP:
+ - EquivDimCheck now honoured
+ - iis.pd: #undef Generic
+ - OpenGL/Makefile.PL update + generate.PL tuning
+ - Browse: manpage twiddle
+
+1.93_02
+
+Tjl:
+ - Core/Basic.pm: use PDL::Core qw/:Func/;
+ - Core/Core.xs, pdl.h, pdlapi.h: hdr stuff (untested)
+ - Core/Core.xs: bugfix threadover_n to make_physical
+ - Core/pdlapi.c: pdl_destroy will not destroy if an affine trans the
+ child of which hasn't been allocated exists.
+ - Core/pdlapi.c: pdl_changed will not try to do overeager
+ optimization. Fixes flow.t bug
+ - Basic/t/flow.t: enable again the tests that now work.
+ - Gen/PP.pm: new '$a = inner($b,$c)' changes.
+ - Slices/slices.pd: splitdim checks arguments
+ - Basic/t/thread.t: semi-add new test
+ - Graphics/TriD/OpenGL: new PDL::OpenGL module to enable virtualization
+ - Graphics/TriD/OpenGLQ: a test for TriD virtualization of OpenGL,
+ this will later on expand a lot
+ - Graphics/TriD/TriD.pm & TriD/*: new docs, small changes.
+ - Io/Fastraw/FastRaw.pm: don't waffle when mmapping
+ - MANIFEST.SKIP: add more ignorable stuff
+
+KGB:
+
+ - Fixed multiple 'use PDL' etc problem for loaders.
+ - "use 5.004"
+
+1.93_01 (Kgb) MAJOR CHANGES
+
+- these are very significant and affect code throughout the
+ system so EXPECT problems. In particular note that this code
+ is the new PATCHBASE.
+
+- NEW IMPORT/EXPORT system
+
+ PDL_OO.pm now deleted.
+
+ PDL::Exporter is DEAD and gone!! (hooray)
+
+ All modules now define their functions in package PDL.
+
+ The idea is a PDL::Module now looks like this:
+
+ package PDL::Module;
+
+ @EXPORT_OK = qw( sub1 sub2 ...);
+ %EXPORT_TAGS = (Func=>[@EXPORT_OK]);
+
+ @ISA = qw( Exporter ... );
+
+ *sub1 = \&PDL::sub1;
+ sub PDL::sub1 { ... def ...}
+
+ # If you wanted to do something special (e.g. a constructor) you can:
+
+ sub rfits(PDL->rfits(@_)); # This gets exported
+ sub PDL::rfits {
+ my $class = shift;
+ # etc...
+ }
+
+ i.e. the onus is entirely on the module writer.
+
+ Thus saying 'use PDL::Module' will load (cheaply) PDL methods.
+ If you want to (less cheaply) import functions say 'use PDL::Module qw/:Func/'
+
+ PP has been modified to generate modules which follow this scheme. i.e. by
+ default it stuffs its functions in to the PDL namespace, and writes stubs
+ '*sub1 = \&PDL::sub1;' into the PM file. This can be changed at whim
+ however. There is a new pp function - pp_bless('MyObj') which will change the
+ default package from "PDL" to 'MyObj' in anticipation of future
+ Object-Oriented PP modules. (Up to the author how he writes his module).
+ Also the pp_def(PMFunc=>'...') attribute can be used to generate special
+ purpose PM code instead of the default.
+
+ Comments please, hopefully nice ones as I have spent all day changing
+ code everywhere and debugging!!!
+
+ - Karl (exhausted)
+
+
+- Module defaults
+
+ PDL.pm now loads a set of standard packages (with :Func) - including graphics
+ and I/O for TPJ article and v1.11 compatibility. Thus a script with 'use PDL'
+ is v1.11 compatible (modulo bug fixes!)
+
+ Lite.pm loads only the truly fundametal core, with no imports, for method
+ speed freaks. Thus a lean script need only say 'use PDL::Lite' plus whatever
+ else it needs.
+
+ I hope various other sets of meta-modules (PDL::Astronomy, PDL::Medical) etc
+ will follow this simple scheme. Basically there is nothing sacred about
+ 'use PDL' anymore - it is just one of many loaders.
+
+- perldl shell
+
+ The 'perldl' script sources C<~/.perldlrc> if present or falls back to
+ C<PDL/default.perldlrc>. The latter just does the standard 'use PDL'
+
+ Thus by creating a C<~/.perldlrc> you are free to 'use PDL::Lite' or
+ whatever set of modules you fancy without impinging on v1.11 compatibility.
+
+ I think this is a rather elegant solution to all our aesthetic tastes
+ (namespace polluters vs method maniacs, module hoarders vs leany
+ meanies) while still ensuring script compatibility with v1.11.
+
+ I hope everyone is happy with this!
+
+- Fixed minor bug in FlexRaw
+
+1.92_10: 'make test' ok but see flow.t
+
+- PATCHBASE reset to zero
+
+(KGB)
+
+- new wfits() with BITPIX support and clever BSCALE/BZERO - PLEASE TEST!!
+- added Robin's PDL::Io::Browser
+- Robin's 'cutmask' function (need PP version!!!) - needs docs SOMEWHERE!!
+- string() no longer make_physical()
+- added mslice and test (slice.t)
+- lags patch (Jun 29)
+- extra tests to flow.t which FAIL, currently disabled as
+ 'make test' then stops early.
+- added some tests of simple ops and functions
+- moved all the 2D routines (med2d etc) into PDL::Image2D
+- Inserted new TriD 16/Jul (untested)
+- tjl's 'IMPORTANT: Just let me eat my words once more today' patch
+- applied tjl's 'minorities' patch - ext modules now seem to work
+- fixed rfits/wfits bugs, added gzip/compress support via suffixes
+- increased size trap in pdlhash.c to 1Gb
+
+1.92_09:
+
+- applied Tuomas' Simplex patch
+- applied Robin's patch: SlowRaw -> FlexRaw
+- added PDL::Io::Pnm and PDL::Io::Pic (+PDL::Lib::Iutil) to
+ support image I/O based on pbmplus/netpbm (+ wmpeg based on
+ mpeg_encode)
+- PDL::PP - $TBSULFD(B,S,U,L,F,D)_func now expands to
+ B_func, S_func, etc *without* intervening whitespace
+ - byte+ qualifier to make a pdl a "typeslave"
+- dispensed with Pthread.pm, thread_define now part of
+ PDL::Core
+- new PDL::Dbg
+
+1.92_08:
+
+- ops.pd debugged
+- FastRaw doc patches (TJL)
+
+1.92_06/07:
+
+Applied the 41(!) missing patches. See file KGB.1.92_06_TO_1.92_07
+- numerous small changes.
+
+1.92_05/06:
+- Rudimentary perl level threading; see documentation in Pthread.pm.
+- Diagonal patch
+- workaround for slice and clump to *not* leave trans in
+ a too ill-defined state when croaking (previously sometimes
+ coredumped upon destruction (as reported by Karl), see tests
+ in croak.t).
+- Karl's zeroes patch.
+- Matmult in primitive.pd.
+- history mechanism for perldl.
+- PDL::PP : type+ qualifiers, int, float and double now supported
+ $GENERIC, $SIZE, fixed $P vaffine bug, [t] now does
+ something, set named dimension from an 'OtherPars', i.e.
+ OtherPars => 'int nsz => n'
+- primitive.pd : added histogram + interpol
+- Basic.pm : added hist
+- new file tests.pd in Basic/Test to hold tests for PP features
+- updated indexing.pod, PP.pod and FAQ.pod
+- Lib/Makefile.PL : only build slatec stuff if we have f2c (until we
+ get a Makefile that works with ExtUtils::F77)
+- Dev.pm : change postambles so that C files built from .pd's will be cleaned
+
+1.92_04:
+Lots of patches from people installed. If I forget someone's
+attribution, please remind me.
+
+1.92_02:
+
+Vaffining. Just about everything should work now.
+New library files that don't work properly yet.
+
+1.91_01:
+
+Perldl: don't use blib unless have to (eval).
+
+Hashes done away with: $a->{...} doesn't work.
+It was impossible to get both that *and* a reasonable
+assignment behaviour.
+
+1.91:
+
+Bug fixen
+
+New PDL::PP
+
+The perldl shell now aborts on <EOF>, q and Q.
+
+
diff --git a/DEPENDENCIES b/DEPENDENCIES
new file mode 100644
index 0000000..1521155
--- /dev/null
+++ b/DEPENDENCIES
@@ -0,0 +1,251 @@
++----------------------------------------------------------------------------+
+| PDL Module Dependencies |
++----------------------------------------------------------------------------+
+
+This file lists dependencies of PDL modules on external programs
+or libraries. Some of the modules will build ok without the
+external software but in general are not very useful without it.
+Others require certain libraries/include files to be installed.
+
+See INSTALL on hints how to enable/disable building of some modules
+in the distribution if required.
+
+The easiest way to resolve dependencies on other Perl modules is
+to use the CPAN module to install PDL. Installation should be as
+simple as
+
+ cpan install PDL # if the cpan script is in your path
+
+or if you don't have the cpan script try
+
+ perl -MCPAN -e shell
+ cpan> install PDL
+
+
+
++----------------+---------------------+-------------------------------------+
+| MODULE | DEPENDS ON | COMMENT |
++----------------+---------------------+-------------------------------------+
+
+PDL (all) perl >= 5.8.x PDL requires at least this version
+ of perl to build and run.
+
+ File::Spec >= 0.6 perl5 core module.
+ File::Temp >= 0 perl5 core module.
+ Pod::Parser >= 0 perl5 core module.
+ Pod::Select >= 0 perl5 core module.
+
+ ExtUtils::MakeMaker >= 6.56
+
+ This version of EU::MM is the first
+ with support for CONFIGURE_REQUIRES.
+
+
+PDL::NiceSlice Text::Balanced >= 1.89 A nicer way to index piddles.
+ Filter::Util::Call
+
+ Filter::Simple Required for new PDL::NiceSlice
+ Module::Compile implementation under development.
+
+
+Inline::Pdlpp Inline >= 0.43 This module allows to define fast
+ PP code inline in your scripts.
+
+ NOTE: Though Inline is listed as as
+ PDL prerequisite for CPAN, you can
+ build PDL manually without it.
+
+
+PDL::ParallelCPU pthreads library Multi-CPU support will be enabled
+ if libpthreads is detected and
+ built against. A pthreads for
+ win32 can be found at
+ http://sourceware.org/pthreads-win32/
+
+
+
+PDL::IO::Dumper Data::Dumper >= 2.121
+ Convert::UU Convert::UU is required.
+
+ uuencode/uudecode (Optional) Better performance on
+ unix flavor platforms! They will
+ be used instead of Convert::UU
+ if detected.
+
+
+PDL::IO::Storable Storable >=1.03
+
+
+pdl2 (shell) Devel::REPL >= 1.003011
+ and Term::ReadLine::Perl
+ or Term::ReadLine::Gnu
+
+ Devel::REPL requires Data::Dump::Streamer
+ to support pdl2. This may need to be
+ hand-installed if you are doing a manual
+ PDL build.
+
+perldl (shell) Term::ReadLine::Perl
+ or Term::ReadLine::Gnu
+
+ pdl2 (and perldl) will be installed
+ by default. If Devel::REPL is not
+ installed, pdl2 uses perldl. The
+ same thing if a Term::ReadLine::Perl
+ or Term::ReadLine::Gnu is not installed.
+
+
+PDL::GIS::Proj
+PDL::Transform::Proj
+ A PDL interface to the PROJ4 geographic projection
+ library and the PDL::Transform interface to PROJ4.
+ See http://trac.osgeo.org/proj/
+
+ Module will be built if the PROJ4
+ library is installed and detected.
+
+
+PDL::Graphics::TriD
+ Requires the perl OpenGL module be installed.
+ See the POGL_VERSION entry in perldl.conf for
+ the minimum required version.
+
+ Perl OpenGL requires you have the OpenGL graphics
+ library and FreeGLUT (Apple GLUT on Mac OS X)
+ installed.
+
+ PDL::Graphics::TriD will be
+ built if Perl OpenGL is detected
+ and of version greater than the
+ POGL_VERSION in perldl.conf.
+
+ To disable the build, edit
+ perldl.conf and set WITH_3D => 0.
+
+
+PDL::Graphics::PGPLOT
+ Requires both the PGPLOT perl module **and**
+ the PGPLOT fortran library. See
+ http://astro.caltech.edu/~tjp/pgplot for the
+ library and
+ http://search.cpan.org/search%3fmodule=PGPLOT
+ for the perl module (on CPAN).
+
+ NOTE: These are two separate items to be installed.
+
+ PDL::Graphics::PGPLOT Module
+ builds ok without PGPLOT module
+ and library.
+
+
+PDL::Graphics::PLplot
+ The PLplot graphics library.
+ See http://plplot.sourceforge.net
+
+ Module will be built if the
+ PLplot library is detected.
+
+
+PDL::Graphics::IIS
+ To be useful an application that supports
+ the 'IIS' protocol must be installed, e.g.
+ SAOimage or Ximtool, see
+ http://tdc-www.harvard.edu/software/saoimage.html
+ http://iraf.noao.edu/iraf/web/projects/x11iraf/
+
+ PDL::Graphics::IIS builds
+ without viewers.
+
+
+PDL::GSL modules
+ Needs the GSL (Gnu Scientific Library) to
+ build. Version >= 1.0 is required
+ See http://www.gnu.org/software/gsl/
+
+ Will not be built unless
+ an appropriate GSL version
+ is installed and detected.
+
+
+PDL::IO::Browser
+ Requires a 'curses'-compatible library.
+ You'll need to enable in perldl.conf if you
+ wish to try the new configure and build,
+ no guarantees...
+
+ Not built by default.
+
+PDL::IO::FastRaw
+PDL::IO::FlexRaw
+ Memory-mapped file IO functions (mapfraw
+ and mapflex) require File::Map 0.47 or
+ higher. (Systems with POSIX mmap routines
+ will work without File::Map but it is
+ expected that the less-flexible, legacy
+ implementation will be deprecated)
+
+ Built by default if File::Map
+ or mmap dependencies are met.
+
+
+PDL::IO::FITS Needs Astro::FITS::Header for full support
+ of all FITS header features. Will build ok,
+ and run, without it but for given that
+ Astro::FITS::Header is a Perl only module, you
+ should install it unless you specifically need not.
+
+ NOTE: It is currently listed as an official
+ prerequisite module for the purposes of building
+ with the cpan shell.
+
+
+PDL::IO::GD PDL interface to the GD image library.
+ See http://www.libgd.org
+
+ Will not be built unless
+ libgd is already installed
+ and detected.
+
+
+PDL::IO::HDF PDL interface to HDF4 library. See
+ PDL::IO::HDF5 on CPAN for HDF5 bindings.
+ Not all HDF4 types are supported.
+ See http://www.hdfgroup.org/products/hdf4/
+
+ Will not be built unless the
+ HDF4 libraries are detected.
+
+
+PDL::IO::Pic rpic/wpic: NetPBM converters
+ See http://netpbm.sourceforge.net/
+
+ wmpeg: requires the ffmpeg program
+ See http://ffmpeg.org/
+
+ Module builds ok without
+ converters. Recommend at
+ least version 10.58.00 of
+ NetPBM.
+
+
+PDL::Minuit PDL interface to Minuit minimization routines in
+ the CERN library,
+ http://wwwasdoc.web.cern.ch/wwwasdoc/minuit/minmain.html
+ The Minuit library code is included. A fortran compiler
+ is required and ExtUtils:F77 (version >= 1.03).
+
+ Will not be built unless
+ ExtUtils::F77 is installed *and*
+ supports your platform.
+
+
+PDL::Slatec Linear algebra routines.
+ Several other PDL modules use PDL::Slatec
+
+ Slatec fortran lib is included but
+ requires a fortran compiler and
+ ExtUtils::F77 (version >= 1.03).
+
+ Will not be built unless
+ ExtUtils::F77 is installed *and*
+ supports your platform.
diff --git a/DEVELOPMENT b/DEVELOPMENT
new file mode 100644
index 0000000..935e790
--- /dev/null
+++ b/DEVELOPMENT
@@ -0,0 +1,194 @@
+This file has some information on how to get
+access to the latest PDL sources (mainly of
+interest for potential developers). This should
+not be confused with the latest public release
+which will always be available from CPAN (if you
+don't know what that is check the FAQ).
+
+Public Git repository at sourceforge.net
+--------------------------------------------
+
+From version PDL-2.4.4 onwards the source
+distribution is in a publicly accessible Git
+repository. The project is hosted at the
+sourceforge site at
+
+ http://sourceforge.net/projects/pdl/
+
+Starting from the above URL you will find
+directions on how to check out the current
+sources, browse the Git repository online, etc.
+
+If you would like to actively contribute to PDL
+development don't hesitate to contact one of the
+project admins (listed at the above URL) to apply
+for write access to the repository. We strongly
+believe in the power of open source development!
+
+If you do not know how to use Git try 'man git'
+or have a look at some of the online tutorials
+available on the web.
+
+The main Git home page is at
+
+ http://www.git-scm.org/
+
+and two good online Git references are the Git
+User's Manual at
+
+ http://www.kernel.org/pub/software/scm/git/docs/user-manual.html
+
+and Git Magic at
+
+ http://www-cs-students.stanford.edu/~blynn/gitmagic/
+
+
+PDL Developer Guidelines:
+-------------------------
+
+The following guidelines are for any developer that has
+access to the PDL Git repository.
+
+1) Before committing a change with new files to the repository
+ you should update:
+
+ - MANIFEST (if files were added, using 'make manifest')
+ - MANIFEST.SKIP (if applicable)
+
+2) Make sure you add a test case in the 't' directory for any
+ significant additional capability you add to PDL. Please
+ use Test::More or one the of the Test modules available via
+ perl modules rather than doing-it-yourself!
+
+3) Please include POD documentation for any functions you add to
+ the distribution.
+
+ - See Basic/Core/Core.pm for an example of including POD
+ documentation in .pm files.
+ - See Basic/Core/Primitive/Primitive.pd for an example of
+ including POD documentation in PDL .pd files.
+ - read the documentation in PDL::Doc for a detailed description of
+ the PDL documentation conventions.
+
+4) Don't commit before you successfully built and passed 'make test'.
+
+5) Bugs reported on the list should be entered into the bug database
+ and bugs closed when a patch has been committed as a fix. (Primary
+ responsibility for this task is the pumpking, but other devels
+ should be able to help.)
+
+
+PDL Developer Notes:
+--------------------
+
+A (small) collection of random musings to note if you feel the need to
+improve or add to PDL (please do):
+
+*) git supports file-by-file commits so it is helpful to commit
+ your changes to git a little at a time where each commit
+ corresponds to a single change. This makes it easy in the
+ log to determine what was done and to locate any desired
+ commit in case of issues that need to be resolved.
+
+*) Need help?
+
+See the pdl-porters email list; details for subscription and access to
+the archives can be found on the PDL web page at:
+
+ http://pdl.perl.org/?page=mailing-lists
+
+*) Access to PDL's configuration
+
+If you need to access the configuration for PDL then use the
+%PDL::Config variable. Prior to 2.4.1 this was a mess since you
+had to use %PDL_CONFIG within Makefile.PL and PDL::Config from
+*.pm/tests. The build process has been changed (I hesitate to say
+"cleaned up" ;) to just use %PDL::Config consistently throughout.
+
+- %PDL::Config is automatically available to you when you are in a
+ Makefile.PL within the PDL distribution. You can change the hash
+ and these changes will be stored in the PDL::Config module. You
+ should only change values when it makes sense (e.g. if the user
+ has specified that a module should be built but you find out this
+ is not possible).
+
+- use PDL; now loads PDL::Config by default
+
+- Otherwise you can say 'use PDL::Config;' or - perhaps something like
+ eval 'require "' . whereami_any() . '/Core/Config.pm";';
+ where whereami_any() is from PDL::Core::Dev;
+
+*) Location of temporary files
+
+Please use $PDL::Config{TEMPDIR} for the directory in which to
+place temporary files (e.g. when IO::File::new_tmpfile() is not
+appropriate). This will make it easier for distributions to package
+PDL since there will only be one place they need to change if the
+default value causes problems.
+
+This *includes* test cases as well as for Makefile.PL's!
+
+
+
+-------------------------------------------------------------
+Notes on transferring an external PDL module to the PDL
+ source tree for distribution with PDL.
+-------------------------------------------------------------
+
+Suppose you have developed a PDL module that resides in a
+standalone source tree. You typically will need to have PDL
+installed on your system before you can build this module.
+
+If you wish to migrate the module into the PDL distribution
+you will need to make certain changes to the module source
+in order to built in the PDL distribution. You will need to
+removed dependecies on a pre-existing PDL installation for
+configuration and build of your module. This is because as
+part of the PDL distribution, it is possible that PDL has
+never been installed. Build processes based on PDL will then
+fail.
+
+Following is some specific advice that can help you do this.
+
+[ These notes are very preliminary and are expected to be ]
+[ revised and/or replaced by improved documentation. ]
+
+Changes that must be made to files in your module source tree
+if you are building the module from a .pd file :
+
+Makefile.PL:
+-- You must remove the line 'use PDL::Core::Dev;'.
+
+-- The line 'PDL::Core::Dev->import();' must be present
+
+-- You must change the call from 'pdlpp_postamble' to a call to
+ 'pdlpp_postamble_int' (with the same arguments.)
+
+-- It seems that most modules in the PDL source use
+ VERSION_FROM => '../../Basic/Core/Version.pm',
+ but not all of them in order that their version tracks
+ the PDL release version. It is possible to maintain
+ separate versioning even within the PDL source tree but
+ it may make things confusing.
+
+Make certain that you make these changes to each 'Makefile.PL' in
+your source tree.
+
+
+Changes to the existing PDL source tree:
+
+-- Edit the 'Makefile.PL' in the directory above your module source
+ to add your module directory name to
+ 'DIR => [ qw/Module1 AnotherModule / ]'.
+
+-- Add your test files (.t files) to the PDL/t directory renaming if
+ required to avoid namespace conflicts.
+
+-- Does your module depend on any libraries or external
+ programs ? If so, doocument the required programs with version
+ numbers in PDL/DEPENDENCIES and add the PREREQ_* option to the
+ main Makefile.PL if required.
+
+-- If your module requires external libraries or header files,
+ add a section to perldl.conf. The hash values with be available
+ in your module's 'Makefile.PL' as $PDL::Config{WITH_MYMODULE},...
diff --git a/Demos/BAD2_demo.pm.PL b/Demos/BAD2_demo.pm.PL
new file mode 100644
index 0000000..c134a38
--- /dev/null
+++ b/Demos/BAD2_demo.pm.PL
@@ -0,0 +1,168 @@
+#
+# Create BAD2_demo.pm
+# - requires both bad-value support and PGPLOT
+#
+
+use strict;
+
+use Config;
+use File::Basename qw(&basename &dirname);
+use blib;
+
+# check for bad value support
+use lib '../Basic/Core'; # so Config.pm is found during build
+use PDL::Config;
+my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+my $file;
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($Config{'osname'} eq 'VMS' or
+ $Config{'osname'} eq 'OS2'); # "case-forgiving"
+open OUT,">$file" or die "Can't create $file: $!";
+
+if ( $bvalflag ) {
+ print "Extracting $file (WITH bad value support)\n";
+} else {
+ print "Extracting $file (NO bad value support)\n";
+}
+chmod 0644, $file;
+
+print OUT <<'!NO!SUBS!';
+#
+# Created by BAD2_demo.pm.PL
+# ** DO NOT EDIT THIS FILE **
+#
+package PDL::Demos::BAD2_demo;
+use PDL;
+use PDL::IO::Misc;
+use PDL::Graphics::PGPLOT;
+
+use File::Spec;
+
+PDL::Demos::Routines->import();
+sub comment($);
+sub act($);
+sub output;
+
+sub run {
+
+!NO!SUBS!
+
+ if ( ! $bvalflag ) {
+ print OUT <<'!NO!SUBS!';
+
+comment q|
+
+ Your version of PDL has been compiled without support for bad
+ values, hence this demo cannot do anything.
+
+|;
+
+!NO!SUBS!
+
+} else {
+ print OUT <<'!NO!SUBS!';
+
+$ENV{PGPLOT_XW_WIDTH}=0.6;
+$ENV{PGPLOT_DEV}=$^O =~ /MSWin32/ ? '/GW' : "/XSERVE";
+
+# try and find m51.fits
+$d = File::Spec->catdir( "PDL", "Demos" );
+$m51path = undef;
+foreach my $path ( @INC ) {
+ my $check = File::Spec->catdir( $path, $d );
+ if ( -d $check ) { $m51path = $check; last; }
+}
+barf "Unable to find directory ${m51path} within the perl libraries.\n"
+ unless defined $m51path;
+
+comment q|
+ This demo is just a bit of eye-candy to show bad values in action,
+ and requires PGPLOT support in PDL. It makes use of the image of
+ M51 kindly provided by the Hubble Heritage group at the
+ Space Telescope Science Institute.
+
+ It also serves to demonstrate that you often don't need to change
+ your code to handle bad values, as the routines may 'do it' for you.
+
+|;
+
+act q|
+
+ # read in the image ($m51path has been set up by this demo to
+ # contain the location of the file)
+ $m51 = rfits "$m51path/m51.fits";
+
+ # display it
+ $just = { JUSTIFY => 1 };
+ imag $m51, $just;
+
+ # These are used to create the next image
+ ( $nx, $ny ) = $m51->dims;
+ $centre = [ $nx/2, $ny/2 ];
+|;
+
+act q|
+
+ # now, let's mask out the central 40 pixels and display it
+ $masked = $m51->setbadif( $m51->rvals({CENTRE=>$centre}) < 40 );
+
+ # since imag auto-scales the output, the bad values are not displayed
+ imag $masked, $just;
+
+ # compare the statistics of the images
+ # (as $PDL::verbose = 1, stats prints out the answers itself)
+ print "Original:\n"; $m51->stats;
+ print "Masked:\n"; $masked->stats;
+
+|;
+
+act q|
+
+ # let's filter it a little bit
+ use PDL::Image2D;
+ $nb = 15;
+ $filtered = med2d $masked, ones($nb,$nb), { Boundary => 'Truncate' };
+
+ # this is a model of the diffuse component of M51
+ imag $filtered, $just;
+
+|;
+
+act q|
+
+ # unsharp masking, to bring out the small-scale detail
+ $unsharp = $masked - $filtered;
+
+ imag $unsharp, $just;
+
+|;
+
+act q|
+
+ # add on some contours showing the large scale structure of the galaxy
+ imag $unsharp, $just;
+ hold;
+ cont $filtered;
+ rel;
+
+|;
+
+!NO!SUBS!
+
+} # if: $bvalflag
+
+print OUT <<'!NO!SUBS!';
+
+}
+
+1;
+
+!NO!SUBS!
+
+# end
+
diff --git a/Demos/BAD_demo.pm.PL b/Demos/BAD_demo.pm.PL
new file mode 100644
index 0000000..dc33aba
--- /dev/null
+++ b/Demos/BAD_demo.pm.PL
@@ -0,0 +1,239 @@
+#
+# Create BAD_demo.pm
+# - needed since we allow bad pixel handling to be switched off
+#
+
+use strict;
+
+use Config;
+use File::Basename qw(&basename &dirname);
+use blib;
+
+# check for bad value support
+use lib '../Basic/Core'; # so Config.pm is found during build
+use PDL::Config;
+my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+my $file;
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($Config{'osname'} eq 'VMS' or
+ $Config{'osname'} eq 'OS2'); # "case-forgiving"
+open OUT,">$file" or die "Can't create $file: $!";
+
+if ( $bvalflag ) {
+ print "Extracting $file (WITH bad value support)\n";
+} else {
+ print "Extracting $file (NO bad value support)\n";
+}
+chmod 0644, $file;
+
+print OUT <<'!NO!SUBS!';
+#
+# Created by BAD_demo.pm.PL
+# ** DO NOT EDIT THIS FILE **
+#
+package PDL::Demos::BAD_demo;
+use PDL;
+
+PDL::Demos::Routines->import();
+sub comment($);
+sub act($);
+sub output;
+
+sub run {
+
+!NO!SUBS!
+
+ if ( ! $bvalflag ) {
+ print OUT <<'!NO!SUBS!';
+
+comment q|
+
+ Your version of PDL has been compiled without support for bad
+ values, hence this demo doesn't do anything.
+
+|;
+
+!NO!SUBS!
+
+#'
+
+} else {
+ print OUT <<'!NO!SUBS!';
+
+comment q|
+ Welcome to this tour of the bad value support in PDL
+
+ Each piddle contains a flag - accessible via the badflag() method -
+ which indicates whether:
+
+ the piddle contains no bad values (flag equals 0)
+ the piddle *MAY* contain bad values (flag equals 1)
+
+ If the flag is set, then the routines (well, those that have been
+ converted) will process these bad values correctly, otherwise they
+ are ignored.
+
+ The code has been written so as to provide as little overhead as
+ possible; therefore there should be almost no difference in the
+ time it takes to process piddles which do not have their bad flag
+ set.
+
+|;
+
+act q|
+
+ # There are 2 ways to see whether bad-value support has been
+ # compiled into your perldl or pdl2 shell:
+ print("You can use bad values.\n") if $PDL::Bad::Status;
+
+ # or
+ use PDL::Config;
+ print("You can stil use bad values.\n") if $PDL::Config{WITH_BADVAL};
+
+ # note that PDL::Bad is included by default when you use
+ # 'use PDL', 'use PDL::Lite', or 'use PDL::LiteF'
+
+|;
+
+act q|
+
+ # create a piddle
+ $a = byte(1,2,3);
+ print( "Bad flag (a) == ", $a->badflag(), "\n" );
+
+ # set bad flag, even though all the data is good
+ $a->badflag(1);
+ print( "Bad flag (a) == ", $a->badflag(), "\n" );
+
+ # note the bad flag is infectious
+ $b = 2 * $a;
+ print( "Bad flag (b) == ", $b->badflag(), "\n\n" );
+
+|;
+
+act q|
+
+ # the badflag is also included in the state info of
+ # piddle
+ #
+ $c = pdl(2,3); # just a piddle without the badflag set
+
+ print " Type Dimension State Mem\n";
+ print "-------------------------------------------------\n";
+ print "a ", $a->info("%-6T %-15D %-5S %12M"), "\n";
+ print "b ", $b->info("%-6T %-15D %-5S %12M"), "\n";
+ print "c ", $c->info("%-6T %-15D %-5S %12M"), "\n\n";
+|;
+
+act q|
+
+ print "No bad values: $a\n";
+ # set the middle value bad
+ $a->setbadat(1);
+
+ # now print out
+ print "Some bad values: $a\n";
+ print "b contains: $b\n";
+ $c = $a + $b;
+ print "so a + b = $c\n\n";
+
+|;
+
+act q|
+
+ # The module PDL::Bad contains a number of routines designed
+ # to make using bad values easy.
+ print "a contains ", $a->nbad, " bad elements.\n";
+ print "The bad value for type #",$a->get_datatype," is ",$a->badvalue,"\n";
+ print "It is easy to find whether a value is good: ", isgood($a), "\n\n";
+
+ print "or to remove the bad values\n";
+ $a->inplace->setbadtoval(23);
+ print "a = $a and \$a->badflag == ", $a->badflag, "\n\n";
+
+|;
+
+act q|
+
+ print "We can even label certain values as bad!\n";
+ $a = sequence(3,3);
+ $a = $a->setbadif( $a % 2 ); # unfortunately can not be done inplace
+ print $a;
+
+|;
+
+act q|
+
+ # the issue of how to cope with dataflow is not fully resolved. At
+ # present, if you change the badflag of a piddle, all its children
+ # are also changed:
+ $a = sequence( byte, 2, 3 );
+ $a = $a->setbadif( $a == 3 );
+ $b = $a->slice("(1),:");
+ print "b = $b\tbadflag = ", $b->badflag, "\n";
+
+ $a->inplace->setbadtoval(3);
+ print "b = $b\tbadflag = ", $b->badflag, "\n\n";
+
+|;
+
+act q|
+
+ # Note that "boolean" operators return a bad value if either of the
+ # operands are bad: one way around this is to replace all bad values
+ # by 0 or 1.
+
+ $a = sequence(3,3); $a = $a->setbadif( $a % 2 );
+ print $a > 5;
+ print setbadtoval($a > 5,0); # set all bad values to false
+
+|;
+
+act q|
+ # One area that is likely to cause confusion is the return value from
+ # comparison operators (e.g. all and any) when ALL elements are bad.
+
+ # Currently, the bad value is returned; however most code will not
+ # be aware of this and just see it as a true or false value (depending
+ # on the numerical value used to store bad values).
+
+ # There is also the fact that the bad value need not relate to the
+ # type of the input piddle (due to internal conversion to an 'int +').
+
+ $a = ones(3); $a = $a->setbadif( $a == 1 );
+ print "Any returns: ", any( $a > 2 ), "\n";
+ print "which is the bad value of 'long' (", long->badvalue, ").\n";
+
+ print "Whereas the bad value for \$a is: ", $a->badvalue, "\n";
+
+|;
+
+comment q|
+ Many of the 'core' routines have been converted to handle bad values.
+ However, some (including most of the additional modules) have not,
+ either because it does not make sense or its too much work to do!
+
+ To find out the status of a particular routine, use the 'badinfo'
+ command in perldl or pdl2 shell (this information is also included
+ when you do 'help'), or the '-b' switch of pdldoc.
+
+|;
+
+!NO!SUBS!
+
+} # if: $bvalflag
+
+print OUT <<'!NO!SUBS!';
+
+}
+
+1;
+
+!NO!SUBS!
+
+# end
diff --git a/Demos/Cartography_demo.pm b/Demos/Cartography_demo.pm
new file mode 100644
index 0000000..3e84f7d
--- /dev/null
+++ b/Demos/Cartography_demo.pm
@@ -0,0 +1,178 @@
+#
+package PDL::Demos::Cartography_demo;
+
+use PDL;
+use PDL::Graphics::PGPLOT::Window;
+use PDL::Transform::Cartography;
+
+use File::Spec;
+
+PDL::Demos::Routines->import();
+sub comment($);
+sub act($);
+sub output;
+
+sub run {
+ local($PDL::debug) = 0;
+ local($PDL::verbose) = 0;
+
+##$ENV{PGPLOT_XW_WIDTH}=0.6;
+$ENV{PGPLOT_DEV}=$^O =~ /MSWin32/ ? '/GW' : "/XWIN";
+
+
+ unless( PDL->rpiccan('JPEG') ) {
+ comment q|
+This demo illustrates the PDL::Transform::Cartography module.
+
+It requires PGPLOT and also the ability to read/write JPEG images.
+
+You don't seem to have that ability at the moment -- this is likely
+because you do not have NetPBM installed. See the man page for PDL::IO::Pic.
+
+I'll continue with the demo anyway, but it will likely crash on the
+earth_image('day') call on the next screen.
+
+|
+}
+
+comment q|
+
+ This demo illustrates the PDL::Transform::Cartography module.
+ It also requires PGPLOT support: you must have PGPLOT installed to run it.
+
+ PDL::Transform::Cartography includes a global earth vector coastline map
+ and night and day world image maps, as well as the infrastructure for
+ transforming them to different coordinate systems.
+
+ If you are using an RGB-enabled version of PGPLOT, then the map
+ images will appear in color on your screen. Otherwise they will
+ appear in greyscale. (The vector data will appear in color
+ regardless).
+
+ |;
+
+act q|
+ ### Load the necessary modules
+ use PDL::Graphics::PGPLOT::Window;
+ use PDL::Transform::Cartography;
+
+ ### Get the vector coastline map (and a lon/lat grid), and load the Earth
+ ### RGB daytime image -- both of these are built-in to the module. The
+ ### coastline map is a set of (X,Y,Pen) vectors.
+ $coast = earth_coast() -> glue( 1, graticule(15,1) );
+ print "Coastline data are a collection of vectors: ",
+ join("x",$coast->dims),"\n";
+
+ $map = earth_image('day');
+ print "Map data are RGB: ",join("x",$map->dims),"\n\n";
+|;
+
+act q&
+ ### Map data are stored natively in Plate Caree format.
+ ### The image contains a FITS header that contains coordinate system info.
+ print "FITS HEADER INFORMATION:\n";
+ for $_(keys %{$map->hdr}){
+ next if(m/SIMPLE/ || m/HISTORY/ || m/COMMENT/);
+ printf (" %8s: %10s%s", $_, $map->hdr->{$_}, (++$i%3) ? " " : "\n");
+ }
+ print "\n";
+
+ $dev = $^O =~ /MSWin/i ? '/GW' : '/xw';
+ $w = pgwin(Dev=> $dev, size=>[8,6]);
+ $w->fits_imag($map, {Title=>"NASA/MODIS Earth Map (Plate Caree)",J=>0});
+&;
+
+act q&
+ ### The map data are co-aligned with the vector data, which can be drawn
+ ### on top of the window with the "->lines" PGPLOT method. The
+ ### clean_lines method breaks lines that pass over the map's singularity
+ ### at the 180th parallel.
+
+ $w->hold;
+ $w->lines( $coast -> clean_lines );
+ $w->release;
+
+&;
+
+act q&
+### There are a large number of map projections -- to list them all,
+### say "??cartography" in the perldl or pdl2 shell. Here are four
+### of them:
+
+$w->close; # Close old window
+undef $w;
+
+$dev = $^O =~ /MSWin/i ? '/GW' : '/xw';
+$w = pgwin( Dev=> $dev, size=>[8,6], nx=>2, ny=>2 ) ;
+
+sub draw {
+ ($tx, $t, $px, $opt ) = @_;
+ $w->fits_imag( $map->map( $tx, $px, $opt ),{Title=>$t, CharSize=>1.5, J=>1} );
+ $w->hold; $w->lines( $coast -> apply( $tx ) -> clean_lines ); $w->release;
+}
+
+## (The "or" option specifies the output range of the mapping)
+draw( t_mercator, "Mercator Projection", [400,300] );
+draw( t_aitoff, "Aitoff / Hammer", [400,300] );
+draw( t_gnomonic, "Gnomonic", [400,300],{or=>[[-3,3],[-2,2]]} );
+draw( t_lambert, "Lambert Conformal Conic",[400,300],{or=>[[-3,3],[-2,2]]} );
+
+
+&;
+
+act q|
+### You can create oblique projections by feeding in a different origin.
+### Here, the origin is centered over North America.
+
+draw( t_mercator( o=>[-90,40] ), "Mercator Projection", [400,300] );
+draw( t_aitoff ( o=>[-90,40] ), "Aitoff / Hammer", [400,300] );
+draw( t_gnomonic( o=>[-90,40] ), "Gnomonic",[400,300],{or=>[[-3,3],[-2,2]]} );
+draw( t_lambert( o=>[-90,40] ), "Lambert ",[400,300],{or=>[[-3,3],[-2,2]]} );
+
+|;
+
+act q|
+### There are three main perspective projections (in addition to special
+### cases like stereographic and gnomonic projection): orthographic,
+### vertical, and true perspective. The true perspective has options for
+### both downward-looking and aerial-view coordinate systems.
+
+draw( t_orthographic( o=>[-90,40] ),
+ "Orthographic", [400,300]);
+
+draw( t_vertical( r0=> (2 + 1), o=>[-90,40] ),
+ "Vertical (Altitude = 2 r\\\\de\\\\u)", [400,300]);
+
+draw( t_perspective( r0=> (2 + 1), o=>[-90,40] ),
+ "True Perspective (Altitude= 2 r\\\\de\\\\u)", [400,300]);
+
+# Observer is 0.1 earth-radii above surface, lon 117W, lat 31N (over Tijuana).
+# view is 45 degrees below horizontal, azimuth -22 (338) degrees.
+draw( t_perspective( r0=> 1.1, o=>[-117,31], cam=>[-22,-45,0] ),
+ "Aerial view of West Coast of USA", [400,300],
+ {or=>[[-60,60],[-45,45]], method=>'linear'});
+
+|;
+
+comment q|
+
+That concludes the basic cartography demo. Numerous other transforms
+are available.
+
+Because PDL's cartographic transforms work with in the Transform module
+and are invertible, it's easy to use them both forwards and backwards.
+In particular, the perspective transformation is useful for ingesting
+scientific image data of the Earth or other planets, and converting to
+a map of the imaged body.
+
+Similarly, scanned images of map data can easily be converted into
+lat/lon coordinates or reprojected to make other projections.
+
+|;
+
+$w->close;
+undef $w;
+
+}
+
+1;
diff --git a/Demos/General.pm b/Demos/General.pm
new file mode 100644
index 0000000..b5737c6
--- /dev/null
+++ b/Demos/General.pm
@@ -0,0 +1,168 @@
+# Copyright (C) 1998 Tuomas J. Lukka.
+# All rights reserved, except redistribution
+# with PDL under the PDL License permitted.
+
+package PDL::Demos::General;
+use PDL;
+
+PDL::Demos::Routines->import();
+sub comment($);
+sub act($);
+sub output;
+
+sub run {
+
+comment q|
+ Welcome to a short tour of PDL's capabilities.
+
+ This tour shows some of the main selling points
+ of PDL. However, because we want this script to
+ run everywhere, some modules which require external
+ modules for use are explicitly excluded, namely
+ - PDL::Graphics::TriD (3D Graphics) [*]
+ - PDL::Graphics::PGPLOT (PGPLOT graphics)
+ - PDL::IO::FlexRaw (flexible raw input/output)
+ [*]: this module has its separate demos in a subdirectory.
+
+ Note that your own scripts must start with
+
+ use PDL;
+
+ to work properly, so that you can simply say
+
+ perl script.pl
+
+ or you can just try some of the commands illustrated
+ in the demos by just retyping them at the perldl or pdl
+ 'pdl>' command prompt.
+|;
+
+act q|
+ $a = zeroes 5,5; # 5x5 matrix
+ output $a;
+|;
+
+act q|
+ # Now, don't think that the number of dimensions is limited
+ # to two:
+ $m = zeroes(3,2,2); # 3x2x2 cube
+ output $m;
+|;
+
+act q|
+ $a ++; # Operators like increment work..
+ output $a;
+|;
+
+act q|
+ # xvals and yvals (yes, there is also zvals...)
+ # give you piddles which give the coordinate value.
+ $b = xvals $a;
+ output $b;
+|;
+
+act q|
+ # So you can do things like
+ $b = $a + 0.1 * xvals($a) + 0.01 * yvals($a);
+ output $b;
+|;
+
+act q|
+ # Arithmetic operations work:
+ $x = xvals(10) / 5;
+ output $x,"\n";
+ output ((sin $x),"\n");
+|;
+
+act q|
+ # You can also take slices:
+ output $b;
+ output $b->slice(":,2:3"); # rows 2 and 3
+|;
+act q|
+ output $b->slice("2:3,:"); # or columns 2 and 3
+|;
+
+act q|
+ output $b;
+ output $b->diagonal(0,1),"\n"; # 0 and 1 are the dimensions
+|;
+
+act q|
+ # One of the really nifty features is that the
+ # slices are actually references back to the original
+ # piddle:
+ $diag = $b->diagonal(0,1);
+ output $b;
+ output $diag,"\n";
+ $diag+=100;
+ output "AFTER:\n";
+ output $diag,"\n";
+ output "Now, guess what \$b looks like?\n";
+|;
+
+act q|
+ # Yes, it has changed:
+ output $b;
+|;
+
+act q|
+ # Another example (we only modify elements 0,2 and 4 of
+ # each row):
+ $t = $b->slice("0:4:2"); $t += 50;
+ output $b;
+|;
+
+act q|
+ # There are lots of useful functions in e.g. PDL::Primitive
+ # and PDL::Slices - we can't show you all but here are some
+ # examples:
+
+ output $b;
+ output $b->sum, "\n";
+ output $b->sumover,"\n"; # Only over first dim.
+|;
+
+act q|
+ output $b->xchg(0,1);
+ output $b->minimum,"\n"; # over first dim.
+ output $b->min,"\n";
+|;
+
+act q|
+ output $b->random;
+|;
+
+act q|
+ # Here are some more advanced tricks for selecting
+ # parts of 1-D vectors:
+ $a = (xvals 12)/3;
+ $i = which(sin($a) > 0.5); # Indices of those sines > 0.5
+ output $a,"\n";
+ output $i,"\n";
+ output $a->index($i),"\n";
+ # and we can have the effect of the last command in one
+ # go using 'where' instead of 'which' and 'index' as in
+ output $a->where(sin($a) > 0.5),"\n";
+ # and finally take the sin of these elements
+ # (to show that these are indeed the correct ones)
+ output sin($a->index($i)),"\n";
+|;
+
+comment q|
+ We hope you enjoyed these demos illustrating some
+ of the basic capabilities of PDL.
+
+ We encourage you to play with these commands in
+ the perldl or pdl2 shell and use its online help support
+ to find out more about these and other commands and
+ features of PDL.
+
+ Just type 'help' to get started.
+
+|;
+
+
+}
+
+1;
diff --git a/Demos/Gnuplot_demo.pm b/Demos/Gnuplot_demo.pm
new file mode 100644
index 0000000..0116b44
--- /dev/null
+++ b/Demos/Gnuplot_demo.pm
@@ -0,0 +1,332 @@
+##############################
+# Gnuplot_demo package for PDL
+#
+# To use this manually:
+# use PDL::Demos::Screen;
+# do 'Gnuplot_demo.pm';
+# PDL::Demos::Gnuplot_demo::run();
+#
+# Authors: Dima Kogan & Craig DeForest
+
+package PDL::Demos::Gnuplot_demo;
+
+use PDL;
+
+BEGIN {
+ eval 'use PDL::Graphics::Gnuplot;';
+ if ($@ or !defined($PDL::Graphics::Gnuplot::VERSION)) {
+ eval <<'EOF';
+ sub run {
+ print qq{
+
+PDL::Graphics::Gnuplot is required for this demo, but didn't load. You may have
+to go get it from CPAN (http://search.cpan.org). You might also need to get the
+external "gnuplot" app (http://www.gnuplot.info).
+
+};
+ }
+EOF
+ }
+ return 1;
+}
+
+use PDL::ImageND;
+
+use PDL::Demos::Screen; # This is awful but seems to be needed since Screen.pm is where the Routines are located. -CED 2/2013
+
+PDL::Demos::Routines->import();
+sub comment($);
+sub act($);
+sub output;
+
+
+sub run {
+ local($PDL::debug) = 0;
+ local($PDL::verbose) = 0;
+
+
+ $s = q|
+ # ensure that the module is loaded
+ use PDL::Graphics::Gnuplot;
+
+ # Create a Gnuplot object - the default device displays on most
+ # operating systems. (No plot window yet - just the object).
+
+ $w = gpwin(%%params%%);
+
+ # Create variables to plot
+ $x = xvals(1000);
+ $y = $x/1000 * sin($x/10);
+
+|;
+ if(!defined($PDL::Graphics::Gnuplot::VERSION)) {
+ die q{
+
+*******************************************************************************
+This demo requires both the external "gnuplot" application and the module
+"PDL::Graphics::Gnuplot". You don't seem to have the module installed on your
+system. You might want to get it from CPAN and try again.
+*******************************************************************************
+
+};
+ }
+
+ if(!defined($PDL::Graphics::Gnuplot::valid_terms)) {
+ my $ww = new PDL::Graphics::Gnuplot;
+ }
+
+ if($PDL::Graphics::Gnuplot::valid_terms->{wxt}) {
+ $subst = "wxt, size=>[8,6,'in'], title=>'Gnuplot demo window', persist=>0";
+ } elsif($ENV{DISPLAY}) {
+ $subst = "x11, size=>[8,6,'in'], title=>'Gnuplot demo window', persist=>0";
+ } else {
+ $subst = "";
+ }
+ $s=~s/\%\%params\%\%/$subst/;
+ act $s;
+
+
+ $s = q|
+ # ensure that the module is loaded
+ use PDL::Graphics::Gnuplot;
+
+ # Create a Gnuplot object - the default device displays on most
+ # operating systems. (No plot window yet - just the object).
+ $w = gpwin(%%params%%);
+
+ # Create variables to plot
+ $x = xvals(1000)/1000;
+ $y = $x * sin(100 * $x);
+
+ # Generate a line plot. Plot parameters in front.
+ $w->lines({title=>" x * sin(100 x) ",xl=>"Ordinate",yl=>"Abscissa"}, $x, $y );
+|;
+ $s =~s/\%\%params\%\%/$subst/;
+ act $s;
+
+ act q|
+
+ # You can set persistent plot parameters with "options".
+ $w->options(title=>"Two lines", xl=>"Ordinate", yl=>"Abscissa");
+
+ # A two-line plot
+ $y2 = sqrt($x) * cos(100*$x);
+ $w->lines($x,$y,{},$x,$y2);
+
+|;
+
+ act q|
+ # You can set persistent plot parameters with "options".
+ $w->options(title=>"Two lines", xl=>"Ordinate", yl=>"Abscissa");
+
+ # A two-line plot.
+ # Groups of data are separated by non-PDL options -- in this
+ # case, the null hash since there are no per-curve options.
+
+ $y2 = sqrt($x) * cos(100*$x);
+ $w->lines($x,$y,{},$x,$y2);
+
+ # A two-line plot with legend.
+ # The legend for each line separates the groups of PDL data.
+
+ $w->options(title=>"Two lines (with legend)", key=>'left');
+ $w->lines( legend=>"sin",$x,$y, legend=>"cos",$x,$y2 );
+
+ #
+|;
+
+ act q|
+ # You can also generate multiline plots with threading.
+ # Here, $x is a 1000-element 1-D PDL, and $yy is a 1000x2 2-D PDL.
+
+ $x = xvals(1000)/1000;
+ ($y,$y2) = ( $x * sin(100 * $x), sqrt($x) * cos(100 * $x) );
+ $yy = pdl( $y, $y2 );
+
+ # all options can be abbreviated to the smallest unique string.
+ # Here, "tit" stands for "title", and "le" for "legend".
+
+ $w->lines({tit=>"2-lines threaded"}, le=>["sin", "cos"], $x, $yy);
+
+
+
+|;
+
+act q|
+ # line plots are far from the only thing you can do!
+
+ # Here is the same plot, with points and some tweaks to the axis labels.
+ $w->options(tit=>"2 sets of points");
+
+ $l = ["sin", "cos"];
+ $w->points({xtics=>{rotate=>45,offset=>[0,-1.5],font=>',14'},
+ xlab=>"Tilted Labels in 14-point text}"
+ },
+ le=>$l, $x, $yy);
+
+
+
+|;
+
+act q|
+ # Many types of plot are supported, using the "plot" command
+ # and the "with" curve option. Here, we can mix and match points and lines.
+
+ # You can also set plot options *temporarily* with a hash ref at the start of the
+ # plot call:
+
+ $w->plot( {title=>"Points and lines mixed"},
+ with=>'points', le=>'sin (points)', $x, $y,
+ with=>'lines', le=>'cos (line)', $x, $y2);
+
+
+|;
+
+act q|
+ # Many types of plot are supported, using the "plot" command
+ # and the "with" curve option. Here, we can mix and match points and lines.
+
+ $w->plot( with=>'points', le=>'sin (points)', $x, $y,
+ with=>'lines', le=>'cos (line)', $x, $y2);
+
+ $x = xvals(51)/50;
+ ($y,$y2) = ( $x * sin(20 * $x), sqrt($x) * cos(20 * $x) );
+ $radii = 0.01 * (0.25 - ($x*2 - 0.5)**2);
+
+ # Here are some other options.
+ $w->plot( {title=>"Circles and Steps"},
+ le=>"Circles", with=>'circles', $x, $y, $radii,
+ le=>"Steps", with=> 'steps', $x, $y2
+ );
+|;
+
+act q|
+ # You can plot multiple plots on one pane with "multiplot".
+
+ $x = xvals(51)/50;
+ ($y,$y2) = ( $x * sin(20 * $x), sqrt($x) * cos(20 * $x) );
+
+
+ $w->multiplot(layout=>[1,2]);
+
+ $w->plot( {title=>"Impulses"}, with=> 'impulses', $x, $y );
+ $w->plot( {title=>"Filled Curves"}, with => "filledcurves", $x, $y, $y2 );
+
+ $w->end_multi();
+|;
+
+act q|
+ # 2-D data...
+
+ $rv = rvals(51,51)/2;
+ $im = 25 * cos($rv) / ($rv+1.5);
+
+ $w->multiplot(layout=>[2,2]);
+ $w->options(justify=>1); # set nice aspect ratio
+ $w->plot( {tit=>'Default color map'}, with=>'image', $im );
+ $w->plot( {tit=>'Grayscale', clut=>'gray'}, with=>'image', $im );
+ $w->plot( {tit=>'heat map', clut=>'heat1'}, with=>'image', $im );
+ $w->plot( {tit=>'3d perspective', trid=>1}, with=>'pm3d', $im );
+ $w->end_multi;
+
+|;
+
+
+
+act q|
+ # You can indpendently specify color and position on surface plots,
+ # and can overlay multiple types of plot -- even in 3D.
+ #
+ $rv = rvals(101,101)/5; $im = cos($rv)/($rv+2.5);
+ $grad = sumover $im->range([[-1,0],[1,0]],[$im->dims],'e') * pdl(-1,1);
+
+ $im2 = $im->indexND(ndcoords(26,26)*4); # subsample $im
+
+ $w->reset;
+ $w->options( trid=>1, hidden=>'front', colorbox=>0, clut=>'heat1' );
+
+ $w->multiplot(layout=>[2,2]);
+
+ $w->plot( {title=>"A colormap-shaded 3-d surface plot"}, with=>'pm3d', $im );
+
+ $w->plot( {title=>"Perspective 3-d surface plot"},
+ with=>'pm3d', xvals($im), yvals($im), $im, $grad );
+
+ $w->plot( {title=>"Perspective grid plot"},
+ with=>'lines', xvals($im2)*4, yvals($im2)*4, $im2 );
+
+ $w->plot( {title=>"Combined"},
+ with=>'pm3d', xvals($im),yvals($im), $im, $grad,
+ with=>'lines', xvals($im2)*4, yvals($im2)*4, $im2 );
+
+ $w->end_multi;
+
+|;
+
+
+ use File::Spec;
+ $d = File::Spec->catdir( "PDL", "Demos" );
+ $m51path = undef;
+ foreach my $path ( @INC ) {
+ my $check = File::Spec->catdir( $path, $d );
+ if ( -d $check ) { $m51path = $check; last; }
+ }
+ if( defined($m51path) && -e "$m51path/m51.fits") {
+ $m51path = "$m51path/m51.fits";
+ } else {
+ comment q|
+
+ ******************************************************
+ You seem to be missing the file 'm51.fits', which
+ should be included in the PDL distribution. Without
+ it, I can't show you the m51 image demos, so I'll
+ quit now.
+ ******************************************************
+ |;
+ return;
+ }
+
+ $s = q|
+ # Images ...
+
+ $m51 = rfits('%%m51%%');
+
+ $w->reset;
+ $w->image({j=>1, clut=>'gray', title=>"M51 galaxy"}, with=>'image',$m51 );
+|;
+
+ $s=~ s/\%\%m51\%\%/$m51path/;
+ act $s;
+
+ $s = q|
+
+ $m51 = rfits('%%m51%%')->slice('0:-1:4,0:-1:4');
+
+ $m51s = $m51->convolveND(ones(11,11)/11**2);
+
+ $w->options(clut=>'heat2', trid=>1);
+
+ # 3-D display of M51: various angles (note "columnsfirst" in multiplot)
+
+ $w->multiplot(layout=>[2,2,'columnsfirst']);
+
+ $w->plot({title=>"M51 in 3-D (default view)"},
+ with=>'pm3d',xvals($m51s), yvals($m51s), $m51s, $m51s );
+ $w->plot({title=>"M51 in 3-D (ortho view)", view=>'equal xy'},
+ with=>'pm3d',xvals($m51s), yvals($m51s), $m51s, $m51s );
+
+ $w->plot({title=>"M51 in 3-D (near-vertical view)", view=>[ 0, 80, 'equal xy' ]},
+ with=>'pm3d',xvals($m51s), yvals($m51s), $m51s, $m51s );
+ $w->plot({title=>"M51 in 3-D (nearly along X axis)", view=>[ 85, 5 ]},
+ with=>'pm3d',xvals($m51s), yvals($m51s), $m51s, $m51s );
+
+ $w->end_multi;
+
+|;
+ $s =~ s/\%\%m51\%\%/$m51path/;
+ act $s;
+}
+1;
+
+
+
diff --git a/Demos/Makefile.PL b/Demos/Makefile.PL
new file mode 100644
index 0000000..841657a
--- /dev/null
+++ b/Demos/Makefile.PL
@@ -0,0 +1,43 @@
+
+require 'Core/Dev.pm'; PDL::Core::Dev->import();
+
+use ExtUtils::MakeMaker;
+# # See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# # the contents of the Makefile that is written.
+#
+# NOTE:
+# we hijack m51.fits from the parent directory and
+# install that into the demos directory
+#
+WriteMakefile(
+ 'NAME' => 'PDL::Demos',
+ 'VERSION_FROM' => '../Basic/Core/Version.pm',
+ 'PM' => {'General.pm' => '$(INST_LIBDIR)/Demos/General.pm',
+ 'Screen.pm' => '$(INST_LIBDIR)/Demos/Screen.pm',
+ 'TriD1.pm' => '$(INST_LIBDIR)/Demos/TriD1.pm',
+ 'TriD2.pm' => '$(INST_LIBDIR)/Demos/TriD2.pm',
+ 'TriDGallery.pm' => '$(INST_LIBDIR)/Demos/TriDGallery.pm',
+ 'PGPLOT_demo.pm' => '$(INST_LIBDIR)/Demos/PGPLOT_demo.pm',
+ 'PGPLOT_OO_demo.pm' => '$(INST_LIBDIR)/Demos/PGPLOT_OO_demo.pm',
+ 'BAD_demo.pm' => '$(INST_LIBDIR)/Demos/BAD_demo.pm',
+ 'BAD2_demo.pm' => '$(INST_LIBDIR)/Demos/BAD2_demo.pm',
+ 'Transform_demo.pm' => '$(INST_LIBDIR)/Demos/Transform_demo.pm',
+ 'Cartography_demo.pm' => '$(INST_LIBDIR)/Demos/Cartography_demo.pm',
+ 'Gnuplot_demo.pm' => '$(INST_LIBDIR)/Demos/Gnuplot_demo.pm',
+ '../m51.fits' => '$(INST_LIBDIR)/Demos/m51.fits',
+ 'Prima.pm' => '$(INST_LIBDIR)/Demos/Prima.pm',
+ },
+ 'clean' => { 'FILES' => 'BAD_demo.pm BAD2_demo.pm' },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
+# For the lazy people
+sub MY::postamble {
+PDL::Core::Dev::postamble().
+q~
+
+test_tjl :
+ PERL_DL_NONLAZY=1 $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' *.pl
+
+~
+}
diff --git a/Demos/PGPLOT_OO_demo.pm b/Demos/PGPLOT_OO_demo.pm
new file mode 100644
index 0000000..0226979
--- /dev/null
+++ b/Demos/PGPLOT_OO_demo.pm
@@ -0,0 +1,134 @@
+package PDL::Demos::PGPLOT_OO_demo;
+
+# show how to use the new OO PGPLOT interface
+
+use PDL;
+use PDL::Graphics::PGPLOT::Window;
+
+PDL::Demos::Routines->import();
+sub comment($);
+sub act($);
+sub output;
+
+sub run {
+
+$ENV{PGPLOT_XW_WIDTH}=0.3;
+$ENV{PGPLOT_DEV}=$^O =~ /MSWin32/ ? '/GW' : "/XSERVE";
+
+comment q|
+ The PGPLOT demo showed you how to use the old interface to PGPLOT.
+ As this is perl, TIMTOWTDI, and this demo shows you how to use the
+ new, object-orientated PGPLOT interface. For the simple examples
+ shown here, the new method appears overkill; however, it really
+ comes into its own when you wish to deal with multiple plots
+ or windows.
+
+ Enough prattle, on with the show...
+
+|;
+
+act q|
+ # we start with a different module to the traditional interface
+ use PDL::Graphics::PGPLOT::Window;
+
+ # create a window "object"
+ $dev = $^O =~ /MSWin32/ ? '/GW' : '/XSERVE';
+ $win = PDL::Graphics::PGPLOT::Window->new( { Dev => $dev } );
+
+|;
+
+act q|
+ # First we define some variables to use for the rest of the demo.
+ $x=sequence(10);
+ $y=2*$x**2;
+
+ # Now a simple plot with points
+ $win->points( $x, $y );
+
+|;
+
+act q|
+ # Here is the same with lines
+ $win->line( $x, $y );
+
+ # if you're beginning to think its the same as the old calls,
+ # just with "$win->" at the beginning then you're not far wrong!
+
+|;
+
+act q|
+ # You can do all the things you did before ...
+
+ $win->points( $x, $y, {Symbol=>4} );
+ $win->hold;
+ $win->line( $x, $y );
+ $yerr=sqrt($y);
+ $win->errb( $x, $y, $yerr );
+
+ $win->release;
+
+|;
+
+act q|
+ # and it acts the same way
+
+ $gradient=sequence(40,40);
+ $win->imag( $gradient );
+ $win->hold;
+ $win->cont( $gradient );
+ $win->release;
+
+ # add labels to the plot
+ $win->label_axes( "An axis", "Another axis", "Title" );
+|;
+
+
+act q|
+ # let's try and read the cursor
+
+ use PDL::Complex;
+ $c = zeroes(300)->xlinvals(0,12)+i*zeroes(300)->xlinvals(2,10);
+ $sin = sin $c;
+ $win->line( $sin->im, $sin->re );
+
+ print "Select a point in the graph (mouse button or key press):\n";
+ ( $x, $y, $ch ) = $win->cursor( { Type=>'CrossHair' } );
+
+ print "\nYou selected: $x + $y i (key = $ch)\n";
+
+|;
+
+# should really do something related to the selected points...
+
+act q|
+ # how about another window?
+
+ $win2 = PDL::Graphics::PGPLOT::Window->new( { Dev => $dev } );
+ $win2->env( 0, 4, -2, 0, { Axis => 'logy' } );
+ $x = sequence(101) / 25;
+ $win2->points( $x, $x->sin->abs()->log10 );
+
+|;
+
+act q|
+ # switch back to the original window (we don't want to hurt
+ # its feelings)
+
+ $win->line( $x, { Border => 1 } );
+
+|;
+
+act q|
+ # free up the windows, after finding their names
+
+ print "You've been watching " . $win->name();
+ print " and " . $win2->name() . "\n";
+
+ $win->close();
+ $win2->close();
+
+|;
+
+}
+
+1;
diff --git a/Demos/PGPLOT_demo.pm b/Demos/PGPLOT_demo.pm
new file mode 100644
index 0000000..b510b8a
--- /dev/null
+++ b/Demos/PGPLOT_demo.pm
@@ -0,0 +1,223 @@
+package PDL::Demos::PGPLOT_demo;
+use PDL;
+use PDL::Graphics::PGPLOT;
+
+PDL::Demos::Routines->import();
+sub comment($);
+sub act($);
+sub output;
+
+sub run {
+
+$ENV{PGPLOT_XW_WIDTH}=0.3;
+$ENV{PGPLOT_DEV}=$^O =~ /MSWin32/ ? '/GW' : "/XSERVE";
+
+comment q|
+ Welcome to this tour of the PDL's PGPLOT interface.
+
+ This tour will introduce the PDL's PGPLOT plotting module and show
+ what this powerful package can provide in terms of plotting. It is
+ not designed to give a full tour of PGPLOT, you are advised to see
+ the routines provided with pgperl for that.
+
+ The PDL::Graphics::PGPLOT module provides a high-level interface
+ to PGPLOT. However if you want even better control of your plots
+ you might want to include the PGPLOT module specifically:
+
+ use PGPLOT;
+
+ One aspect of PGPLOT that requires mention is the use of devices:
+ Normally PGPLOT will inquire you about what device you want to use,
+ with the prompt:
+
+ Graphics device/type (? to see list, default /NULL):
+
+
+|;
+
+act q|
+ # ensure the module is loaded (required for PDL versions >= 2.004)
+ use PDL::Graphics::PGPLOT;
+ # The size of the window can be specified
+ $ENV{PGPLOT_XW_WIDTH}=0.3;
+ # You can set your device explicitly
+ $id=dev($^O =~ /MSWin32/ ? '/GW' : '/XSERVE');
+|;
+
+act q|
+ # First we define some variables to use for the rest of the demo.
+ $x=sequence(10);
+ $y=2*$x**2;
+
+ # Now a simple plot with points
+ points $x, $y;
+|;
+
+act q|
+ # Here is the same with lines
+ line $x, $y;
+|;
+
+act q|
+ # If you want to overlay one plot you can use the command
+ # 'hold' to put the graphics on hold and 'release' to
+ # revert the effect
+
+ points $x, $y, {SYMBOL=>4}; # The last argument sets symboltype
+ hold;
+ # Now draw lines between the points
+ line $x, $y;
+ # Plot errorbars over the points
+ $yerr=sqrt($y);
+ errb $x, $y, $yerr;
+
+ # To revert to old behaviour, use release
+ release;
+|;
+
+act q|
+ bin $x, $y;
+
+ # This plots a binned histogram of the data and as you can
+ # see it made a new plot.
+|;
+
+act q|
+ # 2D data can also easily be accomodated:
+
+ # First make a simple image
+ $gradient=sequence(40,40);
+
+ # Then display it.
+ imag $gradient;
+
+ # And overlay a contour plot over it:
+ hold;
+ cont $gradient;
+ release;
+|;
+
+act q|
+ # PDL::Graphics::PGPLOT contains several colour tables,
+ # a more extensive collection can be found in
+ # PDL::Graphics::LUT
+ #
+ # (note: the call to lut_names() can take a few seconds to execute)
+ #
+ use PDL::Graphics::LUT;
+ @names = lut_names();
+ print "Available tables: [ ", @names, " ]\n";
+
+ # use the first table
+ ctab( lut_data($names[0]) );
+ use PGPLOT;
+ pglabel "", "", "Colour table: $names[0]";
+
+|;
+
+act q|
+ # To change plot specifics you can either use the specific PGPLOT
+ # commands - recommended if you need lots of control over your
+ # plot.
+ #
+ # Or you can use the new option specifications:
+
+ # To plot our first graph again with blue color, dashed line
+ # and a thickness of 10 we can do:
+
+ line $x, $y, {COLOR=>5, LINESTYLE=>'dashed', LINEWIDTH=>10};
+
+|;
+
+act q|
+
+ # Now for a more complicated example.
+ # First create some data
+ $a=sequence(360)*3.1415/180.;
+ $b=sin($a)*transpose(cos($a));
+
+ # Make a piddle with the wanted contours
+ $contours=pdl [0.1,0.5,1.0];
+ # And an array (reference to an array) with labels
+ $labels=['A', 'B', 'C'];
+ # Create a contour map of the data - note that we can set the colour of
+ # the labels.
+ cont($b, {CONTOURS=>$contours, linest=>'DASHED',
+ LINEWIDTH=>3, COLOR=>2, LABELCOL=>4});
+ hold;
+
+ pgqlw($linewidth);
+
+ points $a->slice('0:-1:4')*180./3.1415;
+ release;
+|;
+
+act q|
+ #
+ # More examples of changing the plot defaults
+ #
+ $a = 1+sequence(10);
+ $b = $a*2;
+ $bord_opt = { TYPE => 'RELATIVE', VALUE => 0.1 };
+ line log10($a), $b, { AXIS => 'LOGX', BORDER => $bord_opt };
+|;
+
+act q|
+ #
+ # We can also create vector maps of data
+ # This requires one array for the horizontal component and
+ # one for the vertical component
+ #
+ $horizontal=sequence(10,10);
+ $vertical=transpose($horizontal)+random(10,10)*$horizontal/10.;
+
+ $arrow={ARROW=> {FS=>1, ANGLE=>25, VENT=>0.7, SIZE=>3}};
+ vect $horizontal, $vertical, {ARROW=>$arrow, COLOR=>RED};
+ hold;
+ cont $vertical-$horizontal, {COLOR=>YELLOW};
+ release;
+
+|;
+
+act q|
+ #
+ # To draw [filled] polygons, the command poly is handy:
+ #
+
+ $x=sequence(10)/5;
+ poly $x, $x**2, {FILL=>HATCHED, COLOR=>BLUE};
+
+|;
+
+act q|
+ #
+ # the latest feature of PDL are complex numbers
+ # so let's play with a simple example
+ #
+
+
+ use PDL::Complex;
+ $z50 = zeroes(50);
+ $c = $z50->xlinvals(0,7)+i*$z50->xlinvals(2,4);
+ line im sin $c; hold; # the imaginary part
+ line re sin $c; # real
+ line abs sin $c; release; # and the modulus
+
+|;
+
+act q|
+ #
+ # more complex numbers
+ #
+
+ use PDL::Complex;
+ $c = zeroes(300)->xlinvals(0,12)+i*zeroes(300)->xlinvals(2,10);
+ $sin = sin $c;
+ line $sin->im, $sin->re; # look at the result in the complex plane
+ #close the window--we're done!
+ close_window($id);
+|;
+
+}
+
+1;
diff --git a/Demos/Prima.pm b/Demos/Prima.pm
new file mode 100644
index 0000000..74e57ba
--- /dev/null
+++ b/Demos/Prima.pm
@@ -0,0 +1,618 @@
+use strict;
+use warnings;
+
+############################################################################
+ package PDL::Demos::Prima;
+############################################################################
+
+use PDL;
+
+=head1 NAME
+
+PDL::Demos::Prima - PDL demo for PDL::Graphics::Prima
+
+=head1 SYNOPSIS
+
+You can enjoy this demo in any number of ways. First, you can invoke the
+demo from the command line by saying
+
+ perl -MPDL::Demos::Prima
+
+Second, you can invoke the demo from with the pdl shell by saying
+
+ pdl> demo prima
+
+Finally, all of the content is in the pod documentation, so you can simply
+read this, though it won't be quite so interactive. :-)
+
+ perldoc PDL::Demos::Prima
+ podview PDL::Demos::Prima
+
+=head1 DESCRIPTION
+
+The documentation in this module is meant to give a short, hands-on
+introduction to L<PDL::Graphics::Prima|PDL::Graphics::Prima/>, a plotting
+library written on top of the L<Prima|Prima/> GUI toolkit.
+
+=cut
+
+##############################
+# Check load status of Prima #
+##############################
+
+my $min_version = 0.13;
+my $loaded_prima = eval {
+ require PDL::Graphics::Prima;
+ return 0 if $PDL::Graphics::Prima::VERSION < $min_version;
+ require PDL::Graphics::Prima::Simple;
+ PDL::Graphics::Prima::Simple->import();
+ require Prima::Application;
+ Prima::Application->import();
+ 1;
+};
+
+###########################################
+# Pull the demo pod into a data structure #
+###########################################
+
+# Pull the pod apart into the following sort of array structure
+# @demo = (
+# 'Introduction' => $first_paragraph => $first_code,
+# 'Introduction' => $second_paragraph => $second_code,
+# ...
+# 'First steps' => $first_paragraph => $first_code,
+# ...
+# );
+
+my (@demo, $curr_section, $curr_par, $curr_code);
+my $curr_state = 'section_title';
+while(my $line = <DATA>) {
+ # Only =head2s in this documentation
+ last if $line =~ /=head1/;
+ if ($line =~ /^=head2 (.*)/) {
+ # Add the current section's name and an empty arrayref
+ $curr_section = $1;
+ }
+ elsif ($line =~ /^\n/) {
+ if (defined $curr_par and defined $curr_code) {
+ push @demo, $curr_section, $curr_par, $curr_code;
+ $curr_par = $curr_code = undef;
+ }
+ }
+ elsif (not defined $curr_par) {
+ $curr_par = $line;
+ }
+ elsif (not defined $curr_code and $line !~ /^\s/) {
+ $curr_par .= $line;
+ }
+ elsif ($line =~ /^\s/) {
+ # Accumulate code lines, stripping off the leading space
+ $line =~ s/^\s//;
+ $curr_code .= $line;
+ }
+}
+
+# Add some extra content for Prima viewing only
+if ($loaded_prima) {
+ unshift @demo, 'Introduction',
+'This is the demo for L<PDL::Graphics::Prima|PDL::Graphics::Prima/>. Explanatory
+text will appear here; code samples will appear below. Tip: you can modify and
+re-run the code samples. When you are done, simply close the window.',
+'### HEY, EDIT ME! ###
+use Prima::MsgBox;
+Prima::MsgBox::message( "Hello, this is the PDL::Graphics::Prima demo.", mb::Ok);'
+}
+
+##################################
+# The command that runs the demo #
+##################################
+
+# These are widgts I will need across multiple functions, so they are globals.
+my ($section_title_label, $text_pod, $code_eval, $prev_button, $next_button,
+ $run_button, $help_window, $window, $is_evaling);
+sub run {
+
+ # Make sure they have it. Otherwise, bail out.
+ if (not $loaded_prima) {
+ my $reason =
+"I couldn't load the library, either because it's not installed on your
+machine or it's broken.";
+ $reason =
+"your version of PDL::Graphics::Prima (v$PDL::Graphics::Prima::VERSION) is out of date. This demo
+requires at least v$min_version." if defined $loaded_prima;
+ print <<SORRY;
+
+Thanks for trying to learn more about PDL::Graphics::Prima. Unfortunately,
+$reason
+
+If you really want to get this working, the fastest way to get help is to
+join the live chat on the PDL irc channel. If you have an IRC client, check
+out
+
+ irc.perl.org#pdl
+
+If you don't have an IRC client, you can join the discussion via mibbit:
+
+ http://www.mibbit.com/chat/?url=irc://irc.perl.org/pdl
+
+If you would rather, you can send an email to the mailing list:
+
+ http://mailman.jach.hawaii.edu/mailman/listinfo/perldl
+
+For more information about PDL::Graphics::Prima, check out
+
+ http://p3rl.org/PDL::Graphics::Prima.
+
+
+Thanks, and keep trying! I promise it's worth it.
+
+SORRY
+ return;
+ }
+
+ # Note that by the time we reach here, $::application is defined.
+ require Prima::Label;
+ require Prima::PodView;
+ require Prima::Buttons;
+ require Prima::Utils;
+ require Prima::Edit;
+
+ my $current_slide = 0;
+
+ # ---( Build the Demo Window )--- #
+
+ # Window
+ $window = Prima::Window->create(
+ place => {
+ relx => 0.15, relwidth => 0.7, relheight => 0.7, rely => 0.15,
+ anchor => 'sw',
+ },
+ sizeMax => [600, 800],
+ sizeMin => [600, 800],
+ text => 'PDL::Graphics::Prima Demo',
+ onDestroy => sub {
+ require Prima::Utils;
+ # Throw an exception after destruction is complete so that we
+ # break out of the $::application->go loop.
+ Prima::Utils::post(sub { die 'time to exit the event loop' });
+ },
+ onKeyUp => \&keypress_handler,
+ );
+ $window->font->size(12);
+ # Title
+ # ---( Build list of windows that we don't want to close )---
+ my @dont_touch = $::application->get_widgets;
+
+ my $title_height = 50;
+ $section_title_label = $window->insert(Label =>
+ place => {
+ x => 0, relwidth => 1, anchor => 'sw',
+ y => -$title_height, rely => 1, height => $title_height,
+ },
+ text => '',
+ height => $title_height,
+ alignment => ta::Center(),
+ valignment => ta::Center(),
+ backColor => cl::White(),
+ font => {
+ size => 24,
+ },
+ onKeyUp => \&keypress_handler,
+ );
+ # Buttons
+ my $button_height = 35;
+ $prev_button = $window->insert(Button =>
+ place => {
+ x => 0, relwidth => 0.333, anchor => 'sw',
+ y => 0, height => $button_height,
+ },
+ height => $button_height,
+ text => 'Previous',
+ enabled => 0,
+ onClick => sub {
+ $current_slide-- unless $current_slide == 0;
+ setup_slide($current_slide);
+ },
+ );
+ $run_button = $window->insert(Button =>
+ place => {
+ relx => 0.333, relwidth => 0.333, anchor => 'sw',
+ y => 0, height => $button_height,
+ },
+ height => $button_height,
+ text => 'Run',
+ onClick => sub {
+ # Clear out old windows
+ for my $curr_window ($::application->get_widgets) {
+ next if grep { $curr_window == $_ } @dont_touch
+ or defined $help_window and $curr_window == $help_window;
+ $curr_window->destroy;
+ }
+
+ # Disable the buttons
+ my $prev_state = $prev_button->enabled;
+ $prev_button->enabled(0);
+ $run_button->enabled(0);
+ my $next_state = $next_button->enabled;
+ $next_button->enabled(0);
+
+ # Run the eval
+ eval 'no strict; no warnings; ' . $code_eval->text;
+ if ($@ and $@ !~ /time to exit the event loop/ ) {
+ warn $@;
+ Prima::MsgBox::message($@);
+ }
+
+ $prev_button->enabled($prev_state);
+ $run_button->enabled(1);
+ $next_button->enabled($next_state);
+ },
+ );
+ $next_button = $window->insert(Button =>
+ place => {
+ relx => 0.666, relwidth => 0.333, anchor => 'sw',
+ y => 0, height => $button_height,
+ },
+ height => $button_height,
+ text => 'Next',
+ onClick => sub {
+ $current_slide++ unless $current_slide == @demo/3;
+ setup_slide($current_slide);
+ },
+ );
+ # Text
+ my $par_container = $window->insert(Widget =>
+ place => {
+ x => 0, relwidth => 1, anchor => 'sw',
+ rely => 0.6, relheight => 0.4, height => -$title_height-1,
+ },
+ backColor => cl::White(),
+ );
+ my $padding = 10;
+ $text_pod = $par_container->insert(PodView =>
+ place => {
+ x => $padding, relwidth => 1, width => -2*$padding,
+ y => $padding, relheight => 1, height => -2*$padding - 15,
+ anchor => 'sw',
+ },
+ # This Event does not appear to be documented!!! Beware!!!
+ # Modify link clicking so that it opens the help window instead
+ # of following the link.
+ onLink => sub {
+ my ($self, $link) = @_;
+ # $link is a reference to the link that should be opened; deref
+ $::application->open_help($$link);
+ # Store the help window so we can close it on exit later
+ $help_window = $::application->get_active_window;
+ # Bring the help window to the fore
+ $::application->get_active_window->bring_to_front
+ if $::application->get_active_window;
+ # Clear the event so that it doesn't follow the link in this
+ # renderer
+ $self->clear_event;
+ },
+ backColor => cl::White(),
+ borderWidth => 0,
+ autoVScroll => 1,
+ onKeyUp => \&keypress_handler,
+ );
+
+ # Code
+ my $code_container = $window->insert(Widget =>
+ place => {
+ x => 0, relwidth => 1, anchor => 'sw',
+ y => $button_height+1, relheight => 0.6, height => -$button_height-2,
+ },
+ backColor => cl::White(),
+ );
+ $code_eval = $code_container->insert(Edit =>
+ place => {
+ x => $padding, relwidth => 1, width => -2*$padding,
+ y => $padding, relheight => 1, height => -2*$padding,
+ anchor => 'sw',
+ },
+ borderWidth => 0,
+ backColor => cl::White(),
+ tabIndent => 4,
+ syntaxHilite => 1,
+ wantTabs => 1,
+ wantReturns => 1,
+ wordWrap => 0,
+ autoIndent => 1,
+ cursorWrap => 1,
+ font => { name => 'monospace', size => 12 },
+ );
+
+ $window->bring_to_front;
+ setup_slide(0);
+
+ # Run this sucker
+ local $@;
+ eval { $::application->go };
+ $help_window->close if defined $help_window and $help_window->alive;
+}
+
+sub keypress_handler {
+ my ($self, $code, $key, $mod) = @_;
+ if ($key == kb::Down() or $key == kb::Right() or $key == kb::PgDn()) {
+ $next_button->notify('Click');
+ }
+ elsif ($key == kb::Up() or $key == kb::Left() or $key == kg::PgUp()) {
+ $prev_button->notify('Click');
+ }
+ else {
+ $code_eval->notify('KeyUp', $code, $key, $mod);
+ }
+}
+
+
+#############################################################
+# Function that transitions between paragraphs and sections #
+#############################################################
+
+sub setup_slide {
+ my $number = shift;
+ if ($number == 0) {
+ $prev_button->enabled(0);
+ }
+ else {
+ $prev_button->enabled(1);
+ }
+ if ($number == @demo/3 - 1) {
+ $next_button->enabled(1);
+ $next_button->text('Finish');
+ }
+ elsif ($number == @demo/3) {
+ # Close the window
+ $window->notify('Destroy');
+ return;
+ }
+ else {
+ $next_button->enabled(1);
+ $next_button->text('Next');
+ }
+
+ $number *= 3;
+ # Set the section title and code
+ $section_title_label->text($demo[$number]);
+ $code_eval->text($demo[$number+2]);
+
+ # Load the pod
+ $text_pod->open_read;
+ $text_pod->read("=pod\n\n$demo[$number+1]\n\n=cut");
+ $text_pod->close_read;
+
+ # Run the demo
+ $run_button->notify('Click');
+}
+
+# This way, it can be invoked as "perl -MPDL::Demos::Prima" or as
+# "perl path/to/Prima.pm"
+if ($0 eq '-' or $0 eq __FILE__) {
+ run;
+ exit;
+}
+
+1;
+
+__DATA__
+
+=head2 use PDL::Graphics::Prima::Simple
+
+To get started, you will want to use
+L<PDL::Graphics::Prima::Simple|PDL::Graphics::Prima::Simple/>. This
+module provides a set of friendly wrappers for simple, first-cut data
+visualization. L<PDL::Graphics::Prima|PDL::Graphics::Prima/>, the underlying
+library, is a general-purpose 2D plotting library built as a widget in the
+L<Prima GUI toolkit|Prima/>, but we don't need the full functionality for
+the purposes of this demo.
+
+ use PDL::Graphics::Prima::Simple;
+ my $x = sequence(100)/10;
+ line_plot($x, $x->sin);
+
+=head2 More than just lines!
+
+In addition to numerous ways to plot x/y data, you can also plot
+distributions and images. The best run-down of the simple plotting routines
+can be found in
+L<the Synopsis for PDL::Graphics::Prima::Simple|PDL::Graphics::Prima::Simple/SYNOPSIS>.
+
+ $distribution = grandom(100);
+ hist_plot($distribution);
+
+ $x = sequence(100)/10;
+ cross_plot($x, $x->sin);
+
+ $image = rvals(100, 100);
+ matrix_plot($image);
+
+=head2 Mouse Interaction
+
+Plots allow for
+L<mouse interaction|PDL::Graphics::Prima::Simple/"Interactive Features">,
+herein referred to as twiddling. You can resize the window, zoom with the
+scroll wheel, or click and drag the canvas around. There is also a
+right-click zoom-rectangle, and a right-click context menu.
+
+ hist_plot(grandom(100));
+
+ # Run this, then try using your mouse
+
+In your Perl scripts, and in the PDL shell for some operating systems and
+some versions of L<Term::ReadLine>, twiddling will cause your script to pause
+when you create a new plot. To resume your script or return execution to the
+shell, either close the window or press 'q'.
+
+ # If your PDL shell supports simultaneous
+ # input and plot interaction, running this
+ # should display both plots simultaneously:
+
+ $x = sequence(100)/10;
+ cross_plot($x, $x->sin);
+ line_plot($x, $x->cos);
+
+=head2 Multiple plots without blocking
+
+The blocking behavior just discussed is due to what is called autotwiddling.
+To turn this off, simply send a boolean false value to auto_twiddle. Then,
+be sure to invoke twiddling when you're done creating your plots.
+
+ auto_twiddle(0);
+ hist_plot(grandom(100));
+ matrix_plot(rvals(100, 100));
+ twiddle();
+
+Once turned off, autotwiddling will remain off until you turn it back on.
+
+ # autotwiddling still off
+ hist_plot(grandom(100));
+ matrix_plot(rvals(100, 100));
+ twiddle();
+
+=head2 Adding a title and axis labels
+
+Functions like
+L<hist_plot|PDL::Graphics::Prima::Simple/hist_plot>,
+L<cross_plot|PDL::Graphics::Prima::Simple/cross_plot>, and
+L<matrix_plot|PDL::Graphics::Prima::Simple/matrix_plot> actually create and
+return plot objects which you can subsequently modify. For example,
+adding a title and axis labels are pretty easy. For titles, you call the
+L<title method on the plot object|PDL::Graphics::Prima/title>. For axis
+labels, you call the
+L<label method on the axis objects|PDL::Graphics::Prima::Axis/label>.
+
+ # Make sure autotwiddling is off in your script
+ auto_twiddle(0);
+
+ # Build the plot
+ my $x = sequence(100)/10;
+ my $plot = line_plot($x, $x->sin);
+
+ # Add the title and labels
+ $plot->title('Harmonic Oscillator');
+ $plot->x->label('Time [s]');
+ $plot->y->label('Displacement [cm]');
+
+ # Manually twiddle once everything is finished
+ twiddle();
+
+=head2 Saving to a file
+
+L<PDL::Graphics::Prima::Simple> excels at user interaction, but you can save
+your plots to a file using L<save_to_file|PDL::Graphics::Prima/save_to_file>
+or L<save_to_postscript|PDL::Graphics::Prima/save_to_postscript> methods, or
+by right-clicking and selecting the appropriate menu option.
+
+ auto_twiddle(0);
+ $x = sequence(100)/10;
+ line_plot($x, $x->sin)->save_to_postscript;
+
+ # You can supply a filename to the method if you like.
+ # Also available is save_to_file, which saves to raster
+ # file formats. Expect save_to_postscript to be merged
+ # into save_to_file in the future.
+
+=head2 Adding additional data to the plot
+
+Once you have created a plot, you can
+L<add additional data to it|PDL::Graphics::Prima/dataSets>. You
+achieve this by adding a new
+L<DataSet|PDL::Graphics::Prima::DataSet> with the data you want displayed.
+
+ auto_twiddle(0);
+ my $plot = hist_plot(grandom(100));
+
+ # Add a Gaussian curve that "fits" the data
+ use PDL::Constants qw(PI);
+ my $fit_xs = zeroes(100)->xlinvals(-2, 2);
+ my $fit_ys = exp(-$fit_xs**2 / 2) / sqrt(2*PI);
+ $plot->dataSets->{fit_curve} = ds::Pair($fit_xs, $fit_ys);
+
+ twiddle();
+
+The default L<plot type|PDL::Graphics::Prima::PlotType/> for
+L<pairwise data|PDL::Graphics::Prima::DataSet/Pair> is
+L<Diamonds|PDL::Graphics::Prima::PlotType/ppair::Diamonds>. You can choose a
+L<different pairwise plot type|PDL::Graphics::Prima::PlotType/Pairs>, or
+even mix and match L<multiple pairwise plot types|PDL::Graphics::Prima::PlotType/SYNOPSIS>.
+
+ auto_twiddle(0);
+ my $plot = hist_plot(grandom(100));
+
+ # Add a Gaussian curve that "fits" the data
+ use PDL::Constants qw(PI);
+ my $fit_xs = zeroes(200)->xlinvals(-5, 5);
+ my $fit_ys = exp(-$fit_xs**2 / 2) / sqrt(2*PI);
+ $plot->dataSets->{fit_curve} = ds::Pair($fit_xs, $fit_ys,
+ # Use lines
+ plotTypes => [
+ ppair::Lines(
+ # with a thickness of three pixels
+ lineWidth => 3,
+ # And the color red
+ color => cl::LightRed,
+ ),
+ ppair::Diamonds,
+ ],
+ );
+
+ twiddle();
+
+=head2 The plot command
+
+If you want to specify everything in one command, you can use the plot
+function. This lets you put everything together that we've already discussed,
+including multiple DataSets in a single command, title specification, and
+x and y axis options.
+
+ # Generate some data:
+ my $xs = sequence(100)/10 + 0.1;
+ my $ys = $xs->sin + $xs->grandom / 10;
+ my $y_err = $ys->grandom/10;
+
+ # Plot the data and the fit
+ plot(
+ -data => ds::Pair($xs, $ys,
+ plotTypes => [
+ ppair::Triangles(filled => 1),
+ ppair::ErrorBars(y_err => $y_err),
+ ],
+ ),
+ -fit => ds::Func(\&PDL::sin,
+ lineWidth => 3,
+ color => cl::LightRed,
+ ),
+ -note => ds::Note(
+ pnote::Text('Incoming Signal',
+ x => 0.2,
+ y => sin(0.2) . '-3em',
+ ),
+ ),
+ title => 'Noisey Sine Wave',
+ x => {
+ label => 'Time [s]',
+ scaling => sc::Log,
+ },
+ y => { label => 'Measurement [Amp]' },
+ );
+
+=head2 Enjoy PDL::Graphics::Prima!
+
+I hope you've enjoyed the tour, and I hope you find
+L<PDL::Graphics::Prima|PDL::Graphics::Prima/> to be a useful plotting tool!
+
+ # Thanks!
+
+=head1 AUTHOR
+
+David Mertens C<dcmertens.perl at gmail.com>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2013, David Mertens. All righs reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself. See L<perlartistic>.
+
+=cut
diff --git a/Demos/Screen.pm b/Demos/Screen.pm
new file mode 100644
index 0000000..3a360f9
--- /dev/null
+++ b/Demos/Screen.pm
@@ -0,0 +1,62 @@
+# Perform pdl demos on terminals
+
+package PDL::Demos::Routines;
+
+# Copyright (C) 1998 Tuomas J. Lukka.
+# All rights reserved, except redistribution
+# with PDL under the PDL License permitted.
+
+use Carp;
+use PDL;
+
+ at ISA="Exporter";
+ at EXPORT = qw/comment act actnw output/;
+
+$SIG{__DIE__} = sub {die Carp::longmess(@_);};
+
+sub home() {
+ if (-e '/usr/bin/tput') {
+ system 'tput clear';
+ } elsif ( $^O eq 'MSWin32' ) {
+ system 'cls';
+ }
+}
+
+sub comment($) {
+ home();
+ print "----\n";
+ print $_[0];
+ my $prompt = "---- (press enter)";
+ defined($PERLDL::TERM) ? $PERLDL::TERM->readline($prompt) : ( print $prompt, <> );
+}
+
+sub act($) {
+ home();
+ my $script = $_[0];
+ $script =~ s/^(\s*)output/$1print/mg;
+ print "---- Code:";
+ print $script;
+ print "---- Output:\n";
+ my $pack = (caller)[0];
+# eval "package $pack; use PDL; $_[0]";
+ eval "package $pack; use PDL; $_[0]";
+ print "----\nOOPS!!! Something went wrong, please make a bug report!: $@\n----\n" if $@;
+ my $prompt = "---- (press enter)";
+ defined($PERLDL::TERM) ? $PERLDL::TERM->readline($prompt) : ( print $prompt, <> );
+}
+
+sub actnw($) {
+ home();
+ my $script = $_[0];
+ $script =~ s/^(\s*)output/$1print/mg;
+ print "---- Code:";
+ print $script;
+ print "---- Output:\n";
+ my $pack = (caller)[0];
+# eval "package $pack; use PDL; $_[0]";
+ eval "package $pack; use PDL; $_[0]";
+ print "----\n";
+ print "----\nOOPS!!! Something went wrong, please make a bug report!: $@\n----\n" if $@;
+}
+
+sub output {print @_}
diff --git a/Demos/Transform_demo.pm b/Demos/Transform_demo.pm
new file mode 100644
index 0000000..29c2eba
--- /dev/null
+++ b/Demos/Transform_demo.pm
@@ -0,0 +1,335 @@
+#
+package PDL::Demos::Transform_demo;
+
+use PDL;
+use PDL::Graphics::PGPLOT::Window;
+use PDL::Transform;
+
+use File::Spec;
+
+PDL::Demos::Routines->import();
+sub comment($);
+sub act($);
+sub output;
+
+sub run {
+ local($PDL::debug) = 0;
+ local($PDL::verbose) = 0;
+
+##$ENV{PGPLOT_XW_WIDTH}=0.6;
+$ENV{PGPLOT_DEV}=$^O =~ /MSWin32/ ? '/GW' : "/XWIN";
+
+# try and find m51.fits
+$d = File::Spec->catdir( "PDL", "Demos" );
+$m51path = undef;
+foreach my $path ( @INC ) {
+ my $check = File::Spec->catdir( $path, $d );
+ if ( -d $check ) { $m51path = $check; last; }
+}
+barf "Unable to find directory ${m51path} within the perl libraries.\n"
+ unless defined $m51path;
+
+comment q|
+ This demo illustrates the PDL::Transform module.
+
+ It requires PGPLOT support in PDL and makes use of the image of
+ M51 kindly provided by the Hubble Heritage group at the
+ Space Telescope Science Institute.
+
+|;
+
+act q|
+ # PDL::Transform objects embody coordinate transformations.
+
+ use PDL::Transform;
+
+ # set up a simple linear scale-and-shift relation
+
+ $t = t_linear( Scale=>[2,-1], Post=>[100,0]);
+ print $t;
+|;
+
+act q|
+ # The simplest way to use PDL::Transform is to transform a set of
+ # vectors. To do this you use the "apply" method.
+
+ # Define a few 2-vectors:
+ $xy = pdl([[0,1],[1,2],[10,3]]);
+ print "xy: ", $xy;
+
+ # Transform the 2-vectors:
+ print "Transformed: ", $xy->apply( $t );
+|;
+
+act q|
+ # You can invert and compose transformations with 'x' and '!'.
+ $u = t_linear( Scale=>10 ); # A new transformation (simple x10 scale)
+ $xy = pdl([[0,1],[10,3]]); # Two 2-vectors
+ print "xy: ", $xy;
+ print "xy': ", $xy->apply( !$t ); # Invert $t from earlier.
+ print "xy'': ", $xy->apply( $u x !$t ); # Hit the result with $u.
+|;
+
+act q|
+ # PDL::Transform is useful for data resampling, and that's perhaps
+ # the best way to demonstrate it. First, we do a little bit of prep work:
+
+ # Read in an image ($m51path has been set up by this demo to
+ # contain the location of the file). Transform is designed to
+ # work well with FITS images that contain WCS scientific coordinate
+ # information, but works equally well in pixel space.
+
+ $m51 = rfits("$m51path/m51.fits",{hdrcpy=>1});
+
+ # we use a floating-point version of the image in some of the demos
+ # to highlight the interpolation schemes. (Note that the FITS
+ # header gets deep-copied automatically into the new variable).
+
+ $m51_fl = $m51->float;
+
+ # Define a nice, simple scale-by-3 transformation.
+
+ $ts = t_scale(3);
+
+|;
+
+act q|
+ #### Resampling with ->map and no FITS interpretation works in pixel space.
+
+ ### Create a PGPLOT window, and display the original image
+ $dev = $^O =~ /MSWin/i ? '/GW' : '/xw';
+ $win = pgwin( dev=> $dev, nx=>2, ny=>2, Charsize=>2, J=>1, Size=>[8,6] );
+
+ $win->imag( $m51 , { DrawWedge=>0, Title=>"M51" } );
+
+ ### Grow m51 by a factor of 3; origin is at lower left
+ # (the "pix" makes the resampling happen in pixel coordinate
+ # space, ignoring the FITS header)
+
+ $win->imag( $m51->map( $ts, {pix=>1} ) );
+ $win->label_axes("","","M51 grown by 3 (pixel coords)");
+
+ ### Shrink m51 by a factor of 3; origin still at lower left.
+ # (You can invert the transform with a leading '!'.)
+
+ $win->imag( $m51->map( !$ts, {pix=>1} ) );
+ $win->label_axes("","","M51 shrunk by 3 (pixel coords)");
+
+|;
+
+act q|
+ # You can work in scientific space (or any other space) by
+ # wrapping your main transformation with something that translates
+ # between the coordinates you want to act in, and the coordinates
+ # you have. Here, "t_fits" translates between pixels in the data
+ # and arcminutes in the image plane.
+
+ ### Clear the panel and start over
+
+ $win->panel(4); # (Clear whole window on next plot)
+ $win->imag( $m51, { Title=>"M51" } );
+
+ ### Scale in scientific coordinates.
+ # Here's a way to scale in scientific coordinates:
+ # wrap our transformation in FITS-header transforms to translate
+ # the transformation into scientific space.
+
+ $win->imag( $m51->map( !$ts->wrap(t_fits($m51)), {pix=>1} ) );
+ $win->label_axes("","","M51 shrunk 3x (sci. coords)");
+
+|;
+
+act q|
+ # If you don't specify "pix=>1" then the resampler works in scientific
+ # FITS coordinates (if the image has a FITS header):
+
+ ### Scale in scientific coordinates (origin at center of galaxy)
+ $win->fits_imag( $m51->map( $ts, $m51->hdr ), { Title=>"M51 3x" } );
+
+ ### Instead of setting up a coordinate transformation you can use the
+ # implicit FITS header matching. Just tweak the template header:
+ $tohdr = $m51->hdr_copy;
+ $tohdr->{CDELT1} /= 3; # Magnify 3x in horiz direction
+ $tohdr->{CDELT2} /= 3; # Magnify 3x in vert direction
+
+ ### Resample to match the new FITS header
+ # (Note that, although the image is scaled exactly the same as before,
+ # this time the scientific coordinates have scaled too.)
+ $win->fits_imag( $m51->map( t_identity(), $tohdr ), { Title=>"3x (FITS)" } );
+|;
+
+act q|
+ ### The three main resampling methods are "sample", "linear", and "jacobian".
+ # Sampling is fastest, linear interpolation is better. Jacobian resampling
+ # is slow but prevents aliasing under skew or reducing transformations.
+
+ $win->fits_imag( $m51_fl , {Title=>"M51"} );
+
+ $win->fits_imag( $m51_fl->map( $ts, $m51_fl, { method=>"sample" } ),
+ {Title=>"M51 x3 (sampled)"} );
+
+ $win->fits_imag( $m51_fl->map( $ts, $m51_fl, { method=>"linear" } ),
+ { Title=>"M51 x3 (interp.)"} );
+
+ $win->fits_imag( $m51_fl->map( $ts, $m51_fl, { method=>"jacobian" } ),
+ { Title=>"M51 x3 (jacob.)"} );
+
+|;
+
+act q|
+ ### Linear transformations are only the beginning. Here's an example
+ # using a simple nonlinear transformation: radial coordinate transformation.
+
+ ### Original image
+ $win->fits_imag( $m51 ,{Title=>"M51"});
+
+ ### Radial structure in M51 (linear radial scale; origin at (0,0) by default)
+ $tu = t_radial( u=>'degree' );
+ $win->fits_imag( $m51_fl->map($tu), { Title=>"M51 radial (linear)", J=>0});
+
+ ### Radial structure in M51 (conformal/logarithmic radial scale)
+ $tu_c = t_radial( r0=>0.1 ); # Y axis 0 is at 0.1 arcmin
+ $win->panel(3);
+ $win->fits_imag( $m51_fl->map($tu_c),
+ { Title=>"M51 radial (conformal)",
+ YRange=>[0,4] } );
+
+
+|;
+# NOTE:
+# need to 'double protect' the \ in the label_axes()
+# since it's being evaluated twice (I think)
+#
+
+
+act q|
+
+ #####################
+ # Wrapping transformations allows you to work in a convenient
+ # space for what you want to do. Here, we can use a simple
+ # skew matrix to find (and remove) logarithmic spiral structures in
+ # the galaxy. The "unspiraled" images shift the spiral arms into
+ # approximate straight lines.
+
+ $sp = 3.14159; # Skew by 3.14159
+
+ # Skew matrix
+ $t_skew = t_linear(pre => [$sp * 130, 0] , matrix => pdl([1,0],[-$sp,1]));
+
+ # When put into conformal radial space, the skew turns into 3.14159
+ # radians per scale height.
+ $t_untwist = t_wrap($t_skew, $tu_c);
+
+ # Press enter to see the result of these transforms...
+|;
+
+act q|
+ ##############################
+ # Note that you can use ->map and ->unmap as either PDL methods
+ # or transform methods; what to do is clear from context.
+
+ # Original image
+ $win->fits_imag($m51, {Title => "M51"} );
+
+ # Skewed
+ $win->fits_imag( $m51_fl->map( $t_skew ),
+ { Title => "M51 skewed by \\\\gp in spatial coords" } );
+
+ # Untwisted -- show that m51 has a half-twist per scale height
+ $win->fits_imag( $m51_fl->map( $t_untwist ),
+ { Title => "M51 unspiraled (\\\\gp / r\\\\ds\\\\u)"} );
+
+ # Untwisted -- the jacobean method uses variable spatial filtering
+ # to eliminate spatial artifacts, at significant computational cost
+ # (This may take some time to complete).
+ $win->fits_imag( $m51_fl->map( $t_untwist, {m=>jacobean}),
+ { Title => "M51 unspiraled (\\\\gp / r\\\\ds\\\\u; antialiased)" } );
+|;
+
+
+$win->close;
+
+act q|
+ ### Native FITS interpretation makes it easy to view your data in
+ ### your preferred coordinate system. Here we zoom in on a 0.2x0.2
+ ### arcmin region of M51, sampling it to 100x100 pixels resolution.
+
+ $m51 = float $m51;
+ $data = $m51->match([100,100],{or=>[[-0.05,0.15],[-0.05,0.15]]});
+ $s = "M51 closeup ("; $ss=" coords)";
+ $ps = " (pixels)";
+
+ $dev = $^O =~ /MSWin/i ? '/GW' : '/xw';
+ $w1 = pgwin( dev=> $dev, size=>[4,4], charsize=>1.5, justify=>1 );
+ $w1->imag( $data, 600, 750, { title=>"${s}pixel${ss}",
+ xtitle=>"X$ps", ytitle=>"Y$ps" } );
+ $w1->hold;
+
+ $w2 = pgwin( dev=> $dev, size=>[4,4], charsize=>1.5, justify=>1 );
+ $w2->fits_imag( $data, 600, 750, { title=>"${s}sci.${ss}", dr=>0 } );
+ $w2->hold;
+
+ # Now please separate the two X windows on your screen, and press ENTER.
+ ###############################
+|;
+
+act q|
+ ### Now rotate the image 360 degrees in 10 degree increments.
+ ### The 'match' method resamples $data to the rotated scientific
+ ### coordinate system in $hdr. The "pixel coordinates" window shows
+ ### the resampled data in their new pixel coordinate system.
+ ### The "sci. coordinates" window shows the data remaining fixed in
+ ### scientific space, even though the pixels that represent them are
+ ### moving and rotating.
+
+ $hdr = $data->hdr_copy;
+
+ for( $rot=0; $rot<=360; $rot += 10 ) {
+ $hdr->{CROTA2} = $rot;
+
+ $d = $data->match($hdr);
+
+ $w1->imag( $d, 600, 750 );
+ $w2->fits_imag($d, 600, 750, {dr=>0});
+ }
+|;
+
+act q|
+ ### You can do the same thing even with nonsquare coordinates.
+ ### Here, we resample the same region in scientific space into a
+ ### 150x50 pixel array.
+
+ $data = $m51->match([150,50],{or=>[[-0.05,0.15],[-0.05,0.15]]});
+ $hdr = $data->hdr_copy;
+
+ $w1->release;
+ $w1->imag( $data, 600, 750, { title=>"${s}pixel${ss}",
+ xtitle=>"X$ps", ytitle=>"Y$ps", pix=>1 } );
+ $w1->hold;
+
+ for( $rot=0; $rot<=750; $rot += 5 ) {
+ $hdr->{CROTA2} = $rot;
+ $d = $data->match($hdr);
+ $w1->imag($d, 600, 750); $w2->fits_imag($d, 600, 750, {dr=>0});
+ }
+
+ |;
+
+
+comment q|
+
+ This concludes the PDL::Transform demo.
+
+ Be sure to check the documentation for PDL::Transform::Cartography,
+ which contains common perspective and mapping coordinate systems
+ that are useful for work on the terrestrial and celestial spheres,
+ as well as other planets &c.
+
+|;
+
+ $w1->release; $w1->close; undef $w1;
+ $w2->release; $w2->close; undef $w2;
+ undef $win;
+}
+
+1;
diff --git a/Demos/TriD/mandel.pl b/Demos/TriD/mandel.pl
new file mode 100644
index 0000000..951c00e
--- /dev/null
+++ b/Demos/TriD/mandel.pl
@@ -0,0 +1,52 @@
+$|=1;
+use PDL;
+use PDL::Graphics::TriD;
+use Time::HiRes qw(sleep);
+# use PDL::Dbg;
+
+# PDL::Core::set_debugging(1);
+
+$size = 100;
+
+$a = zeroes(float,$size,$size);
+$res = $a->copy;
+$resc0 = $res->clump(2);
+$resc = $resc0;
+$resi = xvals $resc;
+$inds0 = $resi;
+
+$re00 = 2*(xvals $a)->clump(2)/$size-1.5;
+$im00 = 2*(yvals $a)->clump(2)/$size-0.5;
+
+$re0 = $re00;
+$im0 = $im00;
+
+$im = $im0; $re = $re0;
+$im2 = $im; $re2 = $re;
+
+for(1..60) {
+ $rp = ($resc == 0) * ($im2 ** 2 + $re2 ** 2 > 2) * $_;
+ $resc += $rp;
+ if(1) {
+ $inds = ($resc == 0)->which->long->sever;
+ $inds1 = $inds0->index($inds)->sever;
+ $inds0 = $inds1;
+ $re0 = $re00->index($inds1)->sever;
+ $im0 = $im00->index($inds1)->sever;
+ $re = $re->index($inds)->sever;
+ $im = $im->index($inds)->sever;
+ $resi = $resi->index($inds)->sever;
+ # Use inds1 here so that resc propagates back only one step.
+ $resc = $resc0->index($inds1);
+ }
+ $re2 = $re ** 2 - $im ** 2;
+ $im2 = 2 * $re * $im;
+ $re2 += $re0;
+ $im2 += $im0;
+ $re = $re2; $im = $im2;
+ nokeeptwiddling3d();
+ my $r = $res/max($res);
+ imagrgb [$r,1-$r,$r] if $_ % 2 == 0;
+ sleep 0.05;
+}
+
diff --git a/Demos/TriD/test3.p b/Demos/TriD/test3.p
new file mode 100644
index 0000000..6ddb613
--- /dev/null
+++ b/Demos/TriD/test3.p
@@ -0,0 +1,121 @@
+use blib;
+use Carp;
+
+$SIG{__DIE__} = sub {die Carp::longmess(@_);};
+
+use PDL;
+
+#$PDL::Graphics::TriD::verbose=1;
+
+use PDL::Graphics::TriD;
+
+use PDL::Graphics::TriD::Image;
+use PDL::IO::Pic;
+use PDL::Graphics::TriD::GoBoard;
+
+
+
+# Calculate some random function
+
+
+print "START\n";
+
+sub snap {
+ if(1) {return}
+ my $ppdl = grabpic3d();
+ print "GOT PICTURE!\n";
+ wpic $ppdl,"$_[0].jpg";
+ system("xv $_[0].jpg");
+}
+
+$gob = pdl [
+[
+ [1, 0, 0, 0],
+ [0, 1, 0, 0],
+ [0, 0, 1, 0],
+ [0, 0, 0, 1],
+],
+[
+ [0.5, 0.5, 0, 0],
+ [0.5, 0, 0.5, 0],
+ [0.5, 0, 0, 0.5],
+ [0, 0, 0.5, 0.5],
+],
+[
+ [0.33, 0.33, 0.33, 0],
+ [0.33, 0.33, 0, 0.33],
+ [0.33, 0, 0.33, 0.33],
+ [0, 0.33, 0.33, 0.33],
+],
+[
+ [0.25, 0.25, 0.25, 0.25],
+ [0.25, 0.25, 0.25, 0.25],
+ [0.25, 0.25, 0.25, 0.25],
+ [0.25, 0.25, 0.25, 0.25],
+]
+];
+
+$gob2 = $gob->slice(":,1:2,1:2");
+$gob3 = $gob->slice(":,2:3,2:3");
+
+$b = new PDL::Graphics::TriD::GoBoard({Data => $gob});
+$b->add_inlay($gob2,1,1,0.25);
+$b->add_inlay($gob3,2,2,0.5);
+
+if(1) {
+$win = PDL::Graphics::TriD::get_current_window();
+$win->clear_objects();
+$win->add_object($b);
+$win->twiddle();
+}
+
+snap "pic0";
+
+# $f = zeroes(10,10);
+
+# $foo = cos(xvals($f)/1.5) * cos(yvals($f)/1.5)/2;
+$t = xvals zeroes 30,30;
+$u = yvals zeroes 30,30;
+
+$x = sin($u*0.5 + $t * 0.1)/2+0.5;
+$y = cos($u*0.3 + $t * 0.27)/2+0.5;
+$z = cos($u*0.1 + $t * 0.56)/2+0.5;
+
+PDL::Graphics::TriD::imagrgb([$x,$y,$z]);
+snap "pic1.1";
+
+$x .= $t / 30;
+$y .= $u / 30;
+$z .= 0.5*($t + $u)/30;
+
+$r = zeroes(4,4,4,4)+0.1;
+$g = zeroes(4,4,4,4);
+$b = zeroes(4,4,4,4);
+
+($tmp = $r->slice(":,:,2,2")) .= 1;
+($tmp = $r->slice(":,:,:,1")) .= 0.5;
+($tmp = $g->slice("2,:,1,2")) .= 1;
+($tmp = $b->slice("2,3,1,:")) .= 1;
+
+$t = 0.1 * xvals zeroes 300;
+
+$x = sin($t * 0.1)/2+0.5;
+$y = cos($t * 0.27)/2+0.5;
+$z = cos($t * 0.56)/2+0.5;
+
+line3d([$x,$y,$z],[$x,1-$x,0]);
+snap "pic4";
+
+ $f = zeroes(3,3);
+$foo = ((xvals $f) - 2) ** 2 + ((yvals $f) -2) ** 2;
+
+print $foo;
+
+print "TOIMAG\n";
+
+PDL::Graphics::TriD::imag3d([$foo]); # Use default values to make a 3D plot.
+ # Stops here for rotating until user presses 'q'.
+snap "pic5";
+
+print "OUTOFIMAG\n";
+
diff --git a/Demos/TriD/test4.p b/Demos/TriD/test4.p
new file mode 100644
index 0000000..db39ef1
--- /dev/null
+++ b/Demos/TriD/test4.p
@@ -0,0 +1,75 @@
+
+use blib;
+use Carp;
+
+$SIG{__DIE__} = sub {die Carp::longmess(@_);};
+
+use PDL;
+use PDL::Graphics::TriD;
+use PDL::Graphics::TriD::Image;
+use PDL::IO::Pic;
+
+$s = 10;
+$k = zeroes($s,$s);
+
+$x = $k->xvals();
+random($k->inplace); $x += $k;
+
+$y = $k->yvals();
+random($k->inplace); $y += $k;
+
+random($k->inplace);
+$z = $k;
+
+$x /= $s; $y /= $s; $z /= $s;
+
+
+$a = new PDL::Graphics::TriD::Lattice([$x,$y,$z]);
+$b = new PDL::Graphics::TriD::Points([$x,$y,$z+1]);
+
+$win = PDL::Graphics::TriD::get_current_window();
+$win->clear_objects();
+$win->add_object($a);
+$win->add_object($b);
+
+#$PDL::Graphics::TriD::verbose=1;
+#$win->twiddle();
+#exit;
+
+$nx = zeroes(3,20);
+$nc = zeroes(3,20);
+random($nx->inplace);
+random($nc->inplace);
+print "NX: $nx, NC: $nc\n";
+
+use PDL::Graphics::OpenGL;
+# glShadeModel (&GL_FLAT);
+glShadeModel (&GL_SMOOTH);
+
+$lb = $win->glpRasterFont("5x8",0,255);
+print "LIST: $lb\n";
+
+$win->add_object(new TOBJ());
+$win->twiddle();
+
+package TOBJ;
+BEGIN{@TOBJ::ISA = qw/PDL::Graphics::TriD::Object/;}
+use PDL::Graphics::OpenGLQ;
+use PDL::Graphics::OpenGL;
+
+sub new {
+ bless {},$_[0];
+}
+
+sub togl {
+ glDisable(&GL_LIGHTING);
+ line_3x_3c(
+# $::x->slice("0:2"),$::y->slice("0:2")
+ $::nx,$::nc
+ );
+ glColor3f(1,0,1);
+ glRasterPos3f(0,0,0.5);
+ PDL::Graphics::OpenGL::glpPrintString($::lb,"HELLO HELLO HELLO GLWORLD!!!");
+ glEnable(&GL_LIGHTING);
+}
+
diff --git a/Demos/TriD/test5.p b/Demos/TriD/test5.p
new file mode 100644
index 0000000..c567def
--- /dev/null
+++ b/Demos/TriD/test5.p
@@ -0,0 +1,56 @@
+
+use blib;
+use Carp;
+
+$SIG{__DIE__} = sub {die Carp::longmess(@_);};
+
+use PDL;
+use PDL::Graphics::TriD;
+use PDL::Graphics::TriD::Image;
+use PDL::IO::Pic;
+
+use PDL::Graphics::TriD::Graph;
+use PDL::Graphics::OpenGL;
+
+$g = new PDL::Graphics::TriD::Graph();
+$g->default_axes();
+
+$a = PDL->zeroes(3,1000);
+random($a->inplace);
+
+$g->add_dataseries(new PDL::Graphics::TriD::Points($a,$a),"pts");
+$g->bind_default("pts");
+
+$b = PDL->zeroes(3,30,30);
+axisvalues($b->slice("(0)"));
+axisvalues($b->slice("(1)")->xchg(0,1));
+
+$b /= 30;
+
+random($b->slice("(2)")->inplace);
+
+($tmp = $b->slice("(2)")) /= 5; $tmp += 2;
+
+$c = PDL->zeroes(3,30,30);
+random($c->inplace);
+
+$g->add_dataseries(new PDL::Graphics::TriD::SLattice($b,$c),"slat");
+$g->bind_default("slat");
+
+# $g->add_dataseries(new PDL::Graphics::TriD::Lattice($b,(PDL->pdl(0,0,0)->dummy(1)->dummy(1))),
+# "blat");
+# $g->bind_default("blat");
+
+$g->add_dataseries(new PDL::Graphics::TriD::SCLattice($b+1,$c->slice(":,0:-2,0:-2")),
+ "slat2");
+$g->bind_default("slat2");
+
+$g->scalethings();
+
+$win = PDL::Graphics::TriD::get_current_window();
+$win->clear_objects();
+$win->add_object($g);
+
+$win->twiddle();
+
+
diff --git a/Demos/TriD/test7.p b/Demos/TriD/test7.p
new file mode 100644
index 0000000..939ddc8
--- /dev/null
+++ b/Demos/TriD/test7.p
@@ -0,0 +1,29 @@
+use blib;
+use Carp;
+
+$SIG{__DIE__} = sub {die Carp::longmess(@_);};
+
+use PDL;
+use PDL::Graphics::TriD;
+
+$nx = 20;
+
+$t = (xvals zeroes $nx+1,$nx+1)/$nx;
+$u = (yvals zeroes $nx+1,$nx+1)/$nx;
+
+$x = sin($u*15 + $t * 3)/2+0.5 + 5*($t-0.5)**2;
+
+# Need to specify type first because points doesn't default to anything
+points3d([SURF2D,$x]);
+line3d([SURF2D,$x]);
+mesh3d([$x]);
+imag3d([$x],{Lines => 0});
+imag3d([$x],{Lines => 0, Smooth => 1});
+imag3d([$x]);
+
+# Then, see the same image twice...
+
+my $ox = $x->dummy(2,2)->zvals; # 0 for first, 1 for second surface.
+
+imag3d([$x * ($ox-0.5) + $ox ],{Smooth => 1});
+imag3d([$x * ($ox-0.5) + $ox ],{Lines => 0,Smooth => 1});
diff --git a/Demos/TriD/test8.p b/Demos/TriD/test8.p
new file mode 100644
index 0000000..245a089
--- /dev/null
+++ b/Demos/TriD/test8.p
@@ -0,0 +1,114 @@
+use blib;
+use Carp;
+
+ $SIG{__DIE__} = sub {die Carp::longmess(@_);};
+
+use PDL;
+use PDL::Graphics::TriD;
+use PDL::Opt::Simplex;
+use PDL::Dbg;
+
+my $asize = 5000;
+my $follow = zeroes(3,4,$asize);
+my $followc = zeroes(4,$asize);
+my $follows = $follow->oneslice(2,0,1,0);
+my $followcs = $followc->oneslice(1,0,1,0);
+my $folt = $follows->get_trans();
+my $folct = $followcs->get_trans();
+
+sub d2c {
+ my($mf) = @_;
+ $mf = $mf-min($mf); $mf += (100-$mf)*($mf > 100); $mf /= 100;
+ return (1-$mf)**6;
+}
+
+
+sub func {
+ my($x) = $_[0]->slice("(0)");
+ my($y) = $_[0]->slice("(1)");
+ my($z) = $_[0]->slice("(2)");
+ return $x**2 + ($y-$x**2)**2 + $z**2;
+}
+
+die << "EOD";
+
+This example is disabled since the required
+'foomethod' has been disabled in recent versions of PDL.
+
+Contact pdl-porters if you feel you need this functionality.
+
+EOD
+
+my $a = zeroes(3,10000);
+random $a->inplace;
+$a -= 0.5; $a *= 30;
+$mf = d2c(func($a));
+points3d($a,[$mf]);
+
+PDL::Graphics::OpenGL::glShadeModel (&PDL::Graphics::OpenGL::GL_SMOOTH);
+
+$PDL::debug = 1;
+my $win = PDL::Graphics::TriD::get_current_window();
+my $g = PDL::Graphics::TriD::get_current_graph();
+$fcc = [$followcs,pdl(0.2),$followcs];
+PDL::Graphics::TriD::Rout::combcoords(@$fcc,(my $fccs = PDL->null));
+my $line = new PDL::Graphics::TriD::LineStrip($follows->px,$fccs->px);
+
+# $win->add_object($line);
+
+$g->add_dataseries($line,"line");
+$g->bind_default("line");
+
+my $ndone = 0;
+
+my $nrounds = 0;
+my $perround = 1;
+
+($optimum,$simplex) = simplex(
+ pdl(10.0,10.0,10.0),
+ 0.9,
+ 0.00000001,
+ $asize*$perround+100,
+ \&func,
+ sub {
+ $win->twiddle(1,1);
+# print $_[0],$_[1];
+# print "NDONE: $ndone\n";
+ if($ndone == $asize) {
+ return;
+ }
+ $nrounds++;
+# $follow->dump();
+# $followc->dump();
+# $followcs->dump();
+ ($tmp = $follow->slice(":,:,($ndone)")) .= $_[0];
+ ($tmp = $followc->slice(":,($ndone)")) .= d2c($_[1]);
+ $ndone++;
+ if($nrounds % $perround != 0) {return}
+# print "FOLLOW1:\n";
+# $follow->dump();
+ $folt->call_trans_foomethod(0,1,$ndone);
+ $folct->call_trans_foomethod(0,1,$ndone);
+# $fccs->dump;
+# $followc->dump;
+# $followcs->dump();
+# print $fccs;
+# print "FOLLOW2:\n";
+# $follow->dump();
+ $line->data_changed();
+ $win->twiddle(1);
+# print "FOLLOWS: \n";
+# $follows->dump();
+# print "NDONE: $ndone\n";
+# print "FOLLOW:\n";
+# $follow->dump();
+# print "FOLSL: ",$follow->slice(":,:,0:6");
+# print "FOLS: ",$follows;
+ }
+ ,0
+);
+
+
+$win->twiddle();
+
+
diff --git a/Demos/TriD/test9.p b/Demos/TriD/test9.p
new file mode 100644
index 0000000..3154a57
--- /dev/null
+++ b/Demos/TriD/test9.p
@@ -0,0 +1,26 @@
+use blib;
+use Carp;
+
+# $SIG{__DIE__} = sub {die Carp::longmess(@_);};
+
+use PDL;
+use PDL::Graphics::TriD;
+use PDL::IO::Pic;
+use PDL::Graphics::TriD::Polygonize;
+
+
+$orig = PDL->pdl(0,0,0)->float;
+
+sub func1 {
+ my($x,$y,$z) = map {$_[0]->slice("($_)")} 0..2;
+ $r = $x**2 + 1.5*$y**2 + 0.3 * $z**2 + 5*($x**2-$y)**2;
+ $res = ($r - 1) * -1;
+# print $res;
+ return $res;
+}
+
+$a = PDL::Graphics::TriD::StupidPolygonize::stupidpolygonize($orig,
+ 5, 50, 10,\&func1) ;
+
+# print $a;
+imag3d $a,{Lines => 0, Smooth => 1};
diff --git a/Demos/TriD/testimg.p b/Demos/TriD/testimg.p
new file mode 100644
index 0000000..65c4484
--- /dev/null
+++ b/Demos/TriD/testimg.p
@@ -0,0 +1,30 @@
+use blib;
+use Carp;
+
+$SIG{__DIE__} = sub {die Carp::longmess(@_);};
+
+use PDL;
+use PDL::Graphics::TriD;
+use PDL::Graphics::TriD::Image;
+use PDL::IO::Pic;
+
+$PDL::Graphics::TriD::verbose=0;
+
+$win = PDL::Graphics::TriD::get_current_window();
+$vp = $win->new_viewport(0,0,1,1);
+
+# Here we show an 8-dimensional (!!!!!) RGB image to test Image.pm
+
+$r = zeroes(4,5,6,7,2,2,2,2)+0.1;
+$g = zeroes(4,5,6,7,2,2,2,2);
+$b = zeroes(4,5,6,7,2,2,2,2);
+
+($tmp = $r->slice(":,:,2,2")) .= 1;
+($tmp = $r->slice(":,:,:,1")) .= 0.5;
+($tmp = $g->slice("2,:,1,2")) .= 1;
+($tmp = $b->slice("2,3,1,:")) .= 1;
+
+$vp->clear_objects();
+$vp->add_object(new PDL::Graphics::TriD::Image([$r,$g,$b]));
+$win->twiddle();
+
diff --git a/Demos/TriD/testvib.p b/Demos/TriD/testvib.p
new file mode 100644
index 0000000..c0b5354
--- /dev/null
+++ b/Demos/TriD/testvib.p
@@ -0,0 +1,111 @@
+use blib ;
+
+use PDL;
+
+use PDL::Graphics::TriD;
+
+# $PDL::Graphics::TriD::verbose=1;
+
+$offs = 0.0;
+
+$tc = 0.2;
+$fc = $tc * 0.4;
+$sc = $tc * 3.2;;
+$fric = 0.02;
+$bc = 1-$fric*$tc;
+
+$size = 80 ;
+
+$a = zeroes(float(),$size,$size);
+
+$b = ((rvals $a) < $size/2)->float;
+
+$c = (rvals ($size,$size,{Centre=>[$size/3,$size/3]}))->float ;
+$c2 = (rvals ($size,$size,{Centre=>[$size/3,$size/2]}))->float ;
+
+# $sdiv = 12/$size;
+$sdiv = 20/$size;
+
+$a .= exp(-($sdiv*$c) ** 2)->float;
+$a -= exp(-($sdiv*$c2) ** 2)->float;
+$a *= $b;
+
+if(0) {
+ $a->set(8,8,0.3);
+ $a->set(8,9,0.5);
+ $a->set(9,8,0.5);
+ $a->set(9,9,1);
+ $a->set(10,8,0.3);
+ $a->set(10,9,0.5);
+ $a->set(8,10,0.3);
+ $a->set(9,10,0.5);
+ $a->set(10,10,0.3);
+}
+
+
+$asl1 = $a->slice("0:-3,1:-2");
+$asl2 = $a->slice("1:-2,0:-3");
+$asl3 = $a->slice("2:-1,1:-2");
+$asl4 = $a->slice("1:-2,2:-1");
+
+$ach = $a->slice("1:-2,1:-2");
+$bch = $b->slice("1:-2,1:-2");
+
+$s = $ach * 0;
+
+$round = 0;
+
+$win = PDL::Graphics::TriD::get_current_window();
+# points3d([SURF2D,$a]);
+$g = PDL::Graphics::TriD::get_current_graph();
+
+keeptwiddling3d(1);
+
+$surf = new PDL::Graphics::TriD::SLattice_S([$a]);
+
+if(0) {
+ $g->add_dataseries($surf,"surf");
+ $g->bind_default("surf");
+ $g->scalethings();
+ $g->PDL::Graphics::TriD::Object::changed();
+ $win->add_object($g);
+ $win->twiddle();
+} else {
+ $win->add_object($surf);
+}
+
+$a->set(0,0,$offs);
+$a->set(1,0,-$offs);
+# $as = $a->slice("");
+# $as->doflow(1);
+while(1) {
+
+ $aav = ($asl1 + $asl2 + $asl3 + $asl4)/4;
+
+ $da = ($aav - $ach) * $fc;
+ $da *= $bch;
+
+ $s += $da;
+ $s *= $bc;
+
+ $ach += $s * $sc;
+
+ print $round,"\n";
+
+ if($round % 5 == 0) {
+ if(0) {
+ $surf->data_changed();
+ # $g->data_changed();
+ $g->PDL::Graphics::TriD::Object::changed();
+ $win->changed();
+ $win->twiddle(1);
+ } else {
+ imag3d([$a],{KeepTwiddling => 0});
+ }
+ }
+ $round++;
+}
+
+
+
+
diff --git a/Demos/TriD/tmathgraph.p b/Demos/TriD/tmathgraph.p
new file mode 100644
index 0000000..d578451
--- /dev/null
+++ b/Demos/TriD/tmathgraph.p
@@ -0,0 +1,54 @@
+use blib;
+use PDL;
+use PDL::Graphics::TriD;
+use PDL::Graphics::TriD::Graph;
+use PDL::Graphics::TriD::MathGraph;
+use PDL::Graphics::TriD::Labels;
+
+$g = PDL::Graphics::TriD::get_new_graph();
+$g->default_axes();
+
+$coords = [
+ [ 0,-1,0 ],
+ [ -1,-1,-2],
+ [3,5,2],
+ [2,1,-3],
+ [1,3,1],
+ [1,1,2],
+];
+
+
+$from = PDL->pdl([0,1,2,3,4,4,4,5,5,5]);
+$to = PDL->pdl([1,2,3,1,0,2,3,0,1,2]);
+
+for(@$coords) {
+ push @$names,join ",",@$_;
+}
+
+$e = new PDL::GraphEvolver(scalar @$coords);
+$e->set_links($from,$to,PDL->ones(1));
+$c = $e->getcoords;
+
+$g->add_dataseries($lab = new PDL::Graphics::TriD::Labels($c,{Strings => $names}),
+ "foo1");
+$g->bind_default("foo1");
+
+$g->add_dataseries($lin = new PDL::Graphics::TriD::MathGraph(
+ $c, {From => $from, To => $to}),"foo2");
+$g->bind_default("foo2");
+
+$g->scalethings();
+
+nokeeptwiddling3d();
+twiddle3d();
+while(1) {
+ $e->step();
+ if(++$ind%2 == 0) {
+ $lab->data_changed();
+ $lin->data_changed();
+ $g->scalethings() if (($ind % 200) == 0 or 1);
+ print "C: $c\n" if $verbose;
+ twiddle3d();
+ }
+
+}
diff --git a/Demos/TriD/tvrml.p b/Demos/TriD/tvrml.p
new file mode 100644
index 0000000..3041ff3
--- /dev/null
+++ b/Demos/TriD/tvrml.p
@@ -0,0 +1,56 @@
+BEGIN {
+ $PDL::Graphics::TriD::device = "VRML";
+ print "====================================\n";
+ print " VRML not available...stopping demo \n";
+ print "====================================\n";
+ exit;
+}
+use PDL::Graphics::TriD;
+use PDL::LiteF;
+use Carp;
+# $PDL::Graphics::TriD::verbose=1;
+$SIG{__DIE__} = sub {print Carp::longmess(@_); die;};
+
+$set = tridsettings();
+$set->browser_com('netscape/unix');
+
+$nx = 5;
+
+$t = (xvals zeroes $nx+1,$nx+1)/$nx;
+$u = (yvals zeroes $nx+1,$nx+1)/$nx;
+
+$x = sin($u*15 + $t * 3)/2+0.5 + 5*($t-0.5)**2;
+$cx = PDL->zeroes(3,$nx+1,$nx+1);
+random($cx->inplace);
+$pdl = PDL->zeroes(3,20);
+$pdl->inplace->random;
+$cols = PDL->zeroes(3,20);
+$cols->inplace->random;
+
+$g = PDL::Graphics::TriD::get_new_graph;
+$name = $g->add_dataseries(new PDL::Graphics::TriD::Points($pdl,$cols));
+$g->bind_default($name);
+$name = $g->add_dataseries(new PDL::Graphics::TriD::Lattice([SURF2D,$x]));
+$g->bind_default($name);
+$name = $g->add_dataseries(new PDL::Graphics::TriD::SLattice_S([SURF2D,$x+1],$cx,
+ {Smooth=>1,Lines=>0}));
+$g->bind_default($name);
+$g->scalethings();
+describe3d('A simple test of
+the current PDL 3D
+VRML module');
+
+$win = PDL::Graphics::TriD::get_current_window();
+
+use PDL::Graphics::TriD::Logo;
+
+$win->add_object(new PDL::Graphics::TriD::Logo);
+
+#use Data::Dumper;
+#my $out = Dumper($win);
+#print $out;
+
+
+$win->display('netscape');
+
+
diff --git a/Demos/TriD/tvrml2.p b/Demos/TriD/tvrml2.p
new file mode 100644
index 0000000..01bcba7
--- /dev/null
+++ b/Demos/TriD/tvrml2.p
@@ -0,0 +1,72 @@
+BEGIN {
+ $PDL::Graphics::TriD::device = "VRML";
+ print "====================================\n";
+ print " VRML not available...stopping demo \n";
+ print "====================================\n";
+ exit;
+}
+
+
+BEGIN{
+ PDL::Graphics::VRMLNode->import();
+ PDL::Graphics::VRMLProto->import();
+}
+use PDL::Graphics::TriD;
+use PDL::LiteF;
+use Carp;
+
+$SIG{__DIE__} = sub {print Carp::longmess(@_); die;};
+$set = tridsettings();
+$set->browser_com('netscape/unix');
+#$set->set(Compress => 1);
+
+$nx = 20;
+
+$t = (xvals zeroes $nx+1,$nx+1)/$nx;
+$u = (yvals zeroes $nx+1,$nx+1)/$nx;
+
+$x = sin($u*15 + $t * 3)/2+0.5 + 5*($t-0.5)**2;
+$cx = PDL->zeroes(3,$nx+1,$nx+1);
+random($cx->inplace);
+$pdl = PDL->zeroes(3,20);
+$pdl->inplace->random;
+$cols = PDL->zeroes(3,20);
+$cols->inplace->random;
+
+$g = PDL::Graphics::TriD::get_new_graph;
+$name = $g->add_dataseries(new PDL::Graphics::TriD::Points($pdl,$cols));
+$g->bind_default($name);
+$name = $g->add_dataseries(new PDL::Graphics::TriD::Lattice([SURF2D,$x]));
+$g->bind_default($name);
+$name = $g->add_dataseries(new PDL::Graphics::TriD::SLattice_S([SURF2D,$x+1],$cx,
+ {Smooth=>1,Lines=>0}));
+$g->bind_default($name);
+$g->scalethings();
+$win = PDL::Graphics::TriD::get_current_window();
+
+
+require PDL::Graphics::VRML::Protos;
+PDL::Graphics::VRML::Protos->import();
+
+
+#$win->{VRMLTop}->register_proto(PDL::Graphics::VRML::Protos::PDLBlockText10());
+
+
+#$win->{VRMLTop}->uses('PDLBlockText10');
+
+
+
+#$win->current_viewport()->add_object(new PDL::Graphics::TriD::VRMLObject(
+# vrn(Transform,
+# translation => '0 0 -1',
+# children =>
+# [new PDL::Graphics::VRMLNode('PDLBlockText10')
+# ]
+# )
+# ));
+
+
+
+
+$win->display('netscape');
+exit;
diff --git a/Demos/TriD1.pm b/Demos/TriD1.pm
new file mode 100644
index 0000000..3382de5
--- /dev/null
+++ b/Demos/TriD1.pm
@@ -0,0 +1,155 @@
+# Copyright (C) 1998 Tuomas J. Lukka.
+# All rights reserved, except redistribution
+# with PDL under the PDL License permitted.
+
+package PDL::Demos::TriD1;
+
+use PDL;
+use PDL::Graphics::TriD;
+use PDL::Graphics::TriD::Image;
+
+PDL::Demos::Routines->import();
+sub comment($);
+sub act($);
+sub actnw($);
+sub output;
+
+sub run {
+
+
+comment q|
+ Welcome to a short tour of the capabilities of
+ PDL::Graphics::TriD.
+
+ Press 'q' in the graphics window for the next screen.
+ Rotate the image by pressing mouse button one and
+ dragging in the graphics window.
+ Zoom in/out by pressing MB3 and drag up/down.
+ Note that a standalone TriD script must start with
+
+ use PDL;
+ use PDL::Graphics::TriD;
+ use PDL::Graphics::TriD::Image;
+
+ to work properly.
+|;
+
+actnw q|
+ # Number of subdivisions for lines / surfaces.
+ $size = 25;
+
+ $cz = (xvals zeroes $size+1) / $size; # interval 0..1
+ $cx = sin($cz*12.6); # Corkscrew
+ $cy = cos($cz*12.6);
+ line3d [$cx,$cy,$cz]; # Draw a line
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ $r = sin($cz*6.3)/2 + 0.5;
+ $g = cos($cz*6.3)/2 + 0.5;
+ $b = $cz;
+ line3d [$cx,$cy,$cz], [$r,$g,$b]; # Draw a colored line
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ $x = (xvals zeroes $size+1,$size+1) / $size;
+ $y = (yvals zeroes $size+1,$size+1) / $size;
+ $z = 0.5 + 0.5 * (sin($x*6.3) * sin($y*6.3)) ** 3; # Bumps
+ line3d [$x,$y,$z]; # Draw several lines
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ $r = $x;
+ $g = $y;
+ $b = $z;
+ line3d [$x,$y,$z], [$r,$g,$b]; # Draw several colored lines
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ lattice3d [$x,$y,$z], [$r,$g,$b]; # Draw a colored lattice
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ points3d [$x,$y,$z], [$r,$g,$b], {PointSize=>4}; # Draw colored points
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ imag3d_ns [$x,$y,$z], [$r,$g,$b]; # Draw a colored surface
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ imag3d [$x,$y,$z]; # Draw a shaded surface
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ hold3d(); # Leave the previous object in..
+ imag3d_ns [$x,$y,$z+1], [$r,$g,$b];
+ # ...and draw a colored surface on top of it...
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ lattice3d [$x,$y,$z-1], [$r,$g,$b];
+ # ...and draw a colored lattice under it...
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ nokeeptwiddling3d(); # Don't wait for user while drawing
+ for(-2,-1,0,1,2) {
+ line3d [$cx,$cy,$cz+$_]; # ... and corkscrews...
+ }
+ keeptwiddling3d(); # Do wait for user while drawing...
+ twiddle3d(); # and actually, wait right now.
+ release3d();
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ # The reason for the [] around $x,$y,$z:
+ # 1. You can give all the coordinates and colors in one piddle.
+ $c = (zeroes 3,$size+1) / $size;
+ $coords =
+ sin((3+3*xvals $c)*yvals $c);
+ $colors = $coords;
+ line3d $coords, $colors; # Draw a curved line, colored
+ # (this works also for lattices, etc.)
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ # 2. You can use defaults inside the brackets:
+ lattice3d [$z], [$r]; # Note: no $x, $y, and $r is greyscale
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ # 3. You can plot in certain other systems as defaults
+ imag3d_ns [POLAR2D, $z], [$r, $g, $b]; # Draw the familiar
+ # bumpy surface in polar
+ # coordinates
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ # One last thing: you can plot a color image like this
+ imagrgb([$r,$g,$b]);
+ # [press 'q' in the graphics window when done]
+|;
+
+comment q|
+ '3d2' contains some of the more special constructions available
+ in the PDL::Graphics::TriD modules.
+|;
+
+}
+
+1;
diff --git a/Demos/TriD2.pm b/Demos/TriD2.pm
new file mode 100644
index 0000000..31fe106
--- /dev/null
+++ b/Demos/TriD2.pm
@@ -0,0 +1,121 @@
+# Copyright (C) 1998 Tuomas J. Lukka.
+# All rights reserved, except redistribution
+# with PDL under the PDL License permitted.
+
+package PDL::Demos::TriD2;
+
+use PDL;
+use PDL::Graphics::TriD;
+use PDL::Graphics::TriD::Image;
+
+PDL::Demos::Routines->import();
+sub comment($);
+sub act($);
+sub actnw($);
+sub output;
+
+sub run {
+
+comment q|
+ Welcome to a short tour of the more esoteric capabilities of
+ PDL::Graphics::TriD.
+
+ As in '3d', press 'q' in the graphics window for the next
+ screen. Rotate the image by pressing mouse button one and
+ dragging in the graphics window.
+
+ Note that the script must start with
+
+ use PDL;
+ use PDL::Graphics::TriD;
+ use PDL::Graphics::TriD::Image;
+
+ to work.
+|;
+
+actnw q|
+ # Number of subdivisions for lines / surfaces.
+ $size = 25;
+
+ # You remember this from the first 3d demo, right?
+ $r = (xvals zeroes $size+1,$size+1) / $size;
+ $g = (yvals zeroes $size+1,$size+1) / $size;
+ $b = ((sin($r*6.3) * sin($g*6.3)) ** 3)/2 + 0.5; # Bumps
+ imagrgb [$r,$g,$b]; # Draw an image
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ # How about this?
+ imagrgb3d([$r,$g,$b]); # Draw an image on the lower plane
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ # Let's add the real image on top of this...
+ hold3d();
+ imag3d([$r,$g,$b+0.1], [$r,$g,$b]);
+ # For the next demo, please rotate this so that much
+ # of the image is visible.
+ # Don't make your window too big or you might run out of memory
+ # at the next step.
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ # Warning: your mileage will vary based on which
+ # OpenGL implementation you are using :(
+ # Let's grab this picture...
+ $pic = grabpic3d();
+
+ # Lighten it up a bit so you see the background,
+ # black on black is confusing
+ $l = 0.3;
+ $pic = ($pic + $l) / (1 + $l);
+
+ # And plot it in the picture ;) ;)
+ hold3d(); # You remember, we leave the previous one in...
+ $o0 = imagrgb3d($pic, {Points => [[0,0,0],[0,1,0],[0,1,1],[0,0,1]]});
+
+ # Because we have the data in $pic, we could just as easily
+ # save it in a jpeg using the PDL::Io::Pic module - or read
+ # it from one.
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ # That was fun - let's do that again!
+ $pic1 = grabpic3d();
+
+ # Lighten it up
+ $pic1 = ($pic1 + $l) / (1 + $l);
+
+ # And plot it in the picture ;) ;)
+ hold3d(); # You remember, we leave the previous one in...
+ $o1 = imagrgb3d($pic1, {Points => [[0,0,0],[1,0,0],[1,0,1],[0,0,1]]});
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ # Now, let's update them in real time!
+ nokeeptwiddling3d(); # Don't wait for user while drawing
+ while(1) {
+ $p = grabpic3d();
+ $p = ($p + $l) / (1 + $l);
+ $pic .= $p; $pic1 .= $p;
+ $o0->data_changed(); $o1->data_changed();
+ last if twiddle3d(); # exit from loop when 'q' pressed
+ }
+ # [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+ # Finally, leave 3d in a sane state
+ keeptwiddling3d(); # Don't wait for user while drawing
+ release3d();
+ # [press 'q' in the graphics window when done]
+|;
+
+}
+
+1;
diff --git a/Demos/TriDGallery.pm b/Demos/TriDGallery.pm
new file mode 100644
index 0000000..8f5ac1f
--- /dev/null
+++ b/Demos/TriDGallery.pm
@@ -0,0 +1,207 @@
+# Copyright (C) 1998 Tuomas J. Lukka.
+# All rights reserved, except redistribution
+# with PDL under the PDL License permitted.
+
+package PDL::Demos::TriDGallery;
+
+use PDL;
+use PDL::Graphics::TriD;
+use PDL::Graphics::TriD::Image;
+
+PDL::Demos::Routines->import();
+sub comment($);
+sub act($);
+sub actnw($);
+sub output;
+
+sub run {
+
+
+comment q|
+ Welcome to the TriD Gallery
+
+ The following selection of scripts demonstrates that you
+ can generate interesting images with PDL (and the TriD
+ modules) with just a few lines of code.
+
+ These are the rules for scripts to be accepted for this
+ category:
+
+
+ 1) Must be legal Perl with a recent PDL version - may come with
+ a patch to PDL if the patch is general enough to be included
+ in the next release and usable outside the demo (e.g.
+ $x=mandelbrot($c) is NOT), i.e. you can introduce new
+ commands
+
+ 2) The code must fit in 4 lines, 72 columns.
+
+ 3) It must create an interesting image when fed to perl.
+
+ If you have an interesting new TriD M4LS (Maximal-4-lines-script)
+ submit it to the PDL mailing list (perldl at jach.hawaii.edu)
+ and there is a good chance it will soon be included in the gallery
+
+ Press 'q' in the graphics window for the next screen.
+ Rotate the image by pressing mouse button one and
+ dragging in the graphics window.
+ Zoom in/out by pressing MB3 and drag up/down.
+|;
+
+actnw q|
+# B/W Mandelbrot... [Tjl]
+
+use PDL; use PDL::Graphics::TriD;
+$s=150;$a=zeroes $s,$s;$r=$a->xlinvals(-1.5,0.5);$i=$a->ylinvals(-1,1);
+$t=$r;$u=$i;
+for(0..12){$q=$r**2-$i**2+$t;$h=2*$r*$i+$u;($r,$i)=map{$_->clip(-5,5)}($q,$h);}
+imagrgb[($r**2+$i**2)>2.0];
+
+# [press 'q' in the graphics window when done]
+|;
+
+if(0) {
+actnw q|
+# Greyscale Mandelbrot [Tjl]
+
+use PDL; use PDL::Graphics::TriD;$a=zeroes 300,300;$r=$a->xlinvals(-1.5,
+0.5);$i=$a->ylinvals(-1,1);$t=$r;$u=$i;for(1..30){$q=$r**2-$i**2+$t;$h=2
+*$r*$i+$u;$d=$r**2+$i**2;$a=lclip($a,$_*($d>2.0)*($a==0));($r,$i)=map{$_
+->clip(-5,5)}($q,$h);}imagrgb[$a/30];
+
+# [press 'q' in the graphics window when done]
+|;
+
+actnw q|
+# Color Mandelbrot anim (nokeeptwiddling3d removed -> fits) [Tjl]
+
+use PDL; use PDL::Graphics::TriD;
+nokeeptwiddling3d();
+$a=zeroes 300,300;$r=$a->xlinvals(-1.5,
+0.5);$i=$a->ylinvals(-1,1);$t=$r;$u=$i;for(1..30){$q=$r**2-$i**2+$t;$h=2
+*$r*$i+$u;$d=$r**2+$i**2;$a=lclip($a,$_*($d>2.0)*($a==0));($r,$i)=map{$_
+->clip(-5,5)}$q,$h;imagrgb[($a==0)*($r/2+0.75),($a==0)*($i+1)/2,$a/30]}
+
+# [press 'q' in the graphics window when done]
+|;
+}
+
+if(0){
+actnw q|
+# Torus... (barrel) [Tjl]
+
+use PDL; use PDL::Graphics::TriD;
+$s=40;$a=zeroes $s,$s;$t=$a->xlinvals(0,6.284);
+$u=$a->ylinvals(0,6.284);$o=5;$i=1;$v=$o+$i*sin$u;
+imag3d([$v*sin$t,$v*cos$t,$i*cos$u]);
+|;
+
+actnw q|
+# Ripply torus [Tjl]
+
+use PDL; use PDL::Graphics::TriD;
+$s=40;$a=zeroes 2*$s,$s/2;$t=$a->xlinvals(0,6.284);
+$u=$a->ylinvals(0,6.284); $o=5;$i=1;$v=$o+$i*sin$u;
+imag3d([$v*sin$t,$v*cos$t,$i*cos($u)+$o*sin(3*$t)]);
+|;
+
+actnw q|
+# Ripply torus distorted [Tjl]
+
+use PDL; use PDL::Graphics::TriD;
+$s=40;$a=zeroes 2*$s,$s/2;$t=$a->xlinvals(0,6.284);$u=$a->ylinvals(0,
+6.284); $o=5;$i=1;$v=$o-$o/2*sin(3*$t)+$i*sin$u;
+imag3d([$v*sin$t,$v*cos$t,$i*cos($u)+$o*sin(3*$t)]);
+|;
+
+actnw q~
+# Game of life [Robin Williams (edited by Tjl)]
+
+use PDL; use PDL::Image2D; use PDL::Graphics::TriD;nokeeptwiddling3d;
+$d=byte(random(zeroes(40,40))>0.85);$k=byte [[1,1,1],[1,0,1],[1,1,1]];
+do{ imagrgb [$d]; $s=conv2d($d,$k);
+$d&=($s<4);$d&=($s>1);$d|=($s==3);} while (!twiddle3d);
+
+~;
+
+actnw q~
+# Dewdney's voters (parallelized) [Tjl, inspired by the above 'life']
+
+use PDL; use PDL::Image2D; use PDL::Graphics::TriD;nokeeptwiddling3d;$d=
+byte(random(zeroes(100,100))>0.5);do{$k=float [[1,1,1],[1,0,1],[1,1,1]];
+imagrgb[$d]; $s=conv2d($d,$k)/8; $r = $s->float->random;
+$e = ($s>$r); $d .= $e; }while(!twiddle3d)
+
+~;
+}
+
+actnw q|
+# Volume rendering [Robin Williams]
+use PDL; use PDL::Graphics::TriD; keeptwiddling3d();
+$b=zeroes(50,50,50);$b=sin(0.3*$b->rvals)*cos(0.3*$b->xvals);$c=0;
+$a=byte($b>$c);foreach(1,2,4){$t=($a->slice("0:-2")<<$_);$t+=$a->slice("1:-1");
+$a = $t->mv(0,2);} points3d [whichND(($a != 0) & ($a != 255))];
+|;
+
+actnw q|
+# Lucy deconvolution (AJ 79, 745) [Robin Williams (=> TriD by Tjl)]
+use PDL; use PDL::Graphics::TriD; nokeeptwiddling3d();
+sub smth {use PDL::Image2D; conv2d($_[0],exp(-(rvals ones(3,3))**2));}
+$a=rfits("m51.fits")->float; $c=$d=avg($a)+0*$a;
+while(max $c>1.1) {$c=smth($a/smth($d));$d*=$c;imagrgb[$d/850];}
+|;
+
+
+# use PDL; use PDL::Image2D; use PDL::Graphics::TriD;nokeeptwiddling3d;
+# $d=byte(random(zeroes(90,90))>0.5);do{$k=byte [[1,1,1],[1,0,1],[1,1,1]];
+# imagrgb[$d]if($k++%2); $s=conv2d($d,$k)/8;$i=90*90*random(50);$t=$d->
+# clump(2)-> index($i);$t.=($s->clump(2)->index($i)>.5);}while(!twiddle3d)
+
+actnw q|
+# spherical dynamics [Mark R Baker]
+use PDL;use PDL::Graphics::TriD;for $c(1..99){$n=6.28*$c; $g=$c*rvals(
+sin(zeros(5000))*$c);$cz=-1**$g*$c;$cy=$g*cos$g*$c;$cx=$c*rvals($g)*$c;
+$g=cos($w=$cz+$cy+$cx);$r=sin$cy+$c+$cz;$b=sin$w;nokeeptwiddling3d();
+$i=$cz-$cx-$cy;$q=$i*$n;points3d[$b*sin$q,$r*cos$q,$g*sin$q],[$r,$g,$b]}
+|;
+
+actnw q~
+# Fractal mountain range [Tuomas Lukka]
+use PDL;use PDL::Image2D;use PDL::Graphics::TriD; keeptwiddling3d(); $k=ones(5,5) / 25;
+$a=5;$b=ones(1,1)/2;for(1..7){$c=$b->dummy(0,2)->clump(2)->xchg(0,1)->
+dummy(0,2)->clump(2)->xchg(0,1)->copy;$c+=$a*$c->random;$a/=3;
+$b=conv2d($c,$k); imag3d[$b],{Lines => 0}; }
+~;
+
+comment q|
+ We hope you did like that and got a feeling of
+ the power of PDL.
+
+ Now it's up to you to submit even better TriD M4LSs.
+
+|;
+
+}
+
+if(0) { # one possible addition to volume rendering...
+
+use PDL; use PDL::Graphics::TriD;
+$b=zeroes(50,50,50);$b=sin(0.3*$b->rvals)*cos(0.3*$b->xvals);$c=0;
+$a=byte($b>$c);foreach(1,2,4){$t=($a->slice("0:-2")<<$_);$t+=$a->slice("1:-1");
+$a = $t->mv(0,2);}points3d[map{$_+$_->float->random}whichND(($a!=0)&($a != 255))];
+
+}
+
+# Neat, but too big variation of color mandelbrot
+if(0) {
+
+use PDL; use PDL::Graphics::TriD;
+nokeeptwiddling3d();
+sub f {return abs(sin($_[0]*30))}
+$a=zeroes 300,300;$r=$a->xlinvals(-1.5,
+0.5);$i=$a->ylinvals(-1,1);$t=$r;$u=$i;for(1..30){$q=$r**2-$i**2+$t;$h=2
+*$r*$i+$u;$d=$r**2+$i**2;$a=lclip($a,$_*($d>2.0)*($a==0));($r,$i)=map{$_
+->clip(-5,5)}$q,$h;imagrgb[f(($a==0)*($r/2+0.75)),f(($a==0)*($i+1)/2),$a/30]}
+
+}
+1;
diff --git a/Demos/earth-interp.pl b/Demos/earth-interp.pl
new file mode 100644
index 0000000..29835ef
--- /dev/null
+++ b/Demos/earth-interp.pl
@@ -0,0 +1,63 @@
+##############################
+# Demo code to interpret the map data in earth.txt
+#
+# Craig DeForest, 17-Dec-2002
+#
+$| = 1;
+print "Initializing...\n";
+use PDL;
+use PDL::NiceSlice;
+
+# Snarf the file and build a separate piddle for each polyline
+print "Interpreting map file...\n";
+
+open(MAP,"<earth.txt");
+$nelem = 0;
+while(<MAP>) {
+ next if(m/^\#/ || m/^\s*$/);
+ s/^\s+//;
+ ($x,$y,$z,$color) = split /\s+/;
+ if($color==0 and $#a > 1) {
+ push(@a,$a[0]);
+ my $c = $a[1]->[3];
+ print $c;
+ ($a[-1])->[3] = $c;
+ $nelem++;
+ push(@mainlist,pdl(@a)); undef @a;
+ }
+ push(@a,[$x,$y,$z,$color ? $color-1:0]);
+ $nelem++;
+}
+
+print "Breaking up elements...\n";
+$elements = zeroes(4,$nelem);
+$pos = 0;
+foreach $z(@mainlist) {
+ $n = $z->dim(1);
+ $elements->(0:2,$pos:$pos+$n-1) .= $z->(0:2);
+ $elements->((3),$pos:$pos+$n-2) .= $z->((3),1:-1);
+ $elements->((3),$pos+n-1) .= 0;
+ $pos += $n;
+}
+
+print "... $nelem vectors\n";
+
+# Transform all the polylines into spherical coordinates.
+use PDL::Transform;
+$t = t_compose(t_scale(ones(3)*180/3.14159),t_spherical());
+
+$lonlat = $t->apply( $elements->(pdl(2,0,1)) ) ->(1:2); # discard radius
+
+# Clean up the pen values at the longitude singularity
+print "cleaning up singularities...\n";
+$p = $elements->((3));
+$idx = which((abs($lonlat->((0),0:-2) - $lonlat->((0),1:-1))) > 355);
+$p->($idx) .= 0 if($idx->nelem > 0);
+
+# Plot map
+use PDL::Graphics::PGPLOT::Window;
+$w = pgwin(dev=>'/xs',size=>[10,10]);
+$w->lines($lonlat,$p,{Title=>'Lat/Lon map of world coastlines',XTitle=>'East Longitude',YTitle=>'North Latitude',Axis=>2});
+
+wfits($lonlat->glue(0,$p->dummy(0,1)),'earth_coast.vec.fits');
+1;
diff --git a/Demos/earth.txt b/Demos/earth.txt
new file mode 100644
index 0000000..924abfe
--- /dev/null
+++ b/Demos/earth.txt
@@ -0,0 +1,18826 @@
+# Map data demo file from XEarth by Kirk Johnson <tuna at indra.com>
+#
+# http://www.cs.colorado.edu/~tuna/xearth/
+#
+# This file is copyright (C) 1995 Kirk Lauritz Johnson. Permission to
+# use, copy, modify, and freely distribute this file for non-commercial
+# and not-for-profit purposes is hereby granted without fee, provided
+# this copyright notice appears in all copies and in supporting
+# documentation. You may distribute this file and charge a fee for the
+# act of doing so, though the file itself is free.
+#
+# Notes (CED 17-Dec-2002):
+# Format: <Y>,<Z>,<X>,<COLOR>
+# (<Z> = north, <X> = toward Greenwich, <Y> = east from Greenwich)
+# Color=0: new line
+#
+# Outlines are derived from the CIA World Map (interpreted and distributed
+# c. 1988 on USENET by Joe Dellinger, geojoe at freeusp.org).
+#
+ 13663 15523 21733 0
+ 13525 15597 21767 2
+ 13594 15626 21703 2
+ 13556 15645 21713 2
+ 13463 15669 21754 2
+ 13340 15671 21828 2
+ 13201 15694 21896 2
+ 13108 15640 21990 2
+ 13062 15657 22006 2
+ 13095 15690 21962 2
+ 12950 15653 22075 2
+ 12891 15571 22167 2
+ 12774 15527 22266 2
+ 12691 15448 22367 2
+ 12593 15389 22464 2
+ 12464 15390 22534 2
+ 12332 15452 22564 2
+ 12196 15482 22618 2
+ 12050 15504 22681 2
+ 11930 15541 22719 2
+ 11793 15581 22763 2
+ 11661 15631 22797 2
+ 11524 15658 22848 2
+ 11384 15681 22902 2
+ 11243 15713 22950 2
+ 11110 15717 23012 2
+ 10987 15683 23094 2
+ 10863 15727 23122 2
+ 10768 15851 23082 2
+ 10634 15901 23110 2
+ 10498 15896 23175 2
+ 10355 15920 23223 2
+ 10220 15971 23248 2
+ 10069 15984 23305 2
+ 9953 16064 23300 2
+ 9883 16178 23251 2
+ 9732 16230 23279 2
+ 9591 16274 23306 2
+ 9454 16302 23342 2
+ 9303 16302 23403 2
+ 9188 16247 23487 2
+ 9051 16228 23553 2
+ 8938 16169 23636 2
+ 8832 16102 23721 2
+ 8749 16014 23812 2
+ 8693 15908 23904 2
+ 8697 15781 23986 2
+ 8754 15654 24048 2
+ 8835 15537 24095 2
+ 8839 15411 24174 2
+ 8783 15302 24263 2
+ 8702 15208 24351 2
+ 8591 15143 24431 2
+ 8454 15124 24491 2
+ 8314 15174 24507 2
+ 8185 15251 24503 2
+ 8060 15335 24492 2
+ 7920 15394 24501 2
+ 7779 15445 24514 2
+ 7638 15491 24530 2
+ 7492 15527 24552 2
+ 7347 15551 24580 2
+ 7200 15555 24621 2
+ 7054 15585 24644 2
+ 6918 15651 24641 2
+ 6817 15756 24602 2
+ 6748 15876 24544 2
+ 6702 16001 24475 2
+ 6583 16080 24456 2
+ 6433 16103 24481 2
+ 6290 16148 24488 2
+ 6155 16213 24479 2
+ 6008 16245 24495 2
+ 5863 16274 24511 2
+ 5721 16289 24535 2
+ 5583 16253 24590 2
+ 5434 16259 24619 2
+ 5292 16305 24620 2
+ 5138 16376 24606 2
+ 5013 16414 24606 2
+ 4891 16457 24602 2
+ 4760 16583 24543 2
+ 4622 16608 24552 2
+ 4474 16652 24550 2
+ 4363 16745 24507 2
+ 4331 16867 24428 2
+ 4428 16953 24351 2
+ 4539 17027 24279 2
+ 4626 17118 24199 2
+ 4681 17228 24110 2
+ 4701 17337 24027 2
+ 4649 17465 23945 2
+ 4527 17546 23909 2
+ 4422 17646 23855 2
+ 4412 17768 23766 2
+ 4515 17847 23688 2
+ 4581 17951 23596 2
+ 4563 18052 23522 2
+ 4418 17989 23598 2
+ 4293 17978 23630 2
+ 4234 18108 23541 2
+ 4102 18152 23530 2
+ 3980 18183 23528 2
+ 3840 18146 23579 2
+ 3724 18083 23646 2
+ 3601 18031 23705 2
+ 3453 18022 23733 2
+ 3288 18010 23766 2
+ 3158 18057 23748 2
+ 3021 18063 23761 2
+ 2880 18020 23811 2
+ 2739 18063 23796 2
+ 2619 18050 23819 2
+ 2499 17988 23879 2
+ 2358 17958 23915 2
+ 2224 17910 23964 2
+ 2098 17968 23932 2
+ 1951 18007 23915 2
+ 1799 18012 23923 2
+ 1647 18011 23935 2
+ 1509 17977 23970 2
+ 1357 17959 23993 2
+ 1216 17953 24004 2
+ 1076 17890 24058 2
+ 930 17888 24065 2
+ 782 17870 24084 2
+ 630 17860 24096 2
+ 484 17843 24112 2
+ 350 17792 24152 2
+ 213 17741 24191 2
+ 91 17674 24241 2
+ -3 17573 24315 2
+ -156 17570 24316 2
+ -298 17525 24347 2
+ -439 17489 24371 2
+ -535 17398 24434 2
+ -648 17322 24485 2
+ -779 17258 24527 2
+ -927 17246 24530 2
+ -1075 17257 24516 2
+ -1215 17285 24490 2
+ -1306 17348 24441 2
+ -1473 17297 24467 2
+ -1622 17311 24448 2
+ -1770 17296 24448 2
+ -1917 17281 24448 2
+ -2058 17324 24406 2
+ -2170 17403 24340 2
+ -2249 17500 24263 2
+ -2310 17580 24199 2
+ -2487 17535 24215 2
+ -2562 17427 24284 2
+ -2622 17311 24361 2
+ -2680 17194 24437 2
+ -2747 17079 24510 2
+ -2821 16968 24579 2
+ -2903 16859 24644 2
+ -2997 16759 24702 2
+ -3127 16688 24733 2
+ -3263 16627 24757 2
+ -3403 16573 24774 2
+ -3545 16524 24787 2
+ -3681 16463 24808 2
+ -3789 16377 24848 2
+ -3898 16281 24895 2
+ -4012 16192 24935 2
+ -4079 16084 24993 2
+ -4111 15958 25069 2
+ -4203 15852 25121 2
+ -4298 15746 25171 2
+ -4363 15626 25235 2
+ -4385 15496 25311 2
+ -4401 15365 25388 2
+ -4383 15259 25455 2
+ -4331 15144 25533 2
+ -4378 15014 25601 2
+ -4465 14903 25651 2
+ -4562 14796 25696 2
+ -4654 14688 25741 2
+ -4761 14586 25780 2
+ -4885 14505 25802 2
+ -5022 14438 25813 2
+ -5139 14348 25840 2
+ -5249 14247 25874 2
+ -5386 14184 25880 2
+ -5528 14131 25879 2
+ -5676 14098 25866 2
+ -5825 14076 25844 2
+ -5956 14021 25845 2
+ -6058 13913 25879 2
+ -6128 13785 25931 2
+ -6201 13663 25978 2
+ -6263 13534 26031 2
+ -6373 13437 26054 2
+ -6509 13368 26056 2
+ -6639 13300 26058 2
+ -6736 13200 26085 2
+ -6799 13072 26132 2
+ -6871 12945 26177 2
+ -6939 12819 26220 2
+ -6963 12682 26281 2
+ -7011 12548 26332 2
+ -7116 12447 26352 2
+ -7231 12350 26366 2
+ -7344 12248 26383 2
+ -7468 12163 26387 2
+ -7513 12078 26414 2
+ -7599 11912 26464 2
+ -7680 11780 26500 2
+ -7743 11660 26534 2
+ -7807 11529 26573 2
+ -7898 11403 26601 2
+ -8018 11322 26599 2
+ -8100 11197 26627 2
+ -8139 11062 26672 2
+ -8180 10920 26718 2
+ -8216 10781 26763 2
+ -8205 10718 26792 2
+ -8117 10767 26799 2
+ -8062 10639 26867 2
+ -7968 10573 26921 2
+ -7896 10444 26992 2
+ -7871 10315 27049 2
+ -7906 10184 27089 2
+ -7978 10044 27119 2
+ -7990 9969 27144 2
+ -7933 9794 27224 2
+ -7904 9657 27281 2
+ -7881 9518 27337 2
+ -7876 9375 27388 2
+ -7885 9231 27434 2
+ -7910 9087 27474 2
+ -7961 8947 27506 2
+ -8028 8813 27530 2
+ -8099 8683 27550 2
+ -8153 8545 27577 2
+ -8192 8403 27609 2
+ -8207 8257 27649 2
+ -8246 8117 27679 2
+ -8332 7990 27690 2
+ -8419 7867 27699 2
+ -8520 7754 27700 2
+ -8645 7674 27684 2
+ -8680 7619 27688 2
+ -8549 7540 27750 2
+ -8470 7425 27805 2
+ -8415 7293 27857 2
+ -8367 7256 27881 2
+ -8287 7293 27895 2
+ -8311 7163 27922 2
+ -8306 7031 27957 2
+ -8220 6934 28006 2
+ -8077 6974 28038 2
+ -7926 6989 28077 2
+ -7787 7000 28114 2
+ -7764 6988 28123 2
+ -7929 6974 28080 2
+ -8079 6959 28041 2
+ -8203 6888 28023 2
+ -8340 6954 27966 2
+ -8435 6914 27947 2
+ -8431 6769 27984 2
+ -8441 6619 28017 2
+ -8373 6581 28046 2
+ -8264 6552 28085 2
+ -8095 6571 28130 2
+ -7955 6543 28176 2
+ -7847 6596 28194 2
+ -7815 6612 28199 2
+ -7946 6526 28183 2
+ -8090 6546 28137 2
+ -8235 6532 28098 2
+ -8374 6532 28057 2
+ -8437 6434 28061 2
+ -8305 6350 28120 2
+ -8200 6349 28150 2
+ -8170 6195 28193 2
+ -8029 6230 28226 2
+ -8006 6211 28237 2
+ -8010 6137 28252 2
+ -7865 6181 28283 2
+ -7727 6203 28316 2
+ -7642 6170 28347 2
+ -7840 6101 28307 2
+ -7772 6058 28335 2
+ -7698 6040 28359 2
+ -7809 5931 28352 2
+ -7752 5798 28395 2
+ -7685 5774 28418 2
+ -7648 5745 28434 2
+ -7597 5676 28462 2
+ -7504 5681 28485 2
+ -7462 5592 28514 2
+ -7412 5599 28526 2
+ -7432 5461 28547 2
+ -7345 5333 28594 2
+ -7199 5269 28643 2
+ -7099 5166 28686 2
+ -6985 5103 28726 2
+ -6945 4958 28761 2
+ -6840 4852 28804 2
+ -6785 4741 28836 2
+ -6734 4614 28868 2
+ -6731 4489 28888 2
+ -6682 4442 28907 2
+ -6794 4372 28892 2
+ -6695 4275 28929 2
+ -6629 4147 28963 2
+ -6560 4049 28993 2
+ -6430 4002 29028 2
+ -6366 3899 29056 2
+ -6242 3782 29099 2
+ -6105 3728 29135 2
+ -5982 3647 29170 2
+ -5879 3544 29204 2
+ -5769 3459 29236 2
+ -5637 3391 29270 2
+ -5557 3291 29297 2
+ -5393 3218 29335 2
+ -5278 3137 29365 2
+ -5173 3036 29394 2
+ -5064 2931 29424 2
+ -4955 2833 29452 2
+ -4848 2721 29480 2
+ -4730 2634 29507 2
+ -4600 2564 29534 2
+ -4469 2495 29560 2
+ -4337 2422 29586 2
+ -4197 2372 29610 2
+ -4061 2310 29634 2
+ -3917 2277 29656 2
+ -3780 2337 29669 2
+ -3642 2398 29681 2
+ -3507 2456 29693 2
+ -3366 2507 29705 2
+ -3223 2560 29716 2
+ -3083 2617 29726 2
+ -2929 2653 29739 2
+ -2785 2668 29751 2
+ -2705 2702 29755 2
+ -2484 2691 29776 2
+ -2334 2712 29786 2
+ -2181 2724 29796 2
+ -2150 2750 29796 2
+ -2336 2729 29784 2
+ -2406 2745 29777 2
+ -2190 2769 29792 2
+ -2045 2771 29802 2
+ -1975 2744 29809 2
+ -1734 2707 29827 2
+ -1646 2748 29828 2
+ -1572 2668 29840 2
+ -1357 2602 29856 2
+ -1209 2560 29866 2
+ -1070 2494 29877 2
+ -925 2555 29877 2
+ -798 2630 29874 2
+ -646 2672 29874 2
+ -504 2719 29872 2
+ -362 2765 29870 2
+ -231 2836 29865 2
+ -93 2898 29860 2
+ 42 2963 29853 2
+ 181 3014 29848 2
+ 308 3069 29841 2
+ 222 3153 29833 2
+ 401 3016 29845 2
+ 527 3083 29836 2
+ 628 3187 29824 2
+ 773 3232 29815 2
+ 920 3265 29808 2
+ 1070 3288 29800 2
+ 1221 3306 29792 2
+ 1372 3321 29784 2
+ 1524 3335 29775 2
+ 1676 3337 29767 2
+ 1794 3403 29752 2
+ 1890 3391 29748 2
+ 2084 3352 29739 2
+ 2234 3332 29731 2
+ 2372 3275 29726 2
+ 2491 3182 29727 2
+ 2607 3059 29730 2
+ 2711 2999 29726 2
+ 2804 2888 29729 2
+ 2876 2836 29727 2
+ 2816 2720 29743 2
+ 2838 2605 29752 2
+ 2904 2453 29758 2
+ 3015 2335 29757 2
+ 3142 2276 29748 2
+ 3265 2286 29734 2
+ 3437 2300 29714 2
+ 3518 2357 29700 2
+ 3534 2463 29689 2
+ 3631 2376 29685 2
+ 3714 2396 29673 2
+ 3727 2430 29668 2
+ 3841 2389 29657 2
+ 3948 2393 29643 2
+ 4092 2368 29625 2
+ 4264 2382 29600 2
+ 4321 2476 29584 2
+ 4331 2536 29577 2
+ 4448 2426 29569 2
+ 4573 2389 29553 2
+ 4666 2189 29554 2
+ 4794 2094 29540 2
+ 4922 2091 29520 2
+ 5025 2051 29505 2
+ 5043 1882 29513 2
+ 5120 1751 29508 2
+ 5170 1619 29507 2
+ 5139 1472 29520 2
+ 5115 1323 29531 2
+ 5095 1177 29541 2
+ 5095 1022 29546 2
+ 5037 858 29562 2
+ 4957 754 29578 2
+ 4919 610 29588 2
+ 5050 533 29567 2
+ 5016 327 29576 2
+ 4961 314 29585 2
+ 4883 267 29599 2
+ 4989 148 29582 2
+ 5134 101 29557 2
+ 5129 63 29558 2
+ 4981 74 29584 2
+ 4874 98 29601 2
+ 4857 -121 29604 2
+ 4799 -254 29613 2
+ 4727 -374 29623 2
+ 4641 -396 29636 2
+ 4573 -382 29647 2
+ 4654 -548 29632 2
+ 4732 -677 29617 2
+ 4863 -756 29594 2
+ 4888 -842 29587 2
+ 4745 -731 29613 2
+ 4721 -715 29618 2
+ 4810 -869 29599 2
+ 4886 -973 29583 2
+ 4916 -1040 29576 2
+ 5026 -1241 29550 2
+ 5148 -1296 29527 2
+ 5196 -1333 29517 2
+ 5101 -1335 29533 2
+ 5217 -1448 29507 2
+ 5333 -1541 29482 2
+ 5441 -1644 29457 2
+ 5532 -1764 29433 2
+ 5635 -1870 29407 2
+ 5724 -1988 29382 2
+ 5828 -2093 29354 2
+ 5923 -2203 29327 2
+ 6033 -2307 29297 2
+ 6111 -2438 29270 2
+ 6168 -2560 29247 2
+ 6250 -2656 29221 2
+ 6300 -2832 29194 2
+ 6287 -2974 29183 2
+ 6389 -3106 29147 2
+ 6493 -3134 29121 2
+ 6620 -3061 29100 2
+ 6713 -3087 29076 2
+ 6512 -3155 29114 2
+ 6367 -3210 29140 2
+ 6432 -3386 29106 2
+ 6509 -3511 29074 2
+ 6590 -3632 29041 2
+ 6618 -3781 29016 2
+ 6667 -3923 28985 2
+ 6721 -4062 28954 2
+ 6784 -4198 28920 2
+ 6850 -4329 28885 2
+ 6863 -4470 28860 2
+ 6797 -4586 28858 2
+ 6694 -4688 28865 2
+ 6712 -4839 28836 2
+ 6753 -4982 28802 2
+ 6789 -5117 28770 2
+ 6838 -5249 28735 2
+ 6901 -5389 28694 2
+ 6981 -5513 28651 2
+ 7020 -5643 28616 2
+ 7040 -5791 28582 2
+ 7011 -5936 28559 2
+ 7000 -6085 28530 2
+ 6968 -6232 28506 2
+ 6896 -6377 28492 2
+ 6811 -6489 28487 2
+ 6689 -6555 28501 2
+ 6567 -6659 28505 2
+ 6504 -6789 28489 2
+ 6399 -6894 28487 2
+ 6325 -7018 28474 2
+ 6291 -7175 28442 2
+ 6222 -7308 28423 2
+ 6206 -7451 28390 2
+ 6170 -7598 28358 2
+ 6115 -7732 28334 2
+ 6065 -7867 28308 2
+ 6021 -8019 28274 2
+ 5928 -8137 28260 2
+ 5887 -8251 28236 2
+ 5887 -8395 28193 2
+ 5889 -8539 28150 2
+ 5870 -8683 28109 2
+ 5843 -8831 28069 2
+ 5821 -8971 28029 2
+ 5809 -9115 27985 2
+ 5823 -9258 27936 2
+ 5884 -9384 27881 2
+ 5940 -9511 27825 2
+ 6038 -9615 27769 2
+ 6116 -9732 27711 2
+ 6180 -9854 27653 2
+ 6231 -9984 27595 2
+ 6289 -10109 27536 2
+ 6346 -10235 27477 2
+ 6413 -10354 27417 2
+ 6449 -10490 27356 2
+ 6488 -10624 27295 2
+ 6539 -10750 27234 2
+ 6606 -10870 27170 2
+ 6675 -10987 27106 2
+ 6725 -11115 27041 2
+ 6802 -11226 26976 2
+ 6876 -11339 26910 2
+ 6926 -11465 26844 2
+ 6942 -11600 26782 2
+ 6891 -11715 26744 2
+ 6884 -11881 26673 2
+ 6876 -12013 26616 2
+ 6861 -12153 26556 2
+ 6848 -12289 26497 2
+ 6881 -12422 26426 2
+ 6925 -12544 26357 2
+ 6956 -12673 26287 2
+ 6939 -12810 26225 2
+ 6939 -12945 26159 2
+ 6937 -13078 26093 2
+ 6955 -13210 26022 2
+ 6976 -13332 25954 2
+ 6997 -13457 25884 2
+ 7009 -13585 25813 2
+ 7028 -13715 25739 2
+ 7069 -13836 25663 2
+ 7121 -13955 25584 2
+ 7179 -14071 25504 2
+ 7263 -14171 25425 2
+ 7351 -14265 25347 2
+ 7449 -14358 25266 2
+ 7510 -14462 25188 2
+ 7569 -14574 25106 2
+ 7606 -14695 25024 2
+ 7636 -14820 24941 2
+ 7652 -14947 24860 2
+ 7676 -15072 24777 2
+ 7707 -15193 24694 2
+ 7752 -15309 24608 2
+ 7793 -15426 24522 2
+ 7844 -15539 24434 2
+ 7901 -15647 24347 2
+ 7962 -15754 24257 2
+ 7983 -15877 24170 2
+ 7979 -16006 24086 2
+ 7948 -16134 24011 2
+ 7835 -16224 23988 2
+ 7737 -16273 23986 2
+ 7772 -16368 23910 2
+ 7792 -16443 23852 2
+ 7870 -16595 23721 2
+ 7876 -16718 23632 2
+ 7816 -16831 23572 2
+ 7863 -16868 23530 2
+ 7997 -16845 23501 2
+ 8065 -16929 23417 2
+ 8173 -16996 23331 2
+ 8253 -17080 23241 2
+ 8378 -17113 23172 2
+ 8498 -17078 23154 2
+ 8632 -16999 23163 2
+ 8783 -16961 23134 2
+ 8912 -16942 23099 2
+ 9050 -16944 23043 2
+ 9200 -16929 22994 2
+ 9331 -16850 23000 2
+ 9465 -16800 22982 2
+ 9610 -16782 22935 2
+ 9727 -16808 22866 2
+ 9866 -16803 22811 2
+ 10008 -16777 22768 2
+ 10139 -16799 22694 2
+ 10261 -16832 22614 2
+ 10400 -16849 22538 2
+ 10522 -16772 22539 2
+ 10661 -16782 22465 2
+ 10771 -16753 22435 2
+ 10883 -16659 22451 2
+ 11018 -16664 22381 2
+ 11153 -16660 22317 2
+ 11291 -16607 22287 2
+ 11426 -16548 22263 2
+ 11557 -16473 22250 2
+ 11688 -16398 22238 2
+ 11817 -16321 22226 2
+ 11941 -16231 22225 2
+ 12069 -16152 22214 2
+ 12191 -16061 22213 2
+ 12309 -15968 22215 2
+ 12422 -15869 22223 2
+ 12535 -15770 22230 2
+ 12661 -15687 22217 2
+ 12787 -15607 22202 2
+ 12902 -15506 22206 2
+ 13010 -15401 22216 2
+ 13111 -15289 22234 2
+ 13209 -15176 22253 2
+ 13304 -15058 22277 2
+ 13407 -14948 22289 2
+ 13494 -14826 22318 2
+ 13600 -14715 22327 2
+ 13712 -14617 22323 2
+ 13831 -14525 22310 2
+ 13953 -14455 22279 2
+ 14080 -14362 22259 2
+ 14165 -14247 22279 2
+ 14248 -14120 22308 2
+ 14303 -13988 22355 2
+ 14368 -13858 22395 2
+ 14444 -13730 22424 2
+ 14514 -13599 22459 2
+ 14562 -13466 22508 2
+ 14607 -13331 22559 2
+ 14598 -13239 22619 2
+ 14524 -13137 22726 2
+ 14628 -13023 22725 2
+ 14745 -12903 22718 2
+ 14876 -12822 22678 2
+ 14998 -12769 22627 2
+ 15128 -12714 22572 2
+ 15258 -12668 22510 2
+ 15389 -12619 22449 2
+ 15519 -12570 22386 2
+ 15647 -12510 22331 2
+ 15757 -12415 22306 2
+ 15860 -12301 22297 2
+ 15930 -12163 22322 2
+ 15900 -12098 22379 2
+ 15976 -11899 22432 2
+ 16035 -11765 22460 2
+ 16067 -11656 22494 2
+ 16093 -11501 22555 2
+ 16135 -11359 22597 2
+ 16097 -11345 22631 2
+ 16053 -11404 22633 2
+ 16084 -11218 22704 2
+ 16094 -11078 22766 2
+ 16076 -10946 22842 2
+ 16079 -10831 22895 2
+ 16094 -10679 22955 2
+ 16040 -10574 23041 2
+ 16003 -10465 23117 2
+ 16052 -10318 23149 2
+ 16072 -10178 23197 2
+ 16075 -10119 23221 2
+ 16192 -10154 23124 2
+ 16306 -10067 23082 2
+ 16414 -9965 23050 2
+ 16510 -9857 23027 2
+ 16630 -9753 22986 2
+ 16753 -9695 22920 2
+ 16848 -9627 22880 2
+ 16956 -9510 22848 2
+ 17073 -9388 22812 2
+ 17145 -9256 22811 2
+ 17260 -9166 22761 2
+ 17369 -9088 22710 2
+ 17489 -9014 22647 2
+ 17608 -8949 22580 2
+ 17707 -8890 22526 2
+ 17854 -8835 22432 2
+ 17960 -8797 22362 2
+ 18095 -8740 22275 2
+ 18197 -8651 22227 2
+ 18312 -8578 22161 2
+ 18414 -8481 22113 2
+ 18500 -8377 22081 2
+ 18585 -8262 22053 2
+ 18683 -8145 22013 2
+ 18782 -8030 21972 2
+ 18842 -7886 21972 2
+ 18884 -7787 21972 2
+ 18926 -7691 21969 2
+ 18956 -7517 22004 2
+ 18946 -7434 22040 2
+ 18936 -7333 22083 2
+ 18954 -7151 22128 2
+ 18967 -7013 22160 2
+ 18989 -6878 22184 2
+ 18995 -6717 22228 2
+ 19042 -6578 22229 2
+ 19033 -6419 22283 2
+ 19058 -6278 22303 2
+ 19062 -6137 22338 2
+ 19072 -5984 22371 2
+ 19082 -5858 22396 2
+ 19145 -5709 22381 2
+ 19170 -5569 22394 2
+ 19141 -5418 22456 2
+ 19057 -5339 22546 2
+ 18972 -5275 22632 2
+ 18899 -5173 22717 2
+ 18897 -5017 22754 2
+ 18876 -4883 22801 2
+ 18857 -4734 22848 2
+ 18838 -4615 22887 2
+ 18803 -4451 22948 2
+ 18817 -4309 22964 2
+ 18871 -4163 22947 2
+ 18836 -4049 22996 2
+ 18847 -3888 23014 2
+ 18906 -3768 22986 2
+ 18950 -3649 22969 2
+ 18872 -3553 23049 2
+ 18811 -3435 23116 2
+ 18734 -3348 23191 2
+ 18698 -3187 23243 2
+ 18721 -3039 23244 2
+ 18773 -2896 23220 2
+ 18823 -2752 23197 2
+ 18864 -2601 23182 2
+ 18913 -2461 23157 2
+ 19005 -2369 23091 2
+ 19067 -2230 23054 2
+ 19104 -2092 23036 2
+ 19176 -1940 22989 2
+ 19202 -1843 22976 2
+ 19273 -1721 22926 2
+ 19325 -1569 22893 2
+ 19343 -1424 22887 2
+ 19444 -1338 22806 2
+ 19551 -1297 22717 2
+ 19622 -1184 22662 2
+ 19656 -1050 22639 2
+ 19783 -1012 22530 2
+ 19872 -905 22456 2
+ 19944 -786 22397 2
+ 20009 -646 22344 2
+ 20061 -515 22300 2
+ 20132 -416 22238 2
+ 20212 -295 22167 2
+ 20282 -189 22104 2
+ 20364 -75 22029 2
+ 20440 34 21959 2
+ 20515 145 21889 2
+ 20590 255 21818 2
+ 20665 364 21744 2
+ 20746 465 21665 2
+ 20831 556 21581 2
+ 20909 658 21503 2
+ 20989 757 21421 2
+ 21074 848 21334 2
+ 21161 933 21245 2
+ 21252 1007 21151 2
+ 21344 1076 21054 2
+ 21434 1153 20959 2
+ 21523 1229 20863 2
+ 21601 1325 20776 2
+ 21670 1433 20696 2
+ 21743 1536 20612 2
+ 21814 1641 20530 2
+ 21880 1753 20450 2
+ 21944 1865 20371 2
+ 22010 1974 20290 2
+ 22074 2084 20208 2
+ 22135 2199 20130 2
+ 22197 2311 20049 2
+ 22246 2436 19980 2
+ 22286 2568 19918 2
+ 22337 2691 19845 2
+ 22390 2810 19768 2
+ 22437 2936 19697 2
+ 22480 3064 19628 2
+ 22518 3196 19564 2
+ 22530 3340 19525 2
+ 22550 3482 19477 2
+ 22582 3616 19416 2
+ 22624 3740 19343 2
+ 22668 3863 19268 2
+ 22699 4000 19203 2
+ 22710 4140 19160 2
+ 22768 4253 19066 2
+ 22806 4380 18992 2
+ 22836 4509 18926 2
+ 22860 4647 18863 2
+ 22902 4766 18783 2
+ 22935 4897 18709 2
+ 22925 5049 18680 2
+ 22923 5196 18642 2
+ 22913 5348 18611 2
+ 22982 5421 18505 2
+ 23006 5447 18467 2
+ 22953 5487 18521 2
+ 22940 5632 18494 2
+ 22916 5785 18476 2
+ 22888 5927 18466 2
+ 22903 6065 18404 2
+ 22868 6165 18414 2
+ 22763 6214 18527 2
+ 22680 6180 18639 2
+ 22634 6067 18732 2
+ 22559 6001 18843 2
+ 22470 5969 18959 2
+ 22379 5941 19076 2
+ 22297 5888 19188 2
+ 22204 5856 19305 2
+ 22103 5881 19413 2
+ 22005 5868 19529 2
+ 21922 5807 19639 2
+ 21824 5788 19754 2
+ 21723 5803 19860 2
+ 21627 5789 19968 2
+ 21553 5709 20072 2
+ 21474 5635 20177 2
+ 21387 5578 20285 2
+ 21286 5600 20386 2
+ 21173 5629 20494 2
+ 21082 5628 20588 2
+ 20998 5556 20693 2
+ 20913 5491 20796 2
+ 20827 5436 20897 2
+ 20715 5431 21009 2
+ 20606 5443 21113 2
+ 20504 5529 21190 2
+ 20408 5625 21257 2
+ 20322 5738 21309 2
+ 20248 5874 21343 2
+ 20159 5969 21400 2
+ 20060 6032 21475 2
+ 19943 6008 21591 2
+ 19900 6027 21625 2
+ 19987 6125 21518 2
+ 20075 6191 21416 2
+ 20152 6273 21320 2
+ 20117 6428 21307 2
+ 20042 6545 21342 2
+ 19950 6657 21394 2
+ 19850 6719 21467 2
+ 19753 6836 21520 2
+ 19667 6919 21572 2
+ 19588 7057 21598 2
+ 19491 7154 21655 2
+ 19382 7227 21728 2
+ 19288 7338 21774 2
+ 19202 7455 21811 2
+ 19108 7565 21855 2
+ 18987 7611 21944 2
+ 18895 7700 21993 2
+ 18793 7750 22063 2
+ 18681 7783 22146 2
+ 18615 7917 22154 2
+ 18529 7946 22216 2
+ 18508 7853 22266 2
+ 18412 8014 22289 2
+ 18348 8117 22304 2
+ 18263 8255 22323 2
+ 18207 8398 22316 2
+ 18163 8542 22297 2
+ 18117 8678 22281 2
+ 18055 8821 22276 2
+ 17991 8956 22274 2
+ 17915 9089 22281 2
+ 17832 9218 22295 2
+ 17753 9327 22312 2
+ 17643 9391 22372 2
+ 17543 9482 22413 2
+ 17421 9589 22462 2
+ 17311 9646 22523 2
+ 17233 9775 22527 2
+ 17174 9915 22511 2
+ 17111 10061 22494 2
+ 17079 10193 22459 2
+ 17027 10330 22436 2
+ 16994 10479 22392 2
+ 16947 10615 22364 2
+ 16891 10758 22337 2
+ 16901 10834 22293 2
+ 16773 11029 22294 2
+ 16710 11163 22275 2
+ 16653 11294 22251 2
+ 16533 11377 22298 2
+ 16425 11473 22329 2
+ 16314 11560 22366 2
+ 16180 11633 22425 2
+ 16107 11735 22425 2
+ 16014 11860 22425 2
+ 15966 11994 22388 2
+ 15946 12147 22320 2
+ 15989 12204 22258 2
+ 15861 12307 22293 2
+ 15738 12430 22312 2
+ 15654 12551 22303 2
+ 15572 12675 22290 2
+ 15481 12798 22283 2
+ 15395 12920 22273 2
+ 15304 13042 22264 2
+ 15208 13159 22261 2
+ 15117 13281 22251 2
+ 15025 13405 22238 2
+ 14958 13531 22208 2
+ 14890 13655 22177 2
+ 14802 13770 22165 2
+ 14697 13904 22152 2
+ 14655 14009 22113 2
+ 14542 14122 22115 2
+ 14432 14226 22121 2
+ 14326 14334 22120 2
+ 14231 14448 22108 2
+ 14146 14567 22084 2
+ 14085 14694 22039 2
+ 13976 14807 22032 2
+ 13971 14942 21944 2
+ 14020 14943 21912 2
+ 14106 14792 21959 2
+ 14194 14685 21975 2
+ 14308 14581 21970 2
+ 14388 14464 21995 2
+ 14453 14339 22034 2
+ 14569 14239 22022 2
+ 14679 14138 22015 2
+ 14794 14045 21997 2
+ 14928 13994 21939 2
+ 14970 14102 21841 2
+ 14932 14237 21780 2
+ 14940 14359 21694 2
+ 14933 14489 21612 2
+ 14916 14615 21538 2
+ 14926 14734 21451 2
+ 14976 14732 21418 2
+ 14990 14594 21502 2
+ 15010 14464 21576 2
+ 15035 14332 21646 2
+ 15034 14195 21736 2
+ 15077 14126 21752 2
+ 15218 14116 21660 2
+ 15333 14021 21640 2
+ 15431 13905 21646 2
+ 15528 13789 21650 2
+ 15622 13674 21656 2
+ 15726 13566 21649 2
+ 15826 13452 21647 2
+ 15920 13337 21649 2
+ 16019 13218 21650 2
+ 16104 13115 21649 2
+ 16190 13019 21642 2
+ 16294 12899 21636 2
+ 16391 12782 21633 2
+ 16449 12640 21672 2
+ 16500 12532 21695 2
+ 16604 12411 21686 2
+ 16706 12330 21654 2
+ 16827 12277 21590 2
+ 16949 12194 21541 2
+ 17060 12098 21508 2
+ 17154 11977 21501 2
+ 17241 11848 21502 2
+ 17317 11726 21508 2
+ 17385 11627 21508 2
+ 17483 11458 21519 2
+ 17499 11328 21574 2
+ 17518 11186 21633 2
+ 17586 11063 21641 2
+ 17635 10924 21672 2
+ 17695 10790 21690 2
+ 17796 10671 21667 2
+ 17879 10563 21650 2
+ 17976 10450 21626 2
+ 18086 10394 21561 2
+ 18210 10323 21490 2
+ 18321 10232 21439 2
+ 18419 10135 21401 2
+ 18505 10020 21381 2
+ 18593 9884 21368 2
+ 18673 9754 21359 2
+ 18737 9611 21367 2
+ 18827 9494 21340 2
+ 18900 9366 21333 2
+ 18990 9240 21307 2
+ 19096 9146 21253 2
+ 19199 9053 21200 2
+ 19281 8935 21175 2
+ 19339 8814 21173 2
+ 19441 8686 21133 2
+ 19513 8562 21117 2
+ 19566 8421 21125 2
+ 19607 8273 21145 2
+ 19595 8135 21209 2
+ 19635 7995 21226 2
+ 19647 7878 21259 2
+ 19744 7702 21233 2
+ 19797 7568 21232 2
+ 19825 7458 21245 2
+ 19890 7275 21247 2
+ 19964 7148 21222 2
+ 19993 7004 21242 2
+ 20017 6859 21267 2
+ 20091 6723 21240 2
+ 20166 6609 21205 2
+ 20293 6567 21097 2
+ 20398 6560 20997 2
+ 20491 6602 20893 2
+ 20585 6636 20790 2
+ 20677 6645 20695 2
+ 20741 6746 20599 2
+ 20822 6817 20494 2
+ 20884 6915 20397 2
+ 20980 6950 20286 2
+ 21084 6960 20175 2
+ 21188 6964 20064 2
+ 21281 7000 19953 2
+ 21371 7045 19841 2
+ 21460 7091 19728 2
+ 21525 7184 19624 2
+ 21601 7255 19513 2
+ 21697 7260 19405 2
+ 21791 7266 19296 2
+ 21881 7311 19178 2
+ 21927 7421 19082 2
+ 21971 7529 18989 2
+ 22047 7595 18874 2
+ 22127 7647 18759 2
+ 22216 7679 18641 2
+ 22300 7715 18525 2
+ 22373 7782 18410 2
+ 22460 7814 18290 2
+ 22545 7848 18169 2
+ 22625 7895 18050 2
+ 22695 7956 17934 2
+ 22760 8024 17821 2
+ 22823 8107 17703 2
+ 22785 8258 17682 2
+ 22788 8396 17613 2
+ 22838 8489 17503 2
+ 22910 8542 17382 2
+ 22983 8594 17261 2
+ 23059 8637 17137 2
+ 23137 8671 17014 2
+ 23205 8734 16889 2
+ 23274 8781 16770 2
+ 23360 8787 16647 2
+ 23452 8759 16531 2
+ 23525 8802 16404 2
+ 23535 8935 16317 2
+ 23505 9073 16285 2
+ 23532 9185 16183 2
+ 23607 9220 16054 2
+ 23686 9238 15926 2
+ 23759 9268 15800 2
+ 23781 9378 15700 2
+ 23762 9522 15643 2
+ 23777 9637 15550 2
+ 23831 9701 15426 2
+ 23900 9734 15298 2
+ 23980 9744 15165 2
+ 23982 9836 15104 2
+ 23927 9976 15099 2
+ 23876 10117 15085 2
+ 23859 10254 15020 2
+ 23838 10393 14958 2
+ 23846 10509 14863 2
+ 23902 10487 14790 2
+ 23968 10478 14688 2
+ 23965 10624 14589 2
+ 23962 10734 14512 2
+ 23971 10848 14412 2
+ 24002 10938 14292 2
+ 24017 11040 14189 2
+ 24010 11164 14103 2
+ 24004 11285 14016 2
+ 23985 11416 13942 2
+ 23916 11501 13991 2
+ 23824 11573 14089 2
+ 23738 11686 14140 2
+ 23650 11794 14197 2
+ 23565 11910 14243 2
+ 23481 12002 14303 2
+ 23395 12028 14423 2
+ 23301 12066 14543 2
+ 23213 12093 14660 2
+ 23119 12135 14774 2
+ 23024 12188 14878 2
+ 22928 12282 14949 2
+ 22837 12392 14997 2
+ 22748 12504 15039 2
+ 22667 12631 15055 2
+ 22604 12765 15037 2
+ 22549 12900 15004 2
+ 22486 13029 14987 2
+ 22451 13169 14916 2
+ 22399 13262 14913 2
+ 22377 13084 15101 2
+ 22354 12995 15212 2
+ 22323 12914 15327 2
+ 22309 12803 15441 2
+ 22287 12703 15554 2
+ 22249 12612 15682 2
+ 22235 12519 15776 2
+ 22230 12427 15856 2
+ 22211 12313 15971 2
+ 22152 12252 16098 2
+ 22072 12230 16225 2
+ 21976 12251 16339 2
+ 21887 12269 16445 2
+ 21787 12275 16572 2
+ 21722 12251 16675 2
+ 21658 12191 16802 2
+ 21561 12206 16915 2
+ 21465 12321 16954 2
+ 21395 12347 17023 2
+ 21330 12404 17064 2
+ 21304 12499 17027 2
+ 21307 12660 16904 2
+ 21257 12796 16864 2
+ 21187 12933 16848 2
+ 21160 13044 16796 2
+ 21058 13166 16829 2
+ 20976 13189 16914 2
+ 20969 13074 17011 2
+ 20989 12948 17083 2
+ 21007 12819 17158 2
+ 21071 12684 17180 2
+ 21080 12607 17225 2
+ 20967 12753 17256 2
+ 20874 12893 17264 2
+ 20776 12998 17303 2
+ 20686 13130 17312 2
+ 20663 13214 17275 2
+ 20632 13336 17218 2
+ 20551 13465 17214 2
+ 20467 13555 17244 2
+ 20357 13641 17307 2
+ 20265 13708 17362 2
+ 20160 13828 17389 2
+ 20036 13907 17469 2
+ 19969 14001 17471 2
+ 19867 14130 17483 2
+ 19773 14260 17484 2
+ 19683 14382 17485 2
+ 19595 14495 17492 2
+ 19505 14614 17493 2
+ 19410 14708 17519 2
+ 19348 14762 17542 2
+ 19390 14852 17420 2
+ 19316 15010 17366 2
+ 19463 14975 17232 2
+ 19530 15012 17124 2
+ 19536 15102 17037 2
+ 19517 15209 16964 2
+ 19572 15164 16941 2
+ 19684 15071 16894 2
+ 19786 15028 16812 2
+ 19868 15078 16671 2
+ 19968 14970 16649 2
+ 20076 14859 16619 2
+ 20184 14760 16576 2
+ 20269 14630 16587 2
+ 20361 14527 16565 2
+ 20458 14416 16543 2
+ 20540 14285 16555 2
+ 20633 14164 16543 2
+ 20733 14061 16506 2
+ 20834 14010 16421 2
+ 20936 13985 16314 2
+ 21044 13922 16227 2
+ 21150 13828 16169 2
+ 21239 13740 16128 2
+ 21344 13668 16050 2
+ 21454 13614 15950 2
+ 21554 13520 15895 2
+ 21648 13487 15794 2
+ 21739 13482 15674 2
+ 21839 13425 15583 2
+ 21931 13393 15480 2
+ 21979 13461 15354 2
+ 22036 13511 15227 2
+ 22075 13580 15108 2
+ 22131 13636 14976 2
+ 22180 13697 14847 2
+ 22263 13697 14722 2
+ 22361 13653 14614 2
+ 22440 13564 14576 2
+ 22523 13423 14580 2
+ 22591 13291 14595 2
+ 22662 13164 14599 2
+ 22756 13048 14558 2
+ 22857 13011 14431 2
+ 22941 12975 14330 2
+ 23027 12952 14213 2
+ 23106 12950 14086 2
+ 23195 12908 13977 2
+ 23277 12878 13869 2
+ 23349 12886 13739 2
+ 23435 12862 13615 2
+ 23519 12848 13483 2
+ 23592 12846 13357 2
+ 23683 12794 13245 2
+ 23769 12764 13119 2
+ 23854 12739 12989 2
+ 23907 12752 12878 2
+ 23980 12729 12763 2
+ 24031 12758 12639 2
+ 24068 12776 12550 2
+ 24137 12795 12398 2
+ 24207 12791 12265 2
+ 24275 12796 12124 2
+ 24307 12855 11998 2
+ 24373 12861 11855 2
+ 24459 12808 11736 2
+ 24526 12793 11611 2
+ 24577 12827 11465 2
+ 24628 12849 11329 2
+ 24689 12850 11194 2
+ 24739 12875 11054 2
+ 24792 12895 10913 2
+ 24812 12912 10846 2
+ 24944 12747 10738 2
+ 25008 12615 10746 2
+ 25086 12579 10604 2
+ 25145 12492 10568 2
+ 25214 12366 10551 2
+ 25296 12230 10513 2
+ 25366 12138 10451 2
+ 25433 12131 10297 2
+ 25494 12071 10215 2
+ 25546 12039 10122 2
+ 25563 12114 9989 2
+ 25572 12107 9974 2
+ 25576 11995 10099 2
+ 25638 11883 10075 2
+ 25712 11776 10011 2
+ 25789 11703 9899 2
+ 25861 11642 9782 2
+ 25926 11609 9646 2
+ 25956 11651 9515 2
+ 25988 11698 9369 2
+ 26027 11694 9266 2
+ 26051 11514 9421 2
+ 26021 11460 9569 2
+ 25990 11423 9699 2
+ 25941 11405 9848 2
+ 25908 11399 9941 2
+ 25997 11241 9888 2
+ 26070 11149 9799 2
+ 26147 11047 9710 2
+ 26221 10945 9626 2
+ 26295 10835 9549 2
+ 26367 10739 9457 2
+ 26438 10662 9347 2
+ 26503 10611 9220 2
+ 26541 10634 9081 2
+ 26568 10690 8938 2
+ 26585 10750 8813 2
+ 26607 10814 8668 2
+ 26599 10908 8573 2
+ 26565 11048 8498 2
+ 26491 11185 8553 2
+ 26451 11346 8462 2
+ 26469 11375 8367 2
+ 26523 11337 8247 2
+ 26559 11198 8319 2
+ 26611 11083 8308 2
+ 26652 11073 8190 2
+ 26663 10938 8335 2
+ 26729 10798 8305 2
+ 26795 10673 8251 2
+ 26846 10531 8271 2
+ 26877 10398 8337 2
+ 26915 10259 8387 2
+ 26962 10126 8398 2
+ 27016 10003 8372 2
+ 27070 9884 8339 2
+ 27118 9759 8331 2
+ 27161 9625 8346 2
+ 27214 9476 8342 2
+ 27261 9347 8334 2
+ 27321 9189 8315 2
+ 27374 9051 8290 2
+ 27424 8914 8273 2
+ 27475 8769 8260 2
+ 27529 8610 8248 2
+ 27564 8502 8244 2
+ 27623 8342 8209 2
+ 27674 8219 8160 2
+ 27734 8088 8089 2
+ 27781 7975 8039 2
+ 27835 7818 8005 2
+ 27893 7689 7928 2
+ 27946 7567 7858 2
+ 27985 7467 7814 2
+ 28029 7330 7786 2
+ 28083 7176 7734 2
+ 28124 7052 7701 2
+ 28160 6913 7697 2
+ 28208 6744 7671 2
+ 28244 6635 7631 2
+ 28296 6468 7581 2
+ 28341 6338 7525 2
+ 28389 6219 7444 2
+ 28435 6102 7362 2
+ 28479 5974 7296 2
+ 28520 5851 7236 2
+ 28561 5704 7192 2
+ 28598 5567 7153 2
+ 28639 5427 7098 2
+ 28675 5301 7047 2
+ 28703 5202 7005 2
+ 28733 5067 6983 2
+ 28767 4872 6982 2
+ 28796 4763 6934 2
+ 28831 4652 6867 2
+ 28878 4491 6773 2
+ 28917 4375 6683 2
+ 28957 4277 6571 2
+ 28996 4227 6432 2
+ 29019 4278 6293 2
+ 29034 4360 6164 2
+ 29029 4491 6097 2
+ 29016 4618 6060 2
+ 29020 4738 5947 2
+ 29041 4785 5805 2
+ 29063 4826 5662 2
+ 29093 4817 5513 2
+ 29098 4822 5483 2
+ 29058 4875 5644 2
+ 29032 5003 5666 2
+ 29026 5128 5582 2
+ 29017 5257 5510 2
+ 29015 5365 5419 2
+ 29040 5362 5287 2
+ 29045 5424 5196 2
+ 29016 5574 5197 2
+ 28988 5722 5190 2
+ 28950 5886 5218 2
+ 28927 6001 5219 2
+ 28898 6161 5191 2
+ 28877 6316 5123 2
+ 28867 6423 5045 2
+ 28848 6556 4980 2
+ 28821 6701 4944 2
+ 28792 6847 4911 2
+ 28760 6969 4928 2
+ 28732 7058 4968 2
+ 28697 7207 4955 2
+ 28652 7358 4994 2
+ 28620 7505 4955 2
+ 28582 7633 4979 2
+ 28539 7779 5000 2
+ 28505 7924 4970 2
+ 28478 8058 4904 2
+ 28464 8168 4805 2
+ 28480 8198 4658 2
+ 28494 8192 4583 2
+ 28495 8226 4511 2
+ 28469 8380 4395 2
+ 28466 8450 4278 2
+ 28490 8438 4134 2
+ 28497 8487 3988 2
+ 28489 8570 3861 2
+ 28451 8710 3831 2
+ 28419 8830 3796 2
+ 28407 8918 3675 2
+ 28404 8982 3538 2
+ 28397 9058 3399 2
+ 28379 9147 3311 2
+ 28354 9261 3204 2
+ 28341 9348 3070 2
+ 28332 9418 2937 2
+ 28306 9526 2831 2
+ 28281 9630 2729 2
+ 28251 9743 2634 2
+ 28223 9844 2566 2
+ 28195 9957 2429 2
+ 28174 10044 2307 2
+ 28165 10073 2288 2
+ 28161 10063 2382 2
+ 28127 10187 2260 2
+ 28154 10131 2177 2
+ 28153 10176 1970 2
+ 28130 10263 1836 2
+ 28117 10316 1731 2
+ 28082 10432 1602 2
+ 28045 10542 1535 2
+ 28014 10631 1488 2
+ 27953 10784 1536 2
+ 27904 10913 1498 2
+ 27875 11005 1382 2
+ 27866 11044 1236 2
+ 27854 11088 1091 2
+ 27820 11183 978 2
+ 27771 11310 930 2
+ 27742 11377 962 2
+ 27804 11232 885 2
+ 27861 11090 874 2
+ 27869 11077 806 2
+ 27855 11117 708 2
+ 27803 11250 638 2
+ 27878 11068 581 2
+ 27866 11103 469 2
+ 27822 11212 460 2
+ 27855 11136 321 2
+ 27807 11256 244 2
+ 27786 11310 218 2
+ 27851 11148 169 2
+ 27809 11254 73 2
+ 27750 11398 59 2
+ 27749 11402 38 2
+ 27810 11252 -4 2
+ 27843 11170 -76 2
+ 27795 11287 -205 2
+ 27747 11402 -289 2
+ 27690 11540 -252 2
+ 27637 11668 -245 2
+ 27580 11802 -245 2
+ 27536 11906 -191 2
+ 27515 11955 -69 2
+ 27476 12043 63 2
+ 27450 12102 202 2
+ 27428 12150 250 2
+ 27431 12147 112 2
+ 27478 12040 7 2
+ 27512 11962 -119 2
+ 27516 11950 -267 2
+ 27588 11783 -291 2
+ 27632 11677 -378 2
+ 27647 11634 -522 2
+ 27642 11638 -678 2
+ 27688 11522 -788 2
+ 27742 11385 -863 2
+ 27790 11264 -903 2
+ 27846 11122 -944 2
+ 27898 10989 -968 2
+ 27951 10850 -1002 2
+ 27996 10727 -1076 2
+ 28005 10700 -1114 2
+ 27983 10759 -1106 2
+ 28037 10610 -1177 2
+ 28075 10496 -1271 2
+ 28084 10466 -1332 2
+ 28060 10527 -1345 2
+ 28108 10392 -1398 2
+ 28111 10376 -1452 2
+ 28095 10412 -1496 2
+ 28157 10243 -1503 2
+ 28157 10235 -1561 2
+ 28140 10261 -1690 2
+ 28167 10166 -1807 2
+ 28199 10063 -1884 2
+ 28244 9927 -1931 2
+ 28268 9887 -1785 2
+ 28301 9762 -1939 2
+ 28264 9858 -1994 2
+ 28322 9680 -2044 2
+ 28350 9587 -2096 2
+ 28398 9426 -2169 2
+ 28437 9296 -2220 2
+ 28480 9154 -2252 2
+ 28518 9028 -2282 2
+ 28566 8881 -2256 2
+ 28615 8735 -2216 2
+ 28662 8587 -2179 2
+ 28702 8465 -2135 2
+ 28746 8318 -2120 2
+ 28748 8289 -2196 2
+ 28706 8406 -2301 2
+ 28689 8448 -2354 2
+ 28739 8273 -2373 2
+ 28716 8324 -2465 2
+ 28749 8202 -2497 2
+ 28717 8286 -2581 2
+ 28732 8216 -2639 2
+ 28717 8255 -2680 2
+ 28743 8145 -2734 2
+ 28704 8248 -2841 2
+ 28661 8365 -2926 2
+ 28628 8434 -3050 2
+ 28592 8522 -3143 2
+ 28568 8605 -3139 2
+ 28565 8551 -3307 2
+ 28517 8671 -3405 2
+ 28476 8794 -3435 2
+ 28432 8922 -3465 2
+ 28463 8771 -3594 2
+ 28503 8616 -3651 2
+ 28517 8531 -3743 2
+ 28515 8496 -3835 2
+ 28571 8316 -3815 2
+ 28601 8186 -3869 2
+ 28638 8040 -3901 2
+ 28676 7898 -3913 2
+ 28713 7752 -3934 2
+ 28740 7618 -4001 2
+ 28773 7471 -4033 2
+ 28803 7328 -4088 2
+ 28840 7173 -4102 2
+ 28851 7103 -4142 2
+ 28823 7202 -4169 2
+ 28852 7042 -4239 2
+ 28873 6912 -4307 2
+ 28899 6768 -4365 2
+ 28928 6620 -4402 2
+ 28959 6479 -4406 2
+ 28990 6338 -4403 2
+ 29023 6180 -4413 2
+ 29029 6109 -4468 2
+ 29042 6037 -4483 2
+ 29075 5892 -4464 2
+ 29108 5736 -4450 2
+ 29144 5606 -4381 2
+ 29173 5472 -4355 2
+ 29199 5324 -4369 2
+ 29201 5265 -4422 2
+ 29186 5315 -4466 2
+ 29225 5147 -4403 2
+ 29252 5018 -4372 2
+ 29286 4865 -4318 2
+ 29312 4723 -4300 2
+ 29342 4578 -4255 2
+ 29364 4441 -4244 2
+ 29371 4302 -4337 2
+ 29347 4329 -4472 2
+ 29352 4195 -4565 2
+ 29351 4091 -4667 2
+ 29349 3996 -4762 2
+ 29352 3844 -4869 2
+ 29345 3774 -4965 2
+ 29352 3650 -5017 2
+ 29353 3536 -5090 2
+ 29348 3424 -5191 2
+ 29349 3298 -5268 2
+ 29350 3166 -5343 2
+ 29361 3010 -5371 2
+ 29375 2868 -5377 2
+ 29385 2717 -5399 2
+ 29392 2578 -5429 2
+ 29388 2463 -5503 2
+ 29400 2317 -5503 2
+ 29403 2177 -5541 2
+ 29401 2055 -5599 2
+ 29392 1923 -5694 2
+ 29382 1801 -5784 2
+ 29372 1680 -5870 2
+ 29377 1524 -5888 2
+ 29363 1409 -5984 2
+ 29340 1333 -6115 2
+ 29322 1240 -6221 2
+ 29298 1152 -6349 2
+ 29271 1086 -6485 2
+ 29249 988 -6597 2
+ 29222 916 -6726 2
+ 29194 844 -6855 2
+ 29172 748 -6961 2
+ 29152 713 -7047 2
+ 29112 762 -7204 2
+ 29090 783 -7292 2
+ 29064 785 -7394 2
+ 29072 939 -7344 2
+ 29082 1075 -7285 2
+ 29093 1210 -7220 2
+ 29106 1348 -7142 2
+ 29130 1437 -7026 2
+ 29138 1573 -6963 2
+ 29130 1726 -6961 2
+ 29124 1868 -6950 2
+ 29119 2021 -6927 2
+ 29104 2165 -6949 2
+ 29088 2311 -6968 2
+ 29079 2463 -6953 2
+ 29080 2600 -6898 2
+ 29085 2733 -6828 2
+ 29094 2856 -6738 2
+ 29114 2941 -6614 2
+ 29129 3041 -6502 2
+ 29135 3162 -6415 2
+ 29151 3247 -6300 2
+ 29170 3318 -6174 2
+ 29181 3421 -6065 2
+ 29184 3548 -5977 2
+ 29203 3606 -5844 2
+ 29234 3590 -5698 2
+ 29252 3658 -5564 2
+ 29264 3738 -5443 2
+ 29272 3824 -5338 2
+ 29270 3957 -5253 2
+ 29255 3998 -5308 2
+ 29258 3874 -5380 2
+ 29258 3825 -5418 2
+ 29242 4021 -5361 2
+ 29228 4167 -5326 2
+ 29212 4314 -5294 2
+ 29210 4417 -5222 2
+ 29208 4541 -5125 2
+ 29188 4691 -5104 2
+ 29176 4833 -5040 2
+ 29205 4814 -4889 2
+ 29217 4859 -4772 2
+ 29199 5008 -4729 2
+ 29177 5154 -4704 2
+ 29149 5304 -4715 2
+ 29122 5427 -4737 2
+ 29086 5568 -4796 2
+ 29051 5696 -4857 2
+ 29017 5846 -4884 2
+ 28980 5989 -4929 2
+ 28940 6123 -4996 2
+ 28902 6256 -5052 2
+ 28866 6390 -5090 2
+ 28836 6539 -5069 2
+ 28800 6683 -5089 2
+ 28766 6820 -5098 2
+ 28738 6942 -5091 2
+ 28701 6996 -5228 2
+ 28668 7019 -5372 2
+ 28652 6960 -5532 2
+ 28691 6798 -5533 2
+ 28728 6652 -5521 2
+ 28737 6569 -5573 2
+ 28706 6562 -5737 2
+ 28676 6570 -5877 2
+ 28649 6549 -6028 2
+ 28642 6493 -6124 2
+ 28637 6405 -6236 2
+ 28627 6308 -6381 2
+ 28622 6221 -6486 2
+ 28635 6086 -6559 2
+ 28631 6033 -6622 2
+ 28660 5840 -6672 2
+ 28681 5686 -6715 2
+ 28645 5720 -6838 2
+ 28615 5771 -6921 2
+ 28634 5622 -6963 2
+ 28661 5497 -6951 2
+ 28623 5520 -7088 2
+ 28589 5484 -7252 2
+ 28571 5406 -7381 2
+ 28562 5311 -7485 2
+ 28535 5253 -7627 2
+ 28542 5153 -7668 2
+ 28588 5025 -7582 2
+ 28615 4878 -7576 2
+ 28641 4726 -7574 2
+ 28658 4563 -7609 2
+ 28670 4481 -7611 2
+ 28618 4538 -7773 2
+ 28576 4649 -7861 2
+ 28534 4759 -7946 2
+ 28488 4817 -8078 2
+ 28437 4879 -8218 2
+ 28412 5000 -8231 2
+ 28416 5123 -8142 2
+ 28415 5162 -8121 2
+ 28397 5034 -8262 2
+ 28358 5020 -8402 2
+ 28349 5167 -8346 2
+ 28352 5248 -8282 2
+ 28322 5171 -8434 2
+ 28326 5268 -8361 2
+ 28286 5279 -8488 2
+ 28280 5371 -8448 2
+ 28238 5485 -8516 2
+ 28198 5495 -8643 2
+ 28166 5432 -8785 2
+ 28107 5507 -8926 2
+ 28053 5569 -9057 2
+ 28003 5659 -9154 2
+ 27950 5719 -9277 2
+ 27892 5810 -9397 2
+ 27838 5881 -9511 2
+ 27792 5981 -9583 2
+ 27751 6074 -9643 2
+ 27714 6222 -9656 2
+ 27683 6380 -9642 2
+ 27653 6489 -9655 2
+ 27603 6606 -9718 2
+ 27573 6759 -9698 2
+ 27558 6897 -9643 2
+ 27533 7021 -9626 2
+ 27499 7173 -9611 2
+ 27471 7331 -9572 2
+ 27451 7467 -9522 2
+ 27429 7601 -9479 2
+ 27414 7737 -9414 2
+ 27388 7877 -9374 2
+ 27388 7982 -9284 2
+ 27391 8101 -9170 2
+ 27383 8221 -9087 2
+ 27376 8327 -9012 2
+ 27390 8421 -8881 2
+ 27404 8511 -8751 2
+ 27411 8591 -8650 2
+ 27421 8709 -8501 2
+ 27411 8818 -8418 2
+ 27418 8913 -8296 2
+ 27416 9018 -8188 2
+ 27413 9124 -8078 2
+ 27398 9169 -8081 2
+ 27360 9306 -8052 2
+ 27364 9389 -7939 2
+ 27365 9480 -7827 2
+ 27348 9610 -7730 2
+ 27328 9720 -7662 2
+ 27271 9858 -7686 2
+ 27217 9995 -7702 2
+ 27162 10125 -7726 2
+ 27096 10245 -7802 2
+ 27038 10315 -7907 2
+ 26966 10424 -8009 2
+ 26909 10555 -8030 2
+ 26852 10663 -8078 2
+ 26816 10734 -8104 2
+ 26771 10746 -8236 2
+ 26710 10809 -8350 2
+ 26651 10904 -8415 2
+ 26579 10982 -8541 2
+ 26533 11006 -8652 2
+ 26471 11049 -8786 2
+ 26430 11097 -8848 2
+ 26396 11157 -8875 2
+ 26382 11095 -8993 2
+ 26372 10998 -9142 2
+ 26336 10976 -9271 2
+ 26272 11041 -9374 2
+ 26274 10937 -9490 2
+ 26351 10796 -9438 2
+ 26396 10656 -9471 2
+ 26420 10536 -9538 2
+ 26437 10421 -9615 2
+ 26379 10409 -9788 2
+ 26322 10533 -9810 2
+ 26304 10644 -9736 2
+ 26278 10765 -9673 2
+ 26205 10888 -9734 2
+ 26189 10901 -9762 2
+ 26143 10918 -9867 2
+ 26065 10976 -10006 2
+ 26015 10992 -10119 2
+ 25953 11020 -10246 2
+ 25878 11097 -10353 2
+ 25815 11148 -10456 2
+ 25753 11154 -10600 2
+ 25724 11203 -10618 2
+ 25692 11167 -10734 2
+ 25622 11220 -10845 2
+ 25549 11298 -10938 2
+ 25493 11377 -10985 2
+ 25480 11442 -10947 2
+ 25450 11375 -11086 2
+ 25392 11536 -11053 2
+ 25373 11655 -10971 2
+ 25298 11767 -11026 2
+ 25296 11734 -11065 2
+ 25330 11630 -11097 2
+ 25335 11499 -11220 2
+ 25334 11419 -11305 2
+ 25279 11445 -11401 2
+ 25225 11499 -11466 2
+ 25185 11544 -11509 2
+ 25132 11574 -11594 2
+ 25100 11571 -11667 2
+ 25013 11634 -11789 2
+ 24963 11625 -11905 2
+ 24898 11644 -12021 2
+ 24827 11661 -12151 2
+ 24747 11707 -12268 2
+ 24649 11823 -12355 2
+ 24621 11874 -12361 2
+ 24607 11905 -12360 2
+ 24516 12004 -12445 2
+ 24442 12036 -12559 2
+ 24339 12123 -12674 2
+ 24260 12196 -12756 2
+ 24178 12278 -12832 2
+ 24128 12369 -12840 2
+ 24115 12440 -12794 2
+ 24037 12489 -12893 2
+ 23960 12494 -13032 2
+ 23878 12605 -13076 2
+ 23795 12676 -13158 2
+ 23731 12771 -13181 2
+ 23669 12819 -13247 2
+ 23625 12921 -13225 2
+ 23585 12906 -13310 2
+ 23557 12900 -13366 2
+ 23499 13041 -13331 2
+ 23460 13142 -13301 2
+ 23506 13176 -13186 2
+ 23379 13263 -13323 2
+ 23325 13348 -13333 2
+ 23269 13491 -13287 2
+ 23222 13471 -13390 2
+ 23237 13427 -13406 2
+ 23164 13532 -13428 2
+ 23074 13644 -13470 2
+ 23010 13739 -13483 2
+ 22895 13858 -13557 2
+ 22816 13980 -13563 2
+ 22775 14082 -13527 2
+ 22770 14103 -13514 2
+ 22687 14125 -13630 2
+ 22593 14209 -13699 2
+ 22492 14259 -13812 2
+ 22472 14398 -13702 2
+ 22473 14433 -13662 2
+ 22371 14490 -13768 2
+ 22342 14591 -13709 2
+ 22265 14665 -13755 2
+ 22207 14677 -13836 2
+ 22175 14791 -13766 2
+ 22242 14780 -13668 2
+ 22083 14913 -13782 2
+ 22063 14955 -13769 2
+ 22113 15007 -13631 2
+ 22121 15103 -13512 2
+ 22184 15121 -13388 2
+ 22300 15052 -13272 2
+ 22331 15105 -13159 2
+ 22360 15133 -13077 2
+ 22234 15168 -13251 2
+ 22141 15249 -13314 2
+ 22036 15322 -13404 2
+ 21937 15381 -13497 2
+ 21851 15437 -13574 2
+ 21817 15570 -13475 2
+ 21842 15646 -13347 2
+ 21852 15736 -13224 2
+ 21892 15792 -13089 2
+ 21896 15866 -12994 2
+ 21969 15875 -12858 2
+ 22045 15880 -12721 2
+ 22050 15979 -12589 2
+ 22014 16017 -12604 2
+ 22025 15893 -12740 2
+ 21953 15901 -12853 2
+ 21869 15930 -12960 2
+ 21845 15852 -13095 2
+ 21783 15831 -13225 2
+ 21732 15789 -13358 2
+ 21662 15806 -13451 2
+ 21650 15927 -13327 2
+ 21657 16005 -13222 2
+ 21644 16106 -13119 2
+ 21677 16180 -12974 2
+ 21615 16301 -12925 2
+ 21574 16422 -12841 2
+ 21541 16536 -12750 2
+ 21505 16650 -12662 2
+ 21461 16767 -12581 2
+ 21417 16888 -12494 2
+ 21436 16959 -12364 2
+ 21474 17011 -12228 2
+ 21489 17090 -12089 2
+ 21490 17149 -12004 2
+ 21396 17257 -12017 2
+ 21292 17362 -12051 2
+ 21177 17463 -12107 2
+ 21086 17533 -12165 2
+ 20981 17630 -12205 2
+ 20917 17705 -12208 2
+ 20851 17695 -12335 2
+ 20748 17800 -12356 2
+ 20666 17881 -12376 2
+ 20530 17943 -12513 2
+ 20454 17975 -12591 2
+ 20329 18033 -12710 2
+ 20282 18009 -12819 2
+ 20191 18080 -12861 2
+ 20097 18204 -12834 2
+ 20155 18256 -12668 2
+ 20229 18244 -12568 2
+ 20293 18269 -12427 2
+ 20332 18325 -12280 2
+ 20355 18390 -12145 2
+ 20452 18359 -12027 2
+ 20540 18298 -11970 2
+ 20669 18200 -11897 2
+ 20771 18118 -11845 2
+ 20851 18112 -11714 2
+ 20876 18171 -11577 2
+ 20802 18289 -11522 2
+ 20718 18397 -11503 2
+ 20680 18506 -11397 2
+ 20739 18516 -11272 2
+ 20804 18530 -11128 2
+ 20828 18581 -10997 2
+ 20806 18673 -10882 2
+ 20732 18785 -10830 2
+ 20627 18894 -10843 2
+ 20526 18961 -10917 2
+ 20489 18918 -11060 2
+ 20387 18951 -11190 2
+ 20322 18970 -11276 2
+ 20189 19094 -11307 2
+ 20083 19191 -11329 2
+ 19977 19259 -11401 2
+ 19872 19312 -11496 2
+ 19762 19366 -11594 2
+ 19656 19453 -11628 2
+ 19522 19554 -11685 2
+ 19420 19631 -11726 2
+ 19342 19635 -11848 2
+ 19271 19630 -11970 2
+ 19271 19539 -12119 2
+ 19331 19442 -12179 2
+ 19444 19346 -12151 2
+ 19552 19264 -12109 2
+ 19675 19171 -12057 2
+ 19763 19080 -12057 2
+ 19744 19003 -12209 2
+ 19880 18892 -12162 2
+ 19973 18813 -12130 2
+ 19829 18871 -12277 2
+ 19716 18933 -12362 2
+ 19601 19023 -12406 2
+ 19490 19084 -12487 2
+ 19377 19140 -12578 2
+ 19271 19186 -12669 2
+ 19174 19217 -12770 2
+ 19081 19220 -12904 2
+ 18976 19264 -12993 2
+ 18975 19159 -13148 2
+ 18913 19122 -13290 2
+ 18886 19062 -13415 2
+ 18980 18941 -13453 2
+ 19086 18832 -13457 2
+ 19085 18771 -13542 2
+ 19078 18743 -13593 2
+ 19198 18703 -13477 2
+ 19316 18581 -13477 2
+ 19368 18515 -13494 2
+ 19339 18450 -13624 2
+ 19304 18391 -13752 2
+ 19195 18442 -13835 2
+ 19136 18394 -13982 2
+ 19035 18393 -14119 2
+ 19059 18326 -14174 2
+ 19124 18178 -14277 2
+ 19161 18091 -14339 2
+ 19200 18017 -14378 2
+ 19287 18028 -14248 2
+ 19375 17944 -14235 2
+ 19401 17802 -14377 2
+ 19458 17684 -14446 2
+ 19474 17591 -14537 2
+ 19593 17459 -14536 2
+ 19705 17343 -14524 2
+ 19779 17228 -14560 2
+ 19804 17119 -14654 2
+ 19870 17033 -14665 2
+ 19863 16948 -14773 2
+ 19766 17000 -14843 2
+ 19655 17045 -14937 2
+ 19618 17024 -15010 2
+ 19548 17102 -15013 2
+ 19467 17159 -15053 2
+ 19355 17196 -15156 2
+ 19265 17189 -15277 2
+ 19159 17257 -15334 2
+ 19062 17252 -15460 2
+ 18936 17347 -15508 2
+ 18850 17445 -15504 2
+ 18749 17577 -15476 2
+ 18721 17666 -15409 2
+ 18658 17796 -15335 2
+ 18580 17917 -15288 2
+ 18516 18040 -15222 2
+ 18473 18155 -15137 2
+ 18455 18262 -15031 2
+ 18440 18365 -14922 2
+ 18438 18462 -14805 2
+ 18420 18566 -14698 2
+ 18391 18674 -14596 2
+ 18378 18772 -14486 2
+ 18405 18848 -14352 2
+ 18423 18927 -14226 2
+ 18420 19012 -14116 2
+ 18327 19128 -14080 2
+ 18229 19216 -14088 2
+ 18110 19281 -14151 2
+ 18002 19312 -14248 2
+ 17877 19384 -14306 2
+ 17754 19454 -14364 2
+ 17632 19540 -14397 2
+ 17512 19603 -14459 2
+ 17415 19679 -14473 2
+ 17327 19800 -14414 2
+ 17270 19907 -14333 2
+ 17154 20008 -14333 2
+ 17036 20097 -14349 2
+ 16913 20174 -14386 2
+ 16800 20214 -14463 2
+ 16683 20314 -14457 2
+ 16559 20355 -14542 2
+ 16452 20440 -14545 2
+ 16325 20535 -14553 2
+ 16264 20544 -14609 2
+ 16240 20520 -14670 2
+ 16176 20528 -14728 2
+ 16226 20418 -14827 2
+ 16138 20391 -14959 2
+ 16075 20356 -15074 2
+ 15930 20394 -15176 2
+ 15812 20432 -15249 2
+ 15680 20499 -15294 2
+ 15549 20558 -15349 2
+ 15420 20625 -15390 2
+ 15290 20708 -15408 2
+ 15169 20788 -15420 2
+ 15063 20878 -15402 2
+ 14942 20968 -15396 2
+ 14813 21040 -15425 2
+ 14690 21129 -15420 2
+ 14565 21213 -15424 2
+ 14439 21298 -15425 2
+ 14307 21372 -15445 2
+ 14178 21454 -15450 2
+ 14050 21534 -15456 2
+ 13925 21619 -15450 2
+ 13811 21711 -15423 2
+ 13697 21802 -15397 2
+ 13588 21902 -15352 2
+ 13469 21990 -15331 2
+ 13338 22069 -15331 2
+ 13222 22162 -15297 2
+ 13102 22251 -15272 2
+ 12968 22327 -15275 2
+ 12836 22401 -15278 2
+ 12718 22485 -15253 2
+ 12621 22585 -15187 2
+ 12550 22664 -15128 2
+ 12448 22764 -15062 2
+ 12343 22870 -14987 2
+ 12280 22963 -14897 2
+ 12205 23037 -14843 2
+ 12144 23145 -14726 2
+ 12065 23238 -14643 2
+ 11955 23327 -14592 2
+ 11850 23427 -14518 2
+ 11743 23507 -14475 2
+ 11611 23582 -14460 2
+ 11502 23664 -14413 2
+ 11466 23725 -14340 2
+ 11442 23801 -14233 2
+ 11363 23892 -14144 2
+ 11382 23959 -14015 2
+ 11364 23980 -13994 2
+ 11258 23991 -14060 2
+ 11217 24064 -13968 2
+ 11249 24117 -13850 2
+ 11297 24184 -13695 2
+ 11283 24262 -13567 2
+ 11306 24328 -13427 2
+ 11374 24345 -13340 2
+ 11490 24338 -13252 2
+ 11582 24325 -13196 2
+ 11676 24228 -13292 2
+ 11797 24142 -13341 2
+ 11833 24150 -13295 2
+ 11749 24223 -13238 2
+ 11947 24142 -13207 2
+ 12035 24157 -13100 2
+ 11896 24256 -13045 2
+ 11881 24313 -12950 2
+ 11833 24357 -12911 2
+ 11965 24292 -12912 2
+ 12066 24221 -12953 2
+ 12122 24240 -12863 2
+ 12013 24335 -12787 2
+ 11929 24418 -12707 2
+ 11929 24462 -12621 2
+ 12056 24452 -12520 2
+ 12142 24466 -12410 2
+ 12172 24520 -12273 2
+ 12033 24600 -12250 2
+ 11896 24646 -12292 2
+ 11761 24707 -12299 2
+ 11625 24765 -12311 2
+ 11489 24816 -12337 2
+ 11353 24870 -12354 2
+ 11211 24934 -12354 2
+ 11068 25005 -12339 2
+ 10949 25076 -12301 2
+ 10810 25145 -12284 2
+ 10680 25197 -12290 2
+ 10531 25255 -12300 2
+ 10390 25312 -12301 2
+ 10248 25369 -12303 2
+ 10123 25424 -12294 2
+ 10008 25501 -12228 2
+ 9870 25561 -12215 2
+ 9725 25607 -12234 2
+ 9590 25670 -12209 2
+ 9459 25733 -12179 2
+ 9314 25779 -12194 2
+ 9170 25808 -12242 2
+ 9044 25817 -12317 2
+ 8913 25819 -12406 2
+ 8810 25817 -12484 2
+ 8665 25825 -12569 2
+ 8592 25800 -12670 2
+ 8533 25775 -12761 2
+ 8408 25826 -12741 2
+ 8297 25805 -12856 2
+ 8187 25795 -12946 2
+ 8043 25815 -12996 2
+ 7950 25788 -13107 2
+ 7863 25842 -13053 2
+ 7718 25909 -13006 2
+ 7596 25909 -13078 2
+ 7500 25878 -13195 2
+ 7430 25854 -13280 2
+ 7267 25855 -13369 2
+ 7217 25796 -13509 2
+ 7205 25764 -13576 2
+ 7363 25753 -13512 2
+ 7443 25704 -13561 2
+ 7338 25680 -13663 2
+ 7184 25712 -13684 2
+ 7054 25706 -13763 2
+ 6899 25759 -13743 2
+ 6788 25758 -13800 2
+ 6653 25756 -13870 2
+ 6503 25766 -13922 2
+ 6450 25829 -13829 2
+ 6572 25846 -13740 2
+ 6605 25873 -13673 2
+ 6518 25946 -13576 2
+ 6407 26011 -13504 2
+ 6280 26073 -13445 2
+ 6138 26122 -13415 2
+ 6002 26174 -13374 2
+ 5891 26241 -13293 2
+ 5749 26295 -13248 2
+ 5653 26363 -13155 2
+ 5508 26414 -13113 2
+ 5370 26435 -13128 2
+ 5236 26438 -13176 2
+ 5093 26456 -13195 2
+ 4981 26442 -13267 2
+ 4912 26423 -13331 2
+ 4785 26440 -13342 2
+ 4891 26352 -13478 2
+ 4964 26296 -13560 2
+ 4947 26230 -13693 2
+ 4933 26163 -13826 2
+ 4777 26206 -13800 2
+ 4648 26262 -13738 2
+ 4521 26315 -13677 2
+ 4400 26362 -13627 2
+ 4235 26403 -13600 2
+ 4135 26408 -13621 2
+ 4096 26491 -13471 2
+ 4029 26564 -13346 2
+ 3959 26620 -13256 2
+ 3801 26645 -13250 2
+ 3663 26646 -13287 2
+ 3548 26614 -13384 2
+ 3529 26592 -13433 2
+ 3699 26592 -13385 2
+ 3828 26540 -13453 2
+ 3877 26468 -13580 2
+ 3946 26401 -13690 2
+ 3983 26338 -13801 2
+ 4064 26275 -13896 2
+ 4130 26214 -13992 2
+ 4261 26178 -14020 2
+ 4430 26135 -14048 2
+ 4580 26088 -14087 2
+ 4670 26023 -14177 2
+ 4798 25970 -14231 2
+ 4918 25909 -14302 2
+ 5056 25861 -14341 2
+ 5179 25800 -14406 2
+ 5311 25742 -14462 2
+ 5402 25669 -14558 2
+ 5536 25598 -14633 2
+ 5651 25547 -14677 2
+ 5790 25494 -14714 2
+ 5909 25442 -14757 2
+ 6068 25422 -14727 2
+ 6213 25385 -14730 2
+ 6298 25355 -14747 2
+ 6334 25271 -14875 2
+ 6451 25192 -14958 2
+ 6573 25134 -15002 2
+ 6679 25085 -15038 2
+ 6788 24991 -15144 2
+ 6870 24909 -15242 2
+ 6945 24827 -15343 2
+ 7010 24742 -15450 2
+ 7072 24657 -15558 2
+ 7113 24570 -15675 2
+ 7146 24484 -15795 2
+ 7176 24395 -15918 2
+ 7196 24309 -16041 2
+ 7221 24221 -16161 2
+ 7254 24132 -16280 2
+ 7286 24042 -16398 2
+ 7320 23952 -16515 2
+ 7342 23862 -16634 2
+ 7330 23789 -16744 2
+ 7359 23686 -16877 2
+ 7391 23593 -16993 2
+ 7441 23498 -17102 2
+ 7455 23407 -17221 2
+ 7425 23323 -17346 2
+ 7230 23411 -17310 2
+ 7109 23481 -17266 2
+ 6972 23546 -17233 2
+ 6853 23625 -17173 2
+ 6755 23712 -17091 2
+ 6699 23794 -17000 2
+ 6642 23877 -16904 2
+ 6583 23950 -16824 2
+ 6378 24004 -16826 2
+ 6227 24031 -16844 2
+ 6149 24036 -16867 2
+ 6127 24137 -16729 2
+ 6090 24227 -16612 2
+ 6002 24311 -16521 2
+ 5875 24374 -16474 2
+ 5740 24430 -16439 2
+ 5601 24436 -16477 2
+ 5461 24437 -16524 2
+ 5327 24507 -16463 2
+ 5332 24588 -16341 2
+ 5349 24666 -16216 2
+ 5308 24752 -16099 2
+ 5219 24831 -16006 2
+ 5121 24906 -15921 2
+ 5002 24970 -15859 2
+ 4902 24989 -15860 2
+ 4919 24894 -16003 2
+ 4787 24944 -15965 2
+ 4767 25031 -15834 2
+ 4814 25087 -15732 2
+ 4832 25155 -15616 2
+ 4803 25241 -15486 2
+ 4697 25307 -15412 2
+ 4631 25380 -15310 2
+ 4761 25412 -15216 2
+ 4864 25382 -15235 2
+ 4911 25459 -15090 2
+ 4841 25538 -14979 2
+ 4742 25609 -14889 2
+ 4614 25672 -14821 2
+ 4500 25734 -14748 2
+ 4413 25804 -14653 2
+ 4358 25882 -14530 2
+ 4261 25950 -14437 2
+ 4140 25974 -14430 2
+ 3993 25983 -14454 2
+ 3888 25952 -14539 2
+ 3808 26017 -14443 2
+ 3640 26063 -14404 2
+ 3540 26082 -14395 2
+ 3593 25981 -14563 2
+ 3556 25952 -14624 2
+ 3429 26017 -14539 2
+ 3308 26075 -14462 2
+ 3174 26104 -14440 2
+ 3018 26129 -14428 2
+ 2874 26127 -14461 2
+ 2737 26124 -14493 2
+ 2634 26057 -14631 2
+ 2599 25995 -14748 2
+ 2505 25986 -14780 2
+ 2426 26075 -14636 2
+ 2323 26117 -14578 2
+ 2176 26169 -14507 2
+ 2045 26208 -14455 2
+ 1951 26258 -14378 2
+ 1841 26303 -14309 2
+ 1753 26344 -14246 2
+ 1608 26402 -14155 2
+ 1473 26430 -14116 2
+ 1324 26463 -14071 2
+ 1170 26505 -14004 2
+ 1060 26534 -13957 2
+ 918 26567 -13905 2
+ 796 26610 -13830 2
+ 708 26646 -13765 2
+ 660 26672 -13717 2
+ 581 26628 -13807 2
+ 430 26610 -13847 2
+ 291 26581 -13905 2
+ 200 26591 -13888 2
+ 115 26650 -13776 2
+ 152 26720 -13639 2
+ 184 26781 -13518 2
+ 263 26823 -13434 2
+ 320 26866 -13345 2
+ 336 26962 -13150 2
+ 372 27024 -13021 2
+ 442 27033 -13002 2
+ 579 27073 -12912 2
+ 630 27123 -12804 2
+ 799 27106 -12831 2
+ 835 27117 -12805 2
+ 896 27153 -12725 2
+ 1051 27132 -12757 2
+ 1134 27126 -12762 2
+ 903 27160 -12709 2
+ 767 27155 -12728 2
+ 670 27172 -12699 2
+ 742 27201 -12631 2
+ 587 27168 -12711 2
+ 496 27126 -12804 2
+ 333 27111 -12840 2
+ 209 27134 -12794 2
+ 86 27168 -12723 2
+ -26 27215 -12623 2
+ -100 27268 -12509 2
+ -124 27327 -12378 2
+ -47 27384 -12252 2
+ -96 27438 -12131 2
+ -195 27467 -12062 2
+ -303 27461 -12074 2
+ -249 27397 -12220 2
+ -316 27334 -12359 2
+ -395 27295 -12443 2
+ -545 27301 -12423 2
+ -684 27317 -12382 2
+ -832 27292 -12428 2
+ -908 27240 -12537 2
+ -951 27178 -12668 2
+ -1080 27146 -12726 2
+ -1239 27116 -12774 2
+ -1344 27070 -12861 2
+ -1468 27064 -12861 2
+ -1498 27072 -12839 2
+ -1571 27048 -12882 2
+ -1628 27092 -12781 2
+ -1589 27158 -12645 2
+ -1691 27220 -12499 2
+ -1661 27252 -12432 2
+ -1650 27301 -12327 2
+ -1621 27328 -12270 2
+ -1772 27301 -12309 2
+ -1889 27325 -12239 2
+ -1873 27352 -12179 2
+ -2011 27347 -12169 2
+ -2076 27402 -12033 2
+ -2109 27437 -11949 2
+ -1987 27472 -11888 2
+ -1866 27521 -11794 2
+ -1751 27565 -11708 2
+ -1638 27606 -11629 2
+ -1480 27612 -11635 2
+ -1356 27615 -11643 2
+ -1173 27635 -11616 2
+ -1150 27620 -11654 2
+ -1230 27560 -11787 2
+ -1248 27514 -11892 2
+ -1238 27482 -11967 2
+ -1152 27501 -11932 2
+ -1070 27554 -11817 2
+ -1049 27615 -11676 2
+ -1033 27679 -11525 2
+ -957 27712 -11450 2
+ -855 27771 -11316 2
+ -726 27804 -11243 2
+ -588 27839 -11163 2
+ -477 27867 -11100 2
+ -372 27896 -11031 2
+ -251 27937 -10930 2
+ -136 27977 -10828 2
+ -54 27995 -10784 2
+ 816 28018 -10693 2
+ 926 28058 -10579 2
+ 1003 28081 -10509 2
+ 1171 28109 -10418 2
+ 1304 28129 -10348 2
+ 1418 28159 -10250 2
+ 1565 28168 -10204 2
+ 1475 28195 -10142 2
+ 1616 28208 -10085 2
+ 1689 28193 -10115 2
+ 1742 28142 -10247 2
+ 1723 28108 -10343 2
+ 1682 28057 -10488 2
+ 1697 28008 -10615 2
+ 1792 27974 -10688 2
+ 1961 27979 -10646 2
+ 2013 28028 -10506 2
+ 2137 28056 -10407 2
+ 2154 28109 -10260 2
+ 2223 28137 -10167 2
+ 2394 28104 -10220 2
+ 2538 28108 -10172 2
+ 2678 28116 -10114 2
+ 2809 28128 -10047 2
+ 2922 28139 -9983 2
+ 3072 28133 -9956 2
+ 3210 28119 -9951 2
+ 3348 28077 -10022 2
+ 3397 28026 -10149 2
+ 3457 27972 -10276 2
+ 3533 27943 -10329 2
+ 3462 28022 -10139 2
+ 3448 28074 -9999 2
+ 3449 28124 -9855 2
+ 3559 28149 -9746 2
+ 3531 28201 -9605 2
+ 3450 28244 -9506 2
+ 3442 28293 -9362 2
+ 3490 28332 -9226 2
+ 3583 28358 -9110 2
+ 3696 28375 -9010 2
+ 3831 28380 -8938 2
+ 3981 28377 -8882 2
+ 4094 28370 -8853 2
+ 4256 28357 -8820 2
+ 4402 28342 -8795 2
+ 4542 28339 -8733 2
+ 4594 28367 -8613 2
+ 4587 28416 -8457 2
+ 4701 28423 -8370 2
+ 4745 28433 -8310 2
+ 4759 28471 -8170 2
+ 4800 28496 -8059 2
+ 4650 28527 -8038 2
+ 4680 28562 -7894 2
+ 4774 28579 -7774 2
+ 4900 28583 -7680 2
+ 5039 28555 -7696 2
+ 5174 28514 -7758 2
+ 5325 28485 -7762 2
+ 5350 28504 -7674 2
+ 5209 28539 -7643 2
+ 5151 28552 -7634 2
+ 5165 28526 -7720 2
+ 5038 28575 -7622 2
+ 5193 28575 -7518 2
+ 5264 28580 -7448 2
+ 5056 28587 -7565 2
+ 5010 28597 -7558 2
+ 5101 28617 -7417 2
+ 5199 28630 -7302 2
+ 5300 28639 -7192 2
+ 5414 28643 -7090 2
+ 5510 28653 -6973 2
+ 5605 28654 -6894 2
+ 5714 28614 -6970 2
+ 5847 28607 -6889 2
+ 5964 28566 -6957 2
+ 5929 28552 -7046 2
+ 6049 28510 -7112 2
+ 6145 28452 -7260 2
+ 6234 28452 -7186 2
+ 6299 28462 -7087 2
+ 6429 28418 -7148 2
+ 6500 28405 -7133 2
+ 6525 28446 -6945 2
+ 6567 28468 -6816 2
+ 6689 28457 -6744 2
+ 6829 28427 -6728 2
+ 6911 28444 -6573 2
+ 6900 28480 -6426 2
+ 6911 28499 -6330 2
+ 7094 28438 -6400 2
+ 7206 28395 -6466 2
+ 7361 28344 -6513 2
+ 7445 28340 -6436 2
+ 7461 28367 -6298 2
+ 7447 28398 -6173 2
+ 7372 28451 -6018 2
+ 7292 28487 -5944 2
+ 7260 28510 -5870 2
+ 7245 28545 -5716 2
+ 7220 28580 -5575 2
+ 7292 28580 -5476 2
+ 7401 28526 -5609 2
+ 7506 28481 -5703 2
+ 7556 28460 -5737 2
+ 7428 28524 -5584 2
+ 7355 28572 -5437 2
+ 7385 28589 -5302 2
+ 7370 28621 -5153 2
+ 7388 28642 -5005 2
+ 7441 28652 -4869 2
+ 7469 28671 -4711 2
+ 7506 28682 -4582 2
+ 7571 28686 -4446 2
+ 7618 28684 -4379 2
+ 7613 28720 -4147 2
+ 7487 28764 -4071 2
+ 7525 28778 -3895 2
+ 7561 28789 -3748 2
+ 7620 28791 -3607 2
+ 7724 28777 -3496 2
+ 7847 28750 -3448 2
+ 7985 28708 -3480 2
+ 8172 28646 -3555 2
+ 8130 28664 -3501 2
+ 7989 28708 -3472 2
+ 7871 28750 -3391 2
+ 7740 28791 -3339 2
+ 7693 28815 -3240 2
+ 7793 28803 -3113 2
+ 7726 28834 -2988 2
+ 7795 28831 -2834 2
+ 7906 28797 -2863 2
+ 7903 28788 -2962 2
+ 8050 28760 -2841 2
+ 8150 28740 -2760 2
+ 8240 28722 -2675 2
+ 8317 28714 -2515 2
+ 8408 28694 -2440 2
+ 8538 28660 -2383 2
+ 8526 28667 -2353 2
+ 8379 28707 -2392 2
+ 8253 28738 -2447 2
+ 8113 28773 -2506 2
+ 8021 28789 -2615 2
+ 7888 28821 -2667 2
+ 7750 28852 -2740 2
+ 7622 28884 -2765 2
+ 7483 28913 -2834 2
+ 7352 28937 -2927 2
+ 7217 28966 -2983 2
+ 7077 28995 -3034 2
+ 6922 29033 -3025 2
+ 6854 29062 -2905 2
+ 6802 29076 -2879 2
+ 6800 29066 -2984 2
+ 6673 29103 -2912 2
+ 6600 29131 -2793 2
+ 6520 29163 -2651 2
+ 6438 29193 -2511 2
+ 6467 29198 -2375 2
+ 6518 29199 -2226 2
+ 6609 29185 -2131 2
+ 6655 29184 -2007 2
+ 6468 29227 -1984 2
+ 6470 29237 -1826 2
+ 6438 29251 -1714 2
+ 6261 29286 -1770 2
+ 6201 29309 -1584 2
+ 6284 29298 -1453 2
+ 6419 29273 -1376 2
+ 6567 29243 -1315 2
+ 6702 29213 -1302 2
+ 6844 29177 -1359 2
+ 6888 29165 -1403 2
+ 6909 29168 -1219 2
+ 6972 29157 -1127 2
+ 7119 29117 -1234 2
+ 7263 29082 -1219 2
+ 7465 29028 -1284 2
+ 7392 29049 -1230 2
+ 7269 29081 -1204 2
+ 7120 29118 -1198 2
+ 7088 29131 -1068 2
+ 7194 29110 -941 2
+ 7245 29101 -811 2
+ 7218 29109 -747 2
+ 7159 29126 -656 2
+ 7192 29121 -521 2
+ 7269 29103 -426 2
+ 7377 29077 -296 2
+ 7432 29064 -161 2
+ 7480 29053 -14 2
+ 7546 29035 114 2
+ 7649 29008 218 2
+ 7734 28984 352 2
+ 7881 28943 416 2
+ 7900 28937 484 2
+ 7915 28932 539 2
+ 8044 28898 434 2
+ 8070 28890 465 2
+ 8095 28882 535 2
+ 8231 28846 423 2
+ 8360 28809 378 2
+ 8463 28777 481 2
+ 8543 28752 601 2
+ 8675 28714 520 2
+ 8696 28707 523 2
+ 8553 28748 614 2
+ 8435 28785 530 2
+ 8331 28816 493 2
+ 8368 28801 686 2
+ 8369 28797 834 2
+ 8381 28789 986 2
+ 8364 28788 1139 2
+ 8367 28780 1293 2
+ 8422 28759 1407 2
+ 8558 28717 1440 2
+ 8696 28677 1410 2
+ 8839 28632 1444 2
+ 8969 28594 1393 2
+ 9053 28574 1259 2
+ 9194 28531 1213 2
+ 9293 28503 1098 2
+ 9432 28459 1068 2
+ 9565 28412 1130 2
+ 9691 28369 1134 2
+ 9846 28317 1102 2
+ 9987 28267 1111 2
+ 10054 28238 1240 2
+ 9837 28316 1192 2
+ 9746 28346 1241 2
+ 9893 28290 1338 2
+ 9968 28263 1362 2
+ 9760 28337 1316 2
+ 9617 28387 1302 2
+ 9509 28427 1216 2
+ 9387 28471 1129 2
+ 9318 28490 1224 2
+ 9298 28489 1377 2
+ 9154 28531 1472 2
+ 9063 28557 1541 2
+ 8958 28584 1651 2
+ 8902 28593 1793 2
+ 8933 28574 1934 2
+ 9017 28546 1958 2
+ 9123 28512 1968 2
+ 9025 28533 2099 2
+ 9055 28514 2233 2
+ 9203 28466 2236 2
+ 9320 28435 2147 2
+ 9398 28418 2030 2
+ 9520 28382 1956 2
+ 9589 28360 1942 2
+ 9451 28391 2157 2
+ 9391 28401 2276 2
+ 9313 28417 2398 2
+ 9198 28455 2394 2
+ 9047 28505 2376 2
+ 8923 28549 2305 2
+ 8799 28592 2251 2
+ 8655 28637 2237 2
+ 8591 28651 2304 2
+ 8770 28594 2334 2
+ 8895 28550 2401 2
+ 8947 28522 2538 2
+ 9010 28491 2664 2
+ 9136 28442 2759 2
+ 9280 28398 2732 2
+ 9425 28351 2720 2
+ 9569 28305 2694 2
+ 9691 28257 2762 2
+ 9798 28211 2857 2
+ 9929 28158 2921 2
+ 10065 28109 2932 2
+ 10201 28057 2960 2
+ 10290 28029 2912 2
+ 10326 28031 2760 2
+ 10310 28051 2612 2
+ 10396 28032 2482 2
+ 10500 28002 2380 2
+ 10611 27965 2312 2
+ 10751 27912 2311 2
+ 10871 27864 2324 2
+ 10975 27814 2431 2
+ 11104 27765 2416 2
+ 11177 27746 2283 2
+ 11218 27733 2246 2
+ 11179 27734 2425 2
+ 11050 27778 2507 2
+ 10914 27835 2467 2
+ 10785 27888 2440 2
+ 10659 27935 2450 2
+ 10517 27985 2503 2
+ 10454 27998 2615 2
+ 10462 27980 2764 2
+ 10507 27949 2907 2
+ 10643 27892 2966 2
+ 10785 27839 2946 2
+ 10923 27782 2969 2
+ 11025 27732 3062 2
+ 11107 27686 3183 2
+ 11233 27627 3249 2
+ 11311 27582 3364 2
+ 11354 27547 3504 2
+ 11411 27508 3623 2
+ 11485 27462 3731 2
+ 11396 27481 3861 2
+ 11350 27479 4008 2
+ 11262 27498 4127 2
+ 11149 27529 4226 2
+ 11056 27575 4167 2
+ 11128 27567 4030 2
+ 11230 27539 3938 2
+ 11241 27557 3777 2
+ 11145 27606 3703 2
+ 11061 27657 3569 2
+ 10967 27708 3465 2
+ 10888 27754 3341 2
+ 10781 27805 3263 2
+ 10649 27861 3217 2
+ 10545 27912 3117 2
+ 10402 27959 3175 2
+ 10270 28003 3223 2
+ 10132 28057 3184 2
+ 10005 28108 3139 2
+ 9867 28162 3085 2
+ 9725 28215 3059 2
+ 9604 28262 3001 2
+ 9478 28311 2942 2
+ 9339 28361 2906 2
+ 9204 28402 2931 2
+ 9058 28447 2955 2
+ 8951 28491 2855 2
+ 8836 28535 2769 2
+ 8712 28580 2695 2
+ 8564 28629 2655 2
+ 8439 28660 2721 2
+ 8356 28674 2829 2
+ 8308 28673 2976 2
+ 8266 28672 3099 2
+ 8382 28624 3229 2
+ 8509 28577 3305 2
+ 8633 28531 3384 2
+ 8745 28486 3477 2
+ 8819 28447 3601 2
+ 8860 28416 3747 2
+ 8955 28373 3846 2
+ 9075 28332 3863 2
+ 9200 28293 3856 2
+ 9323 28243 3926 2
+ 9433 28198 3984 2
+ 9544 28145 4092 2
+ 9622 28122 4071 2
+ 9744 28098 3943 2
+ 9887 28046 3962 2
+ 10033 28000 3914 2
+ 10106 27981 3868 2
+ 10234 27920 3969 2
+ 10300 27877 4096 2
+ 10140 27925 4171 2
+ 9992 27970 4226 2
+ 9872 27999 4314 2
+ 9752 28028 4395 2
+ 9630 28053 4502 2
+ 9490 28095 4541 2
+ 9368 28121 4629 2
+ 9262 28139 4736 2
+ 9175 28146 4860 2
+ 9074 28159 4975 2
+ 9054 28143 5097 2
+ 9109 28105 5207 2
+ 9257 28054 5225 2
+ 9381 28011 5233 2
+ 9463 27955 5382 2
+ 9473 27929 5496 2
+ 9535 27888 5600 2
+ 9416 27921 5637 2
+ 9303 27976 5547 2
+ 9210 28003 5569 2
+ 9214 27971 5718 2
+ 9210 27939 5881 2
+ 9150 27931 6012 2
+ 9065 27934 6124 2
+ 9030 27913 6271 2
+ 9071 27866 6420 2
+ 8994 27864 6533 2
+ 8907 27884 6571 2
+ 8817 27940 6451 2
+ 8729 27988 6361 2
+ 8721 28005 6297 2
+ 8668 27985 6459 2
+ 8658 27954 6606 2
+ 8713 27920 6675 2
+ 8699 27905 6756 2
+ 8625 27898 6878 2
+ 8581 27876 7022 2
+ 8579 27833 7193 2
+ 8565 27804 7321 2
+ 8546 27770 7470 2
+ 8505 27745 7608 2
+ 8531 27707 7717 2
+ 8616 27649 7828 2
+ 8669 27598 7948 2
+ 8599 27579 8091 2
+ 8531 27581 8155 2
+ 8372 27625 8172 2
+ 8237 27667 8166 2
+ 8126 27714 8118 2
+ 8112 27760 7973 2
+ 8189 27778 7832 2
+ 8192 27804 7736 2
+ 8064 27853 7692 2
+ 7914 27902 7671 2
+ 7773 27926 7728 2
+ 7673 27922 7842 2
+ 7583 27919 7938 2
+ 7805 27836 8014 2
+ 7867 27792 8105 2
+ 7941 27737 8223 2
+ 8031 27668 8365 2
+ 8173 27627 8365 2
+ 8290 27566 8447 2
+ 8356 27512 8559 2
+ 8420 27453 8686 2
+ 8459 27415 8766 2
+ 8345 27439 8801 2
+ 8185 27494 8780 2
+ 8069 27501 8865 2
+ 8048 27451 9037 2
+ 8018 27413 9178 2
+ 7974 27380 9314 2
+ 7956 27336 9457 2
+ 7971 27286 9589 2
+ 8096 27228 9650 2
+ 8230 27173 9689 2
+ 8317 27108 9797 2
+ 8209 27101 9908 2
+ 8038 27131 9965 2
+ 7916 27139 10041 2
+ 7755 27191 10025 2
+ 7598 27223 10059 2
+ 7584 27169 10215 2
+ 7684 27115 10282 2
+ 7834 27059 10317 2
+ 7970 27042 10258 2
+ 8091 26966 10362 2
+ 8029 26931 10501 2
+ 7886 26949 10563 2
+ 7748 26987 10567 2
+ 7608 27034 10549 2
+ 7469 27054 10597 2
+ 7335 27118 10528 2
+ 7252 27179 10427 2
+ 7144 27236 10352 2
+ 7067 27288 10267 2
+ 7032 27354 10115 2
+ 6935 27407 10037 2
+ 6782 27452 10020 2
+ 6643 27487 10016 2
+ 6521 27530 9978 2
+ 6376 27578 9939 2
+ 6245 27628 9884 2
+ 6210 27645 9859 2
+ 6347 27623 9833 2
+ 6519 27571 9866 2
+ 6639 27555 9830 2
+ 6765 27532 9810 2
+ 6928 27501 9782 2
+ 7072 27479 9741 2
+ 7209 27467 9675 2
+ 7347 27448 9623 2
+ 7488 27425 9582 2
+ 7610 27422 9494 2
+ 7699 27439 9371 2
+ 7761 27468 9236 2
+ 7788 27507 9093 2
+ 7780 27557 8950 2
+ 7744 27611 8813 2
+ 7647 27665 8727 2
+ 7529 27723 8647 2
+ 7400 27768 8611 2
+ 7276 27803 8606 2
+ 7143 27836 8610 2
+ 6979 27870 8636 2
+ 6872 27890 8656 2
+ 6684 27944 8629 2
+ 6538 27978 8629 2
+ 6388 28012 8632 2
+ 6243 28042 8642 2
+ 6116 28050 8705 2
+ 5971 28064 8760 2
+ 5886 28053 8852 2
+ 5854 28039 8919 2
+ 5748 28084 8846 2
+ 5611 28104 8870 2
+ 5569 28130 8813 2
+ 5642 28141 8732 2
+ 5474 28163 8769 2
+ 5421 28136 8887 2
+ 5263 28151 8935 2
+ 5195 28145 8993 2
+ 5107 28161 8994 2
+ 5004 28195 8944 2
+ 4936 28213 8925 2
+ 5125 28209 8832 2
+ 5188 28243 8686 2
+ 5100 28278 8623 2
+ 4969 28303 8615 2
+ 4810 28329 8623 2
+ 4749 28302 8744 2
+ 4775 28261 8862 2
+ 4790 28233 8943 2
+ 4690 28292 8807 2
+ 4651 28335 8690 2
+ 4603 28370 8600 2
+ 4511 28357 8692 2
+ 4535 28307 8840 2
+ 4488 28285 8933 2
+ 4385 28336 8822 2
+ 4355 28282 9009 2
+ 4351 28237 9150 2
+ 4308 28227 9202 2
+ 4264 28284 9046 2
+ 4261 28339 8874 2
+ 4148 28348 8897 2
+ 4102 28319 9012 2
+ 4082 28277 9152 2
+ 4031 28234 9307 2
+ 4023 28197 9421 2
+ 3881 28224 9400 2
+ 3743 28234 9425 2
+ 3746 28213 9488 2
+ 3845 28186 9526 2
+ 3846 28162 9597 2
+ 3713 28170 9625 2
+ 3662 28136 9744 2
+ 3682 28097 9849 2
+ 3633 28083 9906 2
+ 3614 28146 9734 2
+ 3551 28164 9704 2
+ 3554 28112 9852 2
+ 3527 28106 9881 2
+ 3446 28144 9801 2
+ 3445 28097 9933 2
+ 3486 28069 9999 2
+ 3386 28081 9999 2
+ 3329 28067 10059 2
+ 3251 28017 10220 2
+ 3270 27967 10352 2
+ 3160 27936 10470 2
+ 3197 27904 10542 2
+ 3318 27891 10539 2
+ 3263 27874 10600 2
+ 3144 27869 10651 2
+ 3166 27837 10726 2
+ 3158 27807 10807 2
+ 3030 27841 10756 2
+ 3017 27807 10848 2
+ 2949 27769 10963 2
+ 3053 27744 10998 2
+ 3031 27706 11099 2
+ 2934 27698 11145 2
+ 2944 27667 11220 2
+ 3040 27652 11231 2
+ 2890 27626 11333 2
+ 2801 27585 11455 2
+ 2772 27536 11579 2
+ 2767 27477 11721 2
+ 2869 27452 11755 2
+ 2727 27417 11868 2
+ 2716 27375 11969 2
+ 2699 27314 12110 2
+ 2731 27249 12250 2
+ 2666 27200 12371 2
+ 2550 27175 12451 2
+ 2538 27153 12500 2
+ 2612 27157 12476 2
+ 2580 27092 12625 2
+ 2493 27070 12689 2
+ 2386 27051 12750 2
+ 2312 26998 12875 2
+ 2282 26944 12992 2
+ 2262 26897 13094 2
+ 2365 26857 13157 2
+ 2486 26895 13057 2
+ 2497 26940 12962 2
+ 2580 26955 12914 2
+ 2575 26903 13023 2
+ 2501 26854 13138 2
+ 2376 26817 13237 2
+ 2298 26838 13209 2
+ 2193 26862 13177 2
+ 2128 26826 13261 2
+ 2011 26772 13387 2
+ 1999 26729 13475 2
+ 2002 26709 13514 2
+ 1909 26726 13493 2
+ 1949 26690 13560 2
+ 1762 26722 13522 2
+ 1694 26687 13599 2
+ 1836 26668 13618 2
+ 1880 26662 13625 2
+ 1773 26631 13698 2
+ 1603 26636 13709 2
+ 1565 26607 13770 2
+ 1703 26572 13821 2
+ 1722 26542 13877 2
+ 1583 26572 13836 2
+ 1557 26550 13881 2
+ 1478 26532 13924 2
+ 1468 26512 13963 2
+ 1349 26517 13965 2
+ 1276 26502 14000 2
+ 1327 26468 14060 2
+ 1462 26459 14064 2
+ 1550 26446 14079 2
+ 1346 26452 14087 2
+ 1288 26398 14194 2
+ 1329 26336 14305 2
+ 1317 26276 14416 2
+ 1482 26279 14394 2
+ 1623 26288 14364 2
+ 1704 26297 14338 2
+ 1825 26302 14313 2
+ 1871 26312 14290 2
+ 1806 26241 14427 2
+ 1693 26256 14414 2
+ 1528 26262 14422 2
+ 1391 26252 14453 2
+ 1320 26213 14530 2
+ 1364 26158 14626 2
+ 1420 26106 14713 2
+ 1360 26055 14808 2
+ 1436 26047 14816 2
+ 1468 26040 14825 2
+ 1526 26010 14871 2
+ 1617 26084 14731 2
+ 1750 26098 14691 2
+ 1649 26040 14806 2
+ 1533 25966 14947 2
+ 1555 25930 15008 2
+ 1591 25921 15020 2
+ 1463 25882 15099 2
+ 1418 25820 15210 2
+ 1514 25816 15207 2
+ 1603 25840 15157 2
+ 1672 25856 15121 2
+ 1645 25788 15240 2
+ 1637 25715 15365 2
+ 1689 25701 15382 2
+ 1526 25696 15408 2
+ 1515 25616 15541 2
+ 1628 25560 15622 2
+ 1792 25519 15670 2
+ 1885 25475 15732 2
+ 2005 25448 15760 2
+ 2144 25460 15722 2
+ 2258 25492 15654 2
+ 2371 25548 15546 2
+ 2462 25623 15408 2
+ 2533 25673 15313 2
+ 2618 25721 15217 2
+ 2747 25744 15155 2
+ 2763 25823 15018 2
+ 2742 25883 14918 2
+ 2787 25922 14842 2
+ 2830 25820 15010 2
+ 2930 25760 15095 2
+ 3016 25718 15149 2
+ 3038 25627 15298 2
+ 3115 25545 15419 2
+ 3217 25506 15463 2
+ 3247 25404 15623 2
+ 3299 25336 15723 2
+ 3378 25260 15828 2
+ 3459 25185 15929 2
+ 3559 25113 16021 2
+ 3666 25031 16124 2
+ 3646 24951 16253 2
+ 3689 24874 16361 2
+ 3786 24796 16456 2
+ 3817 24705 16586 2
+ 3969 24682 16584 2
+ 4108 24697 16529 2
+ 4193 24734 16451 2
+ 4147 24818 16335 2
+ 4229 24884 16214 2
+ 4322 24918 16138 2
+ 4462 24920 16096 2
+ 4582 24927 16052 2
+ 4609 25021 15897 2
+ 4642 25092 15775 2
+ 4632 25177 15642 2
+ 4615 25259 15513 2
+ 4593 25336 15395 2
+ 4557 25411 15282 2
+ 4557 25482 15163 2
+ 4515 25560 15043 2
+ 4431 25611 14981 2
+ 4413 25619 14973 2
+ 4571 25630 14906 2
+ 4663 25674 14802 2
+ 4722 25717 14708 2
+ 4831 25767 14584 2
+ 4827 25810 14509 2
+ 4661 25786 14607 2
+ 4526 25804 14618 2
+ 4382 25834 14608 2
+ 4295 25851 14604 2
+ 4462 25863 14532 2
+ 4581 25863 14495 2
+ 4583 25894 14440 2
+ 4732 25820 14524 2
+ 4813 25849 14446 2
+ 4887 25912 14306 2
+ 4857 25975 14203 2
+ 4720 26039 14131 2
+ 4602 26095 14066 2
+ 4472 26131 14043 2
+ 4356 26173 14001 2
+ 4292 26248 13879 2
+ 4251 26322 13751 2
+ 4222 26397 13616 2
+ 4232 26446 13517 2
+ 4217 26526 13363 2
+ 4177 26595 13239 2
+ 4253 26641 13121 2
+ 4246 26698 13008 2
+ 4315 26739 12900 2
+ 4386 26786 12778 2
+ 4471 26840 12634 2
+ 4564 26876 12523 2
+ 4639 26907 12429 2
+ 4687 26968 12278 2
+ 4714 27028 12136 2
+ 4721 27082 12013 2
+ 4623 27137 11926 2
+ 4634 27199 11780 2
+ 4601 27262 11645 2
+ 4650 27307 11519 2
+ 4649 27326 11475 2
+ 4692 27337 11430 2
+ 4737 27368 11338 2
+ 4873 27360 11300 2
+ 5015 27362 11232 2
+ 5136 27355 11194 2
+ 5304 27299 11253 2
+ 5373 27236 11372 2
+ 5427 27171 11501 2
+ 5325 27142 11617 2
+ 5306 27083 11763 2
+ 5274 27029 11901 2
+ 5239 26975 12039 2
+ 5189 26925 12170 2
+ 5132 26884 12284 2
+ 5098 26829 12419 2
+ 5046 26780 12544 2
+ 4985 26750 12633 2
+ 4964 26685 12778 2
+ 4988 26619 12906 2
+ 5066 26560 12996 2
+ 5124 26484 13127 2
+ 5222 26414 13231 2
+ 5261 26356 13329 2
+ 5296 26270 13484 2
+ 5325 26203 13603 2
+ 5420 26133 13701 2
+ 5546 26101 13711 2
+ 5707 26058 13727 2
+ 5825 26030 13729 2
+ 5913 25966 13814 2
+ 5924 25940 13857 2
+ 6004 25978 13751 2
+ 6160 25987 13664 2
+ 6249 26015 13571 2
+ 6350 26036 13483 2
+ 6475 26067 13363 2
+ 6562 26093 13269 2
+ 6653 26107 13198 2
+ 6796 26113 13112 2
+ 6911 26120 13038 2
+ 7047 26132 12941 2
+ 7179 26056 13020 2
+ 7319 26027 13001 2
+ 7453 26007 12965 2
+ 7515 25962 13020 2
+ 7325 25971 13110 2
+ 7250 25933 13226 2
+ 7150 25908 13329 2
+ 7137 25841 13465 2
+ 7006 25833 13548 2
+ 6861 25849 13593 2
+ 6715 25870 13625 2
+ 6578 25876 13680 2
+ 6471 25852 13777 2
+ 6354 25843 13848 2
+ 6249 25810 13958 2
+ 6151 25769 14075 2
+ 6172 25703 14186 2
+ 6245 25635 14278 2
+ 6342 25547 14392 2
+ 6500 25522 14366 2
+ 6566 25441 14479 2
+ 6601 25362 14601 2
+ 6669 25281 14710 2
+ 6685 25207 14831 2
+ 6596 25159 14951 2
+ 6453 25188 14964 2
+ 6344 25261 14887 2
+ 6210 25322 14840 2
+ 6103 25358 14823 2
+ 5979 25321 14937 2
+ 5931 25257 15063 2
+ 5947 25177 15191 2
+ 5913 25106 15320 2
+ 5944 25013 15461 2
+ 5974 24940 15566 2
+ 6035 24857 15676 2
+ 6101 24774 15781 2
+ 6175 24687 15887 2
+ 6209 24609 15994 2
+ 6182 24549 16098 2
+ 6075 24587 16080 2
+ 6122 24674 15928 2
+ 6106 24726 15853 2
+ 6072 24607 16051 2
+ 5981 24562 16154 2
+ 5895 24526 16239 2
+ 5884 24440 16372 2
+ 5797 24388 16481 2
+ 5657 24381 16540 2
+ 5535 24438 16497 2
+ 5506 24495 16422 2
+ 5288 24516 16461 2
+ 5158 24495 16535 2
+ 5046 24455 16628 2
+ 4935 24417 16717 2
+ 4872 24361 16817 2
+ 4724 24329 16905 2
+ 4595 24304 16977 2
+ 4469 24272 17055 2
+ 4337 24257 17110 2
+ 4250 24266 17120 2
+ 4440 24208 17154 2
+ 4404 24177 17207 2
+ 4264 24218 17185 2
+ 4161 24299 17095 2
+ 4028 24337 17074 2
+ 3889 24388 17032 2
+ 3795 24384 17059 2
+ 3659 24320 17181 2
+ 3531 24282 17261 2
+ 3440 24260 17309 2
+ 3332 24297 17279 2
+ 3319 24378 17167 2
+ 3120 24391 17185 2
+ 3016 24446 17127 2
+ 2926 24514 17044 2
+ 2876 24554 16996 2
+ 2851 24643 16871 2
+ 2852 24734 16736 2
+ 2894 24798 16634 2
+ 2978 24858 16529 2
+ 3038 24926 16416 2
+ 3134 24977 16319 2
+ 3039 25022 16269 2
+ 2937 25055 16236 2
+ 2891 25163 16077 2
+ 2959 25235 15952 2
+ 2926 25319 15824 2
+ 2897 25347 15785 2
+ 2765 25303 15878 2
+ 2699 25232 16002 2
+ 2579 25199 16074 2
+ 2440 25178 16128 2
+ 2369 25100 16260 2
+ 2441 25075 16287 2
+ 2532 25160 16142 2
+ 2630 25169 16112 2
+ 2720 25159 16113 2
+ 2650 25066 16268 2
+ 2632 25049 16297 2
+ 2540 25078 16268 2
+ 2431 25036 16348 2
+ 2355 24998 16418 2
+ 2368 24944 16497 2
+ 2400 24854 16628 2
+ 2405 24756 16773 2
+ 2489 24717 16819 2
+ 2561 24618 16953 2
+ 2601 24535 17067 2
+ 2676 24459 17164 2
+ 2668 24395 17256 2
+ 2687 24347 17321 2
+ 2750 24268 17421 2
+ 2887 24210 17480 2
+ 2946 24166 17531 2
+ 2736 24224 17484 2
+ 2632 24198 17536 2
+ 2607 24115 17654 2
+ 2505 24138 17637 2
+ 2376 24177 17602 2
+ 2230 24150 17657 2
+ 2234 24070 17766 2
+ 2187 24059 17787 2
+ 2060 24098 17750 2
+ 1913 24086 17782 2
+ 1773 24058 17835 2
+ 1680 23995 17929 2
+ 1553 23941 18012 2
+ 1479 23892 18083 2
+ 1461 23801 18204 2
+ 1415 23716 18318 2
+ 1325 23638 18426 2
+ 1257 23573 18513 2
+ 1273 23528 18570 2
+ 1320 23492 18611 2
+ 1203 23471 18646 2
+ 1331 23433 18685 2
+ 1101 23437 18694 2
+ 966 23396 18753 2
+ 838 23347 18820 2
+ 695 23320 18859 2
+ 556 23279 18915 2
+ 524 23186 19030 2
+ 530 23088 19149 2
+ 495 23028 19221 2
+ 372 22964 19301 2
+ 228 22935 19338 2
+ 93 22888 19394 2
+ 81 22798 19500 2
+ -71 22746 19560 2
+ -220 22761 19542 2
+ -375 22776 19522 2
+ -461 22860 19422 2
+ -623 22853 19426 2
+ -571 22739 19561 2
+ -539 22648 19667 2
+ -530 22534 19797 2
+ -691 22509 19821 2
+ -824 22513 19811 2
+ -963 22503 19816 2
+ -1074 22577 19726 2
+ -1225 22559 19738 2
+ -1361 22533 19758 2
+ -1522 22517 19766 2
+ -1594 22444 19843 2
+ -1537 22381 19918 2
+ -1590 22294 20011 2
+ -1453 22244 20078 2
+ -1316 22225 20107 2
+ -1154 22193 20153 2
+ -1054 22148 20208 2
+ -935 22129 20235 2
+ -844 22054 20320 2
+ -711 22017 20365 2
+ -741 21900 20490 2
+ -674 21806 20593 2
+ -589 21741 20664 2
+ -443 21680 20731 2
+ -399 21576 20840 2
+ -408 21482 20937 2
+ -305 21393 21030 2
+ -253 21294 21131 2
+ -230 21237 21188 2
+ -345 21379 21043 2
+ -416 21376 21045 2
+ -438 21267 21155 2
+ -457 21160 21261 2
+ -443 21082 21339 2
+ -483 20946 21472 2
+ -511 20839 21575 2
+ -543 20733 21676 2
+ -617 20634 21768 2
+ -755 20592 21803 2
+ -901 20592 21798 2
+ -1044 20625 21761 2
+ -1186 20609 21769 2
+ -1337 20643 21727 2
+ -1476 20640 21721 2
+ -1648 20618 21730 2
+ -1793 20627 21709 2
+ -1938 20651 21674 2
+ -2076 20674 21640 2
+ -2224 20697 21603 2
+ -2383 20684 21599 2
+ -2530 20680 21585 2
+ -2678 20675 21573 2
+ -2819 20725 21506 2
+ -2947 20740 21475 2
+ -3086 20698 21496 2
+ -3148 20619 21563 2
+ -3359 20574 21573 2
+ -3482 20518 21608 2
+ -3514 20430 21686 2
+ -3437 20341 21781 2
+ -3384 20265 21860 2
+ -3386 20172 21946 2
+ -3431 20046 22054 2
+ -3433 19944 22146 2
+ -3431 19829 22249 2
+ -3409 19721 22348 2
+ -3436 19606 22446 2
+ -3444 19552 22491 2
+ -3527 19366 22639 2
+ -3573 19268 22715 2
+ -3639 19160 22796 2
+ -3722 19058 22868 2
+ -3786 18974 22927 2
+ -3830 18855 23018 2
+ -3811 18762 23097 2
+ -3685 18815 23075 2
+ -3624 18854 23052 2
+ -3746 18723 23139 2
+ -3699 18660 23197 2
+ -3590 18650 23223 2
+ -3628 18498 23338 2
+ -3629 18377 23433 2
+ -3648 18263 23519 2
+ -3697 18146 23602 2
+ -3679 18079 23657 2
+ -3510 18094 23671 2
+ -3357 18069 23711 2
+ -3224 18075 23725 2
+ -3082 18129 23703 2
+ -2925 18142 23713 2
+ -2841 18123 23738 2
+ -2720 18037 23818 2
+ -2650 17970 23876 2
+ -2620 17835 23980 2
+ -2541 17721 24073 2
+ -2414 17657 24133 2
+ -2286 17690 24121 2
+ -2194 17791 24056 2
+ -2054 17841 24031 2
+ -1916 17880 24014 2
+ -1793 17936 23981 2
+ -1642 17947 23984 2
+ -1491 17939 24000 2
+ -1343 17950 24000 2
+ -1191 17937 24018 2
+ -1057 17973 23997 2
+ -898 17969 24006 2
+ -792 18064 23939 2
+ -723 18176 23856 2
+ -609 18254 23800 2
+ -468 18289 23776 2
+ -335 18326 23750 2
+ -296 18441 23661 2
+ -238 18560 23569 2
+ -148 18648 23500 2
+ -17 18713 23448 2
+ 44 18799 23379 2
+ -78 18901 23297 2
+ -121 19012 23206 2
+ -108 19123 23115 2
+ -35 19225 23031 2
+ 52 19318 22952 2
+ 145 19409 22875 2
+ 226 19509 22789 2
+ 303 19569 22737 2
+ 391 19690 22631 2
+ 525 19732 22591 2
+ 672 19765 22559 2
+ 816 19797 22525 2
+ 926 19873 22455 2
+ 1058 19929 22399 2
+ 1182 19988 22340 2
+ 1255 20078 22255 2
+ 1255 20189 22155 2
+ 1199 20302 22054 2
+ 1176 20414 21952 2
+ 1210 20505 21865 2
+ 1330 20578 21789 2
+ 1450 20647 21717 2
+ 1553 20669 21688 2
+ 1721 20621 21721 2
+ 1835 20629 21704 2
+ 1950 20623 21700 2
+ 2078 20550 21757 2
+ 2231 20504 21786 2
+ 2372 20498 21776 2
+ 2516 20552 21709 2
+ 2598 20632 21623 2
+ 2710 20701 21543 2
+ 2831 20751 21480 2
+ 2976 20782 21431 2
+ 3075 20851 21350 2
+ 3155 20935 21255 2
+ 3276 20992 21180 2
+ 3425 20967 21182 2
+ 3559 20916 21210 2
+ 3695 20866 21236 2
+ 3825 20806 21271 2
+ 3877 20701 21364 2
+ 3947 20602 21447 2
+ 4002 20496 21538 2
+ 4071 20421 21597 2
+ 4193 20346 21644 2
+ 4295 20247 21717 2
+ 4436 20203 21730 2
+ 4552 20113 21789 2
+ 4679 20044 21826 2
+ 4784 19956 21883 2
+ 4910 19873 21930 2
+ 5045 19815 21952 2
+ 5168 19787 21949 2
+ 5315 19772 21927 2
+ 5441 19702 21960 2
+ 5546 19614 22012 2
+ 5678 19544 22040 2
+ 5833 19520 22021 2
+ 5907 19403 22104 2
+ 6020 19323 22145 2
+ 6155 19297 22130 2
+ 6262 19218 22169 2
+ 6331 19108 22244 2
+ 6413 19002 22311 2
+ 6473 18888 22391 2
+ 6499 18784 22471 2
+ 6421 18707 22557 2
+ 6398 18593 22658 2
+ 6372 18494 22746 2
+ 6487 18438 22759 2
+ 6570 18503 22682 2
+ 6638 18596 22586 2
+ 6691 18687 22495 2
+ 6690 18799 22402 2
+ 6818 18847 22323 2
+ 6867 18912 22253 2
+ 6816 19034 22164 2
+ 6688 19112 22136 2
+ 6563 19183 22112 2
+ 6571 19300 22008 2
+ 6610 19403 21905 2
+ 6696 19479 21811 2
+ 6800 19446 21809 2
+ 6964 19401 21797 2
+ 7078 19330 21823 2
+ 7167 19237 21877 2
+ 7264 19249 21834 2
+ 7254 19367 21732 2
+ 7141 19461 21686 2
+ 7018 19539 21655 2
+ 6874 19596 21650 2
+ 6741 19661 21633 2
+ 6602 19720 21623 2
+ 6459 19762 21627 2
+ 6317 19811 21624 2
+ 6176 19890 21593 2
+ 6190 20015 21473 2
+ 6018 20042 21497 2
+ 5873 20043 21536 2
+ 5731 20084 21536 2
+ 5607 20153 21504 2
+ 5480 20230 21464 2
+ 5365 20314 21414 2
+ 5285 20415 21337 2
+ 5223 20522 21250 2
+ 5147 20626 21168 2
+ 5045 20700 21120 2
+ 4908 20765 21089 2
+ 4775 20828 21057 2
+ 4649 20897 21017 2
+ 4568 20994 20938 2
+ 4530 21103 20837 2
+ 4564 21194 20736 2
+ 4475 21311 20635 2
+ 4535 21397 20533 2
+ 4663 21427 20473 2
+ 4772 21478 20394 2
+ 4916 21475 20363 2
+ 4953 21407 20425 2
+ 4965 21303 20531 2
+ 5035 21212 20608 2
+ 5140 21176 20620 2
+ 5194 21263 20516 2
+ 5276 21322 20434 2
+ 5413 21248 20474 2
+ 5469 21149 20563 2
+ 5541 21052 20642 2
+ 5664 20975 20688 2
+ 5665 20924 20739 2
+ 5783 20802 20829 2
+ 5917 20730 20863 2
+ 6024 20657 20904 2
+ 6175 20653 20865 2
+ 6328 20604 20866 2
+ 6458 20532 20898 2
+ 6594 20458 20928 2
+ 6625 20426 20950 2
+ 6503 20447 20968 2
+ 6716 20382 20963 2
+ 6855 20327 20972 2
+ 6999 20254 20995 2
+ 7102 20219 20994 2
+ 7250 20128 21031 2
+ 7362 20042 21074 2
+ 7500 19965 21098 2
+ 7490 19869 21193 2
+ 7525 19757 21284 2
+ 7547 19647 21378 2
+ 7565 19514 21494 2
+ 7598 19423 21565 2
+ 7738 19326 21601 2
+ 7852 19245 21633 2
+ 7935 19141 21695 2
+ 8023 19053 21740 2
+ 8152 18959 21774 2
+ 8287 18893 21780 2
+ 8356 18853 21788 2
+ 8333 18774 21866 2
+ 8448 18664 21916 2
+ 8537 18626 21913 2
+ 8663 18608 21879 2
+ 8822 18625 21801 2
+ 8964 18622 21745 2
+ 9094 18593 21717 2
+ 9213 18508 21739 2
+ 8985 18532 21814 2
+ 8847 18582 21828 2
+ 8728 18574 21883 2
+ 8608 18525 21971 2
+ 8566 18415 22079 2
+ 8677 18313 22121 2
+ 8799 18210 22158 2
+ 8818 18083 22254 2
+ 8938 17994 22278 2
+ 9051 18027 22206 2
+ 9153 17918 22253 2
+ 9216 17869 22265 2
+ 9305 17945 22167 2
+ 9424 17853 22191 2
+ 9461 17866 22165 2
+ 9404 17983 22095 2
+ 9324 18104 22030 2
+ 9233 18214 21978 2
+ 9258 18272 21919 2
+ 9392 18209 21914 2
+ 9439 18281 21834 2
+ 9318 18370 21811 2
+ 9297 18443 21758 2
+ 9441 18464 21678 2
+ 9569 18394 21682 2
+ 9656 18385 21651 2
+ 9605 18531 21548 2
+ 9486 18608 21535 2
+ 9350 18673 21538 2
+ 9229 18736 21536 2
+ 9078 18791 21552 2
+ 9017 18833 21541 2
+ 9080 18916 21441 2
+ 9071 19001 21370 2
+ 9156 18963 21368 2
+ 9023 19116 21288 2
+ 8922 19219 21237 2
+ 8816 19319 21191 2
+ 8789 19444 21087 2
+ 8857 19493 21014 2
+ 8991 19400 21043 2
+ 9103 19308 21079 2
+ 9178 19291 21063 2
+ 9142 19381 20995 2
+ 9276 19302 21009 2
+ 9317 19313 20981 2
+ 9250 19409 20922 2
+ 9363 19402 20878 2
+ 9194 19518 20845 2
+ 9205 19584 20779 2
+ 9330 19607 20701 2
+ 9426 19646 20621 2
+ 9551 19651 20558 2
+ 9656 19664 20496 2
+ 9805 19629 20458 2
+ 9954 19600 20415 2
+ 10070 19524 20430 2
+ 10210 19535 20351 2
+ 10238 19494 20375 2
+ 10135 19426 20491 2
+ 10170 19354 20543 2
+ 10266 19466 20389 2
+ 10364 19523 20284 2
+ 10439 19593 20178 2
+ 10495 19675 20069 2
+ 10623 19688 19988 2
+ 10750 19700 19909 2
+ 10862 19682 19865 2
+ 10957 19744 19752 2
+ 10812 19815 19760 2
+ 10671 19867 19785 2
+ 10549 19945 19772 2
+ 10477 20050 19704 2
+ 10372 20156 19651 2
+ 10254 20242 19624 2
+ 10249 20317 19549 2
+ 10292 20394 19447 2
+ 10255 20514 19339 2
+ 10294 20603 19224 2
+ 10396 20644 19124 2
+ 10363 20766 19010 2
+ 10331 20877 18906 2
+ 10301 20977 18811 2
+ 10304 21072 18703 2
+ 10326 21156 18596 2
+ 10486 21161 18500 2
+ 10473 21269 18383 2
+ 10430 21373 18287 2
+ 10392 21468 18198 2
+ 10464 21493 18127 2
+ 10546 21593 17959 2
+ 10573 21683 17834 2
+ 10584 21771 17720 2
+ 10695 21804 17613 2
+ 10771 21835 17528 2
+ 10859 21860 17441 2
+ 10800 21950 17365 2
+ 10779 21976 17345 2
+ 10877 21864 17426 2
+ 10985 21793 17447 2
+ 11054 21777 17423 2
+ 10874 21773 17541 2
+ 10851 21759 17572 2
+ 10965 21694 17582 2
+ 11123 21627 17566 2
+ 11255 21622 17488 2
+ 11380 21632 17394 2
+ 11514 21599 17347 2
+ 11561 21533 17398 2
+ 11462 21488 17518 2
+ 11382 21433 17637 2
+ 11370 21354 17740 2
+ 11552 21297 17692 2
+ 11686 21253 17656 2
+ 11764 21151 17726 2
+ 11801 21047 17826 2
+ 11949 20988 17797 2
+ 12038 21032 17684 2
+ 12078 21111 17563 2
+ 12179 21144 17453 2
+ 12258 21185 17348 2
+ 12323 21241 17233 2
+ 12467 21218 17158 2
+ 12559 21250 17050 2
+ 12517 21358 16945 2
+ 12358 21365 17052 2
+ 12268 21332 17160 2
+ 12136 21387 17185 2
+ 12018 21477 17156 2
+ 11915 21575 17105 2
+ 11887 21665 17010 2
+ 11957 21685 16935 2
+ 12037 21774 16763 2
+ 12129 21815 16644 2
+ 12213 21834 16557 2
+ 12320 21847 16459 2
+ 12405 21908 16315 2
+ 12467 21960 16197 2
+ 12592 21967 16090 2
+ 12678 21997 15982 2
+ 12750 22011 15904 2
+ 12904 22002 15793 2
+ 12900 21940 15882 2
+ 12820 21896 16006 2
+ 12779 21839 16117 2
+ 12665 21812 16243 2
+ 12652 21773 16306 2
+ 12767 21710 16299 2
+ 12912 21641 16277 2
+ 12920 21608 16315 2
+ 12871 21566 16409 2
+ 12839 21547 16458 2
+ 12835 21412 16637 2
+ 12865 21336 16711 2
+ 12746 21325 16817 2
+ 12636 21333 16889 2
+ 12662 21258 16963 2
+ 12824 21204 16910 2
+ 12944 21118 16925 2
+ 13078 21087 16862 2
+ 13205 21023 16843 2
+ 13338 20971 16802 2
+ 13470 20926 16753 2
+ 13601 20855 16735 2
+ 13732 20779 16724 2
+ 13860 20697 16719 2
+ 13990 20622 16703 2
+ 14127 20550 16676 2
+ 14252 20500 16632 2
+ 14383 20457 16572 2
+ 14508 20382 16556 2
+ 14631 20309 16538 2
+ 14725 20200 16587 2
+ 14824 20092 16630 2
+ 14896 19979 16702 2
+ 14890 19885 16819 2
+ 14853 19811 16939 2
+ 14780 19759 17063 2
+ 14710 19705 17185 2
+ 14621 19662 17310 2
+ 14499 19676 17397 2
+ 14367 19709 17468 2
+ 14255 19701 17569 2
+ 14157 19668 17685 2
+ 14051 19654 17784 2
+ 13915 19683 17859 2
+ 13800 19714 17914 2
+ 13668 19736 17990 2
+ 13542 19799 18017 2
+ 13423 19803 18101 2
+ 13309 19828 18158 2
+ 13176 19942 18131 2
+ 13068 19938 18212 2
+ 12937 19969 18272 2
+ 12826 20070 18239 2
+ 12738 20075 18296 2
+ 12626 20055 18395 2
+ 12498 20062 18475 2
+ 12368 20069 18555 2
+ 12241 20071 18636 2
+ 12140 20032 18745 2
+ 12034 19997 18849 2
+ 11952 19945 18956 2
+ 11872 19883 19071 2
+ 11787 19827 19183 2
+ 11741 19748 19291 2
+ 11629 19713 19394 2
+ 11493 19735 19453 2
+ 11363 19748 19516 2
+ 11232 19743 19598 2
+ 11096 19761 19657 2
+ 10989 19740 19738 2
+ 11054 19641 19800 2
+ 11174 19594 19779 2
+ 11260 19572 19752 2
+ 11083 19544 19880 2
+ 11046 19467 19975 2
+ 10920 19437 20074 2
+ 10788 19440 20142 2
+ 10663 19454 20195 2
+ 10523 19428 20294 2
+ 10403 19454 20330 2
+ 10282 19429 20416 2
+ 10208 19352 20526 2
+ 10156 19262 20636 2
+ 10174 19147 20733 2
+ 10237 19073 20770 2
+ 10371 19100 20679 2
+ 10458 19065 20667 2
+ 10452 18970 20758 2
+ 10572 18843 20813 2
+ 10573 18731 20913 2
+ 10607 18645 20973 2
+ 10449 18683 21018 2
+ 10491 18567 21100 2
+ 10669 18512 21059 2
+ 10813 18448 21042 2
+ 10837 18329 21133 2
+ 10927 18219 21182 2
+ 11022 18132 21207 2
+ 11018 18054 21276 2
+ 11158 18056 21201 2
+ 11286 18067 21124 2
+ 11313 18033 21138 2
+ 11247 17973 21225 2
+ 11157 17939 21300 2
+ 11341 17930 21210 2
+ 11476 17968 21106 2
+ 11627 17916 21067 2
+ 11718 17861 21064 2
+ 11827 17756 21091 2
+ 11966 17709 21053 2
+ 12077 17719 20981 2
+ 12201 17746 20886 2
+ 12257 17801 20806 2
+ 12237 17920 20715 2
+ 12279 17994 20626 2
+ 12415 17984 20553 2
+ 12548 17947 20505 2
+ 12687 17890 20469 2
+ 12820 17831 20438 2
+ 12937 17733 20449 2
+ 13067 17664 20427 2
+ 13192 17665 20345 2
+ 13302 17690 20252 2
+ 13418 17705 20162 2
+ 13509 17757 20055 2
+ 13557 17853 19936 2
+ 13618 17934 19822 2
+ 13721 17960 19728 2
+ 13854 17905 19685 2
+ 13983 17881 19615 2
+ 14025 17938 19533 2
+ 14143 17988 19401 2
+ 14201 17874 19464 2
+ 14153 17779 19585 2
+ 14234 17656 19638 2
+ 14247 17542 19730 2
+ 14287 17429 19802 2
+ 14378 17307 19843 2
+ 14414 17187 19921 2
+ 14489 17065 19971 2
+ 14485 16966 20058 2
+ 14461 16867 20159 2
+ 14473 16745 20252 2
+ 14469 16631 20349 2
+ 14460 16517 20447 2
+ 14461 16404 20538 2
+ 14463 16279 20635 2
+ 14464 16165 20724 2
+ 14484 16040 20807 2
+ 14493 15917 20895 2
+ 14487 15800 20988 2
+ 14460 15691 21088 2
+ 14408 15597 21193 2
+ 14322 15533 21298 2
+ 14208 15507 21393 2
+ 14078 15499 21485 2
+ 13981 15495 21551 2
+ 13892 15488 21613 2
+ 13737 15510 21696 2
+ 13787 15343 21784 2
+ 13821 15232 21839 2
+
+
+ -14284 23878 -11217 0
+ -14366 23773 -11334 2
+ -14381 23798 -11262 2
+ -14441 23767 -11252 2
+ -14520 23748 -11190 2
+ -14511 23858 -10965 2
+ -14557 23797 -11037 2
+ -14711 23712 -11015 2
+ -14671 23719 -11053 2
+ -14617 23683 -11201 2
+ -14616 23636 -11300 2
+ -14738 23517 -11390 2
+ -14835 23548 -11200 2
+ -14810 23527 -11277 2
+ -14813 23454 -11423 2
+ -14904 23423 -11368 2
+ -14893 23387 -11457 2
+ -15052 23290 -11445 2
+ -15122 23286 -11363 2
+ -15216 23288 -11232 2
+ -15334 23232 -11187 2
+ -15377 23283 -11020 2
+ -15417 23237 -11063 2
+ -15383 23183 -11222 2
+ -15458 23146 -11195 2
+ -15517 23165 -11073 2
+ -15610 23149 -10975 2
+ -15550 23248 -10849 2
+ -15571 23237 -10844 2
+ -15664 23121 -10957 2
+ -15739 23126 -10837 2
+ -15757 23102 -10865 2
+ -15832 23001 -10969 2
+ -15940 22926 -10968 2
+ -16029 22923 -10845 2
+ -15974 23008 -10744 2
+ -16006 22989 -10738 2
+ -16129 22884 -10780 2
+ -16136 22857 -10826 2
+ -16179 22810 -10861 2
+ -16260 22827 -10702 2
+ -16376 22767 -10653 2
+ -16416 22710 -10713 2
+ -16521 22644 -10691 2
+ -16648 22565 -10662 2
+ -16753 22470 -10697 2
+ -16877 22364 -10725 2
+ -16975 22290 -10724 2
+ -17063 22178 -10816 2
+ -17155 22072 -10887 2
+ -17137 21993 -11073 2
+ -17108 22051 -11002 2
+ -17068 22129 -10909 2
+ -16988 22222 -10844 2
+ -16970 22215 -10886 2
+ -17015 22101 -11047 2
+ -16975 22142 -11027 2
+ -16945 22222 -10912 2
+ -16849 22317 -10865 2
+ -16754 22343 -10959 2
+ -16663 22350 -11081 2
+ -16562 22369 -11195 2
+ -16425 22412 -11311 2
+ -16477 22329 -11398 2
+ -16595 22237 -11407 2
+ -16712 22144 -11417 2
+ -16820 22048 -11446 2
+ -16963 21931 -11458 2
+ -17098 21801 -11506 2
+ -17148 21722 -11581 2
+ -17305 21666 -11451 2
+ -17258 21650 -11551 2
+ -17287 21584 -11631 2
+ -17380 21479 -11689 2
+ -17463 21381 -11743 2
+ -17547 21269 -11820 2
+ -17622 21164 -11898 2
+ -17713 21049 -11966 2
+ -17783 20950 -12036 2
+ -17864 20841 -12104 2
+ -17943 20734 -12171 2
+ -18015 20615 -12268 2
+ -18056 20521 -12363 2
+ -18121 20409 -12453 2
+ -18222 20303 -12479 2
+ -18309 20191 -12534 2
+ -18419 20087 -12540 2
+ -18517 19979 -12569 2
+ -18621 19869 -12588 2
+ -18696 19752 -12663 2
+ -18780 19626 -12733 2
+ -18805 19550 -12813 2
+ -18880 19424 -12895 2
+ -18995 19329 -12868 2
+ -19110 19239 -12833 2
+ -19213 19128 -12845 2
+ -19293 19009 -12901 2
+ -19390 18892 -12926 2
+ -19493 18794 -12916 2
+ -19608 18703 -12873 2
+ -19769 18574 -12814 2
+ -19827 18497 -12835 2
+ -19941 18426 -12761 2
+ -19948 18482 -12669 2
+ -20015 18509 -12521 2
+ -20105 18502 -12387 2
+ -20104 18492 -12405 2
+ -20020 18492 -12539 2
+ -19998 18440 -12651 2
+ -20129 18305 -12639 2
+ -20057 18332 -12713 2
+ -20113 18231 -12771 2
+ -20210 18116 -12782 2
+ -20320 18044 -12708 2
+ -20420 17970 -12653 2
+ -20462 17866 -12733 2
+ -20562 17744 -12742 2
+ -20675 17651 -12688 2
+ -20781 17549 -12657 2
+ -20884 17462 -12607 2
+ -20999 17364 -12552 2
+ -21099 17266 -12520 2
+ -21185 17145 -12539 2
+ -21276 17020 -12557 2
+ -21368 16980 -12453 2
+ -21452 16964 -12329 2
+ -21537 16946 -12206 2
+ -21651 16865 -12116 2
+ -21742 16806 -12035 2
+ -21822 16792 -11910 2
+ -21922 16702 -11852 2
+ -21997 16662 -11769 2
+ -22106 16587 -11671 2
+ -22206 16508 -11591 2
+ -22307 16408 -11541 2
+ -22395 16286 -11542 2
+ -22472 16183 -11538 2
+ -22576 16048 -11523 2
+ -22675 15935 -11486 2
+ -22779 15817 -11443 2
+ -22853 15700 -11456 2
+ -22951 15594 -11405 2
+ -23043 15470 -11389 2
+ -23136 15368 -11337 2
+ -23237 15218 -11334 2
+ -23311 15138 -11289 2
+ -23396 15000 -11296 2
+ -23484 14883 -11269 2
+ -23576 14802 -11183 2
+ -23666 14735 -11082 2
+ -23757 14659 -10987 2
+ -23851 14557 -10920 2
+ -23939 14466 -10848 2
+ -24027 14372 -10778 2
+ -24098 14242 -10792 2
+ -24159 14105 -10836 2
+ -24221 13981 -10857 2
+ -24199 13977 -10911 2
+ -24145 13987 -11019 2
+ -24062 14004 -11177 2
+ -24097 13936 -11185 2
+ -24187 13851 -11098 2
+ -24275 13743 -11037 2
+ -24358 13679 -10936 2
+ -24442 13610 -10833 2
+ -24537 13526 -10723 2
+ -24599 13539 -10564 2
+ -24680 13441 -10500 2
+ -24768 13352 -10405 2
+ -24847 13290 -10296 2
+ -24926 13196 -10226 2
+ -25041 13014 -10177 2
+ -25081 12944 -10169 2
+ -25137 12812 -10199 2
+ -25193 12665 -10244 2
+ -25251 12580 -10206 2
+ -25343 12471 -10109 2
+ -25432 12374 -10004 2
+ -25501 12306 -9913 2
+ -25578 12228 -9811 2
+ -25656 12134 -9724 2
+ -25733 12045 -9629 2
+ -25807 11959 -9538 2
+ -25880 11836 -9494 2
+ -25955 11697 -9463 2
+ -25996 11704 -9340 2
+ -25999 11795 -9216 2
+ -25961 11924 -9156 2
+ -25886 12033 -9226 2
+ -25811 12153 -9280 2
+ -25745 12245 -9341 2
+ -25662 12311 -9481 2
+ -25614 12324 -9595 2
+ -25540 12430 -9654 2
+ -25484 12566 -9626 2
+ -25416 12690 -9644 2
+ -25338 12805 -9697 2
+ -25260 12928 -9737 2
+ -25177 13041 -9802 2
+ -25107 13169 -9810 2
+ -25033 13302 -9820 2
+ -24959 13422 -9842 2
+ -24884 13493 -9936 2
+ -24829 13549 -9998 2
+ -24751 13669 -10028 2
+ -24667 13769 -10097 2
+ -24579 13888 -10148 2
+ -24494 13974 -10235 2
+ -24418 14100 -10245 2
+ -24335 14233 -10258 2
+ -24256 14316 -10330 2
+ -24160 14444 -10376 2
+ -24078 14524 -10455 2
+ -23986 14645 -10498 2
+ -23895 14748 -10559 2
+ -23804 14836 -10641 2
+ -23714 14919 -10728 2
+ -23620 15021 -10792 2
+ -23539 15143 -10797 2
+ -23465 15273 -10776 2
+ -23382 15404 -10769 2
+ -23296 15517 -10794 2
+ -23224 15648 -10759 2
+ -23121 15818 -10733 2
+ -23163 15806 -10661 2
+ -23253 15741 -10560 2
+ -23344 15699 -10421 2
+ -23389 15703 -10312 2
+ -23482 15610 -10244 2
+ -23570 15561 -10114 2
+ -23641 15482 -10071 2
+ -23707 15356 -10108 2
+ -23795 15239 -10079 2
+ -23882 15125 -10045 2
+ -23968 14992 -10038 2
+ -24055 14878 -10001 2
+ -24144 14763 -9956 2
+ -24222 14666 -9911 2
+ -24312 14535 -9882 2
+ -24401 14434 -9810 2
+ -24492 14321 -9750 2
+ -24577 14238 -9657 2
+ -24665 14127 -9596 2
+ -24754 14049 -9479 2
+ -24814 14026 -9356 2
+ -24876 13922 -9347 2
+ -24961 13781 -9330 2
+ -25041 13694 -9242 2
+ -25123 13628 -9116 2
+ -25208 13503 -9069 2
+ -25266 13479 -8942 2
+ -25364 13354 -8852 2
+ -25407 13270 -8855 2
+ -25438 13136 -8964 2
+ -25516 12999 -8941 2
+ -25568 12999 -8791 2
+ -25586 12957 -8803 2
+ -25620 12915 -8764 2
+ -25683 12850 -8674 2
+ -25800 12733 -8500 2
+ -25858 12644 -8454 2
+ -25903 12574 -8421 2
+ -26008 12438 -8299 2
+ -26045 12383 -8266 2
+ -26117 12300 -8164 2
+ -26188 12214 -8061 2
+ -26261 12114 -7976 2
+ -26333 12001 -7909 2
+ -26406 11894 -7827 2
+ -26474 11787 -7759 2
+ -26552 11677 -7658 2
+ -26615 11587 -7575 2
+ -26682 11475 -7511 2
+ -26746 11338 -7490 2
+ -26805 11202 -7484 2
+ -26874 11076 -7424 2
+ -26941 10971 -7337 2
+ -26998 10818 -7355 2
+ -27019 10689 -7463 2
+ -27072 10586 -7417 2
+ -27077 10495 -7531 2
+ -27102 10397 -7573 2
+ -27164 10264 -7533 2
+ -27229 10144 -7462 2
+ -27292 10037 -7375 2
+ -27358 9924 -7286 2
+ -27410 9858 -7177 2
+ -27465 9804 -7039 2
+ -27520 9735 -6920 2
+ -27576 9659 -6804 2
+ -27634 9556 -6714 2
+ -27693 9442 -6628 2
+ -27744 9383 -6497 2
+ -27792 9335 -6363 2
+ -27837 9292 -6226 2
+ -27880 9255 -6087 2
+ -27912 9252 -5945 2
+ -27959 9187 -5821 2
+ -28013 9084 -5722 2
+ -28062 9005 -5607 2
+ -28112 8922 -5489 2
+ -28156 8859 -5360 2
+ -28197 8812 -5223 2
+ -28238 8759 -5087 2
+ -28282 8700 -4944 2
+ -28324 8628 -4828 2
+ -28357 8601 -4682 2
+ -28389 8571 -4537 2
+ -28424 8531 -4395 2
+ -28469 8438 -4279 2
+ -28512 8380 -4107 2
+ -28545 8320 -3994 2
+ -28580 8253 -3878 2
+ -28605 8236 -3728 2
+ -28632 8209 -3582 2
+ -28667 8143 -3448 2
+ -28696 8103 -3299 2
+ -28710 8112 -3151 2
+ -28710 8164 -3012 2
+ -28709 8218 -2870 2
+ -28709 8269 -2725 2
+ -28698 8349 -2597 2
+ -28693 8405 -2463 2
+ -28700 8412 -2359 2
+ -28726 8357 -2236 2
+ -28756 8298 -2064 2
+ -28731 8360 -2154 2
+ -28738 8356 -2069 2
+ -28770 8274 -1952 2
+ -28805 8179 -1832 2
+ -28838 8088 -1716 2
+ -28871 7994 -1604 2
+ -28914 7866 -1446 2
+ -28936 7794 -1392 2
+ -28969 7688 -1291 2
+ -29001 7584 -1187 2
+ -29031 7488 -1076 2
+ -29058 7396 -959 2
+ -29082 7315 -835 2
+ -29102 7250 -701 2
+ -29114 7217 -555 2
+ -29115 7220 -403 2
+ -29121 7206 -254 2
+ -29134 7153 -114 2
+ -29150 7090 22 2
+ -29167 7019 146 2
+ -29171 6999 303 2
+ -29179 6955 446 2
+ -29195 6869 683 2
+ -29193 6872 755 2
+ -29197 6840 860 2
+ -29192 6838 1035 2
+ -29165 6937 1140 2
+ -29162 6925 1279 2
+ -29197 6760 1353 2
+ -29205 6746 1245 2
+ -29226 6651 1259 2
+ -29242 6561 1356 2
+ -29258 6469 1462 2
+ -29271 6377 1590 2
+ -29289 6269 1687 2
+ -29310 6147 1772 2
+ -29325 6044 1881 2
+ -29336 5952 1998 2
+ -29348 5854 2112 2
+ -29373 5705 2164 2
+ -29394 5577 2214 2
+ -29417 5466 2178 2
+ -29444 5336 2143 2
+ -29463 5196 2217 2
+ -29464 5133 2345 2
+ -29469 5036 2488 2
+ -29447 5107 2603 2
+ -29430 5265 2479 2
+ -29423 5267 2558 2
+ -29426 5186 2685 2
+ -29442 5054 2757 2
+ -29449 4964 2847 2
+ -29443 4915 2995 2
+ -29441 4843 3129 2
+ -29443 4751 3247 2
+ -29460 4611 3298 2
+ -29484 4475 3270 2
+ -29480 4390 3418 2
+ -29463 4498 3417 2
+ -29453 4494 3509 2
+ -29465 4376 3563 2
+ -29472 4247 3655 2
+ -29464 4270 3694 2
+ -29440 4332 3808 2
+ -29422 4337 3944 2
+ -29411 4292 4068 2
+ -29393 4249 4241 2
+ -29396 4145 4325 2
+ -29400 4028 4403 2
+ -29370 4056 4577 2
+ -29371 3936 4672 2
+ -29381 3793 4728 2
+ -29358 3780 4883 2
+ -29327 3854 5009 2
+ -29295 3928 5137 2
+ -29289 4069 5059 2
+ -29291 4180 4955 2
+ -29273 4307 4955 2
+ -29240 4361 5097 2
+ -29201 4461 5232 2
+ -29172 4585 5290 2
+ -29140 4665 5395 2
+ -29093 4725 5593 2
+ -29089 4666 5662 2
+ -29076 4576 5803 2
+ -29071 4435 5934 2
+ -29048 4416 6061 2
+ -29032 4300 6219 2
+ -29056 4323 6088 2
+ -29095 4194 5990 2
+ -29108 4046 6032 2
+ -29108 3925 6109 2
+ -29102 3810 6208 2
+ -29091 3703 6323 2
+ -29095 3582 6377 2
+ -29085 3471 6484 2
+ -29099 3311 6503 2
+ -29114 3182 6500 2
+ -29112 3052 6572 2
+ -29143 2916 6496 2
+ -29148 2800 6524 2
+ -29160 2645 6536 2
+ -29167 2483 6568 2
+ -29181 2342 6557 2
+ -29196 2156 6555 2
+ -29185 2058 6633 2
+ -29187 1953 6658 2
+ -29213 1818 6579 2
+ -29237 1706 6501 2
+ -29267 1556 6406 2
+ -29283 1445 6359 2
+ -29306 1352 6273 2
+ -29336 1317 6135 2
+ -29369 1278 5984 2
+ -29391 1164 5899 2
+ -29395 994 5914 2
+ -29431 893 5748 2
+ -29425 733 5801 2
+ -29442 622 5727 2
+ -29469 569 5589 2
+ -29502 504 5418 2
+ -29523 478 5306 2
+ -29547 385 5181 2
+ -29546 215 5196 2
+ -29550 70 5179 2
+ -29564 -54 5095 2
+ -29582 -164 4987 2
+ -29578 -315 5002 2
+ -29593 -453 4904 2
+ -29614 -533 4767 2
+ -29606 -688 4799 2
+ -29604 -838 4783 2
+ -29594 -992 4818 2
+ -29600 -1132 4747 2
+ -29593 -1223 4768 2
+ -29569 -1299 4897 2
+ -29541 -1393 5038 2
+ -29519 -1296 5191 2
+ -29506 -1276 5268 2
+ -29511 -1112 5279 2
+ -29508 -1125 5290 2
+ -29498 -1281 5312 2
+ -29492 -1416 5314 2
+ -29493 -1560 5264 2
+ -29499 -1691 5189 2
+ -29519 -1760 5055 2
+ -29533 -1849 4936 2
+ -29548 -1940 4814 2
+ -29556 -2052 4716 2
+ -29564 -2165 4615 2
+ -29568 -2287 4530 2
+ -29558 -2439 4514 2
+ -29532 -2591 4596 2
+ -29520 -2730 4592 2
+ -29494 -2849 4691 2
+ -29474 -2993 4728 2
+ -29483 -3079 4613 2
+ -29464 -3208 4645 2
+ -29435 -3291 4771 2
+ -29405 -3361 4903 2
+ -29375 -3431 5034 2
+ -29344 -3514 5156 2
+ -29314 -3633 5243 2
+ -29284 -3753 5329 2
+ -29255 -3891 5385 2
+ -29225 -4026 5447 2
+ -29193 -4149 5527 2
+ -29158 -4251 5631 2
+ -29126 -4381 5701 2
+ -29092 -4510 5774 2
+ -29061 -4655 5815 2
+ -29028 -4788 5870 2
+ -28993 -4914 5937 2
+ -28958 -5057 5989 2
+ -28924 -5195 6032 2
+ -28890 -5331 6081 2
+ -28851 -5458 6150 2
+ -28811 -5585 6224 2
+ -28772 -5716 6286 2
+ -28737 -5860 6312 2
+ -28691 -5962 6425 2
+ -28648 -6082 6503 2
+ -28609 -6236 6529 2
+ -28567 -6350 6602 2
+ -28520 -6466 6692 2
+ -28476 -6594 6756 2
+ -28431 -6721 6820 2
+ -28385 -6845 6886 2
+ -28338 -6970 6956 2
+ -28306 -7132 6922 2
+ -28291 -7228 6884 2
+ -28243 -7364 6934 2
+ -28193 -7484 7011 2
+ -28142 -7605 7083 2
+ -28090 -7690 7199 2
+ -28037 -7794 7292 2
+ -27982 -7905 7383 2
+ -27932 -7999 7473 2
+ -27878 -8067 7597 2
+ -27824 -8138 7719 2
+ -27770 -8209 7837 2
+ -27716 -8284 7951 2
+ -27657 -8366 8067 2
+ -27604 -8413 8200 2
+ -27549 -8479 8318 2
+ -27489 -8545 8447 2
+ -27432 -8600 8573 2
+ -27374 -8660 8699 2
+ -27312 -8756 8796 2
+ -27250 -8835 8909 2
+ -27188 -8897 9035 2
+ -27127 -8990 9126 2
+ -27071 -9123 9161 2
+ -27003 -9210 9275 2
+ -26938 -9299 9376 2
+ -26870 -9386 9480 2
+ -26802 -9489 9571 2
+ -26755 -9636 9557 2
+ -26702 -9779 9560 2
+ -26649 -9920 9562 2
+ -26591 -10059 9577 2
+ -26536 -10198 9583 2
+ -26487 -10341 9566 2
+ -26445 -10479 9531 2
+ -26395 -10626 9508 2
+ -26337 -10764 9513 2
+ -26276 -10903 9523 2
+ -26232 -11037 9491 2
+ -26188 -11177 9446 2
+ -26145 -11314 9405 2
+ -26096 -11455 9368 2
+ -26049 -11592 9332 2
+ -26013 -11729 9260 2
+ -26009 -11807 9173 2
+ -25947 -11945 9169 2
+ -25885 -12056 9198 2
+ -25842 -12187 9147 2
+ -25786 -12328 9116 2
+ -25733 -12465 9080 2
+ -25671 -12600 9070 2
+ -25601 -12732 9083 2
+ -25546 -12866 9047 2
+ -25522 -12976 8957 2
+ -25462 -13113 8929 2
+ -25396 -13251 8915 2
+ -25342 -13378 8878 2
+ -25291 -13512 8821 2
+ -25239 -13646 8761 2
+ -25195 -13763 8705 2
+ -25129 -13900 8677 2
+ -25095 -14015 8593 2
+ -25038 -14144 8545 2
+ -24979 -14276 8499 2
+ -24935 -14396 8426 2
+ -24895 -14519 8334 2
+ -24819 -14648 8335 2
+ -24735 -14773 8363 2
+ -24664 -14903 8343 2
+ -24607 -15026 8289 2
+ -24581 -15126 8185 2
+ -24531 -15244 8114 2
+ -24456 -15375 8094 2
+ -24378 -15504 8084 2
+ -24296 -15633 8081 2
+ -24212 -15763 8081 2
+ -24136 -15886 8067 2
+ -24055 -16016 8054 2
+ -23977 -16135 8047 2
+ -23914 -16256 7992 2
+ -23863 -16374 7903 2
+ -23787 -16499 7872 2
+ -23706 -16624 7853 2
+ -23663 -16732 7753 2
+ -23606 -16849 7675 2
+ -23532 -16970 7631 2
+ -23460 -17094 7578 2
+ -23396 -17212 7509 2
+ -23350 -17315 7415 2
+ -23299 -17424 7318 2
+ -23227 -17541 7268 2
+ -23172 -17651 7176 2
+ -23094 -17773 7126 2
+ -23029 -17895 7030 2
+ -22987 -17977 6960 2
+ -22900 -18107 6908 2
+ -22911 -18148 6763 2
+ -22840 -18258 6707 2
+ -22752 -18374 6690 2
+ -22652 -18486 6720 2
+ -22567 -18605 6678 2
+ -22457 -18742 6666 2
+ -22374 -18834 6684 2
+ -22269 -18952 6703 2
+ -22182 -19062 6676 2
+ -22109 -19173 6602 2
+ -22067 -19251 6516 2
+ -21997 -19361 6426 2
+ -21908 -19477 6376 2
+ -21830 -19588 6305 2
+ -21749 -19696 6250 2
+ -21642 -19812 6255 2
+ -21544 -19903 6304 2
+ -21497 -19950 6314 2
+ -21428 -19988 6426 2
+ -21461 -19918 6536 2
+ -21441 -19903 6645 2
+ -21401 -19896 6791 2
+ -21362 -19948 6762 2
+ -21341 -20022 6610 2
+ -21253 -20091 6681 2
+ -21151 -20196 6690 2
+ -21183 -20184 6624 2
+ -21130 -20250 6591 2
+ -21102 -20294 6548 2
+ -21008 -20406 6501 2
+ -20933 -20495 6460 2
+ -20863 -20601 6352 2
+ -20737 -20724 6365 2
+ -20687 -20792 6307 2
+ -20598 -20902 6231 2
+ -20470 -20993 6349 2
+ -20422 -21029 6384 2
+ -20348 -21125 6300 2
+ -20326 -21187 6161 2
+ -20288 -21253 6059 2
+ -20168 -21347 6129 2
+ -20187 -21353 6046 2
+ -20095 -21458 5979 2
+ -20034 -21535 5908 2
+ -19931 -21647 5846 2
+ -19935 -21626 5908 2
+ -19910 -21653 5897 2
+ -19836 -21756 5763 2
+ -19926 -21679 5744 2
+ -19977 -21666 5614 2
+ -19998 -21629 5678 2
+ -20078 -21549 5703 2
+ -20122 -21539 5581 2
+ -20078 -21610 5468 2
+ -20037 -21675 5357 2
+ -20007 -21732 5239 2
+ -19899 -21856 5132 2
+ -19925 -21826 5160 2
+ -19936 -21780 5309 2
+ -19903 -21806 5327 2
+ -19794 -21877 5438 2
+ -19762 -21875 5561 2
+ -19616 -21996 5601 2
+ -19585 -22056 5474 2
+ -19462 -22159 5495 2
+ -19481 -22166 5401 2
+ -19433 -22211 5387 2
+ -19381 -22225 5518 2
+ -19397 -22177 5650 2
+ -19362 -22202 5674 2
+ -19262 -22274 5731 2
+ -19260 -22280 5713 2
+ -19195 -22338 5706 2
+ -19238 -22327 5605 2
+ -19281 -22325 5462 2
+ -19325 -22307 5381 2
+ -19299 -22335 5359 2
+ -19173 -22419 5457 2
+ -19087 -22505 5404 2
+ -19028 -22572 5333 2
+ -18926 -22670 5278 2
+ -18793 -22783 5270 2
+ -18864 -22695 5395 2
+ -18791 -22757 5383 2
+ -18658 -22860 5411 2
+ -18685 -22848 5372 2
+ -18672 -22880 5275 2
+ -18578 -22951 5301 2
+ -18502 -23020 5268 2
+ -18530 -23024 5150 2
+ -18471 -23076 5132 2
+ -18365 -23140 5221 2
+ -18258 -23228 5203 2
+ -18284 -23175 5351 2
+ -18223 -23229 5322 2
+ -18173 -23298 5190 2
+ -18063 -23376 5224 2
+ -17941 -23467 5235 2
+ -17849 -23540 5223 2
+ -17719 -23631 5254 2
+ -17771 -23578 5319 2
+ -17705 -23625 5326 2
+ -17757 -23572 5392 2
+ -17734 -23565 5494 2
+ -17846 -23491 5449 2
+ -17808 -23504 5518 2
+ -17674 -23594 5562 2
+ -17585 -23672 5517 2
+ -17473 -23768 5458 2
+ -17504 -23742 5468 2
+ -17617 -23654 5490 2
+ -17605 -23676 5430 2
+ -17603 -23694 5361 2
+ -17662 -23683 5213 2
+ -17620 -23722 5179 2
+ -17485 -23828 5149 2
+ -17464 -23816 5275 2
+ -17437 -23833 5285 2
+ -17352 -23916 5189 2
+ -17259 -23979 5209 2
+ -17301 -23928 5303 2
+ -17395 -23843 5375 2
+ -17388 -23820 5500 2
+ -17312 -23828 5704 2
+ -17310 -23854 5602 2
+ -17305 -23896 5433 2
+ -17296 -23928 5319 2
+ -17181 -24020 5281 2
+ -17058 -24094 5336 2
+ -17136 -24017 5433 2
+ -17159 -23983 5509 2
+ -17166 -23947 5645 2
+ -17186 -23897 5794 2
+ -17104 -23950 5816 2
+ -17060 -24013 5688 2
+ -16974 -24102 5567 2
+ -17000 -24080 5579 2
+ -17049 -24062 5509 2
+ -17043 -24089 5409 2
+ -16911 -24168 5470 2
+ -16823 -24207 5569 2
+ -16754 -24222 5708 2
+ -16825 -24149 5807 2
+ -16941 -24059 5844 2
+ -17045 -23967 5918 2
+ -17144 -23877 6001 2
+ -17139 -23845 6138 2
+ -17138 -23807 6286 2
+ -17158 -23760 6409 2
+ -17172 -23715 6534 2
+ -17077 -23737 6705 2
+ -17189 -23653 6714 2
+ -17314 -23568 6691 2
+ -17424 -23518 6580 2
+ -17425 -23503 6631 2
+ -17473 -23448 6702 2
+ -17621 -23340 6690 2
+ -17676 -23295 6703 2
+ -17767 -23203 6778 2
+ -17845 -23116 6871 2
+ -17872 -23047 7030 2
+ -17974 -22982 6984 2
+ -18009 -22943 7022 2
+ -18003 -22936 7060 2
+ -17884 -23010 7119 2
+ -17877 -22971 7264 2
+ -17955 -22882 7352 2
+ -18076 -22766 7414 2
+ -18148 -22691 7469 2
+ -18205 -22608 7579 2
+ -18247 -22533 7702 2
+ -18261 -22474 7839 2
+ -18273 -22414 7980 2
+ -18299 -22343 8121 2
+ -18385 -22255 8167 2
+ -18420 -22206 8221 2
+ -18481 -22118 8322 2
+ -18587 -22016 8354 2
+ -18681 -21970 8267 2
+ -18752 -21959 8135 2
+ -18852 -21908 8040 2
+ -18964 -21834 7976 2
+ -19078 -21758 7914 2
+ -19191 -21659 7910 2
+ -19277 -21560 7973 2
+ -19336 -21469 8075 2
+ -19392 -21377 8183 2
+ -19425 -21300 8305 2
+ -19412 -21259 8440 2
+ -19399 -21209 8594 2
+ -19335 -21211 8732 2
+ -19406 -21125 8782 2
+ -19450 -21030 8913 2
+ -19521 -20931 8990 2
+ -19610 -20826 9040 2
+ -19713 -20717 9066 2
+ -19763 -20621 9175 2
+ -19797 -20537 9291 2
+ -19778 -20479 9456 2
+ -19832 -20436 9436 2
+ -19954 -20358 9348 2
+ -19967 -20278 9493 2
+ -19876 -20325 9583 2
+ -19774 -20405 9624 2
+ -19741 -20368 9769 2
+ -19817 -20259 9843 2
+ -19923 -20149 9854 2
+ -19990 -20156 9702 2
+ -19939 -20234 9645 2
+ -20020 -20207 9533 2
+ -20122 -20145 9448 2
+ -20228 -20056 9412 2
+ -20313 -19944 9467 2
+ -20410 -19836 9486 2
+ -20514 -19724 9496 2
+ -20586 -19605 9584 2
+ -20554 -19599 9667 2
+ -20455 -19646 9779 2
+ -20359 -19691 9889 2
+ -20261 -19741 9989 2
+ -20191 -19744 10125 2
+ -20134 -19731 10262 2
+ -20109 -19683 10401 2
+ -20119 -19586 10565 2
+ -20190 -19502 10585 2
+ -20296 -19383 10602 2
+ -20365 -19267 10679 2
+ -20387 -19192 10772 2
+ -20494 -19041 10837 2
+ -20574 -18970 10809 2
+ -20674 -18836 10852 2
+ -20601 -18855 10960 2
+ -20512 -18878 11085 2
+ -20441 -18876 11220 2
+ -20374 -18868 11353 2
+ -20313 -18850 11492 2
+ -20254 -18829 11629 2
+ -20194 -18808 11768 2
+ -20140 -18778 11906 2
+ -20084 -18751 12043 2
+ -20038 -18711 12182 2
+ -19989 -18673 12320 2
+ -19952 -18622 12456 2
+ -19925 -18561 12590 2
+ -19947 -18466 12693 2
+ -19985 -18359 12788 2
+ -19990 -18268 12910 2
+ -20013 -18165 13019 2
+ -20035 -18062 13129 2
+ -20083 -17950 13208 2
+ -20182 -17811 13246 2
+ -20268 -17772 13167 2
+ -20384 -17688 13102 2
+ -20478 -17572 13109 2
+ -20513 -17460 13204 2
+ -20568 -17352 13262 2
+ -20677 -17255 13218 2
+ -20786 -17182 13143 2
+ -20891 -17122 13053 2
+ -20998 -17060 12964 2
+ -21099 -16959 12931 2
+ -21140 -16864 12989 2
+ -21215 -16742 13024 2
+ -21304 -16620 13035 2
+ -21359 -16494 13106 2
+ -21387 -16386 13196 2
+ -21397 -16297 13288 2
+ -21484 -16159 13316 2
+ -21464 -16173 13331 2
+ -21378 -16298 13317 2
+ -21366 -16395 13218 2
+ -21334 -16504 13133 2
+ -21276 -16626 13073 2
+ -21192 -16748 13054 2
+ -21085 -16846 13100 2
+ -20977 -16941 13152 2
+ -20894 -16975 13239 2
+ -20817 -16970 13366 2
+ -20719 -17021 13454 2
+ -20613 -17087 13533 2
+ -20508 -17136 13630 2
+ -20419 -17160 13733 2
+ -20357 -17118 13877 2
+ -20259 -17138 13994 2
+ -20155 -17174 14101 2
+ -20087 -17151 14224 2
+ -20044 -17065 14389 2
+ -20002 -17034 14483 2
+ -19984 -16945 14613 2
+ -19994 -16839 14720 2
+ -20014 -16729 14817 2
+ -20010 -16634 14930 2
+ -19990 -16548 15052 2
+ -19971 -16460 15173 2
+ -19977 -16355 15279 2
+ -20003 -16237 15370 2
+ -20038 -16115 15453 2
+ -20052 -15980 15574 2
+ -20103 -15891 15600 2
+ -20148 -15744 15690 2
+ -20165 -15639 15773 2
+ -20133 -15561 15891 2
+ -20117 -15466 16004 2
+ -20131 -15337 16110 2
+ -20157 -15214 16193 2
+ -20218 -15092 16231 2
+ -20176 -15108 16268 2
+ -20042 -15155 16390 2
+ -19989 -15248 16369 2
+ -19962 -15367 16290 2
+ -19977 -15470 16174 2
+ -19979 -15562 16083 2
+ -19973 -15671 15983 2
+ -19996 -15744 15884 2
+ -20051 -15873 15684 2
+ -20012 -15848 15759 2
+ -19966 -15779 15886 2
+ -19935 -15695 16008 2
+ -19913 -15603 16125 2
+ -19899 -15504 16238 2
+ -19897 -15396 16343 2
+ -19898 -15285 16445 2
+ -19905 -15170 16542 2
+ -19929 -15047 16626 2
+ -19948 -14924 16714 2
+ -19956 -14807 16809 2
+ -19951 -14696 16911 2
+ -19938 -14590 17018 2
+ -19911 -14495 17131 2
+ -19868 -14413 17249 2
+ -19847 -14299 17368 2
+ -19843 -14200 17453 2
+ -19877 -14065 17524 2
+ -19932 -13934 17566 2
+ -19980 -13802 17616 2
+ -20013 -13683 17671 2
+ -20093 -13530 17697 2
+ -20150 -13398 17733 2
+ -20227 -13251 17756 2
+ -20253 -13099 17839 2
+ -20235 -12995 17935 2
+ -20318 -12911 17902 2
+ -20296 -12859 17965 2
+ -20230 -12836 18055 2
+ -20175 -12749 18178 2
+ -20183 -12672 18222 2
+ -20130 -12572 18350 2
+ -20063 -12509 18466 2
+ -20002 -12425 18589 2
+ -19970 -12328 18688 2
+ -19904 -12255 18806 2
+ -19821 -12179 18942 2
+ -19763 -12123 19039 2
+ -19669 -12095 19153 2
+ -19568 -12085 19262 2
+ -19517 -11986 19376 2
+ -19456 -11920 19477 2
+ -19355 -11887 19598 2
+ -19373 -11826 19617 2
+ -19361 -11729 19687 2
+ -19276 -11720 19776 2
+ -19134 -11723 19911 2
+ -19042 -11746 19986 2
+ -18933 -11720 20104 2
+ -18929 -11617 20168 2
+ -18876 -11657 20194 2
+ -18770 -11707 20264 2
+ -18664 -11694 20369 2
+ -18529 -11698 20490 2
+ -18493 -11609 20573 2
+ -18512 -11477 20630 2
+ -18455 -11381 20734 2
+ -18364 -11327 20844 2
+ -18275 -11271 20952 2
+ -18267 -11162 21017 2
+ -18318 -11020 21047 2
+ -18324 -10884 21113 2
+ -18309 -10755 21192 2
+ -18264 -10654 21282 2
+ -18210 -10553 21379 2
+ -18200 -10410 21457 2
+ -18174 -10288 21537 2
+ -18155 -10166 21612 2
+ -18094 -10067 21708 2
+ -18083 -9933 21779 2
+ -18124 -9790 21810 2
+ -18162 -9646 21842 2
+ -18180 -9505 21889 2
+ -18173 -9368 21954 2
+ -18128 -9250 22041 2
+ -18059 -9151 22140 2
+ -18083 -9012 22176 2
+ -18114 -8866 22210 2
+ -18118 -8726 22262 2
+ -18125 -8582 22312 2
+ -18123 -8441 22368 2
+ -18116 -8302 22425 2
+ -18128 -8159 22468 2
+ -18178 -8014 22480 2
+ -18218 -7869 22499 2
+ -18253 -7715 22523 2
+ -18288 -7578 22542 2
+ -18291 -7431 22588 2
+ -18312 -7278 22621 2
+ -18354 -7149 22628 2
+ -18377 -7020 22650 2
+ -18349 -6881 22715 2
+ -18341 -6673 22783 2
+ -18295 -6590 22844 2
+ -18198 -6701 22889 2
+ -18111 -6681 22965 2
+ -18048 -6569 23046 2
+ -18000 -6447 23118 2
+ -17948 -6326 23192 2
+ -17907 -6196 23258 2
+ -17868 -6022 23334 2
+ -17850 -5895 23380 2
+ -17795 -5784 23450 2
+ -17733 -5691 23520 2
+ -17666 -5580 23596 2
+ -17572 -5500 23685 2
+ -17484 -5418 23768 2
+ -17425 -5300 23838 2
+ -17355 -5191 23913 2
+ -17311 -5048 23976 2
+ -17218 -4963 24060 2
+ -17150 -4850 24132 2
+ -17091 -4727 24198 2
+ -17053 -4592 24251 2
+ -17022 -4453 24298 2
+ -16998 -4311 24341 2
+ -16979 -4169 24379 2
+ -16994 -4003 24396 2
+ -16986 -3892 24420 2
+ -17011 -3706 24431 2
+ -17042 -3588 24428 2
+ -17077 -3439 24424 2
+ -17132 -3274 24408 2
+ -17161 -3151 24404 2
+ -17201 -3006 24395 2
+ -17247 -2862 24379 2
+ -17319 -2732 24343 2
+ -17432 -2668 24269 2
+ -17556 -2649 24182 2
+ -17677 -2666 24092 2
+ -17800 -2665 24001 2
+ -17912 -2620 23923 2
+ -18029 -2573 23839 2
+ -18123 -2476 23779 2
+ -18234 -2412 23700 2
+ -18328 -2314 23638 2
+ -18426 -2219 23570 2
+ -18512 -2106 23513 2
+ -18602 -1986 23452 2
+ -18701 -1917 23379 2
+ -18800 -1829 23307 2
+ -18900 -1746 23233 2
+ -19003 -1670 23153 2
+ -19116 -1597 23066 2
+ -19214 -1524 22989 2
+ -19322 -1482 22901 2
+ -19440 -1470 22802 2
+ -19555 -1493 22702 2
+ -19670 -1510 22602 2
+ -19775 -1537 22507 2
+ -19892 -1510 22406 2
+ -20010 -1451 22305 2
+ -20115 -1470 22208 2
+ -20225 -1428 22112 2
+ -20322 -1359 22026 2
+ -20424 -1297 21936 2
+ -20534 -1251 21836 2
+ -20633 -1298 21739 2
+ -20734 -1333 21641 2
+ -20878 -1442 21495 2
+ -20848 -1316 21532 2
+ -20918 -1311 21464 2
+ -20958 -1408 21420 2
+ -20987 -1556 21381 2
+ -21068 -1678 21292 2
+ -21072 -1642 21290 2
+ -21062 -1501 21311 2
+ -21039 -1352 21343 2
+ -20992 -1213 21397 2
+ -21076 -1214 21315 2
+ -21072 -1156 21323 2
+ -21034 -1020 21366 2
+ -21110 -906 21297 2
+ -21190 -805 21221 2
+ -21307 -838 21102 2
+ -21370 -735 21042 2
+ -21462 -665 20950 2
+ -21542 -630 20870 2
+ -21633 -568 20777 2
+ -21713 -546 20694 2
+ -21820 -484 20582 2
+ -21911 -420 20487 2
+ -22007 -363 20385 2
+ -22099 -360 20285 2
+ -22208 -364 20166 2
+ -22311 -392 20052 2
+ -22369 -543 19983 2
+ -22409 -653 19935 2
+ -22440 -793 19895 2
+ -22511 -796 19815 2
+ -22589 -891 19721 2
+ -22663 -980 19633 2
+ -22724 -1087 19556 2
+ -22759 -1227 19507 2
+ -22808 -1369 19440 2
+ -22816 -1324 19434 2
+ -22789 -1178 19475 2
+ -22800 -996 19472 2
+ -22908 -1030 19343 2
+ -22993 -972 19246 2
+ -23093 -1039 19122 2
+ -23175 -963 19027 2
+ -23210 -842 18989 2
+ -23249 -703 18947 2
+ -23267 -565 18929 2
+ -23302 -505 18888 2
+ -23377 -605 18792 2
+ -23449 -680 18700 2
+ -23538 -753 18584 2
+ -23619 -830 18478 2
+ -23709 -845 18363 2
+ -23817 -826 18222 2
+ -23802 -785 18244 2
+ -23716 -724 18358 2
+ -23626 -697 18474 2
+ -23572 -573 18548 2
+ -23543 -438 18588 2
+ -23497 -302 18649 2
+ -23443 -194 18719 2
+ -23399 -56 18775 2
+ -23320 31 18873 2
+ -23239 112 18972 2
+ -23173 225 19051 2
+ -23119 352 19115 2
+ -23053 463 19192 2
+ -22979 561 19279 2
+ -22941 686 19320 2
+ -22951 834 19302 2
+ -23022 925 19213 2
+ -23117 962 19097 2
+ -23196 1097 18993 2
+ -23204 1227 18975 2
+ -23233 1358 18931 2
+ -23259 1506 18888 2
+ -23286 1652 18843 2
+ -23294 1802 18818 2
+ -23306 1972 18787 2
+ -23319 2099 18757 2
+ -23395 2241 18645 2
+ -23412 2125 18638 2
+ -23441 2146 18598 2
+ -23474 2246 18546 2
+ -23536 2350 18454 2
+ -23578 2460 18386 2
+ -23652 2538 18280 2
+ -23711 2644 18187 2
+ -23775 2743 18089 2
+ -23837 2844 17991 2
+ -23922 2884 17873 2
+ -24005 2925 17753 2
+ -24083 2995 17636 2
+ -24175 2882 17529 2
+ -24162 2957 17535 2
+ -24189 3060 17480 2
+ -24274 3092 17356 2
+ -24358 3119 17233 2
+ -24450 3128 17100 2
+ -24445 3076 17117 2
+ -24457 3062 17102 2
+ -24529 3099 16992 2
+ -24613 3122 16866 2
+ -24706 3047 16743 2
+ -24768 3049 16650 2
+ -24846 3091 16527 2
+ -24925 3113 16402 2
+ -25011 3122 16270 2
+ -25084 2950 16189 2
+ -25079 3021 16183 2
+ -25068 3168 16172 2
+ -25120 3284 16068 2
+ -25169 3346 15979 2
+ -25217 3451 15881 2
+ -25271 3547 15772 2
+ -25347 3586 15643 2
+ -25435 3422 15535 2
+ -25431 3513 15522 2
+ -25391 3656 15554 2
+ -25367 3806 15557 2
+ -25397 3945 15473 2
+ -25435 4042 15386 2
+ -25479 4146 15285 2
+ -25528 4237 15178 2
+ -25603 4314 15030 2
+ -25652 4359 14933 2
+ -25698 4455 14825 2
+ -25768 4496 14690 2
+ -25840 4464 14572 2
+ -25918 4471 14432 2
+ -25980 4415 14337 2
+ -26073 4452 14156 2
+ -26025 4486 14233 2
+ -25970 4576 14304 2
+ -25919 4737 14345 2
+ -25859 4837 14419 2
+ -25864 4952 14372 2
+ -25922 4999 14250 2
+ -25983 5110 14098 2
+ -26051 5073 13986 2
+ -26126 5140 13821 2
+ -26169 5134 13742 2
+ -26193 5264 13645 2
+ -26277 5247 13490 2
+ -26238 5290 13550 2
+ -26270 5416 13438 2
+ -26224 5494 13496 2
+ -26155 5489 13631 2
+ -26042 5553 13820 2
+ -26087 5570 13727 2
+ -26156 5587 13589 2
+ -26225 5582 13458 2
+ -26297 5574 13319 2
+ -26366 5552 13192 2
+ -26439 5549 13046 2
+ -26535 5524 12859 2
+ -26480 5478 12992 2
+ -26525 5444 12915 2
+ -26603 5396 12773 2
+ -26662 5331 12677 2
+ -26720 5275 12579 2
+ -26795 5246 12431 2
+ -26850 5280 12297 2
+ -26915 5334 12129 2
+ -26947 5374 12041 2
+ -26966 5491 11945 2
+ -27013 5532 11819 2
+ -27075 5530 11678 2
+ -27136 5521 11540 2
+ -27198 5494 11405 2
+ -27259 5478 11266 2
+ -27322 5456 11124 2
+ -27374 5474 10985 2
+ -27383 5600 10899 2
+ -27369 5707 10880 2
+ -27376 5838 10792 2
+ -27410 5920 10660 2
+ -27455 5960 10522 2
+ -27502 5985 10383 2
+ -27557 5986 10237 2
+ -27562 6109 10149 2
+ -27546 6254 10106 2
+ -27571 6316 9996 2
+ -27625 6212 9913 2
+ -27639 6078 9956 2
+ -27587 6029 10129 2
+ -27634 5977 10031 2
+ -27681 5912 9941 2
+ -27738 5860 9810 2
+ -27795 5830 9668 2
+ -27851 5766 9545 2
+ -27915 5698 9397 2
+ -27956 5583 9342 2
+ -27973 5435 9378 2
+ -27971 5307 9459 2
+ -27965 5179 9548 2
+ -27972 5043 9599 2
+ -28002 4886 9592 2
+ -28051 4770 9506 2
+ -28105 4721 9373 2
+ -28124 4806 9272 2
+ -28125 4916 9208 2
+ -28132 4994 9145 2
+ -28120 5147 9098 2
+ -28074 5279 9166 2
+ -28024 5398 9247 2
+ -27981 5522 9305 2
+ -27965 5689 9253 2
+ -27959 5783 9211 2
+ -27961 5906 9126 2
+ -27930 6036 9138 2
+ -27873 6082 9281 2
+ -27819 6150 9395 2
+ -27764 6273 9476 2
+ -27759 6407 9401 2
+ -27806 6455 9228 2
+ -27861 6381 9115 2
+ -27906 6336 9004 2
+ -27956 6197 8947 2
+ -28010 6124 8828 2
+ -28063 6067 8697 2
+ -28116 5981 8584 2
+ -28169 5893 8473 2
+ -28216 5864 8334 2
+ -28257 5873 8188 2
+ -28295 5886 8045 2
+ -28337 5756 7993 2
+ -28393 5623 7887 2
+ -28377 5690 7896 2
+ -28374 5722 7886 2
+ -28405 5768 7738 2
+ -28447 5713 7624 2
+ -28497 5609 7512 2
+ -28549 5496 7399 2
+ -28590 5353 7347 2
+ -28609 5239 7355 2
+ -28644 5080 7328 2
+ -28676 4929 7306 2
+ -28713 4898 7182 2
+ -28753 4802 7084 2
+ -28793 4675 7006 2
+ -28836 4582 6893 2
+ -28885 4479 6754 2
+ -28897 4338 6793 2
+ -28919 4179 6801 2
+ -28928 4217 6736 2
+ -28930 4327 6659 2
+ -28939 4438 6546 2
+ -28948 4537 6435 2
+ -28958 4629 6325 2
+ -28963 4742 6219 2
+ -28976 4823 6092 2
+ -28996 4878 5951 2
+ -29019 4913 5810 2
+ -29046 4939 5653 2
+ -29064 4974 5526 2
+ -29091 4992 5366 2
+ -29129 4903 5243 2
+ -29158 4842 5137 2
+ -29194 4774 4994 2
+ -29225 4728 4854 2
+ -29258 4649 4730 2
+ -29288 4593 4594 2
+ -29313 4582 4444 2
+ -29324 4711 4235 2
+ -29342 4664 4160 2
+ -29352 4727 4018 2
+ -29343 4827 3961 2
+ -29334 4951 3872 2
+ -29337 5035 3743 2
+ -29333 5133 3636 2
+ -29327 5236 3538 2
+ -29318 5354 3433 2
+ -29305 5478 3350 2
+ -29287 5611 3287 2
+ -29274 5724 3207 2
+ -29251 5870 3148 2
+ -29219 6000 3206 2
+ -29190 6134 3208 2
+ -29162 6269 3204 2
+ -29132 6394 3230 2
+ -29092 6571 3241 2
+ -29106 6497 3263 2
+ -29103 6489 3306 2
+ -29066 6653 3303 2
+ -29034 6798 3286 2
+ -29001 6945 3276 2
+ -28963 7088 3299 2
+ -28924 7230 3336 2
+ -28884 7352 3414 2
+ -28847 7488 3432 2
+ -28816 7636 3367 2
+ -28795 7703 3395 2
+ -28768 7802 3400 2
+ -28758 7901 3245 2
+ -28770 7916 3099 2
+ -28758 7992 3021 2
+ -28734 8088 2993 2
+ -28725 8183 2814 2
+ -28734 8182 2721 2
+ -28729 8248 2575 2
+ -28746 8231 2433 2
+ -28762 8219 2282 2
+ -28762 8257 2143 2
+ -28773 8247 2017 2
+ -28805 8174 1861 2
+ -28816 8165 1715 2
+ -28828 8154 1565 2
+ -28831 8173 1414 2
+ -28833 8193 1249 2
+ -28833 8212 1102 2
+ -28858 8141 977 2
+ -28856 8161 846 2
+ -28853 8185 713 2
+ -28838 8247 574 2
+ -28796 8387 674 2
+ -28753 8520 803 2
+ -28731 8592 843 2
+ -28688 8730 877 2
+ -28646 8870 857 2
+ -28598 9021 879 2
+ -28555 9157 887 2
+ -28509 9293 934 2
+ -28465 9430 910 2
+ -28451 9480 834 2
+ -28396 9635 919 2
+ -28418 9565 974 2
+ -28460 9430 1047 2
+ -28451 9453 1096 2
+ -28402 9593 1133 2
+ -28352 9734 1179 2
+ -28296 9894 1198 2
+ -28246 10034 1207 2
+ -28196 10174 1224 2
+ -28166 10251 1251 2
+ -28115 10388 1280 2
+ -28068 10504 1363 2
+ -28025 10604 1468 2
+ -27975 10725 1545 2
+ -27924 10853 1564 2
+ -27878 10979 1506 2
+ -27872 11015 1346 2
+ -27890 10981 1242 2
+ -27886 11008 1099 2
+ -27880 11039 920 2
+ -27889 11026 798 2
+ -27907 10989 654 2
+ -27928 10944 513 2
+ -27940 10920 365 2
+ -27948 10902 215 2
+ -27960 10874 68 2
+ -27982 10816 -69 2
+ -28025 10703 -182 2
+ -28068 10589 -223 2
+ -28121 10447 -236 2
+ -28175 10302 -238 2
+ -28218 10183 -289 2
+ -28261 10059 -350 2
+ -28309 9922 -389 2
+ -28341 9824 -502 2
+ -28374 9719 -666 2
+ -28410 9617 -642 2
+ -28442 9514 -737 2
+ -28438 9512 -910 2
+ -28413 9579 -979 2
+ -28396 9610 -1134 2
+ -28409 9552 -1307 2
+ -28416 9515 -1414 2
+ -28422 9474 -1558 2
+ -28412 9462 -1801 2
+ -28421 9421 -1867 2
+ -28421 9394 -1998 2
+ -28423 9355 -2144 2
+ -28404 9383 -2278 2
+ -28357 9501 -2372 2
+ -28323 9569 -2500 2
+ -28293 9622 -2632 2
+ -28274 9631 -2794 2
+ -28249 9673 -2898 2
+ -28192 9812 -2984 2
+ -28145 9918 -3077 2
+ -28094 10046 -3131 2
+ -28039 10186 -3172 2
+ -27987 10303 -3254 2
+ -27936 10411 -3345 2
+ -27885 10517 -3440 2
+ -27831 10636 -3513 2
+ -27774 10764 -3568 2
+ -27716 10895 -3620 2
+ -27662 11012 -3680 2
+ -27578 11200 -3740 2
+ -27602 11156 -3697 2
+ -27686 10977 -3604 2
+ -27654 11061 -3592 2
+ -27599 11166 -3689 2
+ -27540 11292 -3750 2
+ -27479 11430 -3772 2
+ -27423 11562 -3779 2
+ -27375 11692 -3726 2
+ -27309 11846 -3723 2
+ -27235 12022 -3703 2
+ -27194 12116 -3700 2
+ -27132 12263 -3673 2
+ -27073 12401 -3646 2
+ -27016 12536 -3606 2
+ -26959 12670 -3562 2
+ -26907 12797 -3499 2
+ -26859 12919 -3421 2
+ -26802 13050 -3369 2
+ -26740 13172 -3386 2
+ -26669 13300 -3447 2
+ -26608 13415 -3477 2
+ -26532 13557 -3505 2
+ -26475 13676 -3472 2
+ -26415 13768 -3561 2
+ -26419 13777 -3498 2
+ -26393 13850 -3403 2
+ -26323 13981 -3411 2
+ -26309 14018 -3369 2
+ -26271 14110 -3278 2
+ -26249 14170 -3190 2
+ -26211 14270 -3059 2
+ -26161 14377 -2980 2
+ -26183 14367 -2833 2
+ -26190 14380 -2706 2
+ -26174 14425 -2621 2
+ -26155 14482 -2483 2
+ -26109 14586 -2364 2
+ -26057 14696 -2250 2
+ -25990 14810 -2271 2
+ -25959 14874 -2209 2
+ -26004 14809 -2122 2
+ -26033 14757 -2123 2
+ -26040 14746 -2114 2
+ -26017 14805 -1975 2
+ -26002 14851 -1819 2
+ -25955 14941 -1769 2
+ -25974 14912 -1720 2
+ -25993 14898 -1553 2
+ -26008 14887 -1405 2
+ -26044 14836 -1268 2
+ -26070 14802 -1124 2
+ -26052 14844 -973 2
+ -26023 14902 -864 2
+ -26058 14846 -737 2
+ -26093 14792 -614 2
+ -26140 14710 -555 2
+ -26177 14646 -517 2
+ -26198 14612 -379 2
+ -26171 14664 -247 2
+ -26190 14631 -109 2
+ -26131 14738 -43 2
+ -26135 14730 79 2
+ -26171 14665 200 2
+ -26221 14573 317 2
+ -26192 14621 420 2
+ -26144 14710 308 2
+ -26107 14777 174 2
+ -26057 14865 200 2
+ -26000 14963 277 2
+ -25981 14998 219 2
+ -25966 15025 119 2
+ -25959 15037 15 2
+ -25954 15046 -153 2
+ -25892 15153 -106 2
+ -25909 15124 34 2
+ -25933 15082 176 2
+ -25897 15141 309 2
+ -25872 15180 469 2
+ -25877 15166 598 2
+ -25874 15165 749 2
+ -25819 15251 884 2
+ -25878 15147 958 2
+ -25900 15107 996 2
+ -25864 15158 1143 2
+ -25833 15202 1259 2
+ -25824 15210 1336 2
+ -25828 15189 1482 2
+ -25813 15197 1658 2
+ -25841 15137 1767 2
+ -25860 15080 1968 2
+ -25900 15002 2027 2
+ -25956 14894 2113 2
+ -25947 14883 2286 2
+ -25916 14918 2407 2
+ -25865 14985 2538 2
+ -25822 15040 2655 2
+ -25834 14992 2804 2
+ -25873 14902 2916 2
+ -25922 14799 3010 2
+ -25968 14696 3115 2
+ -25997 14617 3239 2
+ -26039 14521 3335 2
+ -26097 14408 3368 2
+ -26180 14260 3356 2
+ -26251 14137 3325 2
+ -26322 14004 3323 2
+ -26308 14016 3381 2
+ -26296 14017 3472 2
+ -26382 13868 3413 2
+ -26429 13770 3450 2
+ -26488 13638 3522 2
+ -26502 13577 3647 2
+ -26551 13454 3751 2
+ -26590 13368 3779 2
+ -26651 13228 3839 2
+ -26693 13121 3916 2
+ -26708 13047 4060 2
+ -26752 12931 4139 2
+ -26802 12802 4214 2
+ -26812 12749 4308 2
+ -26774 12775 4466 2
+ -26730 12842 4539 2
+ -26661 12975 4565 2
+ -26597 13086 4623 2
+ -26525 13228 4630 2
+ -26453 13369 4638 2
+ -26387 13501 4634 2
+ -26329 13626 4592 2
+ -26286 13735 4517 2
+ -26220 13880 4457 2
+ -26164 14005 4393 2
+ -26111 14126 4322 2
+ -26055 14250 4254 2
+ -25989 14385 4203 2
+ -25982 14385 4243 2
+ -26028 14283 4307 2
+ -26094 14155 4331 2
+ -26120 14099 4354 2
+ -26022 14289 4322 2
+ -25964 14411 4265 2
+ -25913 14529 4176 2
+ -25861 14643 4098 2
+ -25802 14765 4030 2
+ -25740 14890 3968 2
+ -25675 15014 3921 2
+ -25606 15143 3878 2
+ -25538 15268 3834 2
+ -25446 15426 3809 2
+ -25386 15518 3838 2
+ -25309 15637 3868 2
+ -25233 15749 3910 2
+ -25160 15848 3977 2
+ -25077 15958 4063 2
+ -25005 16072 4052 2
+ -25001 16067 4097 2
+ -24977 16088 4165 2
+ -24927 16137 4270 2
+ -24849 16220 4407 2
+ -24791 16279 4515 2
+ -24721 16358 4614 2
+ -24640 16459 4687 2
+ -24559 16561 4750 2
+ -24478 16656 4835 2
+ -24408 16724 4959 2
+ -24371 16735 5099 2
+ -24308 16795 5198 2
+ -24227 16895 5254 2
+ -24136 16992 5361 2
+ -24075 17060 5417 2
+ -24027 17085 5551 2
+ -23932 17154 5744 2
+ -23928 17213 5583 2
+ -23905 17222 5652 2
+ -23833 17311 5687 2
+ -23807 17396 5532 2
+ -23797 17405 5547 2
+ -23767 17396 5701 2
+ -23749 17371 5851 2
+ -23665 17450 5955 2
+ -23578 17559 5980 2
+ -23611 17544 5892 2
+ -23597 17575 5856 2
+ -23592 17616 5753 2
+ -23591 17656 5632 2
+ -23586 17679 5581 2
+ -23523 17707 5755 2
+ -23483 17718 5884 2
+ -23441 17772 5887 2
+ -23381 17866 5841 2
+ -23373 17864 5880 2
+ -23448 17747 5938 2
+ -23529 17609 6026 2
+ -23509 17638 6018 2
+ -23443 17751 5942 2
+ -23368 17869 5887 2
+ -23294 17990 5812 2
+ -23313 18014 5657 2
+ -23284 18090 5532 2
+ -23266 18169 5345 2
+ -23253 18165 5415 2
+ -23262 18094 5611 2
+ -23197 18206 5519 2
+ -23184 18197 5600 2
+ -23125 18261 5636 2
+ -23093 18337 5522 2
+ -23018 18483 5342 2
+ -23042 18431 5419 2
+ -23078 18343 5562 2
+ -23011 18412 5610 2
+ -22968 18502 5487 2
+ -22954 18565 5333 2
+ -22933 18629 5200 2
+ -22815 18768 5220 2
+ -22889 18676 5225 2
+ -22920 18602 5352 2
+ -22935 18531 5527 2
+ -22854 18648 5470 2
+ -22798 18717 5471 2
+ -22692 18852 5446 2
+ -22624 18937 5435 2
+ -22551 19013 5474 2
+ -22457 19086 5605 2
+ -22495 19037 5618 2
+ -22599 18931 5561 2
+ -22690 18823 5554 2
+ -22737 18749 5614 2
+ -22797 18681 5594 2
+ -22839 18600 5693 2
+ -22867 18544 5763 2
+ -22929 18449 5820 2
+ -23015 18344 5812 2
+ -23146 18184 5796 2
+ -23082 18246 5859 2
+ -23004 18325 5918 2
+ -22904 18437 5955 2
+ -22804 18545 6006 2
+ -22707 18650 6049 2
+ -22635 18749 6013 2
+ -22561 18869 5913 2
+ -22484 18982 5846 2
+ -22408 19095 5768 2
+ -22318 19188 5806 2
+ -22263 19234 5867 2
+ -22411 19083 5793 2
+ -22458 18990 5916 2
+ -22488 18905 6073 2
+ -22389 18990 6171 2
+ -22304 19070 6232 2
+ -22151 19225 6302 2
+ -22111 19265 6322 2
+ -22014 19377 6319 2
+ -21956 19463 6253 2
+ -21883 19554 6226 2
+ -21724 19720 6259 2
+ -21805 19624 6278 2
+ -21786 19630 6328 2
+ -21696 19699 6420 2
+ -21613 19749 6545 2
+ -21543 19787 6662 2
+ -21483 19799 6816 2
+ -21431 19810 6949 2
+ -21371 19822 7096 2
+ -21240 19941 7156 2
+ -21223 19920 7263 2
+ -21161 19933 7409 2
+ -21118 19926 7547 2
+ -21027 19996 7619 2
+ -20987 20038 7618 2
+ -21079 19985 7502 2
+ -21024 20085 7389 2
+ -20967 20195 7250 2
+ -20852 20301 7285 2
+ -20787 20383 7239 2
+ -20672 20498 7247 2
+ -20551 20602 7296 2
+ -20447 20690 7337 2
+ -20337 20768 7421 2
+ -20289 20802 7459 2
+ -20261 20810 7514 2
+ -20186 20840 7630 2
+ -20094 20905 7694 2
+ -19973 21013 7715 2
+ -19976 20983 7789 2
+ -19914 21009 7877 2
+ -19860 21012 8005 2
+ -19780 21051 8099 2
+ -19695 21088 8209 2
+ -19586 21162 8280 2
+ -19506 21256 8228 2
+ -19478 21265 8272 2
+ -19438 21249 8403 2
+ -19312 21313 8532 2
+ -19282 21305 8620 2
+ -19189 21343 8733 2
+ -19084 21399 8827 2
+ -18977 21451 8930 2
+ -18856 21558 8928 2
+ -18864 21523 8997 2
+ -18868 21494 9057 2
+ -19046 21372 8971 2
+ -19014 21357 9074 2
+ -18948 21358 9210 2
+ -18876 21349 9377 2
+ -18914 21327 9351 2
+ -19044 21258 9244 2
+ -19051 21295 9143 2
+ -19118 21281 9036 2
+ -19221 21228 8939 2
+ -19380 21134 8819 2
+ -19445 21089 8784 2
+ -19549 21029 8695 2
+ -19652 20934 8692 2
+ -19748 20831 8723 2
+ -19789 20752 8816 2
+ -19809 20675 8952 2
+ -19727 20707 9058 2
+ -19632 20756 9153 2
+ -19524 20830 9216 2
+ -19401 20920 9271 2
+ -19319 20983 9301 2
+ -19220 21055 9341 2
+ -19197 21030 9445 2
+ -19114 21070 9525 2
+ -19012 21109 9642 2
+ -18919 21134 9767 2
+ -18827 21176 9856 2
+ -18715 21222 9969 2
+ -18622 21261 10058 2
+ -18499 21305 10192 2
+ -18477 21362 10112 2
+ -18441 21447 9997 2
+ -18461 21490 9867 2
+ -18491 21501 9787 2
+ -18596 21455 9687 2
+ -18624 21477 9587 2
+ -18688 21503 9402 2
+ -18722 21530 9270 2
+ -18700 21601 9149 2
+ -18695 21652 9038 2
+ -18712 21699 8891 2
+ -18632 21809 8787 2
+ -18564 21897 8711 2
+ -18524 21977 8594 2
+ -18390 22085 8606 2
+ -18267 22189 8601 2
+ -18265 22229 8502 2
+ -18373 22187 8375 2
+ -18368 22228 8279 2
+ -18367 22278 8144 2
+ -18414 22302 7973 2
+ -18382 22321 7992 2
+ -18303 22342 8115 2
+ -18261 22330 8240 2
+ -18228 22304 8384 2
+ -18118 22354 8486 2
+ -18006 22419 8554 2
+ -17886 22486 8628 2
+ -17804 22581 8549 2
+ -17743 22663 8460 2
+ -17754 22708 8316 2
+ -17797 22726 8172 2
+ -17864 22722 8038 2
+ -17938 22709 7907 2
+ -18027 22679 7791 2
+ -18126 22637 7683 2
+ -18220 22599 7570 2
+ -18318 22555 7464 2
+ -18416 22510 7358 2
+ -18522 22452 7268 2
+ -18625 22397 7175 2
+ -18740 22324 7101 2
+ -18852 22251 7034 2
+ -18968 22168 6985 2
+ -19081 22090 6925 2
+ -19195 22008 6870 2
+ -19304 21936 6794 2
+ -19419 21880 6647 2
+ -19366 21925 6653 2
+ -19262 21990 6741 2
+ -19141 22081 6788 2
+ -19033 22150 6863 2
+ -18916 22233 6920 2
+ -18803 22331 6911 2
+ -18787 22388 6771 2
+ -18813 22431 6552 2
+ -18789 22429 6626 2
+ -18773 22398 6774 2
+ -18761 22362 6926 2
+ -18653 22424 7017 2
+ -18535 22510 7055 2
+ -18421 22586 7110 2
+ -18290 22663 7204 2
+ -18206 22704 7283 2
+ -18114 22743 7393 2
+ -18028 22770 7517 2
+ -17908 22862 7527 2
+ -17795 22943 7545 2
+ -17656 23022 7632 2
+ -17579 23055 7710 2
+ -17509 23068 7830 2
+ -17428 23081 7973 2
+ -17370 23076 8111 2
+ -17301 23080 8247 2
+ -17238 23078 8384 2
+ -17178 23072 8521 2
+ -17114 23071 8651 2
+ -17039 23078 8778 2
+ -16983 23069 8909 2
+ -16931 23037 9090 2
+ -16887 23034 9180 2
+ -16788 23054 9310 2
+ -16714 23059 9429 2
+ -16638 23066 9547 2
+ -16530 23112 9622 2
+ -16396 23184 9678 2
+ -16267 23249 9739 2
+ -16152 23324 9751 2
+ -16020 23395 9799 2
+ -15921 23419 9904 2
+ -15797 23459 10006 2
+ -15716 23463 10124 2
+ -15625 23484 10216 2
+ -15493 23548 10269 2
+ -15373 23597 10338 2
+ -15229 23679 10362 2
+ -15155 23764 10276 2
+ -15169 23817 10133 2
+ -15102 23837 10185 2
+ -15015 23913 10137 2
+ -14935 23981 10093 2
+ -14838 24056 10057 2
+ -14803 24132 9925 2
+ -14824 24180 9776 2
+ -14980 24142 9632 2
+ -14885 24212 9604 2
+ -14821 24289 9507 2
+ -14833 24329 9385 2
+ -14913 24334 9243 2
+ -14925 24303 9307 2
+ -14955 24292 9286 2
+ -15065 24265 9181 2
+ -15192 24206 9126 2
+ -15299 24159 9071 2
+ -15427 24114 8975 2
+ -15552 24055 8917 2
+ -15533 24079 8884 2
+ -15479 24176 8713 2
+ -15426 24163 8844 2
+ -15308 24213 8910 2
+ -15207 24235 9022 2
+ -15036 24297 9140 2
+ -15134 24286 9006 2
+ -15064 24308 9065 2
+ -14958 24335 9167 2
+ -14851 24374 9240 2
+ -14697 24423 9354 2
+ -14676 24483 9230 2
+ -14728 24505 9089 2
+ -14771 24532 8946 2
+ -14738 24604 8800 2
+ -14890 24546 8704 2
+ -14811 24594 8704 2
+ -14797 24634 8616 2
+ -14891 24623 8482 2
+ -14791 24706 8416 2
+ -14720 24782 8316 2
+ -14731 24821 8181 2
+ -14707 24883 8033 2
+ -14678 24948 7883 2
+ -14606 25022 7782 2
+ -14553 25097 7637 2
+ -14566 25078 7678 2
+ -14507 25080 7781 2
+ -14347 25162 7812 2
+ -14310 25225 7675 2
+ -14284 25288 7514 2
+ -14199 25329 7537 2
+ -14105 25411 7439 2
+ -14084 25451 7341 2
+ -14133 25463 7206 2
+ -14080 25488 7222 2
+ -13988 25542 7207 2
+ -14040 25552 7069 2
+ -14023 25572 7032 2
+ -13867 25646 7071 2
+ -13808 25707 6964 2
+ -13836 25723 6847 2
+ -13776 25761 6824 2
+ -13713 25818 6736 2
+ -13644 25875 6659 2
+ -13542 25958 6541 2
+ -13534 25982 6462 2
+ -13514 26002 6425 2
+ -13440 26051 6379 2
+ -13551 26009 6315 2
+ -13681 25940 6320 2
+ -13827 25852 6363 2
+ -13926 25804 6341 2
+ -14022 25746 6366 2
+ -14071 25718 6373 2
+ -14166 25677 6324 2
+ -14316 25579 6383 2
+ -14282 25606 6354 2
+ -14265 25647 6225 2
+ -14412 25576 6177 2
+ -14522 25534 6091 2
+ -14674 25461 6033 2
+ -14624 25508 5958 2
+ -14545 25568 5891 2
+ -14602 25547 5842 2
+ -14734 25471 5845 2
+ -14894 25410 5699 2
+ -14833 25436 5746 2
+ -14724 25479 5834 2
+ -14581 25564 5821 2
+ -14487 25634 5748 2
+ -14450 25684 5615 2
+ -14513 25677 5483 2
+ -14630 25637 5355 2
+ -14543 25688 5352 2
+ -14462 25720 5418 2
+ -14351 25790 5376 2
+ -14251 25864 5288 2
+ -14133 25938 5243 2
+ -14118 25971 5117 2
+ -14154 25985 4945 2
+ -14145 25985 4972 2
+ -14100 25983 5109 2
+ -14016 26012 5188 2
+ -13888 26094 5123 2
+ -13759 26163 5119 2
+ -13634 26229 5112 2
+ -13697 26213 5027 2
+ -13677 26249 4889 2
+ -13706 26261 4745 2
+ -13708 26287 4589 2
+ -13619 26350 4494 2
+ -13553 26398 4408 2
+ -13493 26449 4287 2
+ -13453 26484 4193 2
+ -13386 26536 4082 2
+ -13329 26586 3943 2
+ -13376 26580 3823 2
+ -13494 26536 3706 2
+ -13493 26556 3569 2
+ -13537 26551 3433 2
+ -13499 26591 3270 2
+ -13485 26616 3121 2
+ -13513 26618 2983 2
+ -13628 26570 2883 2
+ -13762 26500 2893 2
+ -13884 26428 2962 2
+ -13974 26369 3061 2
+ -14115 26294 3065 2
+ -14241 26230 3029 2
+ -14316 26182 3092 2
+ -14426 26112 3165 2
+ -14562 26031 3217 2
+ -14643 25976 3289 2
+ -14790 25895 3271 2
+ -14907 25834 3224 2
+ -15013 25776 3192 2
+ -15140 25711 3121 2
+ -15256 25645 3098 2
+ -15328 25594 3166 2
+ -15389 25540 3300 2
+ -15443 25489 3438 2
+ -15515 25429 3555 2
+ -15611 25358 3646 2
+ -15717 25281 3721 2
+ -15831 25201 3783 2
+ -15952 25118 3823 2
+ -16075 25035 3853 2
+ -16200 24952 3870 2
+ -16326 24873 3846 2
+ -16458 24796 3777 2
+ -16564 24734 3723 2
+ -16675 24673 3633 2
+ -16774 24620 3534 2
+ -16865 24573 3425 2
+ -16946 24534 3303 2
+ -17046 24486 3139 2
+ -17127 24427 3163 2
+ -17234 24338 3260 2
+ -17309 24275 3334 2
+ -17422 24188 3377 2
+ -17527 24109 3406 2
+ -17657 24006 3454 2
+ -17760 23921 3515 2
+ -17869 23832 3570 2
+ -17971 23742 3654 2
+ -18082 23661 3629 2
+ -18195 23585 3563 2
+ -18366 23445 3614 2
+ -18332 23487 3511 2
+ -18336 23498 3410 2
+ -18450 23417 3355 2
+ -18599 23284 3452 2
+ -18558 23327 3389 2
+ -18498 23391 3267 2
+ -18498 23412 3120 2
+ -18603 23344 2996 2
+ -18581 23362 2997 2
+ -18470 23438 3089 2
+ -18359 23530 3044 2
+ -18280 23605 2942 2
+ -18226 23661 2822 2
+ -18186 23710 2659 2
+ -18126 23755 2672 2
+ -18019 23847 2581 2
+ -17934 23922 2478 2
+ -17831 24003 2425 2
+ -17717 24086 2442 2
+ -17600 24174 2419 2
+ -17482 24262 2394 2
+ -17385 24339 2319 2
+ -17257 24430 2318 2
+ -17129 24518 2335 2
+ -17012 24604 2282 2
+ -17002 24626 2125 2
+ -17000 24642 1945 2
+ -16999 24649 1866 2
+ -17000 24659 1714 2
+ -17023 24653 1565 2
+ -17090 24616 1409 2
+ -17030 24657 1419 2
+ -16938 24726 1326 2
+ -16874 24775 1201 2
+ -16838 24806 1057 2
+ -16795 24841 914 2
+ -16761 24870 755 2
+ -16686 24923 669 2
+ -16582 24994 577 2
+ -16508 25045 453 2
+ -16423 25103 334 2
+ -16383 25131 197 2
+ -16347 25155 50 2
+ -16282 25197 -84 2
+ -16232 25228 -219 2
+ -16243 25220 -366 2
+ -16287 25189 -506 2
+ -16327 25158 -706 2
+ -16217 25230 -696 2
+ -16093 25308 -708 2
+ -15970 25385 -757 2
+ -15843 25463 -784 2
+ -15722 25537 -827 2
+ -15576 25625 -872 2
+ -15525 25651 -1003 2
+ -15557 25626 -1135 2
+ -15696 25539 -1174 2
+ -15687 25544 -1185 2
+ -15559 25624 -1157 2
+ -15492 25662 -1217 2
+ -15380 25725 -1295 2
+ -15256 25800 -1264 2
+ -15129 25875 -1267 2
+ -14991 25955 -1257 2
+ -14870 26027 -1224 2
+ -14730 26107 -1198 2
+ -14619 26173 -1128 2
+ -14496 26244 -1048 2
+ -14375 26312 -1001 2
+ -14261 26377 -950 2
+ -14150 26439 -851 2
+ -14065 26486 -800 2
+ -13964 26542 -729 2
+ -13953 26549 -664 2
+ -13858 26600 -637 2
+ -13810 26627 -531 2
+ -13747 26660 -541 2
+ -13687 26691 -507 2
+ -13700 26687 -346 2
+ -13635 26721 -205 2
+ -13529 26776 -164 2
+ -13424 26828 -216 2
+ -13352 26863 -346 2
+ -13315 26878 -514 2
+ -13232 26917 -604 2
+ -13186 26936 -765 2
+ -13107 26972 -840 2
+ -13104 26975 -791 2
+ -13183 26940 -661 2
+ -13242 26914 -500 2
+ -13277 26899 -369 2
+ -13336 26872 -241 2
+ -13318 26881 -105 2
+ -13200 26940 -13 2
+ -13099 26989 19 2
+ -13130 26974 132 2
+ -13146 26965 258 2
+ -13096 26988 390 2
+ -12993 27036 468 2
+ -12866 27096 533 2
+ -12756 27146 597 2
+ -12615 27211 657 2
+ -12538 27249 561 2
+ -12540 27250 417 2
+ -12525 27259 263 2
+ -12447 27296 149 2
+ -12341 27344 55 2
+ -12273 27374 -76 2
+ -12254 27382 -243 2
+ -12231 27393 -219 2
+ -12256 27382 -30 2
+ -12249 27385 82 2
+ -12349 27340 253 2
+ -12410 27311 321 2
+ -12499 27269 437 2
+ -12487 27271 594 2
+ -12384 27316 688 2
+ -12263 27369 765 2
+ -12135 27423 842 2
+ -11976 27496 727 2
+ -11916 27518 875 2
+ -11977 27488 986 2
+ -12019 27464 1131 2
+ -12022 27457 1254 2
+ -11983 27472 1300 2
+ -11852 27533 1215 2
+ -11714 27597 1077 2
+ -11749 27578 1187 2
+ -11808 27550 1255 2
+ -11924 27496 1340 2
+ -11878 27510 1449 2
+ -11785 27544 1563 2
+ -11670 27589 1628 2
+ -11569 27626 1722 2
+ -11417 27688 1746 2
+ -11298 27740 1691 2
+ -11202 27785 1584 2
+ -11067 27842 1527 2
+ -10958 27890 1446 2
+ -10902 27909 1500 2
+ -10836 27928 1622 2
+ -10702 27982 1575 2
+ -10582 28027 1589 2
+ -10503 28064 1451 2
+ -10426 28100 1302 2
+ -10385 28113 1347 2
+ -10335 28132 1324 2
+ -10341 28137 1174 2
+ -10296 28159 1028 2
+ -10318 28157 858 2
+ -10419 28120 824 2
+ -10546 28073 843 2
+ -10673 28021 946 2
+ -10800 27973 927 2
+ -10889 27942 827 2
+ -11037 27884 816 2
+ -11181 27827 786 2
+ -11303 27780 722 2
+ -11478 27709 692 2
+ -11595 27663 566 2
+ -11508 27701 477 2
+ -11396 27749 383 2
+ -11265 27803 327 2
+ -11112 27864 353 2
+ -11021 27899 416 2
+ -10880 27955 385 2
+ -10764 28001 306 2
+ -10653 28044 176 2
+ -10734 28014 69 2
+ -10888 27954 46 2
+ -11050 27891 -26 2
+ -10974 27921 -101 2
+ -10831 27976 -97 2
+ -10635 28051 -188 2
+ -10549 28084 -110 2
+ -10478 28110 -208 2
+ -10467 28113 -310 2
+ -10413 28131 -457 2
+ -10325 28164 -431 2
+ -10168 28222 -363 2
+ -10052 28263 -368 2
+ -9932 28305 -423 2
+ -9807 28347 -499 2
+ -9649 28402 -491 2
+ -9521 28444 -546 2
+ -9389 28485 -658 2
+ -9319 28507 -733 2
+ -9296 28512 -811 2
+ -9421 28467 -928 2
+ -9535 28428 -955 2
+ -9611 28398 -1082 2
+ -9734 28355 -1114 2
+ -9894 28302 -1059 2
+ -10004 28260 -1129 2
+ -10140 28211 -1151 2
+ -10282 28162 -1080 2
+ -10371 28133 -972 2
+ -10426 28117 -848 2
+ -10497 28095 -698 2
+ -10580 28065 -660 2
+ -10581 28064 -694 2
+ -10548 28075 -727 2
+ -10655 28033 -785 2
+ -10786 27981 -854 2
+ -10773 27989 -735 2
+ -10905 27940 -687 2
+ -11001 27900 -771 2
+ -11109 27854 -862 2
+ -11166 27827 -1005 2
+ -11249 27790 -1093 2
+ -11374 27739 -1091 2
+ -11515 27682 -1067 2
+ -11659 27621 -1081 2
+ -11700 27599 -1173 2
+ -11795 27558 -1199 2
+ -11681 27604 -1251 2
+ -11643 27626 -1116 2
+ -11530 27671 -1176 2
+ -11402 27720 -1256 2
+ -11284 27770 -1224 2
+ -11103 27845 -1175 2
+ -11123 27833 -1271 2
+ -11054 27859 -1298 2
+ -10922 27903 -1450 2
+ -10953 27885 -1572 2
+ -11001 27862 -1645 2
+ -11150 27804 -1609 2
+ -11169 27804 -1479 2
+ -11298 27754 -1438 2
+ -11265 27760 -1569 2
+ -11119 27814 -1652 2
+ -11186 27785 -1690 2
+ -11216 27765 -1817 2
+ -11157 27780 -1954 2
+ -11134 27777 -2118 2
+ -11147 27761 -2259 2
+ -11104 27766 -2399 2
+ -11010 27792 -2525 2
+ -10895 27829 -2619 2
+ -10857 27828 -2785 2
+ -10732 27869 -2857 2
+ -10617 27906 -2927 2
+ -10475 27960 -2921 2
+ -10373 27988 -3013 2
+ -10388 27966 -3162 2
+ -10400 27944 -3312 2
+ -10412 27922 -3458 2
+ -10550 27861 -3529 2
+ -10593 27861 -3401 2
+ -10587 27880 -3257 2
+ -10567 27909 -3070 2
+ -10642 27875 -3117 2
+ -10684 27847 -3221 2
+ -10693 27821 -3411 2
+ -10801 27769 -3493 2
+ -10955 27709 -3489 2
+ -11107 27650 -3482 2
+ -11215 27600 -3532 2
+ -11389 27521 -3586 2
+ -11321 27544 -3626 2
+ -11137 27612 -3684 2
+ -11087 27643 -3599 2
+ -10905 27708 -3656 2
+ -10867 27713 -3730 2
+ -10728 27760 -3779 2
+ -10609 27795 -3856 2
+ -10570 27795 -3967 2
+ -10574 27771 -4121 2
+ -10542 27761 -4266 2
+ -10506 27751 -4415 2
+ -10438 27756 -4547 2
+ -10354 27765 -4678 2
+ -10227 27790 -4810 2
+ -10113 27847 -4722 2
+ -10127 27864 -4587 2
+ -10080 27896 -4496 2
+ -9938 27943 -4519 2
+ -9806 27980 -4581 2
+ -9698 27994 -4720 2
+ -9677 27983 -4830 2
+ -9590 27994 -4935 2
+ -9474 28014 -5048 2
+ -9342 28046 -5115 2
+ -9229 28065 -5215 2
+ -9117 28083 -5314 2
+ -8977 28119 -5358 2
+ -8846 28148 -5425 2
+ -8748 28156 -5540 2
+ -8710 28144 -5662 2
+ -8792 28091 -5793 2
+ -8730 28084 -5925 2
+ -8588 28141 -5857 2
+ -8453 28195 -5798 2
+ -8413 28196 -5849 2
+ -8495 28146 -5967 2
+ -8584 28093 -6092 2
+ -8505 28094 -6195 2
+ -8358 28137 -6201 2
+ -8223 28186 -6161 2
+ -8082 28234 -6125 2
+ -7912 28279 -6141 2
+ -7981 28243 -6218 2
+ -8036 28196 -6356 2
+ -8045 28159 -6506 2
+ -7973 28153 -6623 2
+ -7953 28124 -6766 2
+ -8019 28064 -6936 2
+ -7933 28088 -6939 2
+ -7880 28070 -7070 2
+ -7878 28038 -7199 2
+ -7941 27989 -7317 2
+ -7917 27970 -7418 2
+ -7847 28016 -7317 2
+ -7835 28055 -7180 2
+ -7819 28097 -7029 2
+ -7868 28117 -6893 2
+ -7893 28141 -6767 2
+ -7860 28204 -6540 2
+ -7761 28211 -6628 2
+ -7748 28179 -6775 2
+ -7704 28147 -6955 2
+ -7674 28132 -7050 2
+ -7679 28093 -7201 2
+ -7639 28066 -7343 2
+ -7643 28025 -7496 2
+ -7753 27970 -7588 2
+ -7708 27975 -7615 2
+ -7623 27969 -7721 2
+ -7515 27980 -7787 2
+ -7390 27990 -7869 2
+ -7252 28011 -7924 2
+ -7078 28049 -7948 2
+ -6958 28076 -7959 2
+ -6802 28111 -7970 2
+ -6685 28120 -8037 2
+ -6550 28128 -8120 2
+ -6415 28150 -8150 2
+ -6270 28180 -8159 2
+ -6118 28206 -8185 2
+ -6013 28201 -8281 2
+ -5913 28189 -8392 2
+ -5777 28206 -8429 2
+ -5631 28223 -8472 2
+ -5507 28224 -8550 2
+ -5356 28244 -8577 2
+ -5216 28263 -8603 2
+ -5069 28279 -8636 2
+ -4945 28273 -8727 2
+ -4830 28267 -8813 2
+ -4670 28287 -8833 2
+ -4548 28333 -8751 2
+ -4412 28349 -8769 2
+ -4288 28336 -8869 2
+ -4127 28371 -8834 2
+ -4040 28342 -8965 2
+ -3985 28375 -8888 2
+ -3846 28417 -8812 2
+ -3773 28392 -8924 2
+ -3731 28354 -9062 2
+ -3627 28334 -9166 2
+ -3494 28331 -9227 2
+ -3445 28297 -9350 2
+ -3486 28257 -9454 2
+ -3420 28273 -9431 2
+ -3314 28258 -9513 2
+ -3174 28232 -9638 2
+ -3108 28217 -9702 2
+ -3071 28175 -9836 2
+ -3044 28129 -9974 2
+ -3055 28076 -10119 2
+ -3014 28032 -10254 2
+ -2925 27998 -10370 2
+ -2790 27986 -10441 2
+ -2642 27983 -10487 2
+ -2595 27954 -10575 2
+ -2575 27894 -10736 2
+ -2625 27871 -10785 2
+ -2761 27836 -10842 2
+ -2901 27803 -10889 2
+ -3021 27768 -10946 2
+ -3159 27721 -11025 2
+ -3240 27665 -11142 2
+ -3349 27629 -11198 2
+ -3509 27626 -11157 2
+ -3667 27608 -11151 2
+ -3735 27541 -11294 2
+ -3852 27535 -11270 2
+ -4010 27522 -11245 2
+ -3943 27493 -11340 2
+ -3803 27510 -11347 2
+ -3598 27573 -11259 2
+ -3658 27539 -11322 2
+ -3837 27469 -11433 2
+ -3795 27421 -11562 2
+ -3650 27418 -11617 2
+ -3509 27424 -11646 2
+ -3353 27447 -11638 2
+ -3324 27520 -11472 2
+ -3182 27525 -11500 2
+ -3075 27497 -11595 2
+ -2988 27457 -11714 2
+ -2918 27436 -11779 2
+ -2791 27412 -11866 2
+ -2695 27375 -11973 2
+ -2590 27343 -12069 2
+ -2610 27309 -12142 2
+ -2802 27273 -12179 2
+ -2949 27258 -12179 2
+ -2887 27231 -12252 2
+ -2937 27185 -12342 2
+ -3001 27138 -12431 2
+ -3114 27093 -12501 2
+ -3265 27076 -12498 2
+ -3389 27076 -12466 2
+ -3516 27094 -12391 2
+ -3710 27086 -12352 2
+ -3810 27069 -12360 2
+ -3878 27082 -12309 2
+ -3969 27129 -12176 2
+ -4086 27157 -12074 2
+ -4194 27134 -12089 2
+ -4155 27072 -12241 2
+ -4241 27018 -12330 2
+ -4320 26954 -12442 2
+ -4354 26891 -12566 2
+ -4282 26845 -12690 2
+ -4123 26842 -12747 2
+ -4046 26811 -12837 2
+ -3979 26761 -12961 2
+ -3838 26749 -13030 2
+ -3714 26787 -12987 2
+ -3634 26748 -13089 2
+ -3608 26674 -13247 2
+ -3651 26611 -13360 2
+ -3542 26599 -13415 2
+ -3487 26539 -13548 2
+ -3479 26464 -13695 2
+ -3433 26411 -13807 2
+ -3481 26358 -13896 2
+ -3604 26284 -14006 2
+ -3661 26311 -13940 2
+ -3722 26371 -13810 2
+ -3726 26363 -13824 2
+ -3689 26299 -13956 2
+ -3766 26245 -14037 2
+ -3903 26209 -14067 2
+ -4065 26218 -14002 2
+ -4126 26176 -14063 2
+ -4012 26157 -14132 2
+ -3852 26203 -14091 2
+ -3766 26142 -14226 2
+ -3833 26088 -14308 2
+ -3962 26039 -14363 2
+ -4091 25972 -14447 2
+ -4210 25930 -14489 2
+ -4348 25940 -14429 2
+ -4464 25973 -14334 2
+ -4468 26038 -14215 2
+ -4502 26129 -14036 2
+ -4496 26086 -14118 2
+ -4544 26028 -14209 2
+ -4634 25951 -14321 2
+ -4731 25880 -14417 2
+ -4742 25808 -14542 2
+ -4795 25749 -14629 2
+ -4838 25714 -14676 2
+ -4855 25629 -14819 2
+ -4957 25617 -14805 2
+ -5029 25666 -14696 2
+ -5160 25710 -14573 2
+ -5307 25679 -14575 2
+ -5419 25675 -14541 2
+ -5616 25583 -14628 2
+ -5612 25670 -14477 2
+ -5707 25719 -14351 2
+ -5688 25702 -14389 2
+ -5765 25629 -14488 2
+ -5885 25634 -14432 2
+ -5989 25669 -14327 2
+ -6052 25722 -14203 2
+ -6062 25716 -14210 2
+ -6067 25644 -14339 2
+ -6016 25580 -14474 2
+ -6073 25500 -14590 2
+ -6060 25425 -14725 2
+ -6129 25329 -14862 2
+ -6135 25305 -14900 2
+ -6029 25270 -15003 2
+ -5962 25213 -15125 2
+ -5929 25119 -15294 2
+ -5847 25085 -15381 2
+ -5758 25048 -15474 2
+ -5662 24999 -15589 2
+ -5599 24937 -15710 2
+ -5640 24841 -15847 2
+ -5554 24818 -15913 2
+ -5424 24862 -15889 2
+ -5299 24846 -15956 2
+ -5200 24802 -16058 2
+ -5117 24727 -16199 2
+ -5075 24669 -16300 2
+ -4984 24629 -16388 2
+ -4948 24558 -16505 2
+ -4992 24577 -16463 2
+ -5129 24604 -16381 2
+ -5256 24602 -16344 2
+ -5313 24654 -16247 2
+ -5350 24738 -16106 2
+ -5443 24716 -16109 2
+ -5584 24721 -16053 2
+ -5674 24748 -15979 2
+ -5771 24800 -15863 2
+ -5872 24780 -15857 2
+ -5904 24799 -15816 2
+ -5977 24839 -15726 2
+ -6104 24888 -15600 2
+ -6147 24933 -15510 2
+ -6121 24996 -15418 2
+ -6207 25036 -15320 2
+ -6303 25084 -15201 2
+ -6398 25125 -15094 2
+ -6477 25169 -14985 2
+ -6487 25238 -14865 2
+ -6537 25300 -14737 2
+ -6606 25342 -14634 2
+ -6680 25390 -14516 2
+ -6751 25446 -14384 2
+ -6842 25477 -14287 2
+ -6861 25531 -14181 2
+ -6892 25598 -14045 2
+ -6961 25659 -13897 2
+ -6886 25714 -13833 2
+ -6721 25748 -13851 2
+ -6708 25825 -13714 2
+ -6756 25890 -13567 2
+ -6823 25921 -13474 2
+ -6881 25967 -13355 2
+ -6791 26040 -13259 2
+ -6832 26050 -13218 2
+ -6879 26107 -13080 2
+ -6915 26171 -12932 2
+ -6932 26230 -12803 2
+ -7007 26272 -12677 2
+ -7089 26310 -12551 2
+ -7249 26341 -12395 2
+ -7237 26300 -12488 2
+ -7414 26227 -12538 2
+ -7325 26224 -12595 2
+ -7187 26234 -12653 2
+ -7099 26200 -12774 2
+ -7053 26151 -12898 2
+ -7114 26073 -13023 2
+ -7113 26006 -13156 2
+ -7121 25934 -13294 2
+ -7268 25900 -13280 2
+ -7287 25854 -13360 2
+ -7210 25809 -13487 2
+ -7310 25770 -13508 2
+ -7418 25787 -13417 2
+ -7499 25859 -13231 2
+ -7562 25877 -13161 2
+ -7605 25928 -13035 2
+ -7666 25979 -12897 2
+ -7815 25972 -12821 2
+ -7843 26028 -12690 2
+ -7822 26095 -12565 2
+ -7753 26111 -12574 2
+ -7719 26124 -12568 2
+ -7672 26170 -12501 2
+ -7648 26226 -12398 2
+ -7685 26275 -12270 2
+ -7712 26248 -12310 2
+ -7804 26228 -12295 2
+ -7906 26232 -12222 2
+ -7995 26265 -12092 2
+ -8007 26238 -12144 2
+ -8118 26181 -12193 2
+ -8260 26140 -12185 2
+ -8393 26087 -12207 2
+ -8480 26133 -12048 2
+ -8528 26087 -12113 2
+ -8663 26034 -12131 2
+ -8794 25993 -12126 2
+ -8924 25994 -12028 2
+ -9033 26005 -11921 2
+ -9163 25996 -11843 2
+ -9340 25982 -11734 2
+ -9443 25937 -11752 2
+ -9583 25908 -11701 2
+ -9689 25914 -11601 2
+ -9728 25966 -11450 2
+ -9846 25950 -11388 2
+ -9837 25924 -11453 2
+ -9826 25878 -11566 2
+ -9929 25824 -11600 2
+ -10043 25792 -11573 2
+ -10197 25751 -11529 2
+ -10339 25702 -11511 2
+ -10502 25629 -11527 2
+ -10611 25581 -11532 2
+ -10787 25530 -11483 2
+ -10853 25540 -11398 2
+ -10866 25578 -11299 2
+ -10736 25634 -11297 2
+ -10607 25677 -11321 2
+ -10578 25705 -11286 2
+ -10717 25684 -11202 2
+ -10797 25669 -11159 2
+ -10951 25568 -11241 2
+ -11086 25524 -11207 2
+ -11101 25549 -11136 2
+ -10986 25628 -11068 2
+ -10826 25735 -10977 2
+ -10751 25798 -10902 2
+ -10786 25782 -10906 2
+ -10903 25706 -10969 2
+ -11018 25640 -11009 2
+ -11159 25559 -11054 2
+ -11302 25544 -10944 2
+ -11418 25473 -10990 2
+ -11554 25414 -10984 2
+ -11681 25335 -11033 2
+ -11763 25268 -11097 2
+ -11828 25218 -11142 2
+ -11971 25162 -11116 2
+ -12119 25092 -11115 2
+ -12225 25031 -11134 2
+ -12422 24945 -11111 2
+ -12460 24882 -11209 2
+ -12559 24774 -11336 2
+ -12570 24811 -11243 2
+ -12607 24874 -11062 2
+ -12711 24823 -11057 2
+ -12824 24745 -11100 2
+ -12955 24646 -11169 2
+ -12994 24598 -11230 2
+ -13084 24529 -11276 2
+ -13136 24551 -11166 2
+ -13100 24629 -11037 2
+ -13021 24706 -10957 2
+ -12927 24788 -10883 2
+ -12904 24809 -10862 2
+ -13035 24703 -10947 2
+ -13123 24614 -11043 2
+ -13145 24618 -11008 2
+ -13069 24710 -10891 2
+ -13107 24702 -10865 2
+ -13190 24594 -11006 2
+ -13208 24549 -11086 2
+ -13264 24474 -11185 2
+ -13349 24406 -11232 2
+ -13289 24418 -11276 2
+ -13364 24358 -11318 2
+ -13492 24337 -11212 2
+ -13506 24302 -11268 2
+ -13513 24256 -11359 2
+ -13639 24185 -11360 2
+ -13793 24108 -11339 2
+ -13791 24153 -11244 2
+ -13773 24230 -11100 2
+ -13829 24215 -11064 2
+ -13920 24125 -11144 2
+ -14083 24079 -11041 2
+ -14034 24088 -11083 2
+ -13916 24116 -11170 2
+ -13924 24085 -11226 2
+ -14060 24007 -11223 2
+ -14214 23920 -11216 2
+
+
+ 10146 -28113 2593 0
+ 10082 -28127 2692 2
+ 10002 -28145 2798 2
+ 9908 -28166 2916 2
+ 9791 -28198 3005 2
+ 9649 -28247 2996 2
+ 9524 -28289 3001 2
+ 9396 -28324 3073 2
+ 9245 -28371 3096 2
+ 9099 -28421 3078 2
+ 8966 -28467 3043 2
+ 8815 -28512 3057 2
+ 8686 -28544 3131 2
+ 8552 -28578 3185 2
+ 8452 -28596 3293 2
+ 8467 -28573 3446 2
+ 8553 -28535 3547 2
+ 8719 -28482 3569 2
+ 8833 -28444 3595 2
+ 8973 -28405 3559 2
+ 9108 -28368 3508 2
+ 9251 -28321 3514 2
+ 9396 -28266 3572 2
+ 9272 -28298 3639 2
+ 9300 -28275 3749 2
+ 9385 -28234 3844 2
+ 9533 -28184 3845 2
+ 9579 -28184 3729 2
+ 9705 -28146 3689 2
+ 9803 -28101 3774 2
+ 9901 -28074 3720 2
+ 9988 -28043 3720 2
+ 10105 -27995 3765 2
+ 10240 -27945 3775 2
+ 10363 -27900 3771 2
+ 10468 -27847 3869 2
+ 10608 -27784 3938 2
+ 10569 -27783 4048 2
+ 10505 -27787 4185 2
+ 10472 -27777 4333 2
+ 10430 -27770 4477 2
+ 10391 -27761 4625 2
+ 10353 -27749 4773 2
+ 10316 -27738 4919 2
+ 10288 -27722 5067 2
+ 10201 -27732 5187 2
+ 10131 -27735 5304 2
+ 10089 -27720 5460 2
+ 10057 -27705 5593 2
+ 10013 -27692 5734 2
+ 9933 -27694 5864 2
+ 9928 -27670 5981 2
+ 9921 -27641 6129 2
+ 9889 -27620 6272 2
+ 9854 -27599 6419 2
+ 9941 -27559 6455 2
+ 10037 -27519 6477 2
+ 10018 -27489 6633 2
+ 10029 -27451 6773 2
+ 10060 -27404 6914 2
+ 10017 -27383 7058 2
+ 9934 -27380 7187 2
+ 9848 -27379 7309 2
+ 9735 -27392 7411 2
+ 9624 -27403 7515 2
+ 9482 -27441 7555 2
+ 9345 -27477 7596 2
+ 9207 -27512 7636 2
+ 9091 -27571 7562 2
+ 9035 -27625 7432 2
+ 8973 -27652 7406 2
+ 8924 -27629 7549 2
+ 8872 -27610 7680 2
+ 8728 -27637 7745 2
+ 8702 -27685 7604 2
+ 8613 -27719 7582 2
+ 8475 -27747 7632 2
+ 8383 -27748 7733 2
+ 8457 -27697 7832 2
+ 8408 -27675 7963 2
+ 8281 -27725 7921 2
+ 8140 -27758 7953 2
+ 8016 -27771 8033 2
+ 7867 -27808 8050 2
+ 7737 -27823 8124 2
+ 7605 -27837 8201 2
+ 7458 -27879 8192 2
+ 7314 -27905 8236 2
+ 7171 -27934 8263 2
+ 7024 -27967 8278 2
+ 6886 -28005 8264 2
+ 6776 -28066 8149 2
+ 6671 -28115 8065 2
+ 6478 -28164 8052 2
+ 6516 -28123 8162 2
+ 6415 -28154 8137 2
+ 6343 -28131 8270 2
+ 6470 -28084 8332 2
+ 6419 -28074 8406 2
+ 6258 -28123 8363 2
+ 6225 -28095 8480 2
+ 6268 -28055 8580 2
+ 6212 -28025 8718 2
+ 6193 -27983 8864 2
+ 6229 -27930 9006 2
+ 6143 -27914 9114 2
+ 5998 -27951 9098 2
+ 5901 -28003 9001 2
+ 5773 -28054 8925 2
+ 5627 -28092 8899 2
+ 5478 -28121 8898 2
+ 5330 -28151 8896 2
+ 5189 -28158 8956 2
+ 5048 -28168 9004 2
+ 4899 -28192 9012 2
+ 4749 -28212 9031 2
+ 4608 -28219 9080 2
+ 4458 -28237 9098 2
+ 4311 -28251 9126 2
+ 4162 -28267 9145 2
+ 4013 -28282 9167 2
+ 3871 -28285 9217 2
+ 3759 -28266 9322 2
+ 3626 -28260 9393 2
+ 3510 -28242 9489 2
+ 3398 -28222 9590 2
+ 3273 -28207 9676 2
+ 3152 -28191 9763 2
+ 2993 -28210 9760 2
+ 2843 -28229 9750 2
+ 2692 -28241 9756 2
+ 2557 -28232 9820 2
+ 2425 -28228 9864 2
+ 2269 -28242 9861 2
+ 2151 -28277 9788 2
+ 2037 -28314 9703 2
+ 1884 -28310 9745 2
+ 1796 -28276 9860 2
+ 1715 -28239 9981 2
+ 1603 -28207 10089 2
+ 1568 -28233 10021 2
+ 1492 -28266 9939 2
+ 1377 -28228 10065 2
+ 1260 -28259 9992 2
+ 1150 -28293 9909 2
+ 998 -28299 9908 2
+ 846 -28306 9902 2
+ 699 -28319 9877 2
+ 554 -28335 9840 2
+ 410 -28351 9800 2
+ 278 -28377 9730 2
+ 139 -28398 9671 2
+ 30 -28431 9574 2
+ -69 -28467 9466 2
+ -159 -28431 9574 2
+ -286 -28436 9557 2
+ -382 -28416 9612 2
+ -499 -28411 9621 2
+ -646 -28419 9589 2
+ -796 -28420 9575 2
+ -945 -28434 9519 2
+ -1028 -28406 9595 2
+ -970 -28364 9724 2
+ -990 -28322 9842 2
+ -1116 -28335 9793 2
+ -1202 -28372 9673 2
+ -1256 -28416 9537 2
+ -1241 -28469 9381 2
+ -1376 -28490 9296 2
+ -1458 -28441 9433 2
+ -1528 -28395 9559 2
+ -1647 -28359 9647 2
+ -1728 -28378 9577 2
+ -1750 -28424 9434 2
+ -1819 -28467 9290 2
+ -1959 -28429 9379 2
+ -2002 -28462 9269 2
+ -1888 -28499 9178 2
+ -1817 -28543 9056 2
+ -1847 -28585 8916 2
+ -1918 -28620 8787 2
+ -2015 -28649 8671 2
+ -2153 -28658 8606 2
+ -2130 -28683 8529 2
+ -2137 -28715 8419 2
+ -2273 -28722 8361 2
+ -2377 -28746 8248 2
+ -2391 -28797 8065 2
+ -2370 -28825 7969 2
+ -2312 -28846 7911 2
+ -2180 -28837 7979 2
+ -2053 -28822 8065 2
+ -2026 -28850 7973 2
+ -2123 -28873 7863 2
+ -2190 -28903 7733 2
+ -2269 -28930 7608 2
+ -2316 -28962 7474 2
+ -2321 -28999 7326 2
+ -2352 -29032 7185 2
+ -2304 -29072 7035 2
+ -2440 -29082 6951 2
+ -2544 -29092 6868 2
+ -2655 -29102 6783 2
+ -2780 -29106 6717 2
+ -2900 -29114 6630 2
+ -3017 -29124 6533 2
+ -3107 -29144 6401 2
+ -3176 -29160 6294 2
+ -3269 -29175 6173 2
+ -3336 -29196 6041 2
+ -3374 -29221 5897 2
+ -3429 -29242 5756 2
+ -3460 -29267 5608 2
+ -3537 -29283 5477 2
+ -3564 -29307 5330 2
+ -3561 -29334 5181 2
+ -3557 -29360 5032 2
+ -3535 -29388 4884 2
+ -3480 -29417 4747 2
+ -3377 -29446 4641 2
+ -3227 -29464 4635 2
+ -3082 -29484 4604 2
+ -2948 -29491 4650 2
+ -2868 -29478 4779 2
+ -2790 -29464 4907 2
+ -2658 -29454 5042 2
+ -2642 -29468 4966 2
+ -2674 -29489 4819 2
+ -2670 -29515 4664 2
+ -2508 -29536 4622 2
+ -2415 -29560 4514 2
+ -2447 -29578 4376 2
+ -2543 -29588 4252 2
+ -2608 -29601 4118 2
+ -2698 -29610 3996 2
+ -2767 -29621 3862 2
+ -2846 -29630 3734 2
+ -2890 -29644 3588 2
+ -2947 -29655 3449 2
+ -2969 -29670 3302 2
+ -2910 -29691 3159 2
+ -2971 -29698 3030 2
+ -3095 -29694 2944 2
+ -3185 -29697 2824 2
+ -3242 -29703 2685 2
+ -3278 -29712 2539 2
+ -3299 -29722 2390 2
+ -3269 -29737 2242 2
+ -3198 -29754 2109 2
+ -3123 -29773 1946 2
+ -3228 -29763 1943 2
+ -3362 -29744 1997 2
+ -3507 -29730 1954 2
+ -3651 -29716 1902 2
+ -3793 -29702 1852 2
+ -3933 -29687 1798 2
+ -4074 -29671 1743 2
+ -4210 -29656 1675 2
+ -4334 -29643 1589 2
+ -4434 -29634 1475 2
+ -4549 -29621 1378 2
+ -4675 -29605 1292 2
+ -4819 -29584 1259 2
+ -4964 -29562 1210 2
+ -5090 -29548 999 2
+ -5080 -29546 1102 2
+ -5142 -29530 1234 2
+ -5270 -29505 1300 2
+ -5411 -29481 1270 2
+ -5468 -29476 1138 2
+ -5507 -29474 987 2
+ -5400 -29496 904 2
+ -5436 -29491 857 2
+ -5578 -29466 801 2
+ -5687 -29448 707 2
+ -5834 -29419 676 2
+ -5990 -29389 642 2
+ -6021 -29380 734 2
+ -5885 -29406 813 2
+ -5773 -29425 912 2
+ -5719 -29431 1053 2
+ -5738 -29422 1203 2
+ -5846 -29397 1288 2
+ -5979 -29372 1231 2
+ -6067 -29359 1107 2
+ -6174 -29341 978 2
+ -6288 -29317 992 2
+ -6264 -29318 1112 2
+ -6180 -29330 1241 2
+ -6120 -29337 1379 2
+ -6043 -29346 1508 2
+ -5960 -29357 1632 2
+ -6010 -29338 1776 2
+ -6129 -29307 1874 2
+ -6243 -29288 1795 2
+ -6290 -29287 1647 2
+ -6413 -29265 1570 2
+ -6549 -29237 1516 2
+ -6692 -29207 1474 2
+ -6834 -29176 1437 2
+ -6973 -29144 1426 2
+ -7089 -29110 1534 2
+ -7029 -29118 1661 2
+ -6890 -29149 1693 2
+ -6761 -29175 1757 2
+ -6691 -29183 1891 2
+ -6630 -29188 2030 2
+ -6569 -29191 2169 2
+ -6515 -29192 2316 2
+ -6606 -29162 2431 2
+ -6642 -29143 2567 2
+ -6645 -29129 2715 2
+ -6640 -29115 2867 2
+ -6661 -29096 3015 2
+ -6691 -29073 3160 2
+ -6721 -29050 3309 2
+ -6827 -29019 3359 2
+ -6923 -28986 3445 2
+ -7035 -28945 3561 2
+ -6940 -28962 3609 2
+ -6946 -28949 3702 2
+ -7063 -28910 3787 2
+ -7153 -28874 3892 2
+ -7247 -28842 3954 2
+ -7287 -28825 4005 2
+ -7348 -28794 4115 2
+ -7478 -28764 4086 2
+ -7609 -28727 4104 2
+ -7543 -28731 4201 2
+ -7518 -28722 4304 2
+ -7627 -28683 4374 2
+ -7783 -28644 4353 2
+ -7903 -28618 4308 2
+ -7957 -28587 4411 2
+ -8081 -28546 4456 2
+ -8196 -28535 4308 2
+ -8234 -28515 4369 2
+ -8205 -28500 4520 2
+ -8314 -28469 4517 2
+ -8376 -28444 4560 2
+ -8440 -28408 4663 2
+ -8586 -28357 4705 2
+ -8697 -28334 4640 2
+ -8769 -28301 4707 2
+ -8903 -28262 4692 2
+ -8999 -28218 4772 2
+ -9155 -28168 4769 2
+ -9284 -28114 4837 2
+ -9418 -28073 4816 2
+ -9552 -28034 4778 2
+ -9702 -27974 4832 2
+ -9819 -27932 4835 2
+ -9846 -27896 4987 2
+ -9899 -27885 4943 2
+ -9905 -27911 4784 2
+ -9792 -27955 4754 2
+ -9812 -27959 4696 2
+ -9894 -27950 4575 2
+ -10019 -27902 4596 2
+ -10103 -27852 4713 2
+ -10185 -27830 4666 2
+ -10332 -27767 4716 2
+ -10452 -27715 4760 2
+ -10491 -27677 4892 2
+ -10591 -27621 4989 2
+ -10614 -27580 5166 2
+ -10732 -27519 5248 2
+ -10803 -27467 5371 2
+ -10601 -27527 5467 2
+ -10715 -27467 5547 2
+ -10622 -27474 5686 2
+ -10602 -27455 5817 2
+ -10623 -27416 5959 2
+ -10696 -27402 5892 2
+ -10714 -27427 5740 2
+ -10856 -27383 5683 2
+ -10944 -27318 5826 2
+ -11041 -27273 5857 2
+ -11092 -27227 5970 2
+ -11110 -27185 6127 2
+ -11152 -27137 6260 2
+ -11190 -27090 6398 2
+ -11172 -27061 6548 2
+ -11086 -27070 6656 2
+ -11126 -27035 6731 2
+ -11223 -26969 6833 2
+ -11270 -26917 6962 2
+ -11272 -26877 7113 2
+ -11216 -26859 7265 2
+ -11311 -26800 7337 2
+ -11396 -26792 7233 2
+ -11403 -26827 7089 2
+ -11431 -26857 6933 2
+ -11406 -26905 6786 2
+ -11421 -26930 6658 2
+ -11445 -26952 6526 2
+ -11450 -26986 6375 2
+ -11377 -27045 6255 2
+ -11354 -27085 6122 2
+ -11351 -27124 5953 2
+ -11330 -27157 5842 2
+ -11292 -27201 5711 2
+ -11346 -27210 5559 2
+ -11220 -27277 5483 2
+ -11150 -27320 5414 2
+ -11097 -27365 5294 2
+ -11050 -27403 5196 2
+ -11049 -27427 5066 2
+ -11001 -27470 4938 2
+ -10926 -27521 4819 2
+ -10841 -27571 4722 2
+ -10791 -27610 4607 2
+ -10775 -27638 4476 2
+ -10630 -27707 4398 2
+ -10538 -27721 4528 2
+ -10457 -27759 4482 2
+ -10365 -27808 4392 2
+ -10230 -27863 4362 2
+ -10125 -27913 4286 2
+ -10005 -27969 4204 2
+ -9882 -28009 4221 2
+ -9781 -28060 4119 2
+ -9812 -28070 3974 2
+ -9817 -28085 3856 2
+ -9673 -28138 3833 2
+ -9546 -28189 3773 2
+ -9405 -28235 3788 2
+ -9263 -28283 3781 2
+ -9122 -28331 3761 2
+ -8983 -28379 3734 2
+ -8854 -28428 3666 2
+ -8712 -28475 3646 2
+ -8568 -28518 3648 2
+ -8434 -28565 3593 2
+ -8316 -28608 3528 2
+ -8221 -28649 3410 2
+ -8173 -28679 3277 2
+ -8133 -28706 3129 2
+ -8124 -28725 2979 2
+ -8149 -28733 2831 2
+ -8147 -28748 2685 2
+ -8152 -28760 2529 2
+ -8121 -28781 2384 2
+ -8123 -28793 2232 2
+ -8138 -28800 2089 2
+ -8129 -28813 1932 2
+ -8215 -28789 1930 2
+ -8292 -28771 1861 2
+ -8276 -28786 1694 2
+ -8373 -28761 1645 2
+ -8504 -28726 1577 2
+ -8603 -28702 1470 2
+ -8548 -28722 1413 2
+ -8455 -28752 1346 2
+ -8326 -28792 1297 2
+ -8242 -28821 1202 2
+ -8277 -28816 1077 2
+ -8357 -28797 949 2
+ -8395 -28790 809 2
+ -8463 -28774 670 2
+ -8647 -28720 628 2
+ -8617 -28731 519 2
+ -8640 -28726 388 2
+ -8680 -28716 254 2
+ -8866 -28660 171 2
+ -8754 -28694 93 2
+ -8684 -28716 -25 2
+ -8629 -28732 -159 2
+ -8669 -28719 -316 2
+ -8665 -28718 -463 2
+ -8616 -28730 -602 2
+ -8622 -28725 -752 2
+ -8582 -28732 -900 2
+ -8578 -28728 -1047 2
+ -8627 -28708 -1200 2
+ -8676 -28688 -1320 2
+ -8634 -28693 -1468 2
+ -8595 -28697 -1612 2
+ -8567 -28696 -1777 2
+ -8597 -28679 -1893 2
+ -8667 -28651 -2003 2
+ -8557 -28680 -2057 2
+ -8427 -28724 -1985 2
+ -8401 -28740 -1847 2
+ -8426 -28742 -1700 2
+ -8439 -28747 -1547 2
+ -8369 -28775 -1405 2
+ -8291 -28795 -1449 2
+ -8255 -28798 -1596 2
+ -8279 -28782 -1745 2
+ -8226 -28789 -1874 2
+ -8116 -28826 -1797 2
+ -8059 -28849 -1673 2
+ -7916 -28893 -1599 2
+ -7889 -28907 -1464 2
+ -7763 -28943 -1432 2
+ -7688 -28966 -1364 2
+ -7590 -28995 -1288 2
+ -7508 -29012 -1396 2
+ -7480 -29012 -1541 2
+ -7548 -28987 -1668 2
+ -7524 -28983 -1829 2
+ -7475 -28987 -1973 2
+ -7389 -29000 -2101 2
+ -7282 -29019 -2206 2
+ -7255 -29014 -2350 2
+ -7267 -28999 -2504 2
+ -7183 -29005 -2670 2
+ -7310 -28967 -2733 2
+ -7458 -28931 -2718 2
+ -7601 -28887 -2790 2
+ -7620 -28867 -2934 2
+ -7511 -28893 -2965 2
+ -7375 -28933 -2911 2
+ -7266 -28956 -2961 2
+ -7280 -28939 -3084 2
+ -7369 -28908 -3167 2
+ -7492 -28869 -3234 2
+ -7579 -28834 -3341 2
+ -7502 -28843 -3438 2
+ -7347 -28889 -3384 2
+ -7243 -28905 -3472 2
+ -7149 -28914 -3586 2
+ -7141 -28896 -3743 2
+ -7049 -28909 -3816 2
+ -6939 -28926 -3893 2
+ -6838 -28934 -4007 2
+ -6743 -28940 -4127 2
+ -6676 -28935 -4262 2
+ -6581 -28940 -4376 2
+ -6516 -28934 -4516 2
+ -6435 -28931 -4644 2
+ -6350 -28930 -4770 2
+ -6241 -28937 -4871 2
+ -6111 -28951 -4947 2
+ -6008 -28954 -5055 2
+ -5929 -28948 -5186 2
+ -5842 -28943 -5309 2
+ -5713 -28953 -5396 2
+ -5695 -28927 -5552 2
+ -5599 -28924 -5660 2
+ -5448 -28943 -5713 2
+ -5304 -28974 -5690 2
+ -5165 -28988 -5747 2
+ -5032 -28994 -5831 2
+ -4886 -29026 -5800 2
+ -4746 -29044 -5824 2
+ -4628 -29044 -5919 2
+ -4501 -29056 -5958 2
+ -4345 -29072 -5996 2
+ -4211 -29094 -5982 2
+ -4068 -29104 -6036 2
+ -3987 -29149 -5871 2
+ -3883 -29146 -5952 2
+ -3805 -29127 -6095 2
+ -3640 -29149 -6090 2
+ -3670 -29167 -5983 2
+ -3800 -29164 -5917 2
+ -3857 -29183 -5784 2
+ -3851 -29211 -5647 2
+ -3772 -29237 -5566 2
+ -3675 -29269 -5459 2
+ -3587 -29269 -5520 2
+ -3427 -29287 -5525 2
+ -3286 -29306 -5511 2
+ -3188 -29307 -5562 2
+ -3146 -29283 -5711 2
+ -3042 -29279 -5787 2
+ -2965 -29274 -5853 2
+ -2913 -29252 -5988 2
+ -2800 -29243 -6083 2
+ -2675 -29259 -6064 2
+ -2557 -29255 -6134 2
+ -2468 -29282 -6037 2
+ -2391 -29313 -5920 2
+ -2350 -29343 -5784 2
+ -2422 -29368 -5628 2
+ -2566 -29362 -5593 2
+ -2687 -29364 -5524 2
+ -2618 -29394 -5400 2
+ -2457 -29408 -5397 2
+ -2420 -29429 -5297 2
+ -2465 -29451 -5155 2
+ -2557 -29463 -5038 2
+ -2639 -29476 -4917 2
+ -2699 -29494 -4778 2
+ -2778 -29507 -4647 2
+ -2847 -29521 -4515 2
+ -2882 -29540 -4368 2
+ -2855 -29564 -4220 2
+ -2795 -29589 -4086 2
+ -2660 -29610 -4022 2
+ -2522 -29629 -3967 2
+ -2389 -29652 -3880 2
+ -2263 -29659 -3904 2
+ -2192 -29646 -4036 2
+ -2096 -29638 -4148 2
+ -1979 -29632 -4244 2
+ -1828 -29644 -4232 2
+ -1844 -29659 -4116 2
+ -1908 -29675 -3971 2
+ -1822 -29696 -3848 2
+ -1799 -29717 -3700 2
+ -1821 -29734 -3546 2
+ -1814 -29752 -3398 2
+ -1708 -29770 -3290 2
+ -1616 -29788 -3172 2
+ -1550 -29806 -3036 2
+ -1475 -29822 -2907 2
+ -1419 -29838 -2770 2
+ -1410 -29852 -2619 2
+ -1442 -29863 -2471 2
+ -1514 -29870 -2338 2
+ -1600 -29876 -2212 2
+ -1684 -29880 -2086 2
+ -1698 -29888 -1953 2
+ -1575 -29896 -1935 2
+ -1486 -29892 -2065 2
+ -1361 -29891 -2162 2
+ -1204 -29902 -2100 2
+ -1090 -29901 -2181 2
+ -933 -29903 -2217 2
+ -813 -29900 -2313 2
+ -728 -29892 -2434 2
+ -636 -29884 -2552 2
+ -561 -29876 -2670 2
+ -453 -29867 -2788 2
+ -325 -29861 -2868 2
+ -172 -29860 -2892 2
+ -49 -29855 -2945 2
+ 66 -29845 -3046 2
+ 198 -29837 -3120 2
+ 333 -29828 -3187 2
+ 446 -29820 -3254 2
+ 531 -29807 -3353 2
+ 684 -29801 -3381 2
+ 722 -29793 -3444 2
+ 767 -29777 -3566 2
+ 856 -29764 -3656 2
+ 965 -29748 -3762 2
+ 1077 -29733 -3846 2
+ 1158 -29717 -3946 2
+ 1262 -29697 -4062 2
+ 1413 -29676 -4164 2
+ 1433 -29654 -4313 2
+ 1544 -29635 -4400 2
+ 1597 -29613 -4533 2
+ 1650 -29591 -4656 2
+ 1782 -29583 -4655 2
+ 1853 -29567 -4728 2
+ 1789 -29544 -4891 2
+ 1831 -29521 -5013 2
+ 1830 -29494 -5171 2
+ 1896 -29467 -5303 2
+ 1844 -29448 -5423 2
+ 1736 -29436 -5521 2
+ 1648 -29418 -5644 2
+ 1542 -29406 -5736 2
+ 1361 -29406 -5780 2
+ 1414 -29394 -5832 2
+ 1547 -29364 -5949 2
+ 1647 -29351 -5983 2
+ 1729 -29314 -6140 2
+ 1811 -29294 -6213 2
+ 1874 -29261 -6345 2
+ 1989 -29233 -6440 2
+ 2024 -29212 -6525 2
+ 2055 -29180 -6655 2
+ 2116 -29143 -6797 2
+ 2143 -29110 -6929 2
+ 2159 -29078 -7059 2
+ 2221 -29042 -7187 2
+ 2297 -29003 -7317 2
+ 2221 -28980 -7431 2
+ 2188 -28944 -7580 2
+ 2080 -28933 -7653 2
+ 2054 -28905 -7764 2
+ 2128 -28864 -7896 2
+ 2018 -28851 -7972 2
+ 2027 -28826 -8060 2
+ 1942 -28794 -8195 2
+ 1852 -28763 -8322 2
+ 1749 -28769 -8324 2
+ 1650 -28761 -8370 2
+ 1625 -28721 -8512 2
+ 1569 -28687 -8638 2
+ 1537 -28640 -8797 2
+ 1546 -28595 -8941 2
+ 1586 -28556 -9057 2
+ 1512 -28526 -9164 2
+ 1498 -28486 -9291 2
+ 1604 -28447 -9393 2
+ 1757 -28437 -9394 2
+ 1883 -28404 -9469 2
+ 2026 -28371 -9537 2
+ 2110 -28329 -9643 2
+ 2273 -28314 -9652 2
+ 2409 -28306 -9640 2
+ 2555 -28291 -9649 2
+ 2709 -28279 -9641 2
+ 2832 -28292 -9568 2
+ 2972 -28257 -9629 2
+ 3119 -28245 -9618 2
+ 3261 -28232 -9610 2
+ 3403 -28206 -9636 2
+ 3509 -28166 -9713 2
+ 3641 -28128 -9775 2
+ 3784 -28099 -9803 2
+ 3919 -28065 -9847 2
+ 4113 -28029 -9874 2
+ 4210 -28041 -9796 2
+ 4334 -28045 -9732 2
+ 4484 -28029 -9709 2
+ 4643 -27992 -9740 2
+ 4689 -27944 -9855 2
+ 4845 -27899 -9908 2
+ 4830 -27935 -9814 2
+ 4804 -27988 -9676 2
+ 4951 -27977 -9633 2
+ 5069 -27977 -9569 2
+ 5207 -27985 -9471 2
+ 5327 -27914 -9614 2
+ 5465 -27903 -9569 2
+ 5610 -27882 -9546 2
+ 5756 -27876 -9478 2
+ 5869 -27826 -9553 2
+ 5984 -27794 -9575 2
+ 6071 -27826 -9427 2
+ 6142 -27801 -9453 2
+ 6290 -27755 -9490 2
+ 6461 -27734 -9438 2
+ 6521 -27679 -9558 2
+ 6605 -27634 -9629 2
+ 6717 -27645 -9521 2
+ 6851 -27625 -9481 2
+ 6998 -27596 -9461 2
+ 7105 -27611 -9335 2
+ 7252 -27579 -9319 2
+ 7383 -27571 -9237 2
+ 7513 -27560 -9164 2
+ 7644 -27544 -9104 2
+ 7785 -27523 -9048 2
+ 7910 -27515 -8963 2
+ 8049 -27494 -8905 2
+ 8182 -27476 -8840 2
+ 8293 -27474 -8741 2
+ 8437 -27448 -8684 2
+ 8590 -27419 -8628 2
+ 8677 -27366 -8707 2
+ 8749 -27304 -8828 2
+ 8869 -27243 -8898 2
+ 8992 -27196 -8919 2
+ 9071 -27198 -8831 2
+ 8985 -27263 -8717 2
+ 8879 -27326 -8629 2
+ 8754 -27385 -8570 2
+ 8712 -27435 -8452 2
+ 8843 -27423 -8353 2
+ 8919 -27437 -8224 2
+ 9000 -27448 -8100 2
+ 9087 -27455 -7979 2
+ 9192 -27452 -7868 2
+ 9224 -27482 -7723 2
+ 9193 -27532 -7582 2
+ 9119 -27588 -7468 2
+ 9079 -27635 -7341 2
+ 9191 -27624 -7240 2
+ 9312 -27606 -7155 2
+ 9449 -27570 -7114 2
+ 9580 -27508 -7180 2
+ 9721 -27473 -7122 2
+ 9746 -27505 -6964 2
+ 9703 -27554 -6828 2
+ 9798 -27536 -6765 2
+ 9893 -27524 -6677 2
+ 9910 -27553 -6527 2
+ 9984 -27546 -6446 2
+ 10103 -27528 -6335 2
+ 10130 -27553 -6183 2
+ 10147 -27578 -6039 2
+ 10211 -27585 -5898 2
+ 10255 -27599 -5758 2
+ 10328 -27600 -5618 2
+ 10380 -27608 -5482 2
+ 10490 -27587 -5375 2
+ 10630 -27538 -5356 2
+ 10766 -27493 -5312 2
+ 10844 -27486 -5187 2
+ 10869 -27506 -5028 2
+ 10998 -27459 -5006 2
+ 11137 -27410 -4966 2
+ 11276 -27362 -4916 2
+ 11335 -27358 -4801 2
+ 11342 -27381 -4653 2
+ 11374 -27392 -4505 2
+ 11368 -27419 -4357 2
+ 11267 -27474 -4267 2
+ 11191 -27522 -4163 2
+ 11174 -27550 -4019 2
+ 11190 -27568 -3844 2
+ 11294 -27539 -3750 2
+ 11418 -27499 -3665 2
+ 11476 -27494 -3521 2
+ 11549 -27479 -3392 2
+ 11627 -27462 -3265 2
+ 11715 -27439 -3141 2
+ 11797 -27417 -3019 2
+ 11856 -27406 -2884 2
+ 11923 -27391 -2751 2
+ 11953 -27392 -2604 2
+ 11947 -27409 -2456 2
+ 11929 -27429 -2309 2
+ 11839 -27478 -2195 2
+ 11774 -27516 -2066 2
+ 11669 -27570 -1936 2
+ 11735 -27547 -1850 2
+ 11817 -27519 -1748 2
+ 11788 -27541 -1586 2
+ 11831 -27530 -1450 2
+ 11823 -27542 -1295 2
+ 11832 -27545 -1138 2
+ 11886 -27527 -997 2
+ 11866 -27541 -847 2
+ 11896 -27532 -699 2
+ 11894 -27536 -544 2
+ 11932 -27522 -400 2
+ 11932 -27524 -246 2
+ 11894 -27541 -101 2
+ 11864 -27554 45 2
+ 11851 -27559 210 2
+ 11969 -27508 259 2
+ 12128 -27437 329 2
+ 12070 -27462 383 2
+ 11923 -27526 399 2
+ 11806 -27575 475 2
+ 11720 -27610 595 2
+ 11677 -27624 737 2
+ 11614 -27647 866 2
+ 11604 -27646 1019 2
+ 11592 -27645 1168 2
+ 11571 -27647 1318 2
+ 11484 -27677 1446 2
+ 11477 -27673 1580 2
+ 11339 -27726 1644 2
+ 11260 -27756 1679 2
+ 11162 -27788 1794 2
+ 11103 -27803 1932 2
+ 11022 -27826 2059 2
+ 10920 -27858 2163 2
+ 10795 -27901 2239 2
+ 10661 -27949 2275 2
+ 10524 -28003 2256 2
+ 10409 -28040 2325 2
+ 10312 -28066 2441 2
+ 10217 -28092 2536 2
+
+
+ 14413 -10720 -24028 0
+ 14519 -10656 -23993 2
+ 14560 -10511 -24032 2
+ 14605 -10390 -24057 2
+ 14723 -10328 -24012 2
+ 14831 -10269 -23970 2
+ 14961 -10204 -23917 2
+ 15082 -10141 -23868 2
+ 15207 -9985 -23855 2
+ 15312 -9969 -23794 2
+ 15428 -9901 -23748 2
+ 15562 -9858 -23678 2
+ 15685 -9782 -23628 2
+ 15763 -9661 -23626 2
+ 15800 -9525 -23657 2
+ 15902 -9415 -23632 2
+ 15930 -9279 -23667 2
+ 15933 -9140 -23719 2
+ 15974 -9003 -23744 2
+ 16045 -8868 -23747 2
+ 16116 -8736 -23748 2
+ 16222 -8627 -23715 2
+ 16316 -8508 -23694 2
+ 16339 -8371 -23727 2
+ 16388 -8227 -23744 2
+ 16438 -8085 -23757 2
+ 16476 -7934 -23782 2
+ 16501 -7802 -23809 2
+ 16545 -7702 -23810 2
+ 16662 -7619 -23755 2
+ 16776 -7535 -23702 2
+ 16853 -7407 -23688 2
+ 16953 -7396 -23620 2
+ 17030 -7455 -23546 2
+ 17132 -7488 -23461 2
+ 17213 -7360 -23442 2
+ 17272 -7223 -23442 2
+ 17317 -7082 -23451 2
+ 17338 -6941 -23478 2
+ 17378 -6794 -23491 2
+ 17427 -6663 -23493 2
+ 17482 -6522 -23491 2
+ 17581 -6402 -23450 2
+ 17593 -6250 -23483 2
+ 17690 -6173 -23430 2
+ 17749 -6029 -23423 2
+ 17775 -5884 -23440 2
+ 17834 -5733 -23432 2
+ 17917 -5633 -23393 2
+ 17994 -5643 -23332 2
+ 18063 -5741 -23254 2
+ 18060 -5899 -23217 2
+ 18076 -6044 -23167 2
+ 18082 -6194 -23123 2
+ 18110 -6262 -23083 2
+ 18157 -6379 -23014 2
+ 18095 -6562 -23011 2
+ 18120 -6659 -22964 2
+ 18147 -6778 -22908 2
+ 18113 -6922 -22891 2
+ 18143 -7060 -22825 2
+ 18135 -7208 -22786 2
+ 18072 -7345 -22791 2
+ 18069 -7493 -22746 2
+ 18032 -7638 -22727 2
+ 17981 -7784 -22718 2
+ 17991 -7921 -22662 2
+ 18007 -8062 -22600 2
+ 18001 -8208 -22552 2
+ 17983 -8349 -22514 2
+ 17993 -8495 -22452 2
+ 18015 -8627 -22384 2
+ 18058 -8746 -22303 2
+ 18066 -8882 -22243 2
+ 18094 -9006 -22170 2
+ 18179 -9082 -22070 2
+ 18282 -9121 -21968 2
+ 18396 -9100 -21881 2
+ 18514 -9037 -21808 2
+ 18628 -8964 -21740 2
+ 18731 -8881 -21686 2
+ 18805 -8752 -21674 2
+ 18924 -8693 -21595 2
+ 19040 -8659 -21506 2
+ 19156 -8618 -21419 2
+ 19263 -8528 -21359 2
+ 19359 -8418 -21316 2
+ 19471 -8352 -21240 2
+ 19580 -8281 -21167 2
+ 19694 -8225 -21084 2
+ 19796 -8192 -21000 2
+ 19902 -8099 -20936 2
+ 20000 -7999 -20881 2
+ 20101 -7910 -20818 2
+ 20208 -7825 -20746 2
+ 20313 -7749 -20672 2
+ 20358 -7619 -20676 2
+ 20319 -7493 -20760 2
+ 20268 -7378 -20852 2
+ 20245 -7252 -20917 2
+ 20255 -7111 -20956 2
+ 20304 -6979 -20954 2
+ 20276 -6876 -21014 2
+ 20185 -6840 -21114 2
+ 20111 -6834 -21186 2
+ 20108 -6689 -21235 2
+ 20071 -6534 -21318 2
+ 20018 -6435 -21398 2
+ 20092 -6353 -21353 2
+ 20179 -6240 -21304 2
+ 20251 -6251 -21233 2
+ 20263 -6359 -21189 2
+ 20298 -6466 -21123 2
+ 20365 -6354 -21092 2
+ 20427 -6344 -21035 2
+ 20475 -6323 -20995 2
+ 20444 -6203 -21061 2
+ 20463 -6169 -21052 2
+ 20538 -6261 -20952 2
+ 20630 -6342 -20837 2
+ 20712 -6350 -20753 2
+ 20821 -6253 -20673 2
+ 20911 -6263 -20579 2
+ 21027 -6238 -20469 2
+ 21133 -6160 -20382 2
+ 21218 -6120 -20306 2
+ 21319 -6122 -20199 2
+ 21417 -6075 -20110 2
+ 21525 -5939 -20035 2
+ 21618 -5957 -19930 2
+ 21719 -5850 -19851 2
+ 21791 -5855 -19771 2
+ 21836 -5851 -19722 2
+ 21902 -5864 -19645 2
+ 21810 -5969 -19715 2
+ 21694 -5972 -19841 2
+ 21614 -6084 -19895 2
+ 21573 -6259 -19885 2
+ 21628 -6352 -19796 2
+ 21703 -6347 -19716 2
+ 21801 -6375 -19598 2
+ 21900 -6384 -19484 2
+ 22016 -6327 -19371 2
+ 22091 -6347 -19279 2
+ 22137 -6485 -19181 2
+ 22197 -6479 -19113 2
+ 22236 -6560 -19040 2
+ 22296 -6632 -18945 2
+ 22339 -6741 -18855 2
+ 22290 -6897 -18857 2
+ 22346 -6996 -18754 2
+ 22396 -7067 -18668 2
+ 22392 -7200 -18622 2
+ 22436 -7294 -18532 2
+ 22459 -7435 -18447 2
+ 22359 -7551 -18521 2
+ 22272 -7651 -18585 2
+ 22289 -7686 -18550 2
+ 22299 -7813 -18485 2
+ 22347 -7777 -18442 2
+ 22439 -7787 -18327 2
+ 22490 -7736 -18285 2
+ 22593 -7680 -18182 2
+ 22702 -7664 -18052 2
+ 22730 -7764 -17974 2
+ 22748 -7927 -17880 2
+ 22789 -7878 -17849 2
+ 22804 -7725 -17898 2
+ 22822 -7608 -17924 2
+ 22921 -7505 -17841 2
+ 22999 -7391 -17788 2
+ 23089 -7288 -17714 2
+ 23178 -7223 -17624 2
+ 23254 -7170 -17545 2
+ 23316 -7184 -17457 2
+ 23335 -7302 -17382 2
+ 23391 -7283 -17316 2
+ 23440 -7322 -17232 2
+ 23505 -7263 -17169 2
+ 23522 -7297 -17130 2
+ 23499 -7470 -17087 2
+ 23559 -7525 -16980 2
+ 23614 -7426 -16948 2
+ 23628 -7464 -16912 2
+ 23660 -7540 -16833 2
+ 23709 -7610 -16733 2
+ 23662 -7735 -16742 2
+ 23642 -7814 -16733 2
+ 23722 -7796 -16628 2
+ 23701 -7926 -16596 2
+ 23757 -7928 -16515 2
+ 23793 -7970 -16442 2
+ 23839 -8067 -16329 2
+ 23771 -8202 -16361 2
+ 23745 -8294 -16352 2
+ 23757 -8394 -16284 2
+ 23648 -8458 -16409 2
+ 23665 -8470 -16378 2
+ 23753 -8465 -16252 2
+ 23838 -8420 -16151 2
+ 23936 -8410 -16010 2
+ 23969 -8499 -15914 2
+ 23959 -8571 -15890 2
+ 23851 -8695 -15985 2
+ 23842 -8815 -15933 2
+ 23849 -8981 -15830 2
+ 23908 -8929 -15770 2
+ 23981 -8800 -15731 2
+ 24056 -8661 -15693 2
+ 24120 -8530 -15667 2
+ 24160 -8522 -15611 2
+ 24170 -8645 -15526 2
+ 24205 -8740 -15418 2
+ 24243 -8842 -15300 2
+ 24237 -8974 -15233 2
+ 24191 -9115 -15222 2
+ 24134 -9252 -15231 2
+ 24102 -9361 -15213 2
+ 24137 -9453 -15101 2
+ 24174 -9544 -14984 2
+ 24181 -9661 -14898 2
+ 24173 -9802 -14819 2
+ 24180 -9922 -14727 2
+ 24205 -10022 -14618 2
+ 24248 -10096 -14495 2
+ 24301 -10153 -14365 2
+ 24358 -10204 -14233 2
+ 24425 -10229 -14099 2
+ 24486 -10265 -13966 2
+ 24555 -10267 -13844 2
+ 24631 -10257 -13715 2
+ 24655 -10354 -13599 2
+ 24696 -10417 -13476 2
+ 24764 -10435 -13335 2
+ 24813 -10479 -13209 2
+ 24839 -10567 -13092 2
+ 24891 -10605 -12960 2
+ 24969 -10587 -12825 2
+ 25048 -10570 -12684 2
+ 25087 -10606 -12577 2
+ 25124 -10671 -12446 2
+ 25154 -10733 -12332 2
+ 25176 -10822 -12208 2
+ 25194 -10913 -12091 2
+ 25208 -11008 -11973 2
+ 25248 -11068 -11834 2
+ 25288 -11118 -11700 2
+ 25303 -11215 -11576 2
+ 25285 -11325 -11508 2
+ 25275 -11460 -11395 2
+ 25334 -11381 -11344 2
+ 25403 -11197 -11371 2
+ 25426 -11233 -11286 2
+ 25399 -11364 -11215 2
+ 25375 -11493 -11136 2
+ 25321 -11618 -11131 2
+ 25256 -11755 -11133 2
+ 25206 -11893 -11101 2
+ 25181 -12015 -11026 2
+ 25162 -12136 -10937 2
+ 25122 -12270 -10878 2
+ 25066 -12409 -10850 2
+ 24986 -12529 -10895 2
+ 24916 -12657 -10909 2
+ 24836 -12776 -10952 2
+ 24754 -12899 -10992 2
+ 24671 -13017 -11041 2
+ 24596 -13136 -11068 2
+ 24543 -13303 -10984 2
+ 24643 -13198 -10887 2
+ 24703 -13117 -10848 2
+ 24801 -12976 -10795 2
+ 24778 -13059 -10748 2
+ 24699 -13183 -10779 2
+ 24612 -13286 -10851 2
+ 24555 -13420 -10814 2
+ 24618 -13370 -10733 2
+ 24721 -13240 -10658 2
+ 24694 -13317 -10624 2
+ 24609 -13424 -10688 2
+ 24522 -13530 -10752 2
+ 24437 -13644 -10801 2
+ 24352 -13763 -10841 2
+ 24270 -13890 -10863 2
+ 24207 -14023 -10834 2
+ 24126 -14151 -10848 2
+ 24037 -14258 -10907 2
+ 23949 -14373 -10948 2
+ 23870 -14497 -10956 2
+ 23777 -14609 -11010 2
+ 23693 -14736 -11022 2
+ 23626 -14867 -10990 2
+ 23555 -15000 -10962 2
+ 23478 -15127 -10952 2
+ 23397 -15255 -10949 2
+ 23307 -15377 -10970 2
+ 23215 -15492 -11002 2
+ 23124 -15611 -11027 2
+ 23030 -15726 -11058 2
+ 22945 -15851 -11059 2
+ 22868 -15988 -11019 2
+ 22776 -16160 -10960 2
+ 22753 -16227 -10909 2
+ 22668 -16354 -10895 2
+ 22605 -16466 -10859 2
+ 22572 -16588 -10739 2
+ 22622 -16602 -10611 2
+ 22630 -16636 -10542 2
+ 22555 -16763 -10502 2
+ 22455 -16893 -10508 2
+ 22371 -16929 -10628 2
+ 22274 -16999 -10719 2
+ 22169 -17097 -10780 2
+ 22071 -17155 -10889 2
+ 22002 -17195 -10965 2
+ 21914 -17221 -11101 2
+ 21845 -17221 -11236 2
+ 21760 -17243 -11366 2
+ 21698 -17234 -11497 2
+ 21662 -17182 -11642 2
+ 21666 -17090 -11769 2
+ 21656 -17009 -11903 2
+ 21602 -16986 -12035 2
+ 21560 -16949 -12162 2
+ 21590 -16836 -12266 2
+ 21571 -16763 -12398 2
+ 21502 -16753 -12530 2
+ 21435 -16741 -12660 2
+ 21371 -16718 -12798 2
+ 21302 -16706 -12928 2
+ 21220 -16711 -13056 2
+ 21123 -16729 -13189 2
+ 21040 -16767 -13273 2
+ 20978 -16741 -13403 2
+ 20905 -16725 -13537 2
+ 20813 -16755 -13641 2
+ 20746 -16716 -13790 2
+ 20744 -16615 -13915 2
+ 20766 -16507 -14010 2
+ 20797 -16389 -14103 2
+ 20767 -16318 -14229 2
+ 20698 -16287 -14364 2
+ 20661 -16219 -14494 2
+ 20615 -16160 -14625 2
+ 20571 -16099 -14753 2
+ 20531 -16031 -14883 2
+ 20452 -16014 -15009 2
+ 20351 -16034 -15125 2
+ 20261 -16032 -15247 2
+ 20179 -16017 -15371 2
+ 20113 -15976 -15499 2
+ 20041 -15940 -15629 2
+ 19975 -15896 -15758 2
+ 19916 -15842 -15887 2
+ 19862 -15781 -16013 2
+ 19785 -15749 -16141 2
+ 19697 -15733 -16263 2
+ 19606 -15721 -16385 2
+ 19512 -15713 -16505 2
+ 19411 -15719 -16617 2
+ 19317 -15711 -16734 2
+ 19239 -15677 -16854 2
+ 19120 -15728 -16942 2
+ 19003 -15794 -17013 2
+ 18886 -15874 -17069 2
+ 18782 -15900 -17160 2
+ 18695 -15882 -17271 2
+ 18573 -15950 -17339 2
+ 18452 -15977 -17443 2
+ 18366 -15975 -17535 2
+ 18240 -16092 -17561 2
+ 18128 -16136 -17635 2
+ 18090 -16256 -17564 2
+ 17992 -16386 -17544 2
+ 17863 -16428 -17636 2
+ 17756 -16527 -17652 2
+ 17671 -16642 -17629 2
+ 17547 -16740 -17660 2
+ 17460 -16853 -17639 2
+ 17380 -17009 -17569 2
+ 17318 -17080 -17560 2
+ 17145 -17152 -17660 2
+ 17175 -17049 -17730 2
+ 17150 -16964 -17835 2
+ 17142 -16847 -17953 2
+ 17111 -16757 -18067 2
+ 17046 -16676 -18203 2
+ 16976 -16635 -18305 2
+ 16965 -16527 -18413 2
+ 16976 -16410 -18508 2
+ 16937 -16319 -18623 2
+ 16973 -16193 -18701 2
+ 16942 -16198 -18724 2
+ 16858 -16321 -18694 2
+ 16825 -16426 -18631 2
+ 16768 -16556 -18566 2
+ 16772 -16658 -18472 2
+ 16783 -16762 -18367 2
+ 16762 -16876 -18282 2
+ 16711 -16998 -18216 2
+ 16651 -17144 -18133 2
+ 16735 -17174 -18027 2
+ 16740 -17288 -17914 2
+ 16634 -17285 -18015 2
+ 16529 -17261 -18134 2
+ 16527 -17152 -18239 2
+ 16560 -17031 -18322 2
+ 16573 -16890 -18441 2
+ 16477 -16956 -18466 2
+ 16355 -17077 -18463 2
+ 16294 -17188 -18414 2
+ 16251 -17313 -18335 2
+ 16254 -17450 -18202 2
+ 16135 -17468 -18289 2
+ 16050 -17423 -18408 2
+ 15967 -17370 -18530 2
+ 15932 -17455 -18479 2
+ 15925 -17505 -18438 2
+ 15809 -17594 -18454 2
+ 15738 -17648 -18462 2
+ 15965 -17489 -18418 2
+ 15931 -17515 -18424 2
+ 15809 -17600 -18448 2
+ 15696 -17699 -18449 2
+ 15596 -17811 -18426 2
+ 15509 -17927 -18387 2
+ 15487 -18044 -18292 2
+ 15412 -18161 -18239 2
+ 15285 -18264 -18242 2
+ 15171 -18353 -18249 2
+ 15057 -18450 -18245 2
+ 14929 -18496 -18304 2
+ 14802 -18528 -18374 2
+ 14664 -18619 -18393 2
+ 14584 -18600 -18476 2
+ 14448 -18618 -18564 2
+ 14325 -18633 -18644 2
+ 14191 -18696 -18683 2
+ 14057 -18751 -18730 2
+ 13922 -18800 -18781 2
+ 13833 -18763 -18883 2
+ 13783 -18682 -19001 2
+ 13714 -18613 -19118 2
+ 13678 -18537 -19217 2
+ 13628 -18440 -19346 2
+ 13519 -18500 -19364 2
+ 13546 -18610 -19240 2
+ 13478 -18660 -19239 2
+ 13404 -18589 -19359 2
+ 13321 -18650 -19358 2
+ 13203 -18740 -19352 2
+ 13085 -18812 -19362 2
+ 12919 -18891 -19397 2
+ 12952 -18810 -19453 2
+ 12907 -18758 -19533 2
+ 12801 -18727 -19632 2
+ 12747 -18638 -19752 2
+ 12694 -18554 -19865 2
+ 12629 -18478 -19977 2
+ 12538 -18425 -20084 2
+ 12424 -18396 -20180 2
+ 12297 -18391 -20262 2
+ 12165 -18385 -20347 2
+ 12047 -18373 -20428 2
+ 11972 -18295 -20542 2
+ 11930 -18210 -20642 2
+ 11979 -18104 -20706 2
+ 12024 -17992 -20778 2
+ 12032 -17871 -20877 2
+ 12048 -17753 -20969 2
+ 12082 -17639 -21045 2
+ 12080 -17521 -21145 2
+ 12058 -17407 -21251 2
+ 12026 -17300 -21356 2
+ 11998 -17217 -21438 2
+ 12016 -17094 -21527 2
+ 12031 -16992 -21599 2
+ 12008 -16866 -21711 2
+ 11981 -16768 -21801 2
+ 11997 -16620 -21905 2
+ 11961 -16509 -22009 2
+ 11932 -16417 -22094 2
+ 11899 -16309 -22191 2
+ 11801 -16225 -22304 2
+ 11744 -16146 -22392 2
+ 11689 -16052 -22488 2
+ 11715 -15925 -22565 2
+ 11669 -15812 -22668 2
+ 11648 -15691 -22762 2
+ 11651 -15567 -22846 2
+ 11656 -15436 -22931 2
+ 11708 -15309 -22990 2
+ 11711 -15182 -23073 2
+ 11703 -15057 -23158 2
+ 11701 -14931 -23241 2
+ 11710 -14802 -23319 2
+ 11728 -14671 -23392 2
+ 11711 -14546 -23479 2
+ 11694 -14422 -23564 2
+ 11740 -14291 -23621 2
+ 11789 -14164 -23673 2
+ 11862 -14037 -23712 2
+ 11935 -13914 -23748 2
+ 12033 -13794 -23768 2
+ 12070 -13673 -23819 2
+ 12096 -13529 -23888 2
+ 12138 -13400 -23940 2
+ 12175 -13270 -23993 2
+ 12210 -13117 -24060 2
+ 12304 -13005 -24072 2
+ 12343 -12867 -24126 2
+ 12473 -12772 -24110 2
+ 12556 -12657 -24128 2
+ 12650 -12552 -24134 2
+ 12771 -12465 -24115 2
+ 12863 -12330 -24135 2
+ 12989 -12230 -24119 2
+ 13096 -12199 -24077 2
+ 13218 -12104 -24058 2
+ 13350 -11994 -24040 2
+ 13428 -11890 -24048 2
+ 13480 -11751 -24087 2
+ 13493 -11617 -24145 2
+ 13584 -11477 -24161 2
+ 13715 -11460 -24095 2
+ 13846 -11354 -24070 2
+ 13870 -11468 -24002 2
+ 13957 -11454 -23959 2
+ 14051 -11356 -23950 2
+ 14124 -11220 -23971 2
+ 14172 -11067 -24014 2
+ 14250 -10962 -24016 2
+ 14320 -10829 -24035 2
+
+
+ -7056 27453 9826 0
+ -7008 27479 9786 2
+ -6906 27476 9868 2
+ -6777 27515 9847 2
+ -6668 27554 9813 2
+ -6519 27617 9737 2
+ -6391 27674 9659 2
+ -6282 27725 9585 2
+ -6167 27762 9551 2
+ -6012 27799 9543 2
+ -5938 27852 9434 2
+ -5908 27905 9294 2
+ -5874 27910 9302 2
+ -5858 27863 9452 2
+ -5827 27834 9554 2
+ -5680 27843 9616 2
+ -5581 27860 9627 2
+ -5494 27876 9631 2
+ -5399 27877 9682 2
+ -5237 27901 9701 2
+ -5109 27917 9723 2
+ -4959 27937 9745 2
+ -4809 27958 9759 2
+ -4662 27998 9715 2
+ -4550 28035 9661 2
+ -4412 28071 9621 2
+ -4271 28106 9581 2
+ -4135 28146 9522 2
+ -4011 28174 9496 2
+ -3910 28205 9445 2
+ -4096 28213 9339 2
+ -4197 28233 9234 2
+ -4300 28252 9129 2
+ -4443 28238 9102 2
+ -4591 28228 9062 2
+ -4734 28194 9094 2
+ -4808 28209 9009 2
+ -4593 28241 9018 2
+ -4516 28266 8980 2
+ -4685 28263 8902 2
+ -4792 28271 8819 2
+ -4841 28276 8778 2
+ -4681 28310 8754 2
+ -4592 28359 8640 2
+ -4520 28372 8637 2
+ -4416 28357 8741 2
+ -4272 28377 8746 2
+ -4155 28413 8686 2
+ -4189 28448 8553 2
+ -4327 28454 8466 2
+ -4427 28463 8382 2
+ -4453 28465 8360 2
+ -4347 28492 8326 2
+ -4393 28523 8195 2
+ -4384 28538 8145 2
+ -4317 28505 8298 2
+ -4266 28467 8453 2
+ -4151 28459 8536 2
+ -4078 28428 8674 2
+ -4010 28406 8776 2
+ -4017 28356 8932 2
+ -4040 28308 9075 2
+ -3977 28273 9210 2
+ -3850 28285 9227 2
+ -3795 28309 9176 2
+ -3712 28281 9295 2
+ -3654 28327 9177 2
+ -3626 28375 9040 2
+ -3586 28429 8885 2
+ -3614 28457 8782 2
+ -3595 28481 8711 2
+ -3657 28491 8653 2
+ -3609 28529 8549 2
+ -3690 28560 8411 2
+ -3750 28587 8290 2
+ -3867 28586 8240 2
+ -3916 28585 8219 2
+ -3760 28626 8150 2
+ -3826 28656 8013 2
+ -3973 28645 7981 2
+ -3998 28662 7905 2
+ -3815 28670 7966 2
+ -3731 28699 7902 2
+ -3847 28715 7789 2
+ -3966 28711 7744 2
+ -3889 28748 7642 2
+ -3742 28736 7763 2
+ -3591 28772 7700 2
+ -3579 28804 7586 2
+ -3479 28791 7678 2
+ -3373 28800 7694 2
+ -3268 28780 7812 2
+ -3271 28777 7822 2
+ -3401 28776 7769 2
+ -3322 28734 7958 2
+ -3190 28744 7974 2
+ -3069 28758 7971 2
+ -2963 28778 7939 2
+ -2928 28818 7808 2
+ -3066 28829 7713 2
+ -3116 28808 7770 2
+ -3106 28854 7601 2
+ -3037 28891 7491 2
+ -2961 28909 7448 2
+ -2823 28897 7550 2
+ -2736 28876 7660 2
+ -2635 28909 7573 2
+ -2688 28928 7478 2
+ -2802 28940 7391 2
+ -2790 28981 7233 2
+ -2875 28988 7174 2
+ -2723 29010 7142 2
+ -2808 29039 6989 2
+ -2793 29050 6948 2
+ -2709 29027 7077 2
+ -2587 29011 7189 2
+ -2492 29048 7072 2
+ -2471 29082 6936 2
+ -2558 29102 6820 2
+ -2633 29107 6770 2
+ -2454 29131 6734 2
+ -2568 29141 6648 2
+ -2632 29173 6481 2
+ -2591 29200 6374 2
+ -2452 29216 6356 2
+ -2327 29225 6361 2
+ -2195 29210 6477 2
+ -2101 29233 6407 2
+ -2120 29265 6250 2
+ -2226 29273 6176 2
+ -2275 29291 6069 2
+ -2194 29310 6009 2
+ -2116 29313 6022 2
+ -2241 29334 5872 2
+ -2350 29317 5915 2
+ -2255 29361 5732 2
+ -2172 29393 5599 2
+ -2111 29420 5477 2
+ -1978 29444 5397 2
+ -1870 29472 5282 2
+ -1832 29502 5128 2
+ -1722 29522 5047 2
+ -1595 29539 4992 2
+ -1616 29555 4890 2
+ -1767 29544 4901 2
+ -1829 29537 4924 2
+ -1698 29566 4792 2
+ -1546 29565 4850 2
+ -1423 29580 4797 2
+ -1444 29596 4691 2
+ -1587 29595 4648 2
+ -1670 29598 4598 2
+ -1442 29610 4599 2
+ -1287 29616 4609 2
+ -1185 29636 4508 2
+ -1061 29654 4418 2
+ -954 29675 4300 2
+ -998 29693 4162 2
+ -1118 29702 4070 2
+ -1269 29694 4080 2
+ -1388 29674 4188 2
+ -1530 29674 4134 2
+ -1674 29655 4213 2
+ -1795 29635 4305 2
+ -1914 29615 4391 2
+ -1981 29606 4425 2
+ -1838 29637 4271 2
+ -1738 29658 4173 2
+ -1642 29680 4049 2
+ -1584 29702 3910 2
+ -1648 29711 3816 2
+ -1765 29692 3909 2
+ -1906 29677 3958 2
+ -2002 29672 3947 2
+ -1811 29701 3816 2
+ -1901 29709 3708 2
+ -2059 29704 3665 2
+ -2192 29698 3639 2
+ -2280 29695 3603 2
+ -2073 29719 3534 2
+ -1910 29721 3610 2
+ -1779 29719 3689 2
+ -1631 29727 3695 2
+ -1491 29738 3664 2
+ -1420 29755 3552 2
+ -1505 29765 3428 2
+ -1578 29770 3356 2
+ -1578 29783 3233 2
+ -1713 29782 3178 2
+ -1842 29781 3113 2
+ -1980 29774 3099 2
+ -2083 29771 3056 2
+ -1922 29782 3052 2
+ -1782 29786 3097 2
+ -1647 29786 3175 2
+ -1537 29797 3123 2
+ -1632 29806 2992 2
+ -1726 29812 2873 2
+ -1869 29811 2796 2
+ -2004 29807 2741 2
+ -2098 29803 2720 2
+ -2191 29793 2748 2
+ -2232 29780 2854 2
+ -2353 29769 2876 2
+ -2384 29786 2672 2
+ -2452 29788 2585 2
+ -2592 29777 2573 2
+ -2661 29769 2596 2
+ -2567 29766 2714 2
+ -2482 29762 2839 2
+ -2487 29749 2973 2
+ -2529 29743 2990 2
+ -2559 29754 2856 2
+ -2638 29762 2697 2
+ -2719 29754 2700 2
+ -2752 29737 2856 2
+ -2799 29725 2933 2
+ -2961 29702 3005 2
+ -3025 29697 2985 2
+ -2997 29715 2830 2
+ -2997 29729 2683 2
+ -2993 29743 2532 2
+ -3089 29735 2509 2
+ -3175 29715 2637 2
+ -3267 29698 2711 2
+ -3327 29687 2755 2
+ -3343 29703 2559 2
+ -3478 29687 2565 2
+ -3286 29722 2406 2
+ -3319 29727 2300 2
+ -3420 29721 2224 2
+ -3573 29708 2158 2
+ -3673 29686 2287 2
+ -3735 29668 2426 2
+ -3748 29666 2427 2
+ -3701 29683 2278 2
+ -3649 29700 2137 2
+ -3769 29690 2070 2
+ -3897 29667 2158 2
+ -4053 29644 2187 2
+ -4149 29638 2090 2
+ -4224 29627 2099 2
+ -4385 29610 2008 2
+ -4520 29593 1962 2
+ -4678 29569 1953 2
+ -4744 29550 2071 2
+ -4662 29554 2195 2
+ -4642 29555 2230 2
+ -4801 29529 2238 2
+ -4932 29502 2307 2
+ -5081 29476 2312 2
+ -5196 29461 2244 2
+ -5275 29456 2132 2
+ -5411 29436 2061 2
+ -5543 29418 1964 2
+ -5635 29407 1860 2
+ -5769 29385 1803 2
+ -5895 29358 1838 2
+ -5980 29331 1984 2
+ -5977 29323 2101 2
+ -6008 29311 2179 2
+ -6086 29289 2257 2
+ -6014 29295 2371 2
+ -5930 29302 2496 2
+ -5903 29300 2584 2
+ -6028 29272 2614 2
+ -6081 29274 2456 2
+ -6164 29259 2433 2
+ -6127 29251 2620 2
+ -6133 29248 2638 2
+ -6178 29252 2479 2
+ -6215 29256 2331 2
+ -6284 29252 2197 2
+ -6406 29225 2200 2
+ -6420 29214 2303 2
+ -6397 29216 2350 2
+ -6453 29192 2483 2
+ -6469 29182 2557 2
+ -6629 29151 2505 2
+ -6697 29123 2651 2
+ -6695 29108 2812 2
+ -6657 29113 2848 2
+ -6575 29133 2838 2
+ -6536 29131 2941 2
+ -6522 29125 3033 2
+ -6422 29139 3108 2
+ -6331 29145 3239 2
+ -6303 29135 3378 2
+ -6299 29118 3533 2
+ -6314 29096 3683 2
+ -6328 29075 3822 2
+ -6392 29045 3942 2
+ -6478 29019 3995 2
+ -6558 28982 4127 2
+ -6604 28948 4289 2
+ -6679 28910 4427 2
+ -6767 28881 4481 2
+ -6841 28859 4511 2
+ -6887 28824 4663 2
+ -6983 28788 4743 2
+ -7069 28741 4896 2
+ -7175 28701 4976 2
+ -7247 28656 5130 2
+ -7361 28617 5188 2
+ -7448 28597 5171 2
+ -7479 28575 5245 2
+ -7579 28536 5318 2
+ -7763 28486 5317 2
+ -7848 28440 5437 2
+ -7801 28428 5564 2
+ -7672 28460 5582 2
+ -7576 28490 5562 2
+ -7441 28542 5475 2
+ -7383 28567 5423 2
+ -7467 28508 5615 2
+ -7496 28475 5745 2
+ -7466 28468 5817 2
+ -7590 28435 5818 2
+ -7518 28436 5906 2
+ -7612 28407 5923 2
+ -7591 28404 5963 2
+ -7633 28385 6001 2
+ -7629 28367 6089 2
+ -7688 28323 6223 2
+ -7761 28283 6312 2
+ -7829 28255 6351 2
+ -7869 28277 6205 2
+ -7867 28310 6053 2
+ -7920 28325 5912 2
+ -7998 28330 5781 2
+ -8103 28297 5798 2
+ -8126 28260 5945 2
+ -8078 28243 6087 2
+ -8087 28208 6240 2
+ -8033 28192 6377 2
+ -7961 28193 6466 2
+ -7933 28177 6568 2
+ -8051 28133 6614 2
+ -8142 28093 6672 2
+ -8228 28045 6767 2
+ -8298 28013 6814 2
+ -8426 27973 6821 2
+ -8523 27932 6866 2
+ -8641 27922 6758 2
+ -8749 27906 6688 2
+ -8849 27870 6704 2
+ -8755 27862 6859 2
+ -8637 27888 6904 2
+ -8607 27885 6952 2
+ -8695 27835 7042 2
+ -8700 27806 7150 2
+ -8783 27826 6969 2
+ -8844 27839 6839 2
+ -8894 27843 6757 2
+ -8947 27838 6706 2
+ -8988 27804 6793 2
+ -9136 27766 6751 2
+ -9192 27732 6815 2
+ -9031 27773 6865 2
+ -8902 27796 6937 2
+ -8866 27784 7031 2
+ -8766 27785 7154 2
+ -8759 27776 7195 2
+ -8845 27752 7184 2
+ -8808 27736 7291 2
+ -8890 27733 7202 2
+ -8946 27748 7073 2
+ -9005 27764 6932 2
+ -9101 27749 6868 2
+ -9271 27705 6818 2
+ -9324 27670 6887 2
+ -9207 27682 6997 2
+ -9101 27691 7098 2
+ -9030 27683 7219 2
+ -9015 27653 7350 2
+ -9009 27650 7371 2
+ -9072 27664 7241 2
+ -9112 27685 7106 2
+ -9222 27674 7007 2
+ -9340 27658 6912 2
+ -9418 27629 6926 2
+ -9419 27603 7027 2
+ -9356 27588 7166 2
+ -9482 27551 7144 2
+ -9533 27517 7206 2
+ -9655 27497 7119 2
+ -9720 27448 7222 2
+ -9575 27479 7296 2
+ -9433 27520 7328 2
+ -9290 27564 7345 2
+ -9147 27601 7382 2
+ -9026 27620 7460 2
+ -9032 27612 7482 2
+ -9138 27587 7448 2
+ -9292 27556 7371 2
+ -9438 27512 7349 2
+ -9581 27473 7310 2
+ -9720 27433 7277 2
+ -9782 27398 7325 2
+ -9697 27397 7441 2
+ -9644 27397 7509 2
+ -9828 27362 7397 2
+ -9845 27334 7480 2
+ -9860 27302 7576 2
+ -9730 27330 7640 2
+ -9594 27359 7711 2
+ -9570 27348 7779 2
+ -9735 27323 7660 2
+ -9870 27281 7636 2
+ -9939 27242 7688 2
+ -10039 27169 7813 2
+ -10011 27164 7867 2
+ -9960 27172 7903 2
+ -10141 27105 7903 2
+ -10215 27042 8025 2
+ -10020 27116 8020 2
+ -9916 27142 8060 2
+ -9797 27206 7991 2
+ -9828 27135 8192 2
+ -9886 27072 8328 2
+ -9909 27057 8351 2
+ -9908 27112 8170 2
+ -9974 27085 8180 2
+ -10009 27057 8232 2
+ -10161 27015 8181 2
+ -10237 26997 8147 2
+ -10104 27012 8264 2
+ -10057 27009 8330 2
+ -10237 26977 8214 2
+ -10307 26944 8234 2
+ -10304 26928 8289 2
+ -10411 26881 8307 2
+ -10364 26874 8389 2
+ -10352 26868 8424 2
+ -10435 26827 8452 2
+ -10413 26815 8517 2
+ -10486 26779 8541 2
+ -10461 26749 8663 2
+ -10499 26707 8747 2
+ -10439 26723 8769 2
+ -10537 26674 8802 2
+ -10667 26591 8896 2
+ -10648 26557 9018 2
+ -10661 26522 9108 2
+ -10682 26494 9164 2
+ -10628 26501 9204 2
+ -10720 26450 9247 2
+ -10662 26460 9284 2
+ -10760 26393 9361 2
+ -10703 26376 9475 2
+ -10724 26365 9482 2
+ -10801 26325 9504 2
+ -10788 26291 9613 2
+ -10751 26281 9680 2
+ -10823 26233 9731 2
+ -10858 26196 9790 2
+ -10766 26209 9857 2
+ -10640 26214 9982 2
+ -10498 26249 10040 2
+ -10382 26271 10101 2
+ -10341 26254 10188 2
+ -10487 26198 10182 2
+ -10427 26195 10251 2
+ -10524 26140 10293 2
+ -10465 26140 10354 2
+ -10468 26122 10397 2
+ -10405 26120 10462 2
+ -10525 26044 10533 2
+ -10422 26078 10551 2
+ -10548 26002 10614 2
+ -10363 26046 10686 2
+ -10284 26015 10837 2
+ -10196 26038 10866 2
+ -10192 26088 10750 2
+ -10197 26133 10634 2
+ -10071 26124 10775 2
+ -10014 26161 10738 2
+ -9993 26204 10655 2
+ -9881 26247 10652 2
+ -9920 26268 10564 2
+ -9846 26280 10602 2
+ -9834 26289 10590 2
+ -9801 26306 10580 2
+ -9793 26321 10551 2
+ -9698 26358 10545 2
+ -9679 26385 10496 2
+ -9606 26416 10484 2
+ -9602 26431 10449 2
+ -9498 26478 10426 2
+ -9414 26548 10324 2
+ -9374 26604 10215 2
+ -9316 26670 10095 2
+ -9191 26696 10143 2
+ -9090 26720 10169 2
+ -9048 26760 10101 2
+ -8963 26793 10091 2
+ -8906 26833 10033 2
+ -8863 26835 10065 2
+ -8806 26845 10089 2
+ -8730 26874 10078 2
+ -8742 26906 9982 2
+ -8615 26923 10046 2
+ -8571 26982 9925 2
+ -8590 27029 9779 2
+ -8420 27061 9839 2
+ -8358 27139 9676 2
+ -8301 27196 9564 2
+ -8188 27203 9641 2
+ -8074 27236 9644 2
+ -7976 27303 9537 2
+ -7849 27326 9575 2
+ -7731 27327 9667 2
+ -7624 27355 9673 2
+ -7542 27405 9598 2
+ -7414 27466 9520 2
+ -7338 27482 9535 2
+ -7349 27454 9607 2
+ -7476 27397 9671 2
+ -7387 27385 9771 2
+ -7240 27404 9828 2
+ -7134 27420 9860 2
+
+
+ -10216 27876 4312 0
+ -10249 27875 4236 2
+ -10177 27895 4281 2
+ -10179 27910 4175 2
+ -10193 27929 4011 2
+ -10154 27941 4027 2
+ -10127 27968 3904 2
+ -10062 27976 4015 2
+ -9977 28007 4006 2
+ -9969 28029 3870 2
+ -9898 28049 3909 2
+ -9890 28064 3824 2
+ -9862 28067 3872 2
+ -9858 28048 4020 2
+ -9822 28038 4168 2
+ -9731 28072 4158 2
+ -9726 28094 4013 2
+ -9749 28106 3871 2
+ -9823 28108 3672 2
+ -9784 28113 3732 2
+ -9683 28132 3848 2
+ -9586 28147 3984 2
+ -9475 28188 3961 2
+ -9392 28234 3827 2
+ -9472 28215 3763 2
+ -9594 28181 3714 2
+ -9743 28144 3601 2
+ -9703 28158 3603 2
+ -9528 28208 3674 2
+ -9541 28217 3572 2
+ -9679 28178 3508 2
+ -9648 28190 3498 2
+ -9526 28226 3541 2
+ -9397 28255 3656 2
+ -9295 28286 3672 2
+ -9249 28321 3515 2
+ -9336 28310 3377 2
+ -9392 28304 3264 2
+ -9614 28231 3253 2
+ -9531 28261 3237 2
+ -9532 28269 3165 2
+ -9490 28284 3152 2
+ -9379 28312 3238 2
+ -9221 28363 3239 2
+ -9272 28356 3154 2
+ -9413 28326 3004 2
+ -9294 28366 2995 2
+ -9185 28391 3092 2
+ -9055 28439 3044 2
+ -9015 28466 2895 2
+ -9096 28448 2821 2
+ -9276 28395 2769 2
+ -9168 28437 2697 2
+ -9235 28421 2641 2
+ -9214 28430 2620 2
+ -9057 28478 2637 2
+ -9083 28476 2570 2
+ -9258 28425 2513 2
+ -9175 28456 2468 2
+ -9103 28482 2434 2
+ -8976 28514 2527 2
+ -8898 28547 2428 2
+ -9062 28505 2312 2
+ -8969 28534 2319 2
+ -9015 28527 2224 2
+ -8986 28536 2225 2
+ -8888 28558 2335 2
+ -8764 28597 2325 2
+ -8728 28619 2184 2
+ -8690 28641 2048 2
+ -8705 28646 1902 2
+ -8821 28617 1806 2
+ -8952 28565 1968 2
+ -8954 28574 1830 2
+ -9122 28515 1922 2
+ -9092 28532 1811 2
+ -9010 28561 1750 2
+ -8952 28586 1644 2
+ -9005 28572 1592 2
+ -9102 28546 1514 2
+ -8994 28584 1444 2
+ -8910 28610 1441 2
+ -8772 28651 1482 2
+ -8634 28695 1428 2
+ -8525 28732 1338 2
+ -8388 28775 1282 2
+ -8327 28798 1170 2
+ -8367 28791 1026 2
+ -8496 28757 923 2
+ -8568 28739 803 2
+ -8684 28703 862 2
+ -8695 28703 736 2
+ -8790 28671 830 2
+ -8778 28678 727 2
+ -8889 28645 672 2
+ -9017 28603 753 2
+ -9135 28562 874 2
+ -9126 28568 775 2
+ -9223 28539 687 2
+ -9343 28498 739 2
+ -9419 28470 860 2
+ -9551 28425 885 2
+ -9707 28373 882 2
+ -9676 28384 839 2
+ -9724 28373 634 2
+ -9669 28391 686 2
+ -9587 28415 814 2
+ -9473 28455 747 2
+ -9360 28495 645 2
+ -9230 28539 581 2
+ -9085 28585 580 2
+ -8953 28628 539 2
+ -8818 28670 524 2
+ -8682 28710 572 2
+ -8544 28751 628 2
+ -8425 28784 720 2
+ -8336 28810 682 2
+ -8330 28815 530 2
+ -8377 28804 387 2
+ -8469 28778 270 2
+ -8606 28739 182 2
+ -8722 28704 122 2
+ -8872 28658 91 2
+ -9005 28617 40 2
+ -9147 28572 28 2
+ -9265 28533 8 2
+ -9412 28485 13 2
+ -9559 28436 16 2
+ -9628 28413 143 2
+ -9645 28406 302 2
+ -9742 28371 433 2
+ -9772 28362 290 2
+ -9756 28369 130 2
+ -9884 28325 132 2
+ -10007 28281 216 2
+ -10094 28249 339 2
+ -10089 28249 467 2
+ -10041 28264 575 2
+ -10067 28254 616 2
+ -10188 28209 677 2
+ -10204 28200 799 2
+ -10200 28197 949 2
+ -10218 28185 1110 2
+ -10202 28184 1257 2
+ -10235 28164 1420 2
+ -10093 28220 1326 2
+ -10125 28204 1415 2
+ -10219 28161 1587 2
+ -10132 28196 1530 2
+ -10099 28204 1593 2
+ -10115 28189 1749 2
+ -10146 28169 1883 2
+ -10069 28189 2003 2
+ -9845 28275 1896 2
+ -9895 28250 2002 2
+ -9940 28226 2123 2
+ -10083 28169 2204 2
+ -10087 28163 2256 2
+ -10099 28153 2332 2
+ -10162 28123 2419 2
+ -10250 28082 2516 2
+ -10339 28038 2639 2
+ -10436 28012 2538 2
+ -10562 27964 2544 2
+ -10458 27990 2677 2
+ -10397 28001 2798 2
+ -10475 27966 2865 2
+ -10523 27933 3001 2
+ -10530 27924 3060 2
+ -10628 27877 3150 2
+ -10668 27850 3254 2
+ -10792 27792 3340 2
+ -10902 27737 3430 2
+ -11021 27680 3512 2
+ -11142 27633 3502 2
+ -11281 27581 3467 2
+ -11307 27555 3591 2
+ -11279 27544 3757 2
+ -11114 27604 3810 2
+ -11137 27577 3933 2
+ -11156 27550 4066 2
+ -11205 27510 4203 2
+ -11326 27459 4210 2
+ -11384 27459 4052 2
+ -11511 27421 3950 2
+ -11439 27458 3902 2
+ -11329 27515 3819 2
+ -11307 27544 3668 2
+ -11336 27552 3519 2
+ -11409 27536 3408 2
+ -11537 27490 3343 2
+ -11671 27443 3270 2
+ -11777 27386 3359 2
+ -11896 27318 3492 2
+ -11975 27296 3399 2
+ -12063 27272 3276 2
+ -12149 27252 3118 2
+ -12223 27212 3178 2
+ -12327 27161 3214 2
+ -12312 27172 3180 2
+ -12207 27227 3110 2
+ -12167 27260 2971 2
+ -12159 27284 2786 2
+ -12256 27246 2732 2
+ -12378 27199 2648 2
+ -12514 27139 2623 2
+ -12635 27077 2679 2
+ -12692 27039 2798 2
+ -12700 27020 2938 2
+ -12647 27032 3050 2
+ -12545 27067 3167 2
+ -12494 27080 3252 2
+ -12472 27070 3413 2
+ -12336 27139 3359 2
+ -12327 27139 3398 2
+ -12400 27088 3532 2
+ -12343 27097 3663 2
+ -12423 27052 3721 2
+ -12506 26999 3830 2
+ -12582 26945 3956 2
+ -12622 26908 4081 2
+ -12632 26881 4222 2
+ -12750 26831 4189 2
+ -12833 26782 4249 2
+ -12859 26743 4409 2
+ -12902 26704 4520 2
+ -12897 26675 4702 2
+ -12900 26651 4827 2
+ -12970 26596 4944 2
+ -12991 26559 5083 2
+ -12970 26538 5243 2
+ -12951 26518 5389 2
+ -12948 26489 5539 2
+ -12939 26460 5697 2
+ -12831 26513 5695 2
+ -12757 26569 5597 2
+ -12680 26631 5479 2
+ -12647 26673 5348 2
+ -12599 26725 5201 2
+ -12570 26761 5083 2
+ -12504 26817 4950 2
+ -12423 26880 4811 2
+ -12365 26894 4879 2
+ -12410 26845 5032 2
+ -12341 26877 5030 2
+ -12336 26873 5064 2
+ -12401 26815 5212 2
+ -12453 26766 5340 2
+ -12418 26778 5362 2
+ -12412 26778 5375 2
+ -12448 26735 5506 2
+ -12445 26708 5638 2
+ -12496 26658 5764 2
+ -12448 26675 5789 2
+ -12354 26721 5778 2
+ -12243 26785 5714 2
+ -12095 26874 5611 2
+ -12146 26822 5746 2
+ -12040 26874 5729 2
+ -11947 26939 5620 2
+ -11901 26979 5522 2
+ -11797 27045 5420 2
+ -11737 27089 5332 2
+ -11678 27137 5214 2
+ -11671 27170 5057 2
+ -11610 27217 4946 2
+ -11514 27279 4827 2
+ -11469 27319 4705 2
+ -11424 27352 4622 2
+ -11300 27425 4490 2
+ -11301 27413 4562 2
+ -11315 27388 4676 2
+ -11230 27420 4694 2
+ -11126 27488 4540 2
+ -11113 27481 4616 2
+ -11049 27509 4601 2
+ -10989 27523 4664 2
+ -11049 27476 4797 2
+ -11028 27457 4950 2
+ -11098 27423 4984 2
+ -11097 27406 5078 2
+ -10928 27456 5171 2
+ -11004 27424 5182 2
+ -11144 27379 5120 2
+ -11221 27331 5207 2
+ -11267 27303 5257 2
+ -11319 27259 5369 2
+ -11343 27225 5492 2
+ -11367 27191 5609 2
+ -11319 27200 5658 2
+ -11198 27263 5599 2
+ -11057 27337 5518 2
+ -11016 27333 5615 2
+ -10942 27355 5655 2
+ -10834 27410 5594 2
+ -10778 27416 5676 2
+ -10707 27468 5556 2
+ -10615 27480 5672 2
+ -10541 27515 5642 2
+ -10459 27543 5657 2
+ -10375 27597 5548 2
+ -10430 27594 5458 2
+ -10522 27569 5408 2
+ -10495 27586 5373 2
+ -10561 27579 5280 2
+ -10534 27594 5255 2
+ -10366 27659 5245 2
+ -10443 27643 5178 2
+ -10532 27636 5032 2
+ -10470 27665 5006 2
+ -10373 27698 5025 2
+ -10268 27754 4929 2
+ -10290 27765 4821 2
+ -10229 27797 4767 2
+ -10320 27770 4726 2
+ -10290 27788 4686 2
+ -10341 27778 4629 2
+ -10262 27816 4581 2
+ -10326 27798 4544 2
+ -10303 27818 4472 2
+ -10273 27852 4327 2
+
+
+ 18592 -4797 -23051 0
+ 18486 -4782 -23139 2
+ 18366 -4806 -23230 2
+ 18247 -4798 -23324 2
+ 18129 -4791 -23417 2
+ 18009 -4843 -23499 2
+ 17901 -4823 -23586 2
+ 17804 -4747 -23674 2
+ 17695 -4684 -23769 2
+ 17705 -4542 -23788 2
+ 17800 -4435 -23738 2
+ 17918 -4377 -23660 2
+ 18035 -4352 -23576 2
+ 18164 -4297 -23486 2
+ 18128 -4297 -23514 2
+ 18021 -4327 -23591 2
+ 17901 -4336 -23680 2
+ 17783 -4323 -23771 2
+ 17649 -4288 -23878 2
+ 17685 -4168 -23872 2
+ 17672 -4156 -23883 2
+ 17526 -4157 -23991 2
+ 17587 -3953 -23981 2
+ 17538 -3986 -24011 2
+ 17419 -4051 -24086 2
+ 17320 -4013 -24164 2
+ 17245 -3969 -24225 2
+ 17123 -4009 -24305 2
+ 17012 -4079 -24371 2
+ 16892 -4123 -24447 2
+ 16761 -4146 -24533 2
+ 16669 -4183 -24590 2
+ 16553 -4263 -24654 2
+ 16475 -4390 -24684 2
+ 16389 -4516 -24718 2
+ 16326 -4636 -24738 2
+ 16193 -4736 -24806 2
+ 16146 -4848 -24815 2
+ 16048 -4945 -24860 2
+ 15938 -5028 -24914 2
+ 15857 -5158 -24939 2
+ 15740 -5244 -24995 2
+ 15617 -5273 -25066 2
+ 15493 -5295 -25138 2
+ 15348 -5299 -25226 2
+ 15231 -5340 -25289 2
+ 15100 -5351 -25364 2
+ 14977 -5385 -25430 2
+ 14792 -5442 -25526 2
+ 14745 -5517 -25537 2
+ 14617 -5558 -25602 2
+ 14494 -5526 -25679 2
+ 14534 -5419 -25679 2
+ 14434 -5361 -25747 2
+ 14479 -5336 -25727 2
+ 14606 -5305 -25661 2
+ 14733 -5255 -25600 2
+ 14851 -5188 -25545 2
+ 14820 -5072 -25586 2
+ 14892 -5013 -25556 2
+ 15023 -4995 -25482 2
+ 15140 -4908 -25430 2
+ 15146 -4732 -25460 2
+ 15284 -4723 -25379 2
+ 15413 -4732 -25299 2
+ 15490 -4616 -25274 2
+ 15568 -4498 -25247 2
+ 15632 -4379 -25228 2
+ 15688 -4231 -25219 2
+ 15802 -4156 -25160 2
+ 15909 -4071 -25107 2
+ 16002 -3969 -25063 2
+ 16112 -3880 -25007 2
+ 16175 -3724 -24990 2
+ 16237 -3588 -24969 2
+ 16151 -3517 -25035 2
+ 16022 -3524 -25117 2
+ 15887 -3494 -25207 2
+ 15867 -3363 -25237 2
+ 15943 -3244 -25205 2
+ 16038 -3136 -25158 2
+ 16162 -3111 -25082 2
+ 16285 -3069 -25008 2
+ 16401 -3005 -24939 2
+ 16518 -2931 -24871 2
+ 16640 -2892 -24794 2
+ 16772 -2856 -24709 2
+ 16801 -2716 -24705 2
+ 16809 -2563 -24716 2
+ 16890 -2447 -24673 2
+ 16979 -2337 -24622 2
+ 17095 -2286 -24547 2
+ 17195 -2190 -24485 2
+ 17295 -2108 -24422 2
+ 17390 -2016 -24362 2
+ 17516 -2003 -24273 2
+ 17630 -1949 -24195 2
+ 17734 -1866 -24125 2
+ 17841 -1789 -24052 2
+ 17963 -1761 -23963 2
+ 18082 -1731 -23875 2
+ 18199 -1687 -23789 2
+ 18314 -1635 -23705 2
+ 18425 -1577 -23623 2
+ 18536 -1518 -23539 2
+ 18646 -1452 -23457 2
+ 18755 -1390 -23374 2
+ 18870 -1364 -23282 2
+ 18976 -1335 -23198 2
+ 19092 -1273 -23106 2
+ 19200 -1241 -23018 2
+ 19315 -1239 -22922 2
+ 19425 -1190 -22831 2
+ 19531 -1123 -22744 2
+ 19636 -1058 -22656 2
+ 19743 -1001 -22566 2
+ 19844 -926 -22480 2
+ 19953 -880 -22386 2
+ 20057 -820 -22295 2
+ 20159 -787 -22204 2
+ 20261 -849 -22108 2
+ 20360 -920 -22014 2
+ 20380 -1034 -21990 2
+ 20434 -1116 -21936 2
+ 20536 -1168 -21838 2
+ 20647 -1168 -21733 2
+ 20706 -1277 -21671 2
+ 20771 -1392 -21602 2
+ 20834 -1502 -21533 2
+ 20897 -1616 -21464 2
+ 20973 -1718 -21382 2
+ 21066 -1766 -21286 2
+ 21177 -1732 -21179 2
+ 21239 -1631 -21124 2
+ 21280 -1525 -21091 2
+ 21331 -1347 -21051 2
+ 21380 -1421 -20997 2
+ 21427 -1368 -20952 2
+ 21487 -1243 -20899 2
+ 21515 -1097 -20878 2
+ 21528 -946 -20872 2
+ 21502 -814 -20904 2
+ 21495 -667 -20917 2
+ 21544 -508 -20871 2
+ 21570 -407 -20847 2
+ 21670 -388 -20743 2
+ 21776 -381 -20631 2
+ 21869 -301 -20534 2
+ 21963 -240 -20435 2
+ 22062 -194 -20328 2
+ 22165 -194 -20216 2
+ 22257 -253 -20114 2
+ 22336 -348 -20025 2
+ 22438 -395 -19909 2
+ 22533 -439 -19801 2
+ 22560 -583 -19766 2
+ 22626 -690 -19687 2
+ 22600 -770 -19715 2
+ 22511 -760 -19816 2
+ 22398 -800 -19942 2
+ 22319 -843 -20029 2
+ 22294 -969 -20050 2
+ 22246 -1086 -20099 2
+ 22150 -1172 -20199 2
+ 22046 -1179 -20312 2
+ 21943 -1186 -20423 2
+ 21839 -1164 -20536 2
+ 21730 -1165 -20650 2
+ 21635 -1124 -20753 2
+ 21596 -1197 -20789 2
+ 21643 -1332 -20732 2
+ 21749 -1350 -20620 2
+ 21798 -1315 -20569 2
+ 21890 -1293 -20473 2
+ 21960 -1401 -20392 2
+ 22043 -1446 -20299 2
+ 22137 -1417 -20198 2
+ 22248 -1462 -20072 2
+ 22197 -1542 -20123 2
+ 22098 -1599 -20227 2
+ 22020 -1711 -20303 2
+ 21952 -1809 -20368 2
+ 21969 -1931 -20338 2
+ 21944 -2081 -20350 2
+ 21859 -2136 -20436 2
+ 21769 -2084 -20537 2
+ 21735 -1957 -20585 2
+ 21699 -1810 -20637 2
+ 21626 -1616 -20729 2
+ 21647 -1690 -20702 2
+ 21632 -1881 -20700 2
+ 21553 -1973 -20774 2
+ 21449 -2038 -20876 2
+ 21347 -2075 -20976 2
+ 21226 -2059 -21100 2
+ 21260 -2112 -21061 2
+ 21199 -2236 -21109 2
+ 21099 -2312 -21201 2
+ 20994 -2327 -21304 2
+ 20884 -2348 -21409 2
+ 20778 -2380 -21509 2
+ 20676 -2441 -21599 2
+ 20572 -2494 -21693 2
+ 20464 -2557 -21787 2
+ 20362 -2582 -21880 2
+ 20261 -2627 -21968 2
+ 20150 -2706 -22060 2
+ 20050 -2787 -22141 2
+ 19963 -2881 -22208 2
+ 19874 -3016 -22269 2
+ 19836 -3154 -22284 2
+ 19789 -3295 -22306 2
+ 19675 -3451 -22383 2
+ 19635 -3534 -22405 2
+ 19514 -3607 -22498 2
+ 19531 -3608 -22484 2
+ 19661 -3617 -22369 2
+ 19515 -3753 -22474 2
+ 19605 -3761 -22394 2
+ 19596 -3816 -22393 2
+ 19506 -3935 -22451 2
+ 19503 -4078 -22428 2
+ 19520 -4254 -22380 2
+ 19416 -4204 -22480 2
+ 19370 -4243 -22512 2
+ 19261 -4256 -22603 2
+ 19094 -4188 -22757 2
+ 19069 -4299 -22757 2
+ 18965 -4403 -22824 2
+ 18871 -4504 -22883 2
+ 18787 -4620 -22929 2
+ 18691 -4722 -22986 2
+
+
+ 26493 2257 -13893 0
+ 26417 2226 -14042 2
+ 26343 2263 -14176 2
+ 26277 2342 -14284 2
+ 26334 2467 -14158 2
+ 26332 2589 -14140 2
+ 26262 2599 -14267 2
+ 26191 2606 -14397 2
+ 26117 2655 -14522 2
+ 26062 2759 -14599 2
+ 26105 2834 -14508 2
+ 26159 2869 -14403 2
+ 26216 2942 -14286 2
+ 26269 3031 -14169 2
+ 26342 2993 -14040 2
+ 26338 3075 -14030 2
+ 26373 3124 -13954 2
+ 26438 3084 -13838 2
+ 26443 3116 -13823 2
+ 26412 3256 -13849 2
+ 26403 3389 -13834 2
+ 26456 3451 -13718 2
+ 26482 3584 -13633 2
+ 26520 3612 -13552 2
+ 26579 3522 -13459 2
+ 26604 3610 -13386 2
+ 26651 3461 -13332 2
+ 26707 3344 -13250 2
+ 26755 3251 -13176 2
+ 26797 3121 -13122 2
+ 26847 2986 -13051 2
+ 26912 2904 -12935 2
+ 26962 2859 -12841 2
+ 26969 2745 -12850 2
+ 26973 2632 -12865 2
+ 27039 2568 -12740 2
+ 27084 2587 -12639 2
+ 27150 2549 -12504 2
+ 27207 2456 -12400 2
+ 27269 2404 -12273 2
+ 27323 2354 -12161 2
+ 27356 2201 -12117 2
+ 27402 2081 -12034 2
+ 27454 1980 -11932 2
+ 27496 1860 -11853 2
+ 27541 1742 -11766 2
+ 27587 1640 -11674 2
+ 27645 1596 -11541 2
+ 27703 1560 -11407 2
+ 27760 1523 -11272 2
+ 27817 1501 -11133 2
+ 27871 1447 -11006 2
+ 27897 1314 -10957 2
+ 27922 1239 -10901 2
+ 27940 1118 -10866 2
+ 27969 962 -10809 2
+ 27975 838 -10804 2
+ 27966 736 -10833 2
+ 28047 797 -10618 2
+ 28093 875 -10489 2
+ 28133 900 -10378 2
+ 28190 903 -10222 2
+ 28229 997 -10105 2
+ 28255 1047 -10028 2
+ 28297 952 -9919 2
+ 28330 831 -9836 2
+ 28339 680 -9820 2
+ 28368 562 -9745 2
+ 28381 407 -9713 2
+ 28377 249 -9731 2
+ 28358 137 -9787 2
+ 28330 11 -9869 2
+ 28344 -135 -9829 2
+ 28332 -280 -9859 2
+ 28300 -363 -9947 2
+ 28290 -460 -9973 2
+ 28240 -495 -10111 2
+ 28202 -604 -10212 2
+ 28173 -734 -10282 2
+ 28180 -891 -10250 2
+ 28172 -1001 -10264 2
+ 28150 -1140 -10310 2
+ 28128 -1307 -10350 2
+ 28120 -1433 -10354 2
+ 28094 -1544 -10408 2
+ 28037 -1560 -10560 2
+ 27994 -1563 -10673 2
+ 27938 -1574 -10815 2
+ 27887 -1546 -10951 2
+ 27844 -1524 -11064 2
+ 27827 -1502 -11108 2
+ 27807 -1663 -11135 2
+ 27781 -1822 -11177 2
+ 27720 -1745 -11339 2
+ 27659 -1784 -11481 2
+ 27609 -1725 -11609 2
+ 27577 -1625 -11698 2
+ 27551 -1591 -11764 2
+ 27499 -1684 -11874 2
+ 27443 -1713 -11997 2
+ 27408 -1812 -12063 2
+ 27355 -1748 -12193 2
+ 27311 -1733 -12292 2
+ 27255 -1806 -12406 2
+ 27221 -1939 -12460 2
+ 27208 -2093 -12465 2
+ 27175 -2167 -12524 2
+ 27119 -2097 -12655 2
+ 27064 -2038 -12783 2
+ 27006 -1983 -12913 2
+ 26950 -1916 -13039 2
+ 26912 -1821 -13131 2
+ 26885 -1691 -13204 2
+ 26889 -1580 -13210 2
+ 26869 -1512 -13257 2
+ 26847 -1341 -13322 2
+ 26808 -1226 -13410 2
+ 26836 -1143 -13361 2
+ 26856 -1081 -13326 2
+ 26866 -918 -13319 2
+ 26819 -776 -13421 2
+ 26783 -653 -13500 2
+ 26771 -612 -13525 2
+ 26711 -593 -13644 2
+ 26663 -467 -13744 2
+ 26604 -404 -13859 2
+ 26600 -259 -13871 2
+ 26619 -113 -13836 2
+ 26611 46 -13851 2
+ 26594 190 -13882 2
+ 26562 326 -13942 2
+ 26511 422 -14036 2
+ 26491 498 -14071 2
+ 26486 537 -14079 2
+ 26421 448 -14204 2
+ 26353 433 -14330 2
+ 26280 443 -14463 2
+ 26254 548 -14506 2
+ 26307 656 -14405 2
+ 26368 749 -14289 2
+ 26423 836 -14181 2
+ 26476 931 -14077 2
+ 26508 1063 -14007 2
+ 26458 1200 -14090 2
+ 26490 1333 -14019 2
+ 26528 1473 -13932 2
+ 26551 1571 -13877 2
+ 26600 1698 -13768 2
+ 26606 1814 -13742 2
+ 26626 1897 -13691 2
+ 26540 1925 -13853 2
+ 26493 1978 -13935 2
+ 26531 2077 -13849 2
+ 26551 2165 -13797 2
+
+
+ -3761 29749 925 0
+ -3656 29765 837 2
+ -3636 29770 722 2
+ -3716 29761 685 2
+ -3745 29758 654 2
+ -3792 29754 574 2
+ -3902 29740 533 2
+ -4038 29721 614 2
+ -4138 29704 746 2
+ -4137 29705 716 2
+ -4065 29718 547 2
+ -4032 29724 476 2
+ -3937 29738 360 2
+ -4008 29730 290 2
+ -4171 29707 338 2
+ -4171 29708 232 2
+ -4162 29710 103 2
+ -4309 29689 -50 2
+ -4419 29673 -19 2
+ -4426 29672 116 2
+ -4479 29664 55 2
+ -4601 29645 20 2
+ -4664 29635 115 2
+ -4581 29646 328 2
+ -4665 29634 284 2
+ -4726 29625 103 2
+ -4854 29604 176 2
+ -4783 29615 272 2
+ -4663 29633 359 2
+ -4592 29642 539 2
+ -4623 29637 505 2
+ -4693 29628 372 2
+ -4835 29606 296 2
+ -4911 29593 368 2
+ -4829 29604 529 2
+ -4815 29605 624 2
+ -4823 29600 745 2
+ -4712 29615 849 2
+ -4560 29639 875 2
+ -4406 29659 969 2
+ -4453 29652 960 2
+ -4609 29630 919 2
+ -4634 29622 1043 2
+ -4675 29616 1026 2
+ -4766 29605 901 2
+ -4806 29597 951 2
+ -4835 29593 935 2
+ -4902 29586 806 2
+ -4980 29577 656 2
+ -5090 29558 660 2
+ -5203 29536 762 2
+ -5299 29515 878 2
+ -5345 29508 843 2
+ -5287 29521 750 2
+ -5169 29544 656 2
+ -5065 29564 544 2
+ -5041 29571 393 2
+ -5109 29560 306 2
+ -5239 29537 362 2
+ -5359 29515 418 2
+ -5473 29492 509 2
+ -5631 29461 584 2
+ -5713 29445 600 2
+ -5698 29443 797 2
+ -5811 29422 753 2
+ -5786 29430 635 2
+ -5767 29437 484 2
+ -5838 29424 344 2
+ -5966 29399 291 2
+ -6131 29365 287 2
+ -6123 29365 423 2
+ -6004 29388 534 2
+ -6072 29374 567 2
+ -6158 29356 569 2
+ -6277 29331 541 2
+ -6396 29304 585 2
+ -6426 29295 705 2
+ -6221 29337 790 2
+ -6292 29322 798 2
+ -6450 29289 738 2
+ -6530 29273 666 2
+ -6515 29279 525 2
+ -6405 29305 456 2
+ -6299 29329 353 2
+ -6342 29321 215 2
+ -6483 29290 249 2
+ -6597 29264 336 2
+ -6669 29248 313 2
+ -6715 29238 171 2
+ -6841 29210 72 2
+ -6991 29174 76 2
+ -6959 29181 166 2
+ -7016 29167 259 2
+ -7001 29169 407 2
+ -7065 29151 529 2
+ -7015 29161 644 2
+ -6926 29179 767 2
+ -6896 29182 911 2
+ -6923 29172 1031 2
+ -7043 29140 1132 2
+ -7013 29142 1251 2
+ -6887 29167 1360 2
+ -6796 29185 1444 2
+ -6652 29218 1429 2
+ -6663 29221 1322 2
+ -6572 29244 1254 2
+ -6560 29252 1130 2
+ -6560 29258 968 2
+ -6445 29284 943 2
+ -6448 29282 994 2
+ -6497 29266 1133 2
+ -6451 29270 1279 2
+ -6318 29296 1347 2
+ -6157 29332 1304 2
+ -6088 29340 1454 2
+ -5988 29359 1470 2
+ -5913 29372 1521 2
+ -5816 29395 1450 2
+ -5756 29403 1518 2
+ -5624 29430 1506 2
+ -5589 29443 1365 2
+ -5651 29438 1214 2
+ -5609 29448 1173 2
+ -5525 29461 1240 2
+ -5475 29466 1322 2
+ -5480 29458 1478 2
+ -5419 29472 1422 2
+ -5435 29478 1230 2
+ -5357 29491 1263 2
+ -5321 29491 1401 2
+ -5246 29498 1529 2
+ -5113 29525 1468 2
+ -5092 29525 1538 2
+ -5048 29524 1688 2
+ -4896 29553 1634 2
+ -4729 29577 1686 2
+ -4637 29587 1760 2
+ -4492 29608 1783 2
+ -4353 29626 1826 2
+ -4203 29645 1865 2
+ -4052 29663 1912 2
+ -4041 29670 1834 2
+ -4158 29660 1739 2
+ -4306 29645 1613 2
+ -4258 29652 1626 2
+ -4117 29666 1722 2
+ -4080 29678 1612 2
+ -4060 29678 1655 2
+ -3959 29684 1782 2
+ -3854 29693 1870 2
+ -3700 29708 1930 2
+ -3555 29725 1943 2
+ -3478 29742 1814 2
+ -3412 29756 1708 2
+ -3391 29765 1587 2
+ -3521 29757 1461 2
+ -3445 29765 1466 2
+ -3404 29774 1380 2
+ -3427 29779 1221 2
+ -3460 29778 1136 2
+ -3569 29767 1084 2
+ -3544 29773 1009 2
+ -3536 29778 870 2
+ -3626 29768 859 2
+ -3750 29750 942 2
+
+
+ -21883 20471 1436 0
+ -21818 20543 1406 3
+ -21731 20639 1341 3
+ -21631 20744 1330 3
+ -21524 20855 1327 3
+ -21422 20957 1381 3
+ -21313 21066 1398 3
+ -21221 21156 1458 3
+ -21120 21246 1585 3
+ -21185 21178 1642 3
+ -21149 21209 1699 3
+ -21040 21315 1719 3
+ -20961 21385 1817 3
+ -20850 21489 1868 3
+ -20858 21468 2018 3
+ -20896 21418 2153 3
+ -20932 21369 2289 3
+ -20975 21312 2419 3
+ -21067 21217 2450 3
+ -21178 21102 2487 3
+ -21289 20991 2484 3
+ -21379 20907 2418 3
+ -21471 20823 2321 3
+ -21568 20723 2319 3
+ -21552 20726 2442 3
+ -21459 20812 2518 3
+ -21405 20851 2661 3
+ -21467 20773 2768 3
+ -21566 20665 2809 3
+ -21665 20555 2847 3
+ -21722 20483 2937 3
+ -21645 20546 3063 3
+ -21552 20632 3137 3
+ -21447 20743 3121 3
+ -21340 20855 3108 3
+ -21234 20957 3147 3
+ -21135 21046 3220 3
+ -21029 21153 3211 3
+ -20929 21269 3104 3
+ -20905 21279 3188 3
+ -20987 21183 3291 3
+ -21051 21107 3366 3
+ -21059 21077 3501 3
+ -21074 21035 3661 3
+ -20958 21136 3744 3
+ -20898 21200 3723 3
+ -20804 21306 3637 3
+ -20743 21384 3528 3
+ -20680 21460 3435 3
+ -20607 21546 3334 3
+ -20604 21572 3183 3
+ -20604 21594 3032 3
+ -20595 21623 2878 3
+ -20593 21645 2723 3
+ -20608 21648 2584 3
+ -20616 21657 2438 3
+ -20609 21681 2287 3
+ -20581 21721 2149 3
+ -20538 21775 2010 3
+ -20447 21864 1980 3
+ -20374 21938 1903 3
+ -20255 22049 1896 3
+ -20167 22138 1792 3
+ -20049 22246 1781 3
+ -20025 22277 1657 3
+ -20038 22276 1507 3
+ -19978 22337 1391 3
+ -19878 22430 1322 3
+ -19768 22531 1256 3
+ -19740 22562 1129 3
+ -19742 22567 979 3
+ -19716 22597 826 3
+ -19682 22631 661 3
+ -19807 22524 566 3
+ -19879 22464 433 3
+ -19882 22464 316 3
+ -19979 22378 255 3
+ -20060 22306 166 3
+ -20124 22249 35 3
+ -20167 22210 -105 3
+ -20210 22170 -245 3
+ -20277 22107 -365 3
+ -20358 22030 -470 3
+ -20432 21959 -582 3
+ -20514 21878 -712 3
+ -20559 21839 -638 3
+ -20523 21876 -483 3
+ -20488 21912 -344 3
+ -20563 21842 -311 3
+ -20597 21811 -242 3
+ -20601 21808 -92 3
+ -20547 21859 40 3
+ -20516 21888 182 3
+ -20465 21933 317 3
+ -20397 21994 461 3
+ -20488 21908 547 3
+ -20490 21903 625 3
+ -20486 21902 770 3
+ -20548 21841 880 3
+ -20615 21772 994 3
+ -20628 21752 1154 3
+ -20590 21781 1281 3
+ -20534 21826 1413 3
+ -20518 21830 1565 3
+ -20480 21852 1740 3
+ -20560 21771 1816 3
+ -20569 21750 1969 3
+ -20606 21704 2080 3
+ -20697 21609 2160 3
+ -20739 21577 2082 3
+ -20763 21566 1941 3
+ -20763 21577 1817 3
+ -20739 21612 1669 3
+ -20793 21571 1529 3
+ -20820 21556 1378 3
+ -20905 21479 1270 3
+ -20896 21491 1233 3
+ -20882 21509 1144 3
+ -20899 21496 1068 3
+ -20996 21405 997 3
+ -21093 21313 927 3
+ -21190 21219 857 3
+ -21316 21096 765 3
+ -21279 21128 918 3
+ -21389 21015 936 3
+ -21494 20908 916 3
+ -21596 20805 863 3
+ -21699 20698 853 3
+ -21799 20594 812 3
+ -21902 20486 812 3
+ -22001 20377 846 3
+ -22104 20265 846 3
+ -22206 20153 859 3
+ -22296 20051 920 3
+ -22381 19952 996 3
+ -22384 19942 1136 3
+ -22326 19999 1264 3
+ -22239 20090 1346 3
+ -22145 20189 1411 3
+ -22045 20296 1446 3
+ -21943 20406 1449 3
+
+
+ 25827 -2922 -14981 0
+ 25764 -2899 -15093 2
+ 25783 -2759 -15088 2
+ 25804 -2618 -15077 2
+ 25788 -2480 -15127 2
+ 25801 -2327 -15128 2
+ 25816 -2177 -15126 2
+ 25822 -2028 -15137 2
+ 25819 -1884 -15159 2
+ 25835 -1726 -15152 2
+ 25877 -1585 -15096 2
+ 25833 -1473 -15182 2
+ 25773 -1390 -15291 2
+ 25698 -1398 -15417 2
+ 25670 -1500 -15453 2
+ 25666 -1668 -15443 2
+ 25695 -1812 -15378 2
+ 25644 -1936 -15448 2
+ 25581 -2032 -15539 2
+ 25504 -2118 -15655 2
+ 25494 -2243 -15654 2
+ 25498 -2403 -15623 2
+ 25442 -2509 -15698 2
+ 25350 -2511 -15845 2
+ 25321 -2367 -15913 2
+ 25246 -2322 -16040 2
+ 25165 -2307 -16167 2
+ 25132 -2193 -16235 2
+ 25193 -2114 -16150 2
+ 25235 -2009 -16098 2
+ 25312 -1902 -15990 2
+ 25306 -1753 -16017 2
+ 25296 -1634 -16045 2
+ 25346 -1506 -15979 2
+ 25409 -1390 -15890 2
+ 25452 -1255 -15831 2
+ 25510 -1150 -15745 2
+ 25592 -1004 -15621 2
+ 25531 -995 -15722 2
+ 25470 -893 -15827 2
+ 25395 -840 -15950 2
+ 25326 -768 -16062 2
+ 25273 -656 -16151 2
+ 25225 -539 -16230 2
+ 25161 -464 -16332 2
+ 25080 -511 -16453 2
+ 25038 -387 -16521 2
+ 25107 -300 -16418 2
+ 25196 -354 -16281 2
+ 25251 -406 -16194 2
+ 25331 -398 -16068 2
+ 25403 -451 -15953 2
+ 25477 -496 -15833 2
+ 25554 -453 -15709 2
+ 25620 -555 -15598 2
+ 25663 -677 -15522 2
+ 25724 -730 -15419 2
+ 25799 -692 -15294 2
+ 25837 -551 -15237 2
+ 25900 -469 -15133 2
+ 25952 -354 -15045 2
+ 25972 -208 -15014 2
+ 25973 -58 -15014 2
+ 25946 83 -15059 2
+ 25902 207 -15134 2
+ 25834 274 -15249 2
+ 25760 240 -15374 2
+ 25684 230 -15501 2
+ 25603 252 -15634 2
+ 25530 263 -15753 2
+ 25455 234 -15874 2
+ 25376 252 -15999 2
+ 25289 258 -16137 2
+ 25217 255 -16249 2
+ 25133 238 -16380 2
+ 25061 162 -16490 2
+ 24976 154 -16618 2
+ 24892 172 -16744 2
+ 24809 199 -16866 2
+ 24730 261 -16981 2
+ 24684 380 -17046 2
+ 24622 491 -17133 2
+ 24565 605 -17210 2
+ 24517 745 -17273 2
+ 24534 871 -17243 2
+ 24605 825 -17143 2
+ 24679 712 -17042 2
+ 24725 622 -16979 2
+ 24793 530 -16882 2
+ 24873 459 -16767 2
+ 24955 448 -16645 2
+ 25036 472 -16521 2
+ 25113 494 -16403 2
+ 25196 458 -16278 2
+ 25274 503 -16155 2
+ 25353 532 -16030 2
+ 25433 552 -15901 2
+ 25510 562 -15777 2
+ 25582 620 -15658 2
+ 25645 661 -15553 2
+ 25726 694 -15418 2
+ 25764 586 -15358 2
+ 25813 463 -15280 2
+ 25886 468 -15156 2
+ 25939 408 -15067 2
+ 25981 287 -14997 2
+ 26023 152 -14926 2
+ 26043 -13 -14892 2
+ 26038 -142 -14899 2
+ 26033 -360 -14904 2
+ 26083 -420 -14815 2
+ 26120 -557 -14746 2
+ 26151 -688 -14685 2
+ 26149 -839 -14681 2
+ 26143 -996 -14682 2
+ 26178 -1129 -14609 2
+ 26188 -1276 -14579 2
+ 26240 -1381 -14476 2
+ 26251 -1496 -14444 2
+ 26247 -1641 -14437 2
+ 26212 -1820 -14478 2
+ 26145 -1823 -14598 2
+ 26074 -1846 -14722 2
+ 26051 -1996 -14743 2
+ 26016 -2125 -14786 2
+ 26006 -2290 -14780 2
+ 26014 -2439 -14742 2
+ 26015 -2587 -14716 2
+ 26032 -2726 -14659 2
+ 26007 -2884 -14673 2
+ 25946 -2959 -14766 2
+ 25874 -2929 -14898 2
+
+
+ 29737 2888 -2716 0
+ 29746 2775 -2728 2
+ 29754 2637 -2780 2
+ 29760 2497 -2852 2
+ 29758 2391 -2952 2
+ 29756 2280 -3065 2
+ 29751 2181 -3179 2
+ 29746 2080 -3289 2
+ 29742 1974 -3398 2
+ 29726 1940 -3549 2
+ 29720 1832 -3656 2
+ 29716 1709 -3748 2
+ 29712 1585 -3830 2
+ 29702 1488 -3948 2
+ 29703 1341 -3989 2
+ 29702 1207 -4043 2
+ 29684 1164 -4181 2
+ 29669 1079 -4314 2
+ 29652 1006 -4443 2
+ 29639 880 -4559 2
+ 29638 744 -4583 2
+ 29633 602 -4638 2
+ 29628 458 -4684 2
+ 29623 315 -4734 2
+ 29617 161 -4776 2
+ 29597 96 -4902 2
+ 29574 23 -5035 2
+ 29563 -107 -5099 2
+ 29547 -224 -5188 2
+ 29529 -339 -5284 2
+ 29511 -461 -5375 2
+ 29501 -607 -5417 2
+ 29482 -733 -5501 2
+ 29467 -869 -5562 2
+ 29448 -999 -5640 2
+ 29440 -1148 -5652 2
+ 29421 -1285 -5721 2
+ 29396 -1390 -5824 2
+ 29372 -1501 -5918 2
+ 29350 -1632 -5991 2
+ 29324 -1739 -6091 2
+ 29293 -1827 -6211 2
+ 29262 -1920 -6330 2
+ 29241 -2059 -6382 2
+ 29211 -2166 -6484 2
+ 29178 -2256 -6600 2
+ 29145 -2354 -6710 2
+ 29110 -2438 -6832 2
+ 29076 -2532 -6940 2
+ 29038 -2602 -7074 2
+ 29002 -2702 -7181 2
+ 28971 -2820 -7261 2
+ 28933 -2928 -7369 2
+ 28883 -3059 -7512 2
+ 28894 -2930 -7520 2
+ 28873 -2914 -7605 2
+ 28822 -3001 -7763 2
+ 28810 -2916 -7841 2
+ 28782 -2927 -7939 2
+ 28738 -3033 -8060 2
+ 28724 -2947 -8138 2
+ 28735 -2797 -8154 2
+ 28744 -2647 -8173 2
+ 28755 -2497 -8181 2
+ 28766 -2347 -8186 2
+ 28785 -2201 -8159 2
+ 28783 -2045 -8207 2
+ 28802 -1908 -8173 2
+ 28796 -1760 -8228 2
+ 28786 -1636 -8286 2
+ 28817 -1532 -8199 2
+ 28845 -1410 -8122 2
+ 28874 -1277 -8042 2
+ 28917 -1238 -7891 2
+ 28958 -1225 -7741 2
+ 28992 -1354 -7590 2
+ 28993 -1255 -7605 2
+ 28979 -1111 -7679 2
+ 29013 -1026 -7563 2
+ 29029 -920 -7513 2
+ 29041 -769 -7486 2
+ 29050 -621 -7462 2
+ 29074 -549 -7377 2
+ 29114 -534 -7217 2
+ 29145 -498 -7093 2
+ 29176 -399 -6971 2
+ 29175 -264 -6981 2
+ 29181 -161 -6959 2
+ 29176 -91 -6980 2
+ 29149 -11 -7096 2
+ 29141 123 -7125 2
+ 29165 216 -7024 2
+ 29198 256 -6886 2
+ 29228 177 -6758 2
+ 29276 112 -6550 2
+ 29260 146 -6620 2
+ 29228 232 -6758 2
+ 29239 357 -6706 2
+ 29271 386 -6561 2
+ 29299 445 -6432 2
+ 29316 562 -6343 2
+ 29324 704 -6294 2
+ 29345 806 -6182 2
+ 29370 870 -6054 2
+ 29395 927 -5924 2
+ 29402 1068 -5863 2
+ 29421 1172 -5749 2
+ 29443 1068 -5655 2
+ 29460 1101 -5558 2
+ 29479 1185 -5437 2
+ 29493 1353 -5323 2
+ 29510 1397 -5216 2
+ 29510 1537 -5174 2
+ 29522 1647 -5072 2
+ 29539 1728 -4946 2
+ 29552 1823 -4830 2
+ 29568 1902 -4703 2
+ 29585 1971 -4564 2
+ 29594 2077 -4461 2
+ 29611 2152 -4311 2
+ 29605 2247 -4298 2
+ 29608 2371 -4212 2
+ 29608 2490 -4140 2
+ 29611 2603 -4049 2
+ 29618 2709 -3932 2
+ 29637 2710 -3782 2
+ 29651 2749 -3641 2
+ 29670 2741 -3493 2
+ 29688 2730 -3344 2
+ 29701 2763 -3198 2
+ 29706 2850 -3075 2
+ 29711 2927 -2947 2
+ 29725 2934 -2799 2
+
+
+ 17606 18970 15171 0
+ 17593 18901 15271 3
+ 17617 18783 15390 3
+ 17696 18659 15450 3
+ 17771 18540 15507 3
+ 17859 18423 15545 3
+ 17964 18320 15546 3
+ 18084 18262 15475 3
+ 18199 18247 15358 3
+ 18306 18208 15276 3
+ 18420 18108 15257 3
+ 18539 18033 15202 3
+ 18658 17969 15133 3
+ 18769 17928 15043 3
+ 18878 17900 14941 3
+ 18981 17883 14830 3
+ 19053 17914 14699 3
+ 19128 17940 14570 3
+ 19197 17973 14438 3
+ 19268 18001 14307 3
+ 19351 18014 14180 3
+ 19377 18016 14140 3
+ 19274 18197 14049 3
+ 19185 18315 14017 3
+ 19100 18436 13975 3
+ 19035 18555 13906 3
+ 18956 18674 13854 3
+ 18901 18789 13774 3
+ 18811 18890 13759 3
+ 18714 18968 13785 3
+ 18597 19001 13897 3
+ 18526 19084 13878 3
+ 18553 19105 13813 3
+ 18596 19123 13730 3
+ 18484 19246 13709 3
+ 18380 19241 13855 3
+ 18269 19324 13886 3
+ 18182 19438 13842 3
+ 18133 19551 13746 3
+ 18112 19644 13641 3
+ 18240 19600 13534 3
+ 18313 19581 13462 3
+ 18401 19548 13390 3
+ 18453 19588 13258 3
+ 18488 19644 13126 3
+ 18427 19737 13072 3
+ 18298 19814 13137 3
+ 18179 19896 13178 3
+ 18076 20008 13151 3
+ 17965 20109 13149 3
+ 17867 20113 13276 3
+ 17807 20080 13405 3
+ 17844 19968 13523 3
+ 17920 19864 13575 3
+ 17963 19784 13635 3
+ 17788 19943 13634 3
+ 17694 20051 13597 3
+ 17626 20155 13531 3
+ 17590 20257 13425 3
+ 17519 20348 13381 3
+ 17383 20400 13478 3
+ 17275 20431 13571 3
+ 17148 20517 13601 3
+ 17049 20562 13658 3
+ 16944 20678 13613 3
+ 16828 20771 13616 3
+ 16717 20870 13601 3
+ 16603 20941 13632 3
+ 16485 20988 13701 3
+ 16448 21071 13620 3
+ 16553 21068 13496 3
+ 16670 21034 13404 3
+ 16693 21064 13329 3
+ 16520 21178 13364 3
+ 16509 21260 13245 3
+ 16504 21344 13118 3
+ 16577 21360 12998 3
+ 16676 21360 12872 3
+ 16779 21343 12765 3
+ 16829 21361 12670 3
+ 16693 21471 12662 3
+ 16665 21563 12542 3
+ 16604 21664 12449 3
+ 16504 21768 12400 3
+ 16427 21866 12331 3
+ 16310 21921 12388 3
+ 16226 21907 12522 3
+ 16157 21897 12628 3
+ 16045 21940 12696 3
+ 15928 21972 12787 3
+ 15865 21935 12929 3
+ 15825 21890 13053 3
+ 15792 21836 13183 3
+ 15741 21779 13338 3
+ 15672 21758 13454 3
+ 15688 21676 13566 3
+ 15655 21614 13702 3
+ 15661 21541 13810 3
+ 15593 21486 13971 3
+ 15502 21460 14113 3
+ 15474 21429 14191 3
+ 15539 21304 14307 3
+ 15565 21205 14425 3
+ 15560 21142 14522 3
+ 15563 21046 14658 3
+ 15676 20972 14644 3
+ 15802 20899 14613 3
+ 15930 20790 14629 3
+ 15999 20719 14654 3
+ 16100 20576 14744 3
+ 16174 20467 14816 3
+ 16291 20371 14820 3
+ 16403 20278 14823 3
+ 16525 20187 14812 3
+ 16641 20090 14815 3
+ 16759 20011 14788 3
+ 16883 19924 14765 3
+ 17002 19832 14753 3
+ 17106 19725 14775 3
+ 17223 19631 14764 3
+ 17338 19540 14750 3
+ 17460 19508 14650 3
+ 17579 19445 14591 3
+ 17585 19407 14633 3
+ 17483 19406 14756 3
+ 17446 19330 14899 3
+ 17497 19217 14986 3
+ 17545 19101 15078 3
+ 17615 19014 15105 3
+
+
+ 19067 -11237 20253 0
+ 19034 -11359 20216 2
+ 19005 -11510 20157 2
+ 18995 -11645 20089 2
+ 19026 -11758 19993 2
+ 19023 -11890 19918 2
+ 19002 -12007 19868 2
+ 18944 -12149 19837 2
+ 18905 -12288 19789 2
+ 18897 -12413 19719 2
+ 18922 -12525 19623 2
+ 18919 -12657 19541 2
+ 18980 -12758 19416 2
+ 19037 -12808 19328 2
+ 19127 -12847 19212 2
+ 19189 -12929 19095 2
+ 19287 -12941 18988 2
+ 19400 -12889 18908 2
+ 19514 -12818 18839 2
+ 19629 -12767 18754 2
+ 19741 -12753 18646 2
+ 19853 -12705 18560 2
+ 19952 -12621 18510 2
+ 20036 -12484 18512 2
+ 20114 -12352 18517 2
+ 20193 -12224 18515 2
+ 20274 -12096 18511 2
+ 20340 -11959 18527 2
+ 20413 -11826 18533 2
+ 20481 -11691 18544 2
+ 20540 -11553 18564 2
+ 20607 -11417 18574 2
+ 20678 -11284 18577 2
+ 20755 -11156 18568 2
+ 20826 -11021 18569 2
+ 20895 -10886 18571 2
+ 20960 -10748 18579 2
+ 21023 -10610 18586 2
+ 21089 -10473 18590 2
+ 21163 -10341 18579 2
+ 21225 -10218 18577 2
+ 21292 -10070 18581 2
+ 21361 -9936 18573 2
+ 21427 -9799 18571 2
+ 21498 -9666 18558 2
+ 21568 -9532 18546 2
+ 21632 -9394 18542 2
+ 21682 -9256 18553 2
+ 21737 -9114 18559 2
+ 21752 -8974 18609 2
+ 21807 -8833 18613 2
+ 21888 -8719 18571 2
+ 21941 -8633 18549 2
+ 21997 -8479 18554 2
+ 22007 -8344 18603 2
+ 22012 -8206 18658 2
+ 22026 -8060 18705 2
+ 22105 -8010 18634 2
+ 22118 -8145 18559 2
+ 22169 -8227 18462 2
+ 22252 -8104 18416 2
+ 22312 -7963 18405 2
+ 22325 -7827 18449 2
+ 22307 -7696 18525 2
+ 22310 -7554 18579 2
+ 22332 -7407 18613 2
+ 22350 -7261 18648 2
+ 22364 -7114 18688 2
+ 22362 -6969 18745 2
+ 22360 -6833 18797 2
+ 22352 -6697 18855 2
+ 22305 -6606 18944 2
+ 22290 -6461 19011 2
+ 22227 -6310 19135 2
+ 22152 -6377 19199 2
+ 22057 -6481 19274 2
+ 22055 -6630 19226 2
+ 22014 -6770 19224 2
+ 21960 -6916 19233 2
+ 21860 -6981 19324 2
+ 21766 -7099 19387 2
+ 21695 -7043 19487 2
+ 21631 -7093 19540 2
+ 21617 -7310 19475 2
+ 21563 -7374 19510 2
+ 21530 -7563 19475 2
+ 21451 -7634 19534 2
+ 21370 -7770 19570 2
+ 21362 -7675 19615 2
+ 21303 -7723 19660 2
+ 21188 -7947 19695 2
+ 21141 -7895 19767 2
+ 21032 -7972 19852 2
+ 20939 -8057 19916 2
+ 20897 -8185 19907 2
+ 20871 -8219 19921 2
+ 20794 -8165 20024 2
+ 20698 -8166 20122 2
+ 20603 -8249 20186 2
+ 20496 -8278 20282 2
+ 20381 -8332 20376 2
+ 20280 -8370 20461 2
+ 20172 -8410 20552 2
+ 20134 -8566 20524 2
+ 20063 -8700 20538 2
+ 19979 -8826 20566 2
+ 19899 -8947 20591 2
+ 19854 -9086 20573 2
+ 19844 -9221 20523 2
+ 19818 -9364 20483 2
+ 19806 -9503 20431 2
+ 19822 -9632 20354 2
+ 19798 -9766 20314 2
+ 19804 -9905 20241 2
+ 19806 -10035 20175 2
+ 19765 -10176 20144 2
+ 19720 -10302 20124 2
+ 19634 -10427 20144 2
+ 19551 -10539 20167 2
+ 19457 -10666 20190 2
+ 19388 -10803 20184 2
+ 19287 -10892 20233 2
+ 19208 -10984 20258 2
+ 19140 -11130 20243 2
+
+
+ 14146 19873 -17463 0
+ 14250 19783 -17481 2
+ 14167 19761 -17573 2
+ 14202 19665 -17651 2
+ 14326 19646 -17572 2
+ 14360 19749 -17429 2
+ 14450 19690 -17421 2
+ 14560 19589 -17443 2
+ 14674 19510 -17437 2
+ 14712 19393 -17535 2
+ 14834 19261 -17578 2
+ 14820 19161 -17698 2
+ 14893 19044 -17764 2
+ 14990 18937 -17796 2
+ 15082 18822 -17840 2
+ 15193 18722 -17851 2
+ 15293 18610 -17882 2
+ 15388 18501 -17914 2
+ 15517 18435 -17871 2
+ 15634 18350 -17856 2
+ 15742 18245 -17869 2
+ 15864 18161 -17847 2
+ 15990 18105 -17792 2
+ 16118 18055 -17727 2
+ 16242 17995 -17675 2
+ 16351 17974 -17595 2
+ 16325 18098 -17491 2
+ 16177 18218 -17504 2
+ 16233 18237 -17433 2
+ 16356 18174 -17384 2
+ 16415 18062 -17445 2
+ 16493 17940 -17497 2
+ 16605 17840 -17494 2
+ 16728 17751 -17467 2
+ 16844 17650 -17457 2
+ 16905 17521 -17528 2
+ 17026 17441 -17491 2
+ 17138 17426 -17396 2
+ 17177 17482 -17301 2
+ 17292 17483 -17185 2
+ 17403 17472 -17083 2
+ 17523 17432 -17002 2
+ 17635 17419 -16899 2
+ 17754 17422 -16772 2
+ 17833 17439 -16669 2
+ 17960 17388 -16586 2
+ 18073 17297 -16558 2
+ 18191 17213 -16516 2
+ 18309 17130 -16473 2
+ 18431 17059 -16411 2
+ 18546 16978 -16365 2
+ 18651 16948 -16276 2
+ 18751 16872 -16240 2
+ 18776 16770 -16317 2
+ 18671 16767 -16440 2
+ 18566 16780 -16546 2
+ 18502 16716 -16681 2
+ 18435 16768 -16703 2
+ 18342 16891 -16681 2
+ 18263 16889 -16770 2
+ 18123 16912 -16898 2
+ 18042 16925 -16971 2
+ 17936 16976 -17032 2
+ 17806 17001 -17144 2
+ 17687 17062 -17207 2
+ 17574 17103 -17282 2
+ 17484 17078 -17397 2
+ 17393 17062 -17504 2
+ 17341 17025 -17592 2
+ 17474 16905 -17576 2
+ 17548 16780 -17621 2
+ 17550 16672 -17722 2
+ 17533 16583 -17821 2
+ 17445 16553 -17936 2
+ 17339 16642 -17956 2
+ 17215 16765 -17960 2
+ 17114 16857 -17971 2
+ 16986 16899 -18053 2
+ 16921 16955 -18061 2
+ 16966 17046 -17933 2
+ 16893 17164 -17889 2
+ 16818 17157 -17966 2
+ 16771 17077 -18087 2
+ 16723 17050 -18156 2
+ 16610 17057 -18253 2
+ 16487 17048 -18373 2
+ 16379 17127 -18396 2
+ 16220 17222 -18447 2
+ 16225 17085 -18570 2
+ 16103 17171 -18597 2
+ 16031 17289 -18551 2
+ 15883 17310 -18657 2
+ 15737 17437 -18662 2
+ 15778 17340 -18718 2
+ 15850 17206 -18781 2
+ 15777 17217 -18833 2
+ 15646 17286 -18878 2
+ 15557 17410 -18838 2
+ 15434 17492 -18864 2
+ 15380 17556 -18848 2
+ 15386 17665 -18741 2
+ 15337 17783 -18670 2
+ 15250 17902 -18626 2
+ 15146 18010 -18607 2
+ 15050 18115 -18584 2
+ 14981 18235 -18522 2
+ 14935 18353 -18442 2
+ 14901 18470 -18353 2
+ 14795 18590 -18317 2
+ 14682 18615 -18383 2
+ 14624 18650 -18393 2
+ 14567 18756 -18330 2
+ 14459 18862 -18307 2
+ 14343 18962 -18296 2
+ 14253 19078 -18245 2
+ 14203 19189 -18167 2
+ 14173 19305 -18068 2
+ 14155 19410 -17970 2
+ 14181 19503 -17848 2
+ 14161 19610 -17746 2
+ 14100 19725 -17667 2
+ 14064 19824 -17585 2
+
+
+ -1369 25599 15582 0
+ -1389 25542 15674 2
+ -1457 25488 15756 2
+ -1455 25427 15855 2
+ -1492 25411 15877 2
+ -1592 25380 15915 2
+ -1602 25295 16049 2
+ -1576 25237 16144 2
+ -1622 25160 16259 2
+ -1691 25080 16375 2
+ -1657 25029 16456 2
+ -1520 25077 16396 2
+ -1509 25059 16425 2
+ -1566 25001 16507 2
+ -1634 24899 16655 2
+ -1642 24827 16761 2
+ -1685 24706 16934 2
+ -1622 24747 16881 2
+ -1582 24828 16765 2
+ -1506 24913 16645 2
+ -1456 24866 16720 2
+ -1436 24804 16813 2
+ -1391 24726 16933 2
+ -1462 24641 17049 2
+ -1528 24560 17160 2
+ -1472 24501 17250 2
+ -1307 24513 17246 2
+ -1170 24523 17241 2
+ -991 24562 17196 2
+ -1000 24535 17235 2
+ -1083 24449 17352 2
+ -1045 24368 17468 2
+ -940 24319 17542 2
+ -906 24255 17632 2
+ -928 24173 17743 2
+ -931 24072 17880 2
+ -1030 24055 17897 2
+ -1185 24051 17892 2
+ -1325 24010 17938 2
+ -1452 23925 18041 2
+ -1375 23912 18065 2
+ -1287 23845 18159 2
+ -1316 23762 18266 2
+ -1424 23697 18342 2
+ -1565 23655 18384 2
+ -1676 23586 18463 2
+ -1601 23533 18538 2
+ -1399 23540 18544 2
+ -1317 23502 18599 2
+ -1202 23475 18641 2
+ -1066 23450 18681 2
+ -862 23523 18599 2
+ -915 23466 18668 2
+ -1008 23394 18754 2
+ -1158 23382 18760 2
+ -1315 23382 18750 2
+ -1428 23326 18811 2
+ -1516 23250 18898 2
+ -1621 23176 18980 2
+ -1717 23105 19058 2
+ -1864 23035 19129 2
+ -1808 23003 19173 2
+ -1696 23020 19162 2
+ -1588 23075 19105 2
+ -1425 23096 19093 2
+ -1282 23068 19137 2
+ -1177 23118 19083 2
+ -1106 23196 18993 2
+ -941 23215 18979 2
+ -805 23178 19029 2
+ -655 23203 19006 2
+ -493 23246 18957 2
+ -366 23254 18951 2
+ -257 23241 18968 2
+ -88 23252 18956 2
+ 66 23240 18971 2
+ 209 23274 18928 2
+ 335 23314 18877 2
+ 447 23404 18764 2
+ 237 23456 18702 2
+ 288 23541 18594 2
+ 401 23611 18502 2
+ 498 23672 18423 2
+ 545 23760 18307 2
+ 545 23850 18190 2
+ 450 23919 18102 2
+ 307 23945 18070 2
+ 158 23924 18100 2
+ 49 23931 18092 2
+ 102 24025 17966 2
+ 34 24108 17856 2
+ -137 24171 17770 2
+ -20 24167 17775 2
+ -43 24240 17676 2
+ -72 24322 17563 2
+ -163 24402 17450 2
+ -297 24450 17381 2
+ -378 24497 17314 2
+ -428 24582 17191 2
+ -464 24665 17071 2
+ -504 24749 16948 2
+ -595 24814 16850 2
+ -709 24863 16773 2
+ -840 24873 16752 2
+ -1010 24872 16744 2
+ -970 24886 16725 2
+ -812 24936 16659 2
+ -870 24984 16585 2
+ -867 24999 16561 2
+ -739 25038 16509 2
+ -660 25106 16408 2
+ -597 25184 16292 2
+ -537 25260 16175 2
+ -527 25329 16067 2
+ -664 25349 16030 2
+ -814 25352 16018 2
+ -965 25354 16007 2
+ -1163 25329 16034 2
+ -1115 25385 15948 2
+ -1052 25452 15846 2
+ -936 25507 15765 2
+ -863 25593 15629 2
+ -993 25606 15600 2
+ -1165 25588 15617 2
+ -1290 25592 15600 2
+
+
+ -8155 28629 -3723 0
+ -8112 28651 -3649 2
+ -7998 28694 -3562 2
+ -7853 28736 -3548 2
+ -7814 28730 -3679 2
+ -7820 28709 -3827 2
+ -7832 28685 -3978 2
+ -7863 28657 -4117 2
+ -7908 28624 -4256 2
+ -8031 28579 -4332 2
+ -8103 28539 -4459 2
+ -8235 28484 -4566 2
+ -8328 28472 -4468 2
+ -8402 28452 -4462 2
+ -8483 28437 -4402 2
+ -8532 28446 -4247 2
+ -8581 28453 -4094 2
+ -8598 28441 -4147 2
+ -8604 28423 -4252 2
+ -8592 28404 -4404 2
+ -8575 28385 -4556 2
+ -8651 28347 -4649 2
+ -8806 28306 -4605 2
+ -8890 28299 -4487 2
+ -8961 28296 -4361 2
+ -9024 28298 -4218 2
+ -9054 28310 -4069 2
+ -9129 28304 -3944 2
+ -9232 28285 -3838 2
+ -9368 28254 -3737 2
+ -9384 28239 -3810 2
+ -9353 28232 -3935 2
+ -9271 28240 -4071 2
+ -9197 28245 -4200 2
+ -9153 28237 -4346 2
+ -9118 28225 -4493 2
+ -9094 28209 -4642 2
+ -9169 28169 -4739 2
+ -9322 28121 -4720 2
+ -9446 28084 -4694 2
+ -9570 28059 -4596 2
+ -9640 28056 -4466 2
+ -9727 28050 -4310 2
+ -9835 28014 -4301 2
+ -9966 27961 -4344 2
+ -10111 27913 -4318 2
+ -10166 27914 -4180 2
+ -10212 27921 -4014 2
+ -10238 27929 -3893 2
+ -10275 27936 -3744 2
+ -10288 27951 -3592 2
+ -10247 27985 -3444 2
+ -10256 27999 -3301 2
+ -10221 28028 -3159 2
+ -10113 28080 -3045 2
+ -10198 28055 -2984 2
+ -10283 28034 -2888 2
+ -10382 28007 -2796 2
+ -10465 27988 -2680 2
+ -10537 27974 -2540 2
+ -10557 27979 -2394 2
+ -10482 28021 -2226 2
+ -10332 28076 -2235 2
+ -10357 28054 -2391 2
+ -10300 28075 -2391 2
+ -10185 28115 -2414 2
+ -10180 28124 -2319 2
+ -10120 28156 -2191 2
+ -10183 28144 -2051 2
+ -10131 28170 -1953 2
+ -9997 28216 -1988 2
+ -9900 28243 -2085 2
+ -9745 28286 -2224 2
+ -9698 28295 -2312 2
+ -9573 28332 -2384 2
+ -9428 28376 -2433 2
+ -9289 28426 -2383 2
+ -9149 28473 -2359 2
+ -9007 28517 -2381 2
+ -8863 28562 -2380 2
+ -8716 28607 -2375 2
+ -8574 28651 -2364 2
+ -8432 28691 -2395 2
+ -8301 28723 -2472 2
+ -8232 28730 -2608 2
+ -8288 28704 -2718 2
+ -8444 28655 -2754 2
+ -8587 28611 -2772 2
+ -8725 28567 -2793 2
+ -8882 28519 -2788 2
+ -8973 28483 -2860 2
+ -8920 28493 -2928 2
+ -8779 28538 -2915 2
+ -8630 28584 -2906 2
+ -8490 28627 -2903 2
+ -8355 28661 -2955 2
+ -8236 28687 -3041 2
+ -8340 28654 -3065 2
+ -8458 28616 -3097 2
+ -8455 28601 -3238 2
+ -8470 28584 -3346 2
+ -8449 28588 -3364 2
+ -8341 28633 -3256 2
+ -8207 28666 -3297 2
+ -8096 28685 -3411 2
+ -8165 28648 -3556 2
+ -8180 28629 -3670 2
+
+
+ -27734 11163 2489 0
+ -27715 11176 2640 2
+ -27707 11168 2754 2
+ -27666 11234 2897 2
+ -27620 11321 2998 2
+ -27597 11336 3148 2
+ -27559 11394 3267 2
+ -27508 11486 3377 2
+ -27460 11561 3502 2
+ -27437 11569 3653 2
+ -27419 11564 3804 2
+ -27413 11519 3978 2
+ -27465 11437 3855 2
+ -27489 11361 3909 2
+ -27482 11331 4043 2
+ -27465 11307 4218 2
+ -27454 11303 4302 2
+ -27448 11263 4444 2
+ -27415 11280 4602 2
+ -27436 11177 4727 2
+ -27440 11107 4867 2
+ -27425 11074 5021 2
+ -27417 11030 5159 2
+ -27388 11034 5307 2
+ -27358 11036 5453 2
+ -27389 10911 5549 2
+ -27432 10778 5597 2
+ -27445 10683 5712 2
+ -27446 10612 5839 2
+ -27418 10600 5990 2
+ -27385 10589 6157 2
+ -27410 10471 6249 2
+ -27472 10362 6158 2
+ -27546 10233 6042 2
+ -27529 10198 6174 2
+ -27495 10207 6312 2
+ -27454 10228 6456 2
+ -27414 10238 6606 2
+ -27375 10249 6749 2
+ -27342 10239 6896 2
+ -27317 10208 7043 2
+ -27261 10236 7217 2
+ -27233 10237 7319 2
+ -27179 10284 7452 2
+ -27106 10343 7635 2
+ -27100 10438 7525 2
+ -27095 10536 7406 2
+ -27113 10592 7259 2
+ -27147 10605 7112 2
+ -27173 10642 6956 2
+ -27138 10747 6929 2
+ -27154 10798 6787 2
+ -27166 10846 6664 2
+ -27193 10872 6506 2
+ -27203 10917 6390 2
+ -27201 11005 6247 2
+ -27205 11041 6163 2
+ -27184 11162 6037 2
+ -27197 11118 6062 2
+ -27204 11111 6040 2
+ -27211 11181 5878 2
+ -27205 11253 5765 2
+ -27203 11325 5636 2
+ -27204 11387 5502 2
+ -27215 11419 5381 2
+ -27245 11426 5213 2
+ -27248 11479 5077 2
+ -27225 11582 4969 2
+ -27212 11661 4848 2
+ -27227 11688 4698 2
+ -27231 11745 4534 2
+ -27243 11761 4418 2
+ -27262 11777 4250 2
+ -27286 11772 4114 2
+ -27294 11796 3987 2
+ -27311 11806 3835 2
+ -27335 11799 3685 2
+ -27375 11748 3548 2
+ -27405 11725 3392 2
+ -27429 11705 3261 2
+ -27468 11651 3120 2
+ -27505 11603 2977 2
+ -27542 11546 2848 2
+ -27596 11442 2742 2
+ -27656 11299 2734 2
+ -27681 11249 2685 2
+ -27714 11204 2525 2
+
+
+ -15425 23492 10498 0
+ -15483 23493 10411 2
+ -15604 23447 10333 2
+ -15727 23380 10297 2
+ -15842 23304 10294 2
+ -15992 23206 10284 2
+ -16103 23132 10275 2
+ -16224 23041 10290 2
+ -16347 22951 10298 2
+ -16487 22827 10350 2
+ -16595 22774 10292 2
+ -16652 22683 10401 2
+ -16726 22664 10322 2
+ -16928 22537 10273 2
+ -17023 22500 10197 2
+ -16964 22465 10371 2
+ -17064 22397 10354 2
+ -17187 22328 10298 2
+ -17311 22248 10265 2
+ -17370 22154 10368 2
+ -17277 22159 10512 2
+ -17185 22184 10609 2
+ -17115 22175 10740 2
+ -17047 22160 10879 2
+ -16982 22145 11008 2
+ -16905 22151 11117 2
+ -16777 22190 11232 2
+ -16668 22237 11301 2
+ -16686 22204 11338 2
+ -16777 22137 11335 2
+ -16755 22117 11407 2
+ -16657 22153 11480 2
+ -16575 22175 11556 2
+ -16546 22160 11627 2
+ -16675 22085 11585 2
+ -16801 22002 11561 2
+ -16921 21954 11475 2
+ -16946 21897 11548 2
+ -16841 21922 11654 2
+ -16724 21997 11680 2
+ -16557 22091 11740 2
+ -16502 22105 11793 2
+ -16364 22215 11778 2
+ -16315 22219 11837 2
+ -16382 22109 11951 2
+ -16474 22028 11975 2
+ -16600 21924 11991 2
+ -16590 21891 12064 2
+ -16453 21975 12099 2
+ -16451 21952 12143 2
+ -16527 21855 12216 2
+ -16463 21831 12344 2
+ -16325 21931 12349 2
+ -16230 22022 12314 2
+ -16091 22157 12252 2
+ -16203 22115 12182 2
+ -16196 22157 12114 2
+ -16028 22300 12076 2
+ -16122 22271 12004 2
+ -16273 22164 11999 2
+ -16264 22224 11899 2
+ -16174 22320 11842 2
+ -16065 22378 11881 2
+ -15899 22471 11927 2
+ -15958 22477 11837 2
+ -16067 22449 11743 2
+ -16017 22494 11726 2
+ -15986 22559 11644 2
+ -15876 22641 11633 2
+ -15754 22728 11629 2
+ -15782 22790 11469 2
+ -15872 22781 11362 2
+ -15960 22765 11271 2
+ -16065 22741 11168 2
+ -16076 22784 11065 2
+ -16136 22804 10935 2
+ -16112 22853 10868 2
+ -15969 22942 10893 2
+ -15990 22992 10756 2
+ -16088 22955 10687 2
+ -16232 22871 10651 2
+ -16218 22900 10609 2
+ -16109 22990 10581 2
+ -15967 23088 10584 2
+ -15853 23162 10594 2
+ -15729 23250 10584 2
+ -15602 23325 10607 2
+ -15566 23392 10512 2
+ -15506 23427 10523 2
+ -15394 23477 10576 2
+
+
+ 1236 -19143 -23066 0
+ 1240 -19065 -23130 2
+ 1178 -18965 -23215 2
+ 1044 -18914 -23264 2
+ 892 -18939 -23249 2
+ 841 -18930 -23258 2
+ 835 -18796 -23367 2
+ 737 -18720 -23431 2
+ 685 -18614 -23517 2
+ 675 -18495 -23611 2
+ 628 -18364 -23715 2
+ 760 -18290 -23768 2
+ 901 -18329 -23733 2
+ 997 -18415 -23662 2
+ 1150 -18467 -23614 2
+ 1280 -18439 -23630 2
+ 1420 -18389 -23661 2
+ 1604 -18317 -23705 2
+ 1660 -18239 -23761 2
+ 1709 -18118 -23850 2
+ 1758 -17994 -23940 2
+ 1864 -17898 -24004 2
+ 1890 -17974 -23945 2
+ 1862 -18119 -23838 2
+ 1973 -18067 -23869 2
+ 2158 -17999 -23903 2
+ 2192 -17910 -23967 2
+ 2198 -17801 -24048 2
+ 2258 -17688 -24126 2
+ 2344 -17560 -24211 2
+ 2331 -17465 -24281 2
+ 2432 -17346 -24356 2
+ 2533 -17287 -24387 2
+ 2657 -17220 -24422 2
+ 2813 -17176 -24435 2
+ 2933 -17125 -24456 2
+ 3039 -16997 -24533 2
+ 3056 -17057 -24489 2
+ 2959 -17158 -24431 2
+ 2922 -17279 -24350 2
+ 2796 -17369 -24300 2
+ 2774 -17474 -24227 2
+ 2676 -17581 -24161 2
+ 2515 -17738 -24063 2
+ 2561 -17637 -24133 2
+ 2542 -17657 -24120 2
+ 2392 -17723 -24087 2
+ 2371 -17837 -24004 2
+ 2389 -17903 -23953 2
+ 2310 -18026 -23869 2
+ 2183 -18052 -23861 2
+ 2200 -18114 -23813 2
+ 2182 -18209 -23742 2
+ 2119 -18360 -23631 2
+ 2125 -18475 -23541 2
+ 2158 -18549 -23480 2
+ 2191 -18681 -23371 2
+ 2209 -18798 -23276 2
+ 2315 -18869 -23208 2
+ 2449 -18917 -23155 2
+ 2517 -19007 -23074 2
+ 2422 -19096 -23010 2
+ 2282 -19142 -22986 2
+ 2157 -19215 -22938 2
+ 2010 -19262 -22911 2
+ 1899 -19365 -22834 2
+ 1903 -19445 -22765 2
+ 1933 -19562 -22663 2
+ 2002 -19666 -22567 2
+ 2080 -19761 -22476 2
+ 2015 -19813 -22436 2
+ 1875 -19888 -22382 2
+ 1750 -19879 -22400 2
+ 1633 -19810 -22470 2
+ 1546 -19722 -22553 2
+ 1482 -19623 -22644 2
+ 1411 -19521 -22737 2
+ 1328 -19422 -22826 2
+ 1254 -19329 -22909 2
+ 1201 -19185 -23032 2
+
+
+ 24076 9507 -15164 0
+ 24148 9432 -15096 2
+ 24231 9437 -14960 2
+ 24279 9500 -14843 2
+ 24329 9569 -14716 2
+ 24408 9567 -14585 2
+ 24493 9498 -14487 2
+ 24560 9349 -14470 2
+ 24620 9207 -14460 2
+ 24672 9068 -14458 2
+ 24699 8924 -14502 2
+ 24739 8777 -14525 2
+ 24803 8633 -14501 2
+ 24838 8498 -14521 2
+ 24863 8349 -14564 2
+ 24922 8305 -14488 2
+ 24967 8413 -14348 2
+ 25028 8279 -14320 2
+ 25028 8159 -14388 2
+ 25056 8016 -14421 2
+ 25068 7879 -14476 2
+ 25088 7728 -14521 2
+ 25065 7650 -14603 2
+ 25039 7507 -14721 2
+ 24971 7646 -14765 2
+ 24904 7611 -14895 2
+ 24928 7489 -14916 2
+ 25018 7378 -14821 2
+ 25053 7247 -14826 2
+ 25030 7189 -14893 2
+ 24984 7110 -15009 2
+ 24909 7071 -15151 2
+ 24840 7164 -15220 2
+ 24753 7215 -15337 2
+ 24694 7143 -15466 2
+ 24653 7047 -15574 2
+ 24606 6901 -15713 2
+ 24572 7013 -15717 2
+ 24568 7181 -15648 2
+ 24510 7159 -15749 2
+ 24483 7052 -15839 2
+ 24429 6959 -15962 2
+ 24420 6828 -16033 2
+ 24389 6745 -16115 2
+ 24296 6691 -16277 2
+ 24295 6559 -16332 2
+ 24240 6564 -16412 2
+ 24200 6739 -16400 2
+ 24268 6799 -16274 2
+ 24268 6900 -16231 2
+ 24296 7043 -16128 2
+ 24211 7121 -16221 2
+ 24224 7194 -16169 2
+ 24299 7248 -16032 2
+ 24364 7200 -15954 2
+ 24399 7293 -15858 2
+ 24444 7404 -15738 2
+ 24515 7416 -15622 2
+ 24598 7325 -15534 2
+ 24652 7232 -15491 2
+ 24720 7294 -15354 2
+ 24728 7416 -15281 2
+ 24712 7574 -15230 2
+ 24693 7687 -15205 2
+ 24696 7821 -15131 2
+ 24685 7951 -15081 2
+ 24608 8096 -15129 2
+ 24570 8231 -15118 2
+ 24442 8342 -15264 2
+ 24407 8347 -15318 2
+ 24347 8469 -15346 2
+ 24275 8610 -15381 2
+ 24211 8744 -15406 2
+ 24185 8879 -15370 2
+ 24208 8977 -15278 2
+ 24197 9122 -15209 2
+ 24151 9268 -15193 2
+ 24084 9400 -15218 2
+
+
+ 2308 -19901 -22330 0
+ 2300 -19787 -22432 2
+ 2337 -19723 -22484 2
+ 2425 -19727 -22472 2
+ 2440 -19678 -22512 2
+ 2583 -19746 -22437 2
+ 2712 -19766 -22404 2
+ 2770 -19636 -22512 2
+ 2887 -19557 -22565 2
+ 2900 -19505 -22609 2
+ 3059 -19593 -22512 2
+ 3107 -19688 -22422 2
+ 3101 -19806 -22318 2
+ 3159 -19910 -22217 2
+ 3274 -19983 -22135 2
+ 3330 -20069 -22048 2
+ 3358 -20178 -21945 2
+ 3314 -20227 -21906 2
+ 3266 -20212 -21927 2
+ 3403 -20291 -21833 2
+ 3426 -20397 -21731 2
+ 3490 -20418 -21700 2
+ 3618 -20482 -21619 2
+ 3700 -20544 -21547 2
+ 3825 -20639 -21434 2
+ 3936 -20703 -21351 2
+ 4050 -20746 -21289 2
+ 4104 -20811 -21214 2
+ 4284 -20844 -21146 2
+ 4388 -20914 -21055 2
+ 4463 -20986 -20968 2
+ 4515 -21081 -20862 2
+ 4604 -21159 -20763 2
+ 4696 -21228 -20672 2
+ 4701 -21312 -20584 2
+ 4729 -21354 -20534 2
+ 4777 -21395 -20480 2
+ 4781 -21483 -20387 2
+ 4824 -21561 -20294 2
+ 4755 -21611 -20258 2
+ 4604 -21673 -20226 2
+ 4453 -21660 -20273 2
+ 4311 -21715 -20245 2
+ 4183 -21755 -20230 2
+ 4102 -21791 -20208 2
+ 3936 -21811 -20218 2
+ 3797 -21806 -20250 2
+ 3675 -21758 -20325 2
+ 3585 -21677 -20427 2
+ 3510 -21596 -20525 2
+ 3389 -21521 -20624 2
+ 3370 -21428 -20724 2
+ 3334 -21327 -20833 2
+ 3308 -21211 -20956 2
+ 3403 -21160 -20992 2
+ 3261 -21109 -21066 2
+ 3255 -21003 -21172 2
+ 3319 -20927 -21238 2
+ 3311 -20917 -21249 2
+ 3194 -20891 -21292 2
+ 3064 -20851 -21350 2
+ 2978 -20778 -21433 2
+ 3108 -20688 -21502 2
+ 3221 -20608 -21562 2
+ 3292 -20556 -21601 2
+ 3109 -20680 -21510 2
+ 2979 -20749 -21462 2
+ 2857 -20764 -21464 2
+ 2768 -20778 -21462 2
+ 2637 -20756 -21500 2
+ 2738 -20679 -21561 2
+ 2885 -20642 -21578 2
+ 2960 -20614 -21594 2
+ 2812 -20585 -21641 2
+ 2859 -20558 -21661 2
+ 2731 -20529 -21705 2
+ 2611 -20465 -21780 2
+ 2536 -20379 -21869 2
+ 2477 -20274 -21974 2
+ 2395 -20192 -22058 2
+ 2345 -20108 -22139 2
+ 2252 -19994 -22253 2
+ 2301 -19944 -22292 2
+
+
+ 27917 -4121 -10180 0
+ 27862 -4187 -10305 2
+ 27806 -4247 -10431 2
+ 27749 -4284 -10565 2
+ 27693 -4307 -10703 2
+ 27636 -4325 -10842 2
+ 27579 -4341 -10980 2
+ 27527 -4331 -11114 2
+ 27465 -4352 -11256 2
+ 27404 -4390 -11390 2
+ 27349 -4377 -11527 2
+ 27301 -4326 -11660 2
+ 27239 -4364 -11790 2
+ 27175 -4425 -11913 2
+ 27113 -4477 -12034 2
+ 27050 -4501 -12168 2
+ 27000 -4496 -12280 2
+ 27041 -4288 -12264 2
+ 27049 -4137 -12298 2
+ 27095 -4038 -12229 2
+ 27159 -3999 -12099 2
+ 27217 -4027 -11960 2
+ 27275 -4040 -11821 2
+ 27330 -4034 -11696 2
+ 27392 -3974 -11570 2
+ 27427 -3868 -11524 2
+ 27464 -3746 -11475 2
+ 27506 -3616 -11416 2
+ 27568 -3602 -11272 2
+ 27625 -3566 -11143 2
+ 27683 -3520 -11011 2
+ 27736 -3489 -10887 2
+ 27792 -3472 -10750 2
+ 27841 -3363 -10658 2
+ 27883 -3418 -10530 2
+ 27888 -3560 -10469 2
+ 27921 -3629 -10355 2
+ 27973 -3608 -10222 2
+ 28027 -3598 -10076 2
+ 28080 -3577 -9937 2
+ 28129 -3583 -9793 2
+ 28178 -3561 -9659 2
+ 28230 -3525 -9520 2
+ 28267 -3390 -9459 2
+ 28317 -3294 -9344 2
+ 28363 -3283 -9207 2
+ 28408 -3251 -9077 2
+ 28457 -3187 -8948 2
+ 28501 -3117 -8831 2
+ 28533 -3148 -8714 2
+ 28573 -3163 -8578 2
+ 28617 -3139 -8438 2
+ 28662 -3110 -8294 2
+ 28689 -3158 -8184 2
+ 28688 -3299 -8133 2
+ 28697 -3409 -8053 2
+ 28716 -3518 -7938 2
+ 28725 -3563 -7885 2
+ 28673 -3579 -8066 2
+ 28632 -3576 -8212 2
+ 28584 -3639 -8349 2
+ 28548 -3707 -8442 2
+ 28531 -3847 -8438 2
+ 28482 -3878 -8588 2
+ 28436 -3890 -8734 2
+ 28387 -3914 -8879 2
+ 28339 -3966 -9009 2
+ 28290 -4026 -9137 2
+ 28239 -4061 -9277 2
+ 28193 -4052 -9419 2
+ 28152 -4004 -9561 2
+ 28104 -4022 -9694 2
+ 28052 -4031 -9842 2
+ 28000 -4062 -9974 2
+ 27958 -4088 -10082 2
+
+
+ 11139 23963 -14202 0
+ 11228 23868 -14291 2
+ 11324 23782 -14358 2
+ 11412 23695 -14432 2
+ 11474 23602 -14535 2
+ 11501 23527 -14637 2
+ 11499 23436 -14783 2
+ 11540 23343 -14898 2
+ 11643 23251 -14962 2
+ 11725 23154 -15046 2
+ 11774 23059 -15154 2
+ 11846 22962 -15245 2
+ 11917 22865 -15335 2
+ 12003 22768 -15413 2
+ 12088 22670 -15490 2
+ 12190 22573 -15552 2
+ 12236 22479 -15652 2
+ 12257 22386 -15768 2
+ 12322 22284 -15862 2
+ 12428 22187 -15915 2
+ 12510 22084 -15994 2
+ 12556 21984 -16096 2
+ 12650 21883 -16159 2
+ 12749 21781 -16219 2
+ 12799 21678 -16317 2
+ 12787 21598 -16432 2
+ 12634 21734 -16372 2
+ 12497 21821 -16360 2
+ 12396 21794 -16474 2
+ 12337 21751 -16574 2
+ 12342 21669 -16677 2
+ 12236 21830 -16545 2
+ 12294 21866 -16453 2
+ 12278 21975 -16321 2
+ 12263 22068 -16206 2
+ 12281 22140 -16093 2
+ 12244 22241 -15981 2
+ 12164 22340 -15905 2
+ 12061 22438 -15845 2
+ 11959 22533 -15787 2
+ 11861 22629 -15724 2
+ 11753 22715 -15681 2
+ 11630 22755 -15714 2
+ 11510 22727 -15843 2
+ 11464 22661 -15971 2
+ 11442 22582 -16097 2
+ 11431 22565 -16129 2
+ 11441 22668 -15977 2
+ 11418 22762 -15860 2
+ 11377 22858 -15750 2
+ 11345 22952 -15637 2
+ 11324 23042 -15518 2
+ 11296 23133 -15403 2
+ 11247 23228 -15296 2
+ 11203 23321 -15186 2
+ 11164 23411 -15076 2
+ 11136 23503 -14953 2
+ 11094 23597 -14837 2
+ 11047 23683 -14734 2
+ 10970 23771 -14650 2
+ 10909 23814 -14625 2
+ 10787 23958 -14480 2
+ 10737 24054 -14356 2
+ 10712 24134 -14241 2
+ 10678 24210 -14136 2
+ 10591 24307 -14035 2
+ 10623 24366 -13909 2
+ 10703 24328 -13913 2
+ 10721 24235 -14062 2
+ 10787 24164 -14133 2
+ 10930 24095 -14141 2
+ 11052 24077 -14077 2
+ 11107 24019 -14132 2
+
+
+ 24092 5088 -17137 0
+ 24106 4990 -17147 2
+ 24101 4845 -17195 2
+ 24134 4705 -17188 2
+ 24227 4665 -17067 2
+ 24323 4656 -16933 2
+ 24372 4485 -16908 2
+ 24429 4448 -16836 2
+ 24501 4435 -16734 2
+ 24557 4298 -16687 2
+ 24680 4208 -16529 2
+ 24659 4278 -16541 2
+ 24654 4432 -16509 2
+ 24708 4508 -16406 2
+ 24771 4497 -16315 2
+ 24859 4427 -16199 2
+ 24913 4293 -16152 2
+ 24996 4237 -16040 2
+ 25078 4200 -15921 2
+ 25152 4113 -15826 2
+ 25188 3971 -15805 2
+ 25229 3828 -15775 2
+ 25271 3687 -15742 2
+ 25214 3638 -15843 2
+ 25160 3783 -15896 2
+ 25106 3922 -15947 2
+ 25048 4038 -16010 2
+ 24992 3958 -16117 2
+ 24917 3960 -16231 2
+ 24843 3910 -16357 2
+ 24783 4056 -16412 2
+ 24705 4039 -16533 2
+ 24640 3967 -16648 2
+ 24610 3837 -16722 2
+ 24668 3705 -16666 2
+ 24696 3561 -16656 2
+ 24695 3413 -16688 2
+ 24674 3281 -16746 2
+ 24614 3195 -16851 2
+ 24544 3124 -16966 2
+ 24466 3072 -17087 2
+ 24395 3144 -17175 2
+ 24370 3104 -17218 2
+ 24373 2969 -17237 2
+ 24318 2958 -17317 2
+ 24256 3084 -17383 2
+ 24226 3227 -17398 2
+ 24244 3372 -17345 2
+ 24285 3483 -17265 2
+ 24242 3638 -17295 2
+ 24153 3782 -17387 2
+ 24105 3675 -17477 2
+ 24080 3540 -17539 2
+ 24074 3353 -17584 2
+ 24046 3400 -17613 2
+ 24020 3572 -17615 2
+ 23959 3663 -17679 2
+ 23898 3795 -17734 2
+ 23881 3941 -17725 2
+ 23906 4069 -17662 2
+ 23896 4232 -17637 2
+ 23900 4361 -17601 2
+ 23930 4479 -17530 2
+ 23889 4622 -17549 2
+ 23904 4793 -17483 2
+ 23955 4892 -17385 2
+ 23998 4977 -17300 2
+ 24054 5068 -17196 2
+
+
+ -3077 27485 11624 0
+ -3212 27455 11659 2
+ -3277 27494 11548 2
+ -3382 27504 11494 2
+ -3481 27440 11615 2
+ -3635 27419 11617 2
+ -3755 27420 11579 2
+ -3821 27363 11689 2
+ -3841 27363 11685 2
+ -3874 27416 11549 2
+ -3954 27435 11476 2
+ -4093 27375 11569 2
+ -4195 27407 11458 2
+ -4276 27352 11558 2
+ -4367 27316 11610 2
+ -4494 27264 11682 2
+ -4529 27272 11650 2
+ -4536 27330 11510 2
+ -4469 27386 11402 2
+ -4494 27431 11285 2
+ -4557 27480 11141 2
+ -4671 27496 11053 2
+ -4650 27472 11120 2
+ -4695 27410 11253 2
+ -4795 27428 11168 2
+ -4887 27398 11202 2
+ -4912 27358 11287 2
+ -4960 27341 11307 2
+ -5071 27316 11320 2
+ -5089 27291 11372 2
+ -4958 27294 11422 2
+ -4807 27314 11439 2
+ -4691 27296 11528 2
+ -4783 27244 11613 2
+ -4724 27217 11700 2
+ -4794 27198 11717 2
+ -4935 27190 11677 2
+ -5119 27162 11663 2
+ -5072 27145 11723 2
+ -4913 27142 11798 2
+ -4880 27105 11895 2
+ -4790 27096 11953 2
+ -4797 27064 12023 2
+ -4862 27007 12123 2
+ -5035 26956 12167 2
+ -4956 26929 12259 2
+ -4791 26938 12303 2
+ -4665 26910 12413 2
+ -4621 26870 12517 2
+ -4505 26851 12598 2
+ -4375 26828 12693 2
+ -4205 26843 12720 2
+ -4095 26879 12679 2
+ -3994 26908 12648 2
+ -3842 26927 12656 2
+ -3696 26961 12628 2
+ -3558 27004 12574 2
+ -3414 27034 12550 2
+ -3254 27071 12514 2
+ -3177 27122 12423 2
+ -3062 27168 12350 2
+ -3024 27196 12298 2
+ -2987 27233 12225 2
+ -2968 27273 12140 2
+ -3040 27319 12019 2
+ -3110 27358 11910 2
+ -3130 27418 11766 2
+ -3093 27467 11662 2
+
+
+ -26874 10130 8671 0
+ -26904 10149 8554 2
+ -26927 10215 8403 2
+ -26969 10221 8259 2
+ -27020 10197 8121 2
+ -27063 10109 8085 2
+ -27032 10061 8248 2
+ -27021 9976 8388 2
+ -27066 9846 8395 2
+ -27091 9728 8453 2
+ -27087 9628 8578 2
+ -27119 9545 8571 2
+ -27181 9496 8428 2
+ -27224 9502 8279 2
+ -27261 9521 8134 2
+ -27295 9541 7998 2
+ -27330 9566 7846 2
+ -27362 9593 7699 2
+ -27417 9490 7632 2
+ -27415 9412 7737 2
+ -27397 9324 7903 2
+ -27343 9381 8023 2
+ -27299 9390 8161 2
+ -27265 9362 8303 2
+ -27225 9351 8448 2
+ -27175 9374 8580 2
+ -27124 9382 8734 2
+ -27096 9334 8872 2
+ -27099 9220 8979 2
+ -27105 9125 9058 2
+ -27071 9141 9143 2
+ -27008 9257 9212 2
+ -26944 9392 9265 2
+ -26876 9459 9393 2
+ -26858 9399 9502 2
+ -26805 9396 9654 2
+ -26736 9483 9760 2
+ -26682 9486 9904 2
+ -26629 9485 10046 2
+ -26581 9471 10187 2
+ -26554 9406 10315 2
+ -26506 9435 10411 2
+ -26436 9556 10479 2
+ -26434 9669 10381 2
+ -26451 9755 10257 2
+ -26497 9774 10118 2
+ -26549 9826 9929 2
+ -26491 9886 10026 2
+ -26495 9928 9971 2
+ -26552 9921 9825 2
+ -26552 10020 9728 2
+ -26559 10089 9633 2
+ -26600 10117 9491 2
+ -26635 10156 9351 2
+ -26663 10213 9209 2
+ -26718 10186 9077 2
+ -26765 10205 8917 2
+ -26832 10122 8810 2
+
+
+ 12962 21402 -16551 0
+ 13045 21364 -16535 2
+ 13138 21270 -16582 2
+ 13162 21167 -16695 2
+ 13218 21060 -16786 2
+ 13310 20955 -16844 2
+ 13385 20847 -16920 2
+ 13504 20757 -16935 2
+ 13578 20653 -17002 2
+ 13654 20551 -17066 2
+ 13768 20532 -16997 2
+ 13891 20566 -16855 2
+ 13965 20465 -16917 2
+ 14088 20376 -16922 2
+ 14226 20308 -16888 2
+ 14319 20188 -16953 2
+ 14303 20098 -17073 2
+ 14348 19996 -17155 2
+ 14426 19875 -17230 2
+ 14320 19895 -17296 2
+ 14190 19980 -17304 2
+ 14079 19975 -17400 2
+ 14044 20033 -17362 2
+ 14095 20106 -17236 2
+ 14169 20156 -17116 2
+ 14117 20254 -17043 2
+ 14003 20286 -17100 2
+ 13944 20219 -17227 2
+ 13788 20285 -17274 2
+ 13664 20303 -17351 2
+ 13592 20247 -17474 2
+ 13528 20184 -17596 2
+ 13450 20131 -17715 2
+ 13342 20088 -17845 2
+ 13229 20207 -17795 2
+ 13112 20304 -17771 2
+ 12985 20385 -17772 2
+ 12850 20445 -17801 2
+ 12720 20439 -17901 2
+ 12584 20470 -17962 2
+ 12362 20560 -18013 2
+ 12415 20587 -17946 2
+ 12403 20698 -17826 2
+ 12362 20799 -17737 2
+ 12240 20915 -17685 2
+ 12290 20911 -17655 2
+ 12423 20832 -17655 2
+ 12548 20816 -17585 2
+ 12621 20870 -17469 2
+ 12728 20899 -17356 2
+ 12791 20961 -17234 2
+ 12844 21030 -17110 2
+ 12883 21107 -16985 2
+ 12900 21195 -16863 2
+ 12919 21281 -16741 2
+ 12947 21361 -16616 2
+
+
+ -6596 29135 -2761 0
+ -6532 29140 -2866 2
+ -6389 29166 -2915 2
+ -6434 29143 -3052 2
+ -6441 29132 -3132 2
+ -6493 29108 -3252 2
+ -6610 29094 -3143 2
+ -6614 29087 -3191 2
+ -6602 29071 -3358 2
+ -6714 29059 -3241 2
+ -6734 29042 -3348 2
+ -6719 29029 -3490 2
+ -6834 29000 -3506 2
+ -6936 28990 -3386 2
+ -7006 28986 -3276 2
+ -6942 29021 -3098 2
+ -7039 28997 -3100 2
+ -7085 29001 -2957 2
+ -7136 29004 -2805 2
+ -7194 28988 -2820 2
+ -7183 28977 -2959 2
+ -7189 28960 -3104 2
+ -7230 28934 -3253 2
+ -7376 28901 -3216 2
+ -7444 28898 -3084 2
+ -7442 28914 -2933 2
+ -7391 28942 -2783 2
+ -7370 28959 -2655 2
+ -7358 28976 -2498 2
+ -7401 28976 -2368 2
+ -7446 28976 -2224 2
+ -7382 29001 -2108 2
+ -7252 29039 -2031 2
+ -7124 29075 -1967 2
+ -6983 29108 -1992 2
+ -7031 29087 -2128 2
+ -6975 29094 -2215 2
+ -6830 29126 -2247 2
+ -6674 29163 -2227 2
+ -6519 29200 -2206 2
+ -6514 29193 -2310 2
+ -6610 29162 -2421 2
+ -6741 29133 -2416 2
+ -6877 29098 -2456 2
+ -7041 29061 -2424 2
+ -7056 29048 -2533 2
+ -6984 29052 -2679 2
+ -6827 29085 -2726 2
+ -6699 29114 -2738 2
+
+
+ -2179 24668 16933 0
+ -2273 24621 16989 2
+ -2387 24623 16970 2
+ -2508 24560 17044 2
+ -2579 24503 17116 2
+ -2524 24452 17197 2
+ -2598 24373 17297 2
+ -2672 24349 17320 2
+ -2812 24350 17297 2
+ -3027 24335 17281 2
+ -3012 24255 17396 2
+ -2987 24205 17470 2
+ -3118 24123 17560 2
+ -3049 24073 17641 2
+ -2873 24025 17735 2
+ -2950 23948 17827 2
+ -3066 23851 17937 2
+ -2988 23838 17967 2
+ -2838 23862 17960 2
+ -2845 23843 17984 2
+ -3000 23822 17987 2
+ -3117 23762 18045 2
+ -3231 23694 18115 2
+ -3298 23598 18228 2
+ -3162 23583 18272 2
+ -3218 23542 18314 2
+ -3117 23539 18336 2
+ -3141 23501 18380 2
+ -3101 23479 18415 2
+ -2961 23488 18427 2
+ -2805 23518 18413 2
+ -2675 23579 18354 2
+ -2541 23609 18335 2
+ -2417 23663 18282 2
+ -2248 23696 18260 2
+ -2100 23712 18257 2
+ -2013 23779 18180 2
+ -1953 23870 18067 2
+ -1899 23957 17957 2
+ -1911 24057 17822 2
+ -1907 24136 17715 2
+ -1941 24223 17592 2
+ -1891 24282 17515 2
+ -1761 24336 17454 2
+ -1695 24405 17364 2
+ -1733 24488 17244 2
+ -1773 24558 17140 2
+ -1839 24628 17032 2
+ -2071 24619 17018 2
+ -2127 24667 16942 2
+
+
+ -8496 -28645 2696 0
+ -8490 -28638 2793 2
+ -8441 -28638 2937 2
+ -8417 -28630 3083 2
+ -8449 -28605 3218 2
+ -8520 -28569 3353 2
+ -8635 -28524 3439 2
+ -8758 -28477 3517 2
+ -8896 -28429 3558 2
+ -9031 -28380 3604 2
+ -9169 -28331 3640 2
+ -9312 -28282 3666 2
+ -9457 -28235 3650 2
+ -9599 -28187 3654 2
+ -9740 -28136 3672 2
+ -9884 -28085 3677 2
+ -10018 -28042 3643 2
+ -10172 -27984 3665 2
+ -10237 -27975 3555 2
+ -10227 -27997 3406 2
+ -10160 -28037 3274 2
+ -10020 -28088 3269 2
+ -9887 -28135 3271 2
+ -9756 -28187 3212 2
+ -9609 -28239 3195 2
+ -9547 -28277 3049 2
+ -9433 -28312 3075 2
+ -9339 -28330 3190 2
+ -9195 -28379 3179 2
+ -9209 -28392 3012 2
+ -9271 -28386 2878 2
+ -9175 -28419 2856 2
+ -9176 -28428 2765 2
+ -9133 -28449 2691 2
+ -9136 -28457 2596 2
+ -9120 -28472 2479 2
+ -9093 -28490 2375 2
+ -8964 -28531 2374 2
+ -8860 -28554 2484 2
+ -8919 -28525 2601 2
+ -8914 -28518 2693 2
+ -8963 -28490 2823 2
+ -8910 -28500 2892 2
+ -8788 -28530 2968 2
+ -8726 -28556 2899 2
+ -8644 -28572 2989 2
+ -8590 -28589 2982 2
+ -8623 -28594 2837 2
+ -8688 -28588 2687 2
+ -8578 -28625 2652 2
+
+
+ -16082 -24523 6323 0
+ -16020 -24529 6458 2
+ -15949 -24539 6591 2
+ -15879 -24549 6725 2
+ -15781 -24578 6846 2
+ -15746 -24559 6995 2
+ -15696 -24552 7130 2
+ -15714 -24505 7250 2
+ -15786 -24468 7218 2
+ -15856 -24461 7089 2
+ -15964 -24420 6989 2
+ -16084 -24361 6918 2
+ -16198 -24309 6833 2
+ -16317 -24250 6758 2
+ -16436 -24184 6710 2
+ -16562 -24108 6673 2
+ -16720 -24010 6631 2
+ -16810 -23934 6679 2
+ -16935 -23857 6638 2
+ -16995 -23841 6542 2
+ -17074 -23814 6431 2
+ -17068 -23846 6331 2
+ -17058 -23899 6154 2
+ -16992 -23968 6068 2
+ -16886 -24059 6002 2
+ -16809 -24090 6094 2
+ -16753 -24084 6267 2
+ -16691 -24155 6162 2
+ -16665 -24207 6025 2
+ -16541 -24294 6015 2
+ -16437 -24341 6110 2
+ -16331 -24386 6217 2
+ -16268 -24440 6170 2
+ -16301 -24423 6149 2
+ -16379 -24396 6047 2
+ -16449 -24375 5943 2
+ -16569 -24331 5786 2
+ -16442 -24403 5846 2
+ -16467 -24408 5750 2
+ -16531 -24405 5577 2
+ -16546 -24426 5439 2
+ -16485 -24462 5462 2
+ -16452 -24459 5578 2
+ -16362 -24490 5704 2
+ -16284 -24512 5831 2
+ -16246 -24504 5968 2
+ -16148 -24541 6080 2
+ -16100 -24536 6225 2
+
+
+ -13245 26217 -6103 0
+ -13278 26234 -5958 3
+ -13269 26268 -5824 3
+ -13181 26333 -5732 3
+ -13204 26349 -5600 3
+ -13216 26373 -5459 3
+ -13160 26428 -5325 3
+ -13089 26490 -5191 3
+ -13022 26543 -5092 3
+ -13002 26580 -4946 3
+ -13029 26590 -4816 3
+ -12998 26613 -4772 3
+ -12968 26615 -4843 3
+ -12923 26660 -4715 3
+ -12880 26658 -4844 3
+ -12873 26631 -5009 3
+ -12881 26616 -5070 3
+ -12834 26677 -4861 3
+ -12862 26687 -4730 3
+ -12943 26671 -4596 3
+ -12977 26668 -4516 3
+ -12830 26714 -4664 3
+ -12780 26712 -4809 3
+ -12787 26681 -4959 3
+ -12854 26627 -5078 3
+ -12930 26568 -5192 3
+ -12974 26519 -5332 3
+ -12954 26498 -5483 3
+ -12897 26498 -5614 3
+ -12775 26544 -5679 3
+ -12662 26580 -5760 3
+ -12545 26612 -5868 3
+ -12420 26650 -5958 3
+ -12410 26642 -6017 3
+ -12554 26589 -5952 3
+ -12687 26528 -5942 3
+ -12841 26459 -5918 3
+ -12843 26428 -6051 3
+ -12854 26395 -6172 3
+ -12936 26328 -6283 3
+ -12951 26300 -6371 3
+ -12881 26303 -6497 3
+ -12842 26291 -6624 3
+ -12822 26291 -6663 3
+ -12957 26248 -6568 3
+ -13055 26225 -6468 3
+ -13158 26200 -6358 3
+ -13215 26202 -6233 3
+
+
+ -6930 29187 -252 0
+ -6981 29174 -385 2
+ -6897 29194 -393 2
+ -6780 29220 -475 2
+ -6715 29233 -607 2
+ -6717 29228 -764 2
+ -6833 29201 -787 2
+ -6967 29171 -709 2
+ -7079 29146 -620 2
+ -7090 29147 -447 2
+ -7160 29131 -349 2
+ -7296 29098 -297 2
+ -7442 29061 -275 2
+ -7581 29025 -321 2
+ -7715 28990 -293 2
+ -7876 28946 -259 2
+ -7903 28940 -142 2
+ -7982 28919 -8 2
+ -7892 28943 160 2
+ -8007 28911 253 2
+ -8005 28909 411 2
+ -7983 28914 519 2
+ -7949 28920 649 2
+ -7959 28915 741 2
+ -7850 28941 907 2
+ -7923 28917 1015 2
+ -7934 28909 1153 2
+ -7867 28921 1307 2
+ -7703 28962 1362 2
+ -7612 28988 1329 2
+ -7466 29023 1375 2
+ -7381 29050 1276 2
+ -7315 29072 1134 2
+ -7283 29086 991 2
+ -7322 29081 835 2
+ -7386 29068 704 2
+ -7477 29048 572 2
+ -7538 29033 481 2
+ -7485 29049 337 2
+ -7489 29050 183 2
+ -7453 29059 76 2
+ -7321 29093 39 2
+ -7289 29101 -79 2
+ -7207 29121 -120 2
+ -7152 29135 3 2
+ -7019 29167 -105 2
+ -6918 29191 -165 2
+
+
+ 1042 29488 5419 0
+ 1140 29468 5506 2
+ 1192 29440 5642 2
+ 1240 29410 5787 2
+ 1330 29392 5861 2
+ 1449 29370 5941 2
+ 1505 29391 5825 2
+ 1515 29417 5689 2
+ 1561 29418 5669 2
+ 1638 29401 5734 2
+ 1696 29405 5697 2
+ 1714 29381 5814 2
+ 1587 29360 5958 2
+ 1503 29344 6054 2
+ 1569 29319 6161 2
+ 1714 29328 6079 2
+ 1801 29324 6069 2
+ 1701 29302 6206 2
+ 1758 29290 6247 2
+ 1601 29287 6301 2
+ 1676 29253 6436 2
+ 1822 29235 6480 2
+ 1876 29219 6538 2
+ 1996 29192 6620 2
+ 1999 29236 6423 2
+ 1984 29270 6272 2
+ 2016 29296 6140 2
+ 1993 29330 5982 2
+ 1999 29357 5847 2
+ 1977 29389 5688 2
+ 2039 29411 5555 2
+ 2108 29427 5441 2
+ 1938 29456 5349 2
+ 1814 29474 5288 2
+ 1690 29500 5185 2
+ 1612 29529 5044 2
+ 1478 29539 5024 2
+ 1455 29516 5165 2
+ 1513 29489 5300 2
+ 1581 29462 5432 2
+ 1572 29455 5470 2
+ 1476 29486 5328 2
+ 1402 29513 5199 2
+ 1326 29514 5210 2
+ 1274 29500 5304 2
+ 1200 29527 5167 2
+ 1094 29520 5230 2
+ 1031 29506 5324 2
+
+
+ 14587 -2200 26122 0
+ 14605 -2253 26108 3
+ 14566 -2389 26117 3
+ 14538 -2545 26118 3
+ 14545 -2696 26099 3
+ 14597 -2834 26056 3
+ 14631 -2970 26021 3
+ 14566 -3107 26042 3
+ 14594 -3236 26011 3
+ 14646 -3379 25963 3
+ 14686 -3514 25923 3
+ 14761 -3633 25863 3
+ 14859 -3716 25795 3
+ 14945 -3817 25731 3
+ 14964 -3963 25698 3
+ 15001 -4103 25654 3
+ 15084 -4216 25587 3
+ 15080 -4412 25556 3
+ 15180 -4472 25487 3
+ 15298 -4562 25400 3
+ 15352 -4471 25383 3
+ 15308 -4343 25433 3
+ 15261 -4217 25482 3
+ 15208 -4079 25536 3
+ 15151 -3945 25591 3
+ 15136 -3795 25622 3
+ 15126 -3660 25648 3
+ 15063 -3515 25705 3
+ 14978 -3401 25770 3
+ 14860 -3363 25843 3
+ 14792 -3232 25899 3
+ 14861 -3110 25874 3
+ 14879 -2978 25880 3
+ 14831 -2839 25923 3
+ 14849 -2689 25928 3
+ 14782 -2559 25980 3
+ 14785 -2412 25992 3
+ 14776 -2269 26010 3
+ 14722 -2131 26053 3
+ 14675 -1991 26090 3
+ 14644 -1799 26121 3
+ 14581 -1884 26150 3
+ 14560 -2031 26151 3
+ 14545 -2184 26147 3
+
+
+ 15944 24781 -5628 0
+ 16037 24729 -5595 3
+ 16161 24642 -5620 3
+ 16287 24563 -5601 3
+ 16414 24482 -5586 3
+ 16541 24404 -5555 3
+ 16667 24323 -5533 3
+ 16793 24242 -5507 3
+ 16908 24180 -5427 3
+ 17029 24106 -5376 3
+ 17140 24046 -5293 3
+ 17262 23972 -5229 3
+ 17380 23894 -5197 3
+ 17487 23834 -5116 3
+ 17588 23780 -5017 3
+ 17707 23703 -4964 3
+ 17816 23637 -4887 3
+ 17900 23598 -4766 3
+ 17967 23572 -4639 3
+ 18040 23550 -4468 3
+ 18092 23498 -4531 3
+ 18088 23472 -4679 3
+ 18035 23486 -4814 3
+ 17961 23515 -4943 3
+ 17880 23551 -5069 3
+ 17767 23620 -5141 3
+ 17646 23708 -5152 3
+ 17559 23753 -5239 3
+ 17482 23789 -5333 3
+ 17380 23842 -5431 3
+ 17296 23875 -5553 3
+ 17187 23933 -5640 3
+ 17071 24006 -5681 3
+ 16964 24058 -5782 3
+ 16880 24126 -5742 3
+ 16788 24189 -5748 3
+ 16762 24187 -5834 3
+ 16632 24269 -5863 3
+ 16515 24352 -5852 3
+ 16396 24441 -5815 3
+ 16272 24523 -5816 3
+ 16149 24608 -5800 3
+ 16024 24694 -5780 3
+ 15902 24789 -5715 3
+
+
+ 6601 28935 4379 0
+ 6617 28914 4497 2
+ 6691 28878 4612 2
+ 6745 28857 4665 2
+ 6750 28831 4815 2
+ 6827 28795 4925 2
+ 6904 28787 4861 2
+ 6967 28752 4981 2
+ 7104 28744 4828 2
+ 7203 28735 4734 2
+ 7136 28769 4629 2
+ 7058 28801 4550 2
+ 7059 28818 4438 2
+ 6964 28853 4361 2
+ 6936 28879 4230 2
+ 6843 28914 4143 2
+ 6830 28937 4003 2
+ 6777 28968 3861 2
+ 6727 28992 3766 2
+ 6688 29020 3618 2
+ 6667 29045 3457 2
+ 6660 29065 3300 2
+ 6666 29080 3151 2
+ 6656 29098 3001 2
+ 6644 29116 2853 2
+ 6613 29137 2702 2
+ 6560 29159 2587 2
+ 6445 29194 2489 2
+ 6302 29224 2499 2
+ 6240 29226 2630 2
+ 6280 29203 2780 2
+ 6357 29176 2892 2
+ 6371 29156 3054 2
+ 6357 29142 3214 2
+ 6306 29140 3330 2
+ 6271 29132 3466 2
+ 6291 29114 3576 2
+ 6285 29093 3752 2
+ 6314 29066 3909 2
+ 6373 29034 4051 2
+ 6388 29013 4178 2
+ 6433 28985 4302 2
+ 6559 28946 4371 2
+ 6639 28936 4317 2
+
+
+ -10564 27211 -6925 0
+ -10666 27196 -6827 3
+ -10758 27193 -6696 3
+ -10692 27249 -6570 3
+ -10648 27297 -6442 3
+ -10705 27306 -6306 3
+ -10809 27243 -6401 3
+ -10863 27177 -6587 3
+ -10903 27179 -6512 3
+ -10894 27220 -6357 3
+ -10859 27271 -6197 3
+ -10726 27333 -6153 3
+ -10727 27362 -6021 3
+ -10858 27350 -5837 3
+ -10767 27409 -5728 3
+ -10704 27454 -5628 3
+ -10580 27517 -5555 3
+ -10556 27505 -5662 3
+ -10559 27476 -5795 3
+ -10474 27476 -5946 3
+ -10363 27496 -6047 3
+ -10301 27539 -5956 3
+ -10296 27579 -5781 3
+ -10195 27612 -5798 3
+ -10134 27608 -5923 3
+ -10105 27586 -6073 3
+ -10101 27556 -6214 3
+ -10072 27529 -6379 3
+ -10028 27513 -6517 3
+ -9997 27491 -6656 3
+ -9971 27439 -6905 3
+ -10041 27436 -6814 3
+ -10144 27432 -6677 3
+ -10161 27452 -6570 3
+ -10229 27461 -6425 3
+ -10356 27432 -6342 3
+ -10419 27395 -6399 3
+ -10307 27403 -6545 3
+ -10366 27377 -6563 3
+ -10447 27326 -6647 3
+ -10485 27283 -6760 3
+ -10524 27237 -6884 3
+
+
+ 15744 -1075 25514 0
+ 15750 -1211 25505 3
+ 15813 -1397 25456 3
+ 15908 -1314 25401 3
+ 16002 -1224 25346 3
+ 16121 -1294 25267 3
+ 16218 -1324 25204 3
+ 16230 -1493 25187 3
+ 16285 -1476 25152 3
+ 16278 -1318 25165 3
+ 16373 -1274 25106 3
+ 16495 -1312 25024 3
+ 16627 -1173 24943 3
+ 16473 -1111 25048 3
+ 16509 -1019 25029 3
+ 16592 -908 24978 3
+ 16674 -786 24927 3
+ 16732 -679 24891 3
+ 16802 -538 24847 3
+ 16816 -409 24841 3
+ 16842 -266 24825 3
+ 16958 -234 24746 3
+ 17091 -163 24655 3
+ 17066 -71 24673 3
+ 16930 -143 24766 3
+ 16838 -82 24829 3
+ 16773 18 24873 3
+ 16699 117 24922 3
+ 16593 126 24993 3
+ 16501 189 25054 3
+ 16395 135 25123 3
+ 16295 69 25189 3
+ 16178 80 25264 3
+ 16055 17 25342 3
+ 15939 -32 25415 3
+ 15886 -130 25448 3
+ 15827 -272 25484 3
+ 15782 -417 25510 3
+ 15817 -552 25485 3
+ 15812 -719 25485 3
+ 15775 -852 25504 3
+ 15736 -1001 25522 3
+
+
+ 10098 22921 16512 0
+ 10171 22873 16534 3
+ 10309 22814 16531 3
+ 10448 22757 16522 3
+ 10594 22697 16511 3
+ 10736 22652 16481 3
+ 10862 22640 16415 3
+ 10996 22586 16399 3
+ 11137 22535 16374 3
+ 11275 22481 16354 3
+ 11422 22444 16304 3
+ 11516 22346 16372 3
+ 11574 22247 16465 3
+ 11602 22153 16573 3
+ 11476 22145 16670 3
+ 11359 22137 16761 3
+ 11351 22060 16868 3
+ 11336 21965 17001 3
+ 11318 21886 17115 3
+ 11170 21839 17271 3
+ 11220 21849 17226 3
+ 11341 21875 17114 3
+ 11372 21935 17016 3
+ 11397 22047 16853 3
+ 11418 22096 16775 3
+ 11526 22118 16671 3
+ 11668 22092 16607 3
+ 11680 22153 16517 3
+ 11582 22253 16452 3
+ 11523 22348 16364 3
+ 11456 22467 16248 3
+ 11411 22470 16275 3
+ 11273 22494 16338 3
+ 11126 22561 16346 3
+ 11015 22608 16357 3
+ 10857 22652 16401 3
+ 10720 22701 16424 3
+ 10556 22789 16409 3
+ 10447 22795 16469 3
+ 10302 22834 16507 3
+ 10161 22882 16528 3
+
+
+ 13989 -2192 -26448 0
+ 14075 -2230 -26399 2
+ 14234 -2219 -26315 2
+ 14215 -2366 -26312 2
+ 14190 -2534 -26310 2
+ 14293 -2581 -26250 2
+ 14403 -2650 -26183 2
+ 14468 -2774 -26134 2
+ 14552 -2864 -26078 2
+ 14670 -2875 -26010 2
+ 14793 -2891 -25938 2
+ 14892 -2832 -25888 2
+ 14886 -2685 -25908 2
+ 14929 -2681 -25883 2
+ 14962 -2831 -25848 2
+ 15065 -2890 -25781 2
+ 15190 -2916 -25705 2
+ 15316 -2899 -25633 2
+ 15444 -2879 -25557 2
+ 15573 -2876 -25480 2
+ 15669 -2915 -25416 2
+ 15602 -3033 -25444 2
+ 15473 -3081 -25517 2
+ 15358 -3168 -25575 2
+ 15264 -3187 -25629 2
+ 15138 -3220 -25699 2
+ 15030 -3290 -25754 2
+ 14897 -3287 -25831 2
+ 14771 -3284 -25904 2
+ 14646 -3237 -25981 2
+ 14537 -3172 -26050 2
+ 14411 -3126 -26126 2
+ 14307 -3036 -26193 2
+ 14233 -2922 -26247 2
+ 14097 -2908 -26321 2
+ 13981 -2828 -26392 2
+ 14028 -2672 -26383 2
+ 13945 -2602 -26434 2
+ 13861 -2493 -26489 2
+ 13864 -2337 -26502 2
+ 13936 -2234 -26473 2
+
+
+ 119 4674 29633 0
+ 88 4579 29648 3
+ 62 4423 29672 3
+ 80 4291 29691 3
+ 18 4132 29714 3
+ -118 4236 29699 3
+ -182 4289 29691 3
+ -305 4319 29686 3
+ -393 4445 29666 3
+ -431 4516 29655 3
+ -570 4663 29630 3
+ -576 4579 29643 3
+ -774 4545 29644 3
+ -715 4545 29645 3
+ -575 4501 29655 3
+ -449 4433 29667 3
+ -373 4291 29689 3
+ -296 4220 29700 3
+ -177 4186 29706 3
+ -87 4067 29723 3
+ -255 3970 29735 3
+ -93 3962 29737 3
+ -34 3904 29745 3
+ 51 3784 29760 3
+ 43 3648 29777 3
+ -21 3534 29791 3
+ -154 3520 29792 3
+ -297 3549 29788 3
+ -292 3511 29792 3
+ -151 3445 29801 3
+ -7 3360 29811 3
+ 46 3278 29820 3
+ 58 3290 29819 3
+ 123 3466 29799 3
+ 128 3589 29784 3
+ 146 3730 29767 3
+ 143 3902 29745 3
+ 128 4067 29723 3
+ 88 4173 29708 3
+ 110 4327 29686 3
+ 72 4457 29667 3
+ 109 4599 29645 3
+
+
+ 16496 -5129 24527 0
+ 16526 -5272 24476 3
+ 16589 -5399 24406 3
+ 16575 -5541 24384 3
+ 16573 -5693 24350 3
+ 16557 -5840 24326 3
+ 16563 -5987 24286 3
+ 16526 -6122 24278 3
+ 16447 -6249 24299 3
+ 16415 -6396 24282 3
+ 16455 -6517 24223 3
+ 16478 -6666 24167 3
+ 16482 -6803 24126 3
+ 16465 -6950 24096 3
+ 16530 -7066 24017 3
+ 16526 -7198 23981 3
+ 16523 -7337 23940 3
+ 16603 -7345 23883 3
+ 16669 -7309 23848 3
+ 16759 -7369 23766 3
+ 16731 -7146 23854 3
+ 16666 -7054 23926 3
+ 16670 -6905 23967 3
+ 16674 -6757 24007 3
+ 16698 -6611 24030 3
+ 16684 -6468 24079 3
+ 16715 -6322 24097 3
+ 16797 -6201 24071 3
+ 16837 -6057 24080 3
+ 16811 -5924 24131 3
+ 16747 -5821 24200 3
+ 16740 -5682 24238 3
+ 16755 -5535 24262 3
+ 16748 -5389 24300 3
+ 16741 -5240 24337 3
+ 16689 -5113 24399 3
+ 16616 -5005 24472 3
+ 16532 -4986 24532 3
+
+
+ 18721 21147 10116 0
+ 18680 21234 10009 3
+ 18582 21296 10061 3
+ 18439 21402 10097 3
+ 18329 21477 10138 3
+ 18232 21582 10089 3
+ 18193 21673 9966 3
+ 18147 21757 9864 3
+ 18065 21853 9803 3
+ 18030 21796 9992 3
+ 17921 21835 10103 3
+ 17880 21825 10197 3
+ 17869 21761 10352 3
+ 17957 21663 10404 3
+ 17882 21667 10524 3
+ 17980 21550 10597 3
+ 17935 21559 10656 3
+ 17853 21561 10788 3
+ 17884 21478 10903 3
+ 17947 21378 10994 3
+ 18002 21279 11097 3
+ 18062 21177 11194 3
+ 18158 21069 11242 3
+ 18250 20961 11295 3
+ 18358 20861 11305 3
+ 18470 20736 11352 3
+ 18531 20767 11195 3
+ 18581 20759 11126 3
+ 18662 20746 11015 3
+ 18769 20679 10959 3
+ 18847 20636 10907 3
+ 18882 20678 10764 3
+ 18942 20690 10636 3
+ 18949 20742 10522 3
+ 18846 20833 10526 3
+ 18804 20936 10396 3
+ 18733 21040 10315 3
+ 18719 21091 10236 3
+
+
+ -7108 28862 -4057 0
+ -6996 28883 -4101 2
+ -6855 28909 -4159 2
+ -6785 28907 -4286 2
+ -6726 28899 -4426 2
+ -6685 28884 -4588 2
+ -6817 28841 -4660 2
+ -6963 28802 -4688 2
+ -7056 28759 -4808 2
+ -7135 28718 -4935 2
+ -7236 28677 -5025 2
+ -7335 28631 -5143 2
+ -7407 28589 -5273 2
+ -7496 28542 -5399 2
+ -7600 28523 -5357 2
+ -7739 28494 -5311 2
+ -7879 28462 -5278 2
+ -8020 28417 -5305 2
+ -8149 28387 -5272 2
+ -8148 28416 -5110 2
+ -8158 28436 -4984 2
+ -8180 28456 -4833 2
+ -8073 28502 -4738 2
+ -7948 28555 -4628 2
+ -7935 28579 -4505 2
+ -7851 28621 -4383 2
+ -7804 28654 -4246 2
+ -7781 28682 -4099 2
+ -7760 28708 -3952 2
+ -7741 28733 -3805 2
+ -7694 28764 -3665 2
+ -7546 28802 -3673 2
+ -7401 28835 -3707 2
+ -7258 28866 -3752 2
+ -7168 28873 -3870 2
+ -7170 28853 -4009 2
+
+
+ -12612 27178 1511 0
+ -12540 27216 1425 2
+ -12489 27246 1288 2
+ -12460 27266 1148 2
+ -12374 27309 1050 2
+ -12249 27367 996 2
+ -12247 27372 899 2
+ -12376 27315 851 2
+ -12512 27253 844 2
+ -12654 27188 844 2
+ -12781 27129 828 2
+ -12917 27064 818 2
+ -13058 26996 845 2
+ -13159 26950 735 2
+ -13294 26885 668 2
+ -13301 26878 790 2
+ -13258 26895 951 2
+ -13331 26856 1021 2
+ -13469 26786 1036 2
+ -13499 26767 1149 2
+ -13407 26808 1265 2
+ -13282 26867 1333 2
+ -13180 26911 1444 2
+ -13045 26975 1477 2
+ -13024 26978 1591 2
+ -13102 26932 1729 2
+ -13183 26888 1807 2
+ -13206 26866 1956 2
+ -13216 26850 2102 2
+ -13099 26898 2216 2
+ -13018 26941 2173 2
+ -12962 26977 2059 2
+ -12996 26971 1910 2
+ -12948 26997 1879 2
+ -12807 27066 1847 2
+ -12707 27120 1747 2
+ -12665 27148 1613 2
+
+
+ 29276 3899 5265 0
+ 29298 3743 5253 2
+ 29318 3595 5246 2
+ 29343 3446 5206 2
+ 29366 3305 5168 2
+ 29393 3175 5097 2
+ 29422 3113 4964 2
+ 29445 3121 4821 2
+ 29462 3180 4679 2
+ 29478 3228 4541 2
+ 29490 3306 4407 2
+ 29495 3408 4295 2
+ 29487 3545 4234 2
+ 29473 3692 4205 2
+ 29449 3860 4226 2
+ 29424 3981 4285 2
+ 29403 4086 4331 2
+ 29368 4240 4420 2
+ 29339 4391 4466 2
+ 29315 4478 4539 2
+ 29279 4633 4616 2
+ 29252 4727 4687 2
+ 29221 4852 4750 2
+ 29185 4961 4861 2
+ 29150 5061 4969 2
+ 29141 5074 5006 2
+ 29154 5033 4973 2
+ 29133 5045 5084 2
+ 29173 4951 4944 2
+ 29152 4930 5083 2
+ 29175 4780 5095 2
+ 29184 4645 5170 2
+ 29204 4491 5194 2
+ 29217 4347 5239 2
+ 29225 4241 5284 2
+ 29253 4054 5276 2
+ 29265 3973 5269 2
+
+
+ 23365 142 -18817 0
+ 23419 236 -18748 2
+ 23490 320 -18658 2
+ 23545 426 -18587 2
+ 23456 523 -18696 2
+ 23405 630 -18757 2
+ 23410 786 -18744 2
+ 23495 792 -18638 2
+ 23578 684 -18536 2
+ 23616 577 -18492 2
+ 23679 455 -18415 2
+ 23738 508 -18337 2
+ 23667 627 -18425 2
+ 23628 753 -18470 2
+ 23640 902 -18449 2
+ 23642 1081 -18436 2
+ 23702 1046 -18361 2
+ 23760 918 -18293 2
+ 23786 778 -18266 2
+ 23820 611 -18228 2
+ 23787 484 -18274 2
+ 23782 353 -18283 2
+ 23764 210 -18310 2
+ 23738 83 -18343 2
+ 23743 -68 -18337 2
+ 23701 -188 -18392 2
+ 23646 -313 -18460 2
+ 23548 -436 -18582 2
+ 23566 -367 -18561 2
+ 23617 -239 -18498 2
+ 23652 -100 -18454 2
+ 23672 46 -18429 2
+ 23659 207 -18445 2
+ 23568 218 -18560 2
+ 23478 185 -18675 2
+ 23388 137 -18788 2
+
+
+ 12054 -19593 -19257 0
+ 12112 -19628 -19184 2
+ 12209 -19670 -19079 2
+ 12337 -19705 -18961 2
+ 12413 -19733 -18883 2
+ 12532 -19744 -18791 2
+ 12671 -19706 -18738 2
+ 12809 -19646 -18707 2
+ 12948 -19599 -18661 2
+ 13098 -19570 -18586 2
+ 13118 -19633 -18506 2
+ 13063 -19738 -18433 2
+ 12973 -19846 -18380 2
+ 12871 -19951 -18338 2
+ 12756 -20043 -18318 2
+ 12612 -20189 -18258 2
+ 12610 -20263 -18177 2
+ 12520 -20359 -18132 2
+ 12405 -20457 -18101 2
+ 12269 -20549 -18089 2
+ 12162 -20610 -18091 2
+ 12041 -20657 -18119 2
+ 11916 -20688 -18166 2
+ 11872 -20631 -18260 2
+ 11874 -20542 -18358 2
+ 11862 -20438 -18483 2
+ 11804 -20434 -18524 2
+ 11674 -20490 -18544 2
+ 11662 -20430 -18617 2
+ 11718 -20324 -18699 2
+ 11742 -20222 -18793 2
+ 11720 -20119 -18917 2
+ 11724 -20054 -18983 2
+ 11779 -19942 -19067 2
+ 11836 -19818 -19161 2
+ 11887 -19712 -19240 2
+ 11976 -19615 -19283 2
+
+
+ 19917 21699 5700 0
+ 19946 21645 5798 3
+ 20020 21556 5878 3
+ 20091 21467 5959 3
+ 20208 21369 5916 3
+ 20357 21252 5827 3
+ 20292 21329 5772 3
+ 20200 21431 5717 3
+ 20134 21505 5669 3
+ 20071 21584 5594 3
+ 20056 21630 5466 3
+ 19983 21729 5344 3
+ 19976 21765 5218 3
+ 19976 21785 5136 3
+ 20031 21770 4983 3
+ 20055 21778 4851 3
+ 20114 21757 4697 3
+ 20152 21751 4557 3
+ 20209 21730 4405 3
+ 20265 21704 4271 3
+ 20289 21708 4140 3
+ 20301 21727 3976 3
+ 20203 21835 3885 3
+ 20179 21835 4002 3
+ 20192 21793 4162 3
+ 20145 21808 4312 3
+ 20113 21811 4447 3
+ 20082 21801 4633 3
+ 20042 21811 4753 3
+ 19980 21843 4867 3
+ 19921 21867 5000 3
+ 19903 21848 5153 3
+ 19843 21867 5301 3
+ 19829 21844 5446 3
+ 19880 21767 5567 3
+
+
+ -4651 29635 -334 0
+ -4703 29626 -408 2
+ -4850 29603 -374 2
+ -4892 29595 -451 2
+ -4991 29577 -532 2
+ -5114 29557 -447 2
+ -5147 29550 -563 2
+ -5258 29530 -583 2
+ -5348 29516 -458 2
+ -5398 29506 -477 2
+ -5512 29485 -510 2
+ -5520 29486 -356 2
+ -5546 29482 -203 2
+ -5602 29472 -109 2
+ -5621 29469 -106 2
+ -5638 29464 -260 2
+ -5695 29452 -386 2
+ -5831 29426 -359 2
+ -5953 29402 -262 2
+ -6088 29375 -238 2
+ -6157 29361 -103 2
+ -6058 29382 3 2
+ -6102 29373 84 2
+ -6073 29379 143 2
+ -5941 29405 175 2
+ -5749 29443 195 2
+ -5825 29428 220 2
+ -5757 29441 299 2
+ -5667 29457 379 2
+ -5491 29490 438 2
+ -5425 29504 315 2
+ -5310 29525 264 2
+ -5189 29547 229 2
+ -5057 29570 206 2
+ -5091 29565 132 2
+ -5019 29577 73 2
+ -4927 29593 -8 2
+ -4797 29614 -93 2
+ -4654 29637 -143 2
+ -4527 29656 -220 2
+ -4574 29648 -298 2
+
+
+ -17857 23953 -2714 0
+ -17926 23893 -2788 3
+ -18040 23816 -2717 3
+ -18149 23741 -2645 3
+ -18260 23662 -2589 3
+ -18308 23633 -2507 3
+ -18297 23651 -2416 3
+ -18389 23587 -2341 3
+ -18493 23509 -2311 3
+ -18527 23492 -2203 3
+ -18637 23403 -2226 3
+ -18751 23306 -2281 3
+ -18872 23207 -2306 3
+ -18959 23143 -2231 3
+ -18875 23222 -2120 3
+ -18727 23344 -2088 3
+ -18630 23421 -2085 3
+ -18522 23502 -2144 3
+ -18409 23586 -2188 3
+ -18290 23674 -2236 3
+ -18181 23757 -2250 3
+ -18054 23850 -2283 3
+ -17932 23938 -2323 3
+ -17817 24023 -2342 3
+ -17699 24105 -2388 3
+ -17579 24189 -2427 3
+ -17462 24271 -2446 3
+ -17351 24353 -2425 3
+ -17331 24363 -2466 3
+ -17452 24270 -2534 3
+ -17541 24207 -2517 3
+ -17500 24213 -2738 3
+ -17619 24117 -2815 3
+ -17730 24029 -2869 3
+ -17814 23978 -2776 3
+ -17835 23976 -2665 3
+
+
+ 18868 16148 -16830 0
+ 18750 16259 -16855 2
+ 18707 16352 -16812 2
+ 18718 16438 -16716 2
+ 18731 16503 -16636 2
+ 18683 16608 -16587 2
+ 18797 16599 -16466 2
+ 18815 16688 -16355 2
+ 18832 16739 -16284 2
+ 18942 16702 -16193 2
+ 19048 16614 -16160 2
+ 19167 16558 -16076 2
+ 19271 16491 -16021 2
+ 19330 16397 -16046 2
+ 19344 16307 -16121 2
+ 19375 16198 -16193 2
+ 19257 16245 -16287 2
+ 19168 16381 -16255 2
+ 19169 16237 -16399 2
+ 19211 16138 -16447 2
+ 19317 16009 -16450 2
+ 19426 15905 -16421 2
+ 19476 15773 -16489 2
+ 19546 15638 -16535 2
+ 19542 15557 -16616 2
+ 19471 15573 -16684 2
+ 19414 15712 -16621 2
+ 19368 15720 -16666 2
+ 19410 15585 -16743 2
+ 19438 15496 -16794 2
+ 19287 15620 -16853 2
+ 19178 15693 -16910 2
+ 19101 15819 -16879 2
+ 19024 15945 -16848 2
+ 18945 16054 -16833 2
+
+
+ -21907 20246 3192 0
+ -21969 20189 3129 3
+ -22031 20141 2994 3
+ -22106 20075 2884 3
+ -22115 20089 2714 3
+ -22026 20188 2709 3
+ -21989 20204 2879 3
+ -21917 20284 2864 3
+ -21909 20306 2769 3
+ -22008 20207 2702 3
+ -22110 20105 2640 3
+ -22214 19997 2582 3
+ -22283 19896 2761 3
+ -22306 19861 2826 3
+ -22302 19847 2954 3
+ -22257 19875 3101 3
+ -22223 19890 3247 3
+ -22144 19959 3361 3
+ -22078 20010 3487 3
+ -22019 20051 3621 3
+ -21941 20108 3775 3
+ -21888 20147 3874 3
+ -21815 20203 3995 3
+ -21732 20270 4103 3
+ -21646 20343 4199 3
+ -21550 20438 4229 3
+ -21554 20445 4177 3
+ -21615 20409 4035 3
+ -21653 20397 3891 3
+ -21745 20327 3739 3
+ -21783 20294 3691 3
+ -21786 20318 3543 3
+ -21797 20331 3395 3
+ -21851 20296 3262 3
+
+
+ 16309 24931 -3533 0
+ 16333 24928 -3444 3
+ 16435 24871 -3364 3
+ 16503 24821 -3403 3
+ 16622 24729 -3492 3
+ 16625 24714 -3581 3
+ 16738 24630 -3632 3
+ 16722 24638 -3651 3
+ 16604 24721 -3630 3
+ 16539 24780 -3524 3
+ 16432 24857 -3485 3
+ 16350 24897 -3584 3
+ 16314 24902 -3706 3
+ 16409 24826 -3797 3
+ 16515 24745 -3866 3
+ 16623 24662 -3928 3
+ 16744 24580 -3931 3
+ 16861 24501 -3927 3
+ 16981 24410 -3976 3
+ 17095 24334 -3951 3
+ 17238 24224 -4004 3
+ 17283 24185 -4044 3
+ 17434 24060 -4145 3
+ 17329 24128 -4191 3
+ 17267 24185 -4114 3
+ 17175 24267 -4019 3
+ 17061 24346 -4025 3
+ 16965 24416 -4007 3
+ 16862 24497 -3942 3
+ 16741 24580 -3945 3
+ 16619 24664 -3937 3
+ 16506 24748 -3880 3
+ 16404 24826 -3816 3
+ 16274 24923 -3737 3
+ 16261 24953 -3596 3
+
+
+ -15019 23246 -11578 0
+ -14910 23264 -11682 2
+ -14918 23205 -11790 2
+ -15047 23143 -11747 2
+ -15108 23141 -11673 2
+ -15227 23027 -11742 2
+ -15345 22995 -11652 2
+ -15459 22950 -11590 2
+ -15579 22896 -11536 2
+ -15655 22849 -11526 2
+ -15718 22782 -11574 2
+ -15828 22756 -11473 2
+ -15934 22687 -11463 2
+ -16056 22632 -11402 2
+ -16121 22648 -11278 2
+ -16125 22668 -11232 2
+ -16194 22556 -11357 2
+ -16349 22491 -11263 2
+ -16453 22454 -11186 2
+ -16570 22417 -11087 2
+ -16622 22438 -10965 2
+ -16528 22521 -10939 2
+ -16394 22618 -10940 2
+ -16279 22698 -10946 2
+ -16167 22748 -11007 2
+ -16038 22793 -11103 2
+ -15918 22872 -11112 2
+ -15792 22955 -11121 2
+ -15669 23040 -11120 2
+ -15552 23101 -11156 2
+ -15442 23127 -11256 2
+ -15334 23147 -11362 2
+ -15224 23172 -11457 2
+ -15107 23211 -11533 2
+
+
+ 24179 -4896 -17070 0
+ 24114 -4821 -17184 2
+ 24036 -4779 -17304 2
+ 23959 -4730 -17424 2
+ 23883 -4680 -17542 2
+ 23811 -4620 -17655 2
+ 23736 -4562 -17771 2
+ 23663 -4494 -17884 2
+ 23643 -4379 -17939 2
+ 23748 -4370 -17802 2
+ 23832 -4412 -17680 2
+ 23919 -4418 -17561 2
+ 24004 -4436 -17439 2
+ 24091 -4445 -17317 2
+ 24173 -4473 -17195 2
+ 24249 -4528 -17073 2
+ 24287 -4649 -16986 2
+ 24350 -4729 -16874 2
+ 24417 -4790 -16759 2
+ 24492 -4834 -16636 2
+ 24556 -4907 -16520 2
+ 24604 -5012 -16418 2
+ 24610 -5154 -16365 2
+ 24590 -5276 -16355 2
+ 24581 -5392 -16330 2
+ 24493 -5373 -16468 2
+ 24428 -5307 -16587 2
+ 24349 -5270 -16714 2
+ 24299 -5169 -16818 2
+ 24253 -5061 -16916 2
+ 24228 -4963 -16981 2
+
+
+ 13075 24485 11382 0
+ 13035 24537 11315 3
+ 13049 24595 11171 3
+ 13066 24647 11037 3
+ 13124 24679 10896 3
+ 13188 24702 10765 3
+ 13272 24705 10655 3
+ 13301 24761 10487 3
+ 13231 24789 10508 3
+ 13259 24735 10600 3
+ 13183 24714 10743 3
+ 13098 24707 10863 3
+ 13023 24692 10986 3
+ 12911 24694 11114 3
+ 12959 24634 11190 3
+ 12980 24560 11329 3
+ 13031 24478 11446 3
+ 13037 24416 11572 3
+ 13145 24322 11648 3
+ 13281 24260 11623 3
+ 13376 24180 11679 3
+ 13508 24092 11710 3
+ 13502 24057 11787 3
+ 13521 24047 11786 3
+ 13608 24092 11592 3
+ 13518 24116 11649 3
+ 13436 24190 11589 3
+ 13381 24297 11429 3
+ 13334 24277 11525 3
+ 13241 24296 11592 3
+ 13111 24370 11585 3
+ 13117 24438 11433 3
+
+
+ -3768 -29624 2870 0
+ -3723 -29620 2964 2
+ -3672 -29612 3106 2
+ -3613 -29604 3244 2
+ -3556 -29596 3384 2
+ -3524 -29582 3531 2
+ -3572 -29561 3660 2
+ -3603 -29542 3778 2
+ -3694 -29513 3913 2
+ -3847 -29485 3976 2
+ -3926 -29459 4093 2
+ -4101 -29434 4104 2
+ -4116 -29411 4251 2
+ -4222 -29379 4364 2
+ -4371 -29355 4380 2
+ -4515 -29339 4337 2
+ -4614 -29340 4228 2
+ -4630 -29359 4078 2
+ -4605 -29383 3929 2
+ -4542 -29410 3795 2
+ -4452 -29439 3674 2
+ -4348 -29468 3568 2
+ -4233 -29496 3472 2
+ -4156 -29522 3344 2
+ -4101 -29546 3201 2
+ -4083 -29563 3055 2
+ -4058 -29581 2912 2
+ -3964 -29605 2794 2
+ -3829 -29623 2796 2
+
+
+ -8205 28819 -1455 0
+ -8254 28801 -1550 2
+ -8361 28766 -1624 2
+ -8487 28732 -1561 2
+ -8618 28693 -1569 2
+ -8730 28656 -1628 2
+ -8702 28657 -1749 2
+ -8567 28692 -1831 2
+ -8651 28660 -1947 2
+ -8790 28620 -1908 2
+ -8919 28585 -1836 2
+ -9006 28564 -1726 2
+ -9131 28529 -1655 2
+ -9261 28491 -1586 2
+ -9403 28446 -1547 2
+ -9493 28421 -1456 2
+ -9328 28481 -1356 2
+ -9367 28474 -1234 2
+ -9280 28508 -1094 2
+ -9169 28545 -1060 2
+ -9034 28588 -1038 2
+ -8883 28636 -1050 2
+ -8784 28664 -1111 2
+ -8691 28687 -1243 2
+ -8584 28721 -1198 2
+ -8470 28758 -1099 2
+ -8352 28795 -1033 2
+ -8260 28818 -1126 2
+ -8295 28801 -1294 2
+ -8224 28817 -1398 2
+
+
+ 7341 28492 5857 0
+ 7438 28460 5889 2
+ 7539 28452 5798 2
+ 7668 28438 5701 2
+ 7830 28390 5718 2
+ 7928 28340 5833 2
+ 8064 28319 5747 2
+ 8185 28307 5632 2
+ 8271 28304 5523 2
+ 8343 28302 5421 2
+ 8335 28323 5325 2
+ 8176 28362 5360 2
+ 8030 28402 5372 2
+ 7886 28446 5348 2
+ 7746 28492 5311 2
+ 7622 28534 5261 2
+ 7482 28590 5163 2
+ 7406 28625 5075 2
+ 7323 28666 4961 2
+ 7251 28704 4848 2
+ 7101 28738 4869 2
+ 7002 28745 4972 2
+ 6964 28728 5118 2
+ 7029 28689 5249 2
+ 7039 28664 5367 2
+ 7152 28627 5420 2
+ 7247 28579 5543 2
+ 7271 28549 5663 2
+ 7281 28519 5802 2
+
+
+ 13904 22523 14121 0
+ 13885 22616 13991 3
+ 13862 22704 13870 3
+ 13812 22799 13763 3
+ 13791 22886 13640 3
+ 13735 22984 13530 3
+ 13756 23049 13398 3
+ 13850 23060 13281 3
+ 13849 23083 13243 3
+ 13730 23116 13310 3
+ 13624 23219 13239 3
+ 13603 23299 13119 3
+ 13491 23390 13073 3
+ 13455 23476 12955 3
+ 13469 23542 12820 3
+ 13498 23576 12727 3
+ 13436 23522 12892 3
+ 13438 23447 13026 3
+ 13505 23359 13114 3
+ 13603 23275 13162 3
+ 13610 23198 13290 3
+ 13712 23103 13350 3
+ 13715 23022 13486 3
+ 13755 22931 13600 3
+ 13780 22835 13736 3
+ 13823 22750 13833 3
+ 13860 22660 13943 3
+ 13876 22575 14065 3
+ 13903 22498 14162 3
+
+
+ 25599 5928 -14475 0
+ 25632 5834 -14455 2
+ 25679 5674 -14436 2
+ 25704 5584 -14427 2
+ 25758 5448 -14382 2
+ 25820 5368 -14300 2
+ 25888 5257 -14218 2
+ 25952 5142 -14145 2
+ 26019 5031 -14061 2
+ 26083 4917 -13981 2
+ 26150 4825 -13889 2
+ 26220 4740 -13785 2
+ 26286 4636 -13696 2
+ 26369 4446 -13598 2
+ 26311 4464 -13704 2
+ 26244 4541 -13807 2
+ 26175 4633 -13908 2
+ 26113 4751 -13984 2
+ 26039 4827 -14096 2
+ 25976 4942 -14172 2
+ 25926 5072 -14217 2
+ 25877 5187 -14265 2
+ 25795 5241 -14392 2
+ 25732 5361 -14462 2
+ 25647 5441 -14582 2
+ 25627 5578 -14564 2
+ 25625 5718 -14514 2
+ 25597 5864 -14506 2
+
+
+ 6784 26265 12812 0
+ 6851 26260 12786 3
+ 6888 26317 12648 3
+ 6860 26383 12526 3
+ 6940 26395 12457 3
+ 7001 26439 12328 3
+ 6956 26510 12200 3
+ 6856 26598 12064 3
+ 6829 26548 12189 3
+ 6731 26545 12249 3
+ 6598 26552 12306 3
+ 6460 26633 12204 3
+ 6610 26606 12183 3
+ 6542 26645 12134 3
+ 6449 26718 12023 3
+ 6331 26734 12051 3
+ 6213 26773 12025 3
+ 6119 26840 11924 3
+ 6122 26830 11945 3
+ 6202 26760 12059 3
+ 6334 26697 12131 3
+ 6385 26622 12268 3
+ 6415 26598 12305 3
+ 6526 26558 12333 3
+ 6653 26507 12375 3
+ 6781 26468 12388 3
+ 6768 26436 12463 3
+ 6742 26387 12580 3
+ 6675 26397 12594 3
+ 6588 26399 12638 3
+ 6582 26350 12742 3
+ 6739 26294 12775 3
+
+
+ 23238 12726 -14073 0
+ 23314 12662 -14004 2
+ 23402 12541 -13967 2
+ 23490 12436 -13912 2
+ 23574 12315 -13878 2
+ 23659 12194 -13841 2
+ 23744 12071 -13803 2
+ 23807 11928 -13818 2
+ 23873 11779 -13833 2
+ 23893 11664 -13895 2
+ 23917 11520 -13973 2
+ 23895 11434 -14082 2
+ 23897 11260 -14218 2
+ 23825 11373 -14249 2
+ 23754 11507 -14259 2
+ 23668 11618 -14312 2
+ 23584 11736 -14355 2
+ 23512 11862 -14370 2
+ 23441 12000 -14370 2
+ 23372 12136 -14368 2
+ 23303 12270 -14367 2
+ 23219 12399 -14393 2
+ 23162 12522 -14377 2
+ 23083 12679 -14368 2
+ 23103 12772 -14251 2
+ 23169 12767 -14150 2
+
+
+ -15626 24491 7484 0
+ -15709 24424 7530 3
+ -15823 24336 7576 3
+ -15891 24331 7450 3
+ -15794 24436 7310 3
+ -15838 24404 7322 3
+ -15947 24300 7432 3
+ -16018 24275 7358 3
+ -16001 24333 7201 3
+ -15945 24419 7033 3
+ -15890 24473 6971 3
+ -15791 24563 6878 3
+ -15837 24533 6879 3
+ -15948 24452 6909 3
+ -16055 24357 6999 3
+ -16004 24389 7001 3
+ -15986 24382 7068 3
+ -16030 24311 7211 3
+ -16059 24254 7337 3
+ -16186 24137 7444 3
+ -16125 24179 7440 3
+ -16041 24227 7465 3
+ -15912 24285 7554 3
+ -15889 24256 7692 3
+ -15835 24244 7842 3
+ -15738 24281 7922 3
+ -15737 24303 7856 3
+ -15770 24317 7744 3
+ -15731 24382 7619 3
+ -15653 24462 7524 3
+
+
+ 5003 28957 -6038 0
+ 4861 28970 -6093 2
+ 4773 28965 -6186 2
+ 4651 28977 -6222 2
+ 4657 29016 -6034 2
+ 4577 29057 -5893 2
+ 4509 29060 -5930 2
+ 4620 29016 -6058 2
+ 4606 28990 -6193 2
+ 4490 28991 -6274 2
+ 4370 29026 -6197 2
+ 4277 29059 -6107 2
+ 4340 29085 -5933 2
+ 4439 29091 -5832 2
+ 4462 29118 -5680 2
+ 4524 29115 -5642 2
+ 4651 29078 -5729 2
+ 4709 29072 -5713 2
+ 4710 29100 -5571 2
+ 4737 29127 -5400 2
+ 4852 29114 -5370 2
+ 4986 29081 -5425 2
+ 5095 29049 -5495 2
+ 5193 29015 -5584 2
+ 5236 28975 -5749 2
+ 5239 28945 -5892 2
+ 5130 28947 -5981 2
+ 5035 28967 -5962 2
+
+
+ 7323 -10567 -27106 0
+ 7444 -10473 -27109 2
+ 7586 -10400 -27098 2
+ 7708 -10350 -27083 2
+ 7739 -10373 -27065 2
+ 7660 -10491 -27042 2
+ 7560 -10617 -27021 2
+ 7444 -10719 -27013 2
+ 7345 -10807 -27005 2
+ 7227 -10921 -26991 2
+ 7111 -11008 -26986 2
+ 6982 -11075 -26993 2
+ 6849 -11139 -27000 2
+ 6701 -11221 -27003 2
+ 6597 -11310 -26992 2
+ 6471 -11369 -26997 2
+ 6309 -11412 -27018 2
+ 6258 -11328 -27065 2
+ 6379 -11231 -27077 2
+ 6494 -11148 -27084 2
+ 6609 -11062 -27092 2
+ 6754 -10979 -27090 2
+ 6859 -10920 -27087 2
+ 6987 -10830 -27091 2
+ 7092 -10715 -27109 2
+ 7198 -10629 -27115 2
+
+
+ -20783 20998 5211 0
+ -20850 20958 5102 3
+ -20917 20922 4977 3
+ -20993 20892 4774 3
+ -21013 20855 4853 3
+ -21074 20809 4782 3
+ -21077 20840 4633 3
+ -21112 20834 4497 3
+ -21161 20814 4355 3
+ -21209 20795 4213 3
+ -21269 20759 4085 3
+ -21351 20696 3972 3
+ -21456 20603 3897 3
+ -21500 20539 3987 3
+ -21455 20559 4125 3
+ -21397 20591 4260 3
+ -21353 20607 4404 3
+ -21328 20601 4553 3
+ -21327 20568 4702 3
+ -21290 20570 4859 3
+ -21246 20586 4984 3
+ -21159 20648 5096 3
+ -21079 20711 5172 3
+ -20965 20832 5150 3
+ -20891 20912 5123 3
+ -20791 20984 5232 3
+
+
+ -22450 -137 19899 0
+ -22520 -123 19820 2
+ -22619 -100 19707 2
+ -22717 -81 19594 2
+ -22803 -121 19494 2
+ -22907 -110 19371 2
+ -23003 -78 19258 2
+ -23100 -69 19142 2
+ -23184 -129 19038 2
+ -23206 -308 19010 2
+ -23238 -416 18969 2
+ -23188 -553 19027 2
+ -23207 -602 19002 2
+ -23237 -742 18960 2
+ -23181 -877 19023 2
+ -23115 -953 19100 2
+ -23068 -876 19160 2
+ -23045 -876 19187 2
+ -22966 -908 19281 2
+ -22874 -897 19390 2
+ -22792 -820 19490 2
+ -22695 -798 19604 2
+ -22606 -729 19709 2
+ -22573 -628 19750 2
+ -22503 -511 19833 2
+ -22471 -367 19872 2
+ -22436 -211 19914 2
+
+
+ 23559 -1507 -18512 0
+ 23586 -1582 -18472 2
+ 23629 -1756 -18401 2
+ 23572 -1676 -18481 2
+ 23509 -1710 -18559 2
+ 23421 -1798 -18661 2
+ 23325 -1715 -18789 2
+ 23240 -1762 -18889 2
+ 23143 -1796 -19004 2
+ 23077 -1751 -19088 2
+ 22968 -1771 -19218 2
+ 22884 -1855 -19310 2
+ 22792 -1913 -19413 2
+ 22686 -1996 -19528 2
+ 22649 -1899 -19581 2
+ 22699 -1776 -19535 2
+ 22759 -1645 -19476 2
+ 22846 -1567 -19381 2
+ 22948 -1558 -19260 2
+ 23035 -1504 -19161 2
+ 23134 -1469 -19044 2
+ 23231 -1522 -18921 2
+ 23315 -1490 -18819 2
+ 23412 -1493 -18699 2
+ 23506 -1497 -18580 2
+
+
+ 25640 -4315 -14965 0
+ 25671 -4360 -14899 2
+ 25725 -4425 -14786 2
+ 25710 -4580 -14766 2
+ 25634 -4590 -14894 2
+ 25560 -4592 -15021 2
+ 25478 -4612 -15153 2
+ 25400 -4654 -15270 2
+ 25321 -4628 -15409 2
+ 25247 -4615 -15533 2
+ 25175 -4614 -15650 2
+ 25105 -4564 -15777 2
+ 25024 -4551 -15909 2
+ 24947 -4487 -16047 2
+ 24931 -4305 -16122 2
+ 24946 -4338 -16089 2
+ 25011 -4416 -15966 2
+ 25061 -4496 -15866 2
+ 25144 -4435 -15751 2
+ 25216 -4431 -15637 2
+ 25285 -4460 -15517 2
+ 25364 -4425 -15397 2
+ 25444 -4368 -15281 2
+ 25529 -4328 -15150 2
+ 25601 -4313 -15033 2
+
+
+ 6329 18585 22684 0
+ 6222 18564 22731 2
+ 6103 18534 22787 2
+ 5970 18511 22841 2
+ 5834 18479 22902 2
+ 5692 18474 22941 2
+ 5549 18489 22965 2
+ 5398 18536 22962 2
+ 5245 18510 23019 2
+ 5135 18477 23070 2
+ 5130 18363 23162 2
+ 5257 18293 23189 2
+ 5404 18256 23185 2
+ 5539 18188 23206 2
+ 5675 18127 23221 2
+ 5816 18095 23210 2
+ 5948 18036 23223 2
+ 6062 17953 23258 2
+ 6213 17926 23239 2
+ 6269 17982 23181 2
+ 6295 18100 23081 2
+ 6227 18202 23020 2
+ 6222 18319 22928 2
+ 6260 18425 22833 2
+ 6318 18529 22732 2
+
+
+ 7748 26705 11261 0
+ 7877 26637 11333 3
+ 7952 26630 11298 3
+ 8089 26575 11329 3
+ 8076 26525 11454 3
+ 7915 26580 11440 3
+ 7964 26532 11517 3
+ 7921 26528 11556 3
+ 7786 26594 11496 3
+ 7788 26582 11521 3
+ 7914 26519 11580 3
+ 8013 26449 11671 3
+ 8135 26389 11725 3
+ 8276 26351 11709 3
+ 8423 26276 11775 3
+ 8315 26276 11852 3
+ 8345 26249 11890 3
+ 8517 26219 11833 3
+ 8567 26260 11705 3
+ 8549 26316 11593 3
+ 8429 26381 11531 3
+ 8303 26449 11469 3
+ 8197 26514 11395 3
+ 8128 26589 11268 3
+ 8004 26639 11239 3
+ 7852 26680 11248 3
+
+
+ 14610 -1401 -26164 0
+ 14567 -1458 -26185 2
+ 14446 -1519 -26249 2
+ 14332 -1603 -26306 2
+ 14221 -1688 -26361 2
+ 14113 -1783 -26413 2
+ 13986 -1835 -26477 2
+ 13886 -1932 -26522 2
+ 13800 -2050 -26559 2
+ 13736 -2187 -26581 2
+ 13722 -2338 -26575 2
+ 13649 -2484 -26599 2
+ 13560 -2432 -26650 2
+ 13533 -2289 -26676 2
+ 13574 -2156 -26666 2
+ 13669 -2056 -26626 2
+ 13786 -1978 -26571 2
+ 13880 -1878 -26530 2
+ 13988 -1774 -26480 2
+ 14093 -1684 -26430 2
+ 14209 -1612 -26372 2
+ 14326 -1532 -26314 2
+ 14447 -1473 -26251 2
+ 14559 -1387 -26194 2
+
+
+ 26396 -4371 -13570 0
+ 26423 -4399 -13507 2
+ 26470 -4487 -13387 2
+ 26459 -4647 -13354 2
+ 26403 -4733 -13434 2
+ 26339 -4718 -13564 2
+ 26274 -4696 -13699 2
+ 26212 -4654 -13830 2
+ 26149 -4621 -13960 2
+ 26101 -4541 -14075 2
+ 26074 -4571 -14115 2
+ 25987 -4591 -14270 2
+ 25924 -4526 -14403 2
+ 25955 -4384 -14392 2
+ 26022 -4388 -14270 2
+ 26057 -4341 -14219 2
+ 26131 -4339 -14083 2
+ 26200 -4247 -13983 2
+ 26270 -4268 -13844 2
+ 26222 -4393 -13896 2
+ 26149 -4456 -14014 2
+ 26152 -4520 -13987 2
+ 26221 -4533 -13852 2
+ 26291 -4431 -13754 2
+ 26354 -4399 -13643 2
+
+
+ 26582 10216 -9436 0
+ 26612 10199 -9371 2
+ 26661 10137 -9296 2
+ 26736 10035 -9191 2
+ 26806 9948 -9083 2
+ 26856 9832 -9061 2
+ 26902 9685 -9083 2
+ 26937 9541 -9132 2
+ 26918 9462 -9267 2
+ 26888 9419 -9398 2
+ 26842 9387 -9560 2
+ 26765 9470 -9692 2
+ 26721 9513 -9771 2
+ 26644 9610 -9887 2
+ 26592 9700 -9940 2
+ 26532 9847 -9955 2
+ 26440 10014 -10032 2
+ 26382 10088 -10110 2
+ 26342 10231 -10070 2
+ 26378 10279 -9926 2
+ 26426 10269 -9808 2
+ 26489 10246 -9660 2
+ 26537 10247 -9528 2
+
+
+ -8254 28832 -761 0
+ -8351 28805 -729 2
+ -8382 28795 -779 2
+ -8479 28765 -837 2
+ -8637 28717 -847 2
+ -8782 28673 -869 2
+ -8914 28633 -844 2
+ -9053 28590 -821 2
+ -9199 28544 -807 2
+ -9215 28542 -663 2
+ -9069 28591 -578 2
+ -8902 28642 -610 2
+ -8868 28655 -498 2
+ -8887 28651 -344 2
+ -8769 28689 -252 2
+ -8641 28728 -205 2
+ -8506 28769 -131 2
+ -8366 28810 -54 2
+ -8284 28833 -115 2
+ -8267 28837 -270 2
+ -8224 28848 -374 2
+ -8183 28858 -522 2
+ -8199 28850 -663 2
+
+
+ 14884 12125 23053 0
+ 14876 12008 23120 3
+ 14906 11952 23129 3
+ 14932 11851 23165 3
+ 14890 11721 23257 3
+ 14861 11601 23336 3
+ 14760 11590 23405 3
+ 14652 11571 23482 3
+ 14576 11491 23569 3
+ 14515 11367 23666 3
+ 14467 11258 23748 3
+ 14434 11131 23828 3
+ 14432 11072 23856 3
+ 14489 11238 23744 3
+ 14551 11356 23650 3
+ 14625 11429 23568 3
+ 14677 11533 23485 3
+ 14794 11533 23412 3
+ 14886 11615 23313 3
+ 14940 11710 23231 3
+ 15012 11739 23169 3
+ 14988 11885 23110 3
+ 14955 12016 23064 3
+ 14899 12149 23031 3
+
+
+ -6839 29182 -1275 0
+ -6959 29154 -1272 2
+ -7122 29116 -1246 2
+ -7082 29122 -1321 2
+ -6932 29154 -1422 2
+ -7012 29132 -1464 2
+ -7172 29094 -1440 2
+ -7190 29087 -1490 2
+ -7233 29071 -1592 2
+ -7317 29050 -1600 2
+ -7318 29058 -1437 2
+ -7317 29068 -1235 2
+ -7373 29051 -1293 2
+ -7473 29022 -1376 2
+ -7616 28985 -1374 2
+ -7651 28981 -1239 2
+ -7637 28992 -1082 2
+ -7503 29028 -1033 2
+ -7429 29050 -964 2
+ -7294 29083 -983 2
+ -7136 29124 -948 2
+ -6984 29160 -951 2
+ -6893 29178 -1061 2
+ -6852 29183 -1177 2
+
+
+ 3600 19765 22280 0
+ 3523 19706 22344 2
+ 3417 19636 22422 2
+ 3258 19628 22453 2
+ 3254 19526 22542 2
+ 3347 19427 22614 2
+ 3368 19313 22708 2
+ 3403 19203 22796 2
+ 3391 19086 22896 2
+ 3404 18954 23003 2
+ 3442 18883 23056 2
+ 3565 18841 23072 2
+ 3660 18944 22972 2
+ 3787 18948 22948 2
+ 3869 18984 22905 2
+ 3876 19100 22807 2
+ 3875 19219 22707 2
+ 3856 19329 22616 2
+ 3863 19435 22525 2
+ 3857 19539 22436 2
+ 3783 19652 22349 2
+ 3697 19742 22284 2
+
+
+ 17666 16854 -17432 0
+ 17724 16885 -17342 2
+ 17791 16930 -17230 2
+ 17918 16890 -17137 2
+ 17995 16812 -17133 2
+ 18113 16756 -17062 2
+ 18201 16791 -16935 2
+ 18319 16691 -16907 2
+ 18429 16598 -16879 2
+ 18561 16520 -16810 2
+ 18536 16520 -16837 2
+ 18511 16453 -16930 2
+ 18552 16336 -17000 2
+ 18502 16244 -17141 2
+ 18405 16314 -17178 2
+ 18298 16420 -17192 2
+ 18201 16512 -17207 2
+ 18079 16559 -17290 2
+ 17993 16494 -17441 2
+ 17876 16587 -17474 2
+ 17758 16667 -17517 2
+ 17707 16741 -17498 2
+
+
+ 5861 26752 12246 0
+ 5943 26719 12278 3
+ 5987 26652 12403 3
+ 6063 26588 12503 3
+ 6067 26522 12640 3
+ 6065 26462 12766 3
+ 6091 26401 12880 3
+ 6147 26329 12999 3
+ 6232 26264 13090 3
+ 6345 26283 12999 3
+ 6265 26308 12986 3
+ 6188 26367 12904 3
+ 6140 26439 12779 3
+ 6124 26503 12653 3
+ 6151 26583 12471 3
+ 6234 26608 12376 3
+ 6235 26664 12254 3
+ 6162 26713 12183 3
+ 6146 26668 12291 3
+ 6117 26615 12418 3
+ 6065 26610 12455 3
+ 6050 26665 12344 3
+ 5987 26722 12251 3
+
+
+ -14603 25601 -5597 0
+ -14613 25626 -5455 3
+ -14541 25693 -5331 3
+ -14532 25728 -5186 3
+ -14555 25744 -5041 3
+ -14593 25750 -4894 3
+ -14610 25770 -4737 3
+ -14602 25798 -4613 3
+ -14665 25788 -4461 3
+ -14719 25785 -4302 3
+ -14699 25791 -4332 3
+ -14640 25802 -4463 3
+ -14570 25818 -4597 3
+ -14498 25834 -4734 3
+ -14467 25826 -4873 3
+ -14402 25848 -4948 3
+ -14321 25869 -5068 3
+ -14370 25817 -5193 3
+ -14419 25761 -5334 3
+ -14462 25710 -5462 3
+ -14513 25651 -5604 3
+
+
+ -5757 29270 -3178 0
+ -5793 29252 -3278 2
+ -5861 29224 -3408 2
+ -5920 29196 -3544 2
+ -5974 29168 -3683 2
+ -5986 29146 -3834 2
+ -6090 29117 -3891 2
+ -6197 29114 -3738 2
+ -6274 29102 -3699 2
+ -6337 29097 -3634 2
+ -6237 29133 -3517 2
+ -6168 29164 -3380 2
+ -6078 29196 -3261 2
+ -6132 29186 -3247 2
+ -6275 29151 -3290 2
+ -6253 29169 -3172 2
+ -6197 29196 -3033 2
+ -6072 29228 -2975 2
+ -5962 29260 -2883 2
+ -5843 29286 -2859 2
+ -5834 29278 -2966 2
+ -5799 29273 -3080 2
+
+
+ 20081 22197 2006 0
+ 20029 22248 1962 3
+ 19945 22316 2048 3
+ 19841 22396 2177 3
+ 19772 22454 2205 3
+ 19652 22556 2242 3
+ 19579 22628 2147 3
+ 19531 22686 1965 3
+ 19447 22754 2020 3
+ 19337 22841 2090 3
+ 19319 22849 2175 3
+ 19383 22797 2142 3
+ 19461 22742 2024 3
+ 19539 22672 2050 3
+ 19573 22629 2195 3
+ 19664 22543 2265 3
+ 19779 22442 2265 3
+ 19840 22378 2370 3
+ 19907 22321 2340 3
+ 19964 22284 2204 3
+ 20039 22228 2085 3
+
+
+ -17819 21913 10114 0
+ -17847 21924 10041 2
+ -17989 21830 9991 2
+ -18092 21748 9985 2
+ -18216 21658 9954 2
+ -18329 21566 9948 2
+ -18407 21461 10030 2
+ -18384 21428 10142 2
+ -18308 21434 10266 2
+ -18205 21467 10380 2
+ -18089 21534 10443 2
+ -17994 21621 10427 2
+ -18050 21651 10268 2
+ -18162 21570 10241 2
+ -18264 21486 10238 2
+ -18299 21499 10148 2
+ -18221 21573 10131 2
+ -18079 21658 10203 2
+ -17989 21737 10193 2
+ -17880 21832 10180 2
+
+
+ 7617 6776 28215 0
+ 7517 6813 28232 3
+ 7385 6874 28253 3
+ 7244 6851 28295 3
+ 7155 6929 28298 3
+ 7059 6941 28319 3
+ 6957 6994 28332 3
+ 6964 7141 28293 3
+ 6845 7234 28299 3
+ 6704 7171 28348 3
+ 6744 7018 28377 3
+ 6821 6891 28390 3
+ 6937 6804 28383 3
+ 6991 6735 28386 3
+ 7007 6611 28411 3
+ 7128 6497 28407 3
+ 7223 6562 28369 3
+ 7338 6651 28318 3
+ 7457 6692 28278 3
+ 7607 6721 28230 3
+
+
+ 10847 17337 21949 0
+ 10792 17303 22003 2
+ 10656 17302 22071 2
+ 10531 17343 22098 2
+ 10386 17362 22152 2
+ 10252 17384 22197 2
+ 10111 17366 22276 2
+ 9981 17428 22285 2
+ 9817 17454 22338 2
+ 9770 17393 22406 2
+ 9840 17312 22439 2
+ 9987 17297 22385 2
+ 10128 17279 22335 2
+ 10272 17218 22317 2
+ 10398 17181 22287 2
+ 10527 17198 22213 2
+ 10660 17210 22140 2
+ 10795 17215 22071 2
+ 10859 17284 21986 2
+
+
+ 2092 29573 4591 0
+ 2046 29564 4670 2
+ 1956 29577 4622 2
+ 1958 29556 4757 2
+ 1869 29563 4746 2
+ 1736 29579 4697 2
+ 1693 29577 4729 2
+ 1664 29563 4825 2
+ 1638 29547 4927 2
+ 1716 29523 5045 2
+ 1933 29523 4963 2
+ 1889 29508 5068 2
+ 1947 29490 5150 2
+ 2107 29485 5117 2
+ 2256 29470 5142 2
+ 2347 29484 5020 2
+ 2377 29504 4884 2
+ 2396 29527 4733 2
+ 2339 29553 4599 2
+ 2182 29565 4597 2
+
+
+ -20217 21829 -3845 0
+ -20288 21770 -3804 3
+ -20398 21664 -3822 3
+ -20498 21569 -3820 3
+ -20608 21466 -3813 3
+ -20703 21371 -3827 3
+ -20739 21336 -3830 3
+ -20831 21249 -3814 3
+ -20902 21162 -3908 3
+ -20902 21134 -4061 3
+ -20920 21118 -4051 3
+ -21018 21043 -3926 3
+ -20974 21090 -3913 3
+ -20890 21189 -3825 3
+ -20812 21275 -3771 3
+ -20698 21385 -3777 3
+ -20601 21481 -3762 3
+ -20503 21571 -3787 3
+ -20392 21673 -3801 3
+ -20276 21784 -3787 3
+
+
+ 24559 5678 -16267 0
+ 24604 5701 -16191 2
+ 24686 5684 -16071 2
+ 24739 5567 -16031 2
+ 24787 5431 -16003 2
+ 24816 5270 -16013 2
+ 24895 5197 -15913 2
+ 24957 5092 -15850 2
+ 24944 4963 -15911 2
+ 24888 4876 -16026 2
+ 24854 4751 -16116 2
+ 24781 4757 -16226 2
+ 24746 4891 -16239 2
+ 24761 5018 -16178 2
+ 24727 5176 -16180 2
+ 24673 5314 -16217 2
+ 24622 5452 -16249 2
+ 24567 5591 -16286 2
+
+
+ 7773 28919 -1814 0
+ 7684 28935 -1932 3
+ 7601 28948 -2066 3
+ 7560 28958 -2064 3
+ 7552 28971 -1911 3
+ 7714 28934 -1824 3
+ 7766 28928 -1689 3
+ 7784 28931 -1541 3
+ 7690 28962 -1435 3
+ 7636 28979 -1388 3
+ 7836 28923 -1441 3
+ 7944 28897 -1366 3
+ 7975 28889 -1355 3
+ 7986 28878 -1505 3
+ 8116 28838 -1584 3
+ 8143 28827 -1638 3
+ 7982 28876 -1572 3
+ 7912 28896 -1567 3
+ 7913 28888 -1688 3
+ 7822 28910 -1738 3
+
+
+ 28847 -786 -8199 0
+ 28861 -867 -8144 2
+ 28878 -857 -8081 2
+ 28911 -873 -7961 2
+ 28932 -1026 -7868 2
+ 28905 -1107 -7953 2
+ 28864 -1112 -8100 2
+ 28838 -1229 -8178 2
+ 28820 -1361 -8220 2
+ 28796 -1481 -8282 2
+ 28753 -1536 -8420 2
+ 28713 -1609 -8543 2
+ 28700 -1555 -8595 2
+ 28699 -1384 -8627 2
+ 28725 -1317 -8552 2
+ 28767 -1260 -8419 2
+ 28790 -1117 -8359 2
+ 28803 -967 -8333 2
+ 28827 -831 -8264 2
+
+
+ -13526 25075 -9397 0
+ -13630 25018 -9397 3
+ -13799 24914 -9428 3
+ -13880 24870 -9423 3
+ -13999 24814 -9396 3
+ -14135 24752 -9355 3
+ -14290 24661 -9360 3
+ -14269 24682 -9336 3
+ -14144 24753 -9341 3
+ -14009 24825 -9352 3
+ -13975 24875 -9269 3
+ -14054 24879 -9139 3
+ -14132 24892 -8980 3
+ -14093 24909 -8997 3
+ -14039 24887 -9139 3
+ -13973 24880 -9258 3
+ -13845 24919 -9347 3
+ -13726 24972 -9380 3
+ -13596 25044 -9379 3
+
+
+ -8960 -28564 -1947 0
+ -8964 -28571 -1831 2
+ -8966 -28579 -1682 2
+ -8949 -28594 -1512 2
+ -8909 -28613 -1384 2
+ -8928 -28614 -1226 2
+ -8925 -28621 -1082 2
+ -8985 -28607 -961 2
+ -9091 -28573 -972 2
+ -9108 -28564 -1078 2
+ -9186 -28539 -1064 2
+ -9263 -28512 -1129 2
+ -9162 -28542 -1197 2
+ -9150 -28541 -1299 2
+ -9233 -28510 -1400 2
+ -9157 -28531 -1460 2
+ -9113 -28541 -1536 2
+ -9123 -28531 -1659 2
+ -9107 -28527 -1807 2
+ -9030 -28542 -1960 2
+
+
+ 17593 2406 24180 0
+ 17547 2284 24226 3
+ 17545 2132 24241 3
+ 17531 1985 24264 3
+ 17563 1840 24252 3
+ 17624 1706 24217 3
+ 17684 1578 24182 3
+ 17775 1468 24123 3
+ 17857 1306 24071 3
+ 17908 1411 24028 3
+ 17857 1519 24059 3
+ 17763 1620 24121 3
+ 17705 1753 24155 3
+ 17693 1908 24152 3
+ 17681 2056 24148 3
+ 17678 2207 24137 3
+ 17661 2361 24135 3
+
+
+ 7274 26419 12212 0
+ 7244 26366 12344 3
+ 7218 26303 12493 3
+ 7308 26248 12554 3
+ 7429 26186 12613 3
+ 7541 26117 12690 3
+ 7652 26051 12758 3
+ 7788 25974 12834 3
+ 7833 26021 12710 3
+ 7942 26030 12624 3
+ 8011 26056 12527 3
+ 7988 26120 12408 3
+ 7920 26193 12297 3
+ 7802 26258 12232 3
+ 7654 26308 12220 3
+ 7515 26352 12210 3
+ 7380 26400 12189 3
+
+
+ -5378 29484 -1323 0
+ -5371 29481 -1417 2
+ -5446 29463 -1514 2
+ -5580 29441 -1448 2
+ -5703 29420 -1393 2
+ -5781 29402 -1447 2
+ -5826 29388 -1546 2
+ -5914 29375 -1455 2
+ -5937 29377 -1324 2
+ -6027 29364 -1195 2
+ -6168 29336 -1157 2
+ -6229 29328 -1038 2
+ -6099 29357 -984 2
+ -5952 29386 -1019 2
+ -5812 29414 -1014 2
+ -5691 29435 -1100 2
+ -5592 29449 -1222 2
+ -5449 29474 -1271 2
+
+
+ 13477 22776 14129 0
+ 13586 22700 14146 3
+ 13627 22621 14233 3
+ 13621 22544 14361 3
+ 13596 22466 14506 3
+ 13617 22375 14627 3
+ 13649 22293 14722 3
+ 13568 22263 14840 3
+ 13562 22193 14951 3
+ 13654 22163 14912 3
+ 13739 22211 14762 3
+ 13740 22262 14684 3
+ 13689 22354 14591 3
+ 13684 22450 14449 3
+ 13663 22528 14345 3
+ 13638 22613 14237 3
+ 13606 22696 14135 3
+ 13486 22771 14128 3
+
+
+ 13832 17499 20061 0
+ 13783 17475 20115 2
+ 13696 17421 20223 2
+ 13597 17375 20328 2
+ 13484 17351 20424 2
+ 13339 17356 20514 2
+ 13276 17283 20617 2
+ 13155 17242 20728 2
+ 13175 17148 20793 2
+ 13293 17069 20784 2
+ 13431 17047 20712 2
+ 13541 17089 20606 2
+ 13622 17147 20504 2
+ 13724 17195 20396 2
+ 13694 17287 20338 2
+ 13729 17383 20233 2
+ 13802 17456 20119 2
+
+
+ 24192 6529 -16496 0
+ 24197 6448 -16521 2
+ 24185 6316 -16589 2
+ 24127 6227 -16706 2
+ 24083 6134 -16805 2
+ 24092 6027 -16829 2
+ 24103 5937 -16846 2
+ 24055 5829 -16952 2
+ 23938 5791 -17129 2
+ 23921 5911 -17113 2
+ 23925 6067 -17053 2
+ 23903 6207 -17033 2
+ 23885 6347 -17007 2
+ 23913 6459 -16925 2
+ 23982 6524 -16802 2
+ 24064 6503 -16693 2
+ 24151 6513 -16563 2
+
+
+ 13005 -9227 25411 0
+ 13094 -9120 25404 3
+ 13211 -9029 25376 3
+ 13307 -8900 25371 3
+ 13431 -8816 25335 3
+ 13521 -8737 25315 3
+ 13656 -8678 25262 3
+ 13848 -8607 25182 3
+ 13754 -8533 25259 3
+ 13618 -8577 25318 3
+ 13502 -8671 25348 3
+ 13372 -8735 25395 3
+ 13279 -8832 25410 3
+ 13171 -8963 25420 3
+ 13098 -9075 25418 3
+ 13005 -9194 25423 3
+
+
+ 12753 25778 8535 0
+ 12805 25714 8649 3
+ 12904 25656 8676 3
+ 12899 25607 8826 3
+ 12908 25602 8827 3
+ 12996 25588 8737 3
+ 13139 25509 8756 3
+ 13335 25411 8745 3
+ 13259 25477 8667 3
+ 13174 25510 8701 3
+ 13015 25594 8692 3
+ 12932 25676 8574 3
+ 12805 25749 8546 3
+ 12774 25808 8412 3
+ 12666 25882 8348 3
+ 12613 25915 8325 3
+ 12744 25815 8437 3
+
+
+ -16206 24956 -3814 0
+ -16170 24992 -3734 3
+ -16124 25043 -3587 3
+ -16050 25103 -3499 3
+ -15953 25178 -3396 3
+ -15830 25260 -3364 3
+ -15660 25382 -3245 3
+ -15548 25446 -3277 3
+ -15556 25430 -3363 3
+ -15641 25360 -3493 3
+ -15757 25274 -3598 3
+ -15867 25208 -3578 3
+ -16038 25095 -3610 3
+ -16097 25043 -3705 3
+ -16025 25087 -3722 3
+ -16060 25060 -3756 3
+ -16139 25001 -3808 3
+
+
+ -27904 9377 5782 0
+ -27890 9343 5903 2
+ -27898 9244 6020 2
+ -27884 9197 6154 2
+ -27859 9161 6323 2
+ -27803 9226 6472 2
+ -27776 9222 6590 2
+ -27742 9211 6749 2
+ -27710 9300 6758 2
+ -27716 9372 6634 2
+ -27729 9430 6497 2
+ -27745 9475 6357 2
+ -27770 9501 6210 2
+ -27797 9517 6064 2
+ -27832 9503 5921 2
+ -27875 9461 5785 2
+
+
+ 24919 6169 -15523 0
+ 24904 6086 -15580 2
+ 24919 5942 -15612 2
+ 24949 5794 -15619 2
+ 24995 5646 -15600 2
+ 25022 5494 -15611 2
+ 24992 5479 -15665 2
+ 24913 5547 -15766 2
+ 24828 5590 -15884 2
+ 24756 5692 -15961 2
+ 24678 5787 -16047 2
+ 24619 5957 -16075 2
+ 24674 5984 -15981 2
+ 24743 6013 -15863 2
+ 24803 6077 -15744 2
+ 24861 6146 -15625 2
+
+
+ 25878 -4981 -14336 0
+ 25813 -5073 -14420 2
+ 25739 -5090 -14546 2
+ 25665 -5138 -14659 2
+ 25590 -5222 -14761 2
+ 25519 -5322 -14848 2
+ 25439 -5347 -14976 2
+ 25377 -5286 -15103 2
+ 25403 -5168 -15099 2
+ 25474 -5055 -15018 2
+ 25550 -4994 -14908 2
+ 25629 -4889 -14808 2
+ 25696 -4882 -14693 2
+ 25771 -4883 -14562 2
+ 25843 -4896 -14429 2
+
+
+ 5450 29486 -929 0
+ 5296 29515 -920 2
+ 5163 29540 -867 2
+ 5178 29540 -765 2
+ 5233 29532 -706 2
+ 5102 29556 -623 2
+ 5153 29550 -477 2
+ 5270 29531 -401 2
+ 5422 29504 -315 2
+ 5468 29495 -369 2
+ 5639 29461 -477 2
+ 5685 29450 -610 2
+ 5752 29434 -753 2
+ 5754 29429 -893 2
+ 5639 29449 -972 2
+ 5527 29472 -906 2
+
+
+ 17357 24467 -289 0
+ 17450 24400 -372 3
+ 17564 24317 -439 3
+ 17682 24231 -446 3
+ 17669 24239 -495 3
+ 17606 24285 -491 3
+ 17475 24381 -456 3
+ 17376 24453 -337 3
+ 17263 24534 -300 3
+ 17184 24587 -396 3
+ 17154 24606 -535 3
+ 17052 24672 -713 3
+ 17070 24662 -638 3
+ 17131 24623 -515 3
+ 17171 24597 -373 3
+ 17256 24539 -283 3
+
+
+ -10217 28170 -1431 0
+ -10282 28144 -1490 2
+ -10403 28097 -1528 2
+ -10515 28050 -1611 2
+ -10579 28018 -1753 2
+ -10682 27983 -1687 2
+ -10756 27962 -1564 2
+ -10869 27926 -1417 2
+ -10921 27912 -1294 2
+ -10899 27926 -1158 2
+ -10827 27958 -1047 2
+ -10754 27986 -1062 2
+ -10627 28032 -1137 2
+ -10498 28078 -1185 2
+ -10378 28118 -1301 2
+ -10287 28148 -1364 2
+
+
+ 29126 7027 -1524 0
+ 29151 6932 -1463 2
+ 29186 6788 -1442 2
+ 29223 6635 -1413 2
+ 29255 6499 -1391 2
+ 29287 6352 -1395 2
+ 29323 6196 -1328 2
+ 29354 6043 -1354 2
+ 29344 6077 -1404 2
+ 29311 6232 -1418 2
+ 29276 6382 -1473 2
+ 29249 6499 -1509 2
+ 29208 6682 -1499 2
+ 29181 6791 -1529 2
+ 29146 6936 -1548 2
+
+
+ 6145 29344 -1095 0
+ 6034 29362 -1206 2
+ 5981 29367 -1344 2
+ 5899 29377 -1483 2
+ 5794 29393 -1569 2
+ 5647 29425 -1514 2
+ 5569 29444 -1420 2
+ 5524 29458 -1313 2
+ 5593 29447 -1253 2
+ 5432 29481 -1179 2
+ 5583 29455 -1105 2
+ 5724 29429 -1090 2
+ 5863 29403 -1054 2
+ 6008 29374 -1038 2
+ 6135 29349 -1015 2
+
+
+ 24375 5854 -16479 0
+ 24415 5790 -16444 2
+ 24458 5650 -16428 2
+ 24517 5517 -16385 2
+ 24575 5384 -16342 2
+ 24640 5251 -16288 2
+ 24683 5125 -16264 2
+ 24720 4968 -16255 2
+ 24687 4964 -16307 2
+ 24633 5101 -16346 2
+ 24582 5241 -16378 2
+ 24504 5353 -16458 2
+ 24446 5464 -16509 2
+ 24420 5614 -16497 2
+ 24397 5761 -16480 2
+
+
+ -17689 24006 -3293 0
+ -17686 23992 -3405 3
+ -17759 23932 -3446 3
+ -17793 23921 -3345 3
+ -17863 23883 -3240 3
+ -17952 23826 -3174 3
+ -18058 23738 -3230 3
+ -18221 23613 -3226 3
+ -18325 23541 -3170 3
+ -18281 23580 -3133 3
+ -18161 23671 -3137 3
+ -18055 23757 -3101 3
+ -17943 23847 -3058 3
+ -17828 23931 -3072 3
+ -17735 23984 -3198 3
+
+
+ 12744 -2905 -27003 0
+ 12739 -3050 -26989 2
+ 12662 -3173 -27011 2
+ 12559 -3272 -27048 2
+ 12496 -3390 -27062 2
+ 12429 -3512 -27077 2
+ 12301 -3581 -27127 2
+ 12168 -3530 -27193 2
+ 12185 -3383 -27205 2
+ 12292 -3266 -27170 2
+ 12396 -3187 -27133 2
+ 12495 -3067 -27101 2
+ 12581 -2933 -27076 2
+ 12700 -2875 -27027 2
+
+
+ -12039 24973 -11465 0
+ -12103 24933 -11483 2
+ -12239 24858 -11501 2
+ -12336 24773 -11582 2
+ -12451 24687 -11640 2
+ -12557 24640 -11628 2
+ -12685 24576 -11623 2
+ -12811 24507 -11631 2
+ -12818 24545 -11544 2
+ -12719 24620 -11493 2
+ -12563 24713 -11465 2
+ -12502 24768 -11412 2
+ -12372 24845 -11387 2
+ -12232 24902 -11413 2
+ -12108 24962 -11415 2
+
+
+ 7404 28675 -4785 0
+ 7375 28658 -4931 2
+ 7358 28637 -5079 2
+ 7365 28608 -5228 2
+ 7320 28597 -5351 2
+ 7170 28650 -5270 2
+ 7039 28692 -5219 2
+ 6925 28738 -5116 2
+ 6908 28762 -5000 2
+ 6915 28786 -4852 2
+ 6971 28796 -4714 2
+ 7096 28771 -4679 2
+ 7242 28716 -4790 2
+ 7371 28686 -4773 2
+
+
+ -18411 21935 8938 0
+ -18526 21854 8898 2
+ -18563 21784 8992 2
+ -18579 21717 9122 2
+ -18585 21659 9246 2
+ -18514 21661 9382 2
+ -18531 21602 9485 2
+ -18454 21620 9594 2
+ -18323 21711 9639 2
+ -18343 21746 9522 2
+ -18412 21735 9411 2
+ -18468 21751 9263 2
+ -18520 21762 9133 2
+ -18502 21809 9058 2
+ -18432 21899 8983 2
+
+
+ -19925 -10993 19549 0
+ -20010 -10933 19495 3
+ -20091 -10802 19485 3
+ -20186 -10670 19460 3
+ -20137 -10626 19534 3
+ -20013 -10735 19602 3
+ -19909 -10784 19681 3
+ -19947 -10749 19661 3
+ -20053 -10612 19629 3
+ -20120 -10574 19581 3
+ -20231 -10590 19456 3
+ -20220 -10666 19427 3
+ -20156 -10784 19428 3
+ -20127 -10910 19387 3
+ -20076 -10934 19426 3
+ -19976 -10981 19504 3
+
+
+ -18321 23571 -2957 0
+ -18342 23546 -3022 3
+ -18397 23502 -3034 3
+ -18524 23414 -2941 3
+ -18617 23343 -2915 3
+ -18722 23262 -2895 3
+ -18840 23172 -2853 3
+ -18964 23073 -2833 3
+ -18988 23069 -2701 3
+ -18899 23146 -2660 3
+ -18792 23225 -2731 3
+ -18702 23285 -2842 3
+ -18603 23365 -2831 3
+ -18448 23482 -2875 3
+ -18382 23527 -2931 3
+
+
+ -17336 22935 8569 0
+ -17413 22944 8388 2
+ -17449 22893 8453 2
+ -17444 22843 8597 2
+ -17477 22771 8720 2
+ -17466 22722 8869 2
+ -17430 22692 9015 2
+ -17385 22669 9157 2
+ -17286 22699 9272 2
+ -17255 22777 9136 2
+ -17259 22830 8996 2
+ -17268 22879 8852 2
+ -17294 22915 8706 2
+
+
+ 18292 -22847 6589 0
+ 18309 -22796 6718 2
+ 18374 -22769 6630 2
+ 18412 -22763 6543 2
+ 18493 -22679 6607 2
+ 18384 -22723 6759 2
+ 18388 -22686 6874 2
+ 18372 -22665 6983 2
+ 18447 -22577 7071 2
+ 18347 -22646 7110 2
+ 18255 -22735 7063 2
+ 18130 -22847 7023 2
+ 18176 -22841 6923 2
+ 18232 -22841 6775 2
+ 18239 -22863 6683 2
+
+
+ 25183 6987 -14730 0
+ 25164 6919 -14796 2
+ 25130 6812 -14902 2
+ 25129 6672 -14967 2
+ 25121 6548 -15035 2
+ 25103 6411 -15124 2
+ 25048 6381 -15228 2
+ 24987 6483 -15285 2
+ 24947 6625 -15290 2
+ 24918 6784 -15266 2
+ 24936 6898 -15186 2
+ 24992 6972 -15060 2
+ 25055 6997 -14943 2
+ 25131 7007 -14810 2
+
+
+ -8316 28793 1345 0
+ -8428 28760 1359 2
+ -8534 28724 1443 2
+ -8653 28685 1513 2
+ -8736 28654 1628 2
+ -8666 28667 1763 2
+ -8625 28670 1905 2
+ -8613 28663 2061 2
+ -8514 28691 2080 2
+ -8406 28730 1980 2
+ -8311 28765 1871 2
+ -8269 28786 1723 2
+ -8299 28786 1573 2
+ -8283 28799 1423 2
+
+
+ -20941 -20602 6087 0
+ -20998 -20524 6152 2
+ -21067 -20436 6208 2
+ -21163 -20341 6195 2
+ -21239 -20259 6203 2
+ -21293 -20164 6326 2
+ -21409 -20040 6327 2
+ -21473 -20012 6200 2
+ -21426 -20086 6121 2
+ -21344 -20194 6052 2
+ -21247 -20305 6023 2
+ -21149 -20419 5981 2
+ -21065 -20528 5906 2
+ -20979 -20593 5984 2
+
+
+ -4213 -29615 2279 0
+ -4267 -29597 2406 2
+ -4380 -29573 2503 2
+ -4508 -29547 2582 2
+ -4646 -29519 2654 2
+ -4702 -29517 2572 2
+ -4590 -29544 2469 2
+ -4512 -29565 2351 2
+ -4557 -29570 2206 2
+ -4684 -29561 2046 2
+ -4549 -29584 2023 2
+ -4469 -29587 2148 2
+ -4320 -29606 2196 2
+
+
+ -7190 25393 -14265 0
+ -7112 25378 -14331 2
+ -7120 25307 -14452 2
+ -7024 25329 -14461 2
+ -6921 25307 -14549 2
+ -6937 25238 -14661 2
+ -7060 25152 -14750 2
+ -7089 25166 -14711 2
+ -7140 25183 -14657 2
+ -7201 25135 -14710 2
+ -7254 25157 -14645 2
+ -7308 25222 -14506 2
+ -7376 25272 -14384 2
+ -7458 25292 -14306 2
+ -7433 25354 -14210 2
+ -7329 25398 -14185 2
+ -7241 25418 -14195 2
+
+
+ -19493 22341 -4569 0
+ -19472 22331 -4707 3
+ -19490 22314 -4716 3
+ -19508 22329 -4566 3
+ -19549 22322 -4426 3
+ -19653 22240 -4378 3
+ -19763 22155 -4310 3
+ -19839 22114 -4170 3
+ -19850 22141 -3969 3
+ -19826 22151 -4033 3
+ -19807 22141 -4177 3
+ -19683 22231 -4283 3
+ -19626 22264 -4376 3
+ -19523 22343 -4430 3
+
+
+ 631 -8774 -28681 0
+ 536 -8722 -28699 2
+ 423 -8648 -28724 2
+ 297 -8665 -28720 2
+ 79 -8600 -28741 2
+ 199 -8618 -28735 2
+ 202 -8556 -28753 2
+ 51 -8393 -28802 2
+ 169 -8385 -28804 2
+ 295 -8444 -28786 2
+ 437 -8487 -28771 2
+ 573 -8549 -28750 2
+ 715 -8613 -28728 2
+ 692 -8702 -28702 2
+
+
+ 19698 -3856 -22297 0
+ 19764 -3875 -22234 2
+ 19858 -3942 -22138 2
+ 19917 -4057 -22065 2
+ 19958 -4190 -22003 2
+ 19991 -4334 -21945 2
+ 19935 -4378 -21987 2
+ 19823 -4377 -22088 2
+ 19711 -4379 -22188 2
+ 19623 -4290 -22283 2
+ 19544 -4197 -22370 2
+ 19509 -4061 -22425 2
+ 19527 -3935 -22432 2
+ 19636 -3850 -22352 2
+
+
+ -11506 10377 -25689 0
+ -11530 10271 -25721 2
+ -11485 10138 -25794 2
+ -11542 9992 -25825 2
+ -11574 9847 -25866 2
+ -11686 9764 -25848 2
+ -11782 9854 -25770 2
+ -11896 9912 -25695 2
+ -12010 9993 -25611 2
+ -11943 10110 -25596 2
+ -11854 10227 -25591 2
+ -11723 10303 -25621 2
+ -11590 10358 -25659 2
+
+
+ 3573 20459 21649 0
+ 3555 20377 21729 2
+ 3434 20322 21799 2
+ 3328 20243 21890 2
+ 3339 20136 21986 2
+ 3381 20023 22083 2
+ 3445 19928 22159 2
+ 3590 19867 22191 2
+ 3648 19965 22093 2
+ 3666 20079 21986 2
+ 3681 20189 21883 2
+ 3641 20303 21784 2
+ 3617 20410 21688 2
+
+
+ -13127 24311 -11689 0
+ -13095 24275 -11800 2
+ -13115 24210 -11911 2
+ -13126 24171 -11978 2
+ -13007 24279 -11890 2
+ -12888 24314 -11947 2
+ -12876 24273 -12043 2
+ -12989 24180 -12109 2
+ -13137 24097 -12115 2
+ -13215 24038 -12146 2
+ -13314 24023 -12067 2
+ -13299 24094 -11943 2
+ -13218 24182 -11854 2
+ -13169 24265 -11738 2
+
+
+ -27102 -7955 10108 0
+ -27143 -7915 10032 3
+ -27136 -8036 9953 3
+ -27134 -8131 9881 3
+ -27084 -8207 9954 3
+ -27024 -8266 10070 3
+ -26970 -8365 10133 3
+ -26921 -8351 10273 3
+ -26863 -8463 10332 3
+ -26822 -8433 10462 3
+ -26878 -8318 10410 3
+ -26933 -8214 10351 3
+ -27001 -8109 10257 3
+ -27063 -8011 10169 3
+
+
+ 24282 5951 -16583 0
+ 24283 5821 -16626 2
+ 24271 5697 -16687 2
+ 24209 5633 -16799 2
+ 24230 5488 -16816 2
+ 24218 5295 -16896 2
+ 24143 5357 -16983 2
+ 24105 5471 -17000 2
+ 24127 5608 -16925 2
+ 24105 5760 -16905 2
+ 24106 5897 -16856 2
+ 24180 5898 -16750 2
+ 24242 5949 -16641 2
+
+
+ -26265 9394 11041 0
+ -26290 9264 11093 2
+ -26229 9254 11244 2
+ -26168 9254 11384 2
+ -26112 9243 11520 2
+ -26040 9279 11654 2
+ -25958 9408 11734 2
+ -25991 9492 11591 2
+ -26038 9500 11479 2
+ -26097 9512 11334 2
+ -26157 9514 11193 2
+ -26220 9502 11057 2
+
+
+ 959 -9398 -28474 0
+ 863 -9358 -28490 2
+ 726 -9328 -28504 2
+ 680 -9232 -28536 2
+ 726 -9095 -28579 2
+ 846 -8991 -28608 2
+ 952 -8948 -28619 2
+ 1117 -8982 -28602 2
+ 1239 -9037 -28580 2
+ 1310 -9153 -28539 2
+ 1344 -9285 -28495 2
+ 1216 -9355 -28478 2
+ 1066 -9394 -28471 2
+
+
+ 14782 -8096 24818 0
+ 14851 -8116 24770 3
+ 14970 -8149 24688 3
+ 15103 -8126 24614 3
+ 15232 -8127 24535 3
+ 15362 -8108 24459 3
+ 15534 -8064 24365 3
+ 15482 -8040 24406 3
+ 15353 -8062 24480 3
+ 15229 -8072 24555 3
+ 15094 -8077 24636 3
+ 14967 -8102 24705 3
+ 14840 -8091 24785 3
+
+
+ -18588 -22992 5084 0
+ -18618 -22951 5159 2
+ -18714 -22867 5186 2
+ -18831 -22759 5237 2
+ -18952 -22653 5260 2
+ -19068 -22561 5237 2
+ -19052 -22600 5125 2
+ -18926 -22712 5098 2
+ -18893 -22769 4965 2
+ -18747 -22888 4972 2
+ -18807 -22812 5088 2
+ -18754 -22857 5086 2
+ -18640 -22954 5063 2
+
+
+ 10930 21399 -17962 0
+ 11042 21342 -17960 2
+ 11173 21333 -17891 2
+ 11262 21290 -17886 2
+ 11393 21219 -17887 2
+ 11541 21133 -17895 2
+ 11662 21043 -17922 2
+ 11628 21029 -17960 2
+ 11497 21103 -17957 2
+ 11363 21184 -17948 2
+ 11223 21237 -17973 2
+ 11085 21298 -17986 2
+ 10930 21351 -18018 2
+
+
+ 2123 5909 29336 0
+ 2214 5831 29345 3
+ 2344 5758 29349 3
+ 2409 5627 29369 3
+ 2324 5515 29397 3
+ 2284 5382 29425 3
+ 2334 5220 29450 3
+ 2368 5256 29441 3
+ 2396 5395 29413 3
+ 2406 5530 29388 3
+ 2414 5682 29358 3
+ 2311 5798 29344 3
+ 2179 5864 29340 3
+
+
+ -17261 24337 -3127 0
+ -17367 24256 -3168 3
+ -17464 24183 -3193 3
+ -17534 24116 -3312 3
+ -17637 24047 -3264 3
+ -17726 23996 -3153 3
+ -17753 23996 -3006 3
+ -17723 24027 -2932 3
+ -17680 24048 -3017 3
+ -17628 24077 -3089 3
+ -17503 24165 -3114 3
+ -17421 24240 -2985 3
+ -17406 24241 -3062 3
+ -17312 24308 -3064 3
+
+
+ -17925 23424 5478 0
+ -17981 23402 5389 3
+ -18090 23338 5299 3
+ -18186 23275 5249 3
+ -18344 23147 5264 3
+ -18466 23042 5297 3
+ -18395 23090 5333 3
+ -18307 23164 5319 3
+ -18188 23250 5350 3
+ -18055 23337 5424 3
+ -18122 23285 5424 3
+ -18079 23307 5472 3
+ -17970 23372 5553 3
+ -17965 23382 5524 3
+ -17949 23399 5504 3
+
+
+ -11151 25532 -11125 0
+ -11247 25472 -11165 2
+ -11360 25387 -11245 2
+ -11514 25291 -11305 2
+ -11603 25207 -11400 2
+ -11642 25248 -11268 2
+ -11599 25304 -11189 2
+ -11412 25424 -11108 2
+ -11533 25365 -11118 2
+ -11496 25398 -11081 2
+ -11361 25471 -11052 2
+ -11229 25505 -11108 2
+
+
+ -8245 28241 5871 0
+ -8361 28193 5939 2
+ -8472 28148 5990 2
+ -8527 28115 6069 2
+ -8460 28104 6211 2
+ -8525 28086 6207 2
+ -8559 28058 6282 2
+ -8448 28071 6378 2
+ -8314 28095 6445 2
+ -8194 28138 6410 2
+ -8186 28176 6254 2
+ -8154 28216 6111 2
+ -8181 28240 5966 2
+
+
+ -29258 6281 2126 0
+ -29281 6183 2094 3
+ -29308 6047 2123 3
+ -29331 5906 2195 3
+ -29338 5824 2318 3
+ -29335 5778 2463 3
+ -29327 5753 2617 3
+ -29302 5858 2659 3
+ -29285 5977 2576 3
+ -29271 6090 2474 3
+ -29263 6178 2351 3
+ -29254 6263 2231 3
+
+
+ 15271 556 25816 0
+ 15343 663 25771 3
+ 15427 783 25718 3
+ 15536 857 25649 3
+ 15609 980 25601 3
+ 15623 1179 25584 3
+ 15563 1143 25622 3
+ 15469 1042 25683 3
+ 15368 952 25747 3
+ 15275 847 25806 3
+ 15196 727 25856 3
+ 15215 607 25848 3
+
+
+ 4573 29647 -405 0
+ 4680 29631 -283 2
+ 4807 29611 -242 2
+ 4971 29585 -202 2
+ 5045 29572 -186 2
+ 5108 29561 -240 2
+ 5156 29551 -392 2
+ 5082 29562 -522 2
+ 4997 29574 -630 2
+ 4832 29602 -631 2
+ 4723 29620 -605 2
+ 4606 29640 -512 2
+ 4528 29653 -458 2
+
+
+ 9509 25746 12114 0
+ 9428 25721 12228 3
+ 9535 25676 12240 3
+ 9592 25613 12327 3
+ 9442 25639 12388 3
+ 9484 25610 12416 3
+ 9635 25545 12435 3
+ 9800 25481 12436 3
+ 9886 25484 12363 3
+ 9884 25551 12226 3
+ 9756 25609 12207 3
+ 9617 25671 12187 3
+
+
+ 10885 -3987 -27670 0
+ 10786 -4100 -27692 2
+ 10673 -4191 -27722 2
+ 10543 -4265 -27761 2
+ 10416 -4332 -27798 2
+ 10258 -4423 -27842 2
+ 10250 -4360 -27855 2
+ 10358 -4251 -27832 2
+ 10480 -4170 -27799 2
+ 10611 -4111 -27758 2
+ 10728 -4020 -27726 2
+ 10847 -3956 -27689 2
+
+
+ -10784 27846 2885 0
+ -10753 27865 2814 2
+ -10759 27878 2664 2
+ -10843 27855 2552 2
+ -10983 27804 2512 2
+ -11122 27749 2511 2
+ -11249 27693 2565 2
+ -11292 27663 2687 2
+ -11237 27672 2830 2
+ -11131 27704 2930 2
+ -10991 27759 2933 2
+ -10858 27816 2891 2
+
+
+ -20095 -16594 14860 0
+ -20110 -16535 14906 3
+ -20157 -16401 14991 3
+ -20152 -16310 15097 3
+ -20120 -16271 15180 3
+ -20063 -16246 15282 3
+ -20156 -16058 15358 3
+ -20193 -16119 15245 3
+ -20218 -16214 15111 3
+ -20210 -16309 15019 3
+ -20219 -16404 14904 3
+ -20139 -16535 14866 3
+
+
+ -19229 22976 -1545 0
+ -19296 22918 -1556 3
+ -19384 22836 -1664 3
+ -19481 22751 -1696 3
+ -19561 22675 -1788 3
+ -19633 22616 -1758 3
+ -19658 22605 -1609 3
+ -19579 22684 -1447 3
+ -19487 22755 -1566 3
+ -19484 22767 -1426 3
+ -19393 22843 -1461 3
+ -19296 22921 -1516 3
+
+
+ -1931 -29525 -4956 0
+ -1965 -29500 -5088 2
+ -1938 -29476 -5235 2
+ -1892 -29453 -5379 2
+ -1850 -29429 -5526 2
+ -1722 -29428 -5571 2
+ -1604 -29455 -5461 2
+ -1567 -29483 -5322 2
+ -1611 -29506 -5179 2
+ -1693 -29523 -5051 2
+ -1812 -29531 -4962 2
+
+
+ -7314 -28817 -4011 0
+ -7276 -28807 -4146 2
+ -7213 -28803 -4283 2
+ -7177 -28790 -4430 2
+ -7097 -28787 -4575 2
+ -7011 -28823 -4482 2
+ -6887 -28867 -4392 2
+ -6856 -28890 -4285 2
+ -6964 -28879 -4182 2
+ -7073 -28867 -4081 2
+ -7192 -28850 -3996 2
+
+
+ -10998 25512 -11321 0
+ -10957 25484 -11424 2
+ -11011 25423 -11508 2
+ -11118 25352 -11562 2
+ -11247 25290 -11573 2
+ -11222 25338 -11491 2
+ -11242 25347 -11452 2
+ -11392 25299 -11408 2
+ -11375 25343 -11329 2
+ -11188 25400 -11389 2
+ -11262 25388 -11340 2
+ -11255 25425 -11265 2
+ -11134 25459 -11308 2
+ -11089 25463 -11344 2
+
+
+ -29990 -14 -784 0
+ -29991 -153 -700 2
+ -29992 -308 -616 2
+ -29988 -413 -745 2
+ -29987 -521 -723 2
+ -29990 -525 -569 2
+ -29994 -438 -445 2
+ -29994 -304 -489 2
+ -29994 -176 -557 2
+ -29993 -51 -632 2
+ -29991 56 -714 2
+
+
+ 24220 -1670 -17623 0
+ 24199 -1812 -17639 2
+ 24131 -1911 -17722 2
+ 24047 -1978 -17828 2
+ 23961 -1985 -17943 2
+ 23880 -1926 -18057 2
+ 23840 -1814 -18121 2
+ 23895 -1712 -18058 2
+ 23974 -1620 -17962 2
+ 24065 -1606 -17840 2
+ 24155 -1637 -17716 2
+
+
+ 140 28342 -9835 0
+ -8 28358 -9789 2
+ -155 28356 -9794 2
+ -307 28370 -9749 2
+ -403 28404 -9646 2
+ -302 28445 -9528 2
+ -163 28462 -9480 2
+ -13 28456 -9501 2
+ 109 28427 -9586 2
+ 209 28389 -9697 2
+ 217 28348 -9817 2
+
+
+ 9134 18840 21486 0
+ 9268 18774 21486 2
+ 9394 18683 21511 2
+ 9529 18629 21498 2
+ 9642 18562 21506 2
+ 9779 18480 21514 2
+ 9736 18542 21480 2
+ 9639 18642 21438 2
+ 9548 18737 21396 2
+ 9398 18777 21427 2
+ 9274 18851 21416 2
+
+
+ -21516 19701 6996 0
+ -21570 19694 6847 2
+ -21622 19676 6733 2
+ -21678 19664 6588 2
+ -21728 19651 6458 2
+ -21846 19562 6330 2
+ -21840 19534 6436 2
+ -21763 19571 6585 2
+ -21694 19597 6730 2
+ -21629 19630 6845 2
+ -21547 19677 6968 2
+
+
+ -2471 26742 -13370 0
+ -2577 26779 -13275 2
+ -2515 26811 -13223 2
+ -2382 26834 -13201 2
+ -2269 26876 -13135 2
+ -2111 26875 -13164 2
+ -1966 26888 -13159 2
+ -1903 26861 -13223 2
+ -1996 26815 -13303 2
+ -2172 26820 -13264 2
+ -2285 26791 -13306 2
+ -2398 26749 -13369 2
+
+
+ -10150 -24537 13962 0
+ -10160 -24501 14017 2
+ -10262 -24419 14085 2
+ -10409 -24355 14089 2
+ -10536 -24306 14078 2
+ -10669 -24284 14015 2
+ -10811 -24271 13929 2
+ -10764 -24299 13918 2
+ -10641 -24334 13952 2
+ -10497 -24383 13974 2
+ -10360 -24435 13986 2
+ -10224 -24509 13955 2
+
+
+ -15831 -23712 9333 0
+ -15820 -23673 9453 2
+ -15808 -23628 9584 2
+ -15775 -23585 9743 2
+ -15746 -23547 9879 2
+ -15818 -23485 9912 2
+ -15872 -23485 9825 2
+ -15937 -23456 9789 2
+ -16040 -23421 9703 2
+ -15980 -23513 9581 2
+ -15962 -23569 9472 2
+ -15928 -23639 9353 2
+
+
+ -26860 12885 -3537 0
+ -26882 12817 -3615 3
+ -26946 12675 -3639 3
+ -27001 12555 -3648 3
+ -27055 12427 -3690 3
+ -27153 12210 -3695 3
+ -27125 12276 -3679 3
+ -27066 12414 -3650 3
+ -27009 12549 -3611 3
+ -26952 12683 -3567 3
+ -26896 12816 -3514 3
+
+
+ 21555 20350 4610 0
+ 21542 20337 4727 3
+ 21519 20327 4874 3
+ 21508 20302 5023 3
+ 21523 20237 5216 3
+ 21612 20171 5107 3
+ 21671 20139 4979 3
+ 21703 20142 4825 3
+ 21677 20203 4682 3
+ 21606 20314 4532 3
+
+
+ 25080 -2304 -16299 0
+ 25116 -2395 -16231 2
+ 25117 -2547 -16207 2
+ 25122 -2692 -16175 2
+ 25150 -2830 -16107 2
+ 25122 -2953 -16129 2
+ 25075 -2890 -16214 2
+ 25021 -2813 -16310 2
+ 25035 -2717 -16306 2
+ 25069 -2633 -16267 2
+ 25036 -2496 -16340 2
+ 25041 -2367 -16350 2
+
+
+ -5147 -29506 1706 0
+ -5111 -29507 1790 2
+ -5206 -29483 1916 2
+ -5310 -29457 2024 2
+ -5395 -29433 2149 2
+ -5498 -29404 2278 2
+ -5553 -29399 2198 2
+ -5512 -29418 2053 2
+ -5456 -29438 1913 2
+ -5367 -29462 1792 2
+ -5236 -29489 1719 2
+
+
+ 3601 24897 16346 0
+ 3507 24832 16465 2
+ 3401 24830 16490 2
+ 3258 24788 16581 2
+ 3289 24705 16698 2
+ 3361 24642 16777 2
+ 3522 24593 16815 2
+ 3610 24628 16746 2
+ 3622 24701 16636 2
+ 3659 24768 16527 2
+ 3651 24851 16403 2
+
+
+ -16031 -24558 6319 0
+ -16060 -24566 6211 2
+ -16088 -24589 6045 2
+ -16069 -24631 5922 2
+ -15939 -24699 5991 2
+ -15997 -24653 6028 2
+ -15992 -24637 6107 2
+ -15891 -24691 6150 2
+ -15759 -24740 6290 2
+ -15874 -24670 6277 2
+ -15992 -24612 6205 2
+ -15978 -24600 6288 2
+
+
+ 4179 29039 -6267 0
+ 4252 29002 -6388 2
+ 4198 28976 -6539 2
+ 4141 28953 -6675 2
+ 4027 28946 -6778 2
+ 3873 28961 -6802 2
+ 3786 28995 -6706 2
+ 3882 29012 -6575 2
+ 3974 29020 -6483 2
+ 4075 29030 -6375 2
+ 4134 29040 -6293 2
+
+
+ 7225 28615 -5385 0
+ 7075 28645 -5425 2
+ 6936 28669 -5476 2
+ 6784 28705 -5479 2
+ 6761 28737 -5335 2
+ 6757 28763 -5201 2
+ 6857 28753 -5125 2
+ 6981 28709 -5205 2
+ 7118 28667 -5250 2
+ 7241 28621 -5330 2
+ 7290 28597 -5390 2
+
+
+ 27028 -4267 -12299 0
+ 26981 -4368 -12368 2
+ 26913 -4418 -12496 2
+ 26837 -4561 -12608 2
+ 26798 -4487 -12717 2
+ 26756 -4387 -12840 2
+ 26809 -4263 -12771 2
+ 26878 -4222 -12639 2
+ 26933 -4270 -12505 2
+ 27000 -4241 -12369 2
+
+
+ 17469 24240 2693 0
+ 17441 24265 2655 3
+ 17358 24337 2525 3
+ 17308 24387 2395 3
+ 17256 24436 2262 3
+ 17199 24491 2092 3
+ 17162 24514 2137 3
+ 17221 24459 2280 3
+ 17294 24396 2403 3
+ 17345 24346 2530 3
+ 17415 24283 2652 3
+
+
+ 9832 -4353 -28007 0
+ 9820 -4448 -27996 2
+ 9788 -4592 -27984 2
+ 9729 -4734 -27981 2
+ 9625 -4841 -27999 2
+ 9491 -4963 -28023 2
+ 9489 -4891 -28036 2
+ 9533 -4766 -28043 2
+ 9614 -4643 -28036 2
+ 9674 -4517 -28036 2
+ 9749 -4386 -28031 2
+
+
+ 3662 25807 14853 0
+ 3527 25809 14881 3
+ 3506 25732 15019 3
+ 3389 25705 15092 3
+ 3365 25652 15187 3
+ 3378 25577 15310 3
+ 3431 25557 15332 3
+ 3546 25596 15240 3
+ 3675 25628 15156 3
+ 3740 25685 15043 3
+ 3732 25750 14933 3
+
+
+ -6841 -28848 -4579 0
+ -6930 -28808 -4696 2
+ -6919 -28789 -4828 2
+ -6963 -28753 -4978 2
+ -6963 -28727 -5123 2
+ -6843 -28743 -5198 2
+ -6761 -28781 -5096 2
+ -6761 -28806 -4951 2
+ -6735 -28837 -4805 2
+ -6753 -28857 -4657 2
+
+
+ 10303 -4850 -27755 0
+ 10300 -4960 -27737 2
+ 10213 -5078 -27747 2
+ 10074 -5117 -27791 2
+ 9929 -5133 -27840 2
+ 9761 -5138 -27899 2
+ 9812 -5010 -27904 2
+ 9940 -4925 -27874 2
+ 10084 -4914 -27824 2
+ 10211 -4865 -27786 2
+
+
+ 27435 -3603 -11592 0
+ 27458 -3673 -11514 2
+ 27422 -3750 -11575 2
+ 27366 -3761 -11704 2
+ 27296 -3766 -11864 2
+ 27251 -3718 -11982 2
+ 27204 -3670 -12103 2
+ 27218 -3597 -12093 2
+ 27279 -3599 -11954 2
+ 27339 -3599 -11817 2
+ 27399 -3598 -11677 2
+
+
+ -19573 -21914 6055 0
+ -19614 -21842 6181 3
+ -19636 -21784 6314 3
+ -19608 -21767 6460 3
+ -19535 -21790 6600 3
+ -19581 -21743 6621 3
+ -19672 -21703 6479 3
+ -19659 -21755 6343 3
+ -19678 -21784 6184 3
+ -19671 -21807 6128 3
+ -19595 -21897 6048 3
+
+
+ -16090 -23678 8971 0
+ -16023 -23693 9051 2
+ -16018 -23638 9203 2
+ -16015 -23585 9341 2
+ -16083 -23473 9505 2
+ -16183 -23453 9384 2
+ -16264 -23458 9230 2
+ -16164 -23539 9200 2
+ -16109 -23601 9137 2
+ -16122 -23641 9009 2
+
+
+ -7427 29059 -664 0
+ -7506 29036 -766 2
+ -7600 29009 -828 2
+ -7735 28973 -849 2
+ -7837 28948 -751 2
+ -7918 28929 -629 2
+ -7887 28941 -490 2
+ -7733 28982 -472 2
+ -7591 29020 -489 2
+ -7461 29052 -567 2
+
+
+ 22146 -6178 -19271 0
+ 22086 -6105 -19363 2
+ 22028 -5989 -19465 2
+ 22083 -5859 -19442 2
+ 22158 -5893 -19347 2
+ 22265 -5913 -19217 2
+ 22364 -5874 -19114 2
+ 22383 -5952 -19068 2
+ 22315 -6079 -19107 2
+ 22219 -6161 -19193 2
+
+
+ 13300 25127 9578 0
+ 13329 25168 9428 3
+ 13322 25224 9287 3
+ 13345 25259 9161 3
+ 13214 25348 9104 3
+ 13174 25364 9117 3
+ 13300 25272 9187 3
+ 13286 25235 9310 3
+ 13295 25186 9430 3
+ 13266 25146 9576 3
+ 13305 25103 9634 3
+
+
+ 11562 21630 17276 0
+ 11678 21590 17248 3
+ 11818 21543 17211 3
+ 11925 21501 17190 3
+ 12139 21361 17214 3
+ 12075 21425 17181 3
+ 11954 21517 17150 3
+ 11818 21608 17130 3
+ 11686 21646 17172 3
+ 11582 21653 17234 3
+
+
+ -25792 5633 14249 0
+ -25835 5621 14175 2
+ -25913 5566 14055 2
+ -25932 5385 14090 2
+ -26021 5277 13966 2
+ -25999 5245 14019 2
+ -25926 5246 14153 2
+ -25847 5277 14286 2
+ -25810 5414 14301 2
+ -25776 5592 14294 2
+
+
+ -11381 25287 -11447 0
+ -11325 25285 -11506 2
+ -11409 25217 -11574 2
+ -11523 25137 -11634 2
+ -11649 25066 -11662 2
+ -11814 24959 -11724 2
+ -11783 25017 -11633 2
+ -11697 25094 -11553 2
+ -11585 25175 -11489 2
+ -11467 25250 -11443 2
+
+
+ -17257 23572 6821 0
+ -17336 23540 6732 3
+ -17352 23563 6611 3
+ -17405 23525 6607 3
+ -17508 23431 6668 3
+ -17570 23353 6777 3
+ -17659 23259 6870 3
+ -17643 23267 6882 3
+ -17519 23350 6917 3
+ -17406 23426 6948 3
+ -17298 23518 6904 3
+
+
+ 21029 -858 -21378 0
+ 20947 -896 -21458 2
+ 20843 -941 -21557 2
+ 20735 -982 -21658 2
+ 20569 -957 -21817 2
+ 20644 -904 -21749 2
+ 20750 -876 -21649 2
+ 20859 -860 -21545 2
+ 20967 -847 -21440 2
+
+
+ 16710 18554 16629 0
+ 16750 18473 16680 3
+ 16827 18373 16711 3
+ 16917 18256 16749 3
+ 17031 18133 16767 3
+ 17094 18194 16637 3
+ 17020 18312 16583 3
+ 16906 18388 16615 3
+ 16831 18510 16556 3
+
+
+ -26154 13570 5641 0
+ -26142 13534 5783 2
+ -26164 13442 5895 2
+ -26202 13345 5948 2
+ -26293 13170 5937 2
+ -26260 13216 5977 2
+ -26190 13336 6020 2
+ -26153 13455 5915 2
+ -26132 13547 5797 2
+ -26146 13580 5655 2
+
+
+ -10691 -27735 4062 0
+ -10602 -27760 4120 2
+ -10655 -27717 4273 2
+ -10747 -27667 4361 2
+ -10850 -27618 4415 2
+ -10969 -27559 4492 2
+ -11013 -27547 4456 2
+ -10944 -27595 4329 2
+ -10846 -27649 4229 2
+ -10755 -27701 4124 2
+
+
+ 5294 28803 -6509 0
+ 5435 28765 -6562 2
+ 5493 28751 -6575 2
+ 5368 28744 -6707 2
+ 5286 28730 -6831 2
+ 5158 28731 -6923 2
+ 5072 28774 -6806 2
+ 5084 28807 -6655 2
+ 5161 28822 -6529 2
+
+
+ -13366 24028 -12001 0
+ -13301 24004 -12121 2
+ -13359 23955 -12153 2
+ -13477 23886 -12158 2
+ -13599 23815 -12161 2
+ -13803 23720 -12118 2
+ -13746 23764 -12096 2
+ -13613 23832 -12112 2
+ -13505 23913 -12075 2
+ -13444 23979 -12010 2
+
+
+ -13524 26719 1794 0
+ -13573 26703 1653 2
+ -13632 26679 1550 2
+ -13761 26616 1493 2
+ -13888 26547 1539 2
+ -13877 26544 1687 2
+ -13780 26587 1796 2
+ -13670 26638 1881 2
+ -13542 26701 1912 2
+
+
+ -19280 22118 -6250 0
+ -19277 22155 -6126 3
+ -19302 22175 -5974 3
+ -19331 22185 -5842 3
+ -19367 22194 -5688 3
+ -19295 22260 -5675 3
+ -19296 22219 -5830 3
+ -19291 22189 -5961 3
+ -19260 22178 -6100 3
+ -19264 22139 -6226 3
+
+
+ -5809 29420 -843 0
+ -5941 29393 -855 2
+ -6105 29361 -799 2
+ -6240 29333 -784 2
+ -6263 29331 -696 2
+ -6180 29351 -553 2
+ -6026 29384 -539 2
+ -5913 29405 -634 2
+ -5801 29425 -740 2
+
+
+ -2866 4214 29564 0
+ -2943 4106 29572 3
+ -2969 3985 29586 3
+ -2995 3827 29604 3
+ -2854 3694 29635 3
+ -2800 3856 29619 3
+ -2871 3844 29614 3
+ -2919 3882 29604 3
+ -2891 4037 29586 3
+ -2871 4152 29572 3
+
+
+ 16380 -17659 -17885 0
+ 16303 -17573 -18039 2
+ 16406 -17509 -18008 2
+ 16503 -17464 -17963 2
+ 16599 -17490 -17849 2
+ 16694 -17522 -17728 2
+ 16683 -17611 -17650 2
+ 16572 -17652 -17714 2
+ 16465 -17641 -17823 2
+
+
+ 2405 29362 5664 0
+ 2244 29361 5738 2
+ 2299 29333 5855 2
+ 2339 29293 6035 2
+ 2506 29280 6033 2
+ 2614 29285 5965 2
+ 2641 29317 5794 2
+ 2526 29334 5756 2
+
+
+ 15812 18669 17362 0
+ 15874 18668 17306 3
+ 15995 18644 17221 3
+ 16096 18626 17145 3
+ 16044 18729 17083 3
+ 16070 18834 16941 3
+ 15985 18852 17003 3
+ 15956 18800 17087 3
+ 15849 18789 17199 3
+ 15811 18720 17308 3
+
+
+ -22192 18429 -8241 0
+ -22216 18378 -8289 3
+ -22258 18273 -8409 3
+ -22303 18178 -8492 3
+ -22300 18084 -8698 3
+ -22331 18079 -8630 3
+ -22338 18144 -8472 3
+ -22275 18259 -8390 3
+ -22230 18365 -8279 3
+
+
+ 11904 -3476 -27317 0
+ 11852 -3559 -27329 2
+ 11746 -3662 -27361 2
+ 11644 -3775 -27389 2
+ 11457 -3842 -27459 2
+ 11505 -3770 -27449 2
+ 11590 -3649 -27429 2
+ 11704 -3561 -27392 2
+ 11826 -3480 -27350 2
+
+
+ 29712 544 -4112 0
+ 29725 642 -4004 2
+ 29737 767 -3887 2
+ 29755 747 -3754 2
+ 29757 689 -3749 2
+ 29748 559 -3839 2
+ 29738 462 -3930 2
+ 29725 324 -4041 2
+ 29713 416 -4120 2
+
+
+ 9469 -5342 -27961 0
+ 9393 -5406 -27974 2
+ 9304 -5517 -27982 2
+ 9181 -5593 -28008 2
+ 8988 -5629 -28063 2
+ 9008 -5520 -28078 2
+ 9119 -5445 -28057 2
+ 9259 -5405 -28019 2
+ 9392 -5332 -27989 2
+
+
+ -4851 24586 -16492 0
+ -4739 24571 -16548 2
+ -4627 24536 -16631 2
+ -4550 24463 -16759 2
+ -4599 24400 -16837 2
+ -4716 24434 -16755 2
+ -4836 24462 -16680 2
+ -4991 24482 -16605 2
+ -4945 24527 -16552 2
+
+
+ 24496 6480 -16061 0
+ 24538 6288 -16073 2
+ 24472 6317 -16162 2
+ 24416 6245 -16275 2
+ 24356 6147 -16401 2
+ 24324 6213 -16424 2
+ 24354 6333 -16334 2
+ 24400 6423 -16230 2
+ 24459 6494 -16111 2
+
+
+ -5809 29356 -2119 0
+ -5784 29353 -2221 2
+ -5774 29344 -2368 2
+ -5830 29322 -2499 2
+ -5984 29288 -2529 2
+ -6093 29273 -2438 2
+ -6091 29287 -2278 2
+ -5960 29318 -2219 2
+ -5880 29341 -2133 2
+
+
+ 28373 6866 -6918 0
+ 28389 6764 -6949 3
+ 28388 6667 -7050 3
+ 28379 6587 -7157 3
+ 28358 6480 -7337 3
+ 28348 6546 -7318 3
+ 28355 6642 -7201 3
+ 28346 6773 -7115 3
+ 28353 6862 -7003 3
+
+
+ 6654 -7693 -28223 0
+ 6739 -7650 -28214 2
+ 6702 -7836 -28172 2
+ 6672 -7985 -28138 2
+ 6566 -8073 -28138 2
+ 6420 -8014 -28188 2
+ 6444 -7870 -28223 2
+ 6544 -7788 -28223 2
+ 6632 -7769 -28208 2
+
+
+ 23496 6501 17484 0
+ 23553 6445 17428 2
+ 23644 6399 17321 2
+ 23731 6414 17196 2
+ 23818 6490 17046 2
+ 23766 6562 17091 2
+ 23681 6575 17204 2
+ 23597 6571 17321 2
+ 23515 6560 17435 2
+
+
+ -6643 25925 -13555 0
+ -6574 25925 -13589 3
+ -6446 25914 -13673 3
+ -6341 25887 -13772 3
+ -6232 25861 -13870 3
+ -6303 25806 -13939 3
+ -6429 25827 -13843 3
+ -6526 25855 -13746 3
+ -6602 25902 -13620 3
+
+
+ -7497 28006 -7711 0
+ -7597 27995 -7653 2
+ -7735 27971 -7604 2
+ -7708 27985 -7580 2
+ -7631 28032 -7482 2
+ -7586 28090 -7307 2
+ -7482 28114 -7323 2
+ -7446 28079 -7491 2
+ -7434 28048 -7619 2
+
+
+ -20663 19947 -8671 0
+ -20672 19907 -8738 3
+ -20771 19796 -8757 3
+ -20881 19698 -8716 3
+ -20998 19601 -8653 3
+ -20990 19655 -8548 3
+ -20937 19719 -8533 3
+ -20835 19792 -8613 3
+ -20721 19885 -8673 3
+
+
+ 4747 25258 15476 0
+ 4732 25211 15557 2
+ 4707 25135 15686 2
+ 4675 25062 15812 2
+ 4698 24971 15949 2
+ 4737 24983 15919 2
+ 4740 25062 15793 2
+ 4752 25142 15662 2
+ 4762 25219 15534 2
+
+
+ 8037 27999 7173 0
+ 8163 27962 7177 2
+ 8233 27975 7045 2
+ 8225 28017 6884 2
+ 8158 28054 6814 2
+ 8012 28089 6842 2
+ 7915 28093 6939 2
+ 7945 28049 7079 2
+
+
+ -8206 28777 -2132 0
+ -8117 28797 -2201 2
+ -8074 28797 -2348 2
+ -8149 28767 -2462 2
+ -8295 28730 -2405 2
+ -8471 28684 -2344 2
+ -8422 28706 -2239 2
+ -8300 28748 -2158 2
+
+
+ 26623 -4311 -13138 0
+ 26650 -4405 -13053 2
+ 26656 -4566 -12985 2
+ 26620 -4634 -13035 2
+ 26536 -4635 -13204 2
+ 26517 -4531 -13278 2
+ 26514 -4384 -13333 2
+ 26575 -4298 -13239 2
+
+
+ -19193 23050 547 0
+ -19196 23050 431 3
+ -19322 22946 352 3
+ -19413 22870 343 3
+ -19464 22825 436 3
+ -19496 22795 559 3
+ -19434 22845 631 3
+ -19303 22956 634 3
+ -19211 23035 595 3
+
+
+ -21968 17844 -9950 0
+ -22020 17699 -10094 3
+ -22085 17667 -10007 3
+ -22138 17678 -9868 3
+ -22237 17606 -9774 3
+ -22231 17617 -9769 3
+ -22126 17697 -9861 3
+ -22081 17689 -9976 3
+ -21995 17812 -9949 3
+
+
+ -9395 -28397 2317 0
+ -9398 -28383 2462 2
+ -9404 -28368 2613 2
+ -9454 -28338 2757 2
+ -9557 -28307 2712 2
+ -9543 -28324 2580 2
+ -9525 -28345 2417 2
+ -9481 -28371 2277 2
+
+
+ -23532 -559 18600 0
+ -23583 -699 18529 2
+ -23505 -689 18629 2
+ -23433 -577 18723 2
+ -23389 -466 18781 2
+ -23407 -313 18762 2
+ -23481 -331 18668 2
+ -23528 -460 18607 2
+
+
+ 29597 -880 -4821 0
+ 29608 -761 -4772 2
+ 29622 -629 -4709 2
+ 29637 -507 -4624 2
+ 29655 -564 -4504 2
+ 29649 -703 -4524 2
+ 29633 -832 -4605 2
+ 29612 -925 -4721 2
+
+
+ -4242 28374 8769 0
+ -4353 28355 8779 2
+ -4501 28336 8763 2
+ -4675 28288 8829 2
+ -4588 28277 8909 2
+ -4438 28287 8953 2
+ -4282 28307 8966 2
+ -4223 28352 8851 2
+
+
+ 23521 18132 -4238 0
+ 23543 18134 -4111 3
+ 23628 18036 -4054 3
+ 23690 17940 -4116 3
+ 23692 17903 -4262 3
+ 23674 17888 -4420 3
+ 23598 17983 -4444 3
+ 23545 18081 -4325 3
+
+
+ -12721 26335 -6680 0
+ -12620 26369 -6739 3
+ -12632 26332 -6860 3
+ -12611 26302 -7010 3
+ -12514 26313 -7142 3
+ -12536 26304 -7138 3
+ -12623 26295 -7018 3
+ -12655 26319 -6869 3
+ -12685 26338 -6736 3
+
+
+ 28556 -1354 -9094 0
+ 28560 -1477 -9062 2
+ 28550 -1630 -9069 2
+ 28508 -1644 -9198 2
+ 28467 -1649 -9324 2
+ 28454 -1504 -9388 2
+ 28484 -1384 -9315 2
+ 28528 -1340 -9186 2
+
+
+ -13304 26737 -2855 0
+ -13380 26703 -2820 3
+ -13457 26675 -2713 3
+ -13434 26697 -2611 3
+ -13289 26772 -2586 3
+ -13198 26825 -2494 3
+ -13149 26843 -2557 3
+ -13161 26825 -2683 3
+ -13256 26764 -2826 3
+
+
+ -4166 24261 -17148 0
+ -4087 24250 -17183 2
+ -4011 24198 -17274 2
+ -3978 24134 -17370 2
+ -3850 24074 -17482 2
+ -3902 24057 -17493 2
+ -4037 24098 -17407 2
+ -4142 24156 -17302 2
+ -4173 24225 -17197 2
+
+
+ 22208 16310 -11865 0
+ 22163 16312 -11947 3
+ 22054 16390 -12042 3
+ 21967 16539 -11996 3
+ 22058 16490 -11895 3
+ 22110 16382 -11948 3
+ 22139 16390 -11884 3
+ 22178 16393 -11807 3
+ 22206 16389 -11760 3
+ 22184 16338 -11872 3
+
+
+ 18389 23461 -3379 0
+ 18467 23403 -3362 3
+ 18593 23301 -3370 3
+ 18741 23181 -3376 3
+ 18715 23192 -3448 3
+ 18595 23283 -3482 3
+ 18475 23375 -3505 3
+ 18352 23480 -3446 3
+
+
+ -12115 27105 4305 0
+ -12042 27144 4265 3
+ -11944 27205 4151 3
+ -11886 27256 3977 3
+ -11963 27223 3977 3
+ -12097 27163 3979 3
+ -12192 27111 4045 3
+ -12123 27125 4154 3
+ -12115 27113 4255 3
+
+
+ 22705 -5 -19608 0
+ 22754 -24 -19551 2
+ 22862 -80 -19425 2
+ 22818 -168 -19476 2
+ 22730 -143 -19579 2
+ 22671 -158 -19647 2
+ 22567 -178 -19766 2
+ 22561 -79 -19773 2
+ 22650 -22 -19672 2
+
+
+ -21304 20829 -3509 0
+ -21365 20762 -3537 3
+ -21454 20670 -3530 3
+ -21547 20588 -3446 3
+ -21644 20505 -3331 3
+ -21627 20522 -3337 3
+ -21542 20594 -3439 3
+ -21449 20677 -3520 3
+ -21361 20768 -3524 3
+
+
+ 21301 -2864 -20930 0
+ 21350 -2973 -20864 2
+ 21345 -3114 -20850 2
+ 21328 -3240 -20847 2
+ 21220 -3300 -20948 2
+ 21204 -3158 -20986 2
+ 21204 -3028 -21006 2
+ 21247 -2886 -20982 2
+
+
+ -3541 26084 -14390 0
+ -3450 26068 -14442 2
+ -3307 26026 -14550 2
+ -3391 25972 -14628 2
+ -3574 25935 -14650 2
+ -3684 25952 -14592 2
+ -3711 25996 -14506 2
+ -3627 26064 -14406 2
+
+
+ -17503 -23888 4794 0
+ -17405 -23951 4839 2
+ -17332 -23984 4938 2
+ -17242 -24024 5056 2
+ -17159 -24065 5140 2
+ -17206 -24032 5138 2
+ -17288 -23990 5063 2
+ -17377 -23949 4945 2
+ -17464 -23907 4848 2
+
+
+ -20659 21543 3021 0
+ -20679 21534 2947 2
+ -20689 21548 2768 2
+ -20719 21543 2574 2
+ -20753 21501 2648 2
+ -20775 21462 2794 2
+ -20781 21434 2955 2
+ -20712 21490 3037 2
+
+
+ 24748 -885 -16934 0
+ 24748 -998 -16928 2
+ 24674 -1039 -17033 2
+ 24588 -1005 -17158 2
+ 24491 -967 -17299 2
+ 24522 -911 -17258 2
+ 24610 -882 -17135 2
+ 24697 -860 -17010 2
+
+
+ 22276 -3747 -19742 0
+ 22324 -3853 -19667 2
+ 22373 -3985 -19585 2
+ 22387 -4091 -19546 2
+ 22326 -4162 -19602 2
+ 22270 -4057 -19687 2
+ 22222 -3932 -19767 2
+ 22229 -3776 -19789 2
+
+
+ -16881 -24201 5419 0
+ -16954 -24164 5354 2
+ -17029 -24132 5259 2
+ -17093 -24103 5185 2
+ -17033 -24162 5108 2
+ -16916 -24247 5093 2
+ -16907 -24232 5194 2
+ -16837 -24280 5195 2
+ -16802 -24288 5271 2
+ -16841 -24239 5369 2
+
+
+ -26588 12735 5561 0
+ -26640 12625 5560 2
+ -26704 12502 5531 2
+ -26736 12390 5629 2
+ -26710 12391 5746 2
+ -26650 12501 5789 2
+ -26609 12624 5708 2
+ -26570 12743 5625 2
+
+
+ 15516 21285 -14359 0
+ 15539 21320 -14283 3
+ 15632 21329 -14168 3
+ 15729 21251 -14178 3
+ 15794 21145 -14262 3
+ 15795 21066 -14378 3
+ 15669 21129 -14425 3
+ 15552 21229 -14404 3
+
+
+ 7216 28601 -5469 0
+ 7186 28582 -5607 2
+ 7188 28551 -5759 2
+ 7086 28564 -5820 2
+ 7023 28603 -5705 2
+ 7063 28622 -5559 2
+ 7137 28626 -5441 2
+ 7238 28609 -5399 2
+
+
+ 3833 29553 3454 0
+ 3835 29564 3360 2
+ 3801 29582 3232 2
+ 3812 29598 3065 2
+ 3683 29614 3070 2
+ 3711 29595 3220 2
+ 3702 29580 3365 2
+ 3753 29563 3453 2
+
+
+ 8843 28172 5303 0
+ 8930 28154 5253 2
+ 9026 28139 5168 2
+ 8944 28180 5088 2
+ 8801 28218 5127 2
+ 8645 28261 5158 2
+ 8644 28240 5274 2
+ 8757 28195 5325 2
+
+
+ 21050 -381 -21372 0
+ 20956 -450 -21463 2
+ 20896 -570 -21518 2
+ 20758 -603 -21650 2
+ 20800 -490 -21613 2
+ 20887 -392 -21531 2
+ 20987 -362 -21434 2
+
+
+ 3999 25672 14999 0
+ 3947 25630 15084 3
+ 3910 25561 15211 3
+ 3907 25438 15415 3
+ 3975 25486 15318 3
+ 4009 25560 15185 3
+ 4016 25626 15072 3
+
+
+ -26361 12892 6235 0
+ -26360 12825 6380 2
+ -26385 12717 6488 2
+ -26451 12584 6481 2
+ -26444 12579 6516 2
+ -26380 12719 6507 2
+ -26355 12825 6398 2
+ -26349 12904 6261 2
+
+
+ 5148 25410 15094 0
+ 5070 25383 15166 2
+ 5022 25312 15300 2
+ 5104 25186 15480 2
+ 5183 25227 15387 2
+ 5205 25294 15269 2
+ 5192 25377 15134 2
+
+
+ 24083 -4111 -17411 0
+ 23997 -4125 -17525 2
+ 23904 -4131 -17651 2
+ 23825 -4049 -17776 2
+ 23851 -3979 -17756 2
+ 23933 -3994 -17642 2
+ 24019 -4018 -17520 2
+
+
+ 12234 -12996 -24113 0
+ 12221 -12862 -24191 2
+ 12195 -12735 -24272 2
+ 12236 -12601 -24321 2
+ 12274 -12603 -24300 2
+ 12281 -12743 -24224 2
+ 12292 -12856 -24158 2
+ 12284 -12989 -24092 2
+
+
+ 1263 19267 22961 0
+ 1175 19245 22984 2
+ 1017 19131 23086 2
+ 1130 19054 23144 2
+ 1275 19024 23161 2
+ 1374 19135 23064 2
+ 1289 19219 22999 2
+
+
+ 24383 5280 -16661 0
+ 24459 5240 -16562 2
+ 24541 5139 -16472 2
+ 24541 5027 -16506 2
+ 24458 5005 -16636 2
+ 24364 5074 -16753 2
+ 24336 5200 -16755 2
+
+
+ -3500 28664 8132 0
+ -3601 28667 8076 2
+ -3688 28634 8155 2
+ -3656 28603 8277 2
+ -3510 28568 8460 2
+ -3436 28603 8369 2
+ -3461 28641 8229 2
+
+
+ 10996 25265 11864 0
+ 11110 25195 11908 3
+ 11226 25113 11972 3
+ 11278 25087 11977 3
+ 11162 25184 11883 3
+ 11088 25270 11767 3
+ 11050 25316 11705 3
+ 10978 25286 11836 3
+
+
+ -8489 -28676 2368 0
+ -8534 -28674 2233 2
+ -8434 -28711 2126 2
+ -8299 -28751 2122 2
+ -8174 -28778 2234 2
+ -8256 -28750 2301 2
+ -8386 -28707 2361 2
+
+
+ -8544 -28708 1696 0
+ -8608 -28679 1845 2
+ -8708 -28644 1927 2
+ -8807 -28616 1888 2
+ -8873 -28606 1722 2
+ -8768 -28639 1705 2
+ -8637 -28683 1644 2
+
+
+ -13684 26583 2464 0
+ -13786 26538 2388 2
+ -13923 26466 2387 2
+ -14021 26405 2485 2
+ -13964 26428 2567 2
+ -13835 26492 2601 2
+ -13708 26561 2576 2
+
+
+ -26462 13710 -3429 0
+ -26501 13633 -3440 2
+ -26571 13498 -3431 2
+ -26681 13293 -3381 2
+ -26639 13374 -3389 2
+ -26569 13504 -3422 2
+ -26499 13638 -3433 2
+
+
+ 25177 -2424 -16132 0
+ 25228 -2479 -16044 2
+ 25243 -2599 -16001 2
+ 25250 -2748 -15966 2
+ 25200 -2804 -16034 2
+ 25160 -2757 -16106 2
+ 25147 -2621 -16148 2
+ 25146 -2487 -16171 2
+
+
+ -3593 28752 7771 0
+ -3723 28726 7809 2
+ -3671 28701 7923 2
+ -3472 28705 7997 2
+ -3572 28730 7864 2
+ -3478 28728 7914 2
+ -3486 28745 7848 2
+
+
+ 18992 23204 -949 0
+ 19042 23166 -870 3
+ 19118 23106 -769 3
+ 19234 23008 -825 3
+ 19245 22994 -957 3
+ 19136 23079 -1078 3
+ 19034 23167 -996 3
+
+
+ 16204 715 25237 0
+ 16285 721 25185 3
+ 16426 677 25094 3
+ 16435 748 25087 3
+ 16492 864 25046 3
+ 16421 862 25092 3
+ 16295 817 25176 3
+ 16173 788 25255 3
+
+
+ 11947 21012 -17769 0
+ 12037 20940 -17795 2
+ 12231 20786 -17843 2
+ 12131 20833 -17855 2
+ 12002 20918 -17844 2
+ 11861 20972 -17874 2
+ 11867 21007 -17829 2
+
+
+ -16323 24985 3054 0
+ -16387 24948 3014 2
+ -16524 24860 2989 2
+ -16479 24874 3116 2
+ -16373 24938 3163 2
+ -16467 24877 3161 2
+ -16422 24905 3175 2
+ -16303 24983 3175 2
+
+
+ 7459 26926 10924 0
+ 7513 26882 10997 3
+ 7635 26828 11044 3
+ 7776 26741 11156 3
+ 7765 26763 11112 3
+ 7721 26826 10988 3
+ 7681 26855 10945 3
+ 7541 26911 10906 3
+
+
+ 4421 25599 -15005 0
+ 4258 25656 -14954 2
+ 4109 25699 -14923 2
+ 4130 25757 -14816 2
+ 4307 25712 -14844 2
+ 4392 25634 -14953 2
+ 4462 25599 -14993 2
+
+
+ -3740 24124 -17437 0
+ -3639 24118 -17467 2
+ -3579 24047 -17577 2
+ -3476 23945 -17736 2
+ -3550 23952 -17712 2
+ -3642 24019 -17602 2
+ -3745 24077 -17501 2
+
+
+ 1630 23899 18060 0
+ 1623 23826 18157 3
+ 1649 23747 18259 3
+ 1801 23751 18239 3
+ 1837 23825 18138 3
+ 1752 23907 18038 3
+ 1698 23966 17965 3
+
+
+ 17320 22752 -9075 0
+ 17418 22694 -9033 3
+ 17544 22617 -8981 3
+ 17636 22531 -9019 3
+ 17620 22517 -9084 3
+ 17502 22591 -9128 3
+ 17388 22655 -9189 3
+ 17355 22695 -9152 3
+
+
+ 6068 25608 14403 0
+ 5959 25597 14466 2
+ 5878 25552 14579 2
+ 5966 25456 14710 2
+ 6004 25469 14673 2
+ 6080 25509 14571 2
+ 6168 25566 14434 2
+
+
+ 17827 6043 23359 0
+ 17858 6112 23318 3
+ 17888 6242 23260 3
+ 17817 6372 23280 3
+ 17695 6347 23380 3
+ 17678 6197 23433 3
+ 17782 6111 23376 3
+
+
+ 1364 -29308 -6258 0
+ 1229 -29302 -6317 2
+ 1253 -29279 -6416 2
+ 1413 -29273 -6411 2
+ 1529 -29264 -6423 2
+ 1493 -29305 -6246 2
+ 1443 -29323 -6169 2
+
+
+ -18191 -23193 5583 0
+ -18265 -23125 5622 3
+ -18278 -23063 5834 3
+ -18333 -23041 5743 3
+ -18425 -23007 5582 3
+ -18359 -23065 5564 3
+ -18244 -23153 5578 3
+
+
+ -5480 29422 -2079 0
+ -5514 29407 -2194 2
+ -5553 29387 -2359 2
+ -5618 29379 -2305 2
+ -5670 29379 -2176 2
+ -5696 29385 -2019 2
+ -5552 29413 -2008 2
+
+
+ -26312 13467 5132 0
+ -26326 13403 5224 2
+ -26288 13423 5364 2
+ -26225 13467 5557 2
+ -26230 13485 5489 2
+ -26262 13490 5322 2
+ -26311 13440 5204 2
+
+
+ 22241 13603 14842 0
+ 22193 13609 14909 2
+ 22130 13563 15044 2
+ 22075 13455 15220 2
+ 22122 13450 15156 2
+ 22189 13486 15026 2
+ 22228 13557 14903 2
+
+
+ -10783 26096 -10136 0
+ -10856 26061 -10147 3
+ -10996 26008 -10134 3
+ -11189 25915 -10161 3
+ -11137 25950 -10127 3
+ -11004 26011 -10118 3
+ -10861 26064 -10135 3
+
+
+ 29783 1256 -3378 0
+ 29787 1324 -3316 2
+ 29796 1412 -3194 2
+ 29807 1499 -3045 2
+ 29813 1403 -3033 2
+ 29802 1338 -3169 2
+ 29791 1251 -3304 2
+
+
+ -17758 24025 2727 0
+ -17787 24019 2591 2
+ -17874 23960 2539 2
+ -17910 23915 2700 2
+ -17915 23890 2888 2
+ -17800 23981 2839 2
+
+
+ -23952 18049 730 0
+ -24007 17974 772 3
+ -24094 17855 810 3
+ -24203 17707 838 3
+ -24168 17753 865 3
+ -24082 17871 828 3
+ -23997 17987 783 3
+
+
+ -1959 8253 28776 0
+ -2044 8220 28779 3
+ -2153 8138 28795 3
+ -2157 8014 28829 3
+ -2103 7933 28856 3
+ -2141 8143 28794 3
+ -2032 8214 28782 3
+
+
+ 24446 -969 -17363 0
+ 24388 -1010 -17442 2
+ 24298 -1004 -17567 2
+ 24193 -976 -17713 2
+ 24218 -945 -17680 2
+ 24308 -942 -17556 2
+ 24398 -945 -17431 2
+
+
+ 2887 27868 10725 0
+ 2967 27892 10640 2
+ 3060 27912 10563 2
+ 3067 27965 10418 2
+ 3008 27944 10493 2
+ 2954 27969 10440 2
+ 2915 27943 10521 2
+ 2890 27898 10646 2
+
+
+ 21419 -3233 -20756 0
+ 21395 -3352 -20761 2
+ 21407 -3475 -20729 2
+ 21356 -3587 -20762 2
+ 21281 -3502 -20853 2
+ 21283 -3385 -20870 2
+ 21367 -3277 -20802 2
+
+
+ 20078 -7369 -21038 0
+ 20021 -7376 -21089 2
+ 19904 -7400 -21192 2
+ 19900 -7339 -21216 2
+ 19922 -7209 -21240 2
+ 19969 -7135 -21221 2
+ 20044 -7154 -21143 2
+ 20063 -7293 -21078 2
+
+
+ 10608 21446 -18098 0
+ 10453 21517 -18104 2
+ 10323 21591 -18090 2
+ 10282 21640 -18056 2
+ 10461 21565 -18042 2
+ 10590 21494 -18051 2
+ 10655 21440 -18077 2
+
+
+ 16151 -1050 -25260 0
+ 16224 -1051 -25213 2
+ 16346 -1027 -25135 2
+ 16495 -1088 -25034 2
+ 16434 -1132 -25073 2
+ 16296 -1144 -25162 2
+ 16177 -1082 -25242 2
+
+
+ 6256 -8530 -28073 0
+ 6167 -8540 -28090 2
+ 6097 -8470 -28126 2
+ 6225 -8357 -28132 2
+ 6335 -8248 -28139 2
+ 6377 -8317 -28110 2
+ 6288 -8426 -28098 2
+
+
+ 21026 13541 -16569 0
+ 21111 13472 -16518 2
+ 21186 13403 -16477 2
+ 21295 13249 -16462 2
+ 21240 13292 -16497 2
+ 21146 13390 -16539 2
+ 21039 13485 -16599 2
+
+
+ -18859 -22602 5789 0
+ -18753 -22656 5917 3
+ -18802 -22607 5950 3
+ -18942 -22492 5941 3
+ -18895 -22540 5908 3
+ -18990 -22473 5858 3
+ -18942 -22524 5819 3
+ -18897 -22577 5762 3
+
+
+ 13656 23661 12396 0
+ 13688 23703 12280 3
+ 13634 23780 12191 3
+ 13597 23872 12052 3
+ 13579 23868 12080 3
+ 13618 23786 12198 3
+ 13648 23704 12322 3
+
+
+ 8006 23007 -17510 0
+ 7855 23063 -17504 2
+ 7734 23149 -17444 2
+ 7751 23202 -17366 2
+ 7909 23112 -17416 2
+ 8038 23054 -17433 2
+
+
+ 3087 24735 16693 0
+ 2904 24716 16754 2
+ 2976 24631 16866 2
+ 3080 24593 16902 2
+ 3198 24626 16832 2
+ 3165 24707 16719 2
+
+
+ -12618 24857 -11088 0
+ -12616 24812 -11190 2
+ -12669 24738 -11292 2
+ -12755 24707 -11265 2
+ -12794 24688 -11260 2
+ -12854 24666 -11241 2
+ -12811 24743 -11121 2
+ -12697 24822 -11075 2
+
+
+ -11749 25130 -11421 0
+ -11784 25081 -11492 2
+ -11894 25005 -11545 2
+ -11984 24923 -11628 2
+ -11997 24952 -11552 2
+ -11931 25029 -11454 2
+ -11852 25089 -11405 2
+
+
+ 25018 -660 -16543 0
+ 25084 -664 -16442 2
+ 25163 -623 -16323 2
+ 25190 -770 -16275 2
+ 25104 -777 -16407 2
+ 25026 -758 -16527 2
+
+
+ -15854 -24577 6681 0
+ -15934 -24552 6579 2
+ -16000 -24553 6417 2
+ -15916 -24614 6391 2
+ -15830 -24642 6496 2
+ -15768 -24646 6630 2
+
+
+ -17115 24557 -2011 0
+ -17119 24547 -2095 3
+ -17152 24511 -2241 3
+ -17184 24475 -2389 3
+ -17213 24457 -2361 3
+ -17182 24492 -2224 3
+ -17139 24533 -2095 3
+
+
+ 11398 -4172 -27435 0
+ 11468 -4286 -27388 2
+ 11351 -4344 -27428 2
+ 11215 -4449 -27467 2
+ 11234 -4322 -27479 2
+ 11320 -4219 -27460 2
+
+
+ -7436 14318 25292 0
+ -7574 14260 25284 2
+ -7657 14199 25294 2
+ -7564 14103 25375 2
+ -7447 14209 25350 2
+ -7349 14319 25317 2
+
+
+ 23814 -745 -18231 0
+ 23819 -838 -18220 2
+ 23745 -898 -18313 2
+ 23622 -862 -18473 2
+ 23677 -749 -18407 2
+ 23765 -720 -18295 2
+
+
+ -1698 25570 15597 0
+ -1786 25547 15625 2
+ -1901 25497 15694 2
+ -1932 25409 15832 2
+ -1812 25443 15791 2
+ -1719 25508 15696 2
+
+
+ -11912 25153 -11200 0
+ -11790 25170 -11291 2
+ -11855 25112 -11351 2
+ -11998 25019 -11406 2
+ -12028 25061 -11282 2
+ -12006 25116 -11184 2
+
+
+ -20089 -9689 20064 0
+ -20155 -9600 20040 3
+ -20231 -9447 20036 3
+ -20249 -9528 19980 3
+ -20180 -9655 19989 3
+ -20180 -9738 19948 3
+ -20141 -9747 19984 3
+
+
+ 22251 15516 -12811 0
+ 22247 15429 -12924 3
+ 22161 15455 -13039 3
+ 22141 15509 -13009 3
+ 22106 15644 -12907 3
+ 22178 15629 -12802 3
+
+
+ -6458 14255 25595 0
+ -6554 14149 25629 2
+ -6559 14123 25642 2
+ -6403 14187 25646 2
+ -6314 14292 25610 2
+ -6346 14389 25548 2
+
+
+ 24489 -4261 -16797 0
+ 24479 -4353 -16788 2
+ 24390 -4387 -16909 2
+ 24298 -4332 -17053 2
+ 24353 -4261 -16994 2
+ 24441 -4260 -16867 2
+
+
+ -3316 28682 8146 0
+ -3415 28695 8058 2
+ -3595 28686 8012 2
+ -3560 28673 8075 2
+ -3446 28656 8184 2
+ -3342 28652 8241 2
+
+
+ 23528 1053 -18582 0
+ 23461 1092 -18665 2
+ 23408 1221 -18724 2
+ 23439 1344 -18676 2
+ 23521 1263 -18578 2
+ 23545 1131 -18556 2
+
+
+ -6353 29317 -386 0
+ -6339 29319 -493 2
+ -6342 29315 -643 2
+ -6460 29289 -661 2
+ -6493 29285 -499 2
+ -6452 29295 -385 2
+
+
+ 23124 -10704 15834 0
+ 23036 -10724 15948 2
+ 22999 -10847 15919 2
+ 23044 -10922 15802 2
+ 23131 -10866 15712 2
+ 23142 -10770 15762 2
+
+
+ -10965 -27064 6879 0
+ -10940 -27048 6980 2
+ -11007 -26992 7089 2
+ -11149 -26948 7036 2
+ -11169 -26971 6914 2
+ -11039 -27037 6868 2
+
+
+ 4917 27988 9617 0
+ 5013 27967 9629 3
+ 5100 27981 9543 3
+ 5064 28053 9347 3
+ 5010 28046 9399 3
+ 4950 28007 9545 3
+
+
+ -11542 -27125 5570 0
+ -11473 -27141 5635 2
+ -11467 -27105 5817 2
+ -11576 -27051 5852 2
+ -11632 -27046 5766 2
+ -11584 -27093 5638 2
+
+
+ 22858 -880 -19409 0
+ 22912 -904 -19345 2
+ 23022 -972 -19210 2
+ 22961 -1059 -19279 2
+ 22862 -1052 -19397 2
+ 22839 -961 -19428 2
+
+
+ -27648 11150 3354 0
+ -27687 11048 3371 2
+ -27711 10974 3414 2
+ -27675 11016 3573 2
+ -27626 11142 3557 2
+ -27621 11197 3417 2
+
+
+ 4612 1962 29578 0
+ 4518 1931 29595 2
+ 4427 1799 29617 2
+ 4460 1694 29618 2
+ 4570 1751 29598 2
+ 4642 1891 29578 2
+
+
+ -1839 23767 -18214 0
+ -1796 23716 -18284 2
+ -1612 23658 -18376 2
+ -1690 23650 -18381 2
+ -1814 23669 -18344 2
+ -1890 23729 -18258 2
+
+
+ -26596 11995 6985 0
+ -26635 11856 7071 2
+ -26664 11771 7104 2
+ -26662 11721 7194 2
+ -26631 11857 7086 2
+ -26593 11984 7013 2
+
+
+ 23795 -164 -18269 0
+ 23841 -219 -18208 2
+ 23812 -377 -18245 2
+ 23716 -430 -18367 2
+ 23734 -356 -18345 2
+ 23759 -226 -18315 2
+
+
+ -22867 -15404 11824 0
+ -22826 -15380 11935 3
+ -22834 -15304 12017 3
+ -22916 -15247 11933 3
+ -22969 -15289 11776 3
+ -22920 -15374 11760 3
+
+
+ 11693 24510 -12748 0
+ 11629 24490 -12845 2
+ 11504 24578 -12789 2
+ 11546 24618 -12675 2
+ 11682 24554 -12674 2
+ 11749 24509 -12699 2
+
+
+ -11168 -26833 7435 0
+ -11150 -26813 7534 2
+ -11068 -26812 7657 2
+ -11110 -26778 7713 2
+ -11217 -26762 7614 2
+ -11231 -26799 7460 2
+
+
+ -13936 24051 -11284 0
+ -14010 23975 -11354 2
+ -14070 23913 -11412 2
+ -14166 23881 -11358 2
+ -14150 23934 -11268 2
+ -14032 24014 -11244 2
+
+
+ 29225 434 -6762 0
+ 29243 495 -6680 2
+ 29273 556 -6542 2
+ 29289 494 -6472 2
+ 29273 413 -6551 2
+ 29236 396 -6718 2
+
+
+ -3608 -29413 4678 0
+ -3700 -29407 4641 2
+ -3899 -29404 4497 2
+ -3803 -29410 4540 2
+ -3678 -29413 4618 2
+
+
+ 27658 11617 -322 0
+ 27692 11536 -286 2
+ 27776 11329 -338 2
+ 27740 11414 -417 2
+ 27687 11546 -384 2
+
+
+ -2705 -28959 7352 0
+ -2729 -28937 7430 2
+ -2844 -28880 7605 2
+ -2910 -28904 7491 2
+ -2771 -28942 7394 2
+
+
+ -15874 23873 -8837 0
+ -15942 23833 -8822 3
+ -16163 23707 -8761 3
+ -16069 23763 -8780 3
+ -15941 23838 -8811 3
+
+
+ -22981 137 19284 0
+ -23077 108 19168 2
+ -23073 27 19173 2
+ -22966 -8 19302 2
+ -22904 106 19376 2
+
+
+ -7340 25545 -13913 0
+ -7253 25554 -13941 2
+ -7179 25516 -14050 2
+ -7181 25466 -14139 2
+ -7294 25470 -14073 2
+ -7377 25507 -13963 2
+
+
+ 1932 28169 -10137 0
+ 2074 28188 -10055 2
+ 2162 28154 -10132 2
+ 2057 28120 -10250 2
+ 1942 28131 -10242 2
+
+
+ -2239 29202 6500 0
+ -2266 29182 6578 2
+ -2312 29124 6816 2
+ -2271 29149 6722 2
+ -2229 29185 6578 2
+
+
+ -24505 2604 17110 0
+ -24555 2505 17052 3
+ -24575 2383 17040 3
+ -24485 2402 17168 3
+ -24450 2531 17199 3
+
+
+ -20336 -21189 6121 0
+ -20347 -21152 6211 2
+ -20408 -21067 6302 2
+ -20487 -21004 6255 2
+ -20468 -21052 6154 2
+ -20397 -21137 6101 2
+
+
+ 4254 3683 -29468 0
+ 4574 3708 -29416 2
+ 4411 3692 -29443 2
+ 4306 3652 -29464 2
+
+
+ 4284 29586 2515 0
+ 4343 29586 2410 2
+ 4257 29610 2263 2
+ 4159 29616 2362 2
+ 4179 29604 2474 2
+
+
+ -26886 10733 7871 0
+ -26857 10721 7985 2
+ -26772 10821 8134 2
+ -26796 10837 8035 2
+ -26847 10809 7900 2
+
+
+ -13498 24234 -11425 0
+ -13603 24169 -11437 2
+ -13772 24084 -11415 2
+ -13704 24146 -11364 2
+ -13569 24214 -11383 2
+
+
+ 22043 16210 -12301 0
+ 21987 16242 -12359 3
+ 21917 16376 -12307 3
+ 21981 16378 -12190 3
+ 21948 16374 -12256 3
+ 21996 16289 -12282 3
+
+
+ 22450 -6144 -18928 0
+ 22339 -6114 -19068 2
+ 22394 -5962 -19052 2
+ 22453 -5946 -18987 2
+ 22468 -6083 -18926 2
+
+
+ 20013 16577 -14989 0
+ 20065 16571 -14926 2
+ 20205 16488 -14829 2
+ 20157 16444 -14943 2
+ 20033 16517 -15028 2
+
+
+ 8227 28696 2972 0
+ 8212 28719 2784 2
+ 8113 28748 2779 2
+ 8047 28756 2886 2
+ 8158 28716 2972 2
+
+
+ -6380 29120 -3367 0
+ -6408 29102 -3469 2
+ -6521 29059 -3610 2
+ -6539 29070 -3486 2
+ -6438 29107 -3369 2
+
+
+ 23793 -10289 15101 0
+ 23699 -10405 15169 2
+ 23686 -10502 15121 2
+ 23780 -10446 15013 2
+ 23819 -10349 15019 2
+
+
+ 18853 -3180 23118 0
+ 18901 -3297 23063 2
+ 18968 -3281 23010 2
+ 18932 -3124 23061 2
+ 18895 -3044 23102 2
+
+
+ -2898 29718 2905 0
+ -2792 29737 2818 2
+ -2798 29752 2644 2
+ -2893 29738 2699 2
+ -2913 29722 2848 2
+
+
+ 4133 24673 -16558 0
+ 4155 24634 -16610 2
+ 4106 24558 -16734 2
+ 4025 24530 -16795 2
+ 4068 24641 -16622 2
+
+
+ -17359 23518 6748 0
+ -17465 23458 6687 2
+ -17532 23383 6774 2
+ -17444 23419 6873 2
+ -17362 23483 6864 2
+
+
+ 24745 -5658 -15990 0
+ 24675 -5633 -16106 2
+ 24627 -5515 -16219 2
+ 24669 -5498 -16162 2
+ 24723 -5579 -16051 2
+
+
+ -6134 29314 -1752 0
+ -6252 29288 -1762 2
+ -6418 29255 -1723 2
+ -6342 29275 -1665 2
+ -6198 29304 -1692 2
+
+
+ -18455 -22892 5946 0
+ -18536 -22842 5888 3
+ -18625 -22804 5752 3
+ -18572 -22857 5713 3
+ -18496 -22884 5851 3
+
+
+ 7506 28869 -3200 0
+ 7392 28904 -3154 2
+ 7455 28902 -3013 2
+ 7565 28873 -3018 2
+ 7586 28854 -3142 2
+
+
+ -19149 -22531 5067 0
+ -19218 -22464 5106 2
+ -19374 -22341 5054 2
+ -19308 -22407 5013 2
+ -19200 -22493 5043 2
+
+
+ -11154 10714 -25706 0
+ -11240 10578 -25725 2
+ -11378 10594 -25658 2
+ -11339 10688 -25636 2
+
+
+ -11977 -26541 7220 0
+ -11942 -26527 7327 2
+ -11921 -26490 7494 2
+ -12001 -26474 7422 2
+ -12012 -26509 7281 2
+
+
+ 12975 18669 19573 0
+ 12986 18730 19508 3
+ 12861 18855 19471 3
+ 12799 18802 19562 3
+ 12908 18705 19583 3
+
+
+ -10778 27815 3183 0
+ -10775 27829 3071 2
+ -10812 27825 2976 2
+ -10915 27778 3045 2
+ -10863 27780 3206 2
+
+
+ 5802 24352 16532 0
+ 5856 24373 16483 2
+ 5972 24457 16315 2
+ 5899 24444 16362 2
+ 5808 24383 16484 2
+
+
+ 10271 19027 20796 0
+ 10166 18984 20887 2
+ 10252 18927 20896 2
+ 10390 18890 20862 2
+ 10365 18962 20809 2
+
+
+ -3812 -7158 -28883 0
+ -3923 -7135 -28874 2
+ -3910 -7011 -28906 2
+ -3733 -7013 -28929 2
+ -3745 -7106 -28905 2
+
+
+ -26344 13706 4261 0
+ -26392 13637 4185 3
+ -26439 13541 4200 3
+ -26435 13510 4322 3
+ -26361 13649 4335 3
+
+
+ 4332 -21849 -20096 0
+ 4358 -21992 -19934 2
+ 4207 -21972 -19989 2
+ 4236 -21901 -20060 2
+
+
+ 11385 17811 21287 0
+ 11313 17770 21360 2
+ 11297 17649 21468 2
+ 11391 17660 21410 2
+ 11419 17767 21306 2
+
+
+ -25127 12810 -10224 0
+ -25152 12740 -10250 2
+ -25207 12608 -10277 2
+ -25238 12542 -10283 2
+ -25154 12745 -10240 2
+
+
+ 12061 -19379 -19468 0
+ 12066 -19320 -19523 2
+ 12195 -19209 -19552 2
+ 12252 -19233 -19494 2
+ 12153 -19341 -19448 2
+
+
+ 14601 -4888 -25747 0
+ 14568 -4993 -25746 2
+ 14427 -5040 -25816 2
+ 14403 -4973 -25842 2
+ 14511 -4900 -25796 2
+
+
+ 3182 28027 10215 0
+ 3267 28052 10121 2
+ 3204 28102 10002 2
+ 3120 28082 10082 2
+ 3120 28037 10207 2
+
+
+ 24760 -13205 -10611 0
+ 24808 -13122 -10602 2
+ 24903 -12966 -10571 2
+ 24892 -13015 -10537 2
+ 24812 -13138 -10571 2
+
+
+ 22676 -468 -19636 0
+ 22732 -514 -19570 2
+ 22714 -646 -19588 2
+ 22638 -667 -19674 2
+ 22633 -508 -19685 2
+
+
+ -8077 26065 -12464 0
+ -8053 26040 -12533 2
+ -8030 25957 -12718 2
+ -8085 25964 -12670 2
+ -8098 26027 -12530 2
+
+
+ -16783 -24152 5918 0
+ -16710 -24223 5833 2
+ -16592 -24312 5802 2
+ -16622 -24273 5877 2
+ -16720 -24192 5930 2
+
+
+ 3471 29597 3461 0
+ 3568 29591 3416 2
+ 3608 29605 3248 2
+ 3528 29615 3245 2
+ 3487 29604 3383 2
+
+
+ -23913 14805 -10440 0
+ -23958 14729 -10443 2
+ -24076 14600 -10353 2
+ -24045 14666 -10331 2
+ -23953 14772 -10394 2
+
+
+ -13537 24149 -11558 0
+ -13615 24102 -11564 2
+ -13770 24029 -11533 2
+ -13751 24067 -11476 2
+ -13618 24129 -11503 2
+
+
+ 25723 -3019 -15140 0
+ 25725 -3100 -15120 2
+ 25701 -3299 -15119 2
+ 25688 -3244 -15152 2
+ 25703 -3094 -15159 2
+
+
+ 18791 -8648 -21728 0
+ 18744 -8620 -21779 2
+ 18643 -8526 -21903 2
+ 18717 -8493 -21853 2
+ 18790 -8572 -21759 2
+
+
+ -8993 -28620 -183 0
+ -8904 -28647 -233 2
+ -8756 -28693 -211 2
+ -8757 -28693 -159 2
+ -8896 -28650 -131 2
+
+
+ -8768 -28641 -1673 0
+ -8745 -28654 -1578 2
+ -8777 -28652 -1427 2
+ -8847 -28628 -1473 2
+ -8831 -28625 -1626 2
+
+
+ 16062 838 25324 0
+ 16111 858 25292 3
+ 16278 941 25182 3
+ 16195 931 25236 3
+ 16079 876 25312 3
+
+
+ -26157 14015 4405 0
+ -26187 13948 4434 2
+ -26264 13777 4517 2
+ -26242 13824 4499 2
+ -26185 13951 4441 2
+
+
+ 21813 15801 -13211 0
+ 21811 15743 -13282 2
+ 21759 15677 -13446 2
+ 21748 15724 -13407 2
+ 21774 15796 -13281 2
+
+
+ -19641 22184 4702 0
+ -19717 22128 4647 3
+ -19827 22011 4732 3
+ -19775 22051 4761 3
+ -19697 22134 4702 3
+
+
+ 15005 -1299 -25945 0
+ 14946 -1352 -25977 2
+ 14822 -1393 -26046 2
+ 14814 -1291 -26055 2
+ 14947 -1268 -25980 2
+
+
+ -10453 11094 -25839 0
+ -10386 11051 -25885 2
+ -10387 10949 -25927 2
+ -10538 10922 -25878 2
+ -10506 11030 -25845 2
+
+
+ -26735 12315 5795 0
+ -26781 12233 5756 2
+ -26818 12106 5853 2
+ -26783 12153 5915 2
+ -26743 12273 5848 2
+
+
+ -16802 23231 -8833 0
+ -16821 23187 -8911 3
+ -16960 23063 -8969 3
+ -16927 23096 -8947 3
+ -16826 23192 -8889 3
+
+
+ 14422 -5109 -25805 0
+ 14343 -5223 -25826 2
+ 14218 -5259 -25888 2
+ 14275 -5196 -25869 2
+ 14387 -5111 -25824 2
+
+
+ 10064 -5982 -27621 0
+ 9996 -6042 -27633 2
+ 9837 -6118 -27673 2
+ 9853 -6071 -27678 2
+ 9984 -6001 -27646 2
+
+
+ 24783 -4317 -16345 0
+ 24789 -4391 -16317 2
+ 24747 -4466 -16360 2
+ 24679 -4341 -16496 2
+ 24735 -4327 -16415 2
+
+
+ -13180 26791 2922 0
+ -13128 26823 2864 2
+ -13126 26839 2717 2
+ -13216 26793 2737 2
+ -13242 26766 2870 2
+
+
+ -1749 25344 15957 0
+ -1843 25298 16019 2
+ -1724 25220 16156 2
+ -1727 25278 16063 2
+
+
+ -26328 14008 -3259 0
+ -26355 13942 -3321 2
+ -26421 13795 -3407 2
+ -26407 13829 -3380 2
+ -26355 13947 -3303 2
+
+
+ 24089 7261 -16340 0
+ 24137 7079 -16350 2
+ 24066 7087 -16451 2
+ 24046 7223 -16419 2
+
+
+ -7194 13999 25540 0
+ -7065 14003 25573 2
+ -7046 14131 25508 2
+ -7177 14118 25479 2
+
+
+ -24613 17122 1025 0
+ -24616 17111 1133 3
+ -24647 17056 1271 3
+ -24636 17071 1274 3
+ -24605 17125 1139 3
+
+
+ 20152 -5943 21414 0
+ 20130 -6048 21406 2
+ 20152 -6167 21351 2
+ 20197 -6130 21319 2
+ 20191 -5970 21371 2
+
+
+ -1915 23677 -18322 0
+ -2006 23657 -18339 2
+ -2179 23660 -18316 2
+ -2137 23675 -18301 2
+ -1995 23680 -18310 2
+
+
+ -23760 17289 6048 0
+ -23713 17329 6115 2
+ -23624 17450 6118 2
+ -23604 17477 6114 2
+ -23716 17330 6101 2
+
+
+ -14558 23775 -11081 0
+ -14543 23744 -11167 2
+ -14555 23670 -11309 2
+ -14595 23665 -11268 2
+ -14591 23734 -11126 2
+
+
+ -12479 24643 -11704 0
+ -12534 24593 -11752 2
+ -12686 24504 -11774 2
+ -12669 24530 -11738 2
+ -12549 24604 -11711 2
+
+
+ 5264 29534 -120 0
+ 5346 29519 -241 2
+ 5223 29540 -301 2
+ 5181 29549 -141 2
+
+
+ 13262 -5908 -26253 0
+ 13197 -5980 -26269 2
+ 13060 -6036 -26325 2
+ 13067 -5982 -26334 2
+ 13198 -5922 -26282 2
+
+
+ -20288 22087 756 0
+ -20269 22106 675 2
+ -20387 22002 550 2
+ -20358 22025 660 2
+
+
+ 19086 -2847 22970 0
+ 19124 -2792 22945 2
+ 19150 -2643 22941 2
+ 19104 -2610 22983 2
+ 19082 -2759 22984 2
+
+
+ -2873 28899 7523 0
+ -3006 28886 7523 2
+ -2992 28856 7640 2
+ -2848 28868 7650 2
+
+
+ 15596 18597 -17633 0
+ 15663 18554 -17619 2
+ 15752 18439 -17660 2
+ 15707 18421 -17718 2
+ 15641 18517 -17677 2
+
+
+ -28925 7951 348 0
+ -28916 7978 426 3
+ -28881 8099 542 3
+ -28882 8098 507 3
+ -28906 8019 355 3
+
+
+ 9541 23385 16190 0
+ 9539 23335 16263 3
+ 9618 23226 16371 3
+ 9637 23245 16333 3
+ 9584 23342 16226 3
+
+
+ 29210 473 -6823 0
+ 29225 550 -6751 2
+ 29256 585 -6613 2
+ 29254 529 -6626 2
+ 29224 461 -6764 2
+
+
+ -25829 15180 1561 0
+ -25833 15182 1475 2
+ -25856 15158 1300 2
+ -25855 15158 1331 2
+ -25835 15177 1479 2
+
+
+ -20000 22355 530 0
+ -20025 22333 455 2
+ -20094 22274 312 2
+ -20109 22260 359 2
+ -20045 22315 482 2
+
+
+ -444 -28368 9750 0
+ -392 -28333 9853 2
+ -553 -28311 9907 2
+ -531 -28358 9775 2
+
+
+ 2286 29384 5600 0
+ 2178 29406 5527 2
+ 2114 29387 5651 2
+ 2212 29368 5710 2
+
+
+ -9750 11346 -26004 0
+ -9636 11283 -26074 2
+ -9729 11192 -26078 2
+ -9817 11257 -26018 2
+
+
+ 29357 1075 -6086 0
+ 29383 1063 -5961 2
+ 29386 930 -5968 2
+ 29361 950 -6086 2
+
+
+ -4180 -7285 -28800 0
+ -4276 -7279 -28788 2
+ -4264 -7212 -28806 2
+ -4091 -7177 -28840 2
+ -4112 -7256 -28817 2
+
+
+ 21812 -2819 -20403 0
+ 21855 -3035 -20326 2
+ 21825 -2974 -20367 2
+ 21786 -2842 -20427 2
+
+
+ -6475 29293 -129 0
+ -6612 29262 -75 2
+ -6578 29270 27 2
+ -6448 29299 -30 2
+
+
+ -9851 -28219 2574 0
+ -9871 -28201 2699 2
+ -9994 -28163 2638 2
+ -9940 -28192 2525 2
+
+
+ 6163 -10670 -27353 0
+ 6247 -10640 -27345 2
+ 6239 -10762 -27299 2
+ 6109 -10797 -27315 2
+
+
+ 24033 10600 14493 0
+ 24032 10539 14540 2
+ 24028 10423 14630 2
+ 24057 10407 14593 2
+ 24056 10526 14509 2
+
+
+ -10404 28061 2080 0
+ -10572 28003 2015 2
+ -10557 28003 2098 2
+ -10408 28055 2142 2
+
+
+ -6287 25435 -14613 0
+ -6462 25370 -14650 3
+ -6495 25390 -14600 3
+ -6386 25444 -14554 3
+
+
+ 3313 24533 16946 0
+ 3385 24479 17010 2
+ 3522 24487 16969 2
+ 3439 24536 16917 2
+
+
+ -17749 22168 9672 0
+ -17804 22146 9621 2
+ -17938 22062 9566 2
+ -17903 22076 9599 2
+ -17793 22145 9644 2
+
+
+ -24211 14614 -10014 0
+ -24256 14513 -10051 2
+ -24317 14469 -9967 2
+ -24240 14620 -9934 2
+
+
+ 6168 20534 20984 0
+ 6246 20515 20979 2
+ 6401 20506 20942 2
+ 6387 20517 20935 2
+ 6239 20536 20960 2
+
+
+ 25249 3517 -15816 0
+ 25303 3462 -15741 2
+ 25271 3358 -15814 2
+ 25210 3456 -15891 2
+
+
+ 24510 6812 -15901 0
+ 24507 6742 -15936 2
+ 24460 6643 -16049 2
+ 24453 6659 -16053 2
+ 24485 6769 -15959 2
+
+
+ 8900 28579 2013 0
+ 8872 28597 1868 2
+ 8774 28626 1885 2
+ 8822 28603 2014 2
+
+
+ -19110 -22514 5287 0
+ -19244 -22402 5271 2
+ -19210 -22449 5198 2
+ -19133 -22517 5191 2
+
+
+ -26431 12476 6763 0
+ -26484 12303 6875 2
+ -26463 12328 6907 2
+ -26435 12448 6801 2
+
+
+ -6923 29146 -1603 0
+ -6934 29136 -1738 2
+ -7020 29115 -1739 2
+ -7008 29127 -1586 2
+
+
+ -7322 29032 -1885 0
+ -7415 29003 -1956 2
+ -7499 28987 -1872 2
+ -7383 29021 -1818 2
+
+
+ 3874 29626 2697 0
+ 4032 29612 2626 2
+ 3970 29623 2587 2
+ 3830 29635 2662 2
+
+
+ -20399 -10562 19296 0
+ -20446 -10508 19275 3
+ -20549 -10426 19211 3
+ -20545 -10458 19198 3
+ -20473 -10519 19241 3
+
+
+ -12040 -26645 6714 0
+ -11949 -26652 6846 2
+ -12006 -26618 6881 2
+ -12085 -26621 6730 2
+
+
+ -8141 28851 -1154 0
+ -8185 28832 -1303 2
+ -8252 28814 -1284 2
+ -8206 28833 -1135 2
+
+
+ -26611 11542 7659 0
+ -26699 11385 7586 2
+ -26673 11408 7644 2
+ -26603 11533 7698 2
+
+
+ -25420 7629 13987 0
+ -25396 7510 14095 2
+ -25357 7594 14119 2
+ -25378 7674 14038 2
+
+
+ -361 26098 14791 0
+ -371 26034 14902 2
+ -317 26006 14952 2
+ -291 26088 14810 2
+
+
+ -10298 18382 21356 0
+ -10168 18355 21441 2
+ -10119 18401 21425 2
+ -10266 18414 21344 2
+
+
+ -6714 29188 -1727 0
+ -6808 29164 -1756 2
+ -6881 29154 -1648 2
+ -6767 29180 -1655 2
+
+
+ -14486 -9145 -24628 0
+ -14593 -9168 -24556 2
+ -14593 -9096 -24583 2
+ -14489 -9056 -24659 2
+
+
+ -12116 27417 1220 0
+ -12261 27347 1354 2
+ -12188 27380 1337 2
+
+
+ 12149 -27337 -2254 0
+ 12141 -27334 -2336 2
+ 12232 -27288 -2395 2
+ 12218 -27307 -2242 2
+
+
+ 4304 29609 2188 0
+ 4256 29629 2003 2
+ 4218 29626 2127 2
+
+
+ -12276 24972 -11211 0
+ -12280 24929 -11301 2
+ -12410 24872 -11286 2
+ -12336 24932 -11236 2
+
+
+ 3993 24360 17048 0
+ 4099 24362 17021 2
+ 4044 24442 16919 2
+ 3988 24414 16972 2
+
+
+ 4361 29555 2736 0
+ 4323 29569 2645 2
+ 4207 29585 2647 2
+ 4282 29565 2748 2
+
+
+ -18479 -23127 4866 0
+ -18531 -23060 4984 2
+ -18592 -23025 4918 2
+ -18533 -23087 4847 2
+
+
+ 2259 21690 20602 0
+ 2422 21730 20541 3
+ 2371 21760 20515 3
+ 2252 21712 20579 3
+
+
+ 20331 14288 -16807 0
+ 20444 14226 -16723 2
+ 20446 14175 -16764 2
+ 20330 14262 -16831 2
+
+
+ -16786 -24244 5517 0
+ -16799 -24258 5419 2
+ -16684 -24335 5429 2
+ -16720 -24294 5499 2
+
+
+ -1657 25010 16486 0
+ -1764 25041 16427 2
+ -1791 24982 16513 2
+ -1685 24973 16538 2
+
+
+ -1331 -20857 -21523 0
+ -1363 -20770 -21604 2
+ -1351 -20739 -21635 2
+ -1257 -20781 -21600 2
+
+
+ -26552 5728 12735 0
+ -26466 5718 12917 2
+ -26507 5748 12819 2
+
+
+ -11118 27856 637 0
+ -11288 27788 642 2
+ -11206 27820 705 2
+
+
+ 2831 -28218 9783 0
+ 2873 -28191 9850 2
+ 2774 -28176 9920 2
+ 2755 -28216 9812 2
+
+
+ 23950 2362 -17911 0
+ 23970 2183 -17907 2
+ 23926 2265 -17956 2
+
+
+ 29304 688 -6390 0
+ 29307 537 -6387 2
+ 29289 555 -6469 2
+
+
+ -9197 -28136 4878 0
+ -9356 -28068 4963 2
+ -9281 -28105 4899 2
+
+
+ -10259 28140 1705 0
+ -10315 28115 1768 2
+ -10253 28132 1869 2
+ -10219 28149 1793 2
+
+
+ 29280 766 -6487 0
+ 29314 808 -6329 2
+ 29291 712 -6445 2
+
+
+ 6865 26520 12229 0
+ 6827 26505 12283 2
+ 6870 26449 12379 2
+ 6920 26480 12286 2
+
+
+ 13499 -19327 -18554 0
+ 13544 -19192 -18661 2
+ 13557 -19272 -18568 2
+
+
+ 16732 5918 24187 0
+ 16609 6049 24240 3
+ 16659 5965 24226 3
+
+
+ 13670 -4696 -26288 0
+ 13524 -4767 -26351 2
+ 13584 -4682 -26336 2
+
+
+ 2313 23926 -17950 0
+ 2152 23910 -17991 2
+ 2232 23957 -17919 2
+
+
+ 3781 28274 9290 0
+ 3874 28308 9144 2
+ 3783 28302 9202 2
+
+
+ 25584 3122 -15352 0
+ 25499 3096 -15499 2
+ 25516 3155 -15460 2
+
+
+ 29702 3744 -1936 0
+ 29719 3591 -1971 2
+ 29704 3680 -2026 2
+
+
+ 24789 6574 -15566 0
+ 24854 6405 -15532 2
+ 24802 6507 -15572 2
+
+
+ -29247 6430 1802 0
+ -29258 6345 1924 3
+ -29241 6417 1947 3
+
+
+ -6095 14636 25468 0
+ -6230 14541 25490 2
+ -6133 14548 25510 2
+
+
+ -10821 10826 -25801 0
+ -10988 10803 -25740 2
+ -10923 10844 -25751 2
+
+
+ 29023 590 -7570 0
+ 29057 585 -7441 2
+ 29038 490 -7520 2
+
+
+ 23976 5439 -17192 0
+ 24015 5262 -17193 2
+ 23982 5349 -17211 2
+
+
+ 5247 29038 -5412 0
+ 5148 29074 -5312 2
+ 5174 29074 -5284 2
+ 5271 29042 -5365 2
+
+
+ -18202 -23335 4919 0
+ -18187 -23330 4992 2
+ -18249 -23268 5060 2
+ -18247 -23290 4960 2
+
+
+ 5756 -9056 -28015 0
+ 5813 -9140 -27976 2
+ 5683 -9150 -27999 2
+
+
+ -11472 -27071 5962 0
+ -11561 -27004 6094 2
+ -11547 -27029 6008 2
+
+
+ -12893 26395 6088 0
+ -12940 26398 5975 2
+ -12990 26348 6087 2
+
+
+ 5886 -8242 -28239 0
+ 5912 -8076 -28281 2
+ 5936 -8143 -28257 2
+
+
+ 8245 18657 21999 0
+ 8220 18598 22058 2
+ 8293 18532 22086 2
+ 8295 18602 22026 2
+
+
+ 5232 21275 20494 0
+ 5290 21152 20606 2
+ 5277 21221 20538 2
+
+
+ -16253 -24546 5776 0
+ -16262 -24567 5656 2
+ -16186 -24610 5689 2
+ -16198 -24587 5751 2
+
+
+ 9502 25942 11694 0
+ 9667 25877 11702 3
+ 9592 25912 11687 3
+
+
+ -12159 27406 1045 0
+ -12300 27340 1104 2
+ -12212 27379 1116 2
+
+
+ 5425 21100 20624 0
+ 5560 21006 20684 2
+ 5490 21064 20644 2
+
+
+ 3389 22127 19973 0
+ 3245 22196 19920 3
+ 3273 22154 19962 3
+
+
+ -29998 -271 -211 0
+ -29997 -374 -238 2
+ -29998 -330 -114 2
+
+
+ -6646 3953 28986 0
+ -6492 3918 29026 2
+ -6558 3982 29003 2
+
+
+ 17776 -4397 -23763 0
+ 17651 -4491 -23839 2
+ 17710 -4430 -23806 2
+
+
+ 15919 -2901 -25262 0
+ 15833 -3014 -25303 2
+ 15835 -2911 -25313 2
+
+
+ 10276 18702 21087 0
+ 10310 18587 21171 2
+ 10359 18635 21106 2
+
+
+ -27182 9729 8156 0
+ -27158 9666 8308 2
+ -27158 9737 8225 2
+
+
+ -5062 29557 -877 0
+ -5213 29531 -862 2
+ -5111 29550 -815 2
+
+
+ 5323 -9639 -27906 0
+ 5417 -9646 -27886 2
+ 5302 -9737 -27876 2
+
+
+ 9566 21962 -18060 0
+ 9646 21902 -18090 2
+ 9500 21989 -18062 2
+
+
+ 7782 19198 21700 0
+ 7880 19084 21765 2
+ 7857 19158 21708 2
+
+
+ -25374 8277 13699 0
+ -25337 8409 13687 2
+ -25385 8366 13624 2
+
+
+ -21077 21320 1096 0
+ -21183 21219 1014 2
+ -21130 21269 1084 2
+
+
+ 24281 -1036 -17589 0
+ 24260 -1202 -17607 2
+ 24259 -1106 -17615 2
+
+
+ -22788 37 19512 0
+ -22873 -15 19412 2
+ -22790 -35 19509 2
+
+
+ 5240 28832 -6422 0
+ 5171 28868 -6319 2
+ 5290 28837 -6358 2
+
+
+ -7468 -28825 -3652 0
+ -7341 -28848 -3725 2
+ -7367 -28853 -3642 2
+
+
+ 24788 6981 -15389 0
+ 24760 6890 -15474 2
+ 24733 7001 -15468 2
+
+
+ -23208 -6 19010 0
+ -23288 -88 18912 2
+ -23214 -74 19003 2
+
+
+ -2403 29024 7200 0
+ -2397 28986 7353 2
+ -2360 29012 7263 2
+
+
+ -8354 27070 9869 0
+ -8323 27133 9722 2
+ -8362 27102 9775 2
+
+
+ 25819 2792 -15019 0
+ 25887 2702 -14919 2
+ 25831 2718 -15012 2
+
+
+ -13037 26839 3117 0
+ -13001 26872 2978 2
+ -13072 26830 3050 2
+
+
+ 19424 15377 -16920 0
+ 19517 15245 -16932 2
+ 19453 15309 -16947 2
+
+
+ 25368 -2667 -15790 0
+ 25352 -2805 -15793 2
+ 25327 -2723 -15847 2
+
+
+ -27385 6432 10424 0
+ -27368 6315 10540 2
+ -27374 6382 10485 2
+
+
+ -16689 -24298 5573 0
+ -16589 -24353 5632 2
+ -16633 -24311 5683 2
+
+
+ 7818 28361 5876 0
+ 7674 28412 5820 2
+ 7742 28383 5870 2
+
+
+ -1083 23630 -18452 0
+ -1033 23552 -18554 2
+ -1125 23582 -18510 2
+
+
+ 25414 6393 -14604 0
+ 25373 6287 -14720 2
+ 25384 6357 -14672 2
+
+
+ -11631 906 -27639 0
+ -11511 997 -27686 2
+ -11560 917 -27668 2
+
+
+ 3474 212 29797 0
+ 3415 89 29805 2
+ 3513 139 29793 2
+
+
+ 2829 27930 10580 0
+ 2846 27978 10446 2
+ 2777 27958 10519 2
+
+
+ -18229 -23261 5161 0
+ -18349 -23176 5118 2
+ -18270 -23241 5106 2
+
+
+ 1852 23822 18140 0
+ 1727 23778 18210 2
+ 1828 23780 18198 2
+
+
+ 17469 17022 -17466 0
+ 17585 16916 -17454 2
+ 17523 16949 -17484 2
+
+
+ -13668 26130 5512 0
+ -13785 26072 5496 2
+ -13724 26088 5575 2
+
+
+ -16825 22385 -10761 0
+ -16894 22325 -10779 2
+ -16778 22432 -10738 2
+
+
+ -17801 -23670 4779 0
+ -17908 -23575 4850 2
+ -17869 -23615 4798 2
+
+
+ -16972 24643 -2166 0
+ -17022 24596 -2304 3
+ -17028 24599 -2226 3
+
+
+ -29510 -1408 5213 0
+ -29525 -1510 5096 2
+ -29513 -1487 5175 2
+
+
+ -8023 14394 25068 0
+ -8091 14428 25028 2
+ -8076 14312 25099 2
+
+
+ 18663 8080 22054 0
+ 18588 8173 22084 2
+ 18557 8137 22123 2
+
+
+ 20234 -5953 -21335 0
+ 20185 -5823 -21416 2
+ 20216 -5880 -21371 2
+
+
+ 9465 -4873 -28048 0
+ 9403 -5018 -28043 2
+ 9413 -4932 -28055 2
+
+
+ 11849 -3988 -27271 0
+ 11770 -4094 -27289 2
+ 11767 -3994 -27305 2
+
+
+ 19173 8661 21387 0
+ 19234 8622 21348 2
+ 19118 8709 21417 2
+
+
+ -25383 8079 13799 0
+ -25391 7950 13860 2
+ -25359 8044 13865 2
+
+
+ -947 23612 -18482 0
+ -828 23562 -18551 2
+ -907 23559 -18551 2
+
+
+ -20303 -21276 5923 0
+ -20379 -21235 5813 2
+ -20315 -21291 5831 2
+
+
+ -3266 29707 2611 0
+ -3229 29723 2473 2
+ -3294 29712 2520 2
+
+
+ 29437 5643 -1268 0
+ 29461 5529 -1224 2
+ 29455 5538 -1306 2
+
+
+ 5941 -8348 -28196 0
+ 5974 -8425 -28166 2
+ 5856 -8419 -28193 2
+
+
+ 8674 28665 1747 0
+ 8737 28650 1683 2
+ 8635 28683 1642 2
+
+
+ 12119 -27290 -2892 0
+ 12251 -27236 -2846 2
+ 12183 -27269 -2830 2
+
+
+ 16774 7079 -23844 0
+ 16856 6955 -23822 2
+ 16783 7009 -23858 2
+
+
+ 20757 13260 17126 0
+ 20820 13132 17148 2
+ 20807 13220 17097 2
+
+
+ -23106 319 19132 0
+ -23120 166 19116 2
+ -23097 241 19143 2
+
+
+ 28708 8390 -2334 0
+ 28749 8273 -2247 2
+ 28731 8314 -2321 2
+
+
+ -17143 22854 -9157 0
+ -17199 22805 -9172 3
+ -17088 22907 -9125 3
+
+
+ 24593 -4420 -16602 0
+ 24535 -4339 -16710 2
+ 24577 -4340 -16647 2
+
+
+ -5670 29343 -2618 0
+ -5794 29319 -2618 2
+ -5724 29338 -2549 2
+
+
+ 29384 4265 -4286 0
+ 29403 4123 -4297 2
+ 29387 4196 -4338 2
+
+
+ -26493 13413 -4266 0
+ -26420 13542 -4314 3
+ -26461 13463 -4305 3
+
+
+ -12215 8751 25965 0
+ -12165 8841 25959 2
+ -12275 8798 25921 2
+
+
+ 942 -9821 -28331 0
+ 815 -9781 -28349 2
+ 833 -9745 -28361 2
+
+
+ 5791 -10962 -27318 0
+ 5863 -11003 -27287 2
+ 5762 -11059 -27286 2
+
+
+ -16110 -24557 6118 0
+ -16165 -24556 5978 2
+ -16113 -24571 6055 2
+
+
+ 24603 7780 -15303 0
+ 24622 7650 -15338 2
+ 24581 7731 -15363 2
+
+
+ -11587 7787 26554 0
+ -11664 7865 26497 2
+ -11661 7765 26528 2
+
+
+ -16566 24953 -1701 0
+ -16600 24921 -1840 3
+ -16615 24916 -1768 3
+
+
+ -10538 27951 2769 0
+ -10651 27901 2840 2
+ -10569 27933 2838 2
+
+
+ -26227 14265 -2946 0
+ -26256 14184 -3072 2
+ -26248 14216 -2996 2
+
+
+ -29996 -410 275 0
+ -29995 -474 271 2
+ -29995 -378 373 2
+
+
+ -1328 24397 17407 0
+ -1416 24329 17495 2
+ -1337 24351 17471 2
+
+
+ 28640 5411 -7103 0
+ 28656 5287 -7133 2
+ 28631 5368 -7174 2
+
+
+ 2879 27986 10415 0
+ 2923 28031 10282 2
+ 2875 28017 10334 2
+
+
+ -10402 -26170 10341 0
+ -10542 -26130 10301 2
+ -10478 -26154 10305 2
+
+
+ -10281 28087 2329 0
+ -10387 28045 2363 2
+ -10309 28069 2413 2
+
+
+ 2742 27846 10820 0
+ 2827 27881 10709 2
+ 2757 27874 10743 2
+
+
+ -3438 -29243 -5748 0
+ -3395 -29223 -5873 2
+ -3366 -29241 -5797 2
+
+
+ -26723 12841 4584 0
+ -26789 12731 4504 2
+ -26760 12774 4551 2
+
+
+ -1401 24087 17828 0
+ -1402 24027 17909 2
+ -1313 24053 17881 2
+
+
+ 5935 -7944 -28314 0
+ 5950 -7799 -28351 2
+ 5961 -7846 -28336 2
+
+
+ 22691 -404 -19620 0
+ 22781 -444 -19515 2
+ 22707 -444 -19601 2
+
+
+ -615 23609 -18500 0
+ -642 23547 -18578 2
+ -715 23572 -18544 2
+
+
+ -7610 27327 9765 0
+ -7524 27336 9804 2
+ -7513 27370 9719 2
+
+
+ 3275 28106 9967 0
+ 3341 28140 9847 2
+ 3275 28132 9893 2
+
+
+ -1798 26125 -14637 0
+ -1923 26078 -14706 2
+ -1863 26103 -14669 2
+
+
+ 3404 28154 9786 0
+ 3420 28188 9682 2
+ 3337 28185 9720 2
+
+
+ -19236 -22431 5182 0
+ -19331 -22350 5178 2
+ -19290 -22398 5119 2
+
+
+ 16386 -1104 25106 0
+ 16313 -1022 25156 2
+ 16289 -1074 25170 2
+
+
+ 19553 -4260 -22350 0
+ 19616 -4311 -22285 2
+ 19547 -4355 -22337 2
+
+
+ -22905 18425 5990 0
+ -22809 18529 6037 2
+ -22842 18494 6019 2
+
+
+ -12241 25010 -11164 0
+ -12358 24940 -11192 2
+ -12316 24982 -11146 2
+
+
+ -6089 -28902 -5253 0
+ -6055 -28888 -5370 2
+ -6012 -28910 -5299 2
+
+
+ 14736 -4824 -25682 0
+ 14693 -4930 -25687 2
+ 14653 -4867 -25721 2
+
+
+ 19044 17073 -15679 0
+ 19138 16965 -15682 2
+ 19074 17019 -15701 2
+
+
+ -16277 25021 3001 0
+ -16379 24963 2923 2
+ -16347 24978 2982 2
+
+
+ 3248 24619 16833 0
+ 3210 24543 16951 2
+ 3241 24575 16899 2
+
+
+ -19337 -22287 5420 0
+ -19319 -22272 5542 2
+ -19373 -22247 5453 2
+
+
+ 3510 24558 16869 0
+ 3557 24490 16958 2
+ 3593 24526 16899 2
+
+
+ -6842 29209 -35 0
+ -6965 29180 -20 2
+ -6900 29196 25 2
+
+
+ -15937 22907 -11013 0
+ -16056 22845 -10969 2
+ -16001 22884 -10968 2
+
+
+ 27779 11315 -526 0
+ 27730 11436 -549 2
+ 27739 11414 -505 2
+
+
+ -12034 25103 -11183 0
+ -12097 25045 -11243 2
+ -12138 25050 -11188 2
+
+
+ 11603 -4113 -27358 0
+ 11589 -4216 -27348 2
+ 11525 -4163 -27383 2
+
+
+ 12813 -2626 -26999 0
+ 12809 -2758 -26987 2
+ 12773 -2687 -27012 2
+
+
+ -25308 8431 13728 0
+ -25270 8388 13823 2
+ -25269 8477 13771 2
+
+
+ -25475 7114 14157 0
+ -25444 7234 14152 2
+ -25486 7172 14107 2
+
+
+ 13199 -12085 -24077 0
+ 13269 -11977 -24093 2
+ 13274 -12037 -24061 2
+
+
+ -14219 23894 -11265 0
+ -14304 23809 -11338 2
+ -14278 23849 -11286 2
+
+
+ 4551 -23163 -18514 0
+ 4580 -23240 -18410 2
+ 4531 -23215 -18454 2
+
+
+ 5199 -9999 -27803 0
+ 5274 -9989 -27792 2
+ 5195 -10081 -27774 2
+
+
+ -3465 -29255 -5667 0
+ -3515 -29268 -5572 2
+ -3541 -29246 -5667 2
+
+
+ 20448 -6320 21022 0
+ 20522 -6372 20935 2
+ 20511 -6309 20964 2
+
+
+ -11210 -27380 4968 0
+ -11277 -27333 5074 2
+ -11270 -27348 5004 2
+
+
+ -7114 29104 -1523 0
+ -7145 29090 -1648 2
+ -7171 29087 -1587 2
+
+
+ 11126 17559 21631 0
+ 11134 17448 21717 2
+ 11138 17492 21679 2
+
+
+ -17516 22482 -9368 0
+ -17553 22438 -9404 3
+ -17476 22529 -9329 3
+
+
+ 23571 -1939 -18457 0
+ 23503 -1905 -18547 2
+ 23540 -1864 -18504 2
+
+
+ -6394 -28910 -4832 0
+ -6421 -28885 -4944 2
+ -6353 -28909 -4893 2
+
+
+ 5794 26057 13692 0
+ 5738 26012 13800 2
+ 5796 26020 13762 2
+
+
+ -23934 17129 5813 0
+ -23966 17093 5783 2
+ -23887 17178 5861 2
+
+
+ -23357 -76 18827 0
+ -23413 -173 18756 2
+ -23372 -148 18808 2
+
+
+ 7231 -5628 -28566 0
+ 7114 -5606 -28600 2
+ 7178 -5572 -28591 2
+
+
+ 8011 -2165 28829 0
+ 7925 -2185 28852 3
+ 7967 -2257 28835 3
+
+
+ -17637 -23714 5158 0
+ -17745 -23644 5107 2
+ -17695 -23678 5120 2
+
+
+ 21913 -8820 18494 0
+ 21979 -8702 18471 2
+ 21945 -8748 18491 2
+
+
+ 9869 19293 20746 0
+ 9784 19255 20821 2
+ 9839 19231 20817 2
+
+
+ 22899 -4077 -18947 0
+ 22873 -4163 -18960 2
+ 22836 -4111 -19017 2
+
+
+ -14038 23901 -11476 0
+ -14145 23829 -11493 2
+ -14110 23868 -11455 2
+
+
+ 4353 24653 16531 0
+ 4422 24592 16603 2
+ 4434 24633 16540 2
+
+
+ -18051 -23470 4832 0
+ -18081 -23422 4950 2
+ -18091 -23428 4883 2
+
+
+ 28220 10019 -1806 0
+ 28243 9937 -1889 2
+ 28218 10009 -1886 2
+
+
+ -20490 -21140 5764 0
+ -20495 -21108 5864 2
+ -20539 -21089 5779 2
+
+
+ 3983 28240 9309 0
+ 3995 28275 9196 2
+ 3943 28269 9236 2
+
+
+ -18699 -22936 4930 0
+ -18790 -22869 4897 2
+ -18753 -22906 4861 2
+
+
+ 627 18932 23264 0
+ 543 18870 23316 2
+ 628 18877 23308 2
+
+
+ 19354 14991 17340 0
+ 19404 14893 17368 2
+ 19418 14939 17313 2
+
+
+ -28747 8411 1693 0
+ -28725 8461 1814 2
+ -28730 8457 1755 2
+
+
+ -8901 26791 10151 0
+ -8903 26830 10046 2
+ -8944 26816 10046 2
+
+
+ -1847 24835 16728 0
+ -1874 24782 16803 2
+ -1790 24801 16784 2
+
+
+ -10396 25971 10836 0
+ -10312 25983 10887 2
+ -10357 26004 10794 2
+
+
+ -1746 26561 13836 0
+ -1700 26507 13946 2
+ -1696 26534 13896 2
+
+
+ -16548 24985 -1391 0
+ -16518 24997 -1514 3
+ -16558 24974 -1470 3
+
+
+ -23092 1143 19117 0
+ -23121 1046 19087 2
+ -23072 1066 19145 2
+
+
+ -9616 27575 -6867 0
+ -9702 27557 -6819 3
+ -9621 27592 -6791 3
+
+
+ 37 -8773 -28689 0
+ -46 -8684 -28716 2
+ 24 -8708 -28708 2
+
+
+ -5877 24660 -16042 0
+ -5848 24597 -16149 2
+ -5889 24616 -16106 2
+
+
+ -7063 29124 1383 0
+ -7169 29100 1337 2
+ -7157 29101 1387 2
+
+
+ 9491 -28294 3062 0
+ 9579 -28259 3111 2
+ 9551 -28264 3151 2
+
+
+ -10563 28011 -1955 0
+ -10655 27974 -1986 2
+ -10653 27979 -1924 2
+
+
+ -23006 339 19251 0
+ -23057 259 19192 2
+ -23005 265 19253 2
+
+
+ 24368 17193 -3258 0
+ 24408 17126 -3310 3
+ 24354 17197 -3335 3
+
+
+ -8017 28176 6466 0
+ -8104 28140 6518 2
+ -8032 28155 6542 2
+
+
+ -26550 11424 8038 0
+ -26521 11404 8159 2
+ -26522 11440 8106 2
+
+
+ 28996 6412 -4254 0
+ 28967 6524 -4285 2
+ 28980 6495 -4237 2
+
+
+ -11839 8554 26204 0
+ -11778 8581 26223 2
+ -11885 8599 26169 2
+
+
+ -20098 -21617 5362 0
+ -20129 -21564 5463 2
+ -20147 -21562 5405 2
+
+
+ 21155 4033 -20886 0
+ 21195 3916 -20867 2
+ 21160 3950 -20896 2
+
+
+ 5515 20897 20806 0
+ 5618 20829 20847 2
+ 5581 20864 20822 2
+
+
+ -29988 -222 -832 0
+ -29990 -172 -771 2
+ -29987 -150 -871 2
+
+
+ 5034 26084 13938 0
+ 5055 26035 14022 2
+ 5109 26045 13984 2
+
+
+ 1691 19298 22907 0
+ 1602 19301 22911 2
+ 1683 19247 22951 2
+
+
+ 2119 26865 13182 0
+ 2003 26862 13207 2
+ 2061 26846 13231 2
+
+
+ 10789 18377 21116 0
+ 10686 18371 21174 2
+ 10748 18342 21167 2
+
+
+ -11870 -26301 8207 0
+ -11843 -26282 8308 2
+ -11908 -26268 8257 2
+
+
+ -18344 -23246 4807 0
+ -18428 -23172 4845 2
+ -18401 -23206 4787 2
+
+
+ -11295 25251 -11610 0
+ -11360 25193 -11673 2
+ -11375 25214 -11613 2
+
+
+ 6300 20443 21033 0
+ 6423 20429 21010 2
+ 6387 20448 21002 2
+
+
+ 29102 725 -7249 0
+ 29129 728 -7138 2
+ 29118 683 -7190 2
+
+
+ -29997 -152 -412 0
+ -29998 -130 -330 2
+ -29997 -78 -415 2
+
+
+ -28040 10545 1595 0
+ -28072 10474 1501 2
+ -28068 10478 1556 2
+
+
+ 11026 18001 21316 0
+ 10929 17970 21392 2
+ 10976 17971 21368 2
+
+
+ 24332 1794 -17457 0
+ 24364 1895 -17401 2
+ 24365 1826 -17407 2
+
+
+ 4781 16690 24466 0
+ 4685 16710 24471 2
+ 4717 16651 24505 2
+
+
+ 21656 -5891 -19908 0
+ 21677 -5775 -19919 2
+ 21693 -5813 -19891 2
+
+
+ -19012 -22658 5013 0
+ -19095 -22601 4959 2
+ -19054 -22639 4944 2
+
+
+ -25345 15903 2173 0
+ -25412 15797 2170 3
+ -25397 15818 2184 3
+
+
+ 22404 -4219 -19500 0
+ 22448 -4297 -19432 2
+ 22396 -4274 -19498 2
+
+
+ -10163 28146 2130 0
+ -10252 28117 2078 2
+ -10231 28120 2147 2
+
+
+ -725 25703 15454 0
+ -832 25722 15417 2
+ -809 25697 15461 2
+
+
+ 25446 6214 -14625 0
+ 25448 6119 -14661 2
+ 25420 6157 -14694 2
+
+
+ -18014 -23519 4728 0
+ -18082 -23452 4803 2
+ -18070 -23470 4757 2
+
+
+ 8350 18419 22159 0
+ 8436 18352 22182 2
+ 8428 18397 22148 2
+
+
+ -16265 24998 3250 0
+ -16354 24943 3223 2
+ -16343 24945 3268 2
+
+
+ -29435 3954 4235 0
+ -29442 3852 4278 2
+ -29432 3910 4298 2
+
+
+ 14345 -4396 -25979 0
+ 14343 -4516 -25959 2
+ 14326 -4471 -25976 2
+
+
+ -20159 -21497 5615 0
+ -20206 -21434 5683 2
+ -20217 -21441 5619 2
+
+
+ 17291 -23956 5209 0
+ 17268 -23996 5100 2
+ 17301 -23964 5141 2
+
+
+ 6171 20591 20926 0
+ 6279 20567 20918 2
+ 6254 20600 20893 2
+
+
+ -8736 -28700 -52 0
+ -8770 -28689 40 2
+ -8808 -28678 -12 2
+
+
+ -5134 25663 -14664 0
+ -5071 25629 -14746 2
+ -5121 25622 -14741 2
+
+
+ 23474 -4238 -18194 0
+ 23403 -4284 -18274 2
+ 23424 -4241 -18258 2
+
+
+ -12945 26676 4562 0
+ -12941 26693 4471 2
+ -12992 26655 4551 2
+
+
+ 11880 -13958 -23749 0
+ 11878 -13859 -23809 2
+ 11905 -13887 -23778 2
+
+
+ 9893 18457 21482 0
+ 9960 18385 21512 2
+ 9977 18416 21478 2
+
+
+ -14530 23658 -11366 0
+ -14565 23598 -11446 2
+ -14588 23609 -11393 2
+
+
+ -17616 -23753 5046 0
+ -17709 -23692 5009 2
+ -17676 -23719 4999 2
+
+
+ 25086 -5507 -15503 0
+ 25035 -5496 -15589 2
+ 25058 -5452 -15568 2
+
+
+ -15610 -24492 7515 0
+ -15622 -24508 7437 2
+ -15570 -24510 7538 2
+
+
+ -15472 22928 -11615 0
+ -15530 22877 -11639 2
+ -15545 22901 -11571 2
+
+
+ -12165 24913 -11461 0
+ -12131 24885 -11557 2
+ -12179 24873 -11533 2
+
+
+ 5310 21296 20452 0
+ 5331 21230 20516 2
+ 5377 21242 20491 2
+
+
+ 17800 23716 -4555 0
+ 17858 23655 -4640 3
+ 17827 23682 -4619 3
+
+
+ 18987 -4163 22851 0
+ 19043 -4074 22820 2
+ 18989 -4105 22860 2
+
+
+ -13833 24181 -11133 0
+ -13829 24134 -11240 2
+ -13850 24141 -11197 2
+
+
+ 6651 29245 -700 0
+ 6701 29234 -696 2
+ 6605 29254 -756 2
+
+
+ -25607 5901 14473 0
+ -25665 5849 14391 2
+ -25638 5846 14440 2
+
+
+ -19397 -22308 5108 0
+ -19396 -22283 5222 2
+ -19410 -22280 5180 2
+
+
+ -23259 -297 18946 0
+ -23312 -357 18879 2
+ -23273 -367 18927 2
+
+
+ -13405 24297 -11400 0
+ -13394 24263 -11486 2
+ -13444 24247 -11460 2
+
+
+ 25842 -4398 -14590 0
+ 25839 -4497 -14565 2
+ 25818 -4470 -14610 2
+
+
+ -25303 12454 -10231 0
+ -25360 12402 -10153 2
+ -25336 12443 -10161 2
+
+
+ -8255 26088 -12300 0
+ -8173 26082 -12367 2
+ -8229 26067 -12362 2
+
+
+ 6152 -8008 -28249 0
+ 6063 -7968 -28280 2
+ 6126 -7951 -28271 2
+
+
+ -25934 14888 2405 0
+ -25970 14841 2304 2
+ -25962 14849 2341 2
+
+
+ -6774 29199 -1229 0
+ -6789 29191 -1338 2
+ -6811 29188 -1297 2
+
+
+ -1560 24786 16830 0
+ -1570 24733 16907 2
+ -1517 24750 16886 2
+
+
+ -21338 21065 -960 0
+ -21383 21024 -863 3
+ -21364 21043 -882 3
+
+
+ -5625 24695 -16078 0
+ -5614 24654 -16145 2
+ -5678 24649 -16130 2
+
+
+ -26663 12045 6635 0
+ -26672 11975 6725 2
+ -26661 12013 6698 2
+
+
+ -27183 11286 5804 0
+ -27186 11232 5896 2
+ -27171 11276 5879 2
+
+
+ -20085 -21491 5891 0
+ -20148 -21425 5919 2
+ -20146 -21441 5868 2
+
+
+ 11920 -13784 -23831 0
+ 11942 -13686 -23876 2
+ 11957 -13714 -23853 2
+
+
+ -19179 -22536 4928 0
+ -19213 -22489 5011 2
+ -19226 -22490 4954 2
+
+
+ -355 23212 19002 0
+ -447 23223 18987 2
+ -427 23190 19027 2
+
+
+ 10541 18339 21273 0
+ 10463 18306 21341 2
+ 10505 18298 21326 2
+
+
+ -14382 25139 7820 0
+ -14472 25083 7836 2
+ -14434 25098 7857 2
+
+
+ -17775 -23685 4805 0
+ -17836 -23625 4875 2
+ -17826 -23641 4834 2
+
+
+ 15192 -711 -25859 0
+ 15156 -799 -25877 2
+ 15134 -752 -25892 2
+
+
+ -25173 6788 14841 0
+ -25170 6869 14808 2
+ -25200 6824 14777 2
+
+
+ 23886 -136 -18151 0
+ 23919 -196 -18106 2
+ 23881 -216 -18156 2
+
+
+ -17001 21978 11312 0
+ -17064 21907 11354 2
+ -17040 21917 11370 2
+
+
+ 11428 -4389 -27389 0
+ 11450 -4488 -27364 2
+ 11416 -4465 -27381 2
+
+
+ -14644 23549 -11447 0
+ -14691 23491 -11504 2
+ -14708 23502 -11460 2
+
+
+ 20716 -6655 20653 0
+ 20742 -6675 20621 2
+ 20731 -6583 20661 2
+
+
+ -27252 6392 10793 0
+ -27252 6313 10838 2
+ -27236 6338 10864 2
+
+
+ 8257 18817 21858 0
+ 8231 18761 21915 2
+ 8272 18744 21914 2
+
+
+ 17728 -4370 -23804 0
+ 17659 -4413 -23847 2
+ 17657 -4373 -23856 2
+
+
+ 7081 29143 -744 0
+ 7127 29133 -711 2
+ 7111 29134 -804 2
+
+
+ 20340 -6075 -21198 0
+ 20282 -6021 -21269 2
+ 20306 -6026 -21245 2
+
+
+ -10500 -27772 4297 0
+ -10487 -27765 4375 2
+ -10544 -27747 4351 2
+
+
+ -21551 16797 -12387 0
+ -21612 16772 -12313 2
+ -21592 16799 -12312 2
+
+
+ -23937 14156 -11253 0
+ -23897 14198 -11285 2
+ -23926 14126 -11313 2
+
+
+ 2497 24497 17137 0
+ 2528 24549 17058 2
+ 2493 24542 17072 2
+
+
+ 21770 -2150 -20529 0
+ 21709 -2216 -20586 2
+ 21723 -2188 -20574 2
+
+
+ -10876 -27085 6937 0
+ -10852 -27070 7031 2
+ -10890 -27062 7002 2
+
+
+ -26625 11639 7461 0
+ -26627 11581 7543 2
+ -26614 11615 7534 2
+
+
+ -25621 14760 -5070 0
+ -25629 14776 -4983 3
+ -25602 14798 -5057 3
+
+
+ -16344 22674 -10897 0
+ -16433 22621 -10874 2
+ -16412 22635 -10877 2
+
+
+ -15599 23126 -11040 0
+ -15659 23073 -11065 2
+ -15673 23082 -11027 2
+
+
+ 2618 27824 10908 0
+ 2667 27843 10848 2
+ 2624 27854 10829 2
+
+
+ 13838 15180 21865 0
+ 13908 15114 21867 3
+ 13911 15136 21849 3
+
+
+ 29104 5954 -4186 0
+ 29079 6043 -4229 2
+ 29088 6022 -4197 2
+
+
+ -17298 24161 -4125 0
+ -17307 24139 -4219 3
+ -17326 24131 -4183 3
+
+
+ 7494 29029 1081 0
+ 7523 29023 1045 2
+ 7443 29044 1026 2
+
+
+ -19537 -11007 19928 0
+ -19569 -10943 19932 3
+ -19599 -10935 19907 3
+
+
+ -18953 -22734 4895 0
+ -18996 -22685 4954 2
+ -19004 -22689 4904 2
+
+
+ 13593 -5535 -26165 0
+ 13507 -5562 -26204 2
+ 13521 -5539 -26201 2
+
+
+ -19136 21815 -7612 0
+ -19209 21755 -7598 3
+ -19203 21767 -7579 3
+
+
+ -24002 17079 5677 0
+ -24030 17072 5578 2
+ -24024 17073 5602 2
+
+
+ -26057 14705 -2194 0
+ -26085 14644 -2268 2
+ -26079 14660 -2224 2
+
+
+ -25874 9131 12130 0
+ -25837 9128 12212 2
+ -25833 9154 12201 2
+
+
+ -22516 16997 -10205 0
+ -22582 16938 -10156 3
+ -22568 16954 -10162 3
+
+
+ 15992 -257 25381 0
+ 15990 -162 25383 2
+ 15972 -205 25394 2
+
+
+ -8284 26137 -12175 0
+ -8230 26121 -12246 2
+ -8253 26111 -12251 2
+
+
+ -20414 -21222 5734 0
+ -20404 -21210 5815 2
+ -20435 -21186 5793 2
+
+
+ -15647 23076 -11075 0
+ -15709 23018 -11108 2
+ -15709 23033 -11078 2
+
+
+ -28391 9662 -763 0
+ -28401 9625 -851 2
+ -28403 9624 -814 2
+
+
+ 23132 6353 18016 0
+ 23192 6324 17948 2
+ 23179 6347 17957 2
+
+
+ -24613 16950 2623 0
+ -24657 16892 2584 3
+ -24641 16907 2639 3
+
+
+ 10870 -14991 23603 0
+ 10905 -15056 23545 3
+ 10912 -15035 23556 3
+
+
+ -27204 11625 4977 0
+ -27209 11578 5059 2
+ -27204 11598 5043 2
+
+
+ -26269 14142 -3158 0
+ -26297 14076 -3216 2
+ -26298 14079 -3194 2
+
+
+ 2537 27833 10903 0
+ 2517 27804 10982 2
+ 2540 27806 10973 2
+
+
+ -27160 11434 5619 0
+ -27160 11399 5690 2
+ -27148 11427 5695 2
+
+
+ 29168 5584 -4248 0
+ 29158 5656 -4221 2
+ 29165 5638 -4196 2
+
+
+ 29735 1076 -3832 0
+ 29738 1144 -3785 2
+ 29740 1113 -3777 2
+
+
+ -1224 25269 16124 0
+ -1281 25233 16176 3
+ -1271 25234 16176 3
+
+
+ -28530 9221 1000 0
+ -28508 9285 1044 2
+ -28508 9286 1027 2
diff --git a/Doc/Doc.pm b/Doc/Doc.pm
new file mode 100644
index 0000000..107f0dc
--- /dev/null
+++ b/Doc/Doc.pm
@@ -0,0 +1,938 @@
+# the filter for the PDL pod format (which is a valid general perl
+# pod format but with special interpretation of some =for directives)
+
+package PDL::PodParser;
+use PDL::Core '';
+use Pod::Select;
+
+ at ISA = qw(Pod::Select);
+
+%Title = ('Example' => 'Example',
+ 'Ref' => 'Reference',
+ 'Sig' => 'Signature',
+ 'Opt' => 'Options',
+ 'Usage' => 'Usage',
+ 'Bad' => 'Bad value support',
+ );
+
+
+
+sub new {
+ my $class = shift;
+ my $parser = $class->SUPER::new(@_);
+ bless $parser,$class; # just in case
+
+ $parser->select("METHODS|OPERATORS|CONTRUCTORS|FUNCTIONS|NAME");
+ $parser->{CURFUNC} = undef;
+ $parser->{SYMHASH} = {};
+ $parser->{INBLOCK} = 0;
+ $parser->{Mode} = "";
+ $parser->{verbose} = 0;
+ $parser->{NAME} = 'UNKNOWN';
+ return $parser;
+}
+
+sub command {
+ my ($this,$cmd,$txt,$line_num,$pod_para) = @_;
+ $this->{Parmode} = 'Body';
+
+ if ($cmd eq 'head1') {
+ $this->{Mode} = $txt;
+ $this->{Parmode} = 'Body';
+ $this->{Parmode} = 'NAME' if $txt =~ /NAME/;
+ } elsif ($this->{Mode} =~ /NAME/) {
+ # do nothing (was 'last' but that was probably a mistake)
+ } elsif ($cmd eq 'head2') {
+ # A function can have multiple names (ex: zeros and zeroes),
+ # so split at the commas
+ my @funcs = split(',',$txt);
+ # Remove parentheses (so myfunc and myfunc() both work)
+ my @names = map {$1 if m/\s*([^\s(]+)\s*/} @funcs;
+ barf "error parsing function list '$txt'"
+ unless $#funcs == $#names;
+ # check for signatures
+ my $sym = $this->{SYMHASH};
+ for (@funcs) {
+ $sym->{$1}->{Module} = $this->{NAME} if m/\s*([^\s(]+)\s*/;
+ $sym->{$1}->{Sig} = $2 if m/\s*([^\s(]+)\s*\(\s*(.+)\s*\)\s*$/;
+ }
+ # make the first one the current function
+ $sym->{$names[0]}->{Names} = join(',', at names) if $#names > 0;
+ my $name = shift @names;
+ # Make the other names cross-reference the first name
+ $sym->{$_}->{Crossref} = $name for (@names);
+ my $sig = $sym->{$name}->{Sig};
+ # diagnostic output
+ print "\nFunction '".join(',',($name, at names))."'\n" if $this->{verbose};
+ print "\n\tSignature: $sig\n" if defined $sig && $this->{verbose};
+ $this->{CURFUNC} = $name;
+ } elsif ($cmd eq 'for') {
+ $this->check_for_mode($txt,$pod_para) if $cmd eq 'for';
+ }
+ local $this->{Parmode} = 'Body';
+ $this->SUPER::command($cmd,$txt,$line_num,$pod_para);
+}
+
+sub check_for_mode {
+ my ($this,$txt,$pod_para) = @_;
+ if ($txt =~ /^(sig|example|ref|opt|usage|bad|body)/i) {
+ $this->{Parmode} = ucfirst lc $1;
+ print "switched now to '$1' mode\n" if $this->{VERBOSE};
+ print "\n\t$Title{$this->{Parmode}}\n"
+ unless $this->{Parmode} =~ /Body/ || !$this->{verbose};
+ }
+}
+
+sub textblock {
+ my $this = shift;
+ my $txt = shift;
+ $this->checkmode($txt);
+ local $this->{INBLOCK} = 1;
+ $this->SUPER::textblock($txt, at _);
+ $this->{Parmode} = 'Body'; # and reset parmode
+}
+
+sub checkmode {
+ my ($this,$txt,$verbatim) = @_;
+ if ($this->{Mode} =~ /NAME/ && $this->{Parmode} =~ /NAME/) {
+ $this->{NAME} = $1 if $this->trim($txt) =~ /^\s*(\S+)\s*/;
+ print "\nNAME\t$this->{NAME}\n" if $this->{verbose};
+ $this->{Parmode} = 'Body';
+ return;
+ }
+ unless ($this->{Parmode} =~ /Body/ || $this->{INBLOCK}) {
+ my $func = $this->{CURFUNC};
+ barf "no function defined" unless defined $func;
+ local $this->{INBLOCK} = 1; # can interpolate call textblock?
+ my $itxt = $verbatim ? $txt : $this->interpolate($txt);
+ $this->{SYMHASH}->{$func}->{$this->{Parmode}} .=
+ $this->trim($itxt,$verbatim);
+ my $cr = ($verbatim && $this->{Parmode} ne 'Sig') ? "\n" : "";
+ my $out = "\n\t\t$cr".$this->trim($itxt,$verbatim);
+ print "$out\n$cr" if $this->{verbose};
+ }
+ $this->{Parmode} = 'Body';
+}
+
+sub verbatim {
+ my $this = shift;
+ my $txt = shift;
+ $this->checkmode($txt,1);
+ $this->SUPER::verbatim($txt, at _);
+}
+
+# this needs improvement
+# and any formatting information should be removed?
+# it probably depends
+sub trim {
+ my ($this,$txt,$verbatim) = @_;
+ my $ntxt = "";
+ $txt =~ s/(signature|usage):\s*//i if $this->{Parmode} eq 'Sig' ||
+ $this->{Parmode} eq 'Usage';
+ if ($this->{Parmode} eq 'Sig') {
+
+ $txt =~ s/^\s*//;
+ $txt =~ s/\s*$//;
+ while( $txt =~ s/^\((.*)\)$/$1/ ) {}; # Strip BALANCED brackets
+
+ }
+ for (split "\n", $txt) {
+ s/^\s*(.*)\s*$/$1/ unless $verbatim;
+ $ntxt .= "$_\n" unless m/^\s*$/;
+ }
+ # $txt =~ s/^\s*(.*)\s*$/$1/;
+ chomp $ntxt;
+ return $ntxt;
+}
+
+
+=head1 NAME
+
+PDL::Doc - support for PDL online documentation
+
+=head1 SYNOPSIS
+
+ use PDL::Doc;
+ $onlinedc = new PDL::Doc ($docfile);
+ @match = $onlinedc->search('m/slice|clump/');
+
+=head1 DESCRIPTION
+
+An implementation of online docs for PDL.
+
+=head1 Using PDL documentation
+
+PDL::Doc's main use is in the "help" (synonym "?") and "apropos"
+(synonym "??") commands in the perldl shell. PDL:Doc provides the
+infrastrucure to index and access PDL's documentation through these
+commands. There is also an API for direct access to the documentation
+database (see below).
+
+The PDL doc system is built on Perl's pod (Plain Old Documentation),
+included inline with each module. The PDL core modules are
+automatically indexed when PDL is built and installed, and there is
+provision for indexing external modules as well.
+
+To include your module's pod into the Perl::Doc index, you should
+follow the documentation conventions below.
+
+=head1 PDL documentation conventions
+
+For a package like PDL that has I<a lot> of functions it
+is very desirable to have some form of online help to
+make it easy for the user to remind himself of names,
+calling conventions and typical usage of the multitude
+of functions at his disposal. To make it straightforward
+to extract the relevant information from the POD documentation
+in source files that make up the PDL distribution
+certain conventions have been adopted in formatting this
+documentation.
+
+The first convention says that all documentation for
+PDL functions appears in the POD section introduced
+by one of the following:
+
+ =head1 FUNCTIONS
+ =head1 OPERATORS
+ =head1 METHODS
+ =head1 CONSTRUCTORS
+
+If you're documenting an object-oriented interface to a class
+that your module defines, you should use METHODS and CONSTRUCTORS
+as appropriate. If you are simply adding functions to PDL,
+use FUNCTIONS and OPERATORS as appropriate.
+
+Individual functions or methods in these section are introduced by
+
+ =head2 funcname
+
+where signature is the argumentlist for a PP defined function as
+explained in L<PDL::PP>. Generally, PDL documentation is in valid POD
+format (see L<perlpod|perlpod>) but uses the C<=for> directive in a
+special way. The C<=for> directive is used to flag to the PDL Pod
+parser that information is following that will be used to generate
+online help.
+
+The PDL Pod parser recognises the following C<=for> directives:
+
+=over 5
+
+=item Ref
+
+indicates that the one line reference for this function follows,
+e.g.,
+
+ =for ref
+
+ Returns a piddle of lags to parent.
+
+=item Sig
+
+the signature for the current function follows, e.g.,
+
+ =for sig
+
+ Signature: (a(n), [o]b(), [t]tmp(n))
+
+=item Usage
+
+an indication of the possible calling conventions for the current
+function, e.g.,
+
+ =for usage
+
+ wpic($pdl,$filename[,{ options... }])
+
+=item Opt
+
+lists options for the current function, e.g.,
+
+ =for options
+
+ CONVERTER => 'ppmtogif', # explicitly specify pbm converter
+ FLAGS => '-interlaced -transparent 0', # flags for converter
+ IFORM => 'PGM', # explicitly specify intermediate format
+ XTRAFLAGS => '-imagename iris', # additional flags to defaultflags
+ FORMAT => 'PCX', # explicitly specify output image format
+ COLOR => 'bw', # specify color conversion
+ LUT => $lut, # use color table information
+
+
+=item Example
+
+gives examples of typical usage for the current function:
+
+ =for example
+
+ wpic $pdl, $file;
+ $im->wpic('web.gif',{LUT => $lut});
+ for (@images) {
+ $_->wpic($name[0],{CONVERTER => 'ppmtogif'})
+ }
+
+=item Bad
+
+provides information on how the function handles bad values (if
+C<$PDL:Config{WITH_BADVAL}> is set to 1). The documentation under
+this directive should indicate if this function accepts piddles
+with bad values and under what circumstances this function might
+return piddles with bad values.
+
+=back
+
+The PDL podparser is implemented as a simple state machine. Any of
+the above C<=for> statements switches the podparser into a state
+where the following paragraph is accepted as information for the
+respective field (C<Ref>, C<Usage>, C<Opt>, C<Example> or C<Bad>).
+Only the text up to
+the end of the current paragraph is accepted, for example:
+
+ =for example
+
+ ($x,$y) = $a->func(1,3); # this is part of the accepted info
+ $x = func($a,0,1); # this as well
+
+ $x = func($a,$b); # but this isn't
+
+To make the resulting pod documentation also easily digestible for the
+existing pod filters (pod2man, pod2text, pod2html, etc) the actual
+textblock of information must be separated from the C<=for> directive
+by at least one blank line. Otherwise, the textblock will be lost in
+the translation process when the "normal" podformatters are used. The
+general idea behind this format is that it should be easy to extract
+the information for online documentation, automatic generation of a
+reference card, etc but at the same time the documentation should be
+translated by the standard podformatters without loss of contents
+(and without requiring any changes in the existing POD format).
+
+The preceding explanations should be further explained by the
+following example (extracted from PDL/IO/Misc/misc.pd):
+
+ =head2 rcols()
+
+ =for ref
+
+ Read ASCII whitespaced cols from file into piddles efficiently.
+
+ If no columns are specified all are assumed
+ Will optionally only process lines matching a pattern.
+ Can take file name or *HANDLE.
+
+ =for usage
+
+ Usage: ($x,$y,...) = rcols(*HANDLE|"filename", ["/pattern/",$col1, $col2,] ...)
+
+ e.g.,
+
+ =for example
+
+ ($x,$y) = rcols 'file1'
+ ($x,$y,$z) = rcols 'file2', "/foo/",3,4
+ $x = PDL->rcols 'file1';
+
+ Note: currently quotes are required on the pattern.
+
+
+which is translated by, e.g, the standard C<pod2text> converter into:
+
+ rcols()
+
+ Read ASCII whitespaced cols from file into piddles efficiently.
+
+ If no columns are specified all are assumed Will optionally only
+ process lines matching a pattern. Can take file name or *HANDLE.
+
+ Usage: ($x,$y,...) = rcols(*HANDLE|"filename", ["/pattern/",$col1, $col2,] ...)
+
+ e.g.,
+
+ ($x,$y) = rcols 'file1'
+ ($x,$y,$z) = rcols 'file2', "/foo/",3,4
+ $x = PDL->rcols 'file1';
+
+ Note: currently quotes are required on the pattern.
+
+It should be clear from the preceding example that readable output
+can be obtained from this format using the standard converters and
+the reader will hopefully get a feeling how he can easily intersperse
+the special C<=for> directives with the normal POD documentation.
+
+=head2 Which directives should be contained in the documentation
+
+The module documentation should
+start with the
+
+ =head1 NAME
+
+ PDL::Modulename -- do something with piddles
+
+section (as anyway required by C<pod2man>) since the PDL podparser
+extracts the name of the module this function belongs to from
+that section.
+
+Each function that is I<not> only for internal use by the module
+should be documented, introduced with the C<=head2> directive
+in the C<=head1 FUNCTIONS> section. The only field that every function
+documented along these lines should have is the I<Ref> field preceding
+a one line description of its intended functionality (suitable for
+inclusion in a concise reference card). PP defined functions (see L<PDL::PP>)
+should have a I<Sig> field stating their signature. To facilitate
+maintainance of this documentation for such functions the 'Doc' field
+has been introduced into the definition of C<pp_def> (see again L<PDL::PP>)
+which will take care that name and signature of the so defined function
+are documented in this way (for examples of this usage see, for example,
+the PDL::Slices module, especially F<slices.pd> and the resulting
+F<Slices.pm>). Similarly, the 'BadDoc' field provides a means of
+specifying information on how the routine handles the presence of
+bad values: this will be autpmatically created if
+C<BadDoc> is not supplied, or set to C<undef>.
+
+Furthermore, the documentation for each function should contain
+at least one of the I<Usage> or I<Examples> fields. Depending on the
+calling conventions for the function under consideration presence
+of both fields may be warranted.
+
+If a function has options that should be given as a hash reference in
+the form
+
+ {Option => Value, ...}
+
+then the possible options (and aproppriate values) should be explained
+in the textblock following the C<=for Opt> directive (see example above
+and, e.g., PDL::IO::Pic).
+
+It is well possible that some of these conventions appear to be clumsy
+at times and the author is keen to hear of any suggestions for better
+alternatives.
+
+=cut
+
+package PDL::Doc;
+use PDL::Core '';
+use IO::File; # for file handles
+use File::Basename;
+use PDL::Doc::Config;
+
+=head1 INSTANCE METHODS
+
+=head2 new
+
+ $onlinedc = new PDL::Doc ('file.pdl',[more files]);
+
+=cut
+
+sub new {
+ my ($type, at files) = @_;
+ my $this = bless {},$type;
+ $this->{File} = [@files];
+ $this->{Scanned} = [];
+ $this->{Outfile} = $files[0];
+ return $this;
+}
+
+=head2 addfiles
+
+add another file to the online database associated with this object.
+
+=cut
+
+sub addfiles {
+ my ($this, at files) = @_;
+ push @{$this->{File}}, @files;
+}
+
+=head2 outfile
+
+set the name of the output file for this online db
+
+=cut
+
+sub outfile {
+ my ($this,$file) = @_;
+ $this->{Outfile} = $file if defined $file;
+ return $this->{Outfile};
+}
+
+=head2 ensuredb
+
+Make sure that the database is slurped in
+
+=cut
+
+sub ensuredb {
+ my ($this) = @_;
+ while (my $fi = pop @{$this->{File}}) {
+ open IN, $fi or
+ barf "can't open database $fi, scan docs first";
+ binmode IN;
+ my ($plen,$txt);
+ while (read IN, $plen,2) {
+ my ($len) = unpack "S", $plen;
+ read IN, $txt, $len;
+ my ($sym, %hash) = split chr(0), $txt;
+ $this->{SYMS}->{$sym} = {%hash};
+ }
+ close IN;
+ push @{$this->{Scanned}}, $fi;
+ }
+ return $this->{SYMS};
+}
+
+=head2 savedb
+
+save the database (i.e., the hash of PDL symbols) to the file associated
+with this object.
+
+=cut
+
+sub savedb {
+ my ($this) = @_;
+ my $hash = $this->ensuredb();
+ open OUT, ">$this->{Outfile}" or barf "can't write to symdb $this->{Outfile}";
+ binmode OUT;
+ while (my ($key,$val) = each %$hash) {
+ next if 0 == scalar(%$val);
+ my $txt = "$key".chr(0).join(chr(0),%$val);
+ print OUT pack("S",length($txt)).$txt;
+ }
+}
+
+
+=head2 gethash
+
+Return the PDL symhash (e.g. for custom search operations)
+
+The symhash is a multiply nested hash with the following structure:
+
+ $symhash = {
+ function_name => {
+ Module => 'module::name',
+ Sig => 'signature string',
+ Bad => 'bad documentation string',
+ ...
+ },
+ function_name => {
+ Module => 'module::name',
+ Sig => 'signature string',
+ Bad => 'bad documentation string',
+ ...
+ },
+ };
+
+The possible keys for each function include:
+
+ Module - module name
+ Sig - signature
+ Crossref - the function name for the documentation, if it has multiple
+ names (ex: the documentation for zeros is under zeroes)
+ Names - a comma-separated string of the all the function's names
+ Example - example text (optional)
+ Ref - one-line reference string
+ Opt - options
+ Usage - short usage explanation
+ Bad - explanation of behavior when it encounters bad values
+
+=cut
+
+sub gethash {
+ return $_[0]->ensuredb();
+}
+
+=head2 search
+
+Search a PDL symhash
+
+=for usage
+
+ $onldc->search($regex, $fields [, $sort])
+
+Searching is by default case insensitive. Other flags can be
+given by specifying the regexp in the form C<m/regex/ismx>
+where C</> can be replaced with any other non-alphanumeric
+character. $fields is an array reference for all hash fields
+(or simply a string if you only want to search one field)
+that should be matched against the regex. Valid fields are
+
+ Name, # name of the function
+ Module, # module the function belongs to
+ Ref, # the one-line reference description
+ Example, # the example for this function
+ Opt, # options
+ File, # the path to the source file these docs have been extracted from
+
+If you wish to have your results sorted by function name, pass a true
+value for C<$sort>.
+
+The results will be returned as an array of pairs in the form
+
+ @results = (
+ [funcname, {SYMHASH_ENTRY}],
+ [funcname, {SYMHASH_ENTRY}],
+ ...
+ );
+
+See the example at the end of the documentation to see how you might
+use this.
+
+=cut
+
+
+sub search {
+ my ($this,$pattern,$fields,$sort) = @_;
+ $sort = 0 unless defined $sort;
+ my $hash = $this->ensuredb;
+ my @match = ();
+
+ # Make a single scalar $fields work
+ $fields = [$fields] if ref($fields) eq '';
+
+ $pattern = $this->checkregex($pattern);
+
+ while (my ($key,$val) = each %$hash) {
+ FIELD: for (@$fields) {
+ if ($_ eq 'Name' and $key =~ /$pattern/i
+ or defined $val->{$_} and $val->{$_} =~ /$pattern/i) {
+ $val = $hash->{$val->{Crossref}}
+ if defined $val->{Crossref} && defined $hash->{$val->{Crossref}};
+ push @match, [$key,$val];
+ last FIELD;
+ }
+ }
+ }
+ @match = sort {$a->[0] cmp $b->[0]} @match if (@match && $sort);
+ return @match;
+}
+
+
+# parse a regexp in the form
+# m/^[a-z]+/ismx
+# where the pairs of '/' can be replaced by any other pair of matching
+# characters
+# if the expression doesn't start with 'm' followed by a nonalphanumeric
+# character, return as-is
+sub checkregex {
+ my ($this,$regex) = @_;
+ return "(?i)$regex" unless $regex =~ /^m[^a-z,A-Z,0-9]/;
+ my $sep = substr($regex,1,1);
+ substr($regex,0,2) = '';
+ $sep = '(?<!\\\\)\\'.$sep; # Avoid '\' before the separator
+
+ my ($pattern,$mod) = split($sep,$regex,2);
+ barf "unknown regex modifiers '$mod'" if $mod && $mod !~ /[imsx]+/;
+ $pattern = "(?$mod)$pattern" if $mod;
+ return $pattern;
+}
+
+=head2 scan
+
+Scan a source file using the PDL podparser to extract information
+for online documentation
+
+=cut
+
+sub scan {
+ my ($this,$file,$verbose) = @_;
+ $verbose = 0 unless defined $verbose;
+ barf "can't find file '$file'" unless -f $file;
+
+ # First HTMLify file in the tree
+
+ # Does not work yet
+
+ #if (system ("pod2html $file")!=0) {
+ # warn "Failed to execute command: pod2html $file2\n";
+ #}
+ #else{ # Rename result (crummy pod2html)
+ # rename ("$file.html","$1.html") if $file =~ /^(.*)\.pm$/;
+ #}
+
+ # Now parse orig pm/pod
+
+ my $infile = new IO::File $file;
+ # XXXX convert to absolute path
+ # my $outfile = '/tmp/'.basename($file).'.pod';
+ open my $outfile, '>', \(my $outfile_text);
+
+ # Handle RPM etc. case where we are building away from the final
+ # location. Alright it's a hack - KGB
+ my $file2 = $file;
+ $file2 =~ s/^$ENV{BUILDROOTPREFIX}// if $ENV{BUILDROOTPREFIX} ne "";
+
+ my $parser = new PDL::PodParser;
+ $parser->{verbose} = $verbose;
+ $parser->parse_from_filehandle($infile,$outfile);
+ $this->{SYMS} = {} unless defined $this->{SYMS};
+ my $hash = $this->{SYMS};
+ my @stats = stat $file;
+ $this->{FTIME}->{$file2} = $stats[9]; # store last mod time
+ # print "mtime of $file: $stats[9]\n";
+ my $phash = $parser->{SYMHASH};
+ my $n = 0;
+ while (my ($key,$val) = each %$phash) {
+ #print "adding '$key'\n";
+ $n++;
+
+ $val->{File} = $file2;
+ $hash->{$key} = $val
+ }
+
+ # KGB pass2 - scan for module name and function
+ # alright I admit this is kludgy but it works
+ # and one can now find modules with 'apropos'
+
+ $infile = new IO::File $file;
+ $outfile_text = '';
+ $parser = new PDL::PodParser;
+ $parser->select('NAME');
+ $parser->parse_from_filehandle($infile,$outfile);
+ my @namelines = split("\n",$outfile_text);
+ my ($name,$does);
+ for (@namelines) {
+ if (/^(PDL) (-) (.*)/ or /^\s*(Inline::Pdlpp)\s*(-*)?\s*(.*)\s*$/ or /\s*(PDL::[\w:]*)\s*(-*)?\s*(.*)\s*$/) {
+ $name = $1; $does = $3;
+ }
+ if (/^\s*([a-z][a-z0-9]*) (-+) (.*)/) { # lowercase shell script name
+ $name = $1; $does = $3;
+ ($name,$does) = (undef,undef) unless $does =~ /shell|script/i;
+ }
+ }
+ $does = 'Hmmm ????' if $does =~ /^\s*$/;
+ my $type = ($file =~ /\.pod$/ ?
+ ($does =~ /shell|script/i && $name =~ /^[a-z][a-z0-9]*$/) ? 'Script:'
+ : 'Manual:'
+ : 'Module:');
+ $hash->{$name} = {Ref=>"$type $does",File=>$file2} if $name !~ /^\s*$/;
+ return $n;
+}
+
+=head2 scantree
+
+Scan whole directory trees for online documentation in
+C<.pm> (module definition) and C<*.pod> (general
+documentation) files (using the File::Find module).
+
+=cut
+
+sub scantree {
+ my ($this,$dir,$verbose) = @_;
+ $verbose = 0 unless defined $verbose;
+ require File::Find;
+ print "Scanning $dir ... \n\n";
+ my $ntot = 0;
+ my $sub = sub { if (($File::Find::name =~ /[.]pm$/ &&
+ $File::Find::name !~ /PP.pm/ &&
+ $File::Find::name !~ m|Pod/Parser.pm| &&
+ $File::Find::dir !~ m#/PP|/Gen#) or (
+ $File::Find::name =~ /[.]pod$/ &&
+ $File::Find::name !~ /Index[.]pod$/)){
+ printf "%-20s", $_.'...';
+ my $n = $this->scan($File::Find::name,$verbose); # bind $this lexically
+ print "\t$n functions\n";
+ $ntot += $n;
+ }
+ };
+ File::Find::find($sub,$dir);
+ print "\n\nfound $ntot functions\n";
+}
+
+
+=head2 funcdocs
+
+extract the complete documentation about a function from its
+ source file using the PDL::Pod::Parser filter.
+
+=cut
+
+sub funcdocs {
+ my ($this,$func,$fout) = @_;
+ my $hash = $this->ensuredb;
+ barf "unknown function '$func'" unless defined($hash->{$func});
+ funcdocs_fromfile($func,$hash->{$func}->{File},$fout);
+}
+
+=head1 FUNCTIONS
+
+=cut
+
+sub funcdocs_fromfile {
+ my ($func,$file) = @_;
+ barf "can't find file '$file'" unless -f $file;
+ local $SIG{PIPE}= sub {}; # Prevent crashing if user exits the pager
+ my $in = new IO::File $file;
+ my $out = ($#_ > 1 && defined($_[2])) ? $_[2] :
+ new IO::File "| pod2text | $PDL::Doc::pager";
+ barf "can't open file $file" unless $in;
+ barf "can't open output handle" unless $out;
+ getfuncdocs($func,$in,$out);
+
+ if (ref $out eq 'GLOB') {
+ print $out "Docs from $file\n\n"; } else {
+ $out->print("Docs from $file\n\n"); }
+}
+
+sub extrdoc {
+ my ($func,$file) = @_;
+ open my $out, '>', \(my $out_text);
+ funcdocs_fromfile($func,$file,$out);
+ return $out_text;
+}
+
+sub getfuncdocs {
+ my ($func,$in,$out) = @_;
+ my $parser = Pod::Select->new;
+# $parser->select("\\(METHODS\\|OPERATORS\\|CONSTRUCTORS\\|FUNCTIONS\\|METHODS\\)/$func(\\(.*\\)*\\s*");
+ foreach my $foo(qw/FUNCTIONS OPERATORS CONSTRUCTORS METHODS/) {
+ seek $in,0,0;
+ $parser->select("$foo/$func(\\(.*\\))*\\s*");
+ $parser->parse_from_filehandle($in,$out);
+ }
+}
+
+
+=head2 add_module
+
+=for usage
+
+ use PDL::Doc; PDL::Doc::add_module("my::module");
+
+=for ref
+
+The C<add_module> function allows you to add POD from a particular Perl
+module that you've installed somewhere in @INC. It searches for the
+active PDL document database and the module's .pod and .pm files, and
+scans and indexes the module into the database.
+
+C<add_module> is meant to be added to your module's Makefile as part of the
+installation script.
+
+=cut
+
+package PDL::Doc;
+sub add_module {
+ my($module) = shift;
+
+ use File::Copy qw{copy};
+
+ my($dir, $file, $pdldoc);
+ local($_);
+
+ DIRECTORY:
+ for(@INC){
+ $dir = $_;
+ $file = $dir."/PDL/pdldoc.db";
+ if( -f $file) {
+ if(! -w "$dir/PDL") {
+ die "No write permission at $dir/PDL - not updating docs database.\n";
+ }
+
+ print "Found docs database $file\n";
+ $pdldoc = new ("PDL::Doc",($file));
+ last DIRECTORY;
+ }
+ }
+
+ die "Unable to find docs database - therefore not updating it.\n" unless($pdldoc);
+
+ my $mfile = $module;
+ $mfile =~ s/\:\:/\//g;
+ for(@INC){
+ my $postfix;
+ my $hit = 0;
+ for $postfix(".pm",".pod") {
+ my $f = "$_/$mfile$postfix";
+ if( -e $f ){
+ $pdldoc->ensuredb();
+ $pdldoc->scan($f);
+ eval { $pdldoc->savedb(); };
+ warn $@ if $@;
+ print "PDL docs database updated - added $f.\n";
+ $hit = 1;
+ }
+ }
+ return if($hit);
+ }
+
+ die "Unable to find a .pm or .pod file in \@INC for module $module\n";
+}
+
+1;
+
+=head1 PDL::DOC EXAMPLE
+
+Here's an example of how you might use the PDL Doc database in your
+own code.
+
+ use PDL::Doc;
+ # Find the pdl documentation
+ my ($dir,$file,$pdldoc);
+ DIRECTORY: for $dir (@INC) {
+ $file = $dir."/PDL/pdldoc.db";
+ if (-f $file) {
+ print "Found docs database $file\n";
+ $pdldoc = new PDL::Doc ($file);
+ last DIRECTORY;
+ }
+ }
+
+ die ("Unable to find docs database!\n") unless $pdldoc;
+
+ # Print the reference line for zeroes:
+ print $pdldoc->gethash->{zeroes}->{Ref};
+
+ # See which examples use zeroes
+ $pdldoc->search('zeroes', 'Example', 1);
+
+ # All the functions that use zeroes in their example:
+ my @entries = $pdldoc->search('zeroes', 'Example', 1);
+ print "Functions that use 'zeroes' in their examples include:\n";
+ foreach my $entry (@entries) {
+ # Unpack the entry
+ my ($func_name, $sym_hash) = @$entry;
+ print "$func_name\n";
+ }
+
+ print "\n";
+
+ # Let's look at the function 'mpdl'
+ @entries = $pdldoc->search('mpdl', 'Name');
+ # I know there's only one:
+ my $entry = $entries[0];
+ my ($func_name, $sym_hash) = @$entry;
+ print "mpdl info:\n";
+ foreach my $key (keys %$sym_hash) {
+ # Unpack the entry
+ print "---$key---\n$sym_hash->{$key}\n";
+ }
+
+=head2 Finding Modules
+
+How can you tell if you've gotten a module for one of your entries?
+The Ref entry will begin with 'Module:' if it's a module. In code:
+
+ # Prints:
+ # Module: fundamental PDL functionality
+ my $sym_hash = $pdldoc->gethash;
+ print $pdldoc->gethash->{'PDL::Core'}->{Ref}, "\n"
+
+=head1 BUGS
+
+Quite a few shortcomings which will hopefully be fixed following
+discussions on the pdl-porters mailing list.
+
+=head1 AUTHOR
+
+Copyright 1997 Christian Soeller E<lt>c.soeller at auckland.ac.nzE<gt>
+and Karl Glazebrook E<lt>kgb at aaoepp.aao.gov.auE<gt>
+
+Further contributions copyright 2010 David Mertens
+E<lt>dcmertens.perl at gmail.comE<gt>
+
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+1;
diff --git a/Doc/Doc/Config.pm.PL b/Doc/Doc/Config.pm.PL
new file mode 100644
index 0000000..64e5535
--- /dev/null
+++ b/Doc/Doc/Config.pm.PL
@@ -0,0 +1,43 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate. Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries. Thus you write
+# $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($Config{'osname'} eq 'VMS' or
+ $Config{'osname'} eq 'OS2'); # "case-forgiving"
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+chmod 0775, $file;
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT "# automatically built from ".basename($0)."\n";
+print OUT "# don't modify, all changes will be lost !!!!\n";
+print OUT <<'!NO!SUBS!';
+package PDL::Doc::Config;
+
+!NO!SUBS!
+
+print OUT <<"EOC";
+\$PDL::Doc::pager = \'$Config{'pager'}\';
+\$PDL::Doc::pager = \$ENV{PAGER} if defined \$ENV{PAGER};
+\$PDL::Doc::pager = \$ENV{PERLDOC_PAGER} if defined \$ENV{PERLDOC_PAGER};
+\$PDL::Doc::DefaultFile = \'$Config{'man1direxp'}\';
+
+1;
+
+EOC
diff --git a/Doc/Doc/Perldl.pm b/Doc/Doc/Perldl.pm
new file mode 100644
index 0000000..673c1ed
--- /dev/null
+++ b/Doc/Doc/Perldl.pm
@@ -0,0 +1,701 @@
+=head1 NAME
+
+PDL::Doc::Perldl - commands for accessing PDL doc database from 'perldl' shell
+
+=head1 DESCRIPTION
+
+This module provides a simple set of functions to
+access the PDL documentation of database, for use
+from the I<perldl> or I<pdl2> shells as well as the
+I<pdldoc> command-line program.
+
+Autoload files are also matched, via a search of the PDLLIB autoloader
+tree. That behavior can be switched off with the variable
+C<$PERLDL::STRICT_DOCS> (true: don't search autoload tree; false: search
+the autoload tree.)
+
+Currently, multiple matches are not handled very well.
+
+=head1 SYNOPSIS
+
+ use PDL::Doc::Perldl; # Load all documenation functions
+
+=head1 BUGS
+
+The description contains the misleading word "simple".
+
+=head1 FUNCTIONS
+
+=cut
+
+package PDL::Doc::Perldl;
+
+use Exporter;
+use strict;
+use vars qw(@ISA @EXPORT);
+
+ at ISA = qw(Exporter);
+
+ at EXPORT = qw( apropos aproposover usage help sig badinfo whatis );
+
+use PDL::Doc;
+use Pod::Select;
+use IO::File;
+use Pod::PlainText;
+
+$PDL::onlinedoc = undef;
+$PDL::onlinedoc = PDL::Doc->new(FindStdFile());
+
+use PDL::Config;
+my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
+
+# Find std file
+
+sub FindStdFile {
+ my ($d,$f);
+ for $d (@INC) {
+ $f = $d."/PDL/pdldoc.db";
+ if (-f $f) {
+ print "Found docs database $f\n" if $PDL::verbose;
+ print "Type 'help' for online help\n" if $PDL::verbose;
+ return $f;
+ }
+ }
+ warn "Unable to find PDL/pdldoc.db in ".join(":", at INC)."\n";
+}
+
+# used to find out how wide the screen should be
+# for printmatch() - really should check for a
+# sensible lower limit (for printmatch >~ 40
+# would be my guess)
+#
+# taken from Pod::Text (v1.0203), then hacked to get it
+# to work (at least on my solaris and linux
+# machines)
+#
+sub screen_width() {
+ return $ENV{COLUMNS}
+ || (($ENV{TERMCAP} =~ /co#(\d+)/) and $1)
+ || ($^O ne 'MSWin32' and $^O ne 'dos' and
+ (`stty -a 2>/dev/null` =~ /columns\s*=?\s*(\d+)/) and $1)
+ || 72;
+}
+
+sub printmatch {
+ my @match = @_;
+ if (@match) {
+ foreach my $t ( format_ref( @_ ) ) { print $t; }
+ } else {
+ print "no match\n\n";
+ }
+} # sub: print_match()
+
+# return a string containing a formated version of the Ref string
+# for the given matches
+#
+sub format_ref {
+ my @match = @_;
+ my @text = ();
+
+ my $width = screen_width()-17;
+ my $parser = new Pod::PlainText( width => $width, indent => 0, sentence => 0 );
+
+ for my $m (@match) {
+ my $ref = $m->[1]{Ref} ||
+ ( (defined $m->[1]{CustomFile})
+ ? "[No ref avail. for `".$m->[1]{CustomFile}."']"
+ : "[No reference available]"
+ );
+
+ $ref = $parser->interpolate( $ref );
+ $ref = $parser->reformat( $ref );
+
+ # remove last new lines (so substitution doesn't append spaces at end of text)
+ $ref =~ s/\n*$//;
+ $ref =~ s/\n/\n /g;
+
+ my $name = $m->[0];
+ if ( length($name) > 15 ) {
+ push @text, sprintf "%s ...\n %s\n", $name, $ref;
+ } else {
+ push @text, sprintf "%-15s %s\n", $name, $ref;
+ }
+ }
+ return wantarray ? @text : $text[0];
+
+} # sub: format_ref()
+
+=head2 apropos
+
+=for ref
+
+Regex search PDL documentation database
+
+=for usage
+
+ apropos 'text'
+
+=for example
+
+ pdl> apropos 'pic'
+ rpic Read images in many formats with automatic format detection.
+ rpiccan Test which image formats can be read/written
+ wmpeg Write an image sequence ((x,y,n) piddle) as an MPEG animation.
+ wpic Write images in many formats with automatic format selection.
+ wpiccan Test which image formats can be read/written
+
+To find all the manuals that come with PDL, try
+
+ apropos 'manual:'
+
+and to get quick info about PDL modules say
+
+ apropos 'module:'
+
+You get more detailed info about a PDL function/module/manual
+with the C<help> function
+
+=cut
+
+sub aproposover {
+ die "Usage: aproposover \$funcname\n" unless $#_>-1;
+ die "no online doc database" unless defined $PDL::onlinedoc;
+ my $func = shift;
+ $func =~ s:\/:\\\/:g;
+ search_docs("m/$func/",['Name','Ref','Module'],1);
+
+}
+
+sub apropos {
+ die "Usage: apropos \$funcname\n" unless $#_>-1;
+ die "no online doc database" unless defined $PDL::onlinedoc;
+ my $func = shift;
+ printmatch aproposover $func;
+}
+
+=head2 PDL::Doc::Perldl::search_docs
+
+=for ref
+
+Internal routine to search docs database and autoload files
+
+=cut
+
+sub search_docs {
+ my ($func,$types,$sortflag,$exact) = @_;
+ my @match;
+
+ @match = $PDL::onlinedoc->search($func,$types,$sortflag);
+ push(@match,find_autodoc( $func, $exact ) );
+
+ @match;
+}
+
+
+
+=head2 PDL::Doc::Perldl::finddoc
+
+=for ref
+
+Internal interface to the PDL documentation searcher
+
+=cut
+
+sub finddoc {
+ local $SIG{PIPE}= sub {}; # Prevent crashing if user exits the pager
+
+ die 'Usage: doc $topic' unless $#_>-1;
+ die "no online doc database" unless defined $PDL::onlinedoc;
+ my $topic = shift;
+
+ # See if it matches a PDL function name
+
+ my $subfield = $1
+ if( $topic =~ s/\[(\d*)\]$// );
+
+ (my $t2 = $topic) =~ s/([^a-zA-Z0-9_])/\\$1/g;
+
+ my @match = search_docs("m/^(PDL::)?".$t2."\$/",['Name'],0);
+
+ unless(@match) {
+
+ print "No PDL docs for '$topic'. Using 'whatis'. (Try 'apropos $topic'?)\n\n";
+ whatis($topic);
+ return;
+
+ }
+
+ # print out the matches
+
+ my $out = IO::File->new( "| pod2text | $PDL::Doc::pager" );
+
+ if($subfield) {
+ if($subfield <= @match) {
+ @match = ($match[$subfield-1]);
+ $subfield = 0;
+ } else {
+ print $out "\n\n=head1 PDL HELP: Ignoring out-of-range selector $subfield\n\n=head1\n\n=head1 --------------------------------\n\n";
+ $subfield = undef;
+ }
+ }
+
+ my $num_pdl_pod_matches = scalar @match;
+ my $pdl_pod_matchnum = 0;
+
+ while (@match) {
+ $pdl_pod_matchnum++;
+
+ if ( @match > 1 and !$subfield ) {
+ print $out "\n\n=head1 MULTIPLE MATCHES FOR HELP TOPIC '$topic':\n\n=head1\n\n=over 3\n\n";
+ my $i=0;
+ for my $m ( @match ) {
+ printf $out "\n=item [%d]\t%-30s %s%s\n\n", ++$i, $m->[0], $m->[1]{Module} && "in ", $m->[1]{CustomFile} || $m->[1]{Module};
+ }
+ print $out "\n=back\n\n=head1\n\n To see item number \$n, use 'help ${topic}\[\$n\]'. \n\n=cut\n\n";
+ }
+
+ if (@match > 0 and $num_pdl_pod_matches > 1) {
+ print $out "\n=head1 Displaying item $pdl_pod_matchnum:\n\n=head1 --------------------------------------\n\n=cut\n\n";
+ }
+
+ my $m = shift @match;
+
+ my $Ref = $m->[1]{Ref};
+ if ( $Ref =~ /^(Module|Manual|Script): / ) {
+ my $in = IO::File->new("<$m->[1]{File}");
+ print $out join("",<$in>);
+ } else {
+ if(defined $m->[1]{CustomFile}) {
+
+ my $parser= Pod::Select->new;
+ print $out "=head1 Autoload file \"".$m->[1]{CustomFile}."\"\n\n";
+ $parser->parse_from_file($m->[1]{CustomFile},$out);
+ print $out "\n\n=head2 Docs from\n\n".$m->[1]{CustomFile}."\n\n";
+
+ } else {
+
+ print $out "=head1 Module ",$m->[1]{Module}, "\n\n";
+ $PDL::onlinedoc->funcdocs($m->[0],$out);
+
+ }
+
+ }
+ }
+ }
+
+
+=head2 find_autodoc
+
+=for ref
+
+Internal helper routine that finds and returns documentation in the autoloader
+path, if it exists. You feed in a topic and it searches for the file
+"${topic}.pdl". If that exists, then the filename gets returned in a
+match structure appropriate for the rest of finddoc.
+
+=cut
+
+# Yuck. Sorry. At least it works. -CED
+
+sub find_autodoc {
+ my $topic = shift;
+ my $exact = shift;
+ my $matcher;
+ # Fix up regexps and exact matches for the special case of
+ # searching the autoload dirs...
+ if($exact) {
+ $topic =~ s/\(\)$//; # "func()" -> "func"
+ $topic .= ".pdl" unless $topic =~ m/\.pdl$/;
+ } else {
+
+ $topic =~ s:([^\$])(.)$:$1\.\*\$$2:; # Include explicit ".*$" at end of
+ # vague matches -- so that we can
+ # make it a ".*\.pdl$" below.
+
+ $topic =~ s:\$(.)$:\.pdl\$$1:; # Force ".pdl" at end of file match
+
+ $matcher = eval "sub { ${topic}i && \$\_ };"; # Avoid multiple compiles
+ }
+
+ my @out;
+
+ return unless(@main::PDLLIB);
+ @main::PDLLIB_EXPANDED = PDL::AutoLoader::expand_path(@main::PDLLIB)
+ unless(@main::PDLLIB_EXPANDED);
+
+ for my $dir(@main::PDLLIB_EXPANDED) {
+ if($exact) {
+ my $file = $dir . "/" . "$topic";
+ push(@out,
+ [$file, {CustomFile => "$file", Module => "file '$file'"}]
+ )
+ if(-e $file);
+ } else {
+ opendir(FOO,$dir) || next;
+ my @dir = readdir(FOO);
+ closedir(FOO);
+ for my $file( grep( &$matcher, @dir ) ) {
+ push(@out,
+ [$file, {CustomFile => "$dir/$file", Module => "file '$dir/$file'"}]
+ );
+ }
+
+ }
+ }
+ @out;
+}
+
+
+=head2 usage
+
+=for ref
+
+Prints usage information for a PDL function
+
+=for usage
+
+ Usage: usage 'func'
+
+=for example
+
+ pdl> usage 'inner'
+
+ inner inner prodcuct over one dimension
+ (Module PDL::Primitive)
+
+ Signature: inner(a(n); b(n); [o]c(); )
+
+
+=cut
+
+sub usage {
+ die 'Usage: usage $funcname' unless $#_>-1;
+ die "no online doc database" unless defined $PDL::onlinedoc;
+ print usage_string(@_);
+}
+sub usage_string{
+ my $func = shift;
+ my $str = "";
+ my @match = search_docs("m/^(PDL::)?$func\$/",['Name']);
+
+ unless (@match) { $str = "\n no match\n" }
+ else {
+ $str .= "\n" . format_ref( $match[0] );
+ my ($name,$hash) = @{$match[0]};
+ $str .= sprintf ( (' 'x16)."(Module %s)\n\n", $hash->{Module} );
+ die "No usage info found for $func\n"
+ if !defined $hash->{Example} && !defined $hash->{Sig} &&
+ !defined $hash->{Usage};
+ $str .= " Signature: $name($hash->{Sig})\n\n" if defined $hash->{Sig};
+ for (['Usage','Usage'],['Opt','Options'],['Example','Example']) {
+ $str .= " $_->[1]:\n\n".&allindent($hash->{$_->[0]},10)."\n\n"
+ if defined $hash->{$_->[0]};
+ }
+ }
+ return $str;
+}
+
+=head2 sig
+
+=for ref
+
+prints signature of PDL function
+
+=for usage
+
+ sig 'func'
+
+The signature is the normal dimensionality of the
+function's arguments. Calling with different dimensions
+doesn't break -- it causes threading. See L<PDL::PP|PDL::PP> for details.
+
+=for example
+
+ pdl> sig 'outer'
+ Signature: outer(a(n); b(m); [o]c(n,m); )
+
+
+=cut
+
+sub sig {
+ die "Usage: sig \$funcname\n" unless $#_>-1;
+ die "no online doc database" unless defined $PDL::onlinedoc;
+ my $func = shift;
+ my @match = search_docs("m/^(PDL::)?$func\$/",['Name']);
+ unless (@match) { print "\n no match\n" } else {
+ my ($name,$hash) = @{$match[0]};
+ die "No signature info found for $func\n"
+ if !defined $hash->{Sig};
+ print " Signature: $name($hash->{Sig})\n" if defined $hash->{Sig};
+ }
+}
+
+sub allindent {
+ my ($txt,$n) = @_;
+ my ($ntxt,$tspc) = ($txt,' 'x8);
+ $ntxt =~ s/^\s*$//mg;
+ $ntxt =~ s/\t/$tspc/g;
+ my $minspc = length $txt;
+ for (split '\n', $txt) { if (/^(\s*)/)
+ { $minspc = length $1 if length $1 < $minspc } }
+ $n -= $minspc;
+ $tspc = ' 'x abs($n);
+ $ntxt =~ s/^/$tspc/mg if $n > 0;
+ return $ntxt;
+}
+
+
+=head2 whatis
+
+=for ref
+
+Describe a perl and/or PDL variable or expression. Useful for
+determining the type of an expression, identifying the keys in a hash
+or a data structure, or examining WTF an unknown object is.
+
+=for usage
+
+ Usage: whatis $var
+ whatis <expression>
+
+=cut
+
+sub whatis {
+ my $topic;
+
+ if(@_ > 1) {
+ whatis_r('',0,[@_]);
+ } else {
+ whatis_r('',0,shift);
+ }
+}
+
+$PDL::Doc::Perldl::max_strlen = 55;
+$PDL::Doc::Perldl::max_arraylen = 1;
+$PDL::Doc::Perldl::max_keylen = 8;
+$PDL::Doc::Perldl::array_indent=5;
+$PDL::Doc::Perldl::hash_indent=3;
+
+sub whatis_r {
+ my $prefix = shift;
+ my $indent = shift;
+ my $a = shift;
+
+ unless(defined $a) {
+ print $prefix,"<undef>\n";
+ return;
+ }
+
+ unless(ref $a) {
+ print "${prefix}'".
+ substr($a,0,$PDL::Doc::Perldl::max_strlen).
+ "'".((length $a > $PDL::Doc::Perldl::max_strlen) && '...').
+ "\n";
+ return;
+ }
+
+ if(ref $a eq 'ARRAY') {
+ print "${prefix}Array (".scalar(@$a)." elements):\n";
+
+ my($el);
+ for $el(0..$#$a) {
+ my $pre = sprintf("%s %2d: "," "x$indent,$el);
+ whatis_r($pre,$indent + $PDL::Doc::Perldl::array_indent, $a->[$el]);
+ last if($el == $PDL::Doc::Perldl::max_arraylen);
+ }
+ printf "%s ... \n"," " x $indent
+ if($#$a > $PDL::Doc::Perldl::max_arraylen);
+
+ return;
+ }
+
+ if(ref $a eq 'HASH') {
+ print "${prefix}Hash (".scalar(keys %$a)." elements)\n";
+ my $key;
+ for $key(sort keys %$a) {
+ my $pre = " " x $indent .
+ " $key: " .
+ (" "x($PDL::Doc::Perldl::max_keylen - length($key))) ;
+
+ whatis_r($pre,$indent + $PDL::Doc::Perldl::hash_indent, $a->{$key});
+ }
+ return;
+ }
+
+ if(ref $a eq 'CODE') {
+ print "${prefix}Perl CODE ref\n";
+ return;
+ }
+
+ if(ref $a eq 'SCALAR' | ref $a eq 'REF') {
+ whatis_r($prefix." Ref -> ",$indent+8,$$a);
+ return;
+ }
+
+ if(UNIVERSAL::can($a,'px')) {
+ my $b;
+ local $PDL::debug = 1;
+
+ $b = ( (UNIVERSAL::isa($a,'PDL') && $a->nelem < 5 && $a->ndims < 2)
+ ?
+ ": $a" :
+ ": *****"
+ );
+
+ $a->px($prefix.(ref $a)." %7T (%D) ".$b);
+
+ } else {
+
+ print "${prefix}Object: ".ref($a)."\n";
+
+ }
+}
+
+=head2 help
+
+=for ref
+
+print documentation about a PDL function or module or show a PDL manual
+
+In the case of multiple matches, the first command found is printed out,
+and the remaining commands listed, along with the names of their modules.
+
+
+=for usage
+
+ Usage: help 'func'
+
+=for example
+
+ pdl> help 'PDL::Tutorials' # show the guide to PDL tutorials
+ pdl> help 'PDL::Slices' # show the docs in the PDL::Slices module
+ pdl> help 'slice' # show docs on the 'slice' function
+
+=cut
+
+sub help_url {
+ local $_;
+ foreach(@INC) {
+ my $a = "$_/PDL/HtmlDocs/PDL/Index.html";
+ if(-e $a) {
+ return "file://$a";
+ }
+ }
+}
+
+sub help {
+ if ($#_>-1) {
+ require PDL::Dbg;
+ my $topic = shift;
+ if (PDL::Core::blessed($topic) && $topic->can('px')) {
+ local $PDL::debug = 1;
+ $topic->px('This variable is');
+ } else {
+ $topic = 'PDL::Doc::Perldl' if $topic =~ /^\s*help\s*$/i;
+ if ($topic =~ /^\s*vars\s*$/i) {
+ PDL->px((caller)[0]);
+ } elsif($topic =~ /^\s*url\s*/i) {
+ my $a = help_url();
+ if($a) {
+ print $a;
+ } else {
+ print "Hmmm. Curious: I couldn't find the HTML docs anywhere in \@INC...\n";
+ }
+ } elsif($topic =~ /^\s*www(:([^\s]+))?\s*/i) {
+ my $browser;
+ my $url = help_url();
+ if($2) {
+ $browser = $2;
+ } elsif($ENV{PERLDL_WWW}) {
+ $browser = $ENV{PERLDL_WWW};
+ } else {
+ $browser = 'mozilla';
+ }
+ chomp($browser = `which $browser`);
+ if(-e $browser && -x $browser) {
+ print "Spawning \"$browser $url\"...\n";
+ `$browser $url`;
+ }
+ } else {
+ finddoc($topic);
+ }
+ }
+ } else {
+ print <<'EOH';
+
+The following commands support online help in the perldl shell:
+
+ help 'thing' -- print docs on 'thing' (func, module, manual, autoload-file)
+ help vars -- print information about all current piddles
+ help url -- locate the HTML version of the documentation
+ help www -- View docs with default web browser (set by env: PERLDL_WWW)
+
+ whatis <expr> -- Describe the type and structure of an expression or piddle.
+ apropos 'word' -- search for keywords/function names
+ usage -- print usage information for a given PDL function
+ sig -- print signature of PDL function
+
+ ('?' is an alias for 'help'; '??' is an alias for 'apropos'.)
+EOH
+
+print " badinfo -- information on the support for bad values\n"
+ if $bvalflag;
+
+print <<'EOH';
+
+Quick start:
+ apropos 'manual:' -- Find all the manual documents
+ apropos 'module:' -- Quick summary of all PDL modules
+ help 'help' -- details about PDL help system
+ help 'perldl' -- help about this shell
+
+EOH
+ }
+}
+
+=head2 badinfo
+
+=for ref
+
+provides information on the bad-value support of a function
+
+And has a horrible name.
+
+=for usage
+
+ badinfo 'func'
+
+=cut
+
+# need to get this to format the output - want a format_bad()
+# subroutine that's like - but much simpler - than format_ref()
+#
+sub badinfo {
+ my $func = shift;
+ die "Usage: badinfo \$funcname\n" unless defined $func;
+
+ die "PDL has not been compiled with support for bad values.\n" .
+ "Recompile with WITH_BADVAL set to 1 in config file!.\n"
+ unless $bvalflag;
+
+ die "no online doc database" unless defined $PDL::onlinedoc;
+
+ local $SIG{PIPE}= sub {}; # Prevent crashing if user exits the pager
+
+ my @match = search_docs("m/^(PDL::)?$func\$/",['Name']);
+ if ( @match ) {
+ my ($name,$hash) = @{$match[0]};
+ my $info = $hash->{Bad};
+
+ if ( defined $info ) {
+ my $out = new IO::File "| pod2text | $PDL::Doc::pager";
+ print $out "=head1 Bad value support for $name\n\n$info\n";
+ } else {
+ print "\n No information on bad-value support found for $func\n";
+ }
+ } else {
+ print "\n no match\n";
+ }
+} # sub: badinfo()
+
+1; # OK
diff --git a/Doc/Makefile.PL b/Doc/Makefile.PL
new file mode 100644
index 0000000..6497ef5
--- /dev/null
+++ b/Doc/Makefile.PL
@@ -0,0 +1,27 @@
+
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+WriteMakefile(
+ 'NAME' => 'PDL::Doc',
+ 'VERSION_FROM' => '../Basic/Core/Version.pm',
+ 'LIBS' => [''], # e.g., '-lm'
+ 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
+ 'INC' => '', # e.g., '-I/usr/include/other'
+ 'dist' => { SUFFIX => "gz", COMPRESS => "gzip -f"},
+ 'PM' => { 'Doc.pm' =>
+ '$(INST_LIBDIR)/Doc.pm',
+ 'Doc/Config.pm' => '$(INST_LIBDIR)/Doc/Config.pm',
+ 'Doc/Perldl.pm' => '$(INST_LIBDIR)/Doc/Perldl.pm',
+ },
+ 'PL_FILES' => {q[Doc/Config.pm.PL]=>q[Doc/Config.pm]},
+# map {s/[.]PL$//; m/^Makefile$/ ? () : ($_.".PL" => $_)}
+# <*.PL>, <Doc/*.PL>
+# },
+ 'clean' => { 'FILES' => q[Doc/Config.pm] },
+# map {s/[.]PL$//; m/^Makefile$/ ?
+# () : $_}
+# <*.PL>, <Doc/*.PL> },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
diff --git a/Doc/README b/Doc/README
new file mode 100644
index 0000000..274a031
--- /dev/null
+++ b/Doc/README
@@ -0,0 +1,106 @@
+This is a first try to get something like online help for PDL.
+Building proceeds as usual:
+
+ perl Makefile.PL
+ make
+
+Then there are a few things you should try:
+
+1) Scan the current PDL distribution (PDL-1.94_05 + PATCHES)
+ for online help info:
+
+ perl -Mblib scantree.pl
+
+and specify the location of your *installed* PDL distribution
+(either the default or YOUR_PDL_DIR/blib/lib/PDL if you haven't
+installed it) when asked to do so.
+
+2) Try the online doc support from within perldl (in the root
+directory of the PDL-Doc distribution):
+
+ perldl
+
+and at the perldl prompt, type 'help':
+
+ perldl> help
+
+and proceed from there.
+For details check the supplied file 'local.perldlrc'.
+
+3) If you want to see which info has been picked from your POD documentation
+try
+
+ perl -Mblib docscan <filename>
+
+in the root directory of the PDL-Doc distribution.
+
+4) Once you have built the online info database (see step 1)
+try the example that builds a 'pdlfunc' manpage by saying:
+
+ perl -Mblib mkpdlfuncpod >pdlfunc.pod
+
+This is just a demonstration of what should become possible once the
+online docs work correctly.
+
+5) If you prefer the itemised listing of PDL functions in
+the manpage version, try
+
+ perl -Mblib pdlhead2item <filename.pm> > <tmpname.pod>
+ pod2man <tmpname.pod> | nroff -man | more
+
+that translates the <=head2> directives into an itemised list. This
+is again just a demo what can be done.
+
+For info about the POD format conventions used by the PDL podparser
+to identify the online documentation check the docs in Doc.pm.
+
+There are still quite a few shortcomings in the implementation:
+
+1) the podparser code is currently a bit messy
+
+2) scanning is done very naively. No real checks are made if a function
+is documented in several files, etc. Needs to be done once integerated
+with the PDL distrib.
+
+3) Scanning and database updating should be integerated with the
+build process. An updating policy should be developed.
+
+4) The PP changes to support the new doc style are poorly documented,
+for the moment refer to the examples supplied in the patches to
+PDL-1.94_05. Briefly, the 'Doc' key has been introduced and PP will
+generate the
+
+ =head2 funcname
+
+ =for sig
+
+ Signature: (...)
+
+entries automatically. No docs are generated if you say
+
+ pp_def('XXXXfunc',
+ Doc => 'internal',...
+ );
+
+pp_addpm has been changed to optionally accept an option hash ref
+to specify if the pm text should be inserted at the top, in the middle
+or at the bottom. I'm not sure of this is necessary/a good solution yet.
+
+6) If the symhash should grow beyond the point where it is practical
+to hold it all in memory the implementation should use some kind
+of cached AnyDBM inplementation.
+
+7) and probably lots of other things...
+
+ Christian Soeller <c.soeller at auckland.ac.nz>
+
+
+Changes for intergration in to PDL distribution
+
+- changed scantree.pl to take args for directory, database.
+- moved local.perldlrc into PDL::Doc::Perldl module
+- Made "borrowed" Pod:: stuff into PDL::Pod:: for now.
+
+ Karl Glazebrook <kgb at aaoepp.aao.gov.au>
+
+
diff --git a/Doc/TODO b/Doc/TODO
new file mode 100644
index 0000000..046ece2
--- /dev/null
+++ b/Doc/TODO
@@ -0,0 +1,9 @@
+- rearrange hash structure to
+
+ root->{Module}->{Funcname}
+
+ to avoid name clashes
+
+- warn about duplicate documentation
+
+- policy to integrate with build process
diff --git a/Doc/mkhtmldoc.pl b/Doc/mkhtmldoc.pl
new file mode 100644
index 0000000..a5e4307
--- /dev/null
+++ b/Doc/mkhtmldoc.pl
@@ -0,0 +1,309 @@
+
+#
+# Should be called like
+#
+# perl mkhtmldoc.pl [FULLPATH_TO_SOURCE] [FULLPATH_TO_HTMLDIR]
+#
+# for example
+#
+# perl mkhtmldoc.pl `pwd`/blib/lib `pwd`/html
+#
+# reverted to use Pod::Html from normal perl distrib
+# Christian
+#
+# (mod. by Tjl)
+
+use File::Find;
+use File::Basename;
+use File::Basename;
+use Getopt::Std;
+use Pod::Html;
+use Cwd;
+
+use IO::File; # for hack_links()
+
+$opt_v = 0;
+$opt_s = '';
+
+getopts('vs:');
+my $verbose = $opt_v;
+my ($strip_path,$add_path) = split(/,/,$opt_s);
+
+##############################################################
+## Subroutines
+
+sub has_pod # does file contain HTML-able pod?
+{
+ my $line; #mustn't clobber $_ during find
+ open(POD,shift) || return 0;
+ while ($line=<POD>) {return 1 if $line =~ /^=head/} # only a guess, avoids "=for nobody", etc.
+ return 0;
+}
+
+sub mkdir_p ($$$) {
+ return if -d $_[0];
+# my @dirs = File::Spec->splitdir($_[0]);
+ my @dirs = split '/', $_[0];
+ pop @dirs;
+ if(!@dirs) {die "Couldn't create directory $_[2]"}
+# my $dir = File::Spec->catdir( @dirs );
+ my $dir = join '/', @dirs;
+ mkdir_p ($dir, $_[1], $_[2]);
+ print "Creating directory $_[0]\n" if $verbose;
+ mkdir $_[0], $_[1] or die "Couldn't create directory $_[0]";
+}
+
+# Replace PDL/...|PDL/... with PDL/...
+# as Pod::Html v1.01 (perlv 5.005_03 )
+# doesn't seem to be able to handle
+# L<PDL::PDL|PDL::PDL> correctly
+#
+# (not necessary for perl 5.6.0)
+#
+sub hack_html ($) {
+ my $infile = shift;
+ my $outfile = "${infile}.n";
+
+ my $ifh = new IO::File "<$infile"
+ or die "ERROR: Unable to read from <$infile>\n";
+ my $ofh = new IO::File ">$outfile"
+ or die "ERROR: Unable to write to <$outfile>\n";
+
+ # assume that links do not break across a line
+ while ( <$ifh> ) {
+ # fix the links
+ s{PDL/([^|]+)\|PDL/\1}{PDL/$1}g;
+ # fix the text of the link
+ s{PDL::([^|]+)\|PDL::\1}{PDL::$1}g;
+ # now fix any links for scripts
+ s{/([^|]+)\|PDL/\1}{/PDL/$1}g;
+ s{([^|]+)\|PDL::\1}{$1}g;
+ print $ofh $_;
+ }
+ $ifh->close;
+ $ofh->close;
+
+ rename $outfile, $infile
+ or die "ERROR: Unable to rename $outfile\n";
+}
+
+sub fix_pdl_dot_html ($) {
+##Links to PDL.html sensibly try to go up one too many directories
+##(e.g., to "../PDL.html" instead of "PDL.html"). This hopefully
+##fixes that. Shamelessly ripped off hack_html() above.
+ my $infile = shift;
+ my $outfile = "${infile}.n";
+
+ my $ifh = new IO::File "<$infile"
+ or die "ERROR: Unable to read from <$infile>\n";
+ my $ofh = new IO::File ">$outfile"
+ or die "ERROR: Unable to write to <$outfile>\n";
+
+ # assume that links do not break across a line
+ while ( <$ifh> ) {
+ # fix the links
+ s{\.\.\/PDL\.html}{PDL.html}g;
+ print $ofh $_;
+ }
+ $ifh->close;
+ $ofh->close;
+
+ rename $outfile, $infile
+ or die "ERROR: Unable to rename $outfile\n";
+}
+
+sub fix_html_path ($) {
+ my $infile = shift;
+ my $outfile = "${infile}.n";
+
+ my $ifh = new IO::File "<$infile"
+ or die "ERROR: Unable to read from <$infile>\n";
+ my $ofh = new IO::File ">$outfile"
+ or die "ERROR: Unable to write to <$outfile>\n";
+
+ # assume that links do not break across a line
+ while ( <$ifh> ) {
+ # fix the links
+ s{a href="$strip_path}{a href="$add_path}g;
+ print $ofh $_;
+ }
+ $ifh->close;
+ $ofh->close;
+
+ rename $outfile, $infile
+ or die "ERROR: Unable to rename $outfile\n";
+}
+
+sub fix_pp_inline ($) {
+ my $infile = shift;
+ my $outfile = "${infile}.n";
+
+ my $ifh = new IO::File "<$infile"
+ or die "ERROR Unable to read from <$infile>\n";
+ my $ofh = new IO::File ">$outfile"
+ or die "ERROR: Unable to write to <$outfile>\n";
+
+ # assume that links do not break across a line
+ while ( <$ifh> ) {
+ #fix the links
+ s|a href="../Inline/Pdlpp.html"|a href="./PP-Inline.html"|g;
+ print $ofh $_;
+ }
+ $ifh->close;
+ $ofh->close;
+ rename $outfile, $infile
+ or die "ERROR: Unable to rename $outfile\n";
+}
+
+##############################################################
+## Code
+
+$SIG{__DIE__} = sub {print Carp::longmess(@_); die;};
+
+$back = getcwd;
+$startdir = shift @ARGV; #$ARGV[0];
+
+unless (defined $startdir) {
+ require PDL;
+ ($startdir = $INC{'PDL.pm'}) =~ s/\.pm$//i;
+ umask 0022;
+}
+die "couldn't find directory '$startdir'" unless -d $startdir;
+chdir $startdir or die "can't change to $startdir";
+$startdir = getcwd; # Hack to get absolute pathname
+chdir $back;
+
+$htmldir = shift @ARGV; #$ARGV[1];
+#$htmldir = File::Spec->catdir( $startdir, "HtmlDocs", "PDL" )
+$htmldir = "${startdir}/HtmlDocs/PDL"
+ unless defined $htmldir;
+
+mkdir_p $htmldir, 0777, $htmldir;
+chdir $htmldir or die "can't change to $htmldir";
+$htmldir = getcwd; # Hack to get absolute pathname
+chdir $back;
+
+#my $updir = File::Spec->updir;
+
+print "Making HTML docs...\n\n";
+
+print "Put HTML $htmldir\n" if $verbose;
+print "Scanning $startdir ... \n\n" if $verbose;
+$sub = sub {
+ return unless $File::Find::name =~ /[.]pod$/ or
+ ($File::Find::name =~ /[.]pm$/ and
+ $File::Find::name !~ /PP.pm/ and
+ $File::Find::dir !~ m{/PP|/Gen});
+
+# if (($File::Find::name =~ /[.]pm$/ and
+# $File::Find::name !~ /PP.pm/ and
+# $File::Find::dir !~ m#/PP|/Gen#) or
+# $File::Find::name =~ /[.]pod$/) {
+
+ if (!&has_pod($File::Find::name)) {
+ printf STDERR "%-30s\n", $_ ."... skipped (no pod)"
+ if $verbose;
+ return;
+ }
+
+ my $re = "\Q$startdir\E"; # ach: '+' in $outdir here!
+
+ my $outdir = $File::Find::dir;
+ # $outdir =~ s/$re/$htmldir/;
+ $outdir =~ s/$re//;
+ $outdir =~ /(^\/)?(.*)$/;
+
+ my $basename = basename($File::Find::name);
+ my $outfi;
+
+ # Special case for needed for PDL.pm file since it is in a
+ # different location than the other .pm and pod files.
+ if( $basename eq 'PDL.pm'){
+ $outfi = $basename;
+ } else {
+ $outfi = $2.($2 =~ /^\s*$/ ? '' : '/').$basename;
+ #
+ # with the following substitution, everything gets stored in the same directory -
+ # so PDL/Graphics/LUT -> PDL_Graphics_LUT for example
+ #
+ #$outfi =~ s|/|_|g;
+ }
+
+ # create the output directory, if required
+ if ( $outdir ne "" ) {
+# $outdir = File::Spec->catdir( $htmldir, $outdir );
+ $outdir = "${htmldir}/${outdir}";
+ mkdir_p $outdir, 0777, $outdir;
+ }
+
+ # print "outdir = $outdir, making $outfi\n"; return;
+ # mkdir_p $outdir, 0777, $outdir;
+
+ my $file = $File::Find::name;
+# my $outfile = File::Spec->catfile( $htmldir, $outfi );
+ my $outfile = "${htmldir}/${outfi}";
+ $outfile =~ s/[.](pm|pod)$//;
+ $outfile .= ".html";
+ printf STDERR "%-30s\n", $_ ."..."; # > $outfile";
+
+ chdir $htmldir; # reuse our pod caches
+ my $topPerlDir = $startdir;
+
+ # get Directory just above PDL for podroot arg
+ $topPerlDir = $1 if ($startdir =~ /^(.+?)\/PDL$/);
+ print "startdir: $startdir, podroot: $topPerlDir\n" if $verbose;
+
+ # instead of having htmlroot="../../.."
+ # (or even File::Spec->catdir( $updir, $updir, $updir ) )
+ # calculate it from the known location of the
+ # file we're creating
+ my $htmlrootdir = $htmldir;
+ $htmlrootdir =~ s|PDL$||;
+
+ my $verbopts = $verbose ? "--verbose" : "--quiet";
+
+ if($] > 5.015) {
+ # With perl 5.15.x (for some value of x) and later, '--libpods' is invalid
+ # and hence needs to be removed.
+ # Beginning with 5.15.x, the generated PDL html docs are a little different
+ # (missing some underlining of headings and some <b></b> tagging), though
+ # this appears to have nothing to do with the removal of --libpods. Rather,
+ # it seems to be the result of some other change to pod2html. Perhaps this
+ # can be addressed over time. SIS 23-Feb-2012
+ pod2html("--podpath=.",
+ "--podroot=$topPerlDir",
+ "--htmldir=$htmlrootdir",
+ "--recurse",
+ "--infile=$file",
+ "--outfile=$outfile",
+ $verbopts,
+ );
+ }
+ else {
+ # Cut out "PDL" from the podpath as it crashes the podscan(!) - It doesn't
+ # seem to help either -- it looks for cached docs in .../HtmlDocs/pdl/PDL,
+ # which is silly. I left this note because pod paths are pretty arcane to
+ # me. CED 11-Mar-2009
+ # pod2html("--podpath=PDL:.",
+ pod2html("--podpath=.",
+ "--podroot=$topPerlDir",
+ "--htmldir=$htmlrootdir",
+ "--libpods=perlfaq",
+ "--recurse",
+ "--infile=$file",
+ "--outfile=$outfile",
+ $verbopts,
+ );
+ }
+ hack_html( $outfile ) if $] < 5.006;
+ fix_pdl_dot_html( $outfile);
+ fix_html_path( $outfile);
+ fix_pp_inline( $outfile);
+
+ chdir $File::Find::dir; # don't confuse File::Find
+};
+
+#File::Find::find($sub,$startdir,File::Spec->catdir( $startdir, $updir, "PDL.pm"));
+File::Find::find( $sub, $startdir, "${startdir}/../PDL.pm" );
+
+## End
diff --git a/Doc/mkpdlfuncpod b/Doc/mkpdlfuncpod
new file mode 100644
index 0000000..a5149c3
--- /dev/null
+++ b/Doc/mkpdlfuncpod
@@ -0,0 +1,93 @@
+use PDL::Doc;
+use PDL::Doc::Perldl;
+
+# @dontmod = qw/ PDL::Graphics::TriD::Tk /;
+%Category = (
+ IO => '^PDL::IO',
+ Graphics => '^PDL::Graphics',
+ Core => '^PDL::Core|
+ ^PDL::Primitive|
+ ^PDL::Slices|
+ ^PDL::Math|
+ ^PDL::Basic',
+ Lib => '^PDL::Image
+ |^PDL::Slatec
+ |^PDL::FFT
+ |^PDL::Filter
+ |^PDL::Fit
+ |^PDL::Gaussian
+ |^PDL::GSL',
+ Dev => '^PDL::Types
+ |^PDL::Dbg
+ |^PDL::Options
+ |^PDL::Autoloader
+ |^PDL::Callext
+ |^PDL::Doc::Perldl',
+ Derived => '^PDL::Complex
+ |^PDL::Char
+ |^PDL::Func',
+ );
+
+sub nofunc {
+ my ($func,$hash) = @_;
+ if ($func =~ /AUTOLOAD
+ |MainLoop
+ /xs ||
+ $hash->{Ref} =~ /^internal$/)
+ { print STDERR "skipping $func\n"; return 1 } else { return 0 }
+}
+
+
+# a very simple script to generate a huge manpage of all documented
+# PDL functions
+# mainly to demonstrate what we can do with the new doc format
+
+print << 'EOD';
+
+=head1 NAME
+
+pdlfunc - Functions in the PDL distribution
+
+=head1 DESCRIPTION
+
+This is a listing of all documented functions in the PDL distribution.
+
+=head2 Alphabetical Listing of PDL Functions
+
+=over 8
+
+EOD
+
+$onldc = $PDL::onlinedoc; # new PDL::Doc ('/tmp/pdlhash.dbtxt');
+$db = $onldc->ensuredb;
+while (my ($key,$val) = each %$db) {
+ my $strip = $key;
+ $strip =~ s/PDL.*::(.*)$/$1/;
+ $val->{Stripped} = $strip;
+}
+
+ at match = $onldc->search('.*',['Name'],1);
+ at match = sort {lc $a->[1]->{Stripped} cmp lc $b->[1]->{Stripped}} @match;
+
+for (@match) {
+ next if $_->[1]->{Ref} =~ /(Module|Manual):/ ||
+ nofunc $_->[1]->{Stripped}, $_->[1];
+ $sh = new StrHandle;
+ print STDERR "function $_->[0] ($_->[1]->{Stripped})\n";
+ $onldc->funcdocs($_->[0],$sh);
+ $mod = "\n\nModule: $_->[1]->{Module}\n\n";
+ $stripped = $_->[1]->{Stripped};
+ $txt = $sh->text;
+ $txt =~ s/=head2 (.*)$/=item $stripped$mod/mg;
+ $txt =~ s/^=cut\s*$//mg;
+ $txt =~ s/^=for.*$//mg;
+ $txt =~ s/Docs from .*$//mg;
+ print $txt;
+}
+
+print <<'EOD';
+
+=back
+
+EOD
+
diff --git a/Doc/scantree.pl b/Doc/scantree.pl
new file mode 100644
index 0000000..0706719
--- /dev/null
+++ b/Doc/scantree.pl
@@ -0,0 +1,130 @@
+use PDL::Doc;
+use Getopt::Std;
+use Config;
+use Cwd;
+
+require PDL; # always needed to pick up PDL::VERSION
+
+$opt_v = 0;
+
+getopts('v');
+$dir = shift @ARGV;
+$outdb = shift @ARGV;
+$outindex = shift @ARGV;
+
+unless (defined $dir) {
+ ($dir = $INC{'PDL.pm'}) =~ s/PDL\.pm$//i;
+ umask 0022;
+ print "DIR = $dir\n";
+}
+unless (defined $outdb) {
+ $outdb = "$dir/PDL/pdldoc.db";
+ print "DB = $outdb\n";
+}
+
+$currdir = getcwd;
+
+chdir $dir or die "can't change to $dir";
+$dir = getcwd;
+
+unlink $outdb if -e $outdb;
+$onldc = new PDL::Doc();
+$onldc->outfile($outdb);
+$onldc->scantree($dir."/PDL",$opt_v);
+$onldc->scan($dir."/PDL.pm",$opt_v);
+
+chdir $currdir;
+
+print STDERR "saving...\n";
+$onldc->savedb();
+ at mods = $onldc->search('module:',['Ref'],1);
+ at mans = $onldc->search('manual:',['Ref'],1);
+ at scripts = $onldc->search('script:',['Ref'],1);
+$outdir = "$dir/PDL";
+# ($outdir = $INC{'PDL.pm'}) =~ s/\.pm$//i;
+$outindex="$outdir/Index.pod" unless (defined $outindex);
+unlink $outindex if -e $outindex; # Handle read only file
+open POD, ">$outindex"
+ or die "couldn't open $outindex";
+print POD <<'EOPOD';
+
+=head1 NAME
+
+PDL::Index - an index of PDL documentation
+
+=head1 DESCRIPTION
+
+A meta document listing the documented PDL modules and
+the PDL manual documents
+
+=head1 PDL manuals
+
+EOPOD
+
+#print POD "=over ",$#mans+1,"\n\n";
+print POD "=over 4\n\n";
+for (@mans) {
+ my $ref = $_->[1]->{Ref};
+ $ref =~ s/Manual:/L<$_->[0]|$_->[0]> -/;
+## print POD "=item L<$_->[0]>\n\n$ref\n\n";
+# print POD "=item $_->[0]\n\n$ref\n\n";
+ print POD "=item *\n\n$ref\n\n";
+}
+
+print POD << 'EOPOD';
+
+=back
+
+=head1 PDL scripts
+
+EOPOD
+
+#print POD "=over ",$#mods+1,"\n\n";
+print POD "=over 4\n\n";
+for (@scripts) {
+ my $ref = $_->[1]->{Ref};
+ $ref =~ s/Script:/L<$_->[0]|PDL::$_->[0]> -/;
+## print POD "=item L<$_->[0]>\n\n$ref\n\n";
+# print POD "=item $_->[0]\n\n$ref\n\n";
+ print POD "=item *\n\n$ref\n\n";
+}
+
+print POD << 'EOPOD';
+
+=back
+
+=head1 PDL modules
+
+EOPOD
+
+#print POD "=over ",$#mods+1,"\n\n";
+print POD "=over 4\n\n";
+for (@mods) {
+ my $ref = $_->[1]->{Ref};
+ next unless $_->[0] =~ /^PDL/;
+ if( $_->[0] eq 'PDL'){ # special case needed to find the main PDL.pm file.
+ $ref =~ s/Module:/L<PDL::PDL|PDL::PDL> -/;
+## print POD "=item L<PDL::PDL>\n\n$ref\n\n";
+# print POD "=item PDL::PDL\n\n$ref\n\n";
+ print POD "=item *\n\n$ref\n\n";
+ next;
+ }
+ $ref =~ s/Module:/L<$_->[0]|$_->[0]> -/;
+## print POD "=item L<$_->[0]>\n\n$ref\n\n";
+# print POD "=item $_->[0]\n\n$ref\n\n";
+ print POD "=item *\n\n$ref\n\n";
+}
+
+print POD << "EOPOD";
+
+=back
+
+=head1 HISTORY
+
+Automatically generated by scantree.pl for PDL version $PDL::VERSION.
+
+EOPOD
+
+close POD;
+
+
diff --git a/Example/Benchmark/Bench.pm b/Example/Benchmark/Bench.pm
new file mode 100644
index 0000000..156790a
--- /dev/null
+++ b/Example/Benchmark/Bench.pm
@@ -0,0 +1,39 @@
+# Old results: approx. 1.91_03: 34 secs (512, 10 iter)
+# With simply folded-out threading: 3.4 secs (10fold!)
+
+# For 512,30iter:
+
+package PDL::Bench;
+
+use vars qw(@ISA @EXPORT $AUTOLOAD);
+
+require Exporter;
+require DynaLoader;
+
+ at ISA = qw(Exporter DynaLoader);
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+ at EXPORT = qw(
+ do_benchmark
+);
+
+bootstrap PDL::Bench;
+
+use Benchmark;
+
+sub do_benchmark {
+ $size = 512;
+ $niter = 80;
+ $piddle = (PDL->zeroes($size,$size));
+ $dref = ${$piddle->get_dataref()};
+ timethese($niter, {
+# 'With double piddle' => 'for($i=0; $i<100; $i++) {$piddle++}',
+ 'With double piddle' => '$piddle++;',
+ 'C using ++' => 'c_use_pp($dref)',
+ 'C using foo = bar + baz' => 'c_use_add($dref,$dref,$dref)',
+ 'C using incrs and foo = bar + baz' => 'c_use_add_incr($dref,$dref,$dref,1,1,1)'
+ });
+}
+
+1;
diff --git a/Example/Benchmark/Bench.xs b/Example/Benchmark/Bench.xs
new file mode 100644
index 0000000..6a566ae
--- /dev/null
+++ b/Example/Benchmark/Bench.xs
@@ -0,0 +1,58 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#ifdef __cplusplus
+}
+#endif
+
+MODULE = PDL::Bench PACKAGE = PDL::Bench
+
+void
+c_use_pp(sv)
+ SV *sv;
+ CODE:
+ /* Let's hope the C compiler isn't smart enough to optimize
+ * away everything
+ */
+ double *p = (double *) SvPV(sv,PL_na);
+ int i = SvCUR(sv) / sizeof(double);
+ while(i--) {
+ (*p)++; p++;
+ }
+
+void
+c_use_add(sv1,sv2,sv3)
+ SV *sv1;
+ SV *sv2;
+ SV *sv3;
+ CODE:
+ double *p1 = (double *) SvPV(sv1,PL_na);
+ int i = SvCUR(sv1) / sizeof(double);
+ double *p2 = (double *) SvPV(sv2,PL_na);
+ double *p3 = (double *) SvPV(sv3,PL_na);
+ while(i--) {
+ *p1 = *p2 + *p3;
+ p1 ++; p2 ++; p3 ++;
+ }
+
+void
+c_use_add_incr(sv1,sv2,sv3,i1,i2,i3)
+ SV *sv1;
+ SV *sv2;
+ SV *sv3;
+ int i1;
+ int i2;
+ int i3;
+ CODE:
+ double *p1 = (double *) SvPV(sv1,PL_na);
+ int i = SvCUR(sv1) / sizeof(double);
+ double *p2 = (double *) SvPV(sv2,PL_na);
+ double *p3 = (double *) SvPV(sv3,PL_na);
+ while(i--) {
+ *p1 = *p2 + *p3;
+ p1 += i1; p2 += i2; p3 += i3;
+ }
+
diff --git a/Example/Benchmark/Makefile.PL b/Example/Benchmark/Makefile.PL
new file mode 100644
index 0000000..831fc9a
--- /dev/null
+++ b/Example/Benchmark/Makefile.PL
@@ -0,0 +1,10 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'PDL::Bench',
+ 'VERSION_FROM' => '../../Basic/Core/Version.pm', # finds $VERSION
+ 'LIBS' => [''], # e.g., '-lm'
+ 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
+ 'INC' => '', # e.g., '-I/usr/include/other'
+);
diff --git a/Example/Benchmark/README b/Example/Benchmark/README
new file mode 100644
index 0000000..ac9108e
--- /dev/null
+++ b/Example/Benchmark/README
@@ -0,0 +1,6 @@
+Just say "perl Makefile.PL" and run time.pl to obtain timing data
+for your machine.
+
+You can edit Bench.pm for different parameters / running times if
+your machine is very slow or very fast.
+
diff --git a/Example/Benchmark/time.pl b/Example/Benchmark/time.pl
new file mode 100644
index 0000000..ef8de24
--- /dev/null
+++ b/Example/Benchmark/time.pl
@@ -0,0 +1,11 @@
+use blib ".";
+use blib "../..";
+use PDL;
+# use PDL::Bench;
+BEGIN{
+require "Bench.pm";
+PDL::Bench->import();
+}
+
+
+do_benchmark();
diff --git a/Example/Fit/lmfit_example.pl b/Example/Fit/lmfit_example.pl
new file mode 100644
index 0000000..1a27fab
--- /dev/null
+++ b/Example/Fit/lmfit_example.pl
@@ -0,0 +1,87 @@
+use PDL;
+use PDL::Math;
+use PDL::Fit::LM;
+use strict;
+
+
+### fit using pdl's lmfit (Marquardt-Levenberg non-linear least squares fitting)
+###
+### `lmfit' Syntax:
+###
+### ($ym,$a,$covar,$iters)
+### = lmfit $x, $y, $sig, \&fn, $initp, {Maxiter => 300, Eps => 1e-3};
+###
+### Explanation of variables
+###
+### OUTPUT
+### $ym = pdl of fitted values
+### $a = pdl of paramters
+### $covar = covariance matrix
+### $iters = number of iterations actually used
+###
+### INPUT
+### $x = x data
+### $y = y data
+### $sig = weights for y data (can be set to scalar 1 for equal weighting)
+### \&fn = reference to function provided by user (more on this below)
+### $initp = initial values for floating parameters
+### (needs to be explicitly set prior to use of lmfit)
+### Maxiter = maximum iterations
+### Eps = convergence criterium (maximum normalized change in Chi Sq.)
+
+### Example:
+# make up experimental data:
+my $xdata = pdl sequence 5;
+my $ydata = pdl [1.1,1.9,3.05,4,4.9];
+
+# set initial prameters in a pdl (order in accord with fit function below)
+my $initp = pdl [0,1];
+
+# Weight all y data equally (else specify different weights in a pdl)
+my $wt = 1;
+
+# Use lmfit. Fourth input argument is reference to user-defined
+# subroutine ( here \&linefit ) detailed below.
+my ($yf,$pf,$cf,$if) = lmfit $xdata, $ydata, $wt, \&linefit, $initp;
+
+# Note output
+print "\nXDATA\n$xdata\nY DATA\n$ydata\n\nY DATA FIT\n$yf\n\n";
+print "Slope and Intercept\n$pf\n\nCOVARIANCE MATRIX\n$cf\n\n";
+print "NUMBER ITERATIONS\n$if\n\n";
+
+
+# simple example of user defined fit function. Guidelines included on
+# how to write your own function subroutine.
+sub linefit {
+
+ # leave this line as is
+ my ($x,$par,$ym,$dyda) = @_;
+
+ # $m and $b are fit parameters, internal to this function
+ # call them whatever make sense to you, but replace (0..1)
+ # with (0..x) where x is equal to your number of fit parameters
+ # minus 1
+ my ($m,$b) = map { $par->slice("($_)") } (0..1);
+
+ # Write function with dependent variable $ym,
+ # independent variable $x, and fit parameters as specified above.
+ # Use the .= (dot equals) assignment operator to express the equality
+ # (not just a plain equals)
+ $ym .= $m * $x + $b;
+
+ # Edit only the (0..1) part to (0..x) as above
+ my (@dy) = map {$dyda -> slice(",($_)") } (0..1);
+
+ # Partial derivative of the function with respect to first
+ # fit parameter ($m in this case). Again, note .= assignment
+ # operator (not just "equals")
+ $dy[0] .= $x;
+
+ # Partial derivative of the function with respect to next
+ # fit parameter ($b in this case)
+ $dy[1] .= 1;
+
+ # Add $dy[ ] .= () lines as necessary to supply
+ # partial derivatives for all floating paramters.
+}
+
diff --git a/Example/IO/wmpeg.pl b/Example/IO/wmpeg.pl
new file mode 100644
index 0000000..d9dab43
--- /dev/null
+++ b/Example/IO/wmpeg.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+#
+# Created on: Wed 28 Jul 2010 03:41:45 PM
+# Last saved: Thu 10 Feb 2011 05:10:44 PM
+
+use PDL;
+use PDL::IO::Pic;
+use PDL::NiceSlice;
+
+# This is a simple program to create a demo MPEG-1
+# movie via the wmpeg() routine in PDL::IO::Pic
+# and to test the functionality of using ffmpeg
+# in place of the outdated mpeg_encoder.
+
+# a simple parabolic trajectory ("bouncing ball")
+# for 30 128x80 image frames
+our $coords = pdl( q[
+ [ 0 1 0]
+ [ 4 9 1]
+ [ 8 17 2]
+ [ 12 25 3]
+ [ 16 32 4]
+ [ 20 38 5]
+ [ 24 43 6]
+ [ 28 48 7]
+ [ 32 53 8]
+ [ 36 57 9]
+ [ 40 60 10]
+ [ 44 62 11]
+ [ 48 64 12]
+ [ 52 66 13]
+ [ 56 66 14]
+ [ 60 66 15]
+ [ 64 66 16]
+ [ 68 65 17]
+ [ 72 63 18]
+ [ 76 60 19]
+ [ 80 57 20]
+ [ 84 54 21]
+ [ 88 50 22]
+ [ 92 45 23]
+ [ 96 39 24]
+ [100 33 25]
+ [104 27 26]
+ [108 19 27]
+ [112 11 28]
+ [116 3 29]
+ ] );
+
+our $frames = zeros byte, 128, 80, 30;
+our $val = pdl(byte,250); # start with white
+
+# make the square ball bounce
+$frames->range($coords,[10,10,1]) .= $val;
+
+# now make the movie
+$frames = $frames->(*3)->copy;
+# the encoding type is from the suffix
+# .mp4 seems to work better than .mpg on
+# Windows Media Player
+$frames->wmpeg('bounce.mp4'); # use bounce.gif for animated GIF
+ # output (uncompressed => big)
diff --git a/Example/InlinePdlpp/Module/Makefile.PL b/Example/InlinePdlpp/Module/Makefile.PL
new file mode 100644
index 0000000..eb90102
--- /dev/null
+++ b/Example/InlinePdlpp/Module/Makefile.PL
@@ -0,0 +1,8 @@
+use Inline::MakeMaker; # to allow us to install the inlined code !
+
+# Note use of 'WriteInlineMakefile' in place of the normal
+# 'WriteMakefile' call! Syntax of args is identical to MakeMaker.
+WriteInlineMakefile(
+ 'NAME' => 'PDL::MyInlineMod',
+ 'VERSION_FROM' => 'MyInlineMod.pm', # finds $VERSION
+);
diff --git a/Example/InlinePdlpp/Module/MyInlineMod.pm b/Example/InlinePdlpp/Module/MyInlineMod.pm
new file mode 100644
index 0000000..54a6270
--- /dev/null
+++ b/Example/InlinePdlpp/Module/MyInlineMod.pm
@@ -0,0 +1,119 @@
+# Below is the stub of documentation for your module. You better edit it!
+
+=head1 NAME
+
+PDL::MyInlineMod - a simple PDL module containing inlined Pdlpp code
+
+=head1 SYNOPSIS
+
+ use PDL::MyInlineMod;
+
+ $a = zeroes 10, 10;
+ $twos = $a->plus2; # a simple function
+
+=head1 DESCRIPTION
+
+A simple example module that demonstrates the usage of inlined Pdlpp
+in a module that can be installed in the usual way.
+
+=head1 FUNCTIONS
+
+=cut
+
+package PDL::MyInlineMod;
+
+# use strict; # strict results in trouble with barewords when using Inline :(
+# no strict 'vars';
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+require PDL::Exporter;
+ at ISA = qw(PDL::Exporter);
+# functions you want to export into the caller's name space
+ at EXPORT_OK = qw(myinc plus2);
+%EXPORT_TAGS = (Func=>[@EXPORT_OK]);
+
+BEGIN { # in BEGIN to make sure we can use $VERSION in the
+ # 'use Inline...' call below
+$VERSION = '0.60'; # Inline requires this to be a *string* that matches
+ # /^\d\.\d\d$/
+ # see Inline-FAQ for more info
+}
+
+use PDL::LiteF;
+
+# quirk 1 follows
+use Inline::MakePdlppInstallable; # allow installation of this module
+
+use Inline Pdlpp => DATA => # inlined PP code is below in DATA section
+ NAME => PDL::MyInlineMod, # required info for module installation
+ VERSION => $VERSION; # ditto, see Inline-FAQ for more info
+
+# quirk 2 follows
+Inline->init; # you need this if you want to 'use' your module
+ # from within perldl or pdl2 and your Pdlpp code
+ # resides in the DATA section (as in this example)
+
+# following required to make exported functions work!
+# PDL::PP used to make these automatically but now we have
+# to make them manually since *we* are writing the pm-file
+*myinc = \&PDL::myinc; # make alias in this module's name space
+*plus2 = \&PDL::plus2; # ditto
+
+1;
+
+__DATA__
+
+__Pdlpp__
+
+# some simple functions to test the whole thing
+
+=head2 myinc
+
+=for ref
+
+a very simple pp function that increments its argument
+
+=for sig
+
+ myinc(i();[o] o())
+
+=cut
+
+pp_def('myinc',
+ Pars => 'i();[o] o()',
+ Code => '$o() = $i() + 1;',
+ );
+
+=head2 plus2
+
+=for ref
+
+a very simple pp function that increments its argument by 2
+
+=for sig
+
+ plus2(i();[o] o())
+
+=cut
+
+pp_def('plus2',
+ Pars => 'i();[o] o()',
+ Code => '$o() = $i() + 2;',
+ );
+
+=head1 AUTHOR
+
+C. Soeller (C) 2002. All rights reserved. This code can be distributed
+under the same terms as PDL itself (see the file COPYING in the PDL
+distribution).
+
+=head1 SEE ALSO
+
+perl(1).
+
+L<Inline>.
+
+L<Inline::Pdlpp>.
+
+=cut
+
diff --git a/Example/InlinePdlpp/Module/t/myinlinemod.t b/Example/InlinePdlpp/Module/t/myinlinemod.t
new file mode 100644
index 0000000..89d68e5
--- /dev/null
+++ b/Example/InlinePdlpp/Module/t/myinlinemod.t
@@ -0,0 +1,33 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..3\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use PDL::MyInlineMod;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+use PDL::LiteF;
+my $a = zeroes 10;
+my $b = $a->myinc;
+print "$b\n";
+
+print 'not ' unless all $b == 1;
+print "ok 2\n";
+
+my $c = $a->plus2;
+print "$c\n";
+print 'not ' unless all $c == 2;
+print "ok 3\n";
+
diff --git a/Example/InlinePdlpp/inlpp.pl b/Example/InlinePdlpp/inlpp.pl
new file mode 100644
index 0000000..c78def5
--- /dev/null
+++ b/Example/InlinePdlpp/inlpp.pl
@@ -0,0 +1,29 @@
+use blib;
+use PDL; # this must be called before (!) 'use Inline Pdlpp' calls
+use Inline Pdlpp; # the actual code is in the __Pdlpp__ block below
+
+$a = sequence 10;
+print $a->inc,"\n";
+print $a->inc->dummy(1,10)->tcumul,"\n";
+
+__DATA__
+
+__Pdlpp__
+
+# a rather silly increment function
+pp_def('inc',
+ Pars => 'i();[o] o()',
+ Code => '$o() = $i() + 1;',
+ );
+
+# a cumulative product
+# essentially the same functionality that is
+# already implemented by prodover
+# in the base distribution
+pp_def('tcumul',
+ Pars => 'in(n); float+ [o] mul()',
+ Code => '$mul() = 1;
+ loop(n) %{
+ $mul() *= $in();
+ %}',
+);
diff --git a/Example/InlinePdlpp/inlpp_link.pl b/Example/InlinePdlpp/inlpp_link.pl
new file mode 100644
index 0000000..55994ff
--- /dev/null
+++ b/Example/InlinePdlpp/inlpp_link.pl
@@ -0,0 +1,39 @@
+use blib; # when using inside the dist tree
+use PDL; # this must be called before (!) 'use Inline Pdlpp' calls
+
+# for this example you need the numerical recipes library
+# edit the INC and LIBS info below to point
+# Inline towards the location of include and library files
+
+use Inline Pdlpp => Config =>
+ INC => "-I$ENV{HOME}/include",
+ LIBS => "-L$ENV{HOME}/lib -lnr -lm",
+ AUTO_INCLUDE => <<'EOINC',
+#include <math.h>
+#include "nr.h" /* for poidev */
+#include "nrutil.h" /* for err_handler */
+
+static void nr_barf(char *err_txt)
+{
+ fprintf(stderr,"Now calling croak...\n");
+ croak("NR runtime error: %s",err_txt);
+}
+EOINC
+ BOOT => 'set_nr_err_handler(nr_barf);'; # catch errors at the perl level
+
+use Inline Pdlpp; # the actual code is in the __Pdlpp__ block below
+
+$a = zeroes(10) + 30;;
+print $a->poidev(-3),"\n";
+
+__DATA__
+
+__Pdlpp__
+
+# poisson deviates
+pp_def('poidev',
+ Pars => 'xm(); [o] pd()',
+ GenericTypes => [L,F,D],
+ OtherPars => 'long idum',
+ Code => '$pd() = poidev((float) $xm(), &$COMP(idum));',
+);
diff --git a/Example/InlinePdlpp/inlppminimal.pl b/Example/InlinePdlpp/inlppminimal.pl
new file mode 100644
index 0000000..2f05853
--- /dev/null
+++ b/Example/InlinePdlpp/inlppminimal.pl
@@ -0,0 +1,22 @@
+use blib; # we're inside the dist tree
+use PDL; # this must be called before (!) 'use Inline Pdlpp' calls
+
+use PDL::NiceSlice; # only used to demonstrate how to switch off below
+use Inline Pdlpp; # the actual code is in the __Pdlpp__ block below
+
+$a = sequence 10;
+print $a(0:4),"\n";
+print $a->inc->(0:4),"\n";
+
+# important!
+no PDL::NiceSlice; # disable NiceSlice before(!) the data section
+
+__END__
+
+__Pdlpp__
+
+# a silly function, really ;)
+pp_def('inc',
+ Pars => 'i();[o] o()',
+ Code => '$o() = $i() + 1;',
+ );
diff --git a/Example/PGPLOT/pgplot.pl b/Example/PGPLOT/pgplot.pl
new file mode 100644
index 0000000..d4c2570
--- /dev/null
+++ b/Example/PGPLOT/pgplot.pl
@@ -0,0 +1,278 @@
+=head1 NAME
+
+std_pgplot - Examples of PGPLOT routines.
+
+=head1 SYNOPSIS
+
+std_pgplot.pl
+
+=head1 DESCRIPTION
+
+This file is intended to show the use of PGPLOT routines using the
+object-oriented approach.
+
+=cut
+
+use PDL;
+use PDL::Graphics::PGPLOT::Window;
+
+
+##
+## Test all PGPLOT routines.
+##
+my $random = grandom(1000);
+my ($xc, $yc)=hist $random;
+my $x=zeroes(100)->xlinvals(-5,5);
+my $y=exp(-$x*$x/2);
+
+
+
+print "First we will test all functions in PGPLOT.\n";
+print "We also will show most of the options\n";
+print "After each plot - please press <CR> to proceed - type q<CR> to quit.\n";
+
+function_to_do ('dev(), env(), hold(), release(), bin(), line()');
+
+#
+# Create a window object to which we will subsequently plot.
+#
+my $w = PDL::Graphics::PGPLOT::Window->new({Device => '/xw', Aspect => 1,
+ WindowWidth => 7});
+# Note how we call the functions via the window object. This particular
+# call will set the axis colour to Red.
+$w->env(-5, 5, 0, max($yc)*1.1, {Axiscolour => 'Red'});
+
+# Plot a histogram.
+$w->bin($xc, $yc);
+
+# Hold the plot. You can subsequently test whether the plot is held
+# by calling held() - which returns true (1) if the plot is held.
+$w->hold();
+
+# This draws a line plot on top of the histogram. Note that you can
+# refer to options using only the first part of their name - and case
+# doesn't matter either. It is advised however to use the full name
+# for options since in some cases you could imagine getting the
+# wrong result.
+$w->line($x, $y*max($yc),
+ {LineSty => 'Dashed', Color => 'Blue', LineWidth => 5});
+
+# Release your connection so that the next plotting command will
+# erase the screen and create a new plot.
+$w->release();
+
+# These two are just a convenience functions for this demo..
+next_plot();
+function_to_do ('errb() & points()');
+
+# Create some more data - this time for plots with errorbars.
+my $xd = pdl(1,3,7,10);
+my $yd = pdl(2, 7,5,7);
+my $dy = sqrt($yd**2/12+0.2**2);
+
+# This is how you set titles on plots. If you forget to you can
+# use the label_axes() command (see below) to set them later.
+$w->env(0, 15, 0, 10, {Xtitle => 'X-data', Ytitle=>'Y-data',
+ Title => 'An example of errb and points',
+ Font => 'Italic'});
+
+# Plot the data as points
+$w->points($xd, $yd);
+# Overplot (implicit) the points with error-bars.
+$w->errb($xd, $yd, $dy);
+$w->release();
+
+next_plot();
+function_to_do('line() poly(), cont(), label_axes() and text()');
+
+# Create an image.
+my $im = rvals(100, 100);
+
+# Draw contours - and hold the plot because will clutter it some more.
+$w->cont($im, {NCOn => 4});
+$w->hold();
+
+# Note that the colours can be specified also in upper case. They can
+# also be referred to with numbers in keeping with the PGPLOT tradition.
+$w->line(pdl(0, 50), pdl(0, 50), {Color => 'RED'});
+
+# The corners of a polygon - note that the last should be equal to the
+# first to get the expected results.
+my $px = pdl(20, 40, 40, 20, 20);
+my $py = pdl(80, 80, 100, 100, 80);
+
+# The poly function draws polygons - note that we set the fill using
+# the numerical notation here - this sets a hatched fill.
+$w->poly($px, $py, {Fill => 3});
+# Pay attention to the hatching command as it sets the properties using
+# an anonymous hash again. I would normally construct this separately
+# and use a variable for this for readability.
+$w->poly($px, $py, {Color=>'Red', Fill => 3, Hatch => {Phase => 0.5}});
+
+# label_axes() is a separate function to set the axis titles. This is
+# often clearer although less compact than setting it directly in the
+# env() function.
+$w->label_axes('X-direction', 'Y-direction', 'Title', {Color => 'Yellow'});
+
+# The text() command puts text on the display and can be displayed using
+# different justifications, angles and fonts as well as colours.
+$w->text('Towards the centre', 24, 25, {Justification => 0.5, Angle=>45,
+ Font => 'Italic'});
+
+
+next_plot();
+function_to_do('imag(), ctab(), hi2d and several panels');
+
+#
+# We now create a new window for image display since we want several
+# panels in the plot window. This requires a new window to be created
+# at present - changes to the code welcome.
+#
+$w->close();
+$w = PDL::Graphics::PGPLOT::Window->new({Device => '/xw',
+ Aspect => 0.5,
+ NX => 2, NY => 2,
+ CharSize => 2});
+
+
+# Display the image using a transform between the pixel coordinates
+# and the display coordinates.
+$w->imag($im, {Transform => pdl([0, 0.1, 0, 0, 0, 0.1])});
+
+# This command will go in the next panel and will display the image using
+# a square root transfer function and square pixels (PIX => 1)
+$w->imag1($im, {PIX => 1, ITF=>'Sqrt'});
+
+# You set the colour table using ctab()
+$w->ctab('Fire');
+$w->imag($im);
+
+# A hold command in a multi-panel situation keeps you in the same panel.
+$w->hold();
+# So that you can overplot a contour plot for instance...
+$w->cont($im, {Color => 'Yellow'});
+$w->release();
+
+# The hi2d() function draws a 2D histogram of the data and could very
+# likely be improved by someone with some extra time on their hands.
+$w->hi2d($im->slice('0:-1:10,0:-1:10'));
+
+next_plot();
+function_to_do('Several plot windows. focus_window(), window_list()');
+
+#
+# Multiple windows - the secret unveiled... Well, it is easy actually
+# at least when you use the OO interface!
+#
+$w->close();
+my $w1 = PDL::Graphics::PGPLOT::Window->new({Device => '/xw', Aspect => 1,
+ AxisColour => 'Blue',
+ WindowName => 'First',
+ WindowWidth => 6});
+my $w2 = PDL::Graphics::PGPLOT::Window->new({Device => '/xw', Aspect => 0.618,
+ AxisColour => 'Red',
+ WindowWidth => 6});
+# First draw something in Window 1
+$w1->line($x, $x**2);
+$w1->hold();
+
+# Then switch to window 2...
+my $ii = which($x>=0);
+$w2->points($x->index($ii), sqrt($x->index($ii)));
+$w2->hold();
+
+$w2->line($x->index($ii), sqrt($x->index($ii)),
+ {Color => 'Red', Linestyle => 'dashed'});
+$w2->release();
+
+# Switch back to window 1 - note how easier it is with the OO interface.
+$w1->points($x, $x**2+$x->grandom());
+$w1->release();
+
+# In the OO interface there is no built-in way to keep track of different
+# windows in the way that the non-OO interface does, but on the other hand
+# you don't really need it.
+
+# See the std_pgplot.pl file for an example of this.
+
+next_plot();
+function_to_do('legend(), cursor()');
+
+# Let's close Window2 and continue our examples in window 1.
+$w2->close();
+
+# The legend function draws legends on plots which can be for different
+# symbols, linestyles, widths and mixtures.
+$w1->legend(['Parabola', 'Scatter points'], -2, 20,
+ {Width => 5, LineStyle => ['Solid', undef], Symbol => [undef, 'Default']});
+
+#
+# Now read the cursor - different types of cursor can be chosen
+print "Select a point using the cursor:\n";
+my ($xp, $yp)=$w1->cursor({Type => 'CrossHair'});
+print "(X, Y)=($xp, $yp)\n";
+
+next_plot();
+function_to_do('circle(), ellipse(), rectangle() and arrow()');
+
+# The circle, ellipse and rectangle functions do not take note of the
+# intrinsic display aspect ratio so if you want a really round circle,
+# you must make sure that the aspect ratio is 1.
+$w1->close();
+$w1 = PDL::Graphics::PGPLOT::Window->new({Device => '/xs', Aspect => 1,
+ WindowWidth => 6});
+$w1->env(0, 100, 0,100);
+
+# Draw a circle - at the moment the default fill-style is solid so we need
+# to specify the outline fill to get a non-filled circle..
+$w1->circle(50, 50, 10, {Fill => 'Outline'});
+# The ellipse can be specified with major and minor axis and the rotation
+# angle for the ellipse, but note that the angle must be specified in radians..
+$w1->ellipse(40, 20, {MajorAxis => 30, MinorAxis=> 10,
+ Theta => 30*3.14/180, Colour => 'Red'});
+# The angle must be specified in radians for the rectangle too....
+$w1->rectangle(70, 70, {XSide => 10, Angle => 45*3.14/180});
+
+# And finally draw an arrow...
+$w1->arrow(40, 20, 70, 20, {Color => 'Green'});
+
+next_plot();
+$w1->close();
+
+$w1 = PDL::Graphics::PGPLOT::Window->new({Device => '/xs', Aspect => 1,
+ NX => 2, NY => 2});
+$w1->line($x, $y);
+
+# The important thing here is to show that you can jump directly to a given
+# panel and start drawing in this..
+$w1->bin($xc, $yc, {Panel => 3});
+$w1->env(0, 1, 0, 1, {Axis => 'Box'});
+$w1->text("That's all folks!", 0.5, 0.5, {Justification => 0.5, CharSize => 5,
+ Color => 'Yellow'});
+
+next_plot();
+
+
+sub function_to_do {
+
+ print "\n**************************\n";
+ print "* $_[0]\n";
+ print "**************************\n\n";
+
+}
+
+
+sub next_plot {
+ my $message = shift;
+
+ $message ||='';
+
+ print $message."\n";
+ my $in = <STDIN>;
+
+ if ($in =~ /^q/i) {
+ exit;
+ }
+
+
+}
diff --git a/Example/PGPLOT/std_pgplot.pl b/Example/PGPLOT/std_pgplot.pl
new file mode 100644
index 0000000..8b60fe4
--- /dev/null
+++ b/Example/PGPLOT/std_pgplot.pl
@@ -0,0 +1,173 @@
+=head1 NAME
+
+std_pgplot - Examples of PGPLOT routines.
+
+=head1 SYNOPSIS
+
+std_pgplot.pl
+
+=head1 DESCRIPTION
+
+This file is intended to show the use of PGPLOT routines using the
+standard interface. See the C<pgplot.pl> file for an object-oriented
+version of the same (the object-oriented interface is strongly recommended.)
+
+=cut
+
+use PDL;
+use PDL::Graphics::PGPLOT;
+
+
+##
+## Test all PGPLOT routines.
+##
+my $random = grandom(1000);
+my ($xc, $yc)=hist $random;
+my $x=zeroes(100)->xlinvals(-5,5);
+my $y=exp(-$x*$x/2);
+
+
+
+print "First we will test all functions in PGPLOT.\n";
+print "We also will show most of the options\n";
+print "After each plot - please press <CR> to proceed - type q<CR> to quit.\n";
+
+function_to_do ('dev(), env(), hold(), release(), bin(), line()');
+
+my $win1 = dev('/xw', {Aspect => 1, WindowWidth => 7});
+env(-5, 5, 0, max($yc)*1.1, {Axiscolour => 'Red'});
+bin $xc, $yc;
+hold;
+line $x, $y*max($yc), {LineSty => 'Dashed', Color => 'Blue', LineWidth => 5};
+release;
+#close_window($win);
+
+next_plot();
+function_to_do ('errb() & points()');
+my $xd = pdl(1,3,7,10);
+my $yd = pdl(2, 7,5,7);
+my $dy = sqrt($yd**2/12+0.2**2);
+env(0, 15, 0, 10, {Xtitle => 'X-data', Ytitle=>'Y-data',
+ Title => 'An example of errb and points', Font => 'Italic'});
+points $xd, $yd;
+errb $xd, $yd, $dy;
+release;
+
+next_plot();
+function_to_do('line() poly(), cont(), label_axes() and text()');
+my $im = rvals(100, 100);
+cont $im, {NCOn => 4};
+hold;
+line pdl(0, 50), pdl(0, 50), {Color => 'RED'};
+my $px = pdl(20, 40, 40, 20, 20);
+my $py = pdl(80, 80, 100, 100, 80);
+poly $px, $py, {Fill => 3};
+poly $px, $py, {Color=>'Red', Fill => 3, Hatch => {Phase => 0.5}};
+label_axes('X-direction', 'Y-direction', 'Title', {Color => 'Yellow'});
+
+text 'Towards the centre', 24, 25, {Justification => 0.5, Angle=>45,
+ Font => 'Italic'};
+
+
+next_plot();
+function_to_do('imag(), ctab(), hi2d and several panels');
+
+$win1= dev('/xw', 2, 2, {Aspect => 0.5, CharSize => 2});
+imag $im, {Transform => pdl([0, 0.1, 0, 0, 0, 0.1])};
+imag1 $im, {PIX => 1, ITF=>'Sqrt'};
+ctab('Fire');
+imag $im;
+hold;
+cont $im, {Color => 'Yellow'};
+release;
+hi2d $im->slice('0:-1:10,0:-1:10');
+
+next_plot();
+function_to_do('Several plot windows. focus_window(), window_list()');
+
+close_window($win1);
+$win1 = dev('/xw', {Aspect => 1, AxisColour => 'Blue', WindowName => 'First',
+ WindowWidth => 6});
+my $win2 = dev('/xw', {Aspect => 0.618, AxisColour => 'Red',
+ WindowWidth => 6, NewWindow => 1});
+
+focus_window('First');
+line $x, $x**2;
+hold;
+focus_window($win2);
+my $ii = which($x>=0);
+points $x->index($ii), sqrt($x->index($ii));
+hold;
+line $x->index($ii), sqrt($x->index($ii)), {Color => 'Red', Linestyle => 'dashed'};
+release;
+focus_window($win1);
+points $x, $x**2+$x->grandom();
+release;
+
+my ($nums, $names)=window_list();
+print "Window list:\n";
+for (my $i=0; $i <= $#$nums; $i++) {
+ print " $$nums[$i]: $$names[$i]\n";
+}
+
+
+next_plot();
+function_to_do('legend(), cursor()');
+
+close_window($win2);
+
+legend ['Parabola', 'Scatter points'], -2, 20,
+ {Width => 5, LineStyle => ['Solid', undef], Symbol => [undef, 'Default']};
+
+
+print "Select a point using the cursor:\n";
+my ($xp, $yp)=cursor({Type => 'CrossHair'});
+print "(X, Y)=($xp, $yp)\n";
+
+next_plot();
+
+function_to_do('circle(), ellipse(), rectangle() and arrow()');
+
+dev('/xs', {Aspect => 1, WindowWidth => 6});
+env(0, 100, 0,100);
+circle(50, 50, 10, {Fill => 'Outline'});
+ellipse(40, 20, {MajorAxis => 30, MinorAxis=> 10, Theta => 30*3.14/180, Colour => 'Red'});
+rectangle(70, 70, {XSide => 10, Angle => 45*3.14/180});
+
+next_plot();
+
+close_window($win1);
+
+$win1 = dev('/xw', 2, 2, {Aspect => 1});
+line $x, $y;
+bin $xc, $yc, {Panel => 3};
+env(0, 1, 0, 1, {Axis => 'Box'});
+text "That's all folks!", 0.5, 0.5, {Justification => 0.5, CharSize => 3,
+ Color => 'Yellow'};
+
+next_plot();
+
+
+sub function_to_do {
+
+ print "\n**************************\n";
+ print "* $_[0]\n";
+ print "**************************\n\n";
+
+}
+
+
+sub next_plot {
+ my $message = shift;
+
+ $message ||='';
+
+ print $message."\n";
+ my $in = <STDIN>;
+
+ if ($in =~ /^q/i) {
+ exit;
+ }
+
+
+}
diff --git a/Example/PLplot/refresh.pdl b/Example/PLplot/refresh.pdl
new file mode 100644
index 0000000..babc0e8
--- /dev/null
+++ b/Example/PLplot/refresh.pdl
@@ -0,0 +1,190 @@
+#!/usr/bin/perl
+#
+# Figure out which low-level commands are necessary to refresh an
+# interactive PLplot device
+
+use strict;
+use PDL::Graphics::PLplot;
+
+sub refresh{
+
+ my $x = sequence(10);
+ my $y = $x**2;
+
+ # my $w=PDL::Graphics::PLplot->new(DEV=>'psc',FILE=>'plplottest.ps',JUST=>0);
+ my $w = PDL::Graphics::PLplot->new(DEV=>'xwin',FILE=>':0',JUST=>1);
+ plspause(0);
+
+ ## Either use this chunk of lines
+ #
+ # print "before first plot BOX is ",@{$w->{BOX}},"\n";
+ # $w->xyplot2(10*$x,$y);
+ # print "after first plot BOX is ",@{$w->{BOX}},"\n";
+ # $w->hold;
+ # $w->xyplot2(10*$x,$y*2,COLOR=>'RED');
+ # print "after second plot BOX is ",@{$w->{BOX}},"\n";
+ # $w->release;
+ # $w->close;
+
+ ## or use this chunk of lines
+ #
+ my $size = 50;
+ $w->imag(sequence($size,$size),PALETTE=>'GREYSCALE');
+ # sleep 3;
+ $w->imag(random($size,2*$size));
+ $w->close;
+
+}
+
+sub PDL::Graphics::PLplot::imag {
+ my $self = shift;
+ my $img = shift;
+ my %opts = @_;
+
+ # Set PLplot to right output stream
+ plsstrm($self->{STREAMNUMBER});
+ # Advance the (sub)page unless we're being held or the window is brand new
+ pladv(0) unless $self->held or !exists($self->{BOX});
+
+ # Only process COLORMAP entries once
+ my $z = $opts{COLORMAP};
+ delete ($opts{COLORMAP});
+
+ # Set ticks to be external
+ $self->{XBOX} = $self->{XBOX} . 'i' unless exists($opts{XBOX});# =~ /i/i;
+ $self->{YBOX} = $self->{YBOX} . 'i' unless exists($opts{YBOX});# =~ /i/i;
+
+ $self->setparm(%opts);
+
+ my @borders = (-0.5,$img->dim(0)-0.5,-0.5,$img->dim(1)-0.5);
+
+ unless ( $self->held ) {
+ $self->{BOX} = \@borders;
+ }
+
+ $self->_setwindow;
+ $self->_drawlabels;
+
+ # Draw the image
+ plimage($img, at borders,0,0, at borders);
+
+ # Plot box
+ plcol0(1); # set to frame color
+ plbox($self->{XTICK}, $self->{NXSUB}, $self->{YTICK}, $self->{NYSUB},
+ $self->{XBOX}, $self->{YBOX}); # !!! note out of order call
+
+ plflush();
+}
+
+sub PDL::Graphics::PLplot::held{
+ my $self = shift;
+ return $self->{HELD};
+}
+
+sub PDL::Graphics::PLplot::hold{
+ my $self = shift;
+ $self->{HELD} = 1;
+}
+
+sub PDL::Graphics::PLplot::release{
+ my $self = shift;
+ $self->{HELD} = 0;
+}
+
+sub PDL::Graphics::PLplot::xyplot2 {
+ my $self = shift;
+ my $x = shift;
+ my $y = shift;
+
+ my %opts = @_;
+
+ # Set PLplot to right output stream
+ plsstrm($self->{STREAMNUMBER});
+
+ # Only process COLORMAP entries once
+ my $z = $opts{COLORMAP};
+ delete ($opts{COLORMAP});
+
+ # Handle ERRORBAR options
+ my $xeb = $opts{XERRORBAR};
+ my $yeb = $opts{YERRORBAR};
+ delete ($opts{XERRORBAR});
+ delete ($opts{YERRORBAR});
+
+
+ # Advance the (sub)page unless we're being held or the window is brand new
+ pladv(0) unless $self->held or !exists($self->{BOX});
+
+ # Apply options
+ $self->setparm(%opts);
+
+ unless ($self->held) {
+ # unless (exists($self->{BOX})) {
+ $self->{BOX} = [$x->minmax, $y->minmax];
+ }
+
+ # Set up viewport, subpage, world coordinates
+ $self->_setwindow;
+
+ # Draw labels
+ $self->_drawlabels;
+
+ # Plot box
+ plcol0(1); # set to frame color
+ plbox($self->{XTICK}, $self->{NXSUB}, $self->{YTICK}, $self->{NYSUB},
+ $self->{XBOX}, $self->{YBOX}); # !!! note out of order call
+
+ # Set the color according to the color specified in the object
+ # (we don't do this as an option, because then the frame might
+ # get the color requested for the line/points
+ plcol0($self->{CURRENT_COLOR_IDX});
+
+ # Set line style for plot only (not box)
+ pllsty($self->{LINESTYLE});
+
+ # Set line width for plot only (not box)
+ plwid($self->{LINEWIDTH});
+
+ # Plot lines if requested
+ if ($self->{PLOTTYPE} =~ /LINE/) {
+ plline($x, $y);
+ }
+
+ # Set line width back
+ plwid(0);
+
+ # Plot points if requested
+ if ($self->{PLOTTYPE} =~ /POINTS/) {
+ my $c = $self->{SYMBOL};
+ unless (defined($c)) {
+
+ # The default for $c is a PDL of ones with shape
+ # equal to $x with the first dimension removed
+ #
+ my $z = PDL->zeroes($x->nelem);
+ $c = PDL->ones($z->zcover) unless defined($c);
+ }
+ plssym(0, $self->{SYMBOLSIZE}) if (defined($self->{SYMBOLSIZE}));
+
+ if (defined($z)) { # If a color range plot requested
+ my ($min, $max) = exists ($self->{ZRANGE}) ? @{$self->{ZRANGE}} : $z->minmax;
+ plcolorpoints($x, $y, $z, $c, $min, $max);
+ } else {
+ plsym($x, $y, $c);
+ }
+ }
+
+ # Plot error bars, if requested
+ if (defined($xeb)) {
+ # Horizontal (X) error bars
+ plerrx($x->nelem, $x - $xeb/2, $x + $xeb/2, $y);
+ }
+
+ if (defined($yeb)) {
+ # Vertical (Y) error bars
+ plerry($y->nelem, $x, $y - $yeb/2, $y + $yeb/2);
+ }
+
+ # Flush the PLplot stream.
+ plflush();
+}
diff --git a/Example/Simplex/tsimp2.pl b/Example/Simplex/tsimp2.pl
new file mode 100644
index 0000000..c1fca50
--- /dev/null
+++ b/Example/Simplex/tsimp2.pl
@@ -0,0 +1,71 @@
+use PDL;
+use PDL::Opt::Simplex;
+#
+# Simplex Demo - Alison Offer (aro at aaocbn.aao.gov.au)
+#
+#
+# this is some sort of convergence criterion
+$minsize = 1.e-6;
+# max number of iterations ?
+$maxiter = 100;
+#
+# number of evaluation
+$count = 0;
+print " \n
+ 1: least squares gaussian fit to data + noise \n
+ 32 *exp (-((x-10)/6)^2) + noise
+ 2: minimise polynomial \n
+ (x-3)^2 + 2.*(x-3)*(y-2.5) + 3.*(y-2.5)^2 \n
+ Please make your choice (1 or 2):";
+chop($choice = <>);
+if ($choice == 1) {
+ print "Please enter noise factor (small number, 0-6):";
+ chop($factor = <>);
+#
+# data : gaussian + noise
+#
+ foreach $j (0..19) {
+ $data[$j] = 32*exp(-(($j-10)/6)**2) +
+ $factor * (rand() - 0.5);
+ }
+#
+# initial guess - $initsize controls the size of the initial simplex (I think)
+#
+ $init = pdl [ 33, 9, 12 ];
+ $initsize = 2;
+#
+#
+ ($optimum,$ssize,$optval) = simplex($init,$initsize,$minsize,$maxiter,
+# this sub returns the function to be minimised.
+ sub {my ($xv) =@_;
+ my $a = $xv->slice("(0)");
+ my $b = $xv->slice("(1)");
+ my $c = $xv->slice("(2)");
+ $count += $a->dim(0);
+ my $sum = $a * 0.0;
+ foreach $j (0..19) {
+ $sum += ($data[$j] -
+ $a*exp(-(($j-$b)/$c)**2))**2;
+ }
+ return $sum;
+ });
+
+} else {
+ $init = pdl [ 2 , 2 ];
+ $initsize = 2;
+ ($optimum,$ssize,$optval) = simplex($init,$initsize,$minsize,$maxiter,
+ sub {my ($xv) =@_;
+ my $x = $xv->slice("(0)");
+ my $y = $xv->slice("(1)");
+ $count += $x->dim(0);
+ return ($x-3)**2 + 2.*($x-3)*($y-2.5)
+ + 3.*($y-2.5)**2;
+ });
+
+
+}
+print "N_EVAL = $count\n";
+print "OPTIMUM = $optimum \n";
+print "SSIZE = $ssize\n";
+print "OPTVAL = $optval\n";
+
diff --git a/Example/Simplex/tsimp_needs_pgplot.pl b/Example/Simplex/tsimp_needs_pgplot.pl
new file mode 100644
index 0000000..a4015af
--- /dev/null
+++ b/Example/Simplex/tsimp_needs_pgplot.pl
@@ -0,0 +1,50 @@
+#use blib;
+use PDL;
+use PDL::Primitive;
+use PDL::Graphics::PGPLOT;
+use PDL::Opt::Simplex;
+
+use Carp;
+
+$SIG{__DIE__} = sub {print Carp::longmess(@_); die FOO};
+
+# First, a 1-dimensional test:
+
+sub func1 {
+ my($x) = @_;
+ return ($x**2)->slice('(0)');
+}
+
+sub logs1 {
+ print "NOW: $_[0],$_[1]\n\n";
+}
+simplex(ones(1)*10,0.3,0.01,15,\&func1,\&logs1);
+
+# Try a simple ellipsoid:
+
+my $mult = pdl 4,1;
+
+dev "/XSERVE";
+env -15,5,-15,5;
+hold;
+
+sub func {
+ my($x) = @_;
+ my $b = ($mult * $x) ** 2;
+ sumover($b,(my $res = null));
+ $res;
+}
+
+sub logs {
+ print "NOW: $_[0],$_[1]\n\n";
+ line($_[0]->slice("(0)"),$_[0]->slice("(1)"));
+ line($_[0]->slice("(0),0:2:2"),$_[0]->slice("(1),0:2:2"));
+}
+
+simplex(pdl(-10,-10), 0.5, 0.01, 30,
+ \&func,
+ \&logs
+);
+
+
+
diff --git a/Example/TriD/3dtest.pl b/Example/TriD/3dtest.pl
new file mode 100644
index 0000000..c0c024d
--- /dev/null
+++ b/Example/TriD/3dtest.pl
@@ -0,0 +1,18 @@
+#!/usr/bin/perl
+#
+# This program is a simple diagnostic example to
+# check if TriD imagrgb is working
+#
+use PDL;
+use PDL::NiceSlice;
+use PDL::Graphics::TriD;
+
+# $PDL::debug_trid=1;
+# $PDL::Graphics::TriD::verbose = 100;
+$im = sequence(640,480)/640.0/480.0;
+$im3 = $im->dummy(0,3);
+
+# print "\$im3 has dims of @{[$im3->dims()]}\n";
+
+imagrgb $im3;
+
diff --git a/Example/TriD/line3d.pl b/Example/TriD/line3d.pl
new file mode 100644
index 0000000..97c063d
--- /dev/null
+++ b/Example/TriD/line3d.pl
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+#
+# This program is a simple diagnostic example to
+# check if TriD line3d is working
+#
+use PDL;
+use PDL::NiceSlice;
+use PDL::Graphics::TriD;
+
+# $PDL::debug_trid=1;
+# $PDL::Graphics::TriD::verbose = 100;
+
+$size = 25;
+
+$cz = (xvals zeroes $size+1) / $size; # interval 0..1
+$cx = sin($cz*12.6); # Corkscrew
+$cy = cos($cz*12.6);
+
+line3d [$cx,$cy,$cz]; # Draw a line
diff --git a/Example/TriD/old_trid_clip.pl b/Example/TriD/old_trid_clip.pl
new file mode 100644
index 0000000..fd52689
--- /dev/null
+++ b/Example/TriD/old_trid_clip.pl
@@ -0,0 +1,111 @@
+#!/usr/local/bin/perl
+#
+# This is an example program from the legacy TriD/OpenGL/examples
+# directory moved here for reference. It only uses OpenGL features
+# so can probably be deprecated in favor of the Perl OpenGL
+# examples eventually.
+#
+# clip
+#
+# This program demonstrates arbitrary clipping planes.
+# Based on the "clip.c" program in the
+# OpenGL Programming Guide, Chapter 3, page 108, Listing 3-5.
+# However this program clips the front part of a rotating cube
+# with flat shaded faces instead of a wire frame sphere.
+#
+# the C synopsis of glClipPlane is
+#
+# void glClipPlane(GLenum plane,const GLdouble *equation )
+#
+# For PERL the routine glpClipPlane was added, and the synopsis is:
+#
+# void glpClipPlane(GLenum plane,GLdouble a,GLdouble b,GLdouble c,GLdouble d)
+#
+# and the 4 double vector (equasion) is packaged by the XSUB.
+# Or you can still use glClipPlane but then you have to pack() the structure
+#
+# note: the statement f(@a) is equivalent to f($a[0],$a[1], ... $a[n])
+# i.e. elements of a list are put on the call stack
+#
+
+use PDL::Graphics::OpenGL::Perl::OpenGL;
+use OpenGL qw(:all);
+
+sub tacky_cube {
+ local($s) = @_;
+ local(@x, at y, at z, at f);
+ local($i,$j,$k);
+ local(@r, at g, at b);
+ $s = $s/2.0;
+ @x=(-$s,-$s,-$s,-$s,$s,$s,$s,$s);
+ @y=(-$s,-$s,$s,$s,-$s,-$s,$s,$s);
+ @z=(-$s,$s,$s,-$s,-$s,$s,$s,-$s);
+ @f=(
+ 0, 1, 2, 3,
+ 3, 2, 6, 7,
+ 7, 6, 5, 4,
+ 4, 5, 1, 0,
+ 5, 6, 2, 1,
+ 7, 4, 0, 3,
+ );
+ @r=(1.0, 0, 0, 1.0, 1.0, 0);
+ @g=(0, 1.0, 0, 1.0, 0, 1.0);
+ @b=(0, 0, 1.0, 0, 1.0, 1.0);
+ for($i=0;$i<6;$i++){
+ glColor3f($r[$i],$g[$i],$b[$i]);
+ glBegin(GL_POLYGON);
+ for($j=0;$j<4;$j++){
+ $k=$f[$i*4+$j];
+ glVertex3d($x[$k],$y[$k],$z[$k]);
+ }
+ glEnd();
+ }
+
+}
+
+sub add_clip_plane {
+ # give the plane a slight tilt-away to prove we're not just
+ # clipping against the view volume
+ @eqn = (0.0, -0.3, -1.0, 1.2);
+ OpenGL::glpClipPlane(GL_CLIP_PLANE0, @eqn);
+ glEnable(GL_CLIP_PLANE0);
+}
+
+sub display{
+ glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);
+ glPushMatrix();
+ glRotatef($spin, 0.0, 1.0, 0.0);
+ tacky_cube(3.0);
+ glPopMatrix();
+ glFlush();
+ glXSwapBuffers;
+}
+
+
+sub myReshape {
+ # glViewport(0, 0, w, h);
+ glMatrixMode(GL_PROJECTION);
+ glLoadIdentity();
+ gluPerspective(60.0, 1.0 , 1.0, 20.0);
+ glMatrixMode(GL_MODELVIEW);
+ glLoadIdentity ();
+}
+
+OpenGL::glpOpenWindow(width => 400, height => 400,
+ attributes => [GLX_RGBA,GLX_DOUBLEBUFFER]);
+glClearColor(0,0,0,1);
+glShadeModel (GL_FLAT);
+myReshape();
+glDisable(GL_CULL_FACE);
+glEnable(GL_DEPTH_TEST);
+
+glLoadIdentity ();
+glTranslatef (0.0, 0.0, -5.0);
+add_clip_plane;
+
+# test glGetClipPlane()
+($a,$b,$c,$d)=OpenGL::glpGetClipPlane(GL_CLIP_PLANE0);
+print "Clipping plane (a,b,c,d) = ($a,$b,$c,$d)\n";
+
+$spin=0;
+while(1) {$spin += 1.0; display;}
diff --git a/Graphics/Graphics2D.pm b/Graphics/Graphics2D.pm
new file mode 100644
index 0000000..3b49d5e
--- /dev/null
+++ b/Graphics/Graphics2D.pm
@@ -0,0 +1,984 @@
+package PDL::Graphics2D;
+
+use Exporter 'import'; # gives you Exporter's import() method directly
+ at EXPORT = qw(imag2d imag2d_update twiddle); # symbols to export on request
+ at EXPORT_OK = qw(imag2d imag2d_update twiddle); # symbols to export on request
+
+=head1 NAME
+
+PDL::Graphics2D - An object oriented interface to PDL graphics
+
+=head1 SYNOPSIS
+
+ use PDL::Graphics2D;
+ $win = PDL::Graphics2D->new(<Interface>, <Options>);
+
+ $w = imag2d( $image, 'Title Here', ... );
+
+=head1 DESCRIPTION
+
+This is an umbrella class allowing for a simple interface to all plotting
+routines in PDL. On its own it does not do any work it merely passes
+information to the appropriate class. Ideally this should probably offer
+a uniform interface to a variety of packages.
+
+This requires a lot more work before it is useful I feel, but it can be
+used already.
+
+=head1 CONSTRUCTORS
+
+=head2 new
+
+=for ref
+
+Create a 2-D graphics object with the requested interface type
+
+=cut
+
+
+{
+ my %lookup=(
+ 'PGPLOT' => 'PDL::Graphics::PGPLOT::Window'
+ );
+ sub new {
+
+ my $type=shift;
+ my $interface=shift;
+
+ #
+ # Translate the interface name to the appropriate class name.
+ #
+ $interface=uc($interface);
+ die "Interface $interface is not known!\n" if !exists($lookup{$interface});
+ my $class = $lookup{$interface};
+ eval "require $class;";
+ return $class->new(@_);
+ }
+}
+
+use strict;
+
+my $debug = 0;
+
+use PDL::Lite;
+use PDL::NiceSlice;
+
+#------------------------------------------------------------------------
+# PDL constants used by imag2d
+#------------------------------------------------------------------------
+#
+# PDL_B
+# PDL_D
+# PDL_F
+# PDL_L
+# PDL_S
+# PDL_US
+#
+#------------------------------------------------------------------------
+
+#------------------------------------------------------------------------
+# PDL methods used by imag2d
+#------------------------------------------------------------------------
+#
+# .=
+# dim
+# float
+# get_dataref
+# ndims
+# sever
+# type->symbol
+#
+#------------------------------------------------------------------------
+
+use OpenGL qw( :all );
+
+#------------------------------------------------------------------------
+# opengl/glut constants used by imag2d
+#------------------------------------------------------------------------
+#
+# GLUT_ACTION_CONTINUE_EXECUTION
+# GLUT_ACTION_ON_WINDOW_CLOSE
+# GLUT_DOUBLE
+# GLUT_RGBA
+# GLUT_WINDOW_HEIGHT
+# GLUT_WINDOW_WIDTH
+#
+# GL_COLOR_BUFFER_BIT
+# GL_FLOAT
+# GL_INT
+# GL_LUMINANCE
+# GL_LUMINANCE_ALPHA
+# GL_MODELVIEW
+# GL_PROJECTION
+# GL_RGB
+# GL_RGBA
+# GL_SHORT
+# GL_UNPACK_ALIGNMENT
+# GL_UNSIGNED_BYTE
+# GL_UNSIGNED_INT_8_8_8_8
+# GL_UNSIGNED_SHORT
+#
+#------------------------------------------------------------------------
+
+
+#------------------------------------------------------------------------
+# opengl/glu/glut routines used by imag2d
+#------------------------------------------------------------------------
+#
+# OpenGL::done_glutInit
+#
+# glutAddMenuEntry
+# glutAttachMenu
+# glutCreateMenu
+# glutCreateWindow
+# glutDestroyWindow
+# glutDisplayFunc
+# glutGet
+# glutGetWindow
+# glutInit
+# glutInitDisplayMode
+# glutInitWindowPosition
+# glutInitWindowSize
+# glutKeyboardFunc
+# glutLeaveMainLoop
+# glutMouseFunc
+# glutPostRedisplay
+# glutReshapeFunc
+# glutReshapeWindow
+# glutSetOption
+# glutSwapBuffers
+#
+# glClear
+# glClearColor
+# glDrawPixels_s
+# glFlush
+# glLoadIdentity
+# glMatrixMode
+# glPixelStorei
+# glPixelZoom
+# glRasterPos2i
+# glViewport
+#
+# gluOrtho2D
+#
+#------------------------------------------------------------------------
+
+
+our $draw_overlay;
+
+my $finished_glutInit = 0;
+my $cur_fig_num = 0;
+my $imag2d_keep_twiddling;
+
+my $show_overlay = 1;
+our $is_paused = 0;
+our $do_step = 0;
+our $step_count = 1;
+our $go_forward = 1;
+our $go_backward = 0;
+
+our @imag2d_list = ();
+
+#------------------------------------------------------------------------
+# glutMouseFunc callback
+#------------------------------------------------------------------------
+sub mouse_click {
+ my ($button, $state, $x, $y) = @_;
+
+ my $window_id = glutGetWindow();
+ my $width = glutGet(GLUT_WINDOW_WIDTH);
+ my $height = glutGet(GLUT_WINDOW_HEIGHT);
+ my $img;
+
+ # search for image corresponding to window
+ foreach my $entry ( @imag2d_list ) {
+ if ( $entry->{window_id} == $window_id ) {
+ $img = $entry->{img}; # 2D piddle for now
+ last;
+ }
+ }
+
+ die "mouse_click: callback could not find image window\n" unless defined $img;
+
+ # calculate zoom/aspect ratio factors
+ my $glds = 0; $glds = 1 if $img->dim(0) < 5; # hack, need verify consistancy
+
+ my $zoom_x = $width / $img->dim($glds+0);
+ my $zoom_y = $height / $img->dim($glds+1);
+ my $zoom = ($zoom_x < $zoom_y) ? $zoom_x : $zoom_y;
+
+ # calculate the offset to the image use for centering
+ my ($hshift, $vshift) = (0,0);
+
+ if ( $zoom == $zoom_x ) {
+ # shift down
+ $vshift = ($height - $zoom * $img->dim($glds+1)) / 2.0;
+ } else {
+ # shift right
+ $hshift = ($width - $zoom * $img->dim($glds+0)) / 2.0;
+ }
+
+ my ($im_x, $im_y);
+ $im_x = sprintf "%.1f", ($x - $hshift) / $zoom;
+ $im_y = sprintf "%.1f", ($y - $vshift) / $zoom;
+
+ if ( $state
+ and (-1 < $im_x)
+ and (-1 < $im_y)
+ and ($im_x < $img->dim($glds+0)+1)
+ and ($im_y < $img->dim($glds+1)+1) ) {
+ printf STDERR "b_%01d: pixel=(%d,%d), im pt=(%.1f,%.1f),", $button, $x, $y, $im_x, $im_y;
+ printf STDERR " im val=%s, glds=$glds, winID=$window_id\n", $glds ? $img->(:,(int($im_x)),(int($im_y))) : $img->((int($im_x)),(int($im_y)));
+ }
+};
+
+#------------------------------------------------------------------------
+# glutReshapeFunc callback
+#------------------------------------------------------------------------
+sub resize_window {
+ my ($width, $height) = @_;
+
+ print STDERR "resize_window: call with new dims ($width, $height)\n" if $debug;
+
+ my $window_id = glutGetWindow();
+ my $img;
+
+ return unless scalar(@imag2d_list);
+
+ # search for image corresponding to window
+ foreach my $entry ( @imag2d_list ) {
+ if ( $entry->{window_id} == $window_id ) {
+ $img = $entry->{img}; # 2D piddle for now
+ last;
+ }
+ }
+
+ die "resize_window: callback could not find image window\n" unless defined $img;
+
+ # calculate zoom/aspect ratio factors
+ my $glds = 0; $glds = 1 if $img->dim(0) < 5; # hack, need verify consistancy
+
+ my $zoom_x = $width / $img->dim($glds+0);
+ my $zoom_y = $height / $img->dim($glds+1);
+ my $zoom = ($zoom_x < $zoom_y) ? $zoom_x : $zoom_y;
+
+ glViewport( 0, 0, $width, $height );
+
+ # set coordinate frame for graphics in window
+ glMatrixMode( GL_PROJECTION );
+ glLoadIdentity();
+
+ gluOrtho2D( 0, $width, $height, 0 );
+
+ glMatrixMode( GL_MODELVIEW );
+ glLoadIdentity();
+
+ # set zoom factors for image display
+ glPixelZoom( $zoom, -$zoom );
+
+ ## glutReshapeWindow($zoom*$img->dim($glds+0), $zoom*$img->dim($glds+1));
+
+ # offset the image in the window to keep centered
+ my ($hshift, $vshift) = (0,0);
+
+ if ( $zoom == $zoom_x ) {
+ # shift down
+ $vshift = ($height - $zoom * $img->dim($glds+1)) / 2.0;
+ } else {
+ # shift right
+ $hshift = ($width - $zoom * $img->dim($glds+0)) / 2.0;
+ }
+
+ glRasterPos2i( int($hshift), int($vshift) );
+
+ my ($do_reshape) = 0;
+ my ($new_width, $new_height) = ($zoom*$img->dim($glds+0), $zoom*$img->dim($glds+1));
+
+ # handle integer rounding problems in resize
+ if (abs($new_width - $width ) <= 2) {
+ $new_width = $width;
+ } else {
+ $do_reshape++;
+ }
+ if (abs($new_height - $height ) <= 2) {
+ $new_height = $height;
+ } else {
+ $do_reshape++;
+ }
+
+ glutReshapeWindow($new_width, $new_height) if $do_reshape;
+};
+
+#------------------------------------------------------------------------
+# glutDisplayFunc callback
+#------------------------------------------------------------------------
+sub display_image {
+ my $window_id = glutGetWindow();
+ my $img;
+ my ($gldrawformat, $gldrawtype, $glds);
+
+ return unless scalar(@imag2d_list);
+
+ # search for image corresponding to window
+ foreach my $entry ( @imag2d_list ) {
+ if ( $entry->{window_id} == $window_id ) {
+ $img = $entry->{img}; # 2D piddle for now
+ last;
+ }
+ }
+
+ die "display_window: callback could not find image window\n" unless defined $img;
+
+ # determine display pixel format to use
+ if ($img->ndims > 2 && $img->dim(0) == 4) {
+ $gldrawformat = GL_RGBA;
+ $glds = 1;
+ } elsif ($img->ndims > 2 && $img->dim(0) == 3) {
+ $gldrawformat = GL_RGB;
+ $glds = 1;
+ } elsif ($img->ndims > 2 && $img->dim(0) == 2) {
+ $gldrawformat = GL_LUMINANCE_ALPHA;
+ $glds = 1;
+ } elsif ($img->ndims > 2 && $img->dim(0) == 1) {
+ $gldrawformat = GL_LUMINANCE;
+ $glds = 1;
+ } else {
+ $gldrawformat = GL_LUMINANCE;
+ $glds = 0;
+ };
+
+ # convert to float if double for display
+ if ($img->type->symbol eq 'PDL_D') { # clean up code
+ $img = $img->float;
+ }
+
+ # determine display pixel type to use
+ if ($img->type->symbol eq 'PDL_F') {
+ $gldrawtype = GL_FLOAT;
+ } elsif ($img->type->symbol eq 'PDL_B') {
+ $gldrawtype = GL_UNSIGNED_BYTE;
+ } elsif ($img->type->symbol eq 'PDL_S') {
+ $gldrawtype = GL_SHORT;
+ } elsif ($img->type->symbol eq 'PDL_US') {
+ $gldrawtype = GL_UNSIGNED_SHORT;
+ } elsif ($img->type->symbol eq 'PDL_L') {
+ $gldrawtype = ( $gldrawformat == GL_RGBA ) ? GL_UNSIGNED_INT_8_8_8_8 : GL_INT;
+ } else {
+ die "display_image: unsupported data type '", $img->type->symbol, "' for image display\n";
+ }
+
+ my ($sizeX, $sizeY) = ($img->dim($glds+0), $img->dim($glds+1));
+ # print STDERR "... calculated image size is ($sizeX, $sizeY)\n";
+
+ # display image
+ glClear(GL_COLOR_BUFFER_BIT);
+ # glRasterPos2i( 0, 0 );
+ glDrawPixels_s( $sizeX, $sizeY, $gldrawformat, $gldrawtype, $img->get_dataref );
+
+ &{$draw_overlay}($img, $sizeX, $sizeY) if $show_overlay and defined($draw_overlay);
+
+ #draw_hough_lines($img, $sizeX, $sizeY);
+
+ glutSwapBuffers();
+ glFlush();
+}
+
+my $RELEASE=99;
+
+#------------------------------------------------------------------------
+# glutCreateMenu callback
+#------------------------------------------------------------------------
+sub ModeMenu {
+ my $entry = shift;
+ my $img;
+
+ if ($entry == $RELEASE) {
+ my ($window_id) = glutGetWindow();
+
+ # search for image corresponding to window
+ foreach my $listentry ( @imag2d_list ) {
+ if ( $listentry->{window_id} == $window_id ) {
+ $img = $listentry->{img}; # 2D piddle for now
+ last;
+ }
+ }
+
+ die "ModeMenu: callback could not find image window\n" unless defined $img;
+
+ glutLeaveMainLoop();
+ # glutDestroyWindow($window_id);
+
+ } else {
+ die "ModeMenu: illegal menu entry '$entry'\n";
+ }
+}
+
+#------------------------------------------------------------------------
+# glutKeyboardFunc callback
+#------------------------------------------------------------------------
+sub key_ops {
+ my ($key, $x, $y) = @_;
+ my $win_id = glutGetWindow();
+
+ # handle keypress events (defaults first)
+ # print STDERR "Got keypress for keypress=$key\n";
+
+ # stop twiddling
+ if ($key == ord('Q') or $key == ord('q')) {
+ $imag2d_keep_twiddling = 0;
+ warn "Stop twiddling command, key '" . chr($key) . "', detected.\n";
+ return;
+ }
+
+ # exit program
+ if ($key == 27 or $key == 3) { # ESC or Ctrl-C
+ warn "Exit program command, key '" . (($key == 27) ? 'ESC' : 'Ctrl-C') . "', detected.\n";
+ if (defined $PERLDL::TERM) { # don't exit if in the perldl or pdl2 shell
+ $imag2d_keep_twiddling = 0;
+ warn "PDL shell in use, stop twiddling instead of exit...\n";
+ return;
+ } else {
+ exit;
+ }
+ }
+
+ # toggle overlay
+ if ($key == ord('O') or $key == ord('o')) {
+ $show_overlay = (($show_overlay) ? 0 : 1);
+ warn "Toggle overlay command, key '" . chr($key) . "', detected.\n";
+ return;
+ }
+
+ # lock windows sizes together
+ if ($key == ord('L') or $key == ord('l')) {
+ ## $lock_sizes = (($lock_sizes) ? 0 : 1);
+ ## warn "Setting \$lock_sizes to $lock_sizes, (window=$win_id)\n";
+ warn "Lock window sizes command, key '" . chr($key) . "', not implemented.\n";
+ return;
+ }
+
+ # toggle image histogram equalization
+ if ($key == ord('H') or $key == ord('h')) {
+ ## $hist_equalize = (($hist_equalize) ? 0 : 1);
+ ## warn "Setting \$hist_equalize to $hist_equalize\n";
+ warn "Toggle image histogram equalization command, key '" . chr($key) . "', not implemented.\n";
+ return;
+ }
+
+ # resize current window (last clicked?) to 1:1
+ if ($key == ord('1')) {
+ ## resize_window(-1,-1); # Special (w,h) args mean set zoom to 1
+ ## glutPostRedisplay();
+ warn "Resize current window to 1:1 scale command, key '" . chr($key) . "', not implemented.\n";
+ return;
+ }
+
+ # resize other image windows to this one
+ if ($key == ord('=')) {
+ ## warn "Resize other images to this one not yet implemented, (window=$win_id)\n";
+ warn "Resize other windows to this one command, key '" . chr($key) . "', not implemented.\n";
+ return;
+ }
+
+ # pause/run with space bar
+ if ($key == 32) { # SPACE
+ if ($is_paused) {
+ $is_paused = 0;
+ } else {
+ $is_paused = 1;
+ $step_count = 1;
+ $do_step = 1;
+ }
+ # warn "Pause/Run command, key 'SPACE', detected\n";
+ return;
+ }
+
+ # toggle verbose output
+ if ($key == ord('v') or $key == ord('V')) {
+ ## $be_verbose = (($be_verbose) ? 0 : 1);
+ warn "Toggle verbose output command, key '" . chr($key) . "', not implemented.\n";
+ return;
+ }
+
+ # change direction or step in direction
+ if ($key == 46 or $key == 62) { # . or >
+ $go_forward = 1;
+ $go_backward = 0;
+ if ($is_paused) {
+ $do_step = 1;
+ $step_count = 1;
+ } else {
+ $step_count++;
+ $step_count = 1 if $step_count == 0;
+ }
+ # warn "Change Direction/Step forward command, key '" . (($key == 46) ? '.' : '>') . "', detected.\n";
+ return;
+ };
+
+ if ($key == 44 or $key == 60) { ; # , or <
+ $go_forward = 0;
+ $go_backward = 1;
+ if ($is_paused) {
+ $do_step = 1;
+ $step_count = -1;
+ } else {
+ $step_count--;
+ $step_count = -1 if $step_count == 0;
+ }
+
+ # warn "Change Direction/Step backward command, key '" . (($key == 44) ? ',' : '<') . "', detected.\n";
+ return;
+ }
+
+ warn "No handler for key " . chr($key) . ", (window=$win_id)\n";
+}
+
+#------------------------------------------------------------------------
+# Create a new OpenGL context window for image display
+#------------------------------------------------------------------------
+sub display_new_window {
+ my ($height, $width, $zoom, $name, $off_r, $off_c, $window_id) = @_;
+
+ my ($window_width, $window_height);
+ my ($zoom_x, $zoom_y);
+
+ if ( $width <= 0 || $height <= 0 || $zoom == 0.0 )
+ {
+ die "display_new_window: invalid arguments!\n";
+ }
+
+ $window_width = int($zoom*$width + 0.5);
+ $window_height = int($zoom*$height + 0.5);
+
+ # compute zoom factors to make graphics overlay the image precisely
+ $zoom_x = $window_width/$width;
+ $zoom_y = $window_height/$height;
+
+ # create display window
+ if (! $finished_glutInit ) {
+ glutInit() unless OpenGL::done_glutInit();
+ glutInitDisplayMode(GLUT_RGBA|GLUT_DOUBLE);
+ glutSetOption(GLUT_ACTION_ON_WINDOW_CLOSE,GLUT_ACTION_CONTINUE_EXECUTION) if OpenGL::_have_freeglut();
+ $finished_glutInit = 1;
+ }
+ glutInitWindowSize( $window_width, $window_height );
+ glutInitWindowPosition( $off_r, $off_c );
+ $window_id = glutCreateWindow( $name );
+
+ # set some standard defaults
+ glPixelStorei( GL_UNPACK_ALIGNMENT, 1 );
+ glClearColor( 0.0, 0.0, 0.0, 0.0 );
+ glViewport( 0, 0, $window_width, $window_height );
+
+ # set coordinate frame for graphics in window
+ glMatrixMode( GL_PROJECTION );
+ glLoadIdentity();
+
+ gluOrtho2D( 0, $width, $height, 0 );
+
+ glMatrixMode( GL_MODELVIEW );
+ glLoadIdentity();
+
+ # set zoom factors for image display
+ glPixelZoom( $zoom_x, -$zoom_y );
+
+ # set origin for drawing images as the top-left corner of the window
+ glRasterPos2i( 0, 0 );
+
+ # success
+ return $window_id;
+};
+
+#------------------------------------------------------------------------
+# Display piddle as 2-D image in window using OpenGL
+#------------------------------------------------------------------------
+
+=head1 FUNCTIONS
+
+=head2 imag2d
+
+=for ref
+
+Display a 2-D image in a figure window
+
+imag2d() creates a plain FreeGLUT OpenGL window and displays
+the input image with 1:1 aspect ratio for pixels. The window
+resize is constrained to the actual ratio of the image
+dimensions. The initial display size is currently a 200x200
+window to prevent things from being too small by default.
+
+The image to display can have dimensions ($c,$M,$N) where for
+$c==4 the display is in GL_RGBA, for $c==3 the display is GL_RGB,
+for $c==2 the display is GL_LUMINANCE_ALPHA, and for $c==1 or for
+for dimensions ($M,$N) then the display is GL_LUMINANCE.
+
+This routine does not yet thread but multiple images may be
+viewed at the same time in separate windows by multiple
+calls to imag2d(). TriD graphics visualization windows and the
+imag2d() windows may be created and used independently.
+
+NOTE: If you are twiddling a TriD window, the imag2d()
+windows are active as well. If you call twiddle()
+the sub, only the imag2d() windows will update correctly.
+
+=for usage
+
+ $window_id = imag2d($image, $name, $zoom, $x_off, $y_off);
+
+ creates a new image figure window from the input piddle
+ with the given title, zoom factor, and position (if possible)
+
+ $window_id - may be used to refer to the figure window
+
+ $image - 2D image piddle with at least 2 or 3 dimensions
+ e.g. [M,N], [1,M,N], [2,M,N], [3,M,N], [4,M,N]
+
+ $name - the name to use for the figure window (optional)
+
+ $zoom - desired (float) pixel zoom factor (optional)
+
+ ($x_off, $y_off) - desired window pixel position (optional)
+ with (0,0) as the top left pixel of the
+ display
+
+=for example
+
+ use PDL::Graphics2D; # imports imag2d() and twiddle()
+
+ $a = sequence(64,48,3); # make test RGB image
+ $a = $a->mv(2,0); # color must be dim(0) with size [0..4]
+ $a /= $a->max; # pixel values in [0.0,1.0]
+ $a = sin(10*$a);
+ $w1 = imag2d($a); # with parens...
+ $w2 = imag2d $a->sqrt; # or without
+ $w3 = imag2d $a**2;
+
+
+=head2 imag2d_update
+
+=for ref
+
+Update an existing imag2d window with new piddle data
+
+=for usage
+
+ $image = random(3,64,48)/2 + 0.25; # random pixel image
+ $win = imag2d($image); # create original image display
+
+ imag2d_update($win, $image->sequence/$image->nelem); # update data
+
+C<imag2d_update> allows one to update an C<imag2d> display window
+by replacing the associated image data with new contents. The
+new image data must be the same type and shape as the previous.
+
+Eventually, we would like to implement this via some sort of
+dataflow that would be transparent to the user.
+
+=cut
+
+=head2 twiddle
+
+=for ref
+
+Enable GUI interaction with a FreeGLUT display window.
+
+=for usage
+
+ twiddle();
+
+ Runs the FreeGLUT event loop so window GUI operations
+ such as resize, expose, mouse click,.. work
+
+=cut
+
+
+sub imag2d {
+ my ($img, $name, $zoom, $off_r, $off_c) = (undef,"Figure $cur_fig_num", undef, 0, 0);
+
+ # need to add error checking here
+ $img = (shift)->copy;
+ $name = shift if scalar(@_);
+ $zoom = shift if scalar(@_);
+ $off_r = shift if scalar(@_);
+ $off_c = shift if scalar(@_);
+
+ my $window_id;
+ my ($gldrawformat, $gldrawtype, $glds);
+
+ # determine display pixel format and type to use
+ if ($img->ndims > 2 && $img->dim(0) == 4) {
+ $gldrawformat = GL_RGBA;
+ $glds = 1;
+ } elsif ($img->ndims > 2 && $img->dim(0) == 3) {
+ $gldrawformat = GL_RGB;
+ $glds = 1;
+ } elsif ($img->ndims > 2 && $img->dim(0) == 2) {
+ $gldrawformat = GL_LUMINANCE_ALPHA;
+ $glds = 1;
+ } elsif ($img->ndims > 2 && $img->dim(0) == 1) {
+ $gldrawformat = GL_LUMINANCE;
+ $glds = 1;
+ } else {
+ $gldrawformat = GL_LUMINANCE;
+ $glds = 0;
+ };
+
+ # convert to float if double for display
+ if ($img->type->symbol eq 'PDL_D') { # clean up code
+ $img = $img->float;
+ }
+
+ # determine display pixel type to use
+ if ($img->type->symbol eq 'PDL_F') {
+ $gldrawtype = GL_FLOAT;
+ } elsif ($img->type->symbol eq 'PDL_B') {
+ $gldrawtype = GL_UNSIGNED_BYTE;
+ } elsif ($img->type->symbol eq 'PDL_S') {
+ $gldrawtype = GL_SHORT;
+ } elsif ($img->type->symbol eq 'PDL_US') {
+ $gldrawtype = GL_UNSIGNED_SHORT;
+ } elsif ($img->type->symbol eq 'PDL_L') {
+ $gldrawtype = ( $gldrawformat == GL_RGBA ) ? GL_UNSIGNED_INT_8_8_8_8 : GL_INT;
+ } else {
+ die "display_image: unsupported data type '", $img->type->symbol, "' for image display\n";
+ }
+
+ # create display window
+ my ($im_height, $im_width);
+ $im_height = $img->dim($glds+1);
+ $im_width = $img->dim($glds+0);
+ if ( !defined($zoom) and ( $im_width < 200 or $im_height < 200 ) ) {
+ # adjust zoom to make initial window bigger than 200px
+ my $mindim = ($im_width < $im_height) ? $im_width : $im_height;
+ my $zoomest = int( 200 / $mindim );
+ $zoomest += 1 unless $zoomest == 200/$mindim;
+ print STDERR "imag2d: estimated zoom factor is $zoomest\n" if $debug;
+ $zoom = $zoomest;
+ }
+ $zoom = defined($zoom) ? $zoom : 1.0;
+
+ print STDERR "imag2d: calling display_new_window( "
+ . $img->dim($glds+1) . ", "
+ . $img->dim($glds+0) . ", $zoom, $name, $off_r, $off_c )" if $debug;
+
+ if ( ! defined( $window_id = display_new_window( $img->dim($glds+1), $img->dim($glds+0), $zoom, $name, $off_r, $off_c ) ) ) {
+ print STDERR "imag2d: failure\n";
+ return;
+ }
+
+ # add GLUT window id to title
+ glutSetWindowTitle($name . ": WinID $window_id");
+ $cur_fig_num++;
+
+ # set callback function for image display
+ glutDisplayFunc ( \&display_image );
+
+ # set callback function for keypress events
+ glutKeyboardFunc ( \&key_ops );
+
+ # set callback for mouse clicks
+ glutMouseFunc( \&mouse_click );
+
+ # set callback for image window resize
+ glutReshapeFunc( \&resize_window );
+
+ glutCreateMenu( \&ModeMenu );
+ glutAddMenuEntry( "End MainLoop", $RELEASE );
+ glutAttachMenu(GLUT_RIGHT_BUTTON);
+
+ # add image and window to list
+ push @imag2d_list, { window_id => $window_id, img => $img };
+
+ # set callback for image window close
+ glutCloseFunc( \&close_imag2d_window );
+
+ # success
+ glRasterPos2i( 0, 0 );
+ glDrawPixels_s( $img->dim($glds+0), $img->dim($glds+1), $gldrawformat, $gldrawtype, $img->get_dataref );
+ glFlush();
+
+ # we don't twiddle if in PDL shell and glutRunning is on
+ twiddle() unless defined $PERLDL::TERM and ref $Term::ReadLine::toloop;
+
+ return $window_id;
+}
+
+#------------------------------------------------------------------------
+# Update imag2d() window image data
+#------------------------------------------------------------------------
+sub imag2d_update {
+ my ($win_id, $image) = @_;
+ my $img;
+
+ return unless scalar(@imag2d_list);
+
+ # search for image corresponding to window
+ foreach my $entry ( @imag2d_list ) {
+ if ( $entry->{window_id} == $win_id ) {
+ $img = $entry->{img}; # 2D piddle for now
+ last;
+ }
+ }
+
+ die "imag2d_update: callback could not find image window\n" unless defined $img;
+
+ # update display window
+ # TODO: do we need to save and restore the current window?
+ # For now: calling imag2d_update makes that window current
+ glutSetWindow($win_id);
+
+ $img .= $image->sever;
+ glutPostRedisplay();
+
+ # update display but don't force twiddle()
+ glutMainLoopEvent();
+
+ return $win_id;
+}
+
+#------------------------------------------------------------------------
+# Close a specific imag2d window
+#------------------------------------------------------------------------
+sub close_imag2d_window {
+
+ my $win_id = glutGetWindow();
+
+ if ( ! scalar(@imag2d_list) ) {
+ $imag2d_keep_twiddling = 0;
+ return;
+ }
+
+ # search for image corresponding to window
+ my ($entry, $found_it);
+ foreach $entry ( @imag2d_list ) {
+ if ($entry->{window_id} == $win_id) {
+ $found_it = 1;
+ last;
+ }
+ }
+
+ if ($found_it) {
+ @imag2d_list = grep { $_->{window_id} != $win_id } @imag2d_list;
+ } else {
+ warn "close_imag2d_window: could not find open window\n";
+ }
+}
+
+#------------------------------------------------------------------------
+# Close all imag2d windows
+#------------------------------------------------------------------------
+sub close_imag2d {
+
+ return unless scalar(@imag2d_list);
+
+ # process all image windows
+ foreach my $entry ( @imag2d_list ) {
+ glutDestroyWindow($entry->{window_id});
+ }
+
+ @imag2d_list = ();
+}
+
+#------------------------------------------------------------------------
+# Simple twiddle for perldl (use [qQ] to exit)
+#------------------------------------------------------------------------
+sub twiddle {
+ print STDERR "Type Q or q to stop twiddling...\n";
+ $imag2d_keep_twiddling = 1 if scalar(@imag2d_list);
+ while ($imag2d_keep_twiddling && scalar(@imag2d_list)) {
+ glutMainLoopEvent();
+ }
+ glutMainLoopEvent();
+ print STDERR "Stopped twiddle-ing!\n";
+}
+
+#------------------------------------------------------------------------
+# Threaded image display as tiles (code from PDL::Graphics::TriD::Image)
+#------------------------------------------------------------------------
+
+# N-D piddle -> 2-D
+sub flatten {
+ my ($this,$bin_align) = @_;
+
+ my @dims = $this->dims;
+ my $imdim0 = shift @dims; # get rid of the '3'
+
+ my $xd = $dims[0]; my $yd = $dims[1];
+ my $xdr = $xd; my $ydr = $yd;
+
+ # Calculate the whole width of the image.
+ my $ind = 0;
+ my $xm = 0; my $ym = 0;
+ for (@dims[2..$#dims]) {
+ if ($ind % 2 == 0) {
+ $xd ++; # = $dims[$ind-2];
+ $xd *= $_;
+ $xdr ++;
+ $xdr *= $_;
+ $xm++;
+ } else {
+ $yd ++; # = $dims[$ind-2];
+ $yd *= $_;
+ $ydr ++;
+ $ydr *= $_;
+ $ym++;
+ }
+ $ind++;
+ }
+ $xd -= $xm; $yd -= $ym;
+
+ # R because the final texture must be 2**x-aligned ;(
+ my ($txd ,$tyd, $xxd, $yyd);
+ if ($bin_align) {
+ for ($txd = 0; $txd < 12 and 2**$txd < $xdr; $txd++) {};
+ for ($tyd = 0; $tyd < 12 and 2**$tyd < $ydr; $tyd++) {};
+ $txd = 2**$txd; $tyd = 2**$tyd;
+ $xxd = ($xdr > $txd ? $xdr : $txd);
+ $yyd = ($ydr > $tyd ? $ydr : $tyd);
+ } else {
+ $xxd=$txd=$xdr; $yyd=$tyd=$ydr;
+ }
+
+ my $p = PDL->zeroes(PDL::float(),$imdim0,$xxd,$yyd);
+
+ # # object is PDL not PDL::Graphics::TriD::Image
+ # if(defined $this->{Opts}{Bg}) {
+ # $p .= $this->{Opts}{Bg};
+ # }
+
+ # print "MKFOOP\n";
+ my $foop = $p->slice(":,0:".($xdr-1).",0:".($ydr-1));
+
+ $ind = $#dims;
+ my $firstx = 1;
+ my $firsty = 1;
+ my $spi;
+ for (@dims[reverse(2..$#dims)]) {
+ $foop->make_physdims();
+ # print "FOOP: \n"; $foop->dump;
+ if ($ind % 2 == 0) {
+ $spi = $foop->getdim(1)/$_;
+ $foop = $foop->splitdim(1,$spi)->slice(":,0:-2")->mv(2,3);
+ } else {
+ $spi = $foop->getdim(2)/$_;
+ $foop = $foop->splitdim(2,$spi)->slice(":,:,0:-2");
+ }
+ # print "IND+\n";
+ $ind++; # Just to keep even/odd correct
+ }
+ # $foop->dump;
+ print "ASSGNFOOP!\n" if $PDL::debug;
+
+ $foop .= $this->{Im};
+ # print "P: $p\n";
+ return wantarray() ? ($p,$xd,$yd,$txd,$tyd) : $p;
+}
+
+sub toimage {
+ # initially very simple implementation
+ my ($this) = @_;
+ return $this->flatten(0);
+}
+
+1;
+
diff --git a/Graphics/IIS/Makefile.PL b/Graphics/IIS/Makefile.PL
new file mode 100644
index 0000000..be570b6
--- /dev/null
+++ b/Graphics/IIS/Makefile.PL
@@ -0,0 +1,39 @@
+
+BEGIN {
+ PDL::Core::Dev->import();
+ $skip = 0;
+ if ($^O =~ /win32/i) {
+ write_dummy_make(unsupported('PDL::Graphics::IIS','win32'));
+ $skip=1;
+ }
+}
+
+return if $skip;
+
+# Makefile.PL for PDL::Graphics::IIS module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+
+#use PDL::Core::Dev;
+PDL::Core::Dev->import();
+
+use ExtUtils::MakeMaker;
+
+# Replace this wit:e
+
+ at pack = (["iis.pd",IIS,PDL::Graphics::IIS]);
+
+#WriteMakefile(
+# pdlpp_stdargs_int(@::pack)
+#);
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{LIBS} = ['-lm'];
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
+
diff --git a/Graphics/IIS/iis.pd b/Graphics/IIS/iis.pd
new file mode 100644
index 0000000..421173e
--- /dev/null
+++ b/Graphics/IIS/iis.pd
@@ -0,0 +1,655 @@
+
+pp_addpm({At=>Top},<<'EOD');
+
+=head1 NAME
+
+PDL::Graphics::IIS - Display PDL images on IIS devices (saoimage/ximtool)
+
+=head1 SYNOPSIS
+
+ use PDL::Graphics::IIS;
+ saoimage ( -geometry => '800x800' );
+ iis rvals(100,100);
+
+=head1 DESCRIPTION
+
+This module provides an interface to any image display 'device' which support the
+'IIS protocol' - viz the SAOimage and Ximtool X-windows programs, the
+old SunView imtool program and presumably even the original IIS CRT itself
+if they aren't all in museums!
+
+These programs should be familiar to astronomer's - they are used by
+the common IRAF system. The programs and their HTML documentation
+can be obtained from the following URLs:
+
+ SAOimage: http://tdc-www.harvard.edu/software/saoimage.html
+ Ximtool: http://iraf.noao.edu/iraf/web/projects/x11iraf/x11iraf.html
+
+Non-astronomer's may find they quite nifty for displaying 2D data.
+
+The Perl variable C<$stdimage> is exported from the module and controls
+the frame buffer configuration currently in use. The default value
+is C<imt1024> which specifies a C<1024x1024> frame buffer. Other
+values supported by the module are:
+
+ imt512, imt800, imt1024, imt1600, imt2048, and imt4096.
+
+If you have a F<$HOME/.imtoolrc> you can use it to specify other frame
+buffer names and configurations in exactly the same way you can in
+IRAF. Here is a sample file:
+
+ -------------------snip-------------------------
+ # Format: configno nframes width height
+ 1 2 512 512 # imt1|imt512
+ 2 2 800 800 # imt2|imt800
+ 3 2 1024 1024 # imt3|imt1024
+ 4 1 1600 1600 # imt4|imt1600
+ 5 1 2048 2048 # imt5|imt2048
+ 6 1 4096 4096 # imt6|imt4096
+ 7 1 8192 8192 # imt7|imt8192
+ 8 1 1024 4096 # imt8|imt1x4
+ 9 2 1144 880 # imt9|imtfs full screen (1152x900 minus frame)
+ 10 2 1144 764 # imt10|imtfs35 full screen at 35mm film aspect ratio
+ -------------------snip-------------------------
+
+(Note: some versions of SAOimage may not even work if this file is not
+present. If you get funny error messages about 'imtoolrc' try copying
+the above to F<$HOME/.imtoolrc> or F</usr/local/lib/imtoolrc>)
+
+The Perl variable C<$iisframe> is also exported from the module and controls
+which display frame number to use in programs such as Ximtool which supports
+multiple frames. This allows you to do useful things such as blink between
+images.
+
+The module communicates with the IIS device down FIFO pipes (special UNIX
+files) - unlike IRAF this module does a pretty decent job of intelligently
+guessing which file names to use for the pipes and will prompt for their
+creating if absent. Also if SAOimage or Ximtool are started from within Perl
+using the module this will guarantee correct file names!
+
+=head1 FUNCTIONS
+
+=cut
+
+
+EOD
+
+use Config;
+
+pp_add_exported('','iis iiscur iiscirc $stdimage $iisframe saoimage ximtool');
+
+############################## PM CODE ########################################
+
+pp_addpm(<<'ENDOFPM');
+
+use PDL::Core '';
+use PDL::Basic '';
+use Carp;
+
+$iisframe = 1; # Starting defaults
+$stdimage = "imt1024";
+$last_stdimage = "";
+$HOME = $ENV{'HOME'}; # Used a lot so shorten
+
+
+################ Public routines #################
+
+# Display
+
+=head2 iis
+
+=for ref
+
+Displays an image on a IIS device (e.g. SAOimage/Ximtool)
+
+=for usage
+
+ iis $image, [ { MIN => $min, MAX => $max,
+ TITLE => 'pretty picture',
+ FRAME => 2 } ]
+ iis $image, [$min,$max]
+
+=for sig
+
+ (image(m,n),[\%options]) or (image(m,n),[min(),max()])
+
+Displays image on a IIS device. If C<min()> or C<max()> are omitted they
+are autoscaled. A good demonstration of PDL threading can be had
+by giving C<iis()> a data *cube* - C<iis()> will be repeatedly called
+for each plane of the cube resulting in a poor man's movie!
+
+If supplied, C<TITLE> is used to label the frame, if no title is
+supplied, either the C<OBJECT> value stored in the image header or a
+default string is used (the title is restricted to a maximum
+length of 32 characters).
+
+To specify which frame to draw to, either use
+the package variable C<$iisframe>, or the C<FRAME> option.
+
+=cut
+
+sub iis {
+ my $usage = 'Usage: iis ( $image, [\%hash | $min, $max] )';
+ barf $usage if $#_<0 || $#_>2;
+
+ my $image = shift;
+ my ( $min, $max );
+
+ my $title = 'perlDL rules !';
+ my $header = $image->gethdr();
+ if ( defined $header and defined $$header{OBJECT} ) {
+ $title = $$header{OBJECT};
+ $title =~ s/^'(.*)'$/$1/;
+ }
+
+ my $frame = $iisframe;
+ if ( $#_ == 1 ) { $min = $_[0]; $max = $_[1]; }
+ elsif ( $#_ == 0 ) {
+ barf $usage unless ref($_[0]) eq "HASH";
+
+ my $opt = new PDL::Options( { MIN => undef, MAX => undef, TITLE => $title, FRAME => $frame } );
+ $opt->options( shift );
+ my $options = $opt->current;
+
+ $min = $$options{MIN};
+ $max = $$options{MAX};
+ $title = $$options{TITLE};
+ $iisframe = $$options{FRAME};
+ }
+
+ my($nx,$ny) = dims($image);
+ fbconfig($stdimage) if $stdimage ne $last_stdimage;
+ $min = $image->min unless defined $min;
+ $max = $image->max unless defined $max;
+ print "Displaying $nx x $ny image in frame $iisframe from $min to $max ...\n" if $PDL::verbose;
+ PDL::_iis($image,$min,$max,$title);
+ $iisframe = $frame; # restore value
+ 1;
+}
+
+=head2 iiscur
+
+=for ref
+
+Return cursor position from an IIS device (e.g. SAOimage/Ximtool)
+
+=for usage
+
+ ($x,$y) = iiscur($ch)
+
+This function puts up an interactive cursor on the IIS device and returns
+the C<($x,$y)> position and the character typed (C<$ch>)
+by the user.
+
+=cut
+
+sub iiscur {
+ barf 'Usage: ($x,$y) = iiscur($ch)' if $#_>=1;
+ my ($x,$y,$ch) = _iiscur_int();
+ $_[0] = $ch; # Pass this back in args
+ return ($x,$y);
+}
+
+=head2 iiscirc
+
+=for ref
+
+Draws a circle on a IIS device (e.g. SAOimage/Ximtool)
+
+=for sig
+
+ (x(),y(),radius(),colour())
+
+=for usage
+
+ iiscirc $x, $y, [$radius, $colour]
+
+Draws circles on the IIS device with specied points and colours. Because
+this module uses
+L<PDL::PP|PDL::PP> threading you can supply lists of points via
+1D arrays, etc.
+
+An amusing PDL idiom is:
+
+ pdl> iiscirc iiscur
+
+Note the colours are the same as IRAF, viz:
+
+ 201 = cursor color (white)
+ 202 = black
+ 203 = white
+ 204 = red
+ 205 = green
+ 206 = blue
+ 207 = yellow
+ 208 = cyan
+ 209 = magenta
+ 210 = coral
+ 211 = maroon
+ 212 = orange
+ 213 = khaki
+ 214 = orchid
+ 215 = turquoise
+ 216 = violet
+ 217 = wheat
+
+=cut
+
+sub iiscirc {
+ barf 'Usage: iiscirc( $x, $y, [$radius, $colour] )' if $#_<1 || $#_>3;
+ my($x, $y, $radius, $colour)=@_;
+ fbconfig($stdimage) if $stdimage ne $last_stdimage;
+ $radius = 10 unless defined $radius;
+ $colour = 204 unless defined $colour;
+ PDL::_iiscirc($x, $y, $radius, $colour);
+ 1;
+}
+
+=head2 saoimage
+
+=for ref
+
+Starts the SAOimage external program
+
+=for usage
+
+ saoimage[(command line options)]
+
+Starts up the SAOimage external program. Default FIFO devices are chosen
+so as to be compatible with other IIS module functions. If no suitable
+FIFOs are found it will offer to create them.
+
+e.g.:
+
+=for example
+
+ pdl> saoimage
+ pdl> saoimage( -geometry => '800x800' )
+
+=cut
+
+sub saoimage { # Start SAOimage
+ fbconfig($stdimage) if $stdimage ne $last_stdimage;
+ if( !($pid = fork)) { # error or child
+ exec("saoimage", -idev => $fifo, -odev => $fifi, @_) if defined $pid;
+ die "Can't start saoimage: $!\n";
+ }
+ return $pid;
+}
+
+=head2 ximtool
+
+=for ref
+
+Starts the Ximtool external program
+
+=for usage
+
+ ximtool[(command line options)]
+
+Starts up the Ximtool external program. Default FIFO devices are chosen
+so as to be compatible with other IIS module functions. If no suitable
+FIFOs are found it will offer to create them.
+
+e.g.
+
+=for example
+
+ pdl> ximtool
+ pdl> ximtool (-maxColors => 64)
+
+=cut
+
+sub ximtool { # Start Ximtool
+ fbconfig($stdimage) if $stdimage ne $last_stdimage;
+ if( !($pid = fork)) { # error or child
+ exec("ximtool", -xrm => "ximtool*input_fifo: $fifi", -xrm => "ximtool*output_fifo: $fifo", @_) if defined $pid;
+ die "Can't start ximtool: $!\n";
+ }
+ return $pid;
+}
+
+
+################ Private routines #################
+
+# Change the frame buffer configuration
+
+sub fbconfig {
+ my $name = shift;
+ parseimtoolrc() unless $parsed++;
+ findfifo() unless $foundfifo++;
+ barf 'No frame buffer configuration "'.$name.'" found'."\n"
+ unless defined $imtoolrc{$name};
+ ($fbconfig, $fb_x, $fb_y ) = @{ $imtoolrc{$name} };
+ print "Using $stdimage - fbconfig=$fbconfig (${fb_x}x$fb_y)\n" if $PDL::verbose;;
+ $last_stdimage = $stdimage;
+1;}
+
+# Try and find user/system imtoolrc definitions
+
+sub parseimtoolrc {
+ # assoc array holds imtool configuations - init with some standard
+ # ones in case imtoolrc goes missing
+
+ %imtoolrc = (
+ 'imt512' => [1,512,512], 'imt800' => [2,800,800],
+ 'imt1024' => [3,1024,1024], 'imt1600' => [4,1600,1600],
+ 'imt2048' => [5,2048,2048], 'imt4096' => [6,4096,4096],
+ );
+
+ # Look for imtoolrc file
+
+ $imtoolrc = "/usr/local/lib/imtoolrc";
+ $imtoolrc = "$HOME/.imtoolrc" if -e "$HOME/.imtoolrc";
+ if (!-e $imtoolrc) {
+ warn "WARNING: unable to find an imtoolrc file in $HOME/.imtoolrc\n".
+ "or /usr/local/lib/imtoolrc. Will try \$stdimage = imt1024.\n";
+ return 1;
+ }
+
+ # Load frame buffer configuartions from imtoolrc file and
+ # store in assoc array
+
+ open(IMTOOLRC, $imtoolrc) || die "File $imtoolrc not found";
+ while(<IMTOOLRC>) {
+ if ( /^\s*(\d+)\s+\d+\s+(\d+)\s+(\d+)\s+\#\s*(\S+)\s/ ) {
+ foreach $name (split(/\|/,$4)) {
+ $imtoolrc{$name} = [$1,$2,$3];
+ }
+ }
+ }close(IMTOOLRC);
+1;}
+
+# Try a few obvious places for the FIFO pipe and create if necessary
+
+sub findfifo {
+ $fifi = ""; $fifo = "";
+ if (-e "/dev/imt1i" && -e "/dev/imt1o") {
+ $fifi = "/dev/imt1i"; $fifo = "/dev/imt1o";
+ }
+ if (-e "$HOME/dev/imt1i" && -e "$HOME/dev/imt1o") {
+ $fifi = "$HOME/dev/imt1i"; $fifo = "$HOME/dev/imt1o";
+ }
+ if (-e "$HOME/iraf/dev/imt1i" && -e "$HOME/iraf/dev/imt1o") {
+ $fifi = "$HOME/iraf/dev/imt1i"; $fifo = "$HOME/iraf/dev/imt1o";
+ }
+ if (defined $ENV{'IMTDEV'} && $ENV{'IMTDEV'} =~ /^fifo:(.*):(.*)$/) {
+ $fifi = $1; $fifo = $2;
+ }
+ if ($fifi eq "" && $fifo eq "") { # Still not found use this default
+ warn "WARNING: cannot locate FIFO pipes in /dev/, $HOME/dev, ".
+ "$HOME/iraf/dev or environment variable \$IMTDEV\n";
+ $fifi = "$HOME/dev/imt1i"; $fifo = "$HOME/dev/imt1o";
+ }
+ print "Using FIFO devices in: $fifi\n".
+ " out: $fifo\n" if $PDL::verbose;
+ for $pipe ($fifi, $fifo) {
+ if (!-p $pipe) {
+ print "FIFO $pipe does not exist - try and create now? "; my $ans = <STDIN>;
+ system "/usr/etc/mknod $pipe p" if $ans =~ /^y/i;
+
+ if ($ans =~ /^y/i) {
+ unlink $pipe if -e $pipe;
+ my $path = $ENV{PATH};
+ $ENV{PATH} .= ":/etc:/usr/etc";
+
+ # Note system return value is backwards - hence 'and'
+
+ if ( system('mknod', $pipe, 'p') and system('mkfifo',$pipe) ) {
+ die "Failed to create named pipe $pipe\n";
+ }
+ $ENV{PATH} = $path;
+ }
+ }
+ }
+1;}
+
+
+ENDOFPM
+
+################################ XS CODE ######################################
+
+pp_addhdr(<<"EOD");
+#include "libiis.h"
+EOD
+
+# Non-blocking I/O
+
+pp_addhdr(<<"EOD") if defined $Config{'o_nonblock'} && $Config{'o_nonblock'} ne 'O_NONBLOCK';
+#define O_NONBLOCK $Config{'o_nonblock'}
+EOD
+
+pp_addhdr(<<"EOD");
+#include "pdliisdisp.c"
+EOD
+
+pp_addxs('',<<'EOD');
+
+MODULE = PDL::Graphics::IIS PACKAGE = PDL::Graphics::IIS
+
+void
+_iiscur_int()
+ PPCODE:
+ STRLEN n_a;
+ STRLEN n_b;
+ float x,y;
+ char ch;
+ int frame = (int)SvIV( perl_get_sv("iisframe", FALSE) );
+
+ iis_open(SvPV(perl_get_sv("fifi",FALSE),n_a),SvPV(perl_get_sv("fifo",FALSE),n_b),
+ (int)SvIV( perl_get_sv("fbconfig", FALSE) ),
+ (int)SvIV( perl_get_sv("fb_x", FALSE) ),
+ (int)SvIV( perl_get_sv("fb_y", FALSE) ) );
+ iis_cur(&x,&y,&ch);
+ iis_close();
+
+ EXTEND(sp,3);
+ PUSHs(sv_2mortal(newSVnv((float)x)));
+ PUSHs(sv_2mortal(newSVnv((float)y)));
+ PUSHs(sv_2mortal(newSVpv(&ch,1)));
+
+
+EOD
+
+# Internal routine for iis()
+
+pp_bless('PDL::Graphics::IIS');
+
+pp_def('_iis',
+ Pars => 'image(m,n); min(); max();',
+ OtherPars => 'char *perl_title',
+ Doc => undef,
+ Code => '
+
+ int frame = (int)SvIV( perl_get_sv("iisframe", FALSE) );
+
+ unsigned short hdr[8];
+ unsigned char *data;
+ int j,nlines, x,y, offx, offy, nx, ny, nx2, ny2, baseX, baseY, m1, n1;
+ int ntrans;
+ float xx, yx, xy, yy, xo, yo; int w_type; /* WCS */
+ float fmin, fmax;
+ char wcsbuf[SZ_WCSTEXT];
+ char title[33]; /* 32 chars + null terminator */
+ int chan;
+ STRLEN n_a;
+ STRLEN n_b;
+
+ /* Open pipes etc */
+
+ if (frame<1 || frame>4)
+ barf("$iisframe must be in range 1--4");
+
+ iis_open(SvPV(perl_get_sv("fifi",FALSE),n_a),SvPV(perl_get_sv("fifo",FALSE),n_b),
+ (int)SvIV( perl_get_sv("fbconfig", FALSE) ),
+ (int)SvIV( perl_get_sv("fb_x", FALSE) ),
+ (int)SvIV( perl_get_sv("fb_y", FALSE) ) );
+
+ /* Convenience variables */
+
+ nx = $PRIV(__m_size);
+ ny = $PRIV(__n_size);
+ fmin = (float) $min();
+ fmax = (float) $max();
+
+ chan = iis_chan(frame);
+
+ /* Work out how many lines to transfer at a go */
+
+ ntrans = BUFFSZ/frameX;
+ if (ntrans<1)
+ ntrans = 1;
+
+ /* Allocate buffer for data transfers */
+
+ data = (unsigned char*) calloc(ntrans*frameX, sizeof(unsigned char));
+ if (data==NULL)
+ iis_error("iis_display: out of memory for buffer","");
+
+ threadloop %{
+
+ /* Send WCS info */
+
+ hdr[TRANSFER_ID] = PDL_IIS_IWRITE | PACKED;
+ hdr[THING_COUNT] = -SZ_WCSTEXT;
+ hdr[SUB_UNIT] = WCS;
+ hdr[CHECK_SUM] = 0;
+ hdr[X_REGISTER] = 0;
+ hdr[Y_REGISTER] = 0;
+ hdr[Z_REGISTER] = chan;
+ hdr[T_REGISTER] = fbconfig-1; /* fbconfig number */
+ iis_checksum(hdr);
+ iis_write((char*)hdr, 8*sizeof(short));
+
+ offx = 0; offy = 0; /* Centre image in frame if small */
+ if (nx<frameX)
+ offx = (frameX-nx)/2;
+ if (ny<frameY)
+ offy = (frameY-ny)/2;
+
+ nx2 = nx; ny2 = ny; baseX=0; baseY=0; /* Truncate image if too big */
+ if (nx>frameX) {
+ nx2=frameX; baseX = (nx-frameX)/2;
+ }
+ if (ny>frameY) {
+ ny2=frameY; baseY = (ny-frameY)/2;
+ }
+
+ /* Note my WCS is zero offset! */
+
+ xx=1; yx=0; xy=0; yy=-1; xo=baseX-offx; yo=baseY+frameY-offy-1; w_type=1;
+
+ strncpy( title, $COMP(perl_title), 32 );
+ title[32] = ' . "'" . '\0' . "'" . ';
+ sprintf (wcsbuf, "%-33s\n%f %f %f %f %f %f %f %f %d",
+ title, /*** was "perlDL rules!", ***/
+ xx, yx, xy, yy, xo, yo, fmin, fmax, w_type);
+ iis_write((char*)wcsbuf, SZ_WCSTEXT*sizeof(char));
+
+ /* Reset the frame buffer */
+
+ hdr[TRANSFER_ID] = fbconfig-1; /* fbconfig number */
+ hdr[THING_COUNT] = 0;
+ hdr[SUB_UNIT] = FEEDBACK;
+ hdr[CHECK_SUM] = 0;
+ hdr[X_REGISTER] = 0;
+ hdr[Y_REGISTER] = 0;
+ hdr[Z_REGISTER] = chan;
+ hdr[T_REGISTER] = 0;
+ iis_checksum(hdr);
+ iis_write((char*)hdr, 8*sizeof(short));
+
+ { $GENERIC() val,sval;
+
+ for (y = 0; y < ny2; y+=ntrans) {
+
+ nlines = ntrans; /* Number of lines to transfer */
+ if (y+ntrans>ny2)
+ nlines = ny2 - y;
+
+ /* create header */
+ hdr[TRANSFER_ID] = PDL_IIS_IWRITE | PACKED | BLOCKXFER;
+ hdr[THING_COUNT] = -nlines*frameX;
+ hdr[SUB_UNIT] = REFRESH;
+ hdr[CHECK_SUM] = 0;
+ hdr[X_REGISTER] = ADVXONTC;
+ hdr[Y_REGISTER] = ADVYONXOV+frameY-y-nlines-offy;
+ hdr[Z_REGISTER] = chan;
+ hdr[T_REGISTER] = ALLBITPL;
+ iis_checksum(hdr);
+ iis_write((char*)hdr, 8*sizeof(short));
+
+ for (j=0; j<nlines; j++) {
+ n1 = baseY+y+nlines-j-1;
+ for (x = 0; x < nx2; x++) {
+ m1 = x + baseX;
+ val = $image(m=>m1, n=>n1);
+ sval = FMIN+(val-fmin)*(FMAX-FMIN)/(fmax-fmin);
+ if (sval<FMIN)
+ sval = FMIN;
+ if (sval>FMAX)
+ sval = FMAX;
+ data[j*frameX+x+offx] = (unsigned char) sval;
+ }
+ }
+ iis_write((char*)data, nlines*frameX*sizeof(char) );
+ }
+
+ }
+
+ %}
+
+ free(data);
+ iis_close();
+
+'); # End of iis_c pp_def
+
+pp_def( '_iiscirc',
+ Pars => 'x(); y(); r(); colour();',
+ Doc => undef,
+ Code => '
+
+ int frame = (int)SvIV( perl_get_sv("iisframe", FALSE) );
+ STRLEN n_a;
+
+ /* Open pipes etc */
+
+ if (frame<1 || frame>4)
+ barf("$iisframe must be in range 1--4");
+
+ iis_open(SvPV(perl_get_sv("fifi",FALSE),n_a),SvPV(perl_get_sv("fifo",FALSE),n_a),
+ (int)SvIV( perl_get_sv("fbconfig", FALSE) ),
+ (int)SvIV( perl_get_sv("fb_x", FALSE) ),
+ (int)SvIV( perl_get_sv("fb_y", FALSE) ) );
+
+ threadloop %{
+ iis_drawcirc( (float) $x(), (float) $y(), (float) $r(), (int) $colour(), frame);
+ %}
+
+ iis_close();
+
+'); # End of iiscirc_c pp_def
+
+
+pp_addpm({At=>Bot},<<'EOD');
+
+=head1 BUGS
+
+None known
+
+=head1 AUTHOR
+
+Copyright (C) Karl Glazebrook 1997.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+
+EOD
+
+pp_done();
+
diff --git a/Graphics/IIS/libiis.h b/Graphics/IIS/libiis.h
new file mode 100644
index 0000000..b81ef13
--- /dev/null
+++ b/Graphics/IIS/libiis.h
@@ -0,0 +1,154 @@
+
+/*
+ Note: libiis.h in PDL distribution has iis_display
+ redefined
+*/
+
+/*
+
+ libiis.h - IIS constants for IIS C library v1.0
+
+ Loosely based on code from various sources
+
+ Karl Glazebrook, Anglo-Australian Observatory 30/May/1996
+
+ email: kgb at aaoepp.aao.gov.au
+
+*/
+
+#include <stdio.h>
+#include <math.h>
+#include <stdlib.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <string.h>
+
+#define TRANSFER_ID 0
+#define THING_COUNT 1
+#define SUB_UNIT 2
+#define CHECK_SUM 3
+#define X_REGISTER 4
+#define Y_REGISTER 5
+#define Z_REGISTER 6
+#define T_REGISTER 7
+
+/* Transfer ID definitions */
+
+#define PDL_IIS_IREAD 0100000
+#define PDL_IIS_IWRITE 00
+#define PACKED 040000
+#define BYPASSIFM 020000
+#define BYTE 010000
+#define ADDWRITE 04000
+#define ACCUM 02000
+#define BLOCKXFER 01000
+#define VRETRACE 0400
+#define MUX32 0200
+#define IMT800 0100
+
+/* Subunits */
+
+#define REFRESH 01
+#define LUT 02
+#define OFM 03
+#define IFM 04
+#define FEEDBACK 05
+#define SCROLL 06
+#define VIDEOM 07
+#define SUMPROC 010
+#define GRAPHICS 011
+#define CURSOR 012
+#define ALU 013
+#define ZOOM 014
+#define IPB 017
+
+/* following from iraf "iis.h" */
+#define IMCURSOR 020
+#define WCS 021
+
+/* checksum */
+#define CHECKSUMVAL 0177777
+
+/* Command definitions from iraf iis.h */
+
+#define COMMAND 100000B
+
+
+/* X-register */
+#define ADVXONTC 0100000
+#define ADVXONYOV 040000
+
+/* Y-register */
+
+#define ADVYONXOV 0100000
+#define ADVYONTC 040000
+
+/* Z-register */
+
+#define CHAN1 01
+#define CHAN2 02
+#define CHAN3 04
+#define CHAN4 010
+#define GRCHAN 0100000
+
+/* T-register */
+
+#define BITPL0 01
+#define BITPL1 02
+#define BITPL2 04
+#define BITPL3 010
+#define BITPL4 020
+#define BITPL5 040
+#define BITPL6 0100
+#define BITPL7 0200
+#define ALLBITPL 0377
+
+/* IIS WCS buffer */
+
+
+/* Imtool colour numbers */
+
+#define FMIN 1
+#define FMAX 200
+#define IIS_GREEN 201
+#define IIS_BLACK 202
+#define IIS_WHITE 203
+#define IIS_RED 204
+#define IIS_BLUE 206
+#define IIS_YELLOW 207
+
+/* Buffer sizes */
+
+#define BUFFSZ 16384 /* Approx number of bytes to transfer per record */
+#define RBUFFSZ 2048 /* Approx number of bytes to transfer when reading */
+#define STRSIZE 1024 /* Useful string size */
+#define SZ_WCSTEXT 320 /* WCS text */
+
+/* Global variables */
+
+static int iispipe_i; /* FIFO pipe handles */
+static int iispipe_o;
+static int fbconfig; /* Frame buffer configaration */
+static int frameX;
+static int frameY;
+
+/* Public functions prototypes */
+
+int iis_display(void *f, int datatype,
+ int N1, int N2, float fmin, float fmax, int frame);
+void iis_cur(float*x, float*y, char* ch);
+void iis_drawcirc(float xcen, float ycen, float radius, int colour, int frame);
+void iis_open(char* inpipe, char* outpipe, int fb, int fbx, int fby);
+void iis_close();
+
+/* Private functions prototypes */
+
+void iis_write(char* buf, int size);
+void iis_read (char* buf, int size);
+void iis_checksum(unsigned short *hdr);
+void iis_error(char* error1, char* error2);
+int iis_chan(int frame);
+int iis_round ( float i );
+float iis_abs (float x);
+
+
diff --git a/Graphics/IIS/pdliisdisp.c b/Graphics/IIS/pdliisdisp.c
new file mode 100644
index 0000000..930161a
--- /dev/null
+++ b/Graphics/IIS/pdliisdisp.c
@@ -0,0 +1,390 @@
+/***************************************************************
+
+ pdliisdisplay.c
+
+****************************************************************/
+
+/* Redefine iis_error to use Perl's croak() */
+
+void iis_error( char* error1, char*error2 ) {
+ croak (error1,error2);
+}
+
+
+/*****************************************************/
+
+
+/* Rest of the subroutines are identical to libiis.c v1.0 */
+
+
+/******************* iis_cur ************************/
+
+/* Return cursor position and character typed */
+
+void iis_cur(float*x, float*y, char* ch) {
+
+ unsigned short hdr[8];
+ short buf[SZ_WCSTEXT];
+ int nbytes,wcs;
+
+ /* Send read request */
+
+ hdr[TRANSFER_ID] = PDL_IIS_IREAD;
+ hdr[THING_COUNT] = 0;
+ hdr[SUB_UNIT] = IMCURSOR;
+ hdr[CHECK_SUM] = 0;
+ hdr[X_REGISTER] = 0;
+ hdr[Y_REGISTER] = 0;
+ hdr[Z_REGISTER] = 0;
+ hdr[T_REGISTER] = 0;
+ iis_checksum(hdr);
+ iis_write((char*)hdr, 8*sizeof(short));
+
+ /* Read however many bytes it send in this case */
+
+ if ((nbytes = read (iispipe_i, buf, SZ_WCSTEXT)) <= 0)
+ iis_error ("iis_cur: cannot read IIS pipe\n","");
+
+ if (sscanf ((char*)buf, "%f %f %d %c", x, y, &wcs, ch) != 4)
+ iis_error ("iis_cur: can't parse '%s'\n", (char*)buf);
+}
+
+
+/******************* iis_drawcirc *******************/
+
+/* Draw a circle on the image display at a given position */
+
+void iis_drawcirc(float xcen, float ycen, float radius, int colour, int frame) {
+
+ unsigned short hdr[8];
+ unsigned char *data;
+ int i,j,y;
+ int ymin,ymax,ntrans,nlines,nbytes;
+ float xcen2,ycen2,dd;
+ char wcsbuf[SZ_WCSTEXT];
+ float xx, yx, xy, yy, xo, yo; /* wcs matrix values */
+ float xx2, yx2, xy2, yy2, xo2, yo2; /* wcs inverse matrix values */
+ char label[1024]; /* wcs file title */
+ int w_type; /* wcs scaling code */
+ float low, high; /* wcs scaling limits */
+ int chan;
+ float rr;
+
+ chan = iis_chan(frame);
+
+
+ /* Send WCS read request */
+
+ hdr[TRANSFER_ID] = -PDL_IIS_IREAD;
+ hdr[THING_COUNT] = 0;
+ hdr[SUB_UNIT] = WCS;
+ hdr[CHECK_SUM] = 0;
+ hdr[X_REGISTER] = 0;
+ hdr[Y_REGISTER] = 0;
+ hdr[Z_REGISTER] = chan;
+ hdr[T_REGISTER] = 0;
+ iis_checksum(hdr);
+ iis_write((char*)hdr, 8*sizeof(short));
+
+ iis_read ((char*)wcsbuf, SZ_WCSTEXT); /* Get WCS data */
+
+ sscanf(wcsbuf, "%[^\n]\n%f%f%f%f%f%f%f%f%d", label,
+ &xx, &yx, &xy, &yy, &xo, &yo, &low, &high, &w_type);
+
+ /* Invert transform (I don't care about non-square coord systems! */
+
+ xcen2 = (xcen-xo)/xx;
+ ycen2 = frameY - (ycen-yo)/yy - 1;
+
+ /* Correct scale factor - OK for square images don't want to
+ draw ellipses for non-square ones so take geometric mean */
+
+ rr = radius / sqrt(iis_abs(xx*yy));
+
+ /* Transfer limits (with buffer to allow for edge effects) */
+
+ ymin = ycen2-rr-2;
+ if (ymin<0)
+ ymin=0;
+ ymax = ycen2+rr+2;
+ if (ymax>=frameY)
+ ymax=frameY-1;
+
+ /* Work out how many lines to transfer at a go */
+
+ ntrans = RBUFFSZ/frameX;
+ if (ntrans<1)
+ ntrans = 1;
+
+ /* Allocate buffer for data transfers */
+
+ data = (unsigned char*) calloc(ntrans*frameX, sizeof(unsigned char));
+ if (data==NULL)
+ iis_error("iis_drawcirc: out of memory for buffer","");
+
+ /* Loop over blocks */
+
+ for (y = ymin; y < ymax; y+=ntrans) {
+
+ nlines = ntrans; /* Number of lines to transfer */
+ if (y+ntrans>ymax)
+ nlines = ymax - y;
+
+ /* Read data */
+
+ hdr[TRANSFER_ID] = -PDL_IIS_IREAD | PACKED | BLOCKXFER;
+ hdr[THING_COUNT] = -nlines*frameX;
+ hdr[SUB_UNIT] = REFRESH;
+ hdr[CHECK_SUM] = 0;
+ hdr[X_REGISTER] = ADVXONTC;
+ hdr[Y_REGISTER] = ADVYONXOV+frameY-y-nlines;
+ hdr[Z_REGISTER] = chan;
+ hdr[T_REGISTER] = ALLBITPL;
+ iis_checksum(hdr);
+ iis_write((char*)hdr, 8*sizeof(short));
+ iis_read((char*)data, nlines*frameX*sizeof(char));
+
+ /* Write data */
+
+ hdr[TRANSFER_ID] = PDL_IIS_IWRITE | PACKED | BLOCKXFER;
+ hdr[THING_COUNT] = -nlines*frameX;
+ hdr[SUB_UNIT] = REFRESH;
+ hdr[CHECK_SUM] = 0;
+ hdr[X_REGISTER] = ADVXONTC;
+ hdr[Y_REGISTER] = ADVYONXOV+frameY-y-nlines;
+ hdr[Z_REGISTER] = chan;
+ hdr[T_REGISTER] = ALLBITPL;
+ iis_checksum(hdr);
+ iis_write((char*)hdr, 8*sizeof(short));
+
+ /* Change Data - draw in i and j to fill circle gaps via symmetry */
+
+ for (j=0; j<nlines; j++) {
+ dd = rr*rr - (y+j-ycen2)*(y+j-ycen2);
+ if (dd>=0) {
+ dd = sqrt(dd);
+ i = iis_round( (float)xcen2 - dd );
+ if (i>=0 && i<frameX)
+ data[ (nlines-j-1)*frameX + i ] = colour;
+ i = iis_round( (float)xcen2 + dd );
+ if (i>=0 && i<frameX)
+ data[ (nlines-j-1)*frameX + i ] = colour;
+ }
+ }
+
+ for (i=0; i<frameX; i++) {
+ dd = rr*rr - (i-xcen2)*(i-xcen2);
+ if (dd>=0) {
+ dd = sqrt(dd);
+ j = iis_round( (float)ycen2 - (float)y - dd );
+ if (j>=0 && j<nlines)
+ data[ (nlines-j-1)*frameX + i ] = colour;
+ j = iis_round( (float)ycen2 - (float)y + dd );
+ if (j>=0 && j<nlines)
+ data[ (nlines-j-1)*frameX + i ] = colour;
+ }
+ }
+
+ iis_write((char*)data, nlines*frameX*sizeof(char));
+
+ }
+ free(data);
+}
+
+
+/******************* iis_open ****************/
+
+/*
+ Open IIS connection - if inpipe or outpipe are "" default
+ pipes are searched for in the environment variable $IMTDEV,
+ then in the directories (with the usual filenames) $HOME/iraf/dev,
+ $HOME/dev, and finally /dev.
+
+ Note the frame buffer configuration number and dimensions
+ must be suppled by hand - life is too short to write
+ imtoolrc parsing code in C! If these don't match those in the
+ appropriate imtoolrc file problems will occur.
+
+*/
+
+void iis_open(char* inpipe, char* outpipe, int fb, int fbx, int fby) {
+
+ FILE *syspipe;
+ char *home, *imtdev, *tok=NULL;
+ char iname[STRSIZE],oname[STRSIZE];
+ int i,j;
+
+ home = getenv("HOME");
+
+ imtdev = getenv("IMTDEV");
+ if (imtdev != NULL) /* Start parsing IMTDEV environment variable */
+ tok = strtok(imtdev,":");
+ if (tok!=NULL && strcmp(tok,"fifo")!=0) /* Ignore if not fifo */
+ tok = NULL;
+
+ /* Get input fifo name */
+
+ if (strcmp(inpipe,"")==0) {
+
+ if (tok!=NULL) { /* Check next bit of IMTDEV */
+ tok = strtok(NULL,":");
+ if (tok != NULL) {
+ strncpy(iname,tok,STRSIZE);
+ goto gotin;
+ }
+ }
+
+ /* Else look in standard places */
+
+ strncpy(iname,home,STRSIZE); strncat(iname,"/iraf/dev/imt1i",STRSIZE);
+ if (!access(iname,F_OK))
+ goto gotin;
+ strncpy(iname,home,STRSIZE); strncat(iname,"/dev/imt1i",STRSIZE);
+ if (!access(iname,F_OK))
+ goto gotin;
+ strncpy(iname,"/dev/imt1i",STRSIZE);
+ if (!access(iname,F_OK))
+ goto gotin;
+ }
+ else {
+ strncpy(iname,inpipe,STRSIZE); /* Use supplied arg */
+ goto gotin;
+ }
+ iis_error("Unable to locate input FIFO in any of $HOME/dev/imt1i or %s",
+ "$HOME/dev/imt1i or /dev/imt1i\n");
+
+ gotin:
+
+ if (strcmp(outpipe,"")==0) { /* Get output fifo name */
+
+ if (tok!=NULL) { /* Check next bit of IMTDEV */
+ tok = strtok(NULL,":");
+ if (tok != NULL) {
+ strncpy(oname,tok,STRSIZE);
+ goto gotout;
+ }
+ }
+ /* Else look in standard places */
+
+ strncpy(oname,home,STRSIZE); strncat(oname,"/iraf/dev/imt1o",STRSIZE);
+ if (!access(oname,F_OK))
+ goto gotout;
+ strncpy(oname,home,STRSIZE); strncat(oname,"/dev/imt1o",STRSIZE);
+ if (!access(oname,F_OK))
+ goto gotout;
+ strncpy(oname,"/dev/imt1o",STRSIZE);
+ if (!access(oname,F_OK))
+ goto gotout;
+ }
+ else {
+ strncpy(oname,outpipe,STRSIZE); /* Use supplied arg */
+ goto gotout;
+ }
+
+ iis_error("Unable to locate output FIFO in any of $HOME/iraf/dev/imt1o or %s",
+ "$HOME/dev/imt1o or /dev/imt1o\n");
+
+ gotout:
+
+ /*
+ Open the output fifo. We have to open it ourselves first as a client to
+ get around the fifo open-no-client error.
+ */
+
+
+ if ((iispipe_i = open (oname, O_RDONLY | O_NONBLOCK)) != -1) {
+ if ((iispipe_o = open (oname, O_WRONLY | O_NONBLOCK)) != -1) {
+ fcntl (iispipe_o, F_SETFL, O_WRONLY);
+ } else
+ iis_error("iis_open: cannot open IIS output pipe %s\n",oname);
+ close (iispipe_i);
+ } else
+ iis_error("iis_open: cannot open IIS output pipe %s\n",oname);
+
+ /* Open the input fifo */
+
+ if ((iispipe_i = open (iname, O_RDONLY | O_NONBLOCK)) != -1) {
+
+ /* Clear input for reading. */
+ fcntl (iispipe_i, F_SETFL, O_RDONLY);
+ } else
+ iis_error("iis_open: cannot open IIS input pipe %s\n",iname);
+
+ fbconfig = fb; frameX = fbx; frameY = fby; /* Frame buffer globals */
+}
+
+/******************* iis_close ****************/
+
+/* Close the IIS connection */
+
+void iis_close() {
+ close(iispipe_o);
+ close(iispipe_i);
+}
+
+/******************* Private routines ****************/
+
+/* write to pipe */
+
+void iis_write (char* buf, int size) {
+ int n = 0;
+ int total = 0;
+
+ while (total < size) {
+ n = write (iispipe_o, buf, size - total);
+ if (n <= 0)
+ iis_error ("iis_write: can't write to pipe\n","");
+ total += n;
+ }
+}
+
+/* read from pipe */
+
+void iis_read (char* buf, int size) {
+ int n = 0;
+ int total = 0;
+
+ while (total < size) {
+ n = read (iispipe_i, buf, size - total);
+ if (n <= 0)
+ iis_error ("iis_read: can't read from pipe\n","");
+ total += n;
+ }
+}
+
+void iis_checksum ( unsigned short *hdr ) {
+ int indx;
+ int checksum = 0;
+ for (indx = 0; indx < 8; indx++) {
+ checksum += hdr[indx];
+ }
+ hdr[CHECK_SUM] = CHECKSUMVAL - (unsigned short) checksum;
+}
+
+/* Return the channel number associated with a display frame */
+
+int iis_chan(int frame) {
+ int chan[5];
+
+ chan[1]=CHAN1; chan[2]=CHAN2; chan[3]=CHAN3; chan[4]=CHAN4;
+ if (frame>0 && frame<5)
+ return chan[frame];
+ else
+ iis_error("iis_display: invalid frame number, must be 1-4\n","");
+}
+
+/* Round to nearest int symmetrically about zero */
+
+int iis_round ( float i ) {
+ if (i>=0)
+ return (int) (i+0.5);
+ else
+ return -( (int)(0.5-i) );
+}
+
+float iis_abs(float x) {
+ if (x<0)
+ return (-x);
+ else
+ return x;
+}
diff --git a/Graphics/LUT/LUT.pm b/Graphics/LUT/LUT.pm
new file mode 100644
index 0000000..ceceb3b
--- /dev/null
+++ b/Graphics/LUT/LUT.pm
@@ -0,0 +1,241 @@
+
+=head1 NAME
+
+PDL::Graphics::LUT - provides access to a number of look-up tables
+
+=head1 SYNOPSIS
+
+ use PDL::Graphics::PGPLOT;
+ use PDL::Graphics::LUT;
+
+ # what tables are available
+ my @tables = lut_names();
+
+ # get the reversed colour table 'smooth',
+ # with the gamma intensity ramp
+ my ( $l, $r, $g, $b ) = lut_data( 'smooth', 1, 'gamma' );
+
+ # use the table idl5 in ctab
+ ctab( lut_data('idl5') );
+
+=head1 DESCRIPTION
+
+PDL::Graphics::LUT contains a number of colour look-up tables
+(in rgb format) and intensity ramps, and provides routines to
+access this data.
+The format of the data is suitable for use by
+L<ctab|PDL::Graphics::PGPLOT::Window/ctab>.
+
+Unlike the initial release of the package, the data tables are
+now stored within the PDL distribution as FITS files
+(see L<$tabledir|/$tabledir> and L<$rampdir|/$rampdir>),
+rather than in the module itself.
+Changes to these directories will be picked up on the next call
+to one of the package functions.
+
+=head1 FUNCTIONS
+
+=head2 lut_names()
+
+=for ref
+
+Return, as a list, the names of the available colour tables.
+
+=for usage
+
+ @tables = lut_names();
+
+=head2 lut_ramps()
+
+=for ref
+
+Return, as a list, the names of the available intensity ramps.
+
+=for usage
+
+ @ramps = lut_ramps();
+
+=head2 lut_data()
+
+=for ref
+
+Load in the requested colour table and intensity ramp.
+
+=for usage
+
+ ( $l, $r, $g, $b ) = lut_data( $table, [ $reverse, [ $ramp ] ] );
+
+Returns the levels and r, g, b components of the colour table
+C<$table>. If C<$reverse> is 1 (defaults to B<0>
+if not supplied),
+then the r, g, and b components are reversed before being
+returned.
+If not supplied, C<$ramp> defaults to B<"ramp">
+(this is a linear intensity ramp).
+
+The returned values are piddles containing values in the range
+0 to 1 inclusive, and are floats.
+
+=head1 VARIABLES
+
+=head2 $tabledir
+
+=for ref
+
+The directory in which the colour tables (in rgb format)
+are stored.
+
+=head2 $rampdir
+
+=for ref
+
+The directory in which the intensity ramps are stored.
+
+=head2 $suffix
+
+=for ref
+
+The suffix for the data files in C<$tabledir> and
+C<$rampdir>.
+
+=head1 FURTHER INFORMATION
+
+The colour tables were taken from the STARLINK GAIA package,
+and are provided under the GNU copyleft.
+See http://star-www.rl.ac.uk/ and
+http://star-www.dur.ac.uk/~pdraper/ for more details.
+
+=head1 AUTHOR
+
+Doug Burke (djburke at cpan.org), with thanks to
+Peter Draper/STARLINK for providing the colour-table data,
+and Christian Soeller and Karl Glazebrook for their help.
+
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+package PDL::Graphics::LUT;
+
+# Just a plain function exporting package
+use Exporter;
+
+# attempt to avoid Unix-specific file/directory names
+use File::Spec;
+use File::Basename;
+
+use PDL::Core qw/:Func :Internal/; # Grab the Core names
+use PDL::Basic;
+use PDL::Types;
+use PDL::Slices;
+use PDL::IO::Misc;
+use PDL::IO::FITS;
+
+# should be careful that $suffix is a valid length on non-Unix systems
+$suffix = ".fits";
+use vars qw( $tabledir $rampdir $suffix );
+
+# should really use EXPORT_OK
+ at EXPORT = qw( lut_names lut_ramps lut_data );
+ at EXPORT_OK = qw( $tabledir $rampdir $suffix );
+ at ISA = qw( Exporter );
+
+use strict;
+
+############################################################################
+
+# can we find the data?
+BEGIN {
+ my $d = File::Spec->catdir( "PDL", "Graphics", "LUT" );
+ my $lutdir = undef;
+ foreach my $path ( @INC ) {
+ my $check = File::Spec->catdir( $path, $d );
+ if ( -d $check ) { $lutdir = $check; last; }
+ }
+ barf "Unable to find directory ${d} within the perl libraries.\n"
+ unless defined $lutdir;
+ $tabledir = File::Spec->catdir( $lutdir, "tables" );
+ $rampdir = File::Spec->catdir( $lutdir, "ramps" );
+ barf "Unable to find directory ${tabledir} within the perl libraries.\n"
+ unless -d $tabledir;
+ barf "Unable to find directory ${rampdir} within the perl libraries.\n"
+ unless -d $rampdir;
+}
+
+############################################################################
+
+# exported functions
+
+# Return the list of available tables
+#
+sub lut_names () {
+ my $glob = File::Spec->catfile( $tabledir, "*${suffix}" );
+ # note: really should protect any "."'s in $suffix, but too lazy
+ return map { basename($_,$suffix); } glob( $glob );
+}
+
+# Return the list of available ramps
+#
+sub lut_ramps () {
+ my $glob = File::Spec->catfile( $rampdir, "*${suffix}" );
+ # note: really should protect any "."'s in $suffix, but too lazy
+ return map { basename($_,$suffix); } glob( $glob );
+}
+
+# Return the requested colour table
+#
+sub lut_data ($;$$) {
+ my $table = shift;
+ my $reverse = $#_ != -1 ? shift : 0;
+ my $ramp = $#_ != -1 ? shift : "ramp";
+
+ my $lfile = File::Spec->catfile( $tabledir, "${table}${suffix}" );
+ my $rfile = File::Spec->catfile( $rampdir, "${ramp}${suffix}" );
+ print "Reading colour table and intensity ramp from:\n $lfile\n $rfile\n"
+ if $PDL::verbose;
+
+ # unknown table?
+ unless ( -e $lfile ) {
+ my @names = lut_names();
+ barf <<"EOD";
+Unknown colour table $table
+Available tables:
+ @names
+EOD
+ }
+
+ # unknown ramp?
+ unless ( -e $rfile ) {
+ my @names = lut_ramps();
+ barf <<"EOD";
+Unknown intensity ramp $ramp
+Available ramps:
+ @names
+EOD
+ }
+
+ # read in rgb data
+ my $rgb = rfits $lfile;
+ $rgb = float($rgb) if $rgb->get_datatype != $PDL_F;
+ my ( @ldims ) = $rgb->dims;
+ barf "LUT file $lfile is not the correct format (ie n by 3)\n"
+ unless $#ldims == 1 and $ldims[1] == 3;
+
+ # read in intensity data
+ my $l = rfits $rfile;
+ $l = float($l) if $l->get_datatype != $PDL_F;
+ barf "Ramp file $rfile does not match the colour table size.\n"
+ unless $l->nelem == $ldims[0];
+
+ my $s = $reverse ? "-1:0" : "";
+ return ( $l, $rgb->slice("${s},(0)"), $rgb->slice("${s},(1)"), $rgb->slice("${s},(2)") );
+
+} # sub: lut_data()
+
+# Exit with OK status
+1;
+
diff --git a/Graphics/LUT/Makefile.PL b/Graphics/LUT/Makefile.PL
new file mode 100644
index 0000000..b995837
--- /dev/null
+++ b/Graphics/LUT/Makefile.PL
@@ -0,0 +1,10 @@
+#
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'PDL::Graphics::LUT',
+ 'VERSION_FROM' => '../../Basic/Core/Version.pm',
+ 'DIR' => [ 'tables', 'ramps' ],
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
diff --git a/Graphics/LUT/README b/Graphics/LUT/README
new file mode 100644
index 0000000..a8303e7
--- /dev/null
+++ b/Graphics/LUT/README
@@ -0,0 +1,5 @@
+
+The colour tables were taken from STARLINK's GAIA distribution, where they
+have the GNU copyleft. Further information on STARLINK and GAIA can be found
+via http://star-www.rl.ac.uk/ and http://star-www.dur.ac.uk/~pdraper/.
+
diff --git a/Graphics/LUT/ramps/Makefile.PL b/Graphics/LUT/ramps/Makefile.PL
new file mode 100644
index 0000000..be893a7
--- /dev/null
+++ b/Graphics/LUT/ramps/Makefile.PL
@@ -0,0 +1,21 @@
+#
+# files ending in .fits will end up in
+# PDL/Graphics/LUT/ramps/
+#
+# WARNING: this all looks rather UNIX specific
+# (unless MakeMaker is clever enough to convert
+# UNIX file names to the system it's running on)
+#
+use ExtUtils::MakeMaker;
+
+my @tables = glob( "*.fits" );
+
+WriteMakefile(
+ 'NAME' => 'PDL::Graphics::LUT::ramps::DATA',
+ 'VERSION_FROM' => '../../../Basic/Core/Version.pm',
+ 'PM' => {
+ (map {($_,'$(INST_LIBDIR)/'.$_)} @tables)
+ },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
diff --git a/Graphics/LUT/ramps/equa.fits b/Graphics/LUT/ramps/equa.fits
new file mode 100644
index 0000000..b7f82ad
Binary files /dev/null and b/Graphics/LUT/ramps/equa.fits differ
diff --git a/Graphics/LUT/ramps/expo.fits b/Graphics/LUT/ramps/expo.fits
new file mode 100644
index 0000000..3349adc
Binary files /dev/null and b/Graphics/LUT/ramps/expo.fits differ
diff --git a/Graphics/LUT/ramps/gamma.fits b/Graphics/LUT/ramps/gamma.fits
new file mode 100644
index 0000000..381873c
Binary files /dev/null and b/Graphics/LUT/ramps/gamma.fits differ
diff --git a/Graphics/LUT/ramps/jigsaw.fits b/Graphics/LUT/ramps/jigsaw.fits
new file mode 100644
index 0000000..b4d67c3
Binary files /dev/null and b/Graphics/LUT/ramps/jigsaw.fits differ
diff --git a/Graphics/LUT/ramps/lasritt.fits b/Graphics/LUT/ramps/lasritt.fits
new file mode 100644
index 0000000..ba600be
Binary files /dev/null and b/Graphics/LUT/ramps/lasritt.fits differ
diff --git a/Graphics/LUT/ramps/log.fits b/Graphics/LUT/ramps/log.fits
new file mode 100644
index 0000000..62ffe95
Binary files /dev/null and b/Graphics/LUT/ramps/log.fits differ
diff --git a/Graphics/LUT/ramps/neg.fits b/Graphics/LUT/ramps/neg.fits
new file mode 100644
index 0000000..7dbb3d4
Binary files /dev/null and b/Graphics/LUT/ramps/neg.fits differ
diff --git a/Graphics/LUT/ramps/neglog.fits b/Graphics/LUT/ramps/neglog.fits
new file mode 100644
index 0000000..49c6d55
Binary files /dev/null and b/Graphics/LUT/ramps/neglog.fits differ
diff --git a/Graphics/LUT/ramps/null.fits b/Graphics/LUT/ramps/null.fits
new file mode 100644
index 0000000..9213a19
Binary files /dev/null and b/Graphics/LUT/ramps/null.fits differ
diff --git a/Graphics/LUT/ramps/ramp.fits b/Graphics/LUT/ramps/ramp.fits
new file mode 100644
index 0000000..30db904
Binary files /dev/null and b/Graphics/LUT/ramps/ramp.fits differ
diff --git a/Graphics/LUT/ramps/stairs.fits b/Graphics/LUT/ramps/stairs.fits
new file mode 100644
index 0000000..6f66aa7
Binary files /dev/null and b/Graphics/LUT/ramps/stairs.fits differ
diff --git a/Graphics/LUT/tables/Makefile.PL b/Graphics/LUT/tables/Makefile.PL
new file mode 100644
index 0000000..5d81293
--- /dev/null
+++ b/Graphics/LUT/tables/Makefile.PL
@@ -0,0 +1,21 @@
+#
+# files ending in .fits will end up in
+# PDL/Graphics/LUT/tables/
+#
+# WARNING: this all looks rather UNIX specific
+# (unless MakeMaker is clever enough to convert
+# UNIX file names to the system it's running on)
+#
+use ExtUtils::MakeMaker;
+
+my @tables = glob( "*.fits" );
+
+WriteMakefile(
+ 'NAME' => 'PDL::Graphics::LUT::tables::DATA',
+ 'VERSION_FROM' => '../../../Basic/Core/Version.pm',
+ 'PM' => {
+ (map {($_,'$(INST_LIBDIR)/'.$_)} @tables)
+ },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
diff --git a/Graphics/LUT/tables/aips0.fits b/Graphics/LUT/tables/aips0.fits
new file mode 100644
index 0000000..4884866
Binary files /dev/null and b/Graphics/LUT/tables/aips0.fits differ
diff --git a/Graphics/LUT/tables/backgr.fits b/Graphics/LUT/tables/backgr.fits
new file mode 100644
index 0000000..74b9092
Binary files /dev/null and b/Graphics/LUT/tables/backgr.fits differ
diff --git a/Graphics/LUT/tables/bgyrw.fits b/Graphics/LUT/tables/bgyrw.fits
new file mode 100644
index 0000000..3f9c1d6
Binary files /dev/null and b/Graphics/LUT/tables/bgyrw.fits differ
diff --git a/Graphics/LUT/tables/blue.fits b/Graphics/LUT/tables/blue.fits
new file mode 100644
index 0000000..9615e9e
Binary files /dev/null and b/Graphics/LUT/tables/blue.fits differ
diff --git a/Graphics/LUT/tables/blulut.fits b/Graphics/LUT/tables/blulut.fits
new file mode 100644
index 0000000..ff43587
Binary files /dev/null and b/Graphics/LUT/tables/blulut.fits differ
diff --git a/Graphics/LUT/tables/color.fits b/Graphics/LUT/tables/color.fits
new file mode 100644
index 0000000..3c3bd80
Binary files /dev/null and b/Graphics/LUT/tables/color.fits differ
diff --git a/Graphics/LUT/tables/green.fits b/Graphics/LUT/tables/green.fits
new file mode 100644
index 0000000..2405171
Binary files /dev/null and b/Graphics/LUT/tables/green.fits differ
diff --git a/Graphics/LUT/tables/heat.fits b/Graphics/LUT/tables/heat.fits
new file mode 100644
index 0000000..a14196e
Binary files /dev/null and b/Graphics/LUT/tables/heat.fits differ
diff --git a/Graphics/LUT/tables/idl11.fits b/Graphics/LUT/tables/idl11.fits
new file mode 100644
index 0000000..5063553
Binary files /dev/null and b/Graphics/LUT/tables/idl11.fits differ
diff --git a/Graphics/LUT/tables/idl12.fits b/Graphics/LUT/tables/idl12.fits
new file mode 100644
index 0000000..9dd4c4f
Binary files /dev/null and b/Graphics/LUT/tables/idl12.fits differ
diff --git a/Graphics/LUT/tables/idl14.fits b/Graphics/LUT/tables/idl14.fits
new file mode 100644
index 0000000..c05edea
Binary files /dev/null and b/Graphics/LUT/tables/idl14.fits differ
diff --git a/Graphics/LUT/tables/idl15.fits b/Graphics/LUT/tables/idl15.fits
new file mode 100644
index 0000000..1737918
Binary files /dev/null and b/Graphics/LUT/tables/idl15.fits differ
diff --git a/Graphics/LUT/tables/idl2.fits b/Graphics/LUT/tables/idl2.fits
new file mode 100644
index 0000000..62a223a
Binary files /dev/null and b/Graphics/LUT/tables/idl2.fits differ
diff --git a/Graphics/LUT/tables/idl4.fits b/Graphics/LUT/tables/idl4.fits
new file mode 100644
index 0000000..2e42ea4
Binary files /dev/null and b/Graphics/LUT/tables/idl4.fits differ
diff --git a/Graphics/LUT/tables/idl5.fits b/Graphics/LUT/tables/idl5.fits
new file mode 100644
index 0000000..0affa79
Binary files /dev/null and b/Graphics/LUT/tables/idl5.fits differ
diff --git a/Graphics/LUT/tables/idl6.fits b/Graphics/LUT/tables/idl6.fits
new file mode 100644
index 0000000..da9edfc
Binary files /dev/null and b/Graphics/LUT/tables/idl6.fits differ
diff --git a/Graphics/LUT/tables/isophot.fits b/Graphics/LUT/tables/isophot.fits
new file mode 100644
index 0000000..37d4a49
Binary files /dev/null and b/Graphics/LUT/tables/isophot.fits differ
diff --git a/Graphics/LUT/tables/light.fits b/Graphics/LUT/tables/light.fits
new file mode 100644
index 0000000..94701d9
Binary files /dev/null and b/Graphics/LUT/tables/light.fits differ
diff --git a/Graphics/LUT/tables/manycol.fits b/Graphics/LUT/tables/manycol.fits
new file mode 100644
index 0000000..15246ac
Binary files /dev/null and b/Graphics/LUT/tables/manycol.fits differ
diff --git a/Graphics/LUT/tables/pastel.fits b/Graphics/LUT/tables/pastel.fits
new file mode 100644
index 0000000..7f9c0a9
Binary files /dev/null and b/Graphics/LUT/tables/pastel.fits differ
diff --git a/Graphics/LUT/tables/rainbow.fits b/Graphics/LUT/tables/rainbow.fits
new file mode 100644
index 0000000..9d5f0b6
Binary files /dev/null and b/Graphics/LUT/tables/rainbow.fits differ
diff --git a/Graphics/LUT/tables/rainbow1.fits b/Graphics/LUT/tables/rainbow1.fits
new file mode 100644
index 0000000..9b284a6
Binary files /dev/null and b/Graphics/LUT/tables/rainbow1.fits differ
diff --git a/Graphics/LUT/tables/rainbow2.fits b/Graphics/LUT/tables/rainbow2.fits
new file mode 100644
index 0000000..144f347
Binary files /dev/null and b/Graphics/LUT/tables/rainbow2.fits differ
diff --git a/Graphics/LUT/tables/rainbow3.fits b/Graphics/LUT/tables/rainbow3.fits
new file mode 100644
index 0000000..ea48f1b
Binary files /dev/null and b/Graphics/LUT/tables/rainbow3.fits differ
diff --git a/Graphics/LUT/tables/rainbow4.fits b/Graphics/LUT/tables/rainbow4.fits
new file mode 100644
index 0000000..7f39f23
Binary files /dev/null and b/Graphics/LUT/tables/rainbow4.fits differ
diff --git a/Graphics/LUT/tables/ramp.fits b/Graphics/LUT/tables/ramp.fits
new file mode 100644
index 0000000..8156457
Binary files /dev/null and b/Graphics/LUT/tables/ramp.fits differ
diff --git a/Graphics/LUT/tables/random.fits b/Graphics/LUT/tables/random.fits
new file mode 100644
index 0000000..87a0d32
Binary files /dev/null and b/Graphics/LUT/tables/random.fits differ
diff --git a/Graphics/LUT/tables/random1.fits b/Graphics/LUT/tables/random1.fits
new file mode 100644
index 0000000..765b61f
Binary files /dev/null and b/Graphics/LUT/tables/random1.fits differ
diff --git a/Graphics/LUT/tables/random2.fits b/Graphics/LUT/tables/random2.fits
new file mode 100644
index 0000000..5843b66
Binary files /dev/null and b/Graphics/LUT/tables/random2.fits differ
diff --git a/Graphics/LUT/tables/random3.fits b/Graphics/LUT/tables/random3.fits
new file mode 100644
index 0000000..ffdae4e
Binary files /dev/null and b/Graphics/LUT/tables/random3.fits differ
diff --git a/Graphics/LUT/tables/random4.fits b/Graphics/LUT/tables/random4.fits
new file mode 100644
index 0000000..47effdd
Binary files /dev/null and b/Graphics/LUT/tables/random4.fits differ
diff --git a/Graphics/LUT/tables/random5.fits b/Graphics/LUT/tables/random5.fits
new file mode 100644
index 0000000..8e50fb2
Binary files /dev/null and b/Graphics/LUT/tables/random5.fits differ
diff --git a/Graphics/LUT/tables/random6.fits b/Graphics/LUT/tables/random6.fits
new file mode 100644
index 0000000..0a3dc08
Binary files /dev/null and b/Graphics/LUT/tables/random6.fits differ
diff --git a/Graphics/LUT/tables/real.fits b/Graphics/LUT/tables/real.fits
new file mode 100644
index 0000000..5237521
Binary files /dev/null and b/Graphics/LUT/tables/real.fits differ
diff --git a/Graphics/LUT/tables/red.fits b/Graphics/LUT/tables/red.fits
new file mode 100644
index 0000000..1eb194b
Binary files /dev/null and b/Graphics/LUT/tables/red.fits differ
diff --git a/Graphics/LUT/tables/smooth.fits b/Graphics/LUT/tables/smooth.fits
new file mode 100644
index 0000000..1aaf6cd
Binary files /dev/null and b/Graphics/LUT/tables/smooth.fits differ
diff --git a/Graphics/LUT/tables/smooth1.fits b/Graphics/LUT/tables/smooth1.fits
new file mode 100644
index 0000000..dcbc416
Binary files /dev/null and b/Graphics/LUT/tables/smooth1.fits differ
diff --git a/Graphics/LUT/tables/smooth2.fits b/Graphics/LUT/tables/smooth2.fits
new file mode 100644
index 0000000..5d38af0
Binary files /dev/null and b/Graphics/LUT/tables/smooth2.fits differ
diff --git a/Graphics/LUT/tables/smooth3.fits b/Graphics/LUT/tables/smooth3.fits
new file mode 100644
index 0000000..9f19261
Binary files /dev/null and b/Graphics/LUT/tables/smooth3.fits differ
diff --git a/Graphics/LUT/tables/staircase.fits b/Graphics/LUT/tables/staircase.fits
new file mode 100644
index 0000000..c3fc5bb
Binary files /dev/null and b/Graphics/LUT/tables/staircase.fits differ
diff --git a/Graphics/LUT/tables/stairs8.fits b/Graphics/LUT/tables/stairs8.fits
new file mode 100644
index 0000000..e588cf0
Binary files /dev/null and b/Graphics/LUT/tables/stairs8.fits differ
diff --git a/Graphics/LUT/tables/stairs9.fits b/Graphics/LUT/tables/stairs9.fits
new file mode 100644
index 0000000..6f2ab15
Binary files /dev/null and b/Graphics/LUT/tables/stairs9.fits differ
diff --git a/Graphics/LUT/tables/standard.fits b/Graphics/LUT/tables/standard.fits
new file mode 100644
index 0000000..a364606
Binary files /dev/null and b/Graphics/LUT/tables/standard.fits differ
diff --git a/Graphics/Limits/Limits.pm b/Graphics/Limits/Limits.pm
new file mode 100644
index 0000000..a77f705
--- /dev/null
+++ b/Graphics/Limits/Limits.pm
@@ -0,0 +1,1464 @@
+package PDL::Graphics::Limits;
+
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+our %EXPORT_TAGS = ( 'all' => [ qw(
+ limits
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+ limits
+);
+
+our $VERSION = '0.01';
+$VERSION = eval $VERSION;
+
+
+# Preloaded methods go here.
+
+use PDL::Core qw( cat pdl );
+use PDL::Primitive qw( append );
+use PDL::Fit::Polynomial;
+use PDL::Options;
+use PDL::Bad;
+use Carp;
+use POSIX qw( log10 );
+
+use strict;
+use warnings;
+
+################################################################################
+# figure out what's good in a piddle after a possible transformation which could
+# generate Infs or NaN's. If only everyone used PDL::Bad::UseNaN...
+sub set_mask
+{
+ my ( $mask, $data ) = @_;
+
+ if ( $PDL::Bad::Status )
+ {
+ my $badflag = $data->badflag();
+ $data->badflag(1);
+
+ $mask .= $PDL::Bad::UseNaN ? (! $data->isbad ) : ( $data->isfinite & ! $data->isbad );
+
+ $data->badflag($badflag);
+ } else
+ {
+ $mask .= $data->isfinite;
+ }
+}
+
+
+
+{
+ package PDL::Graphics::Limits::DSet;
+
+ use PDL::Core qw( cat pdl );
+
+ *set_mask = \*PDL::Graphics::Limits::set_mask;
+
+ sub new
+ {
+ my $class = shift;
+ my $self = bless {}, $class;
+
+ my ( $min, $max ) = splice( @_, 0, 2 );
+
+ $self->{Vectors} = [ @_ ];
+ $self->{MinMax} = [ map{ [ $min, $max ] } 1..@{$self->{Vectors}} ];
+
+ $self;
+ }
+
+ sub ndim { scalar @{$_[0]->{Vectors}} }
+
+ sub validate
+ {
+ my ( $self, $attr) = @_;
+
+ my $ivec = 0;
+ my $n;
+ foreach my $vec ( @{$self->{Vectors}} )
+ {
+ die( 'vector ', $ivec+1, ": no data?\n" )
+ unless defined $vec->{data};
+
+ $n = $vec->{data}->nelem unless defined $n;
+
+ # if a data set vector has no transformation function, use the
+ # default in $attr{Trans}
+ $vec->{trans} = $attr->{Trans}[$ivec]
+ if ! exists $vec->{trans} && exists $attr->{Trans}[$ivec];
+
+ # remove explicitly undefined trans
+ delete $vec->{trans}
+ if exists $vec->{trans} && ! defined $vec->{trans};
+
+ # ensure that data and errors have the same length.
+ die( 'vector ', $ivec+1, ": attribute $_: ",
+ "inconsistent number of elements",
+ "expected $n, got ", $vec->{$_}->nelem, "\n" )
+ foreach
+ grep { exists $vec->{$_} &&
+ defined $vec->{$_} &&
+ $vec->{$_}->nelem != $n }
+ qw( data en ep );
+ }
+ continue
+ {
+ $ivec++;
+ }
+
+ }
+
+ sub vector
+ {
+ $_[0]->{Vectors}[$_[1]];
+ }
+
+ sub set_minmax
+ {
+ my ( $dset, $min, $max, $axis ) = @_;
+
+ my $mm = $dset->{MinMax}[$axis];
+
+ $mm->[0] = $min if defined $min;
+ $mm->[1] = $max if defined $max;
+ }
+
+ sub upd_minmax
+ {
+ my ( $dset, $min, $max, $axis ) = @_;
+
+ my $mm = $dset->{MinMax}[$axis];
+
+ $mm->[0] = $min if $mm->[0] > $min;
+ $mm->[1] = $max if $mm->[1] < $max;
+ }
+
+ sub get_minmax
+ {
+ my ( $dset ) = @_;
+ cat( map { pdl( $dset->{MinMax}[$_] ) } 0..$dset->ndim-1 );
+ }
+
+ sub calc_minmax
+ {
+ my $dset = shift;
+
+ my @axes = @_ ? ( $_[0] ) : ( 0 ..$dset->ndims-1 );
+
+ $dset->calc_minmax_axis( $_ ) foreach @axes;
+ }
+
+ #####################################################################
+ # determine the limits for a dataset.
+ sub calc_minmax_axis
+ {
+ my ( $dset, $axis ) = @_;
+
+ my $vec = $dset->{Vectors}[$axis];
+ my $data = $vec->{data};
+
+ my $xfrm = defined $vec->{trans};
+
+ # we need the transformed data point min max in case
+ # a transformed data + error is out of range of the transform
+ # function (e.g. log(0)).
+
+ my @minmax;
+
+ # reuse these as much as possible to reduce memory hit
+ my $tmp;
+ my $mask = PDL::null;
+
+ # i know of no way of determining whether a function can be applied inplace.
+ # assume not.
+
+ # if xfrm is true, $tmp will be an independent piddle, else its an alias for data
+ # no need to create a new piddle unless necessary.
+ $tmp = $xfrm ? $vec->{trans}->($data) : $data;
+ set_mask( $mask, $tmp );
+ push @minmax, $tmp->where($mask)->minmax;
+
+ if ( defined $vec->{errn} )
+ {
+ # worry about not overwriting the original data!
+ if ( $xfrm ) { $tmp .= $vec->{trans}->($data - $vec->{errn}) }
+ else { $tmp = $data - $vec->{errn} }
+ set_mask( $mask, $tmp );
+ push @minmax, $tmp->where($mask)->minmax;
+ }
+
+ if ( defined $vec->{errp} )
+ {
+ # worry about not overwriting the original data!
+ if ( $xfrm ) { $tmp .= $vec->{trans}->($data + $vec->{errp}) }
+ else { $tmp = $data + $vec->{errp} }
+ set_mask( $mask, $tmp );
+ push @minmax, $tmp->where($mask)->minmax;
+ }
+
+ my ( $min, $max ) = PDL::Core::pdl( @minmax )->minmax;
+
+ $dset->set_minmax( $min, $max, $axis );
+ }
+
+}
+
+#####################################################################
+
+# based upon PGPLOT's pgrnge routine.
+sub range_frac
+{
+ my ( $axis, $frac, $zerofix ) = @_;
+
+ my $expand = $frac * ( $axis->[1] - $axis->[0] );
+ my $min = $axis->[0] - $expand;
+ my $max = $axis->[1] + $expand;
+
+ if ( $zerofix )
+ {
+ $min = 0.0
+ if $min < 0 && $axis->[0] >= 0.0;
+
+ $max = 0.0
+ if $max > 0 && $axis->[1] <= 0.0;
+ }
+
+ @{$axis} = ( $min, $max );
+}
+
+#####################################################################
+
+# based upon PGPLOT's pgrnd routine
+
+# routine to find the closest "round" number to X, a "round" number
+# being 1, 2 or 5 times a power of 10.
+
+# If X is negative, round_pow(X) = -round_pow(abs(X)).
+# If X is zero, the value returned is zero.
+
+# round_pow( direction, $x )
+# where direction is up, down, or both i.e.
+# $ub = round ( up => $x );
+# $lb = round ( down => $x );
+
+our @nice = ( 1, 2, 5, 10 );
+our %flip = ( 'up' => 'down', 'down' => 'up' );
+sub round_pow
+{
+ my ( $what, $x ) = @_;
+
+ croak( "incorrect number of arguments" )
+ unless 2 == @_;
+
+ if ( $x != 0.0 )
+ {
+ my $xx = abs($x);
+ my $xlog = log10($xx);
+ my $ilog = int($xlog);
+
+ $what = $flip{$what} if $x < 0 ;
+
+ $ilog--
+ if ( $xlog <= 0 && ( 'down' eq $what || $xlog != $ilog ) )
+ ||
+ ( $xlog > 0 && 'down' eq $what && $xlog == $ilog ) ;
+
+ my $pwr = 10 ** $ilog;
+ my $frac = $xx / $pwr;
+
+ my $i;
+ if ( 'up' eq $what )
+ {
+ $i = 3;
+ $i = 2 if $frac < $nice[2];
+ $i = 1 if $frac < $nice[1];
+ $i = 0 if $frac < $nice[0];
+ my $t = ( $x < 0 ? -1 : 1 ) * $pwr * $nice[$i];
+ if(abs($t - $x) < 0.0000001) {$i++}
+ }
+
+ elsif ( 'down' eq $what )
+ {
+ $i = 0;
+ $i = 1 if $frac > $nice[1];
+ $i = 2 if $frac > $nice[2];
+ $i = 3 if $frac > $nice[3];
+ }
+
+ $x = ( $x < 0 ? -1 : 1 ) * $pwr * $nice[$i];
+ }
+
+ $x;
+}
+
+#####################################################################
+
+sub setup_multi
+{
+ my ( $common, $dim, $keys ) = @_;
+
+ my @arr;
+
+ if ( 'ARRAY' eq ref $common )
+ {
+ return $common;
+ }
+
+ elsif ( 'HASH' eq ref $common )
+ {
+ @arr[ 0..($dim-1)] = map { $common->{$_->{data}} } @{$keys};
+ }
+
+ else
+ {
+ my $value = $common;
+ @arr = ($value) x $dim;
+ }
+
+ \@arr;
+}
+
+#####################################################################
+# normalize_dsets
+#
+# transform the user's heterogeneous list of data sets into a regular
+# list of data sets, each with the form
+# { Vectors => \@vectors }
+# where each vector is a hashref with the following keys:
+# { data => $data,
+# en => $err_n,
+# ep => $err_p,
+# trans => $trans }
+
+sub normalize_dsets
+{
+ my ( $attr, @udsets ) = @_;
+ my @dsets;
+
+ while ( @udsets )
+ {
+ my $ds = shift @udsets;
+ my $ref = ref $ds;
+
+ # peek inside the array to see what's there. we can have the following
+ # [ scalar|piddle, scalar|piddle, ... ] -> a zero dimensional data set
+ # [ \@a, \@b, \@c, \%d, ... ] -> a bunch of data sets
+ # [ \%h, @keys ] -> a hash with its keys
+
+ # scalar or piddle, turn it into its own data set
+ if ( ! $ref || UNIVERSAL::isa($ds, 'PDL') )
+ {
+ push @dsets,
+ PDL::Graphics::Limits::DSet->new( $attr->{Min}, $attr->{Max},
+ { data => PDL::Core::topdl( $ds ) } );
+ }
+
+ elsif ( 'ARRAY' eq $ref )
+ {
+ normalize_array( \@dsets, $attr, $ds );
+ }
+
+ else
+ {
+ die( "data set: ", scalar @dsets + 1,
+ "illegal type in data set list: not an arrayref, scalar, or piddle\n" );
+ }
+
+ }
+
+ # ensure data sets have the same dimensions
+ my %dim;
+ $dim{$_->ndim}++ foreach @dsets;
+
+ # whoops. only one allowed
+ die( "data sets do not all have the same dimensionality\n" )
+ if keys %dim > 1;
+
+ ( $attr->{dims} ) = keys %dim;
+
+ # clean up datasets.
+ my $idset = -1;
+ foreach my $dset ( @dsets )
+ {
+ $idset++;
+
+ eval { $dset->validate( $attr ) };
+ if ( $@ )
+ {
+ chomp $@;
+ die( "data set $idset: $@\n" );
+ }
+ }
+
+ @dsets;
+}
+
+#####################################################################
+
+# array refs in data set lists may be just a plain ol' data set, or
+# it may contain a bunch of other stuff. here we deal with a single
+# array ref. we tear it apart and (re)build data sets.
+sub normalize_array
+{
+ my ( $dsets, $attr, $aref ) = @_;
+
+ # if the first element is a hash, it's either a hash based data set
+ # with a bunch of attributes specific to that hash:
+ # [ \%h, @keys ] -> a hash with its keys
+ # in which case the rest of the elements are scalars, or its
+ # all hashes.
+
+ eval
+ {
+ if ( 'HASH' eq ref $aref->[0] )
+ {
+
+ # all hashes?
+ if ( @$aref == grep { 'HASH' eq ref $_ } @$aref )
+ {
+ # can't do anything unless we've been told which hash keys
+ # we should use, as this format doesn't allow local specification
+ die( "must specify hash keys for hash based data set spec\n" )
+ unless defined $attr->{KeySpec} && scalar @{$attr->{KeySpec}};
+
+ foreach ( @{$aref} )
+ {
+ push @$dsets, normalize_hash_dset($attr, $_, @{$attr->{Keys}} );
+ }
+ }
+
+ # hash + scalars?
+ elsif ( @$aref > 1 && 1 == grep { ref $_ } @$aref )
+ {
+ push @$dsets, normalize_hash_dset( $attr, @{$aref} )
+ }
+
+ # something wrong
+ else
+ {
+ die( "hash based data specification has an unexpected element" );
+ }
+
+ }
+
+ # must be a list of vectors as either scalars, piddles, or array
+ # refs (vectors with attributes)
+ else
+ {
+ # for array based data sets, we have to accumulate vectors as we iterate
+ # through the array. they are stored here
+ my @vecs;
+
+ for my $vec ( @$aref )
+ {
+ my $ref = ref $vec;
+
+ eval
+ {
+ # naked scalar or piddle: data vector with no attributes
+ if ( ! $ref || UNIVERSAL::isa($vec, 'PDL') )
+ {
+ push @vecs, { data => PDL::Core::topdl( $vec ) };
+ }
+
+ # array: data vector with attributes
+ elsif ( 'ARRAY' eq $ref )
+ {
+ push @vecs, normalize_array_vec( $vec );
+ }
+
+ else
+ {
+ die( 'vector ', @vecs+1, ": unexpected data type ($ref) in list of data sets\n" );
+ }
+ };
+
+ if ( $@ )
+ {
+ chomp $@;
+ die( 'vector ', @vecs+1, ": $@\n" );
+ }
+ }
+
+ push @$dsets,
+ PDL::Graphics::Limits::DSet->new( $attr->{Min}, $attr->{Max}, @vecs )
+ if @vecs;
+ }
+ };
+
+ if ( $@ )
+ {
+ chomp $@;
+ die( 'data set ', @$dsets+1, ": $@\n" );
+ }
+}
+
+#####################################################################
+
+# parse an array based vector
+sub normalize_array_vec
+{
+ my ( $vec ) = @_;
+
+ # we should have
+ # [ $data, [ $err | $err_n, $err_p ], [ \&func ] ]
+
+ my @el = @$vec;
+
+ die( "too few or too many entries in array based data set spec\n" )
+ if @el < 1 || @el > 4;
+
+ my %vec;
+ $vec{data} = PDL::Core::topdl( shift @el);
+
+ # if last value is CODE, it's a trans
+ $vec{trans} = pop @el if 'CODE' eq ref $el[-1];
+
+ if ( exists $el[2] )
+ {
+ # if we have 3 elements and the last isn't undef, it's an error.
+ # it can't be CODE as we'd have stripped it off in the last statement
+ die( "illegal value for trans func: $el[2]\n" )
+ if defined $el[2];
+
+ # we need to turn off trans for this element
+ $vec{trans} = undef;
+ pop @el;
+ }
+
+ # two values? asymmetric errors
+ if ( @el == 2 )
+ {
+ $vec{errn} = PDL::Core::topdl($el[0]) if defined $el[0];
+ $vec{errp} = PDL::Core::topdl($el[1]) if defined $el[1];
+ }
+
+ # one value? symmetric errors
+ elsif ( @el == 1 )
+ {
+ $vec{errn} = PDL::Core::topdl($el[0]) if defined $el[0];
+ $vec{errp} = $vec{errn} if defined $vec{errn};
+ }
+
+ \%vec;
+}
+
+#####################################################################
+
+# this takes a hash and a hash key spec and generates a regularized
+# data set array of the form
+# [ { data => $data, ep => ..., en => ..., trans => }, ... ]
+sub normalize_hash_dset
+{
+ my ( $attr, $ds, @keys ) = @_;
+
+ my $KeySpec = $attr->{KeySpec};
+
+ my @dset;
+
+ die( "too many local VecKeys (", scalar @keys,
+ ") and global VecKeys (", scalar @{$KeySpec}, ")\n" )
+ if @keys && @{$KeySpec} && @{$KeySpec} <= @keys;
+
+ my @spec;
+
+ # handle local keys
+ if ( @keys )
+ {
+ my $nvec = 0;
+ for my $key ( @keys )
+ {
+ my %spec;
+
+
+ # parse the specs for this vector
+ eval { %spec = parse_vecspec( $key ) };
+ do { chomp $@; die( "vector $nvec: $@" ) }
+ if $@;
+
+
+ # now, merge it with the global KeySpecs
+
+ if ( @{$KeySpec} )
+ {
+ my $Spec = $KeySpec->[$nvec];
+
+ foreach ( keys %{$Spec} )
+ {
+ # only copy from Spec if not present in spec
+ $spec{$_} = $Spec->{$_} if ! exists $spec{$_};
+ }
+ }
+
+ push @spec, \%spec;
+ }
+ continue
+ {
+ $nvec++;
+ }
+
+ # handle case where local VecKeys are a subst of global VecKeys
+ while ( @{$KeySpec} > @spec )
+ {
+ push @spec, $KeySpec->[$nvec++];
+ }
+ }
+
+ # no local keys; use global KeySpec
+ else
+ {
+ @spec = @{$KeySpec};
+ }
+
+ my $nvec = 0;
+ for my $spec ( @spec )
+ {
+ $nvec++;
+ my %vec;
+
+ die( "vector $nvec: no data spec?\n" )
+ unless exists $spec->{data};
+
+ for my $el ( qw( data errn errp trans ) )
+ {
+ if ( exists $spec->{$el} )
+ {
+
+ # if not defined, don't bother looking for it in the data set
+ unless ( defined $spec->{$el} )
+ {
+ # trans is different from the others in that we need to pass
+ # it as undef if $spec->{trans} is undef (as full handling of
+ # trans is done elsewhere.
+ $vec{trans} = undef if 'trans' eq $el;
+ }
+
+ elsif ( exists $ds->{$spec->{$el}} )
+ {
+ $vec{$el} = $ds->{$spec->{$el}};
+ }
+
+ elsif ( $attr->{KeyCroak} )
+ {
+ die( "vector $nvec: missing key in data set hash: ", $spec->{$el}, "\n" )
+ }
+ }
+
+ }
+
+ # missing data; certainly a fatal error.
+ die( "vector $nvec: no data for key $spec->{data}\n" )
+ unless defined $vec{data};
+
+ push @dset, \%vec;
+ }
+
+ PDL::Graphics::Limits::DSet->new( $attr->{Min}, $attr->{Max}, @dset );
+}
+
+#####################################################################
+# parse specifications for a hash based data set. These are the elements
+# in the VecKeys attribute. See the docs for more details.
+# Returns a hashref with keys data, en, ep, trans
+
+my $colre = qr/[^&<>=]/;
+
+# these are the different specs available.
+my %keyre = ( data => qr/^($colre+)/,
+ errn => qr/<($colre*)/,
+ errp => qr/>($colre*)/,
+ err => qr/=($colre*)/,
+ trans => qr/\&($colre*)/
+ );
+
+my %vecspeckeys = ( data => 1,
+ err => 1,
+ errn => 1,
+ errp => 1,
+ trans => 1 );
+
+sub parse_vecspec
+{
+ my ( $ukeys ) = @_;
+
+ my %k;
+
+ # do we get a hash?
+ if ( 'HASH' eq ref $ukeys )
+ {
+ # complain about keys we don't use
+ my @badkeys = grep { ! defined $vecspeckeys{$_} } keys %$ukeys;
+ die( "illegal keys: ", join(' ,', @badkeys), "\n" )
+ if @badkeys;
+
+ # copy keys we need
+ do { $k{$_} = $ukeys->{$_} if exists $ukeys->{$_} }
+ foreach keys %vecspeckeys;
+
+ }
+
+ # parse the string.
+ else
+ {
+
+ # make a local copy, as we modify it in place.
+ my $keys = $ukeys;
+
+ # deal with a "default" spec
+ if ( ! defined $keys )
+ {
+ $keys = '';
+ }
+ else
+ {
+ # spaces and commas are there for human use only
+ $keys =~ s/[\s,]//g;
+ }
+
+
+ # extract the known specs.
+ my ( $what, $re );
+ $keys =~ s/$re// and $k{$what} = $1 while( ($what, $re) = each %keyre);
+
+ # if there's anything left, it's bogus
+ die( "illegal key specification: $ukeys\n" )
+ unless $keys eq '';
+
+ }
+
+ # check for consistent error bar specs
+ die( "can't specify `=' with `<' or `>'\n" )
+ if exists $k{err} && ( exists $k{errn} || exists $k{errp} );
+
+ # error bars are always specified as positive and negative; turn a symmetric
+ # spec into that
+ $k{errn} = $k{errp} = $k{err} if exists $k{err};
+ delete $k{err};
+
+ # set empty values to undefined ones
+ do { $k{$_} = undef if $k{$_} eq '' } foreach keys %k;
+
+ %k;
+}
+
+sub parse_vecspecs
+{
+ my $keys = shift;
+ my @specs;
+
+ push @specs, { parse_vecspec($_) }
+ foreach @$keys;
+
+ \@specs;
+}
+
+#####################################################################
+# normalize user supplied limits
+
+sub parse_limits
+{
+ my ( $ndim, $spec, $KeySpec ) = @_;
+
+ $spec = [] unless defined $spec;
+
+ my @limits;
+
+ # array containing limits (as arrays or scalars)
+ if ( 'ARRAY' eq ref $spec )
+ {
+ # no limits; just move on
+ unless ( @$spec )
+ {
+ }
+
+ # multi-dimensional data sets
+ elsif ( 'ARRAY' eq ref $spec->[0] )
+ {
+ my $ilim = 0;
+ for my $vlim ( @$spec )
+ {
+ $ilim++;
+ die( "Limit spec element $ilim: expected array ref\n" )
+ if 'ARRAY' ne ref $vlim;
+
+ die( "Limit spec element $ilim: too many values\n" )
+ if @$vlim > 2;
+
+ die( "Limit spec element $vlim: values must be scalars\n" )
+ if grep { ref $_ } @$vlim;
+
+ my @lims = @$vlim;
+ $lims[0] = undef unless defined $lims[0];
+ $lims[1] = undef unless defined $lims[1];
+
+ push @limits, \@lims;
+ }
+ }
+
+ # one-dimensional data sets
+ elsif ( ! ref $spec->[0] )
+ {
+ die( "unexpected non-scalar element in Limits spec\n" )
+ if grep { ref $_ } @$spec;
+
+ my @lims = @$spec;
+ $lims[0] = undef unless defined $lims[0];
+ $lims[1] = undef unless defined $lims[1];
+
+ push @limits, \@lims;
+ }
+
+ push @limits, [ undef, undef ]
+ while ( @limits != $ndim );
+
+ }
+
+ # hash containing vector names and limits
+ elsif ( 'HASH' eq ref $spec )
+ {
+ # first ensure that VecKeys has been specified
+ die( "cannot use Limits without VecKeys\n" )
+ unless @$KeySpec;
+
+ # make sure that we've got common keys.
+ my %vecs = map { ( $_->{data} => 1) } @$KeySpec;
+
+ # identify unknown vectors
+ my @badvecs = grep { ! defined $vecs{$_} } keys %$spec;
+ die( 'unknown vector(s): ', join(', ', @badvecs), "\n" )
+ if @badvecs;
+
+ # work our way through the KeySpec's, filling in values from
+ # $spec as appropriate.
+ for my $kspec ( @$KeySpec )
+ {
+ my @lims = ( undef, undef );
+ if ( exists $spec->{$kspec->{data}} )
+ {
+ my $lspec = $spec->{$kspec->{data}};
+ $lims[0] = $lspec->{min} if exists $lspec->{min};
+ $lims[1] = $lspec->{max} if exists $lspec->{max};
+ }
+ push @limits, \@lims;
+ }
+ }
+
+ # say what?
+ else
+ {
+ die( "Limits attribute value must be a hashref or arrayref\n" );
+ }
+
+ map { { calc => scalar ( grep { !defined $_ } @{$_} ), range => $_ } } @limits;
+}
+
+
+
+#####################################################################
+
+sub limits
+{
+ my $attr = 'HASH' eq ref $_[-1] ? pop @_ : {};
+
+ my @udsets = @_;
+
+ my %attr = iparse( {
+ Min => -1.8e308,
+ Max => +1.8e308,
+ Bounds => 'minmax',
+ Clean => 'RangeFrac',
+ RangeFrac => 0.05,
+ ZeroFix => 0,
+ VecKeys => [],
+ KeyCroak => 1,
+ Limits => [],
+ Trans => [],
+ }, $attr );
+
+ # turn Trans and VecKeys into arrays if necessary; may be scalars for 1D
+ # data sets
+ $attr{$_} = [ $attr{$_} ]
+ foreach grep { defined $attr{$_} && 'ARRAY' ne ref $attr{$_} }
+ qw( VecKeys Trans );
+
+ # parse vector key specs
+ $attr{KeySpec} = parse_vecspecs( $attr{VecKeys} );
+
+ # normalize data sets to make life easier later. also
+ # counts up the number of dimensions and sets $attr{dims}
+ my @dsets = normalize_dsets( \%attr, @udsets );
+
+ # set up the Limits
+ my @limits = parse_limits( $attr{dims}, $attr{Limits}, $attr{KeySpec} );
+
+ if ( 'minmax' eq lc $attr{Bounds} )
+ {
+ for my $dim ( 0..$attr{dims}-1 )
+ {
+ # only calculate minmax values for those dims which need them.
+ my $limits = $limits[$dim];
+
+ foreach ( @dsets )
+ {
+ # calculate min & max
+ $_->calc_minmax( $dim )
+ if $limits->{calc};
+
+ # make sure we pay attention to user specified limits
+ $_->set_minmax( @{$limits->{range}}, $dim );
+ }
+ }
+ }
+
+ elsif ( 'zscale' eq lc $attr{Bounds} )
+ {
+ croak( "zscale only good for dim = 2\n" )
+ unless $attr{dims} == 2;
+
+ foreach my $dset ( @dsets )
+ {
+ $dset->calc_minmax( 0 )
+ if $limits[0]{calc};
+
+
+ if ( $limits[1]{calc} )
+ {
+ my $y = $dset->vector(1)->{data};
+
+ # this is a waste, as we don't care about the evaluated
+ # fit values, just the min and max values. since we
+ # get them all anyway, we'll use them.
+
+ my $mask = PDL::null;
+ set_mask( $mask, $y );
+
+ my $fit = fitpoly1d( $y->where($mask)->qsort, 2 );
+ $dset->set_minmax( $fit->minmax, 1 );
+ }
+
+ $dset->set_minmax( @{$limits[$_]{range}}, $_ ) for 0,1;
+ }
+ }
+ else
+ {
+ die( "unknown Bounds type: $attr{Bounds}\n" );
+ }
+
+ # derive union of minmax limits from data sets
+ my $minmax = PDL::Core::null;
+ $minmax = append( $minmax, $_->get_minmax ) foreach @dsets;
+
+ # get overall minmax limits
+ $minmax = cat(($minmax->minmaximum)[0,1])->transpose;
+
+ my @minmax = map{ [ $minmax->slice(":,$_")->list ] } 0..$attr{dims}-1;
+
+ if ( 'rangefrac' eq lc $attr{Clean} )
+ {
+ my $RangeFrac =
+ setup_multi( $attr{RangeFrac}, $attr{dims}, $attr{KeySpec} );
+
+ my $ZeroFix =
+ setup_multi( $attr{ZeroFix}, $attr{dims}, $attr{KeySpec} );
+
+ range_frac( $minmax[$_], $RangeFrac->[$_], $ZeroFix->[$_] )
+ for 0..$attr{dims}-1;
+ }
+
+ elsif ( 'roundpow' eq lc $attr{Clean} )
+ {
+ $_ = [ round_pow( down => $_->[0] ),
+ round_pow( up => $_->[1] ) ]
+ foreach @minmax;
+ }
+
+ elsif ( 'none' eq lc $attr{Clean} )
+ {
+ # do nothing
+ }
+
+ else
+ {
+ die( "unknown Clean type: $attr{Clean}\n" );
+ }
+
+ if ( wantarray )
+ {
+ return map { ( @{$_} ) } @minmax;
+ }
+ else
+ {
+ my @key;
+ if ( @{$attr{KeySpec}} )
+ {
+ @key = map { $_->{data} } @{$attr{KeySpec}};
+ }
+ else
+ {
+ @key = map { 'q' . $_ } ( 1 .. $attr{dims} );
+ }
+
+ return { map { ( $key[$_] => { min => $minmax[$_][0],
+ max => $minmax[$_][1] } ) }
+ 0.. ( @minmax - 1 ) };
+ }
+}
+
+1;
+
+
+__END__
+
+=pod
+
+=head1 NAME
+
+PDL::Graphics::Limits - derive limits for display purposes
+
+
+=head1 DESCRIPTION
+
+Functions to derive limits for data for display purposes
+
+=head1 SYNOPSIS
+
+ use PDL::Graphics::Limits;
+
+
+=head1 FUNCTIONS
+
+=head2 limits
+
+=for ref
+
+B<limits> derives global limits for one or more multi-dimensional sets
+of data for display purposes. It obtains minimum and maximum limits
+for each dimension based upon one of several algorithms.
+
+=for usage
+
+ @limits = limits( @datasets );
+ @limits = limits( @datasets, \%attr );
+ $limits = limits( @datasets );
+ $limits = limits( @datasets, \%attr );
+
+=head3 Data Sets
+
+A data set is represented as a set of one dimensional vectors, one per
+dimension. All data sets must have the same dimensions.
+Multi-dimensional data sets are packaged as arrays or hashs; one
+dimensional data sets need not be. The different representations may
+be mixed, as long as the dimensions are presented in the same order.
+Vectors may be either scalars or piddles.
+
+=over 8
+
+=item One dimensional data sets
+
+One dimensional data sets may be passed directly, with no additional packaging:
+
+ limits( $scalar, $piddle );
+
+=item Data sets as arrays
+
+If the data sets are represented by arrays, each vectors in each array
+must have the same order:
+
+ @ds1 = ( $x1_pdl, $y1_pdl );
+ @ds2 = ( $x2_pdl, $y2_pdl );
+
+They are passed by reference:
+
+ limits( \@ds1, \@ds2 );
+
+=item Data sets as hashes
+
+Hashes are passed by reference as well, but I<must> be further
+embedded in arrays (also passed by reference), in order that the last
+one is not confused with the optional trailing attribute hash. For
+example:
+
+ limits( [ \%ds4, \%ds5 ], \%attr );
+
+If each hash uses the same keys to identify the data, the keys
+should be passed as an ordered array via the C<VecKeys> attribute:
+
+ limits( [ \%h1, \%h2 ], { VecKeys => [ 'x', 'y' ] } );
+
+If the hashes use different keys, each hash must be accompanied by an
+ordered listing of the keys, embedded in their own anonymous array:
+
+ [ \%h1 => ( 'x', 'y' ) ], [ \%h2 => ( 'u', 'v' ) ]
+
+Keys which are not explicitly identified are ignored.
+
+=back
+
+=head3 Errors
+
+Error bars must be taken into account when determining limits; care
+is especially needed if the data are to be transformed before plotting
+(for logarithmic plots, for example). Errors may be symmetric (a single
+value indicates the negative and positive going errors for a data point) or
+asymmetric (two values are required to specify the errors).
+
+If the data set is specified as an array of vectors, vectors with
+errors should be embedded in an array. For symmetric errors, the error
+is given as a single vector (piddle or scalar); for asymmetric errors, there
+should be two values (one of which may be C<undef> to indicate
+a one-sided error bar):
+
+ @ds1 = ( $x, # no errors
+ [ $y, $yerr ], # symmetric errors
+ [ $z, $zn, $zp ], # asymmetric errors
+ [ $u, undef, $up ], # one-sided error bar
+ [ $v, $vn, undef ], # one-sided error bar
+ );
+
+If the data set is specified as a hash of vectors, the names of the
+error bar keys are appended to the names of the data keys in the
+C<VecKeys> designations. The error bar key names are always prefixed
+with a character indicating what kind of error they represent:
+
+ < negative going errors
+ > positive going errors
+ = symmetric errors
+
+(Column names may be separated by commas or white space.)
+
+For example,
+
+ %ds1 = ( x => $x, xerr => $xerr, y => $y, yerr => $yerr );
+ limits( [ \%ds1 ], { VecKeys => [ 'x =xerr', 'y =yerr' ] } );
+
+To specify asymmetric errors, specify both the negative and positive going
+errors:
+
+ %ds1 = ( x => $x, xnerr => $xn, xperr => $xp,
+ y => $y );
+ limits( [ \%ds1 ], { VecKeys => [ 'x <xnerr >xperr', 'y' ] } );
+
+For one-sided error bars, specify a column just for the side to
+be plotted:
+
+ %ds1 = ( x => $x, xnerr => $xn,
+ y => $y, yperr => $yp );
+ limits( [ \%ds1 ], { VecKeys => [ 'x <xnerr', 'y >yperr' ] } );
+
+
+Data in hashes with different keys follow the same paradigm:
+
+ [ \%h1 => ( 'x =xerr', 'y =yerr' ) ], [ \%h2 => ( 'u =uerr', 'v =verr' ) ]
+
+In this case, the column names specific to a single data set override
+those specified via the C<VecKeys> option.
+
+ limits( [ \%h1 => 'x =xerr' ], { VecKeys => [ 'x <xn >xp' ] } )
+
+In the case of a multi-dimensional data set, one must specify
+all of the keys:
+
+ limits( [ \%h1 => ( 'x =xerr', 'y =yerr' ) ],
+ { VecKeys => [ 'x <xn >xp', 'y <yp >yp' ] } )
+
+One can override only parts of the specifications:
+
+ limits( [ \%h1 => ( '=xerr', '=yerr' ) ],
+ { VecKeys => [ 'x <xn >xp', 'y <yp >yp' ] } )
+
+Use C<undef> as a placeholder for those keys for which
+nothing need by overridden:
+
+ limits( [ \%h1 => undef, 'y =yerr' ],
+ { VecKeys => [ 'x <xn >xp', 'y <yp >yp' ] } )
+
+=head3 Data Transformation
+
+Normally the data passed to B<limits> should be in their final,
+transformed, form. For example, if the data will be displayed on a
+logarithmic scale, the logarithm of the data should be passed to
+B<limits>. However, if error bars are also to be displayed, the
+I<untransformed> data must be passed, as
+
+ log(data) + log(error) != log(data + error)
+
+Since the ranges must be calculated for the transformed values,
+B<range> must be given the transformation function.
+
+If all of the data sets will undergo the same transformation, this may
+be done with the B<Trans> attribute, which is given a list of
+subroutine references, one for each element of a data set. An
+C<undef> value may be used to indicate no transformation is to be
+performed. For example,
+
+ @ds1 = ( $x, $y );
+
+ # take log of $x
+ limits( \@ds1, { trans => [ \&log10 ] } );
+
+ # take log of $y
+ limits( \@ds1, { trans => [ undef, \&log10 ] } );
+
+If each data set has a different transformation, things are a bit more
+complicated. If the data sets are specified as arrays of vectors, vectors
+with transformations should be embedded in an array, with the I<last>
+element the subroutine reference:
+
+ @ds1 = ( [ $x, \&log10 ], $y );
+
+With error bars, this looks like this:
+
+ @ds1 = ( [ $x, $xerr, \&log10 ], $y );
+ @ds1 = ( [ $x, $xn, $xp, \&log10 ], $y );
+
+If the C<Trans> attribute is used in conjunction with individual data
+set transformations, the latter will override it. To explicitly
+indicate that a specific data set element has no transformation
+(normally only needed if C<Trans> is used to specify a default) set
+the transformation subroutine reference to C<undef>. In this case,
+the entire quad of data element, negative error, positive error, and
+transformation subroutine must be specified to avoid confusion:
+
+ [ $x, $xn, $xp, undef ]
+
+Note that $xn and $xp may be undef. For symmetric errors, simply
+set both C<$xn> and C<$xp> to the same value.
+
+For data sets passed as hashes, the subroutine reference is an element
+in the hashes; the name of the corresponding key is added to the list
+of keys, preceded by the C<&> character:
+
+ %ds1 = ( x => $x, xerr => $xerr, xtrans => \&log10,
+ y => $y, yerr => $yerr );
+
+ limits( [ \%ds1, \%ds2 ],
+ { VecKeys => [ 'x =xerr &xtrans', 'y =yerr' ] });
+ limits( [ \%ds1 => 'x =xerr &xtrans', 'y =yerr' ] );
+
+If the C<Trans> attribute is specified, and a key name is also
+specified via the C<VecKeys> attribute or individually for a data set
+element, the latter will take precedence. For example,
+
+ $ds1{trans1} = \&log10;
+ $ds1{trans2} = \&sqrt;
+
+ # resolves to exp
+ limits( [ \%ds1 ], { Trans => [ \&exp ] });
+
+ # resolves to sqrt
+ limits( [ \%ds1 ], { Trans => [ \&exp ],
+ VecKeys => [ 'x =xerr &trans2' ] });
+
+ # resolves to log10
+ limits( [ \%ds1 => '&trans1' ], { Trans => [ \&exp ],
+ VecKeys => [ 'x =xerr &trans2' ] });
+
+
+To indicate that a particular vector should have no transformation,
+use a blank key:
+
+ limits( [ \%ds1 => ( 'x =xerr &', 'y =yerr' ) ], [\%ds2],
+ { Trans => [ \&log10 ] } );
+
+or set the hash element to C<undef>:
+
+ $ds1{xtrans} = undef;
+
+
+=head3 Range Algorithms
+
+Sometimes all you want is to find the minimum and maximum values. However,
+for display purposes, it's often nice to have "clean" range bounds. To that
+end, B<limits> produces a range in two steps. First it determines the bounds,
+then it cleans them up.
+
+To specify the bounding algorithm, set the value of the C<Bounds> key
+in the C<%attr> hash to one of the following values:
+
+=over 8
+
+=item MinMax
+
+This indicates the raw minima and maxima should be used. This is the
+default.
+
+=item Zscale
+
+This is valid for two dimensional data only. The C<Y> values are sorted,
+then fit to a line. The minimum and maximum values of the evaluated
+line are used for the C<Y> bounds; the raw minimum and maximum values
+of the C<X> data are used for the C<X> bounds. This method is good
+in situations where there are "spurious" spikes in the C<Y> data which
+would generate too large a dynamic range in the bounds. (Note that
+the C<Zscale> algorithm is found in IRAF and DS9; its true origin
+is unknown to the author).
+
+=back
+
+To specify the cleaning algorithm, set the value of the C<Clean> key
+in the C<%attr> hash to one of the following values:
+
+=over 8
+
+=item None
+
+Perform no cleaning of the bounds.
+
+=item RangeFrac
+
+This is based upon the C<PGPLOT> B<pgrnge> function. It symmetrically expands
+the bounds (determined above) by a fractional amount:
+
+ $expand = $frac * ( $axis->{max} - $axis->{min} );
+ $min = $axis->{min} - $expand;
+ $max = $axis->{max} + $expand;
+
+The fraction may be specified in the C<%attr> hash with the
+C<RangeFrac> key. It defaults to C<0.05>.
+
+Because this is a symmetric expansion, a limit of C<0.0> may be
+transformed into a negative number, which may be inappropriate. If
+the C<ZeroFix> key is set to a non-zero value in the C<%attr> hash,
+the cleaned boundary is set to C<0.0> if it is on the other side of
+C<0.0> from the above determined bounds. For example, If the minimum
+boundary value is C<0.1>, and the cleaned boundary value is C<-0.1>,
+the cleaned value will be set to C<0.0>. Similarly, if the maximum
+value is C<-0.1> and the cleaned value is C<0.1>, it will be set to C<0.0>.
+
+This is the default clean algorithm.
+
+=item RoundPow
+
+This is based upon the C<PGPLOT> B<pgrnd> routine. It determines a
+"nice" value, where "nice" is the closest round number to
+the boundary value, where a round number is 1, 2, or 5 times a power
+of 10.
+
+=back
+
+=head3 User Specified Limits
+
+To fully or partially override the automatically determined limits,
+use the B<Limits> attribute. These values are used as input to the
+range algorithms.
+
+The B<Limits> attribute value may be either an array of arrayrefs, or
+a hash.
+
+=over
+
+=item Arrays
+
+The B<Limits> value may be a reference to an array of arrayrefs, one
+per dimension, which contain the requested limits.
+
+The dimensions should be ordered in the same way as the datasets.
+Each arrayref should contain two ordered values, the minimum and
+maximum limits for that dimension. The limits may have the undefined
+value if that limit is to be automatically determined. The limits
+should be transformed (or not) in the same fashion as the data.
+
+For example, to specify that the second dimension's maximum limit
+should be fixed at a specified value:
+
+ Limits => [ [ undef, undef ], [ undef, $max ] ]
+
+Note that placeholder values are required for leading dimensions which
+are to be handled automatically. For convenience, if limits for a
+dimension are to be fully automatically determined, the placeholder
+arrayref may be empty. Also, trailing undefined limits may be
+omitted. The above example may be rewritten as:
+
+ Limits => [ [], [ undef, $max ] ]
+
+If the minimum value was specified instead of the maximum, the following
+would be acceptable:
+
+ Limits => [ [], [ $min ] ]
+
+If the data has but a single dimension, nested arrayrefs are not required:
+
+ Limits => [ $min, $max ]
+
+
+=item Hashes
+
+Th B<Limits> attribute value may be a hash; this can only be used in
+conjunction with the B<VecKeys> attribute. If the data sets are
+represented by hashes which do not have common keys, then the user
+defined limits should be specified with arrays. The keys in the
+B<Limits> hash should be the names of the data vectors in the
+B<VecKeys>. Their values should be hashes with keys C<min> and C<max>,
+representing the minimum and maximum limits. Limits which have the value
+C<undef> or which are not specified will be determined from the data.
+For example,
+
+ Limits => { x => { min => 30 }, y => { max => 22 } }
+
+=back
+
+=head3 Return Values
+
+When called in a list context, it returns the minimum and maximum
+bounds for each axis:
+
+ @limits = ( $min_1, $max_1, $min_2, $max_2, ... );
+
+which makes life easier when using the B<env> method:
+
+ $window->env( @limits );
+
+When called in a scalar context, it returns a hashref with the keys
+
+ axis1, ... axisN
+
+where C<axisN> is the name of the Nth axis. If axis names have not
+been specified via the C<VecKeys> element of C<%attr>, names are
+concocted as C<q1>, C<q2>, etc. The values are hashes with keys
+C<min> and C<max>. For example:
+
+ { q1 => { min => 1, max => 2},
+ q2 => { min => -33, max => 33 } }
+
+=head3 Miscellaneous
+
+Normally B<limits> complains if hash data sets don't contain specific
+keys for error bars or transformation functions. If, however,
+you'd like to specify default values using the C<%attr> argument,
+but there are data sets which don't have the data and you'd rather
+not have to explicitly indicate that, set the C<KeyCroak> attribute
+to zero. For example,
+
+ limits( [ { x => $x }, { x => $x1, xerr => $xerr } ],
+ { VecKeys => [ 'x =xerr' ] } );
+
+will generate an error because the first data set does not have
+an C<xerr> key. Resetting C<KeyCroak> will fix this:
+
+ limits( [ { x => $x }, { x => $x1, xerr => $xerr } ],
+ { VecKeys => [ 'x =xerr' ], KeyCroak => 0 } );
+
+
+=head1 AUTHOR
+
+Diab Jerius, E<lt>djerius at cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2004 by the Smithsonian Astrophysical Observatory
+
+
+This software is released under the GNU General Public License.
+You may find a copy at L<http://www.fsf.org/copyleft/gpl.html>.
+
+=cut
diff --git a/Graphics/Limits/Makefile.PL b/Graphics/Limits/Makefile.PL
new file mode 100644
index 0000000..0e1cc06
--- /dev/null
+++ b/Graphics/Limits/Makefile.PL
@@ -0,0 +1,15 @@
+
+# Makefile.PL for PDL::Graphics::PGPLOT module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+
+WriteMakefile(
+ 'NAME' => 'PDL::Graphics::Limits',
+ 'VERSION_FROM' => '../../Basic/Core/Version.pm',
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
diff --git a/Graphics/Makefile.PL b/Graphics/Makefile.PL
new file mode 100644
index 0000000..f0a38f4
--- /dev/null
+++ b/Graphics/Makefile.PL
@@ -0,0 +1,45 @@
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import(); # for trylink
+
+ at subdirs = qw(PGPLOT LUT IIS PLplot Limits);
+
+# we try and build unless WITH_3D == 0
+$t = $PDL::Config{WITH_3D};
+if ( defined($t) and not $t ) {
+ print "\n WITH_3D: WITH_3D => 0, not building TriD or OpenGL. Set WITH_3D => 1 if this is incorrect.\n\n";
+} elsif ( $PDL::Config{USE_POGL} ) {
+ print "\n WITH_3D: USE_POGL => 1, will build TriD using OpenGL.\n\n";
+ $PDL::Config{WITH_3D} = 1;
+ unshift @subdirs,"TriD";
+} else {
+ print "\n WITH_3D: USE_POGL => 0, setting WITH_3D => 0. Will not build TriD graphics.\n\n";
+ $PDL::Config{WITH_3D}=0; # don't build TriD if no POGL
+}
+
+#WriteMakefile(
+# 'NAME' => 'PDL',
+# VERSION_FROM => '../Basic/Core/Version.pm',
+# DIR => [@subdirs]
+#);
+my @pm_names = qw (Graphics2D.pm State.pm);
+
+my %pm = map { $h = '$(INST_LIBDIR)/';
+ $h .= 'PDL/' if $_ !~ /PDL.pm$/;
+ $h .= 'Graphics/' if $_ =~ /State.pm$/;
+ ( $_, $h . $_ );
+ } ( @pm_names);
+
+my %man3pods = map { $h = '$(INST_MAN3DIR)/';
+ $h .= 'PDL::' if $_ !~ /PDL.pm$/;
+ ( $_, $h . substr($_,0,length($_)-3) . '.$(MAN3EXT)' );
+ } @pm_names;
+
+# Write makefile
+WriteMakefile(
+ 'NAME' => 'PDL',
+ 'VERSION_FROM' => '../Basic/Core/Version.pm',
+ 'PM' => \%pm,
+ 'MAN3PODS' => \%man3pods,
+ 'DIR' => [@subdirs],
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
diff --git a/Graphics/PGPLOT/Makefile.PL b/Graphics/PGPLOT/Makefile.PL
new file mode 100644
index 0000000..f17f591
--- /dev/null
+++ b/Graphics/PGPLOT/Makefile.PL
@@ -0,0 +1,16 @@
+
+# Makefile.PL for PDL::Graphics::PGPLOT module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+
+WriteMakefile(
+ 'NAME' => 'PDL::Graphics::PGPLOT',
+ 'VERSION_FROM' => '../../Basic/Core/Version.pm',
+ 'DIR' => ['Window'],
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
diff --git a/Graphics/PGPLOT/PGPLOT.pm b/Graphics/PGPLOT/PGPLOT.pm
new file mode 100644
index 0000000..69d7880
--- /dev/null
+++ b/Graphics/PGPLOT/PGPLOT.pm
@@ -0,0 +1,589 @@
+# Graphics functions for the PDL module, this module
+# requires the PGPLOT module be previously installed.
+# PGPLOT functions are also made available to the caller.
+
+=head1 NAME
+
+ PDL::Graphics::PGPLOT - PGPLOT enhanced interface for PDL
+
+=head1 SYNOPSIS
+
+ pdl> $a = pdl [1..100]
+ pdl> $b = sqrt($a)
+ pdl> line $b
+ pdl> hold
+ Graphics on HOLD
+ pdl> $c = sin($a/10)*2 + 4
+ pdl> line $c
+
+=head1 DESCRIPTION
+
+C<PDL::Graphics::PGPLOT> is a convenience interface to the PGPLOT commands,
+implemented using the object oriented PGPLOT plotting package in
+L<PDL::Graphics::PGPLOT::Window|PDL::Graphics::PGPLOT::Window>. See the documentation for that package
+for in-depth information about the usage of these commands and the options
+they accept.
+
+The list of currently availably commands:
+
+ imag - Display an image (uses pgimag()/pggray() as appropriate)
+ im - Shorthand to display an image with aspect ratio of 1
+ fits_imag - Display a FITS image with appropriate transforms & labels
+ cont - Display image as contour map
+ fits_cont - Display a FITS image in scientific coordinates as a contour map
+ vect - Display 2 images as a vector field
+ fits_vect - Display 2 FITS images in sci. coordinates as a vector field
+ ctab - Load an image colour table
+ ctab_info - Get information about currently loaded colour table
+ line - Plot vector as connected points
+ points - Plot vector as points
+ errb - Plot error bars
+ bin - Plot vector as histogram (e.g. bin(hist($data)) )
+ hi2d - Plot image as 2d histogram (not very good IMHO...)
+ poly - Draw a polygon
+ text - Write text in the plot area
+ label_axes - Print axis titles
+ legend - Create a legend with different texts, linestyles etc.
+ cursor - Interactively read cursor positions.
+ circle - Draw a circle
+ ellipse - Draw an ellipse.
+
+Device manipulation commands:
+
+ hold - Hold current plot window range - allows overlays etc.
+ release - Release back to autoscaling of new plot window for each
+ command
+ rel - short alias for 'release'
+ env - Define a plot window, put on 'hold'
+ dev - Explicitly set a new PGPLOT graphics device
+ new_window - Create a new plot window (use of dev is recommended)
+ focus_window - Change focus to a new window
+ window_list - Get a list of currently exisiting plot windows
+ close_window - Close an open window
+
+
+=head1 FUNCTIONS
+
+The following is a list of the functions that are private to this package,
+for the other functions please read the L<PDL::Graphics::PGPLOT::Window|PDL::Graphics::PGPLOT::Window>
+documentation.
+
+=head2 dev
+
+=for ref
+
+Open PGPLOT graphics device
+
+=for usage
+
+ Usage: dev $device, [$nx,$ny, $opt];
+
+C<$device> is a PGPLOT graphics device such as "/xserve" or "/ps",
+if omitted defaults to last used device (or value of env
+var C<PGPLOT_DEV> if first time).
+C<$nx>, C<$ny> specify sub-panelling. The function returns the id of
+the newly created window - this can subsequently be used as argument to
+C<focus_window> to select the window.
+
+The result of this command can be modified using options. The options
+recognised are the same as for C<new_window> - which primarily and in
+addition it is possible to set the default values for a window that are
+defined in L<PDL::Graphics::PGPLOTOptions|PDL::Graphics::PGPLOTOptions>, see this for details but see below for
+a synopsis.
+
+In addition C<dev> recognises the option C<NewWindow> which allows the
+user to specify that a C<dev> command is to create a new window rather than
+closing the previous. This allows a large number of output destinations to
+be open at the same time, which occasionally can be convenient.
+
+Here is a quick summary of the most useful additional options that can
+be given:
+
+=over
+
+=item Device
+
+Alternative to C<$device>.
+
+=item AspectRatio
+
+The aspect ratio of the output window
+
+=item WindowWidth
+
+The width of the plot window in inches
+
+=item AxisColour
+
+The axis colour to be used as default for plots in this window. In the same
+way it is possible to set the default character size (C<CharSize>) and axis
+and box styles. See L<PDL::Graphics::PGPLOTOptions|PDL::Graphics::PGPLOTOptions> for details.
+
+=item WindowName
+
+The name of a window. This name can subsequently be used to refer to the
+window instead of its ID, making interactive use somewhat more intuitive.
+
+=back
+
+=for example
+
+To open a X-window output that will stay on screen:
+
+ $win = dev('/xs');
+
+To open two windows, one small and square, one large and wide:
+
+ $win1 = dev('/xs', {Aspect => 1, WindowWidth => 4});
+ $win2 = dev('/xs', {Aspect => 0.5, WindowWidth => 10});
+
+=cut
+
+package PDL::Graphics::PGPLOT;
+
+# Just a plain function exporting package
+
+use PDL::Core qw/:Func :Internal/; # Grab the Core names
+use PDL::Graphics::PGPLOTOptions qw(default_options);
+use PDL::Graphics::PGPLOT::Window;
+use PGPLOT;
+use Exporter;
+
+use strict;
+
+use vars qw (@ISA @EXPORT);
+
+ at ISA = ('Exporter');
+
+ at EXPORT = qw( dev hold release rel env bin errb line points
+ fits_imag imag imag1 fits_cont cont fits_vect vect
+ draw_wedge ctab ctab_info hi2d poly CtoF77coords
+ new_window focus_window window_list close_window
+ label_axes text legend cursor circle ellipse rectangle
+ tpoints tline retrieve_state replay turn_off_recording
+ turn_on_recording clear_state autolog get_current_window
+ transform
+ );
+
+*rel = *release; # Alias
+*image = *imag;
+
+############################################################################
+
+#############################################################
+# This is a new version of PGPLOT which uses PDL::Options for
+# option parsing.
+#############################################################
+
+# Option explanation:
+#
+# Each routine has a set of options, and there is also a set of
+# global options that may or may not affect a particular routine.
+# The global options are defined here in the start of the code.
+#
+# This require a minor adjustment to the PDL::Options code since
+# otherwise we would need to define the global options everywhere.
+#
+# The actual setting of default parameters is split off in a separate
+# file PDL::Graphics::PGPLOTOptions - which also exports default_options
+# used below.
+
+# The list of default global opttions, synonyms and translations.
+#
+
+END { # Destructor to close plot when perl exits
+ _close_windows();
+}
+
+#############################################################
+# We now want to be able to have several plotting windows #
+# The current set of windows is stored in these #
+# variables - accessed by the local subs. Added JB 12/7/00 #
+# #
+# This has lead to a substantial rewrite of the code since #
+# all the real work is now done in the Window object which #
+# this routine only provides a convenient (and backwards #
+# compatible) interface to. #
+#############################################################
+
+
+
+
+my @_WINDOWS=(); # The list of windows to access - the value is the options.
+my %_WINDOWNAMES = (); # A map of names for each window to their number.
+my $CW = undef;
+
+
+=head2 new_window
+
+=for ref
+
+Open a PGPLOT graphics device
+
+=for usage
+
+ $win = new_window($dev, $nx, $ny, $opt);
+
+This function is identical to L<dev|dev> except that it always creates a new
+window. This means that the user is required to close all windows
+explicitly using L<close_window|close_window>. All functionality is otherwise like C<dev>
+so see the documentation for L<dev|dev> for details of use.
+
+=cut
+
+sub new_window {
+ my ($dev, $nx, $ny, $opt)=@_;
+
+ if (ref($dev) eq 'HASH') {
+ $opt = $dev;
+ ($dev, $nx, $ny)=(undef, undef, undef);
+ } elsif (ref($nx) eq 'HASH') {
+ $opt = $nx;
+ ($nx, $ny)=(undef, undef);
+ }
+
+ $opt={} unless defined($opt);
+
+ # This will cause problems if people both pass dev, nx & ny _and_
+ # passes them in an options hash with poor spelling - don't do that..
+ $opt->{Device}=$dev if defined($dev);
+ $opt->{NXPanel}=$nx if defined($nx);
+ $opt->{NYPanel}=$ny if defined($ny);
+
+ # Now insert the necessary information in the variables above.
+ # barf "Options must be an anonymous hash!\n" if defined($_[0]) &&
+ # ref($_[0]) ne 'HASH';
+ my $win = PDL::Graphics::PGPLOT::Window->new($opt);
+ my ($name, $id) = ($win->name(), $win->id());
+ $_WINDOWS[$id] = $name;
+ $_WINDOWNAMES{$name}=$win;
+ $_WINDOWNAMES{$id}=$name; # Reverse lookup for speed
+
+ $CW = $win;
+ if (wantarray) {
+ return ($id, $name, $win);
+ } else {
+ return $id;
+ }
+}
+
+
+# Close all windows.
+sub _close_windows {
+ close_window({All=>1}); # Do all windows...
+}
+
+
+
+=head2 close_window
+
+=for ref
+
+Close a PGPLOT output device
+
+=for usage
+
+ Usage: close_window($id)
+
+This function closes a PGPLOT output device created with C<dev> or
+C<new_window>. It requires the id of the window to close. If C<$id> is
+left undefined, the currently focussed window is deleted and focus is
+transferred to the lowest numbered window in existence. If many windows
+have been created and deleted this might not be what you expect, so
+it is recommended to make an explicit call to L<focus_window|focus_window> after
+any call to C<close_window>.
+
+=cut
+
+sub close_window {
+ my ($name)=@_;
+
+ if (ref($name) eq 'HASH') { # Hack - to avoid checking window names..
+ for (my $id=0; $id<=$#_WINDOWS; $id++) {
+ next unless defined($_WINDOWS[$id]);
+ my $n = $_WINDOWS[$id];
+ $_WINDOWNAMES{$n}->close();
+ delete $_WINDOWNAMES{$n};
+ delete $_WINDOWNAMES{$id};
+ }
+ @_WINDOWS=(); # Remove all windows.
+ $CW = undef; # No current window
+ } else {
+ #
+ # Delete a specific window
+ #
+ my $id = _get_windownumber($name);
+ my $CWid = $CW->id();
+
+ my $n= $_WINDOWNAMES{$id}; # In case the name was not passed..
+ $_WINDOWNAMES{$n}->close();
+ delete $_WINDOWNAMES{$n};
+ delete $_WINDOWNAMES{$id};
+ $_WINDOWS[$id]=undef; #splice(@_WINDOWS, $id, 1);
+
+
+ if ($CWid == $id) {
+ # Now determine the current window, viz the lowest numbered
+ # window existing.
+
+ $CW = undef;
+ for (my $i=0; $i<=$#_WINDOWS; $i++) {
+ if (defined($_WINDOWS[$i])) {
+ $CW = $_WINDOWNAMES{$_WINDOWS[$i]};
+ last;
+ }
+ }
+ }
+
+ # Since we set the corresponding array elements to undef - we
+ # have to check if we have in fact deleted the whole shebang in
+ # which case @_WINDOWS should be reset.
+ @_WINDOWS=() if (!defined($CW));
+ }
+}
+
+# Utility function - allowing both numbers and names to be used.
+
+=head2 _get_windownumber
+
+Internal function to obtain the ID of a window. This allows the user
+to refer to a window with its name.
+
+=cut
+
+
+sub _get_windownumber {
+ my ($name)=@_;
+ if (!defined($name) || $name eq '') {
+ return -1 unless defined($CW);
+ return $CW->id();
+ }
+ my $windownumber = -1;
+ if (!exists($_WINDOWNAMES{$name}) || !ref($_WINDOWNAMES{$name})) {
+ # Then it ought to be a number
+ if ($name =~ m/^\d+$/) {
+ $windownumber = $name;
+ } else {
+ print "Valid window names: \n";
+ foreach my $k (keys %_WINDOWNAMES) {
+ print "$k\n";
+ }
+ barf ("I cannot switch to window $name - no such name\n");
+ }
+ } else {
+ $windownumber = $_WINDOWNAMES{$name}->id();
+ }
+ barf("Invalid windownumber ($name)\n") if
+ !defined($_WINDOWS[$windownumber]);
+
+ return $windownumber;
+}
+
+
+
+{
+ my $dev_options = undef;
+
+ sub dev {
+ # This delayed creation of the options variable is for increased speed.
+ # Although for dev() this is unnecessary...
+ if (!defined($dev_options)) {
+ $dev_options = PDL::Options->new({NewWindow => 0});
+ $dev_options->warnonmissing(0); # Turn off warnings.
+ }
+
+ # Get the input options.
+ my ($dev, $nx, $ny, $u_opt)=@_;
+
+ if (ref($nx) eq 'HASH') {
+ $u_opt = $nx;
+ ($nx, $ny)=(undef, undef);
+ }
+ $u_opt = {} if !defined($u_opt);
+ my $opt = $dev_options->options($u_opt);
+
+ # Then we want to close the current one before opening a new one.
+ if (!$opt->{NewWindow}) {
+ my ($state,$len);
+ pgqinf('STATE',$state,$len);
+ close_window() if $state eq 'OPEN';
+ }
+
+ my $win=new_window(@_);
+ return $win;
+ }
+
+}
+
+=head2 focus_window
+
+=for ref
+
+Switch to another output window.
+
+=for usage
+
+ Usage: focus_window($id);
+
+This command is used to switch output focus to another window created by
+L<dev|dev> or L<new_window|new_window>. The window can be referred to either by its
+ID or by its name.
+
+=for example
+
+ $win1 = dev('/xs', {WindowName => 'X-output'});
+ $win2 = dev('test.ps/ps', {WindowName => 'PS-output'});
+
+ focus_window('X-output'); # Or focus_window($win1);
+ <.. Commands ..>
+ focus_window($win2); # Or focus_window('PS-output');
+ <.. Commands ..>
+
+=cut
+
+
+# Switch to a new window.
+sub focus_window {
+ my ($name)=@_;
+ my $windownumber = _get_windownumber($name);
+ die "No such window ($name)\n" if $windownumber < 0;
+ $CW = $_WINDOWNAMES{$_WINDOWS[$windownumber]};
+ print "Window focus switched to Window nr $windownumber ($_WINDOWNAMES{$windownumber})\n" if $PDL::verbose;
+ $CW->focus();
+}
+
+
+=head2 window_list
+
+=for ref
+
+Return a list of ID numbers and names of the windows currently opened using
+L<dev|dev> or L<new_window|new_window>.
+
+=for usage
+
+ Usage: ($numbers, $names)=window_list();
+
+C<$numbers> and C<$names> are anonymous arrays giving the ID numbers and
+names of the open windows respectively.
+
+=cut
+
+# And getting a list of windows
+sub window_list {
+ my @numbers=();
+ my @names=();
+ foreach (keys %_WINDOWNAMES) {
+ if (ref($_WINDOWNAMES{$_}) eq 'PDL::Graphics::PGPLOT::Window') {
+ push @names, $_;
+ } else {
+ push @numbers, $_;
+ }
+ }
+ return (wantarray ? (\@numbers, \@names) : \@numbers);
+}
+
+
+sub label_axes {
+ # We do not label axes when there is no plot window.
+ return if !defined($CW);
+ $CW->label_axes(@_);
+}
+
+sub turn_on_recording {
+ if (!defined($CW)) {
+ warn "You can only turn on recording when you have a device open!\n";
+ return;
+ }
+ $CW->turn_on_recording();
+}
+
+sub turn_off_recording {
+ if (!defined($CW)) {
+ warn "You can only turn off recording when you have a device open!\n";
+ return;
+ }
+ $CW->turn_off_recording();
+}
+
+sub retrieve_state {
+ if (!defined($CW)) {
+ warn "You can only retrieve the state when a device is open\n";
+ return;
+ }
+ $CW->retrieve_state();
+}
+
+
+sub replay {
+ if (!defined($CW)) {
+ warn "You can only replay plotting commands when a device is open!\n";
+ return;
+ }
+ $CW->replay(@_);
+}
+
+sub clear_state {
+ if (!defined($CW)) {
+ warn "You can only clear the state when a device is open\n";
+ return;
+ }
+ $CW->clear_state();
+}
+
+
+sub autolog { # for this one we use the class method to set autolog globally
+ dev() if !defined($CW);
+ PDL::Graphics::PGPLOT::Window->autolog(@_);
+}
+
+sub text {
+ barf 'Open a plot window first!' if !defined($CW);
+ $CW->text(@_);
+}
+
+sub cursor {
+ barf 'Open a plot window first!' if !defined($CW);
+ $CW->cursor(@_);
+}
+
+sub legend {
+ barf 'Open a plot window first!' if !defined($CW);
+ $CW->legend(@_);
+}
+
+# should add these routines to EXPORT array as we create
+# each routine
+#
+foreach my $func (
+ qw(
+ env bin cont fits_cont errb line tline points tpoints
+ imag fits_imag imag1 draw_wedge
+ ctab ctab_info hi2d poly vect fits_vect
+ CtoF77coords circle ellipse rectangle
+ ) ) {
+ eval <<"ENDOFFUNC";
+sub $func {
+ dev() if !defined(\$CW);
+ \$CW->${func}(\@_);
+}
+ENDOFFUNC
+}
+
+sub transform {
+ barf 'Open a plot window first!' if !defined($CW);
+ $CW->transform(@_);
+}
+
+sub hold { return if !defined($CW); $CW->hold(); print "Graphics on HOLD\n" if $PDL::verbose;};
+sub release { return if !defined($CW); $CW->release(); print "Graphics RELEASED\n" if $PDL::verbose;};
+#sub held { return 0 if !defined($CW); return $CW->held()};
+#sub current_device { return $CW->device(); };
+
+sub get_current_window { return $CW; } # return current window or undef if none exists
+
+1; # Exit with OK status
+
+
+
+
diff --git a/Graphics/PGPLOT/PGPLOTOptions.pm b/Graphics/PGPLOT/PGPLOTOptions.pm
new file mode 100644
index 0000000..52507c3
--- /dev/null
+++ b/Graphics/PGPLOT/PGPLOTOptions.pm
@@ -0,0 +1,413 @@
+=head1 NAME
+
+PDL::Graphics::PGPLOTOptions - Setting PGPLOT options
+
+=head1 SYNOPSIS
+
+use PGPLOTOptions qw('default_options');
+
+=head1 DESCRIPTION
+
+This package contains one function (at present) which returns PDL::Option
+objects for default settings for plot windows and plot commands. This
+should be complemented by functions that could affect this such as
+file reading commands etc.
+
+=head1 OPTIONS
+
+The following is a listing of options that are set in this file and what
+they do and what their default value is
+
+=head2 Window specfic options
+
+These options modify the appearance of windows and can also modify the
+default settings for creation of plot axes etc.
+
+=over
+
+=item Device
+
+The default PGPLOT device to use. The default value is set to the PGPLOT_DEV
+environment variable if set, otherwise to '?'.
+
+=item AxisColour
+
+The colour with which to draw axes. Default value=3 (Green)
+
+=item HardLW, HardCH, HardFont, HardAxisColour, HardColour
+
+The linewidth, character height, font and axis colour to use on hardcopy
+devices. The default values are HardLW=1, HardCH=1.4, HardFont=2 (Roman),
+HardAxisColour=1 (Black) and HardColour=1 as well. The latter is the default
+plot colour to use on hardcopy devices.
+
+=item Axis
+
+The axis style to use. See the L<PDL::Graphics::PGPLOT::Window> documentation
+for details. It defaults to 'Normal' which is a labelled box. Valid arguments
+are 'Empty', 'Box', 'Normal', 'Axes', 'Grid', 'LogX', 'LogY', 'LogXY'.
+
+=item AspectRatio
+
+The aspect ratio of the output device. The default value is device dependent.
+
+=item WindowWidth
+
+The width of the output window in inches and defaults to as big as possible.
+
+=item WindowXSize and WindowYSize
+
+These are alternatives to AspectRatio and WindowWidth.
+
+=item WindowName
+
+The name of the window - can later be retrieved using name(). It defaults
+to 'Window'+Window ID.
+
+=item NXPanel
+
+The number of panels in the X-direction - defaults to 1
+
+=item NYPanel
+
+The number of panels in the Y-direction - defaults to 1
+
+=item Justify
+
+A boolean value which, if true, causes both axes to drawn
+to the same scale; see
+the PGPLOT C<pgenv()> command for more information.
+
+=item TightLabels
+
+Boolean value which, if true, causes axis labels to be pulled
+slightly closer to the main viewport than usual. That's handy
+for making multi-panel plots. Undef (the default) is equivalent
+to 0 for panels with NYPanels <= 1 and 1 for panels with NYPanels > 1.
+
+=item TitleSize
+
+The relative size of a plot or image title, compared to other annotations.
+Defaults to 1.0 (original behavior) but can be set to, e.g., 1.5 to
+emphasize graph titles in a multipanel plot.
+
+=item Border
+
+Adjust the spacing around the plot. See the documentation in
+L<PDL::Graphics::PGPLOT::Window> for details.
+
+=item CharSize
+
+The default charsize for the plot - used when annotating the axes for
+instance. It defaults to 1.
+
+=item PlotPosition
+
+The position of the plot in normalised coordinates.
+
+=item Erase
+
+Explicitly erase the plotting surface, normally required when making new
+plots with PlotPosition.
+
+=back
+
+=head2 Plot specific options
+
+
+For the moment see the C<PDL::Graphics::PGPLOT::Window> documentation for
+these.
+
+
+=cut
+
+package PDL::Graphics::PGPLOTOptions;
+
+
+# use PDL::Core qw/:Func :Internal/;
+use Exporter;
+use strict;
+use vars qw(@ISA @EXPORT_OK);
+
+ at ISA = ('Exporter');
+ at EXPORT_OK = qw(default_options set_pgplot_options);
+
+#
+# To be able to set options outside of PGPLOT in the .perldlrc I will
+# have to define these local variables.
+#
+my %options = (
+ Device => undef,
+ AxisColour => 3,
+ BackgroundColour => -1, # Text background colour
+ HardLW => 1,
+ HardCH => 1.4,
+ HardFont => 2,
+ HardAxisColour => 1,
+ HardColour => 1,
+ Axis => 'BCNST', # see kludge in Window::imag if you change this
+ AspectRatio => undef,
+ WindowWidth => undef,
+ WindowXSize => undef,
+ WindowYSize => undef,
+ Size => undef,
+ Unit=> undef,
+ WindowName => '',
+ NXPanel => 1,
+ NYPanel => 1,
+ Justify => 0, # Justification of boxes & axes
+ Scale=> undef, # device pixels per data pixel
+ Pitch=> undef, # Horizontal data pixels per <unit>
+ Unit => undef, # Unit for pitch
+ Pix => undef, # Pixel aspect ratio
+ Align => undef, # Alignment of viewport within plot area
+ DirAxis=> undef, # Default direction of axes
+ Border => 0,
+ CharSize => 1,
+ Symbol => 17,
+ Colour => 5,
+ ErrTerm => 1,
+ LineStyle => 1,
+ Font => 1,
+ Fill => 1,
+ ITF => 0,
+ Transform => undef,
+ LineWidth => 1,
+ XRange => undef,
+ YRange => undef,
+ Arrow => {FS => 1, Angle => 45.0, Vent => 0.3,
+ ArrowSize => undef},
+ Hatch => {Angle => 45.0, Separation => 1.0, Phase => 0.0},
+ XTitle => '',
+ YTitle => '',
+ Title => '',
+ );
+
+
+sub default_options {
+
+
+ my $DEV=undef;
+ # Use the standard PGPLOT environment variable.
+ $DEV = $ENV{"PGPLOT_DEV"} if defined $ENV{"PGPLOT_DEV"};
+ # However if the user has specified the Perl-ish variable use that.
+ $DEV = $options{Device} if defined($options{Device});
+ $DEV = "?" if !defined($DEV) || $DEV eq ""; # Safe default
+
+ # Options specific (primarily) to window creation
+ my $wo = {
+ Device => $DEV, ### Tidy this up.
+ AxisColour => $options{AxisColour}, # Axis colour
+ HardLW => $options{HardLW}, # Line width for hardcopy devices,
+ HardCH => $options{HardCH}, # Character height for hardcopy devices
+ HardFont => $options{HardFont}, # For for hardcopy devices
+ HardAxisColour => $options{HardAxisColour}, # Black colour as default on hardcopy devices.
+ HardColour => $options{HardColour}, # Black as default plot colour on hardcopy devices.
+ Axis => $options{Axis}, # The type of box
+ AspectRatio => $options{AspectRatio}, # The aspect ratio of the plot window.
+ WindowWidth => $options{WindowWidth}, # The width of the plot window in inches.
+ WindowXSize => $options{WindowXSize}, # The X&Y size of a window, these will be
+ WindowYSize => $options{WindowYSize}, # used to give the aspect ratio if defined.
+ Size => $options{Size}, # alternative window size spec
+ Unit => $options{Unit}, # Units for size spec
+ WindowName => $options{WindowName}, # The window name given
+ NXPanel => $options{NXPanel}, # The number of plotting panels
+ NYPanel => $options{NYPanel}, # Ditto.
+ TightLabels => undef,
+ TitleSize => 1.0,
+ Justify => $options{Justify}, # Justification of boxes & axes
+ Scale => $options{Justify}, # device pixels per data pixel
+ Pitch => $options{Pitch}, # Horizontal data pixels per unit
+ Unit => $options{Unit}, # PGPLOT unit for pitch
+ Pix => $options{Pix}, # Pixel aspect ratio
+ Align => $options{Align}, # Alignment of vp in plot area
+ DirAxis => $options{DirAxis}, # The default axis direction
+ Border => $options{Border},
+ CharSize => $options{CharSize}, # Character size for annotation
+ Erase => 0,
+ Recording => 0, # Off by default.
+ PlotPosition => 'Default' # The position of the plot on the page.
+ };
+
+ # Options specific to plotting commands
+ my $o = {
+ Symbol => $options{Symbol}, # Symbol for points
+ Colour => $options{Colour}, # Colour for plots
+ CharSize => $options{CharSize}, # Character height
+ ErrTerm => $options{ErrTerm}, # Size of error-bar terminators
+ Erase => 0, # Whether to erase a panel when switching.
+ Panel => undef, # What panel to switch to.
+ LineStyle => $options{LineStyle}, # Solid linestyle
+ Font => $options{Font}, # Normal font
+ Fill => $options{Fill}, # Solid fill
+ ITF => $options{ITF}, # Linear ITF
+ Axis => $options{Axis}, # Standard axis-type
+
+ Transform => $options{Transform}, # The transform used for plots.
+ Justify => $options{Justify}, # Justification of boxes & axes
+ Scale => $options{Justify}, # device pixels per data pixel
+ Pitch => $options{Pitch}, # Horizontal data pixels per unit
+ Unit => $options{Unit}, # PGPLOT unit for pitch
+ Pix => $options{Pix}, # Pixel aspect ratio
+ Align => $options{Align}, # Alignment of vp in plot area
+ DirAxis => $options{DirAxis}, # The default axis direction
+
+ LineWidth => $options{LineWidth},
+ TightLabels => $options{TightLabels},
+ TitleSize => $options{TitleSize},
+ XRange => $options{XRange},
+ YRange => $options{YRange},
+ BackgroundColour => $options{BackgroundColour},
+ # The following two should really be implemented as an Options
+ # object, but that will make I/O of options somewhat difficult.
+ # Note that the arrowsize is implemented as a synonym for the
+ # charsize this should not cause any problems but might be worth
+ # noting...
+ # In addition to this the arrowsize below is also set to be undefined
+ # by default which will automatically use the character size.
+ # All these problems are historical..
+ Arrow => $options{Arrow},
+ Hatch => $options{Hatch},
+ XTitle => $options{XTitle}, # Label for X-axis
+ YTitle => $options{YTitle}, # Label for Y-axis
+ Title => $options{Title}, # Title for plot
+ };
+
+
+ # Now for the synonyms
+ my $s = {Color => 'Colour', 'Line-style' => 'LineStyle',
+ 'Line-width' => 'LineWidth', 'Hatching' => 'Hatch',
+ FillType => 'Fill', 'ArrowSize' => 'CharSize',
+ AxisColor => 'AxisColour', HardAxisColor => 'HardAxisColour',
+ HardColor => 'HardColor', BackgroundColor => 'BackgroundColour'};
+ #
+ # And now for the lookup tables..
+ #
+ my $t = {
+ Colour => {
+ 'White' => 0, 'Black' => 1, 'Red' => 2,
+ 'Green' => 3, 'Blue' => 4, 'Cyan' => 5,
+ 'Magenta' => 6, 'Yellow' => 7, 'Orange' => 8,
+ 'DarkGray' => 14, 'DarkGrey' => 14,
+ 'LightGray' => 15, 'LightGrey' => 15,
+ 'CosmicSpectrum' => [0.269, 0.388, 0.342]
+ },
+ BackgroundColour => {
+ 'White' => 0, 'Black' => 1, 'Red' => 2,
+ 'Green' => 3, 'Blue' => 4, 'Cyan' => 5,
+ 'Magenta' => 6, 'Yellow' => 7, 'Orange' => 8,
+ 'DarkGray' => 14, 'DarkGrey' => 14,
+ 'LightGray' => 15, 'LightGrey' => 15
+ },
+ Symbol => {
+ 'Square' => 0, 'Dot' => 1, 'Plus' => 2,
+ 'Asterisk' => 3, 'Circle' => 4, 'Cross' => 5,
+ 'Triangle' => 7, 'Earth' => 8, 'Sun' => 9,
+ 'Diamond' => 11, 'Star' => 12, Default => 17
+ },
+ ITF => {
+ 'Linear' => 0, 'Log' => 1, 'Sqrt' => 2
+ },
+ LineStyle => {
+ 'Solid' => 1, 'Dashed' => 2, 'Dot-Dash' => 3,
+ 'Dotted' => 4, 'Dash-Dot-Dot' => 5,
+ '-' => 1, '--' => 2, '.-' => 3, '.' => 4,
+ '-..' => 5
+ },
+ Font => {
+ Normal => 1, Roman => 2,Italic => 3, Script => 4
+ },
+ Fill => {
+ Solid => 1, Outline => 2, Hatched => 3,
+ Cross_Hatched => 4, CrossHatched => 4
+ },
+ };
+
+ my $wt = {
+ # valid values for axis parameter (eg env())
+ Axis => {
+ Empty => '', Box => 'BC', Normal => 'BCNST',
+ Axes => 'ABCNST', Grid => 'ABCGNST',
+ LogX => ['BCLNST', 'BCNST'],
+ LogY => ['BCNST', 'BCLNST'],
+ LogXY => ['BCLNST', 'BCLNST'],
+ '-2' => '', '-1' => 'BC', '0' => 'BCNST',
+ '1' => 'ABCNST', '2' => 'ABCGNST',
+ '10' => ['BCLNST', 'BCNST'],
+ '20' => ['BCNST', 'BCLNST'],
+ '30' => ['BCLNST', 'BCLNST']
+ },
+ AxisColour => {
+ 'White' => 0, 'Black' => 1, 'Red' => 2,
+ 'Green' => 3, 'Blue' => 4, 'Cyan' => 5,
+ 'Magenta' => 6, 'Yellow' => 7, 'Orange' => 8,
+ 'DarkGray' => 14, 'DarkGrey' => 14,
+ 'LightGray' => 15, 'LightGrey' => 15
+ },
+ HardFont => {
+ Normal => 1, Roman => 2,Italic => 3, Script => 4
+ },
+ HardAxisColour => {
+ 'White' => 0, 'Black' => 1, 'Red' => 2,
+ 'Green' => 3, 'Blue' => 4, 'Cyan' => 5,
+ 'Magenta' => 6, 'Yellow' => 7, 'Orange' => 8,
+ 'DarkGray' => 14, 'DarkGrey' => 14,
+ 'LightGray' => 15, 'LightGrey' => 15
+ }
+ };
+
+
+ # Set up the two primary sets of options for PGPLOT commands.
+ my $window_options = PDL::Options->new($wo);
+ $window_options->translation($wt);
+
+ my $general_options = PDL::Options->new($o);
+ $general_options->translation($t);
+ $general_options->synonyms($s);
+
+ return ($general_options, $window_options);
+
+}
+
+
+=head2 set_pgplot_options
+
+This function allows the user to set the default PGPLOT options. It
+is particularly useful in the C<.perldlrc> file since one can do
+
+ use PDL::Graphics::PGPLOTOptions ('set_pgplot_options');
+ set_pgplot_options('Device' => '/xs', 'HardLW' => 3);
+
+for instance to set the default values. The main drawback is that the
+routine is rather unflexible with no synonyms or case-insensitivity.
+
+=cut
+
+sub set_pgplot_options {
+ my %o;
+ if (ref($_[0]) eq 'HASH') {
+ %o = %{$_[0]};
+ } else {
+ %o = @_;
+ }
+
+ foreach my $k (keys %o) {
+ if (exists($options{$k})) {
+ $options{$k} = $o{$k};
+ } elsif ($k =~ /Color/) {
+ my $knew = $k;
+ $knew =~ s/Color/Colour/;
+ if (!exists($options{$knew})) {
+ warn "Option $k is not recognised!\n";
+ } else {
+ $options{$knew} = $o{$k};
+ }
+ } else {
+ warn "Option $k is not recognised!\n";
+ }
+ }
+
+}
+
+
+1;
diff --git a/Graphics/PGPLOT/Window/Makefile.PL b/Graphics/PGPLOT/Window/Makefile.PL
new file mode 100644
index 0000000..c0ef4c9
--- /dev/null
+++ b/Graphics/PGPLOT/Window/Makefile.PL
@@ -0,0 +1,16 @@
+
+# Makefile.PL for PDL::Graphics::PGPLOT module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+
+WriteMakefile(
+ 'NAME' => 'PDL::Graphics::PGPLOT::Window',
+ 'VERSION_FROM' => '../../../Basic/Core/Version.pm',
+ 'INC' => '-I../../../Basic/Core/', # for ppport.h
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
diff --git a/Graphics/PGPLOT/Window/Window.pm b/Graphics/PGPLOT/Window/Window.pm
new file mode 100644
index 0000000..3616217
--- /dev/null
+++ b/Graphics/PGPLOT/Window/Window.pm
@@ -0,0 +1,7097 @@
+=head1 NAME
+
+PDL::Graphics::PGPLOT::Window - A OO interface to PGPLOT windows
+
+=head1 SYNOPSIS
+
+ pdl> use PDL::Graphics::PGPLOT::Window
+ pdl> $win = pgwin(Device => '/xs');
+ pdl> $a = pdl [1..100]
+ pdl> $b = sqrt($a)
+ pdl> $win->line($b)
+ pdl> $win->hold()
+ pdl> $c = sin($a/10)*2 + 4
+ pdl> $win->line($c)
+
+In the following documentation the commands are not shown in their OO
+versions. This is for historical reasons and should not cause too much
+trouble.
+
+=head1 DESCRIPTION
+
+This package offers a OO interface to the PGPLOT plotting package. This
+is intended to replace the traditional interface in
+L<PDL::Graphics::PGPLOT|PDL::Graphics::PGPLOT>
+and contains interfaces to a large number of PGPLOT routines. Below the
+usage examples for each function tend to be given in the non-OO version for
+historical reasons. This will slowly be changed, but in the meantime refer
+to the section on OO-interface below to see how to convert the usage
+information below to OO usage (it is totally trivial).
+
+PDL::Graphics::PGPLOT::Window is an interface to the PGPLOT graphical
+libraries. It currently supports PGPLOT-5.2 and PGPLOT-5.2-cd2. The
+-cd2 version includes RGB output and anti-aliasing.
+
+High-level plotting commands:
+
+ imag - Display an image (uses pgimag/pggray/pgrgbi as appropriate)
+ fits_imag - Display a FITS image in scientific coordinates
+ cont - Display image as contour map
+ fits_cont - Display a FITS image in scientific coordinates as a contour map
+ vect - Display 2 images as a vector field
+ fits_vect - Display 2 FITS images in sci. coordinates as a vector field
+ ctab - Load an image colour table
+ ctab_info - Get information about currently loaded colour table
+ line - Plot vector as connected points
+ tline - Plot a collection of vectors as lines
+ lines - Plot a polyline, multicolor vector [threadable]
+ points - Plot vector as points
+ tpoints - Plot a collection of vectors as points [threadable]
+ errb - Plot error bars
+ bin - Plot vector as histogram (e.g. bin(hist($data)) )
+ hi2d - Plot image as 2d histogram (not very good IMHO...)
+ tcircle - Plot vectors as circles [threadable]
+ label_axes - Print axis titles
+ legend - Create a legend with different texts, linestyles etc.
+
+Low-level plotting commands:
+
+ arrow - Draw an arrow
+ poly - Draw a polygon
+ rectangle - Draw a rectangle
+ text - Write text in the plot area
+ cursor - Interactively read cursor positions.
+ circle - Draw a circle
+ ellipse - Draw an ellipse.
+
+Device manipulation commands:
+
+ new - Construct a new output device
+ pgwin - Exported hook to new()
+ close - Close a PGPLOT output device.
+ hold - Hold current plot window range - allows overlays etc.
+ release - Release back to freshly autoscaling for each command.
+ held - Indicates whether the current window is held.
+ focus - Set focus to the given device.
+ erase - Erase the current window (or panel).
+ options - Get the options set for the present output device.
+ id - The ID for the device.
+ device - The device type.
+ name - The window name.
+
+Notes: C<$transform> for image/cont etc. is used in the same way as the
+C<TR()> array in the underlying PGPLOT FORTRAN routine but is, fortunately,
+zero-offset. The L<transform()|/transform> routine can be used to create this piddle.
+
+For completeness: The transformation array connect the pixel index to a
+world coordinate such that:
+
+ X = tr[0] + tr[1]*i + tr[2]*j
+ Y = tr[3] + tr[4]*i + tr[5]*j
+
+=head2 Variable passing and extensions
+
+In general variables are passed to the pgplot routines by using
+C<get_dataref>
+to get the reference to the values. Before passing to pgplot routines
+however, the data are checked to see if they are in accordance with the
+format (typically dimensionality) required by the PGPLOT routines.
+This is done using the routine C<checkarg> (internal to PGPLOT). This routine
+checks the dimensionality of the input data. If there are superfluous
+dimensions of size 1 they will be trimmed away until the dimensionality
+is correct. Example:
+
+Assume a piddle with dimensions (1,100,1,1) is passed to C<line>, which
+expects its inputs to be vectors. C<checkarg> will then return a piddle
+with dimensions (100). If instead the same piddle was passed to C<imag>,
+which requires 2D piddles as output, C<checkarg> would return a piddle
+with dimensionality (100, 1) (Dimensions are removed from the I<start>)
+
+Thus, if you want to provide support for another PGPLOT function, the
+structure currently look like this (there are plans to use the Options
+package to simplify the options parsing):
+
+ # Extract the hash(es) on the commandline
+ ($arg, $opt)=_extract_hash(@_);
+ <Check the number of input parameters>
+ <deal with $arg>
+ checkarg($x, 3); # For a hypothetical 3D routine.
+ &catch_signals;
+ ...
+ pgcube($n, $x->get_dataref);
+ &release_signals;
+ 1;
+
+(the catch_signals/release_signals pair prevent problems with the perl-PGPLOT
+interface if the user hits c-C during an operation).
+
+=head2 Setting options
+
+All routines in this package take a hash with options as an optional
+input. This options hash can be used to set parameters for the
+subsequent plotting without going via the PGPLOT commands.
+
+This is implemented such that the plotting settings (such as line width,
+line style etc.) are affected only for that plot, any global changes made,
+say, with C<pgslw()> are preserved. Some modifications apply when using
+the OO interface, see below.
+
+=head2 Alphabetical listing of standard options
+
+The following options are always parsed. Whether they have any importance
+depend on the routine invoked - e.g. line style is irrelevant for C<imag>,
+or the C<justify> option is irrelevant if the display is on 'hold'.
+This is indicated in the help text for the commands below.
+
+The options are not case sensitive and will match for unique substrings,
+but this is not encouraged as obscure options might invalidate what
+you thought was a unique substring.
+
+In the listing below examples are given of each option. The actual
+option can then be used in a plot command by specifying it as an argument
+to the function wanted (it can be placed anywhere in the command list).
+
+E.g:
+
+ $opt={COLOR=>2};
+ line $x, $y, $opt; # This will plot a line with red color
+
+If you are plotting to a hardcopy device then a number of
+options use a different name:
+
+ HardLW instead of LineWidth
+ HardCH instead of CharSize
+ HardFont instead of Font
+
+ HardAxisColour instead of AxisColour
+ HardColour instead of Colour
+
+[although I'm not sure when HardColour is actually used]
+
+=over 4
+
+=item align
+
+If C<pix> is set, then images and plots are not stretched to fill the plot
+area. the C<align> string tells how to align them within the available
+area. 'L' and 'R' shove the plot against the left and right edges,
+respectively; 'B' and 'T' shove the plot against the bottom and top
+edges. The default is to center the image. e.g. 'BL' puts the image
+on the bottom left corner, while 'CT' centers the image horizontally
+while placing it at the top of the available plot area. This defaults
+to 'BT' for non-justified images, to 'CC' for justified images.
+
+=item arrow
+
+This options allows you to set the arrow shape, and optionally size for
+arrows for the vect routine. The arrow shape is specified as a hash
+with the key FS to set fill style, ANGLE to set the opening angle of
+the arrow head, VENT to set how much of the arrow head is cut out and
+SIZE to set the arrowsize.
+
+The following
+
+ $opt = {ARROW => {FS=>1, ANGLE=>60, VENT=>0.3, SIZE=>5}};
+
+will make a broad arrow of five times the normal size.
+
+Alternatively the arrow can be specified as a set of numbers
+corresponding to an extention to the syntax for pgsah. The equivalent to
+the above is
+
+ $opt = {ARROW => pdl([1, 60, 0.3, 5})};
+
+For the latter the arguments must be in the given order, and if any are
+not given the default values of 1, 45, 0.3 and 1.0 respectively will
+be used.
+
+=item arrowsize
+
+The arrowsize can be specified separately using this option to the
+options hash. It is useful if an arrowstyle has been set up and one
+wants to plot the same arrow with several sizes. Please note that it is
+B<not> possible to set arrowsize and character size in the same call to
+a plotting function. This should not be a problem in most cases.
+
+ $opt = {ARROWSIZE => 2.5};
+
+=item axis
+
+Set the axis value (see L</env>). If you pass in a scalar you set the
+axis for the whole plot. You can also pass in an array ref for finer
+control of the axes.
+
+If you set the option to a scalar value, you get one of a few standard layouts.
+You can specify them by name or by number:
+
+ EMPTY (-2) draw no box, axes or labels
+ BOX (-1) draw box only
+ NORMAL (0) draw box and label it with coordinates
+ AXES (1) same as NORMAL, but also draw (X=0,Y=0) axes
+ GRID (2) same as AXES, but also draw grid lines
+ LOGX (10) draw box and label X-axis logarithmically
+ LOGY (20) draw box and label Y-axis logarithmically
+ LOGXY (30) draw box and label both axes logarithmically
+
+When using logarithmic axes (C<LOGX>, C<LOGY> and C<LOGXY>) you normally
+need to log the data yourself, e.g.
+
+ line $x->log10, $y, {axis=>'LOGX'};
+
+For your convenience you can put PDL::Graphics::PGPLOT into
+autolog mode. In this mode a call to C<line> or C<points>
+will log the data for you and you can pass in the unmodified
+data, e.g.
+
+ autolog(1); # enable automatic logarithm calculation
+ line $x, $y, {axis=>'LOGX'}; # automatically displays logged x data
+
+You can use the function interface to enable autologging:
+
+ autolog(1);
+
+or use it with a window reference (mode switching on a per window basis)
+
+ $win->autolog(1);
+
+C<autolog> without arguments returns the current autolog setting (0=off,
+1=on).
+
+If you set the C<AXIS> option to an array ref, then you can specify the
+box/axis options separately for the horizontal (ordinate; X
+coordinate; 0th element) and vertical (abscissa; Y coordinate; 1st element))
+axes. Each element of the array ref should contain a PGPLOT format string.
+Presence or absence of specific characters flags particular options. For
+normal numeric labels, the options are:
+
+ A : draw axis for this dimension.
+ B : draw bottom (X) or left (Y) edge of frame.
+ C : draw top (X) or right (Y) edge of frame.
+ G : draw Grid of vertical (X) or horizontal (Y) lines.
+ I : Invert ticks: draw them outside the plot rather than inside.
+ L : Label the axis Logarithmically.
+ P : Extend ("Project") major tick marks outside the box.
+ M : Numeric labels go in the alternate place above (X) or to the
+ right (Y) of the viewport.
+ N : Numeric labels go in the usual location below (X) or to the
+ left (Y) of the viewport
+ T : Draw major tick marks at the major coordinate interval.
+ S : Draw minor tick marks (subticks).
+ V : Orient numeric labels Vertically. Only applicable to Y.
+ (The default is to write them parallel to the axis.)
+ 1 : Force decimal labelling, instead of automatic choice
+ 2 : Force exponential labeling, instead of automatic.
+
+If you don't specify any axis value at all, the default is ['BCNST','BCNST']
+for plots and ['BCINST','BCINST'] for images. (These list ref elements are
+handed on directly to the low-level PGPLOT routines).
+
+In addition, you can specify that your axis labels should be printed
+as days, hours, minutes, and seconds (ideal for julian dates and delta-t,
+or for angular quantities). You do that by setting additional character
+flags on the affected axis:
+
+ X : Use HH MM SS.S time labeling rather than conventional numeric
+ labels. The ordinate is in secsonds. Hours roll over at 24.
+ Y : Like 'X' but the hour field runs past 24 if necessary.
+ Z : Like 'X' but with a days field too (only shown where nonzero).
+ H : Label the numbers with superscript d, h, m, and s symbols.
+ D : Label the numbers with superscript o, ', and '' symbols.
+ F : Omit first (lowest/leftmost) label; useful for tight layouts.
+ O : Omit leading zeroes in numbers under 10 (e.g. " 3h 3m 1.2s"
+ rather than "03h 03m 01.2s").
+
+For example, to plot a numeric quantity versus Julian day of the year
+in a standard boxed plot with tick marks, you can use ["BNCSTZHO","BCNST"].
+
+=item border
+
+Normally the limits are
+chosen so that the plot just fits; with this option you can increase
+(or decrease) the limits by either a relative
+(ie a fraction of the original axis width) or an absolute amount.
+Either specify a hash array, where the keys are C<TYPE> (set to
+'relative' or 'absolute') and C<VALUE> (the amount to change the limits
+by), or set to 1, which is equivalent to
+
+ BORDER => { TYPE => 'rel', VALUE => 0.05 }
+
+=item charsize
+
+Set the character/symbol size as a multiple of the standard size.
+
+ $opt = {CHARSIZE => 1.5}
+
+The HardCH option should be used if you are plotting to a hardcopy device.
+
+=item colour (or color)
+
+Set the colour to be used for the subsequent plotting. This can be
+specified as a number, and the most used colours can also be specified
+with name, according to the following table (note that this only works for
+the default colour map):
+
+ 0 - WHITE 1 - BLACK 2 - RED 3 - GREEN 4 - BLUE
+ 5 - CYAN 6 - MAGENTA 7 - YELLOW 8 - ORANGE 14 - DARKGRAY
+ 16 - LIGHTGRAY
+
+However there is a much more flexible mechanism to deal with colour.
+The colour can be set as a 3 or 4 element anonymous array (or piddle)
+which gives the RGB colours. If the array has four elements the first
+element is taken to be the colour index to change. For normal work you
+might want to simply use a 3 element array with R, G and B values and
+let the package deal with the details. The R,G and B values go from 0
+to 1.
+
+In addition the package will also try to interpret non-recognised
+colour names using the default X11 lookup table, normally using the
+C<rgb.txt> that came with PGPLOT.
+
+For more details on the handling of colour it is best that the user
+consults the PGPLOT documentation. Further details on the handling of
+colour can be found in the documentation for the internal routine
+L</_set_colour>.
+
+The HardColour option should be used if you are plotting to a hardcopy device
+[this may be untrue?].
+
+=item diraxis
+
+This sets the direction of the axes of a plot or image, when you don't explitly
+set them with the XRange and YRange options. It's particularly useful when
+you want (for example) to put long wavelengths (larger numbers) on the left
+hand side of your plot, or when you want to plot an image in (RA,dec)
+coordinates.
+
+You can use either a scalar or a two-element perl array. If you set it to
+0 (the default) then PDL will guess which direction you want to go. If you
+set it to a positive number, the axis will always increase to the right. If
+you set it to a negative number, the axis will always increase to the left.
+
+For example, [0,0] is the default, which is usually right. [1,1] tells
+PGPLOT to always increase the axis values up and to the right. For a
+plot of intensity (y-axis) versus wavelength (x-axis) you could say
+[-1,1].
+
+This option is really only useful if you want to allow autoranging but
+need to set the direction that the axis goes. If you use the ranging
+options (C<XRange> and C<YRange>), you can change the direction by changing
+the order of the maximum and minimum values. That direction will
+override C<DirAxis>.
+
+=item filltype
+
+Set the fill type to be used by L</poly>, L</circle>,
+L</ellipse>, and L</rectangle>
+The fill can either be specified using numbers or name, according to the
+following table, where the recognised name is shown in capitals - it is
+case-insensitive, but the whole name must be specified.
+
+ 1 - SOLID
+ 2 - OUTLINE
+ 3 - HATCHED
+ 4 - CROSS_HATCHED
+
+ $opt = {FILLTYPE => 'SOLID'};
+
+(see below for an example of hatched fill)
+
+=item font
+
+Set the character font. This can either be specified as a number following
+the PGPLOT numbering or name as follows (name in capitals):
+
+ 1 - NORMAL
+ 2 - ROMAN
+ 3 - ITALIC
+ 4 - SCRIPT
+
+(Note that in a string, the font can be changed using the escape sequences
+C<\fn>, C<\fr>, C<\fi> and C<\fs> respectively)
+
+ $opt = {FONT => 'ROMAN'};
+
+gives the same result as
+
+ $opt = {FONT => 2};
+
+The HardFont option should be used if you are plotting to a hardcopy device.
+
+=item hatching
+
+Set the hatching to be used if either fillstyle 3 or 4 is selected
+(see above) The specification is similar to the one for specifying
+arrows. The arguments for the hatching is either given using a hash
+with the key ANGLE to set the angle that the hatch lines will make
+with the horizontal, SEPARATION to set the spacing of the hatch lines
+in units of 1% of C<min(height, width)> of the view surface, and PHASE to
+set the offset the hatching. Alternatively this can be specified as a
+1x3 piddle C<$hatch=pdl[$angle, $sep, $phase]>.
+
+ $opt = {FILLTYPE => 'HATCHED',
+ HATCHING => {ANGLE=>30, SEPARATION=>4}};
+
+Can also be specified as
+
+ $opt = {FILL=> 'HATCHED', HATCH => pdl [30,4,0.0]};
+
+For another example of hatching, see L</poly>.
+
+=item justify
+
+If C<justify> is set true, then the plot axes are shrunk to fit
+the plot or image and it specifies the aspect ratio of pixel
+coordinates in the plot or image. Setting justify=>1 will
+produce a correct-aspect-ratio, shrink-wrapped image or plot;
+setting justify=>0.5 will do the same thing but with a short and
+fat plot. The difference between C<justify> and C<pix> is that
+C<pix> does not affect the shape of the axes themselves.
+
+=item linestyle
+
+Set the line style. This can either be specified as a number following
+the PGPLOT numbering:
+
+ 1 - SOLID line
+ 2 - DASHED
+ 3 - DOT-DASH-dot-dash
+ 4 - DOTTED
+ 5 - DASH-DOT-DOT-dot
+
+or using name (as given in capitals above).
+Thus the following two specifications both specify the line to be dotted:
+
+ $opt = {LINESTYLE => 4};
+ $varopt = {LINESTYLE => 'DOTTED'};
+
+The names are not case sensitive, but the full name is required.
+
+=item linewidth
+
+Set the line width. It is specified as a integer multiple of 0.13 mm.
+
+ $opt = {LINEWIDTH => 10}; # A rather fat line
+
+The HardLW option should be used if you are plotting to a hardcopy device.
+
+=item pitch
+
+Sets the number of data pixels per inch on the output device.
+You can set the C<unit> (see below) to change this to any other
+PGPLOT unit (millimeters, pixels, etc.). Pitch is device independent,
+so an image should appear exactly the same size (e.g. C<Pitch=E<gt>100>
+is 100 dpi) regardless of output device.
+
+=item pix
+
+Sets the pixel aspect ratio height/width. The height is adjusted
+to the correct ratio, while maintaining any otherwise-set pitch or scale
+in the horizontal direction. Larger numbers yield tall, skinny pixels;
+smaller numbers yield short, fat pixels.
+
+=item scale
+
+Sets the number of output display pixels per data pixel. You can set
+the C<unit> (see below) to change this to number of PGPLOT units
+(inches, millimeters, etc.) per data pixel. C<scale> is deprecated,
+as it is not device-independent; but it does come in handy for quick
+work on digital displays, where aliasing might otherwise interfere
+with image interpretation. For example, C<scale=E<gt>1> displays
+images at their native resolution.
+
+=item Panel
+
+It is possible to define multiple plot ``panels'' with in a single
+window (see the L<NXPanel and NYPanel options in the
+constructor|/new>). You can explicitly set
+in which panel most plotting commands occur, by passing either a
+scalar or an array ref into the C<Panel> option. There is also a
+L<panel|PDL::Graphics::PGPLOT/panel> method, but its use is deprecated
+because of a wart with the PGPLOT interface.
+
+=item plotting & imaging range
+
+Explicitly set the plot range in x and y. X-range and Y-range are set
+separately via the aptly named options C<XRange> and C<YRange>. If omitted
+PGPLOT selects appropriate defaults (minimum and maximum of the data range
+in general). These options are ignored if the window is on hold.
+
+ line $x, $y, {xr => [0,5]}; # y-range uses default
+ line $x, $y, {XRange => [0,5], YRange => [-1,3]}; # fully specified range
+ imag $im, {XRange => [30,50], YRange=>[-10,30]};
+ fits_imag $im, {XRange=>[-2,2], YRange=>[0,1]};
+
+Imaging requires some thought if you don't want to lose a pixel off
+the edge of the image. Pixels are value-centered (they are centered
+on the coordinate whose value they represent), so the appropriate
+range to plot the entirety of a 100x100 pixel image is C<[-0.5,99.5]> on
+each axis.
+
+=back
+
+=head1 OBJECT-ORIENTED INTERFACE
+
+This section will briefly describe how the PDL::Graphics::PGPLOT::Window
+package can be used in an object-oriented (OO) approach and what the
+advantages of this would be. We will start with the latter
+
+=over
+
+=item Multiple windows.
+
+For the common user it is probably most interesting to use the OO interface
+when handling several open devices at the same time. If you have one
+variable for each plot device it is easier to distribute commands to the
+right device at the right time. This is the angle we will take in the rest
+of this description.
+
+=item Coding and abstraction
+
+At a more fundamental level it is desirable to approach a situation where
+it is possible to have a generic plotting interface which gives access
+to several plotting libraries, much as PGPLOT gives access to different
+output devices. Thus in such a hypothetical package one would say:
+
+ my $win1 = Graphics::new('PGPLOT', {Device => '/xs'});
+ my $win2 = Graphics::new('gnuplot', {Background => 'Gray'};
+
+From a more practical point of of view such abstraction also comes in
+handy when you write a large program package and you do not want to import
+routines nilly-willy in which case an OO approach with method calls is a
+lot cleaner.
+
+The pgwin exported constructor, arguably, breaks this philosophy; hopefully
+it will ``wither away'' when other compatible modules are available.
+
+=back
+
+Anyway, enough philosophizing, let us get down to Earth and give some
+examples of the use of OO PGPLOT. As an example we will take Odd (which
+happens to be a common Norwegian name) who is monitoring the birth of
+rabbits in O'Fib-o-nachy's farm (alternatively he can of course be
+monitoring processes or do something entirely different). Odd wants the
+user to be able to monitor both the birth rates and accumulated number
+of rabbits and the spatial distribution of the births. Since these are
+logically different he chooses to have two windows open:
+
+ $rate_win = PDL::Graphics::PGPLOT::Window->new(Device => '/xw',
+ Aspect => 1, WindowWidth => 5, NXPanel => 2);
+
+ $area_win = PDL::Graphics::PGPLOT::Window->new(Device => '/xw',
+ Aspect => 1, WindowWidth => 5);
+
+See the documentation for L<new|/new> below for a full overview of the
+options you can pass to the constructor.
+
+Next, Odd wants to create plotting areas for subsequent plots and maybe
+show the expected theoretical trends
+
+ $rate_win->env(0, 10, 0, 1000, {XTitle => 'Days', YTitle => '#Rabbits'});
+ $rate_win->env(0, 10, 0, 100, {Xtitle=>'Days', Ytitle => 'Rabbits/day'});
+
+ $area_win->env(0, 1, 0, 1, {XTitle => 'Km', Ytitle => 'Km'});
+ # And theoretical prediction.
+ $rate_win->line(sequence(10), fibonacci(10), {Panel => [1, 1]});
+
+That is basically it. The commands should automatically focus the relevant
+window. Due to the limitations of PGPLOT this might however lead you to
+plot in the wrong panel... The package tries to be smart and do this
+correctly, but might get it wrong at times.
+
+=head1 STATE and RECORDING
+
+A new addition to the graphics interface is the ability to record plot
+commands. This can be useful when you create a nice-looking plot on the
+screen that you want to re-create on paper for instance. Or if you want
+to redo it with slightly changed variables for instance. This is still
+under development and views on the interface are welcome.
+
+The functionality is somewhat detached from the plotting functions
+described below so I will discuss them and their use here.
+
+Recording is off by default. To turn it on when you create a new
+device you can set the C<Recording> option to true, or you can set
+the C<$PDL::Graphics::PGPLOT::RECORDING> variable to 1. I recommend doing the
+latter in your C<.perldlrc> file at least since you will often have use
+for recording in the perldl or pdl2 script.
+
+=head2 Use of recording
+
+The recording is meant to help you recreate a plot with new data or
+to a different device. The most typical situation is that you have
+created a beautiful plot on screen and want to have a Postscript file
+with it. In the dreary old world you needed to go back and execute all
+commands manually, but with this wonderful new contraption, the recorder,
+you can just replay your commands:
+
+ dev '/xs', {Recording => 1}
+ $x = sequence(10)
+ line $x, $x**2, {Linestyle => 'Dashed'}
+ $s = retrieve_state() # Get the current tape out of the recorder.
+ dev '/cps'
+ replay $s
+
+This should result in a C<pgplot.ps> file with a parabola drawn with a
+dashed line. Note the command C<retrieve_state> which retrieves the current
+state of the recorder and return an object (of type PDL::Graphics::State)
+that is used to replay commands later.
+
+=head2 Controlling the recording
+
+Like any self-respecting recorder you can turn the recorder on and off
+using the C<turn_on_recording> and C<turn_off_recording> respectively.
+Likewise you can clear the state using the C<clear_state> command.
+
+ $w=PDL::Graphics::PGPLOT::Window->new(Device => '/xs');
+ $w->turn_on_recording;
+ $x=sequence(10); $y=$x*$x;
+ $w->line($x, $y);
+ $w->turn_off_recording;
+ $w->line($y, $x);
+ $w->turn_on_recording;
+ $w->line($x, $y*$x);
+ $state = $w->retrieve_state();
+
+We can then replay C<$state> and get a parabola and a cubic plot.
+
+ $w->replay($state);
+
+=head2 Tips and Gotchas!
+
+The data are stored in the state object as references to the real
+data. This leads to one good and one potentially bad consequence:
+
+=over
+
+=item The good is that you can create the plot and then subsequently
+redo the same plot using a different set of data. This is best explained
+by an example. Let us first create a simple gradient image and get
+a copy of the recording:
+
+ $im = sequence(10,10)
+ imag $im
+ $s=retrieve_state
+
+Now this was a rather dull plot, and in reality we wanted to show an
+image using C<rvals>. Instead of re-creating the plot (which of course
+here would be the simplest option) we just change C<$im>:
+
+ $im -= sequence(10,10)
+ $im += rvals(10,10)
+
+Now replay the commands
+
+ replay $s
+
+And hey presto! A totally different plot. Note however the trickery
+required to avoid losing reference to C<$im>
+
+=item This takes us immediately to the major problem with the recording
+though. Memory leakage! Since the recording keeps references to the data
+it can keep data from being freed (zero reference count) when you expect
+it to be. For instance, in this example, we lose totally track of the
+original $im variable, but since there is a reference to it in the state
+it will not be freed
+
+ $im = sequence(1000,1000)
+ imag $im
+ $s = retrieve_state
+ $im = rvals(10,10)
+
+Thus after the execution of these commands we still have a reference to
+a 1000x1000 array which takes up a lot of memory...
+
+The solution is to call C<clear> on the state variable:
+
+ $s->clear()
+
+(This is done automatically if the variable goes out of scope). I forsee
+this problem to most acute when working on the C<perldl> or C<pdl2>
+command line, but since this is exactly where the recording is most useful
+the best advice is just to be careful and call clear on state variables.
+
+If you are working with scripts and use large images for instance I would
+instead recommend that you do not turn on recording unless you need it.
+
+=back
+
+
+
+
+=head1 FUNCTIONS
+
+A more detailed listing of the functions and their usage follows. For
+all functions we specify which options take effect and what other options
+exist for the given function. The function descriptions below are all
+given for the non-OO usage for historical reasons, but since the conversion
+to an OO method is trivial there is no major need for concern. Whenever you
+see a function example of the form
+
+ Usage: a_simple_function($x, $y, $z [, $opt]);
+
+and you wish to use the OO version, just let your mind read the above line
+as:
+
+ Usage: $win->a_simple_function($x, $y, $z [, $opt]);
+
+where C<$win> is a PDL::Graphics::PGPLOT::Window object. That is all.
+
+
+=head2 Window control functions.
+
+=head2 pgwin
+
+=for ref
+
+Exported constructor for PGPLOT object/device/plot window.
+
+=for usage
+
+ Usage: pgwin($opt);
+ Usage: pgwin($option->$value,...);
+ Usage: pgwin($device);
+
+Parameters are passed on to new() and can either be specified by hash
+reference or as a list.
+
+See the documentation fo PDL::Graphics::PGPLOT::Window::new for details.
+
+Because pgwin is a convenience function, you can specify the device by
+passing in a single non-ref parameter. For even further convenience, you
+can even omit the '/' in the device specifier, so these two lines
+deliver the same result:
+
+ $a = pgwin(gif);
+ $a = new PDL::Graphics::PGPLOT::Window({Dev=>'/gif'});
+
+=head2 new
+
+=for ref
+
+Constructor for PGPLOT object/device/plot window.
+
+=for usage
+
+ Usage: PDL::Graphics::PGPLOT::Window->new($opt);
+ Usage: PDL::Graphics::PGPLOT::Window->new($option=>$value,...);
+
+Options to new() can either be specified via a reference to a hash
+
+ $win = PDL::Graphics::PGPLOT::Window->new({Dev=>'/xserve',ny=>2});
+
+or directly, as an array
+
+ # NOTE: no more {} !
+ $win = PDL::Graphics::PGPLOT::Window->new(Dev=>'/xserve',ny=>2);
+
+The following lists the recognised options:
+
+=over
+
+=item AspectRatio
+
+The aspect ratio of the image, in the sense vertical/horizontal.
+See the discussion on size setting.
+
+=item Device
+
+The type of device to use. The syntax of this is the one used by PGPLOT.
+
+=item Hold
+
+Hold the plot window so that subsequent plots can plot over existing plots.
+This can be adjusted with the C<hold()> and C<release()> methods.
+
+=item NXPanel
+
+The number of panels in the X-direction
+
+=item NYPanel
+
+The number of panels in the Y-direction
+
+=item Size
+
+Yet another way to identify the plot window size -- this takes a scalar
+or an array ref containing one, two, or three numbers. One number gives
+you a square window. Two gives you a rectangular window C<(X,Y)>. Three
+lets you specify the unit compactly (e.g. C<< [<X>,<Y>,1] >> for inches,
+C<< [<X>,<Y>,2] >> for mm) but is deprecated in favor of using the
+C<Unit> option.
+See the discussion on size setting.
+
+=item Unit
+
+The unit to use for size setting. PGPLOT accepts inch, mm, or pixel.
+The default unit is inches for historical reasons, but you can choose
+millimeters or (God forbid) pixels as well. String or numeric
+specifications are OK (0=normalized, 1=inches, 2=mm, 3=pixels).
+Normalized units make no sense here and are not accepted. Ideally
+someone will one day hook this into the CPAN units parser so you can
+specify window size in rods or attoparsecs.
+
+=item WindowName
+
+The name to give to the window. No particular use is made of this at present.
+It would be great if it was possible to change the title of the window frame.
+
+=item WindowWidth
+
+The width of the window in inches (or the specified Unit). See the
+discussion on size setting.
+
+=item WindowXSize and WindowYSize
+
+The width and height of the window in inches (or the specified Unit). See
+the discussion on size setting.
+
+=back
+
+An important point to note is that the default values of most options can be
+specified by passing these to the constructor. All general options (common to
+several functions) can be adjusted in such a way, but function specific
+options can not be set in this way (this is a design limitation which is
+unlikely to be changed).
+
+Thus the following call will set up a window where the default axis colour
+will be yellow and where plot lines normally have red colour and dashed
+linestyle.
+
+ $win = PDL::Graphics::PGPLOT::Window->new(Device => '/xs',
+ AxisColour => 'Yellow', Colour => 'Red', LineStyle => 'Dashed');
+
+
+Size setting: There are a gazillion ways to set window size, in
+keeping with TIMTOWTDI. In general you can get away with passing any
+unique combination of an C<< <X> >> size, a C<< <Y> >>size,
+and/or an aspect ratio.
+In increasing order of precedence, the options are: (C<Units>,
+C<AspectRatio>, C<WindowWidth>, C<< Window<X,Y>Size >>, C<Size>).
+
+So if you specify an AspectRatio *and* an X and a Y coordinate, the
+AspectRatio is ignored. Likewise, if you specify Units and a
+three-component Size, the Units option is ignored in favor of the
+numeric unit in the Size.
+
+If you don't specify enough information to set the size of the window,
+you get the default pane size and shape for that device.
+
+=head2 close
+
+=for ref
+
+Close a plot window
+
+=for usage
+
+ Usage: $win->close()
+
+Close the current window. This does not necessarily mean that the
+window is removed from your screen, but it does ensure that the
+device is closed.
+
+A message will be printed to STDOUT giving the name of the
+file created if the plot was made to a hardcopy device and
+C<$PDL::verbose> is true.
+
+=head2 held
+
+=for ref
+
+Check if a window is on hold
+
+=for usage
+
+ $is_held = $win->held();
+
+Function to check whether the window is held or not.
+
+
+=head2 hold
+
+=for ref
+
+Hold the present window.
+
+=for usage
+
+ Usage: $win->hold()
+
+Holds the present window so that subsequent plot commands overplots.
+
+
+=head2 panel
+
+=for ref
+
+Switch to a different panel
+
+=for usage
+
+ $win->panel(<num>);
+
+Move to a different panel on the plotting surface. Note that you will need
+to erase it manually if that is what you require.
+
+This routine currently does something you probably don't want, and hence is
+deprecated for most use: if you say
+
+ $win->panel(1);
+ $win->imag($image);
+
+then $image will actually be displayed in panel B<2>. That's because
+the main plotting routines such as line and imag all advance the panel
+when necessary. Instead, it's better to use the Panel option within
+plotting commands, if you want to set the panel explicitly.
+
+=head2 release
+
+=for ref
+
+Release a plot window.
+
+=for usage
+
+ $win->release()
+
+Release a plot window so that subsequent plot commands move to the next
+panel or erase the plot and create a new plot.
+
+=head2 erase
+
+=for ref
+
+Erase plot
+
+=for usage
+
+ $win->erase($opt);
+
+Erase a plot area. This accepts the option C<Panel> or alternatively a number
+or array reference which makes it possible to specify the panel to erase when
+working with several panels.
+
+=head2 Plotting functions
+
+=head2 env
+
+=for ref
+
+Define a plot window, and put graphics on 'hold'
+
+=for usage
+
+ $win->env( $xmin, $xmax, $ymin, $ymax, [$justify, $axis] );
+ $win->env( $xmin, $xmax, $ymin, $ymax, [$options] );
+
+C<$xmin>, C<$xmax>, C<$ymin>, C<$ymax> are the plot boundaries.
+C<$justify> is a boolean value (default is B<0>);
+if true the axes scales will be the same (see C<justify>).
+C<$axis> describes how the axes should be drawn (see
+C<axis>) and defaults to B<0>.
+
+If the second form is used, $justify and $axis can be set in the options
+hash, for example:
+
+ $win->env( 0, 100, 0, 50, {JUSTIFY => 1, AXIS => 'GRID',
+ CHARSIZE => 0.7} );
+
+In addition the following options can also be set for C<env>:
+
+=over
+
+=item PlotPosition
+
+The position of the plot on the page relative to the view surface in
+normalised coordinates as an anonymous array. The array should contain
+the lower and upper X-limits and then the lower and upper Y-limits. To
+place two plots above each other with no space between them you could do
+
+ $win->env(0, 1, 0, 1, {PlotPosition => [0.1, 0.5, 0.1, 0.5]});
+ $win->env(5, 9, 0, 8, {PlotPosition => [0.1, 0.5, 0.5, 0.9]});
+
+=item Axis, Justify, Border
+
+See the description of general options for these options.
+
+=item AxisColour
+
+Set the colour of the coordinate axes.
+
+=item XTitle, YTitle, Title, Font, CharSize
+
+Axes titles and the font and size to print them.
+
+=back
+
+=head2 label_axes
+
+=for ref
+
+Label plot axes
+
+=for usage
+
+ $win->label_axes(<xtitle>, <ytitle>, <plot title>, $options);
+
+Draw labels for each axis on a plot.
+
+=head2 imag
+
+=for ref
+
+Display an image (uses C<pgimag()>/C<pggray()> as appropriate)
+
+=for usage
+
+ $win->imag ( $image, [$min, $max, $transform], [$opt] )
+
+NOTES
+
+C<$transform> for image/cont etc. is used in the same way as the
+C<TR()> array in the underlying PGPLOT FORTRAN routine but is,
+fortunately, zero-offset. The L<transform()|/transform> routine can be used to
+create this piddle.
+
+If C<$image> is two-dimensional, you get a grey or pseudocolor image
+using the scalar values at each X,Y point. If C<$image> is
+three-dimensional and the third dimension has order 3, then it is
+treated as an RGB true-color image via L<rgbi|rgbi>.
+
+There are several options related to scaling. By default, the image
+is scaled to fit the PGPLOT default viewport on the screen. Scaling,
+aspect ratio preservation, and 1:1 pixel mapping are available. (1:1
+pixel mapping is useful for avoiding display artifacts, but it's not
+recommended for final output as it's not device-independent.)
+
+Here's an additional complication: the "pixel" stuff refers not
+(necessarily) to normal image pixels, but rather to I<transformed>
+image pixels. That is to say, if you feed in a transform matrix
+via the C<TRANSFORM> option, the C<PIX>, C<SCALE>,
+etc. options all refer to the
+transformed coordinates and not physical image pixels. That is a Good
+Thing because it, e.g., lets you specify plate scales of your output
+plots directly! See fits_imag for an example application. If you
+do not feed in a transform matrix, then the identity matrix is applied
+so that the scaling options refer to original data pixels.
+
+To draw a colour bar (or wedge), either use the C<DrawWedge> option,
+or the C<draw_wedge()> routine (once the image has been drawn).
+
+Options recognised:
+
+=over 3
+
+=item ITF
+
+the image transfer function applied to the pixel values.
+It may be one of 'LINEAR', 'LOG', 'SQRT' (lower case is
+acceptable). It defaults to 'LINEAR'.
+
+=item MIN
+
+Sets the minimum value to be used for calculation of the
+color-table stretch.
+
+=item MAX
+
+Sets the maximum value for the same.
+
+=item RANGE
+
+A more compact way to specify MIN and MAX, as a list:
+you can say "Range=>[0,10]" to scale the color table for
+brightness values between 0 and 10 in the iamge data.
+
+=item CRANGE
+
+Image values between MIN and MAX are scaled to an
+interval in normalized color domain space, on the
+interval [0,1], before lookup in the window's color
+table. CRANGE lets you use only a part of the color
+table by specifying your own range -- e.g. if you
+say "CRange=>[0.25,0.75]" then only the middle half
+of the pseudocolor space will be used. (See the
+writeup on ctab().)
+
+=item TRANSFORM
+
+The PGPLOT transform 'matrix' as a 6x1 vector for display
+
+=item DrawWedge
+
+set to 1 to draw a colour bar (default is 0)
+
+=item Wedge
+
+see the draw_wedge() routine
+
+=back
+
+The following standard options influence this command:
+
+ AXIS, BORDER, JUSTIFY, SCALE, PIX, PITCH, ALIGN, XRANGE, YRANGE
+
+=for example
+
+ To see an image with maximum size in the current window, but square
+ pixels, say:
+ $win->imag( $a, { PIX=>1 } );
+ An alternative approach is to try:
+ $win->imag( $a, { JUSTIFY=>1 } );
+ To see the same image, scaled 1:1 with device pixels, say:
+ $win->imag( $a, { SCALE=>1 } );
+ To see an image made on a device with 1:2 pixel aspect ratio, with
+ X pixels the same as original image pixels, say
+ $win->imag( $a, { PIX=>0.5, SCALE=>2 } );
+ To display an image at 100 dpi on any device, say:
+ $win->imag( $a, { PITCH=>100 } );
+ To display an image with 100 micron pixels, say:
+ $win->imag( $a, { PITCH=>10, UNIT=>'mm' } );
+
+=head2 imag1
+
+=for ref
+
+Display an image with correct aspect ratio
+
+=for usage
+
+ $win->imag1 ( $image, [$min, $max, $transform], [$opt] )
+
+This is syntactic sugar for
+
+ $win->imag( { PIX=>1, ALIGN=>'CC' } );
+
+=head2 rgbi
+
+=for ref
+
+Display an RGB color image
+
+The calling sequence is exactly like L</imag>, except that the input
+image must have three dimensions: C<N x M x 3>. The last dimension is the
+(R,G,B) color value. This routine requires B<pgplot 5.3devel> or later.
+Calling rgbi explicitly is not necessary, as calling image with an
+appropriately dimensioned RGB triplet makes it fall through to rgbi.
+
+=head2 fits_imag
+
+=for ref
+
+Display a FITS image with correct axes
+
+=for usage
+
+ $win->fits_imag( image, [$min, $max], [$opt] );
+
+NOTES
+
+=over 3
+
+=item Titles:
+
+Currently fits_imag also generates titles for you by default and appends the
+FITS header scientific units if they're present. So if you say
+
+ $pdl->hdr->{CTYPE1} = "Flamziness";
+ $pdl->hdr->{CUNIT1} = "milliBleems";
+ $win->fits_imag($pdl);
+
+then you get an X title of "Flamziness (milliBleems)". But you can (of course)
+override that by specifying the XTitle and YTitle switches:
+
+ $win->fits_imag($pdl,{Xtitle=>"Arbitrary"});
+
+will give you "Arbitrary" as an X axis title, regardless of what's in the
+header.
+
+=item Scaling and aspect ratio:
+
+If CUNIT1 and CUNIT2 (or, if they're missing, CTYPE1 and CTYPE2)
+agree, then the default pixel aspect ratio is 1 (in scientific units,
+NOT in original pixels). If they don't agree (as for a spectrum)
+then the default pixel aspect ratio is adjusted automatically to
+match the plot viewport and other options you've specified.
+
+You can override the image scaling using the SCALE, PIX, or PITCH
+options just as with L<the imag() method|/imag> -- but
+those parameters refer to the scientific coordinate system rather than
+to the pixel coordinate system (e.g. C<PITCH=E<gt>100> means "100 scientific units
+per inch", and C<SCALE=E<gt>1> means "1 scientific unit per device pixel"). See
+L<the imag() writeup|/imag> for more info on these
+options.
+
+The default value of the C<ALIGN> option is 'CC' -- centering the image
+both vertically and horizontally.
+
+=item Axis direction:
+
+By default, fits_imag tries to guess which direction your axes are meant
+to go (left-to-right or right-to-left) using the CDELT keywords:
+if C<< CDELT >>
+is negative, then rather than reflecting the image fits_imag will plot the
+X axis so that the highest values are on the left.
+
+This is the most convenient behavior for folks who use calibrated
+(RA,DEC) images, but it is technically incorrect. To force the direction,
+use the DirAxis option. Setting
+C<< DirAxis=>1 >> (abbreviated C<< di=>1 >>)
+will force the scientific axes to increase to the right, reversing the image
+as necessary.
+
+=item Color wedge:
+
+By default fits_imag draws a color wedge on the right; you can explicitly
+set the C<DrawWedge> option to 0 to avoid this. Use the C<WTitle> option
+to set the wedge title.
+
+
+=item Alternate WCS coordinates:
+
+The default behaviour is to use the primary/default WCS information
+in the FITS header (i.e. the C<CRVAL1>,C<CRPIX1>,... keywords). The
+Greisen et al. standard (L<http://fits.cv.nrao.edu/documents/wcs/wcs.html>)
+allows alternative/additional mappings to be included in a header; these
+are denoted by the letters C<A> to C<Z>. If you know that your image contains
+such a mapping then you can use the C<WCS> option to select the appropriate
+letter. For example, if you had read in a Chandra image created by the CIAO
+software package then you can display the image in the C<physical>
+coordinate system by saying:
+
+ $win->fits_imag( $pdl, { wcs => 'p' } );
+
+The identity transform is used if you select a mapping for which there is
+no information in the header.
+Please note that this suport is B<experimental> and is not guaranteed
+to work correctly; please see the documentation for the L<_FITS_tr|/_FITS_tr>
+routine for more information.
+
+=back
+
+
+
+=head2 fits_rgbi
+
+=for ref
+
+Display an RGB FITS image with correct axes
+
+=for usage
+
+ $win->fits_rgbi( image, [$min,$max], [$opt] );
+
+Works exactly like L<fits_imag|/fits_imag>, but the image must be in
+(X,Y,RGB) form. Only the first two axes of the FITS header are examined.
+
+=head2 fits_cont
+
+=for ref
+
+Draw contours of an image, labelling the axes using the WCS information
+in the FITS header of the image.
+
+=for usage
+
+ $win->fits_cont( image, [$contours, $transform, $misval], [$opt] )
+
+Does the same thing for the L<cont|/cont> routine that
+L<fits_imag|/fits_imag> does for the L<imag|/imag> routins.
+
+=head2 draw_wedge
+
+=for ref
+
+Add a wedge (colour bar) to an image.
+
+=for usage
+
+ $win->draw_wedge( [$opt] )
+
+Adds a wedge - shows the mapping between colour and value for a pixel - to
+the current image. This can also be achieved by setting C<DrawWedge> to 1
+when calling the C<imag> routine.
+
+The colour and font size are the same as used to draw the image axes
+(although this will probably fail if you did it yourself). To control the size
+and location of the wedge, use the C<Wedge> option, giving it a hash reference
+containing any of the following:
+
+=over 4
+
+=item Side
+
+Which side of the image to draw the wedge: can be one of 'B', 'L', 'T', or
+'R'. Default is B<'R'>.
+
+=item Displacement
+
+How far from the egde of the image should the wedge be drawn, in units of character
+size. To draw within the image use a negative value. Default is B<1.5>.
+
+=item Width
+
+How wide should the wedge be, in units of character size. Default is B<2>.
+
+=item Label
+
+A text label to be added to the wedge. If set, it is probably worth
+increasing the C<Width> value by about 1 to keep the text readable.
+Default is B<''>. This is equivalent to the C<WTitle> option to
+L<imag|imag>, L<fits_imag|fits_imag>, and similar methods.
+
+=item ForeGround (synonym Fg)
+
+The pixel value corresponding to the "maximum" colour. If C<undef>, uses the
+value used by C<imag> (recommended choice). Default is C<undef>.
+
+=item BackGround (synonym Bg)
+
+The pixel value corresponding to the "minimum" colour. If C<undef>, uses the
+value used by C<imag> (recommended choice). Default is C<undef>.
+
+=back
+
+=for example
+
+ $a = rvals(50,50);
+ $win = PDL::Graphics::PGPLOT::Window->new();
+ $win->imag( $a, { Justify => 1, ITF => 'sqrt' } );
+ $win->draw_wedge( { Wedge => { Width => 4, Label => 'foo' } } );
+ # although the following might be more sensible
+ $win->imag( $a, { Justify => 1, ITF => 'sqrt', DrawWedge => 1,
+ Wedge => { Width => 4, Label => 'foo'} } );
+
+=head2 ctab
+
+=for ref
+
+Load an image colour table.
+
+ Usage:
+
+=for usage
+
+ ctab ( $name, [$contrast, $brightness] ) # Builtin col table
+ ctab ( $ctab, [$contrast, $brightness] ) # $ctab is Nx4 array
+ ctab ( $levels, $red, $green, $blue, [$contrast, $brightness] )
+ ctab ( '', $contrast, $brightness ) # use last color table
+
+Note: See L<PDL::Graphics::LUT|PDL::Graphics::LUT> for access to a large
+number of colour tables.
+
+Notionally, all non-RGB images and vectors have their colors looked up
+in the window's color table. Colors in images and such are scaled to
+a normalized pseudocolor domain on the line segment [0,1]; the color
+table is a piecewise linear function that maps this one-dimensional
+scale to the three-dimensional normalized RGB color space [0,1]^3.
+
+You can specify specific indexed colors by appropriate use of the
+(levels,red,green,blue) syntax -- but that is deprecated, since the actual
+available number of colors can change depending on the output device.
+(Someone needs to write a specific hardware-dependent lookup table interface).
+
+See also L<imag|imag> for a description of how to use only part of the
+color table for a particular image.
+
+=head2 ctab_info
+
+=for ref
+
+Return information about the currently loaded color table
+
+=head2 autolog
+
+=for ref
+
+Turn on automatic logarithmic scaling in C<line> and C<points>
+
+=for usage
+
+ Usage: autolog([0|1]);
+
+Setting the argument to 1 turns on automatic log scaling and setting it to
+zero turns it off again. The function can be used in both the object
+oriented and standard interface. To learn more, see the documentation for
+the L<axis option|axis>.
+
+=for example
+
+ my $win = PDL::Graphics::PGPLOT::Window->new(dev=>'/xserve');
+ my $x=sequence(10);
+ my $y=$x*$x+1;
+
+ $win->autolog(1);
+ $win->line($x,$y, {Axis => 'LogY'});
+
+
+=head2 line
+
+=for ref
+
+Plot vector as connected points
+
+If the 'MISSING' option is specified, those points in the C<$y> vector
+which are equal to the MISSING value are not plotted, but are skipped
+over. This allows one to quickly draw multiple lines with one call to
+C<line>, for example to draw coastlines for maps.
+
+=for usage
+
+ Usage: line ( [$x,] $y, [$opt] )
+
+The following standard options influence this command:
+
+ AXIS, BORDER, COLO(U)R, LINESTYLE, LINEWIDTH, MISSING,
+ JUSTIFY, SCALE, PITCH, PIX, ALIGN
+
+=for example
+
+ $x = sequence(10)/10.;
+ $y = sin($x)**2;
+ # Draw a red dot-dashed line
+ line $x, $y, {COLOR => 'RED', LINESTYLE=>3};
+
+=head2 lines
+
+=for ref
+
+Plot a list of vectors as discrete sets of connected points
+
+This works much like L<line|line>, but for discrete sets of connected
+points. There are two ways to break lines: you can pass in x/y coordinates
+just like in L<line|line>, but with an additional C<pen> piddle that
+indicates whether the pen is up or down on the line segment following
+each point (so you set it to zero at the end of each line segment you
+want to draw); or you can pass in an array ref containing a list
+of single polylines to draw.
+
+Happily, there's extra meaning packed into the C<pen> piddle: it
+multiplies the COLO(U)R that you set, so if you feed in boolean
+values you get what you expect -- but you can also feed in integer
+or floating-point values to get multicolored lines.
+
+Furthermore, the sign bit of C<pen> can be used to draw hairline segments:
+if C<pen> is negative, then the segment is drawn as though it were
+positive but with LineWidth and HardLW set to 1 (the minimum).
+
+Equally happily, even if you are using the array ref mechanism
+to break your polylines you can feed in an array ref of C<pen> values to
+take advantage of the color functionality or further dice your polylines.
+
+Note that, unlike L<line|line>, C<lines> has no no specify-$y-only
+calling path. That's because C<lines> is intended more for line art than for
+plotting, so you always have to specify both $x and $y.
+
+Infinite or bad values are ignored -- that is to say, if your vector
+contains a non-finite point, that point breaks the vector just as if you
+set pen=0 for both that point and the point before it.
+
+=for usage
+
+ Usage: $w->lines( $x, $y, [$pen], [$opt] );
+ $w->lines( $xy, [$pen], [$opt] );
+ $w->lines( \@xvects, \@yvects, [\@pen], [$opt] );
+ $w->lines( \@xyvects, [\@pen], [$opt] );
+
+The following standard options influence this command:
+ AXIS, BORDER, COLO(U)R, LINESTYLE, LINEWIDTH, MISSING,
+ JUSTIFY, SCALE, PITCH, PIX, ALIGN
+
+CAVEAT:
+
+Setting C<pen> elements to 0 prevents drawing altogether, so you
+can't use that to draw in the background color.
+
+=head2 points
+
+=for ref
+
+Plot vector as points
+
+=for usage
+
+ Usage: points ( [$x,] $y, [$symbol(s)], [$opt] )
+
+Options recognised:
+
+ SYMBOL - Either a piddle with the same dimensions as $x, containing
+ the symbol associated to each point or a number specifying
+ the symbol to use for every point, or a name specifying the
+ symbol to use according to the following (recognised name in
+ capital letters):
+ 0 - SQUARE 1 - DOT 2 - PLUS 3 - ASTERISK
+ 4 - CIRCLE 5 - CROSS 7 - TRIANGLE 8 - EARTH
+ 9 - SUN 11 - DIAMOND 12- STAR
+ PLOTLINE - If this is >0 a line will be drawn through the points.
+
+The following standard options influence this command:
+
+ AXIS, BORDER, CHARSIZE, COLOUR, LINESTYLE, LINEWIDTH,
+ JUSTIFY, SCALE, PIX, PITCH, ALIGN
+
+C<SymbolSize> allows to adjust the symbol size, it defaults to CharSize.
+
+The C<ColorValues> option allows one to plot XYZ data with the
+Z axis mapped to a color value. For example:
+
+ use PDL::Graphics::LUT;
+ ctab(lut_data('idl5')); # set up color palette to 'idl5'
+ points ($x, $y, {ColorValues => $z});
+
+=for example
+
+ $y = sequence(10)**2+random(10);
+ # Plot blue stars with a solid line through:
+ points $y, {PLOTLINE => 1, COLOUR => BLUE, symbol => STAR}; # case insensitive
+
+=head2 errb
+
+=for ref
+
+Plot error bars (using C<pgerrb()>)
+
+Usage:
+
+=for usage
+
+ errb ( $y, $yerrors, [$opt] )
+ errb ( $x, $y, $yerrors, [$opt] )
+ errb ( $x, $y, $xerrors, $yerrors, [$opt] )
+ errb ( $x, $y, $xloerr, $xhierr, $yloerr, $yhierr, [$opt])
+
+Any of the error bar parameters may be C<undef> to omit those error bars.
+
+Options recognised:
+
+ TERM - Length of terminals in multiples of the default length
+ SYMBOL - Plot the datapoints using the symbol value given, either
+ as name or number - see documentation for 'points'
+
+The following standard options influence this command:
+
+ AXIS, BORDER, CHARSIZE, COLOUR, LINESTYLE, LINEWIDTH,
+ JUSTIFY, SCALE, PIX, PITCH, ALIGN
+
+=for example
+
+ $y = sequence(10)**2+random(10);
+ $sigma=0.5*sqrt($y);
+ errb $y, $sigma, {COLOUR => RED, SYMBOL => 18};
+
+ # plot X bars only
+ errb( $x, $y, $xerrors, undef );
+
+ # plot negative going bars only
+ errb( $x, $y, $xloerr, undef, $yloerr, undef );
+
+
+=head2 cont
+
+=for ref
+
+Display image as contour map
+
+=for usage
+
+ Usage: cont ( $image, [$contours, $transform, $misval], [$opt] )
+
+Notes: C<$transform> for image/cont etc. is used in the same way as the
+C<TR()> array in the underlying PGPLOT FORTRAN routine but is,
+fortunately, zero-offset. The L<transform()|/transform> routine can be used to
+create this piddle.
+
+Options recognised:
+
+ CONTOURS - A piddle with the contour levels
+ FOLLOW - Follow the contour lines around (uses pgcont rather than
+ pgcons) If this is set >0 the chosen linestyle will be
+ ignored and solid line used for the positive contours
+ and dashed line for the negative contours.
+ LABELS - An array of strings with labels for each contour
+ LABELCOLOUR - The colour of labels if different from the draw colour
+ This will not interfere with the setting of draw colour
+ using the colour keyword.
+ MISSING - The value to ignore for contouring
+ NCONTOURS - The number of contours wanted for automatical creation,
+ overridden by CONTOURS
+ TRANSFORM - The pixel-to-world coordinate transform vector
+
+The following standard options influence this command:
+
+ AXIS, BORDER, COLOUR, LINESTYLE, LINEWIDTH,
+ JUSTIFY, SCALE, PIX, PITCH, ALIGN
+
+=for example
+
+ $x=sequence(10,10);
+ $ncont = 4;
+ $labels= ['COLD', 'COLDER', 'FREEZING', 'NORWAY']
+ # This will give four blue contour lines labelled in red.
+ cont $x, {NCONT => $ncont, LABELS => $labels, LABELCOLOR => RED,
+ COLOR => BLUE}
+
+=head2 bin
+
+=for ref
+
+Plot vector as histogram (e.g. C<bin(hist($data))>)
+
+=for usage
+
+ Usage: bin ( [$x,] $data )
+
+Options recognised:
+
+ CENTRE - (default=1) if true, the x values denote the centre of the
+ bin otherwise they give the lower-edge (in x) of the bin
+ CENTER - as CENTRE
+
+The following standard options influence this command:
+
+ AXIS, BORDER, COLOUR, JUSTIFY, LINESTYLE, LINEWIDTH
+
+=head2 hi2d
+
+=for ref
+
+Plot image as 2d histogram (not very good IMHO...)
+
+=for usage
+
+ Usage: hi2d ( $image, [$x, $ioff, $bias], [$opt] )
+
+Options recognised:
+
+ IOFFSET - The offset for each array slice. >0 slants to the right
+ <0 to the left.
+ BIAS - The bias to shift each array slice up by.
+
+The following standard options influence this command:
+
+ AXIS, BORDER, JUSTIFY, SCALE, PIX, PITCH, ALIGN
+
+Note that meddling with the C<ioffset> and C<bias> often will require you to
+change the default plot range somewhat. It is also worth noting that if
+you have TriD working you will probably be better off using
+L<mesh3d|PDL::Graphics::TriD/mesh3d> or
+a similar command - see the L<PDL::Graphics::TriD|PDL::Graphics::TriD>
+module.
+
+=for example
+
+ $r=sequence(100)/50-1.0;
+ $y=exp(-$r**2)*transpose(exp(-$r**2))
+ hi2d $y, {IOFF => 1.5, BIAS => 0.07};
+
+=head2 arrow
+
+=for ref
+
+Plot an arrow
+
+=for usage
+
+ Usage: arrow($x1, $y1, $x2, $y2, [, $opt]);
+
+Plot an arrow from C<$x1, $y1> to C<$x2, $y2>. The arrow shape can be
+set using the option C<Arrow>. See the documentation for general options
+for details about this option (and the example below):
+
+=for example
+
+Example:
+
+ arrow(0, 1, 1, 2, {Arrow => {FS => 1, Angle => 1, Vent => 0.3, Size => 5}});
+
+which draws a broad, large arrow from (0, 1) to (1, 2).
+
+=head2 rect
+
+=for ref
+
+Draw a non-rotated rectangle
+
+Usage: rect ( $x1, $x2, $y1, $y2 )
+
+Options recognised:
+
+The following standard options influence this command:
+
+ AXIS, BORDER, COLOUR, FILLTYPE, HATCHING, LINESTYLE, LINEWIDTH
+ JUSTIFY, SCALE, PIX, PITCH, ALIGN
+
+=head2 poly
+
+=for ref
+
+Draw a polygon
+
+=for usage
+
+ Usage: poly ( $x, $y )
+
+Options recognised:
+
+The following standard options influence this command:
+
+ AXIS, BORDER, COLOUR, FILLTYPE, HATCHING, LINESTYLE, LINEWIDTH
+ JUSTIFY, SCALE, PIX, PITCH, ALIGN
+
+=for example
+
+ # Fill with hatching in two different colours
+ $x=sequence(10)/10;
+ # First fill with cyan hatching
+ poly $x, $x**2, {COLOR=>5, FILL=>3};
+ hold;
+ # Then do it over again with the hatching offset in phase:
+ poly $x, $x**2, {COLOR=>6, FILL=>3, HATCH=>{PHASE=>0.5}};
+ release;
+
+=head2 circle
+
+=for ref
+
+Plot a circle on the display using the fill setting.
+
+=for usage
+
+ Usage: circle($x, $y, $radius [, $opt]);
+
+All arguments can alternatively be given in the options hash using the
+following options:
+
+=over
+
+=item XCenter and YCenter
+
+The position of the center of the circle
+
+=item Radius
+
+The radius of the circle.
+
+=back
+
+=head2 ellipse
+
+=for ref
+
+Plot an ellipse, optionally using fill style.
+
+=for usage
+
+ Usage: ellipse($x, $y, $a, $b, $theta [, $opt]);
+
+All arguments can alternatively be given in the options hash using the
+following options:
+
+=over
+
+=item MajorAxis
+
+The major axis of the ellipse - this must be defined or C<$a> must be given.
+
+=item MinorAxis
+
+The minor axis, like A this is required.
+
+=item Theta (synonym Angle)
+
+The orientation of the ellipse - defaults to 0.0. This is given in
+radians.
+
+=item XCenter and YCenter
+
+The coordinates of the center of the ellipse. These must be specified or
+C<$x> and C<$y> must be given.
+
+=item NPoints
+
+The number of points used to draw the ellipse. This defaults to 100 and
+might need changing in the case of very large ellipses.
+
+=back
+
+The routine also recognises the same standard options as
+accepted by L<poly|/poly>.
+
+=head2 rectangle
+
+=for ref
+
+Draw a rectangle.
+
+=for usage
+
+ Usage: rectangle($xcenter, $ycenter, $xside, $yside, [, $angle, $opt]);
+
+This routine draws a rectangle with the chosen fill style. Internally
+it calls L<poly|/poly> which is somewhat slower than C<pgrect> but which
+allows for rotated rectangles as well. The routine recognises the same
+options as C<poly> and in addition the following:
+
+=over
+
+=item XCenter and YCenter
+
+The position of the center of the rectangle. XCentre and YCentre are
+valid synonyms.
+
+=item XSide and YSide
+
+The length of the X and Y sides. If only one is specified the
+shape is taken to be square with that as the side-length, alternatively
+the user can set Side
+
+=item Side
+
+The length of the sides of the rectangle (in this case a square) - syntactic
+sugar for setting XSide and YSide identical. This is overridden by XSide
+or YSide if any of those are set.
+
+=item Angle (synonym Theta)
+
+The angle at which the rectangle is to be drawn. This defaults to 0.0 and
+is given in radians.
+
+
+=back
+
+
+=head2 vect
+
+=for ref
+
+Display 2 images as a vector field
+
+=for usage
+
+ Usage: vect ( $w, $a, $b, [$scale, $pos, $transform, $misval], { opt } );
+ $w->vect($a,$b,[$scale,$pos,$transform,$misval], { opt });
+
+Notes: C<$transform> for image/cont etc. is used in the same way as the
+C<TR()> array in the underlying PGPLOT FORTRAN routine but is,
+fortunately, zero-offset. The L<transform()|/transform> routine can be used to
+create this piddle.
+
+This routine will plot a vector field. C<$a> is the horizontal component
+and C<$b> the vertical component. The scale factor converts between
+vector length units and scientific positional units. You can set the
+scale, position, etc. either by passing in parameters in the normal parameter
+list or by passing in options.
+
+Options recognised:
+
+ SCALE - Set the scale factor for vector lengths.
+ POS - Set the position of vectors.
+ <0 - vector head at coordinate
+ >0 - vector base at coordinate
+ =0 - vector centered on the coordinate
+ TRANSFORM - The pixel-to-world coordinate transform vector
+ MISSING - Elements with this value are ignored.
+
+The following standard options influence this command:
+
+ ARROW, ARROWSIZE, AXIS, BORDER, CHARSIZE, COLOUR,
+ LINESTYLE, LINEWIDTH,
+
+=for example
+
+ $a=rvals(11,11,{Centre=>[5,5]});
+ $b=rvals(11,11,{Centre=>[0,0]});
+ vect $a, $b, {COLOR=>YELLOW, ARROWSIZE=>0.5, LINESTYLE=>dashed};
+
+=head2 fits_vect
+
+=for ref
+
+Display a pair of 2-D piddles as vectors, with FITS header interpretation
+
+=for usage
+
+ Usage: fits_vect ($a, $b, [$scale, $pos, $transform, $misval] )
+
+C<fits_vect> is to L<vect|/vect> as L<fits_imag|/fits_imag> is to L<imag|imag>.
+
+=head2 transform
+
+=for ref
+
+Create transform array for contour and image plotting
+
+=for usage
+
+ $win->transform([$xdim,$ydim], $options);
+
+(For information on coordinate transforms, try L<PDL::Transform|PDL::Transform>.)
+This function creates a transform array in the format required by the image
+and contouring routines. You must call it with the dimensions of your image
+as arguments or pass these as an anonymous hash - see the example below.
+
+=over
+
+=item Angle
+
+The rotation angle of the transform, in radians. Positive numbers rotate the
+image clockwise on the screen.
+
+=item ImageDimensions
+
+The dimensions of the image the transform is required for. The dimensions
+should be passed as a reference to an array.
+
+=item Pixinc
+
+The increment in output coordinate per pixel.
+
+=item ImageCenter (or ImageCentre)
+
+The centre of the image as an anonymous array B<or> as a scalar, in
+scientific coordinates. In the latter case the x and y value for the
+center will be set equal to this scalar. This is particularly useful
+in the common case when the center is (0, 0). (ImageCenter overrides
+RefPos if both are specified).
+
+=item RefPos (or ReferencePosition)
+
+If you wish to set a pixel other than the image centre to a given
+value, use this option. It should be supplied with a reference to an array
+containing 2 2-element array references, e.g.
+
+ RefPos => [ [ $xpix, $ypix ], [ $xplot, $yplot ] ]
+
+This will label pixel C<($xpix,$ypix)> as being at position
+C<($xplot,$yplot)>. For example
+
+ RefPos => [ [100,74], [ 0, 0 ] ]
+
+sets the scientific coordinate origin to be at the center of the (100,74)
+pixel coordinate. The pixel coordinates are pixel-centered, and start counting
+from 0 (as all good pixel coordinates should).
+
+=back
+
+Example:
+
+ $im = rvals(100, 100);
+ $w = PDL::Graphics::PGPLOT::Window->new(Device => '/xs');
+ $t = $w->transform(dims($im), {ImageCenter => 0, Pixinc => 5});
+ $w->imag($im, {Transform => $t});
+
+=head2 tline
+
+=for ref
+
+Threaded line plotting
+
+=for usage
+
+ $win->tline($x, $y, $options);
+
+This is a threaded interface to C<line>. This is convenient if you have
+a 2D array and want to plot out every line in one go. The routine will
+apply any options you apply in a "reasonable" way. In the sense that it
+will loop over the options wrapping over if there are less options than
+lines.
+
+Example:
+
+ $h={Colour => ['Red', '1', 4], Linestyle => ['Solid' ,'Dashed']};
+ $tx=zeroes(100,5)->xlinvals(-5,5);
+ $ty = $tx + $tx->yvals;
+ $win->tline($tx, $ty, $h);
+
+=head2 tpoints
+
+=for ref
+
+A threaded interface to points
+
+=for usage
+
+ Usage: tpoints($x, $y, $options);
+
+This is a threaded interface to C<points>. This is convenient if you have
+a 2D array and want to plot out every line in one go. The routine will
+apply any options you apply in a "reasonable" way. In the sense that it
+will loop over the options wrapping over if there are less options than
+lines.
+
+Example:
+
+ $h={Colour => ['Red', '1', 4], Linestyle => ['Solid' ,'Dashed']};
+ $tx=zeroes(100,5)->xlinvals(-5,5);
+ $ty = $tx + $tx->yvals;
+ tpoints($tx, $ty, $h);
+
+=head2 tcircle
+
+=for ref
+
+A threaded interface to circle
+
+=for usage
+
+ Usage: tcircle($x, $y, $r, $options);
+
+This is a threaded interface to C<circle>. This is convenient if you have
+a list of circle centers and radii and want to draw every circle in one go.
+The routine will apply any options you apply in a "reasonable" way,
+in the sense that it will loop over the options wrapping over if there are less
+options than circles.
+
+Example:
+
+ $x=sequence(5);
+ $y=random(5);
+ $r=sequence(5)/10 + 0.1;
+ $h={justify => 1,Color => ['red','green','blue'], filltype => ['solid','outline','hatched','cross_hatched']};
+ tcircle($x, $y, $r, $h);
+
+Note that C<$x> and C<$y> must be the same size (>1D is OK, though meaningless as far as C<tcircle> is concerned). C<$r> can be the same size as C<$x> OR a 1-element piddle OR a single perl scalar.
+
+=head2 Text routines
+
+=head2 text
+
+=for ref
+
+Write text in a plot window at a specified position.
+
+=for usage
+
+ Usage: text ($text, $x, $y [, $opt])
+
+Options recognised:
+
+=over
+
+=item C<ANGLE>
+
+The angle in degrees between the baseline of the text and
+the horisontal (increasing counter-clockwise). This defaults to 0.
+
+=item C<JUSTIFICATION>
+
+The justification of the text relative to the position specified. It
+defaults to 0.0 which gives left-justified text. A value of 0.5 gives
+centered text and a value of 1.0 gives right-justified text.
+
+=item C<XPos>, C<YPos>, C<Text>
+
+These gives alternative ways to specify the text and position.
+
+=item C<BackgroundColour>
+
+This sets the background colour for the text in case an opaque background
+is desired. You can also use the synonyms C<Bg> and C<BackgroundColor>.
+
+=back
+
+The following standard options influence this command:
+
+ COLOUR, CHARSIZE
+
+=for example
+
+ line sequence(10), sequence(10)**2;
+ text 'A parabola', 3, 9, {Justification => 1, Angle=>atan2(6,1)};
+
+
+=head2 legend
+
+=for ref
+
+Add a legend to a plot
+
+=for usage
+
+ Usage: legend($text, $x, $y, [, $width], $opt]);
+
+This function adds a legend to an existing plot. The action is primarily
+controlled by information in the options hash, and the basic idea is that
+C<$x> and C<$y> determines the upper left hand corner of the box in which
+the legend goes. If the width is specified either as an argument or as
+an option in the option hash this is used to determine the optimal character
+size to fit the text into part of this width (defaults to 0.5 - see the
+description of C<TextFraction> below). The rest of the width is filled out with
+either lines or symbols according to the content of the C<LineStyle>,
+C<Symbol>, C<Colour> and C<LineWidth> options.
+
+The local options recognised are as follows:
+
+=over
+
+=item C<Text>
+
+An anonymous array of annotations, can also be specified directly.
+
+=item C<XPos> and C<YPos>
+
+The X and Y position of the upper left-hand corner of the text.
+
+=item C<Width> and C<Height>
+
+The width and/or height of each line (including symbol/line). This is
+used to determine the character size. If any of these are set to 'Automatic'
+the current character size will be used.
+
+=item C<TextFraction>
+
+The text and the symbol/line is set inside a box. C<TextFraction>
+determines how much of this box should be devoted to text. This
+defaults to 0.5. You can also use C<Fraction> as a synonym to this.
+
+=item C<TextShift>
+
+This option allows for fine control of the spacing between the text and the
+start of the line/symbol. It is given in fractions of the total width of the
+legend box. The default value is 0.1.
+
+=item C<VertSpace> or C<VSpace>
+
+By default the text lines are separated by one character height (in the sense that
+if the separation were 0 then they would lie on top of each other). The
+C<VertSpace> option allows you to increase (or decrease) this gap in units of
+the character height; a value of 0.5 would add half a character height to the
+gap between lines, and -0.5 would remove the same distance.
+The default value is 0.
+
+=item C<BackgroundColour>
+
+This sets the background colour for the text in case an opaque background
+is desired. You can also use the synonyms C<Bg> and C<BackgroundColor>.
+
+
+=back
+
+=for example
+
+ line $x, $y, {Color => 'Red', LineStyle => 'Solid'};
+ line $x2, $y2, {Color => 'Blue', 'LineStyle' => 'Dashed', LineWidth => 10};
+
+ legend ['A red line', 'A blue line'], 5, 5,
+ {LineStyle => ['Solid', 'Dashed'], Colour => ['Red', 'Blue']
+ LineWidth => [undef, 10]}; # undef gives default.
+
+
+=head2 Cursor routines
+
+=head2 cursor
+
+=for ref
+
+Interactively read cursor positions.
+
+=for usage
+
+ Usage: ($x, $y, $ch, $xref, $yref) = cursor($opt)
+
+This routine has no standard input parameters, but the type of cursor
+can be set by setting the option C<Type> as a key in the anonymous hash
+C<$opt>. The first three return values from the function are always
+defined and gives the position selected by the user and the character
+pressed.
+
+Depending on the cursor type selected the last two arguments might also
+be defined and these give a reference position. For instance if the cursor
+is selected to be C<Rectangle> then the reference position gives one of
+the corners of the rectangle and C<$x> and C<$y> the diagonally opposite
+one.
+
+Options recognised:
+
+=over
+
+=item XRef, YRef
+
+The reference position to be used
+
+=item Type
+
+The type of cursor. This can be selected using a number between 0 and 7 as
+in PGPLOT, or alternatively you can specify these as, C<Default> (0),
+C<RadialLine> (1), C<Rectangle> (2), C<TwoHorizontalLines> (3),
+C<TwoVerticalLines> (4), C<HorizontalLine> (5), C<VerticalLine> (6)
+and C<CrossHair> (7) respectively. The default cursor is just the normal
+mouse cursor.
+
+For the C<RadialLine> you I<must> specify the reference point, whereas for
+the C<Two(Vertical|Horizontal)Lines> cursor the X or Y reference point,
+respectively, must be specified.
+
+=back
+
+=for example
+
+To select a region on a plot, use the rectangle cursor:
+
+ ($x, $y, $ch, $xref, $yref) = cursor({Type => 'Rectangle'});
+ poly pdl($x, $xref, $xref, $x, $x), pdl($y, $y, $yref, $yref, $y);
+
+To select a region of the X-axis:
+
+ ($x1, $y1, $ch) = cursor({Type => 'VerticalLine'});
+ ($x2, $y2, $ch) = cursor({Type => 'TwoVerticalLines', XRef => $x1});
+
+
+=head1 Internal routines
+
+=cut
+
+
+#'
+
+package PDL::Graphics::PGPLOT::Window;
+require Exporter;
+
+use PDL::Core qw/:Func :Internal/; # Grab the Core names
+use PDL::Basic;
+use PDL::Ufunc;
+use PDL::Primitive;
+use PDL::Types;
+use PDL::Options;
+use PDL::Graphics::State;
+use PDL::Graphics::PGPLOTOptions qw(default_options);
+use PDL::Slices;
+use PDL::NiceSlice;
+use SelfLoader;
+use PGPLOT;
+
+require DynaLoader;
+
+ at ISA = qw( Exporter SelfLoader DynaLoader );
+ at EXPORT = qw( pgwin );
+
+bootstrap PDL::Graphics::PGPLOT::Window;
+$PDL::Graphics::PGPLOT::RECORDING = 0; # By default recording is off..
+
+
+####
+# Helper routines to handle signal avoidance:
+# cpgplot doesn't take well to being interrupted, so we mask out INT
+# signals during most of the routines. But we do want to handle
+# those INTs, so we need a handler that marks 'em.
+#
+# You call catch_signals with no arguments. INT and __DIE__ signals
+# are sent to the signal_catcher, and released, not necessarily in
+# the order they occured, by release_signals.
+#
+# To avoid problems with nested &catch_signals and &release_signals calls,
+# a variable keeps track of balancing the two. Ideally, no signals would
+# actually be released until you undo all of 'em -- but the code is meant
+# to be forgiving, so the third caught INT signal in a row gets released,
+# to be trapped in the usual way.
+#
+# catch_signals catches the __DIE__ pseudosignal, but barf() doesn't
+# throw it -- so remember to release signals before barfing!
+#
+# The mechanism is a little over-powered for what we need -- but, hey,
+# if you want to defer any other signal you can simply add it to the
+# list in catch_signals.
+#
+# Don't try to parse arguments within catch_signals -- the omitted-() call
+# is extra fast but doesn't set @_!
+#
+# --CED 9-Aug-2002
+####
+
+=head2 signal_catcher, catch_signals, release_signals
+
+To prevent pgplot from doing a fandango on core, we have to block interrupts
+during PGPLOT calls. Specifically, INT needs to get caught. These internal
+routines provide a mechanism for that.
+
+You simply bracket any PGPLOT calls with C<&catch_signals> above and
+C<&release_signals> below, and the signal_catcher will queue up any
+signals (like INT -- the control-C interrupt) until the
+C<&release_signals> call.
+
+Any exit path from your hot code must include C<&release_signals>, or
+interrupts could be deferred indefinitely (which would be a bug).
+This includes calls to C<&barf> -- even barfs from someone you called!
+So avoid calling out of the local module if possible, and use
+release_and_barf() instead of barf() from within this module.
+
+Perl 5.6.1 interrupt handling has a bug that this code tickles --
+sometimes the re-emitted signals vanish into hyperspace. Perl 5.8
+seems NOT to have that problem.
+
+=cut
+
+my %sig_log;
+my %sig_handlers;
+my $sig_nest = 0;
+
+
+
+sub signal_catcher {
+ my($sig) = shift;
+
+ if($sig_nest == 0) {
+ $sig_nest = 1;
+ print STDERR "PDL::Graphics::PGPLOT: Warning - who left the light on when they left?\n";
+ &release_signals;
+ }
+
+ if($sig eq '__DIE__') {
+ return unless defined $^S; # Don't do anything during parsing of an eval
+ $sig_nest = 1; # Unwrap all nests when dying
+ &release_signals;
+ &{$SIG{__DIE__}}($sig) if defined($SIG{__DIE__});
+ return;
+ }
+
+ # Print message if debugging is on or on multiple INT signals
+ if($PDL::debug || ($sig_log{$sig} && ($sig eq 'INT'))) {
+ if($sig_log{$sig}==1) {
+ print STDERR "PDL::Graphics::PGPLOT: deferred $sig for PGPLOT; one more aborts operation\n";
+ } else {
+ print STDERR "PDL::Graphics::PGPLOT: deferred $sig signal for PGPLOT operation (l=$sig_nest)\n"
+ }
+ }
+
+ # Handle multiple INT signals (user pressing ^C a bunch)
+ if(defined($sig_log{$sig}) && ($sig_log{$sig}>1) && ($sig eq 'INT')) {
+ print STDERR "Aborting PGPLOT operation".($PDL::debug ? " (may mess up future PGPLOT commands)\n" : "\n");
+ $sig_nest = 1;
+ &release_signals ;
+ }
+ else {
+ $sig_log{$sig}++;
+ }
+}
+
+
+sub catch_signals {
+ my(@sigs) = ('INT');
+
+ local($_);
+
+ if($sig_nest == 0) {
+ foreach $_(@sigs) {
+ no warnings; # mask out warning in case $SIG{$_} is undef or "".
+ next if ($SIG{$_} == \&signal_catcher);
+ $sig_handlers{$_}=$SIG{$_};
+ $SIG{$_}=\&signal_catcher;
+ }
+ }
+
+ $sig_nest++; # Keep track of nested calls.
+}
+
+
+
+sub release_signals {
+ local($_);
+
+ $sig_nest-- if($sig_nest > 0);
+ return if($sig_nest > 0);
+
+ # restore original handlers
+ foreach $_(keys %sig_handlers) {
+ no warnings; # allow assignment even if sig_handlers{$_} is undef
+ $SIG{$_}=$sig_handlers{$_};
+ delete $sig_handlers{$_};
+ }
+
+ # release signals
+ foreach $_(keys %sig_log) {
+ next unless $sig_log{$_};
+ $sig_log{$_} = 0;
+ kill $_,$$;
+ }
+
+}
+
+sub release_and_barf {
+ $sig_nest = 1;
+ &release_signals;
+ barf(@_);
+}
+
+#
+# Note: Here the general and window creation specific options are read in
+# from PGPLOTOptions. The $GeneralOptions variable is most importantly
+# used in the new() routine to set the general options for the window.
+#
+# These are somewhat confusingly named perhaps. The WindowOptions are the
+# options that affect window creation and setup such as width, shape etc.
+# The GeneralOptions are options that affect all function calls in the package
+# (or at least most) since it affects the default colour, character size etc.
+# The problematic aspect here is the treatment of hardcopy settings. For
+# historical reasons these are set in the WindowOptions variable but they
+# should affect settings in the GeneralOptions variable...
+# Ideally this should be re-coded, but to save some time I have instead opted
+# for a patchy solution where they are specially treated in the new_window
+# routine.
+#
+# Added 28/9/01 JB
+# Delay the intialization of the window options so that it is possible
+# to set the defaults in the .perldlrc file
+my ($GeneralOptions, $WindowOptions) = (undef, undef);
+
+
+my $PREVIOUS_DEVICE = undef;
+my $PI = 4*atan2(1,1);
+my $PREVIOUS_ENV = undef;
+
+my $AUTOLOG = 0;
+
+
+sub autolog {
+ my $class = shift;
+ my $ret;
+ if (ref $class) {
+ $ret = $class->{Autolog} || $AUTOLOG;
+ $class->{Autolog} = shift if @_ > 0;
+ } else {
+ $ret = $AUTOLOG;
+ $AUTOLOG = shift if @_ > 0;
+ }
+ return $ret;
+}
+
+sub checklog {
+ my ($self,$x,$y) = @_;
+ $x = $x->log10->float if defined $x && $self->autolog && $self->{Logx};
+ $y = $y->log10->float if defined $y && $self->autolog && $self->{Logy};
+ # print STDERR "Logx: ",$self->{Logx},"\n";
+ # print STDERR "Logy: ",$self->{Logy},"\n";
+ return ($x,$y);
+}
+
+sub pgwin {
+ my(@a) = @_;
+ # Since this is a convenience function, be convenient. If only
+ # one parameter is passed in, assume that it's a device.
+ if(!$#a && !(ref $a[0])){
+ $a[0] = "/$a[0]" unless($a[0] =~ m:/:);
+ unshift(@a,'Dev')
+ }
+
+ # If two parameters are passed in, and the second one is a hash,
+ # then the first one is a device.
+ if(scalar(@a) == 2 && ref $a[1] eq 'HASH') {
+ $a[0] = "/$a[0]" unless($a[0] =~ m:/:);
+ $a[1]->{Dev} = $a[0];
+ @a = %{$a[1]};
+ }
+
+ # Furthermore, if an odd number of parameters are passed in,
+ # then the first one is a device and the rest is intended to
+ # be a parameters hash...
+ if(scalar(@a) % 2) {
+ $a[0] = "/$a[0]" unless($a[0] =~ m/:/);
+ unshift(@a,'Dev');
+ }
+
+ return PDL::Graphics::PGPLOT::Window->new(@a);
+}
+
+sub new {
+ my $type = shift;
+
+ # Set the default options!
+ ($GeneralOptions, $WindowOptions) = default_options();
+ # Turn off warnings for missing options...
+ $GeneralOptions->warnonmissing(0);
+ $WindowOptions->warnonmissing(0);
+
+ # options are either given in a hash reference, or as a list
+ # (which is converted to a hash reference to make the code easier)
+ my $u_opt;
+ if ( ref($_[0]) eq "HASH" ) { $u_opt = shift; }
+ else { $u_opt = { @_ }; }
+# $u_opt={} unless defined($u_opt);
+
+ my $opt = $WindowOptions->options($u_opt);
+ $WindowOptions->full_options(0);
+ my $user_options = $WindowOptions->current();
+ $WindowOptions->full_options(1);
+
+ # If the user set DEVICE then that overrides anything else...
+ if (exists $user_options->{Device}) {
+ $dev = $opt->{Device}
+ } elsif (!defined($dev) || $dev eq "") {
+ # Fall back on the default if first time or use $DEV otherwise..
+ $dev = $PREVIOUS_DEVICE || $opt->{Device};
+ }
+ $PREVIOUS_DEVICE = $dev;
+
+ &catch_signals;
+
+ my $this_opt = PDL::Options->new($opt);
+ my $t=$WindowOptions->translation();
+ $this_opt->translation($t);
+ my $s=$WindowOptions->synonyms();
+ $this_opt->synonyms($s);
+ $this_opt->warnonmissing(0);
+
+ # This is the setup for the plot options - which also can
+ # be set on a per-window basis by the user.
+ my $popt = $GeneralOptions->options($u_opt);
+ my $this_plotopt = PDL::Options->new($popt);
+ $t = $GeneralOptions->translation();
+ $this_plotopt->translation($t);
+ $s = $GeneralOptions->synonyms();
+ $this_plotopt->synonyms($s);
+ $this_plotopt->warnonmissing(0);
+
+ # Modified 7/4/02 JB to add CTAB as an aspect of the window.
+ my $self = {
+ 'Options' => $this_opt,
+ 'PlotOptions' => $this_plotopt,
+ 'Hold' => $opt->{Hold} || 0,
+ 'Name' => $opt->{WindowName} || '',
+ 'ID' => undef,
+ 'AspectRatio' => $opt->{AspectRatio},
+ 'WindowWidth' => $opt->{WindowWidth},
+ 'NX' => $opt->{NXPanel} || 1,
+ 'NY' => $opt->{NYPanel} || 1,
+ 'Device' => $opt->{Device} || $DEV,
+ 'CurrentPanel' => 0,
+ '_env_options' => undef,
+ 'State' => undef,
+ 'Recording' => $opt->{Recording} || $PDL::Graphics::PGPLOT::RECORDING,
+ 'CTAB' => undef, # The default colour table
+ };
+
+ if (defined($self->{Options})) {
+ # Turn off warnings about missing options
+ $self->{Options}->warnonmissing(0);
+ }
+
+ bless $self, ref($type) || $type;
+
+ $self->_open_new_window($opt);
+ # This weird setup is required to create the object.
+
+ # We always have to create a state variable to avoid undefined errors.
+ $self->{State}=PDL::Graphics::State->new();
+
+ &release_signals;
+ return $self;
+
+}
+
+#
+# Graphics windows should be closed when they go out of scope.
+# Thanks to Doug Burke for pointing this out.
+#
+sub DESTROY {
+
+ my $self=shift;
+
+ $self->close() unless !defined($self->{ID});
+}
+
+
+=head2 _open_new_window
+
+Open a new window. This sets the window ID, which is the one used when
+accessing a window later using C<pgslct>. It also sets the window name
+to something easily remembered if it has not been set before.
+
+=cut
+
+sub _open_new_window {
+ my $self = shift;
+ my(@parameters) = @_;
+
+ &catch_signals;
+ my $window_nr = pgopen($self->{Device});
+ release_and_barf("Opening new window (pgopen) failed: $window_nr\n")
+ if ($window_nr < 0);
+
+ $self->{ID} = $window_nr;
+ $self->{Name} = "Window$window_nr" if $self->{Name} eq "";
+
+ $self->_setup_window(@parameters);
+
+ &release_signals;
+}
+
+
+=head2 _setup_window
+
+This routine sets up a new window with its shape and size. This is
+also where the size options are actually parsed. These are then
+forgotten (well, they are stored in $self->{Options}) and the
+corresponding aspect ratio and window width is stored. See the
+discussion under new() for the logic.
+
+Finally the subpanels are set up using C<pgsubp> and colours and linewidth
+are adjusted according to whether we have a hardcopy device or not.
+
+=cut
+
+# bit: 2=>height; 1=>width; 0=>aspect
+$DefaultWindowWidth = 6;
+$DefaultWindowAspect=0.618;
+
+# These are thunks to handle regularizing window values in _setup_window.
+# Index is binary by validity of value. 0 = undefined (or 0), 1 = ok.
+# Bit 0 = aspect, bit 1 = width, bit 2 = height. Arguments in the same order.
+# Return value is ($aspect, $height).
+#
+# If nothing is defined we try to grab the latest values from PGPLOT itself.
+$__setup_subs = [
+ sub { my($vs_x1,$vs_x2,$vs_y1,$vs_y2); # 0 (000)
+ pgqvsz(1,$vs_x1,$vs_x2,$vs_y1,$vs_y2);
+ my($w) = ($vs_x2 - $vs_x1) || $DefaultWindowWidth;
+ return ( ((($vs_y2 - $vs_y1) / $w) || $DefaultWindowAspect),
+ $w
+ );
+ },
+ sub { ($_[0], $DefaultWindowWidth / ($_[0]<1 ? 1 : $_[0])); },# 1 (001)
+ sub { ($DefaultWindowAspect, $_[1]); }, # 2 (010)
+ sub { @_; }, # 3 (011)
+ sub { ($DefaultWindowAspect, $_[2] / $_[0]); }, # 4 (100)
+ sub { ($_[0], $_[2] / $_[0] ) }, # 5 (101)
+ sub { ($_[2] / $_[1], $_[1] ) }, # 6 (110)
+ sub { ($_[2] / $_[1], $_[1] ) } # use W and H; ignore Aspect # 7 (111)
+];
+
+
+sub _setup_window {
+ my $self = shift;
+ my $opt = shift;
+ # Get options as hash or as list
+ if(ref $opt ne 'HASH') {
+ $opt = {$opt, at _};
+ }
+
+ &catch_signals;
+
+ my $unit = _parse_unit($opt->{Unit}) || 1;
+
+ my $aspect = $opt->{AspectRatio};
+
+ my($width,$height);
+
+ $width = $opt->{WindowXSize} || $opt->{WindowWidth};
+ $height = $opt->{WindowYSize};
+
+ if(defined $opt->{Size}) {
+ if(ref $opt->{Size} eq 'ARRAY') {
+ $width = $opt->{Size}->[0];
+ $height = $opt->{Size}->[1] || $width;
+ $unit = _parse_unit($opt->{Size}->[2]) if defined($opt->{Size}->[2]);
+ } elsif(!(ref $opt->{Size})) {
+ $width = $height = $opt->{Size};
+ } else {
+ warn("Size must be a scalar or an array ref if specified! Ignoring...\n");
+ }
+ }
+
+ ($aspect,$width) = &{$__setup_subs->[ ((!!($aspect)) ) |
+ ((!!($width ))<<1) |
+ ((!!($height))<<2)
+ ]}($aspect,$width,$height);
+ $self->{AspectRatio} = $aspect;
+ $self->{WindowWidth} = $width;
+
+ #
+ # PGPLOT seems not to include full unit support in (e.g.) the pgpap
+ # command -- so check here and convert mm->inches if necessary.
+ # This is a real kludge that should be replaced with Real Units Conversion
+ # at a future date.
+ #
+ if($unit==2) { # mm -> inches
+ $width /= 25.4;
+ $height /= 25.4;
+ } elsif($unit==3) { # pixels -> inches. Warning, not device independent!
+ # What a kludge -- get window width in both pixels
+ # and inches to figure out the scaling factor for
+ # pgpap (which requires inches).
+ my($x0,$x1,$y0,$y1);
+ pgqvp(3,$x0,$x1,$y0,$y1);
+ my($pixwidth) = $x1 - $x0;
+ pgqvp(1,$x0,$x1,$y0,$y1);
+ my($inwidth) = $x1 - $x0;
+ my($pixperinch) = $pixwidth / $inwidth;
+ $width /= $pixperinch;
+ $height /= $pixperinch;
+ } elsif($unit ==0 || $unit > 3) {
+ warn("Invalid unit specification for window size; defaulting to inches.\n");
+ }
+
+ # OK, we got a decent size. Now call pgpap to set the size in the
+ # device, and (for interactive devices!) pgpag to get the size we
+ # want -- otherwise the window just hangs around looking lame at the
+ # default size instead of the size the user asked for. We also have
+ # to turn PGASK off so the user doesn't get asked to hit "return".
+ # Afterwards, we turn it back on because that's the default state.
+ # (although it is set to 0 again pretty soon)
+ #
+ pgqinf('HARDCOPY',my $hcopy,my $len);
+ pgpap($width, $aspect);
+ if($hcopy eq 'NO') {
+ pgask(0);
+ pgpage();
+ pgask(1);
+ }
+
+ # Now do the sub-division into panels.
+ my $nx = $self->{NX};
+ my $ny = $self->{NY};
+ if ($nx < 0) {
+ warn "We do not support the alternative numbering of panels of PGPLOT!\n";
+ $nx = abs($nx);
+ $self->{NX}=abs($self->{NX});
+ }
+ pgsubp($nx, $ny);
+
+ # Setup the colours
+ my $o = $self->{Options}->current();
+ pgask(0);
+ if ($hcopy eq "YES") {
+ # This has changed to set the defaults instead.
+ pgslw($o->{HardLW});
+ pgsch($o->{HardCH});
+ pgscf($o->{HardFont});
+ # To change defaults you first need to read them out and then
+ # adjust them and set them again
+ my $temp_wo = $self->{PlotOptions}->defaults();
+ $temp_wo->{Font}= $o->{HardFont};
+ $temp_wo->{CharSize}= $o->{HardCH};
+ $temp_wo->{LineWidth}= $o->{HardLW};
+ $temp_wo->{Colour}= $o->{HardColour};
+ $self->{PlotOptions}->defaults($temp_wo);
+ my $temp_o=$self->{Options}->defaults();
+ $temp_o->{AxisColour}=$o->{HardAxisColour};
+ $temp_o->{CharSize}=$o->{HardCH};
+ $self->{Options}->defaults($temp_o);
+ } else {
+ # Set the global properties as for the hardcopy device.
+ pgsch($o->{CharSize});
+ my $wo = $self->{PlotOptions}->defaults();
+ pgscf($wo->{Font});
+ pgslw($wo->{LineWidth});
+ }
+
+ my $wo = $self->{PlotOptions}->defaults();
+ $self->_set_colour($wo->{Colour});
+ pgask(0);
+
+ &release_signals;
+}
+
+sub _set_defaults { # Set up defaults
+
+ # Now check if this is a hardcopy device, in which case we
+ # set a variety of properties differently.
+ my $self = shift;
+
+}
+
+
+
+
+=head2 _status
+
+This routine checks PGPLOT's status for the window. It returns OPEN if
+the window is open and CLOSED if it is closed. (Windows can be closed
+but still exist).
+
+=cut
+
+sub _status {
+
+ &catch_signals;
+
+ my $self=shift;
+ $self->focus();
+ my ($state, $len);
+ pgqinf('STATE',$state,$len);
+
+ &release_signals;
+ return $state;
+
+}
+
+=head2 _reopen
+
+This functions reopens a window. Since this is an internal function it does
+not have a lot of error-checking. Make sure the device is closed I<before>
+calling this routine.
+
+There is an unfortunate problem which pops up viz. that the window name
+cannot be changed at this point since we are offering that to the rest of
+the world. That might be sensible, but it means that the window name will
+not reflect the id of the window - use C<id()> for that (this is also why
+we do not call C<open_new_window> )
+
+=cut
+
+sub _reopen {
+ my @parameters = @_;
+ my $self = shift;
+
+ &catch_signals;
+ my $window_nr = pgopen($self->{Device});
+
+ release_and_barf("Opening new window (pgopen) failed: $window_nr\n")
+ if ($window_nr < 0);
+
+ $self->{ID} = $window_nr;
+
+ $self->_setup_window(@parameters);
+
+ &release_signals;
+}
+
+
+=head2 _advance_panel
+
+This routine advances one plot panel, updating the CurrentPanel as well.
+If the advance will proceed past the page the page will be erased. Also
+note that when you advance one panel the hold value will be changed.
+
+=cut
+
+sub _advance_panel {
+ &catch_signals;
+
+ my $self = shift;
+
+ my $new_panel = $self->{CurrentPanel}+1;
+ if ($new_panel > ($self->{NX}*$self->{NY})) {
+ # We are at the end of the page..
+ $new_panel = 1;
+ $self->clear_state();
+ pgpage();
+# $self->{_env_set}=[];
+ }
+
+ $self->panel($new_panel);
+ if ($self->held()) {
+ $self->{Hold}=0;
+ print "Graphic released (panel move)\n" if $PDL::verbose;
+ }
+
+ &release_signals;
+}
+
+
+=head2 _check_move_or_erase
+
+This routine is a utility routine which checks if we need to move panel,
+and if so will do this. It also checks if it is necessary to advance panels,
+and whether they need to be erased.
+
+=cut
+
+sub _check_move_or_erase {
+ my $self=shift;
+ my ($panel, $erase)=@_;
+
+ &catch_signals;
+
+ my $sid; pgqid($sid);
+ # Only perform a pgslct if necessary.
+ pgslct($self->{ID}) unless $sid == $self->{ID};
+
+ if (defined($panel)) {
+ $self->panel($panel);
+ } elsif (!$self->held()) {
+ # If no hold has been set.
+ $self->_advance_panel();
+ }
+
+ $self->erase() if $erase;
+
+ &release_signals;
+}
+
+
+=head2 _thread_options
+
+This function is a cludgy utility function that expands an options hash
+to an array of hashes looping over options. This is mainly of use for
+"threaded" interfaces to standard plotting routines.
+
+=cut
+
+
+sub _thread_options {
+ my ($n, $h) = @_;
+
+ # Loop over each option.
+ my @hashes=(); # One for each option.
+ my @keys = keys %$h;
+ foreach my $k (@keys) {
+ my @vals=();
+ my $v=$h->{$k};
+ $v = [$v] if ref($v) ne 'ARRAY';
+ while ($#vals+1 < $n) {
+ splice(@vals, @vals, 0, @$v);
+ }
+ for (my $i=0; $i<$n; $i++) {
+ $hashes[$i]->{$k}=$vals[$i];
+ }
+ }
+ return \@hashes;
+}
+
+############################
+# Replay related functions #
+############################
+
+my $DEBUGSTATE = 0;
+
+sub debug_state {
+ $DEBUGSTATE = !$DEBUGSTATE;
+}
+
+sub replay {
+ my $self = shift;
+ my $state = shift || $self->{State};
+
+
+ &catch_signals;
+
+
+ if (!defined($state)) {
+ die "A state object must be defined to play back commands!\n";
+ }
+
+ my @list = $state->get();
+
+
+ if ($#list < 0) {
+ # If there are no commands, then the user might have forgotten to
+ # turn on recording, let us remind him/her
+
+ warn "Replaying an empty state - did you turn on recording?\n";
+ print "Hint: Put PDL::Graphics::PGPLOT::RECORDING=1 in your .perldlrc file\n"
+ }
+
+ foreach my $arg (@list) {
+ my ($command, $commandname, $arg, $opt)=@$arg;
+ &$command($self, @$arg, $opt);
+ }
+
+ &release_signals;
+}
+
+
+sub clear_state {
+ my $self = shift;
+ print "Clearing state!\n" if $DEBUGSTATE;
+ $self->{State}->clear() if(defined($self) && defined($self->{State}));
+}
+
+sub turn_off_recording {
+ my $self=shift;
+ # Turning off does _NOT_ clear the state at the moment!
+ $self->{Recording} =0;
+ print "Turning off state!\n" if $DEBUGSTATE;
+}
+sub turn_on_recording {
+ my $self=shift;
+ # Previous calls are not recorded of course..
+ print "Turning on state!\n" if $DEBUGSTATE;
+ $self->{Recording} = 1;
+ $self->{State}=PDL::Graphics::State->new() unless defined($self->{State});
+}
+
+sub _add_to_state {
+ my $self=shift;
+ my ($func, $arg, $opt)=@_;
+ my ($pkg, $fname, $line, $funcname, $hasargs, $wantarray,
+ $evaltext, $isrequire, $hints, $bitmask)=caller(1);
+ # We only add if recording has been turned on.
+ print "Adding to state ! $func, $arg, $opt\n" if $DEBUGSTATE;
+ print "State = ".$self->{State}."\n" if $DEBUGSTATE;
+ $self->{State}->add($func, $funcname, $arg, $opt) if $self->{Recording};
+}
+
+sub retrieve_state {
+ my $self=shift;
+ my $state_copy = $self->{State}->copy();
+ print "Retriving state!\n" if $DEBUGSTATE;
+ return $state_copy;
+}
+
+
+#####################################
+# Window related "public" routines. #
+#####################################
+
+sub close {
+ my $self=shift;
+ # let the user know that we've created a file
+ if ( $self->_status() eq 'OPEN' ) {
+ my @info = $self->info( 'HARDCOPY', 'FILE' );
+ print "Created: $info[1]\n" if $info[0] eq 'YES' and $PDL::verbose;
+ pgclos();
+ }
+ $self->{ID}=undef;
+ $self->clear_state();
+}
+
+=head2 options
+
+Access the options used when I<originally> opening the window. At the moment
+this is not updated when the window is changed later.
+
+=cut
+
+sub options {
+ return $_[0]->{Options};
+}
+
+=head2 id
+
+Access the window ID that PGPLOT uses for the present window.
+
+=cut
+
+sub id {
+ return $_[0]->{ID};
+}
+
+=head2 device
+
+This function returns the device type of the present window.
+
+=cut
+
+sub device {
+ return $_[0]->{Device};
+}
+
+=head2 name
+
+Accessor to set and examine the name of a window.
+
+=cut
+
+sub name {
+ my $self=shift;
+ if ($#_>=0) {
+ $self->{Name}=$_[0];
+ }
+ return $self->{Name};
+}
+
+=head2 focus
+
+Set focus for subsequent PGPLOT commands to this window.
+
+=cut
+
+sub focus {
+ my $self=shift;
+ return if !defined($self->{ID});
+
+ &catch_signals;
+
+ my $sid; pgqid($sid);
+ # Only perform a pgslct if necessary.
+ pgslct($self->{ID}) unless $sid == $self->{ID};
+
+ &release_signals;
+}
+
+
+sub hold {
+ my $self=shift;
+ $self->{Hold}=1;
+ $self->_add_to_state(\&hold);
+ return $self->{Hold};
+}
+
+
+sub release {
+ my $self=shift;
+ $self->{Hold}=0;
+ $self->_add_to_state(\&release);
+ return $self->{Hold};
+}
+
+
+sub held {
+ my $self = shift;
+ return $self->{Hold};
+}
+
+
+
+
+=head2 info
+
+=for ref
+
+Get general information about the PGPLOT environment.
+
+=for usage
+
+ @ans = $self->info( @item );
+
+The valid values of C<@item> are as below, where case is not
+important:
+
+ VERSION - What PGPLOT version is in use.
+ STATE - The status of the output device, this is returns 'OPEN'.
+ if the device is open and 'CLOSED' otherwise.
+ USER - The username of the owner of the spawning program.
+ NOW - The current date and time in the format
+ 'dd-MMM-yyyy hh:mm'. Most people are likely to use Perl
+ functions instead.
+ DEVICE * - The current PGPLOT device or file, see also device().
+ FILE * - The filename for the current device.
+ TYPE * - And the device type for the current device.
+ DEV/TYPE * - This combines DEVICE and TYPE in a form that can be used
+ as input to new.
+ HARDCOPY * - This is flag which is set to 'YES' if the current device is
+ a hardcopy device and 'NO' otherwise.
+ TERMINAL * - This flag is set to 'YES' if the current device is the
+ user's terminal and 'NO' otherwise.
+ CURSOR * - A flag ('YES' or 'NO') to inform whether the current device
+ has a cursor.
+
+Those items marced with a C<*> only return a valid answer if
+the window is open. A question mark (C<?>) is returned
+if the item is not recognised or the information is not available.
+
+=cut
+
+#'
+
+sub info {
+ my $self = shift;
+ my @inq;
+ if ( wantarray() ) { @inq = @_; }
+ else { push @ing, $_[0]; }
+
+ &catch_signals;
+
+ $self->focus();
+ my @ans;
+ foreach my $inq ( @inq ) {
+ my ( $state, $len );
+ pgqinf( uc($inq), $state, $len );
+ push @ans, $state;
+ }
+ &release_signals;
+ return wantarray() ? @ans : $ans[0];
+} # info()
+
+
+
+
+
+
+sub panel {
+
+ my $self = shift;
+
+ $self->focus();
+ my ($xpos, $ypos);
+ if ($#_ == 1) {
+ # We have gotten $x and $y..
+ ($xpos, $ypos)=@_;
+ } elsif ($#_ == 0 && ref($_[0]) eq 'ARRAY' ) {
+ ($xpos, $ypos)=@{$_[0]};
+ } elsif ($#_ == 0) {
+ # We have been given a single number... This can be converted
+ # to a X&Y position with a bit of calculation. The code is taken
+ # from one2nd.
+ release_and_barf("panel: Panel numbering starts at 1, not 0\n")
+ if($_[0]<=0);
+
+ my $i=$_[0]-1; # Offset code is 0-based (of course)
+ $xpos = $i % $self->{NX};
+ $i = long($i/$self->{NX});
+ $ypos=$i % $self->{NY};
+ $xpos++; $ypos++; # Because PGPLOT starts at 1..
+ } else {
+ release_and_barf <<'EOD';
+ Usage: panel($xpos, $ypos); or
+ panel([$xpos, $ypos]); or
+ panel($index);
+EOD
+ }
+
+ &catch_signals;
+
+ # We do not subtract 1 from X because we would need to add it again to
+ # have a 1-offset numbering scheme.
+ $self->{CurrentPanel} = ($ypos-1)*$self->{NX}+($xpos);
+ $self->_add_to_state(\&panel, $xpos, $ypos);
+ pgpanl($xpos, $ypos);
+
+ &release_signals;
+}
+
+
+{
+ # To save space and time..
+ my $erase_options = undef;
+ sub erase {
+ my $self = shift;
+
+ # Parse options
+ my $u_opt = shift;
+ if (defined($u_opt) && ref($u_opt) eq 'HASH') {
+ $erase_options = PDL::Options->new({Panel => undef}) if
+ !defined($erase_options);
+ my $o = $erase_options->options($u_opt);
+ # Change panel if requested
+ $self->panel($o->{Panel}) if defined($o->{Panel});
+ } elsif (defined($u_opt)) {
+ # The user has passed a number of reference to array..
+ $self->panel($u_opt);
+ }
+
+ &catch_signals;
+
+ $self->focus();
+ # What should I do with the state here????
+ pgeras();
+ $self->_add_to_state(\&erase, [], $u_opt);
+ # Remove hold.
+ $self->{Hold}=0;
+ }
+
+ &release_signals;
+}
+
+
+##
+## Utility functions
+##
+
+=head2 _extract_hash
+
+This routine takes and array and returns the first hash reference found as
+well as those elements that are I<not> hashes. Note the latter point because
+all other references to hashes in the array will be lost.
+
+=cut
+
+sub _extract_hash {
+ my @opt=@_;
+ #
+ # Given a list, returns a list of hash references and all the rest.
+ #
+ my $count=0;
+ my $hashes=[];
+ foreach (@opt) {
+ push @$hashes, splice(@opt, $count, 1) if ref($_) eq 'HASH';
+ $count++
+ }
+ return (\@opt, $$hashes[0]);
+}
+
+=head2 _parse_unit
+
+Convert a unit string or number into a PGPLOT-certified length unit
+specification, or return undef if it won't go.
+
+=cut
+
+ at __unit_match = (
+ qr/^((\s*0)|(n(orm(al(ized)?)?)?))\s*$/i,
+ qr/^((\s*1)|(i(n(ch(es)?)?)?))\s*$/i,
+ qr/^((\s*2)|(m(m|(illimeter))?s?))\s*$/i,
+ qr/^((\s*3)|(p(ix(el)?)?s?))\s*$/i
+);
+
+sub _parse_unit {
+ # I'm assuming returning undef when $u is undefined is a good thing to do (DJB; 06/28/02)
+ my $u = shift || return undef;
+ # print "parse_unit: got '$u'\n";
+ for my $i (0..$#__unit_match) {
+ return $i if($u =~ m/$__unit_match[$i]/);
+ }
+ return undef;
+}
+
+=head2 _parse_options
+
+This is a convenience routine for parsing a set of options. It returns
+both the full set of options and those that the user has set.
+
+=cut
+
+sub _parse_options {
+
+ my $self=shift;
+ my ($opt, $oin)=@_;
+
+ ## Should do something sensible if $opt is no options object f.i.
+ if (defined($oin) && ref($oin) ne 'HASH') {
+ my ($package, $file, $line, $sub)=caller(1);
+ release_and_barf "_parse_options called by $sub with non-hash options element!";
+ } elsif (!defined($oin)) {
+ my ($package, $file, $line, $sub)=caller(1);
+ warn "_parse_options called by $sub without an options hash! - continuing\n";
+ $oin = {};
+ }
+ my $o=$opt->options($oin);
+ $opt->full_options(0);
+ my $uo=$opt->current();
+ $opt->full_options(1);
+
+ $opt->clear_current();
+
+ return ($o, $uo);
+
+}
+
+
+################################################################
+#
+# GRAPHICS FUNCTIONS below!
+#
+################################################################
+
+############ Local functions #################
+
+=head2 _save_status
+
+Saves the PGPLOT state so that changes to settings can be made and then
+the present state restored by C<_restore_status>.
+
+=cut
+
+sub _save_status {
+ my $self=shift;
+ &catch_signals;
+ pgsave if $self->_status() eq 'OPEN';
+ &release_signals;
+}
+
+=head2 _restore_status
+
+Restore the PGPLOT state. See L</_save_status>.
+
+=cut
+
+sub _restore_status {
+ my $self=shift;
+ &catch_signals;
+ pgunsa if $self->_status() eq 'OPEN';
+ &release_signals;
+}
+
+
+
+=head2 _checkarg
+
+This routine checks and optionally alters the arguments given to it.
+
+=cut
+
+sub _checkarg { # Check/alter arguments utility
+ my $self = shift;
+ my ($arg,$dims,$type,$nobarf) = @_;
+ $type = $PDL_F unless defined $type;
+
+ # nobarf added so the end-user can choose whether to die or not..x
+ $nobarf = 0 unless defined($nobarf);
+ my $ok = 1;
+
+ $arg = topdl($arg); # Make into a pdl
+ $arg = convert($arg,$type) if $arg->get_datatype != $type;
+ if (($arg->getndims > $dims)) {
+ # Get the dimensions, find out which are == 1. If it helps
+ # chuck these off and return trimmed piddle.
+ my $n=nelem(which(pdl($arg->dims)==1));
+ if (($arg->getndims-$n) > $dims) {
+ $ok = 0;
+ release_and_barf "Data is >".$dims."D" unless $nobarf;
+ } else {
+ my $count=0; my $qq;
+ my $s=join ',',
+ map {if ($_ == 1 && $count<$arg->getndims-$dims) {$qq='(0)'; $count++}
+ else {
+ $qq= '';
+ }
+ ; $qq} $arg->dims;
+ $arg=$arg->slice($s);
+ }
+ }
+ $_[0] = $arg if $ok; # Alter
+
+ return $ok;
+}
+
+# a hack to store information in the object.
+# Currently only used by imag() for storing information
+# useful to draw_wedge().
+#
+# This routine needs changing:
+# . store values using PDL::Options, so you can update rather than overwrite
+# . associate the information with a particular window/panel/whatever
+# . clear information when plot erased (correct for current use by imag(),
+# but maybe not in more general cases?)
+#
+# The API is liable to change: you have been warned (Doug Burke)
+#
+sub _store {
+ my $self = shift;
+ release_and_barf 'Usage: _store( $self, $name, $item )' unless $#_ == 1;
+
+ my $name = shift;
+ my $object = shift;
+
+ # create storage space, if needed
+ $self->{_horrible_storage_space} = {}
+ unless defined $self->{_horrible_storage_space};
+
+ # store data
+ $self->{_horrible_storage_space}{$name} = $object;
+
+
+} # sub: _store()
+
+# retrieve information from storage space
+# - same caveats as with _store()
+#
+sub _retrieve {
+ my $self = shift;
+ release_and_barf 'Usage: _retrieve( $self, $name )' unless $#_ == 0;
+
+ my $name = shift;
+
+ release_and_barf "Internal error: no storage space in object"
+ unless exists $self->{_horrible_storage_space};
+
+ if ( exists $self->{_horrible_storage_space}{$name} ) {
+ return $self->{_horrible_storage_space}{$name};
+ } else {
+ return undef;
+ }
+
+} # sub: _retrieve()
+
+##################
+# Options parser #
+##################
+
+
+
+=head2 _set_colour
+
+This is an internal routine that encapsulates all the nastiness of
+setting colours depending on the different PGPLOT colour models (although
+HLS is not supported).
+
+The routine works in the following way:
+
+=over 8
+
+=item *
+
+At initialisation of the plot device the work colour index is set
+to 16. The work index is the index the routine will modify unless the
+user has specified something else.
+
+=item *
+
+The routine should be used after standard interpretation and synonym
+matching has been used. So if the colour is given as input is an integer
+that colour index is used.
+
+=item *
+
+If the colour is a reference the routine checks whether it is an
+C<ARRAY> or a C<PDL> reference. If it is not an error message is given.
+If it is a C<PDL> reference it will be converted to an array ref.
+
+=item *
+
+If the array has four elements the first element is interpreted
+as the colour index to modify and this overrules the setting for the
+work index used internally. Otherwise the work index is used and incremented
+until the maximum number of colours for the output device is reached
+(as indicated by C<pgqcol>). Should you wish to change that you need
+to read the PGPLOT documentation - it is somewhat device dependent.
+
+=item *
+
+When the array has been recognised the R,G and B colours of the
+user-set index or work index is set using the C<pgscr> command and we
+are finished.
+
+=item *
+
+If the input colour instead is a string we try to set the colour
+using the PGPLOT routine C<pgscrn> with no other error-checking. This
+should be ok, as that routine returns a rather sensible error-message.
+
+=back
+
+=cut
+
+{
+ my $work_ci = 16;
+
+ sub _set_colour {
+ my $self = shift;
+ my ($col, $is_textbg) = @_;
+ $is_textbg = 0 if !defined($is_textbg);
+
+ &catch_signals;
+
+ # The colour index to use for user changes.
+ # This is increased until the max of the colour map.
+ # I don't know if this can change, but let's not take any
+ # chances.
+ my ($min_col, $max_col);
+ pgqcol($min_col, $max_col);
+
+ #
+ # Extended treatment of colours - added 2/10/01 JB.
+ #
+ if (ref($col)) {
+ if ((ref($col) eq 'PDL') or (ref($col) eq 'ARRAY')) {
+ my @colvals = (ref($col) eq 'PDL' ? list($col) : @{$col});
+ my ($r, $g, $b)=@colvals;
+ my $index = $work_ci;
+ if ($#colvals == 3) {
+ # This is a situation where the first element is interpreted
+ # as a PGPLOT colour index, otherwise we will use our own
+ # strategy to step through indices.
+ ($index, $r, $g, $b)=@colvals;
+ } else {
+ $work_ci += 1;
+ # NB this does not work on devices with < 16 colours.
+ $work_ci = 16 if $work_ci > $max_col;
+ }
+ pgscr($index, $r, $g, $b);
+
+ if ($is_textbg) {
+ pgstbg($index);
+ } else {
+ pgsci($index);
+ }
+ } else {
+ warn "The colour option must be a number, string, array or PDL!\n";
+ }
+ } else {
+ # Now check if this is a name that could be recognised by pgscrn.
+ # To simplify the logic we first check if $col is a digit.
+ if ($col =~ m/^\s*\d+\s*$/) {
+ if ($is_textbg) {
+ pgstbg($col);
+ } else {
+ pgsci($col);
+ }
+ } else {
+ #
+ # Ok, we either have an untranslated colour name or something
+ # bogus - let PGPLOT deal with that!
+ #
+ my $ier;
+ pgscrn($work_ci, $col, $ier);
+ if ($is_textbg) {
+ pgstbg($work_ci);
+ } else {
+ pgsci($work_ci);
+ }
+ $work_ci += 1;
+ # NB this does not work on devices with < 16 colours.
+ $work_ci = 16 if $work_ci > $max_col;
+ }
+ }
+
+ &release_signals;
+
+ }
+
+}
+
+
+=head2 _standard_options_parser
+
+This internal routine is the default routine for parsing options. This
+routine deals with a subset of options that most routines will accept.
+
+=cut
+
+sub _standard_options_parser {
+ #
+ # Parse the options and act on the values set.
+ #
+ my $self=shift;
+ my ($o)=@_;
+
+ &catch_signals;
+
+ #
+ # The input hash has to contain the options _set by the user_
+ #
+ $self->_set_colour($o->{Colour}) if (exists($o->{Colour}));
+ pgsls($o->{LineStyle}) if exists($o->{LineStyle});
+ pgslw($o->{LineWidth}) if exists($o->{LineWidth});
+ pgscf($o->{Font}) if exists($o->{Font});
+ pgsch($o->{CharSize}) if exists($o->{CharSize});
+ pgsfs($o->{Fill}) if exists($o->{Fill});
+# pgsch($o->{ArrowSize}) if exists($o->{ArrowSize});
+ # Two new options..
+
+
+ my $wo = $self->{PlotOptions}->defaults(); # Window defaults - for some routines below
+
+ # We just need special treatment of the Arrow and Hatch options,
+ # and they are complex for historical reasons...
+
+ if (exists($o->{Arrow})) {
+ #
+ # Set the arrow. The size can be set either independently
+ # using ARROWSIZE or in the hash
+ #
+ # Note the use of $wo to get the true default values here!
+ my ($fs, $angle, $vent)=($wo->{Arrow}{FS}, $wo->{Arrow}{Angle},
+ $wo->{Arrow}{Vent});
+ my $arrowsize = $o->{CharSize}; # Default to the character size..
+ if (ref($o->{Arrow}) eq 'HASH') {
+ while (my ($var, $value)=each %{$o->{Arrow}}) {
+ # options are FS, ANGLE, VENT, SIZE
+ # but SIZE may be ARROWSIZE [see ../PGPLOTOptions.pm]
+ $fs=$value if $var =~ m/^F/i;
+ $vent=$value if $var =~ m/^V/i;
+ $angle=$value if $var =~ m/^AN/i;
+ # not sure about how correct this is, but it stops 'use of undefined'
+ # variable (for $angle) in pgsah() call below
+ $arrowsize=$value if $var =~ m/^S/i or $var =~ m/^AR/i;
+ }
+ } else {
+ $fs=$o->{Arrow}[0] if defined $o->{Arrow}[0];
+ $angle=$o->{Arrow}[1] if defined $o->{Arrow}[1];
+ $vent=$o->{Arrow}[2] if defined $o->{Arrow}[2];
+ $arrowsize=$o->{Arrow}[3] if defined $o->{Arrow}[3];
+ }
+ pgsch($arrowsize) if defined($arrowsize);
+ pgsah($fs, $angle, $vent);
+ }
+
+ if (exists($o->{Hatch})) {
+ my $val = $o->{Hatch};
+ if (!defined($val) || lc($val) eq 'default') {
+ pgshs(); # Default values are either specfied by HATCH=>undef or HATCH=>'default'
+ } else {
+ #
+ # Can either be specified as numbers or as a hash...
+ #
+ # Note the use of $wo to get the true default values!!
+ #
+ my ($angle, $separation, $phase)=
+ ($wo->{Hatch}{Angle}, $wo->{Hatch}{Separation}, $wo->{Hatch}{Phase});
+
+ if (ref($val) eq 'HASH') {
+ while (my ($var, $value) = each %{$val}) {
+ $angle=$value if $var =~ m/^A/i;
+ $separation=$value if $var =~ m/^S/i;
+ $phase=$value if $var =~ m/^P/i;
+ }
+ } else {
+ $angle=$$val[0] if defined($$val[0]);
+ $separation=$$val[1] if defined($$val[1]);
+ $phase=$$val[2] if defined($$val[2]);
+ }
+ if ($separation==0) {
+ warn "The separation of hatch lines cannot be zero, the default of".
+ $wo->{Hatch}{Separation} . " is used!\n";
+ $separation=$wo->{Hatch}{Separation};
+ }
+ pgshs($angle,$separation, $phase);
+ }
+ }
+
+ &release_signals;
+}
+
+# initenv( $xmin, $xmax, $ymin, $ymax, $just, $axis )
+# initenv( $xmin, $xmax, $ymin, $ymax, $just )
+# initenv( $xmin, $xmax, $ymin, $ymax, \%opt )
+#
+# \%opt can be supplied but not be defined
+# we parse the JUSTIFY, AXIS, and BORDER options here,
+# rather than have a multitude of checks below
+#
+
+
+sub initenv{
+ my $self = shift; # Default box
+
+ # We must check the status of the object, and if not ready it must
+ # be re-opened...
+ $self->_status();
+
+ my ($in, $u_opt)=_extract_hash(@_);
+
+ &catch_signals;
+
+ my ($xmin, $xmax, $ymin, $ymax, $just, $axis)=@$in;
+ $u_opt={} unless defined($u_opt);
+
+ ##############################
+ # If the user specifies $just or $axis these values will
+ # override any options given.
+ $u_opt->{Justify} = $just if defined($just);
+ $u_opt->{Axis} = $axis if defined($axis);
+
+ ##############################
+ # Now parse the input options.
+ my $o = $self->{Options}->options($u_opt); # Merge in user options...
+ if ($self->autolog) {
+ # Bug fix JB, 03/03/05 - logging noisy/failed when running with -w or strict.
+ # Hence the extra check on the content of Axis
+ if (ref($o->{Axis}) eq 'ARRAY') {
+ $self->{Logx} = ($o->{Axis}[0] =~ /L/) ? 1 : 0;
+ $self->{Logy} = ($o->{Axis}[1] =~ /L/) ? 1 : 0;
+ } elsif (ref($o->{Axis})) {
+ release_and_barf "The axis option must be an array ref or a scalar!\n";
+ } else {
+ $self->{Logx} = ($o->{Axis} == 10 || $o->{Axis} == 30) ? 1 : 0; #/BCLNST/) ? 1 : 0;
+ $self->{Logy} = ($o->{Axis} == 20 || $o->{Axis} == 30) ? 1 : 0; #/BCLNST/) ? 1 : 0;
+ }
+
+ ($xmin,$xmax) = map {
+ release_and_barf "plot boundaries not positive in logx-mode" if $_ <= 0;
+ log($_)/log(10) } ($xmin,$xmax)
+ if $self->{Logx};
+ ($ymin,$ymax) = map {
+ release_and_barf "plot boundaries not positive in logy-mode" if $_ <= 0;
+ log($_)/log(10) } ($ymin,$ymax)
+ if $self->{Logy};
+ }
+
+ # DJB 2003/12/01 - added some error checking for user errors like
+ # setting xmin==xmax. yeah, should really check abs(x1-x2)<tolerance ;)
+ #
+ release_and_barf "x axis has min==max" if $xmin == $xmax;
+ release_and_barf "y axis has min==max" if $ymin == $ymax;
+
+ if($self->held()) {
+ $self->focus();
+ } else {
+ ##########
+ # Save current colour and set the axis colours
+ my ($col);
+ pgqci($col);
+ $self->_set_colour($o->{AxisColour});
+ # Save current font size and set the axis character size.
+ my ($chsz);
+ pgqch($chsz);
+ pgsch($o->{CharSize});
+
+ if (ref($o->{Border}) eq 'HASH' || $o->{Border} != 0) {
+ my $type = "REL";
+ my $delta = 0.05;
+ if ( ref($o->{Border}) eq "HASH" ) {
+ while (my ($bkey, $bval) = each %{$o->{Border}}) {
+ $bkey = uc($bkey);
+ if ($bkey =~ m/^TYP/) {
+ $type = uc $bval;
+ } elsif ($bkey =~ m/^VAL/) {
+ $delta = $bval;
+ }
+ } # while: (bkey,bval)
+ } # if: ref($val) eq "HASH"
+
+ if ( $type =~ m/^REL/ ) {
+ my $sep = ( $xmax - $xmin ) * $delta;
+ $xmin -= $sep; $xmax += $sep;
+ $sep = ( $ymax - $ymin ) * $delta;
+ $ymin -= $sep; $ymax += $sep;
+ } elsif ( $type =~ m/^ABS/ ) {
+ $xmin -= $delta; $xmax += $delta;
+ $ymin -= $delta; $ymax += $delta;
+ } else {
+ print "Warning: unknown BORDER/TYPE option '$type'.\n";
+ }
+ }
+
+ ##############################
+ # pgpage doesn't behave quite right in the multi-panel case. Hence,
+ # we call erase if there are multiple panels and pgpage if there is only
+ # one.
+ if (defined($o->{Erase}) && $o->{Erase}) {
+ if ($self->{NX}*$self->{NY} > 1) {
+ pgeras();
+ $self->clear_state(); # Added to deal with new pages.
+ } else {
+ $self->clear_state(); # Added to deal with new pages.
+ pgpage();
+ }
+ }
+
+ ##########
+ # Set up the viewport, and get its size in physical screen units.
+ # This has to be done before the PIX/SCALE/PITCH stuff below in order
+ # to make sure we can get physical dimensions of the viewport for scaling,
+ # even though the JUSTIFY stuff redefines the viewport later.
+ #
+ if (!defined($o->{PlotPosition}) || $o->{PlotPosition} eq 'Default') {
+ # Set standard viewport
+ pgvstd();
+ } else {
+ release_and_barf "The PlotPosition must be given as an array reference!" unless
+ ref($o->{PlotPosition}) eq 'ARRAY';
+ my ($x0, $x1, $y0, $y1)=@{$o->{PlotPosition}};
+ print "pgsvp($wx0,$wx1,$wy0,$wy1);\n" if($PDL::Graphics::PGPLOT::debug);
+ pgsvp ($x0, $x1, $y0, $y1);
+ }
+
+ ##############################
+ # Parse out scaling options. The defaults for each value change
+ # based on the others (e.g. specifying "SCALE" and no unit
+ # gives pixels; but specifying "PITCH" and no unit gives dpi).
+ #
+ my($pix,$pitch,$unit);
+
+ ($pix,$pitch,$unit) = (1,1.0/$o->{'Scale'},3)
+ if($o->{'Scale'});
+
+ ($pix,$pitch,$unit) = (1,$o->{'Pitch'},1)
+ if($o->{'Pitch'});
+
+ if(defined $o->{'Unit'}) {
+ $unit = _parse_unit($o->{'Unit'});
+ release_and_barf("Unknown unit '$o->{'Unit'}'\n")
+ unless(defined $unit);
+ }
+
+ $unit = 1 unless defined($unit); # Default to inch (any phys. unit will do)
+
+ ##############################
+ # Get size of viewport in physical screen units
+ my ($x0,$x1,$y0,$y1);
+ pgqvp($unit,$x0,$x1,$y0,$y1);
+
+ # Pixel aspect ratio is always overridden by the pix option
+ $pix = $o->{'Justify'} if $o->{'Justify'}; # Only override if nonzero!
+ $pix = $o->{'Pix'} if defined $o->{'Pix'}; # Override if set.
+
+ ###
+ # Figure out the stretched pitch, if it isn't set.
+ #
+ my $have_pitch_and_pix = (defined($pix) & defined($pitch));
+
+ unless(defined $pitch) {
+ my $p = pdl( ($xmax-$xmin) / ($x1-$x0),
+ ($ymax-$ymin) / ($y1-$y0) * (defined($pix)?$pix:0));
+ $pitch = $p->abs->max;
+ }
+
+ $pix = abs(($y1 - $y0) / ($ymax - $ymin)) * $pitch
+ unless defined($pix);
+
+ ##########
+ # Figure out the actual data coordinate corners of the screen, and/or
+ # tweak the screen to match the data coordinate corners. This is important
+ # because the PIX/SCALE/PITCH options set the scaling explicitly, and
+ # the JUSTIFY option requires changing the viewport.
+ #
+
+ if($o->{Justify}) {
+ ##########
+ # Justify case
+
+ ###
+ # Work out the boundaries of the data in viewport space, given the
+ # pitch and requested pixel aspect ratio. This is complicated a
+ # little by the need to specify the viewport in surface normalized
+ # coordinates: we have to retrieve surface normalized coords to tweak.
+
+ my($ox0,$ox1,$oy0,$oy1);
+ pgqvp(0,$ox0,$ox1,$oy0,$oy1); # Get surface normalized dims of current vp
+
+ my($wxs, $wys) = ( ($ox1-$ox0) / ($x1-$x0) , ($oy1-$oy0) / ($y1-$y0) );
+
+ local($_) = $o->{Align} || "CC";
+ my($wx0,$wx1,$wy0,$wy1);
+
+ my($xrange) = abs(($xmax-$xmin) * $wxs / $pitch );
+ ($wx0,$wx1) =
+ (m/L/i) ? ( $ox0, $ox0 + $xrange ) :
+ (m/R/i) ? ( $ox1 - $xrange, $ox1 ) :
+ (0.5 * ( $ox0 + $ox1 - $xrange ), 0.5 * ( $ox0 + $ox1 + $xrange ));
+
+ my($yrange) = abs(($ymax-$ymin) * $wys * $pix / $pitch );
+ ($wy0,$wy1) =
+ (m/B/i) ? ( $oy0, $oy0 + $yrange ) :
+ (m/T/i) ? ( $oy1 - $yrange, $oy1 ) :
+ (0.5 * ( $oy0 + $oy1 - $yrange ), 0.5 * ( $oy0 + $oy1 + $yrange ));
+
+ pgsvp(minmax(pdl($wx0,$wx1)),minmax(pdl($wy0,$wy1)));
+
+ pgswin($xmin,$xmax,$ymin,$ymax);
+
+ } elsif($have_pitch_and_pix) {
+
+ ##########
+ # Non-justify case with specified pitch and pixel aspect.
+
+ my($xx0,$xx1,$yy0,$yy1); # These get the final data coords
+
+ ###
+ # Work out the boundaries of the viewport in data space, given the
+ # pitch and requested pixel aspect ratio.
+ local($_) = $o->{Align} || "BL";
+
+ ($xx0,$xx1) =
+ (m/L/i) ? ($xmin, $xmin+($x1-$x0)*$pitch) :
+ (m/R/i) ? ($xmax-($x1-$x0)*$pitch, $xmax) :
+ (0.5*($xmin+$xmax - ($x1-$x0)*$pitch),
+ 0.5*($xmin+$xmax + ($x1-$x0)*$pitch));
+
+ ($yy0,$yy1) =
+ (m/B/i) ? ($ymin, $ymin+($y1-$y0)*$pitch/$pix) :
+ (m/T/i) ? ($ymax-($y1-$y0)*$pitch/$pix, $ymax) :
+ (0.5*($ymin+$ymax - ($y1-$y0)*$pitch/$pix),
+ 0.5*($ymin+$ymax + ($y1-$y0)*$pitch/$pix));
+
+ #
+ # Sort out the direction that each axis runs...
+ #
+ my ( $dax, $day );
+ unless(defined $o->{DirAxis}) {
+ ($dax,$day) = (0,0);
+ } elsif( ! ref $o->{DirAxis} ) {
+ $dax=$day=$o->{DirAxis};
+ } elsif( ref $o->{DirAxis} eq 'ARRAY' ) {
+ ($dax,$day) = @{$o->{DirAxis}};
+ } else {
+ release_and_barf "DirAxis option must be a scalar or array\n";
+ }
+
+ ##print "dax=$dax; day=$day\n";
+ ( $xx0, $xx1 ) = ( $xx1, $xx0 )
+ if ( ( $dax==0 and ($xmin-$xmax)*($xx0-$xx1)<0 )
+ or ( $dax < 0 )
+ );
+
+ ( $yy0, $yy1 ) = ( $yy1, $yy0 )
+ if ( ( $day==0 and ($ymin-$ymax)*($yy0-$yy1)<0 )
+ or ( $day < 0 )
+ );
+
+ pgswin($xx0, $xx1, $yy0, $yy1);
+
+ } else {
+ ###
+ # Simplest case -- just do what the user originally said.
+ #
+ pgswin($xmin,$xmax,$ymin,$ymax);
+
+ }
+
+ if (ref($o->{Axis}) eq 'ARRAY') {
+ print "found array ref axis option...\n" if($PDL::Graphics::PGPLOT::debug);
+ pgtbox($o->{Axis}[0], 0.0, 0, $o->{Axis}[1], 0.0, 0);
+ } else {
+ pgtbox($o->{Axis}, 0.0, 0, $o->{Axis}, 0.0, 0);
+ }
+
+ $self->_set_env_options($xmin, $xmax, $ymin, $ymax, $o);
+ $self->label_axes($u_opt->{XTitle}, $u_opt->{YTitle}, $u_opt->{Title},
+ $u_opt);
+
+ # restore settings
+ $self->_set_colour($col);
+ pgsch($chsz);
+
+ } # end of not-held case
+
+ &release_signals;
+
+ 1;
+}
+
+# This is a tidy little routine to set the env options and update the global
+# variable.
+sub _set_env_options {
+ my $self=shift;
+ my @opt=@_;
+
+ $self->{_env_options} = [@opt];
+ $PREVIOUS_ENV = [@opt];
+}
+
+sub redraw_axes {
+ my $self = shift;
+
+ &catch_signals;
+
+ my $o;
+ if (defined($self->{_env_options})) {
+ # Use the previous settings for the plot box.
+ my $e = $self->{_env_options};
+ $o=$$e[4];
+ } else {
+ $o=$self->{Options}->defaults();
+ }
+ my $col;
+ pgqci($col);
+ $self->_set_colour($o->{AxisColour});
+ my $chsz;
+ pgqch($chsz);
+ pgsch($o->{CharSize});
+ my $axval = $o->{Axis}; # Using the last for this window...
+ $axval = 0 unless defined $axval; # safety check
+ unless ( $self->{Hold} ) {
+ if ( ref($axval) ) {
+ pgtbox($$axval[0],0,0,$$axval[1],0,0);
+ } else {
+ pgtbox($axval,0,0,$axval,0,0);
+ }
+ }
+ $self->_set_colour($col);
+ pgsch($chsz);
+
+ $self->_add_to_state(\&redraw_axes);
+
+ &release_signals;
+}
+
+
+=head2 _image_xyrange
+
+Given a PGPLOT tr matrix and an image size, calculate the
+data world coordinates over which the image ranges. This is
+used in L<imag|imag> and L<cont|cont>. It keeps track of the
+required half-pixel offset to display images properly -- eg
+feeding in no tr matrix at all, nx=20, and ny=20 will
+will return (-0.5,19.5,-0.5,19.5). It also checks the options
+hash for XRange/YRange specifications and, if they are present, it
+overrides the appropriate output with the exact ranges in those fields.
+
+=cut
+
+sub _image_xyrange {
+ my($tr,$nx,$ny,$opt) = @_;
+
+ # Set identity $tr if no $tr is passed in. This looks funny
+ # because it's designed for use with evil Fortran coordinates.
+ if(!defined($tr)) {
+ $tr = float [-1,1,0,-1,0,1];
+ }
+
+
+ ##############################
+ ## Because the transform is an inhomogeneous scale-and-rotate,
+ ## the limiting points are always the corners of the original
+ ## physical data plane after transformation. We just tranform
+ ## the four corners of the data (in evil homogeneous FORTRAN
+ ## origin-at-1 coordinates) and find the minimum and maximum
+ ## X and Y values of 'em all.
+
+ my @xvals;
+ if(ref $opt eq 'HASH' and defined $opt->{XRange}) {
+ die "_image_xyrange: if XRange is specified it must be an array ref\n"
+ if(ref $opt->{XRange} ne 'ARRAY');
+ @xvals = @{$opt->{XRange}};
+ } else {
+ @xvals = ($tr->(0:2)*pdl[
+ [1, 0.5, 0.5],
+ [1, 0.5, $nx+0.5],
+ [1, $nx+0.5, 0.5],
+ [1, $nx+0.5, $nx+0.5]
+ ])->sumover->minmax;
+ }
+
+ my @yvals;
+ if(ref $opt eq 'HASH' and defined $opt->{YRange}) {
+ die "_image_xyrange: if YRange is specified it must be an array ref\n"
+ if(ref $opt->{YRange} ne 'ARRAY');
+ @yvals = @{$opt->{YRange}};
+ } else {
+ @yvals = ($tr->(3:5)*pdl[
+ [1, 0.5, 0.5],
+ [1, 0.5, $ny+0.5],
+ [1, $ny+0.5, 0.5],
+ [1, $ny+0.5, $ny+0.5]
+ ])->sumover->minmax;
+ }
+
+ if ( $tr->at(1) < 0 ) { @xvals = ( $xvals[1], $xvals[0] ); }
+ if ( $tr->at(5) < 0 ) { @yvals = ( $yvals[1], $yvals[0] ); }
+
+ return (@xvals, at yvals);
+}
+
+
+=head2 _FITS_tr
+
+Given a FITS image, return the PGPLOT transformation matrix to convert
+pixel coordinates to scientific coordinates. Used by
+L<fits_imag|/fits_imag>, L<fits_rgbi|/fits_rgbi>, and
+L<fits_cont|/fits_cont>, but may come in handy for other methods.
+
+=for example
+
+ my $tr = _FITS_tr( $win, $img );
+ my $tr = _FITS_tr( $win, $img, $opts );
+
+The return value (C<$tr> in the examples above) is the same as
+returned by the L<transform()|/transform> routine, with values
+set up to convert the pixel to scientific coordinate values for the
+two-dimensional image C<$img>. The C<$opts> argument is optional
+and should be a HASH reference; currently it only understands
+one key (any others are ignored):
+
+ WCS => undef (default), "", or "A" to "Z"
+
+Both the key name and value are case insensitive. If left as C<undef>
+or C<""> then the primary coordinate mapping from the header is used, otherwise
+use the additional WCS mapping given by the appropriate letter.
+We make B<no> checks that the given mapping is available; the routine
+falls back to the unit mapping if the specified system is not available.
+
+The WCS option has only been tested on images from the Chandra X-ray satellite
+(L<http://chandra.harvard.edu/>) created by the CIAO software
+package (L<http://cxc.harvard.edu/ciao/>), for which you should
+set C<WCS =E<gt> "P"> to use the C<PHYSICAL> coordinate system.
+
+See L<http://fits.cv.nrao.edu/documents/wcs/wcs.html> for further
+information on the Representation of World Coordinate Systems in FITS.
+
+=cut
+
+{
+ my $_FITS_tr_opt = undef;
+
+ sub _FITS_tr {
+ my $pane = shift;
+ my $pdl = shift;
+ my $opts = shift || {};
+
+ $_FITS_tr_opt = PDL::Options->new( { WCS => undef } )
+ unless defined $_FITS_tr_opt;
+ my $user_opts = $_FITS_tr_opt->options( $opts );
+
+ # Can either be sent a piddle or a hash reference for the header
+ # information
+ #
+ my $isapdl = UNIVERSAL::isa($pdl,'PDL');
+ my $hdr = $isapdl ? $pdl->hdr() : $pdl->hdr;
+
+ print STDERR
+ "Warning: null FITS header in _FITS_tr (do you need to set hdrcpy?)\n"
+ unless (scalar(keys %$hdr) || (!$PDL::debug));
+
+ my ( $cdelt1, $cpix1, $cval1, $n1 );
+ my ( $cdelt2, $cpix2, $cval2, $n2 );
+ my $angle;
+
+ # what WCS system to use? Not sure how well we are following the
+ # Greisen et al proposal/standard here.
+ #
+ my $id = "";
+ if ( defined $$user_opts{WCS} ) {
+ $id = uc( $$user_opts{WCS} );
+ die "WCS option must either be 'undef' or A-Z, not $id\n"
+ unless $id =~ /^[A-Z]?$/;
+ }
+ print "Using the WCS '$id' mapping (if it exists)\n"
+ if $PDL::verbose and $id ne "";
+
+ {
+ # don't complain about missing fields in fits headers
+ no warnings;
+
+ if ( $isapdl ) {
+ ( $n1, $n2 ) = $pdl->dims;
+ } else {
+ $n1 = $hdr->{NAXIS1};
+ $n2 = $hdr->{NAXIS2};
+ }
+
+ $cdelt1 = $hdr->{"CDELT1$id"} || 1.0;
+ $cpix1 = $hdr->{"CRPIX1$id"} || 1;
+ $cval1 = $hdr->{"CRVAL1$id"} || 0.0;
+
+ $cdelt2 = $hdr->{"CDELT2$id"} || 1.0;
+ $cpix2 = $hdr->{"CRPIX2$id"} || 1;
+ $cval2 = $hdr->{"CRVAL2$id"} || 0.0;
+
+ # changed Jan 14 2004 DJB - previously used CROTA
+ # keyword but that is not in the WCS standard
+ # - I hope this doesn't break things
+ # -- This broke a few things because CROTA is a pseudostandard
+ # in the solar physics community. I added a fallback to
+ # CROTA in case CROTA2 doesn't exist. --CED
+ # 13-Apr-2010: changed sign of CROTA2 to match update to PDL::Transform in 2.4.3 --CED
+ $angle = - ( (defined $hdr->{"CROTA2$id"}) ? $hdr->{"CROTA2$id"} :
+ (defined $hdr->{"CROTA"}) ? $hdr->{"CROTA"} : 0) *
+ 3.14159265358979323846264338/180;
+
+ } # no warnings;
+
+ #
+ # Here's what we would do if PGPLOT worked as advertised...
+ #
+ return transform( $pane, {
+ ImageDimensions => [ $n1, $n2 ],
+ Angle => $angle,
+ Pixinc => [ $cdelt1, $cdelt2 ],
+ RefPos => [ [$cpix1-1, $cpix2-1], [$cval1,$cval2] ]
+ } );
+ #
+ # Here's a failed attempt to compensate for the PGPLOT-induced jitter
+ # (look closely at the "demo transform" rotating screens and you'll
+ # see a small movement...)
+ #
+ # $offset = sqrt(0.5)* max abs cos ( $angle + pdl(-1,1)*0.25*3.14159 );
+ # return transform( $pane, {
+ # ImageDimensions => [ $n1, $n2 ],
+ # Angle => $angle,
+ # Pixinc => [ $cdelt1, $cdelt2 ],
+ # RefPos => [ [$cpix1-1-$offset, $cpix2-1-$offset], [$cval1,$cval2] ]
+ # } );
+
+
+ } # sub: _FITS_tr
+
+} # "closure" around _FITS_tr
+
+sub label_axes {
+ # print "label_axes: got ",join(",", at _),"\n";
+ my $self = shift;
+ my ($in, $opt)=_extract_hash(@_);
+
+ &catch_signals;
+
+ # :STATE RELATED:
+ # THIS WILL PROBABLY NOT WORK as label_axes can be called both by
+ # the user directly and by env... Let's see.
+ $self->_add_to_state(\&label_axes, $in, $opt);
+
+ release_and_barf 'Usage: label_axes( [$xtitle, $ytitle, $title], [$opt])' if $#$in > 3;
+
+ my ($xtitle, $ytitle, $title)=@$in;
+
+ $opt = {} if !defined($opt); # For safety.
+
+ # Now the titles are set per plot so we use the general options to
+ # parse the options (if they were set per window we would use
+ # $self->{Options}
+ my ($o, $u_opt) = $self->_parse_options($self->{PlotOptions}, $opt);
+
+ # Added 25/8/01 JB to check whether label_axes is called before env..
+ # This is not fool-proof though... And it will give a warning if the
+ # user creates her/his env box outside of this package.
+ warn "label_axes called before env - weird results might occur!\n" unless
+ defined($self->{_env_options});
+
+ $self->_save_status();
+ $self->_standard_options_parser($u_opt);
+ $o->{Title}=$title if defined($title);
+ $o->{XTitle}=$xtitle if defined($xtitle);
+ $o->{YTitle}=$ytitle if defined($ytitle);
+
+ # what width do we use?
+ # - things are somewhat confused since we have
+ # LineWidth and TextWidth (a recent addition)
+ # and LineWidth is set by _setup_window() - so
+ # _standard_options_parser() uses it - but
+ # TextWidth isn't.
+ #
+ # so for now we over-ride the _standard_options_parser
+ # setting if TextWidth exists
+ # [DJB 2002 Aug 08]
+ my $old_lw;
+ if ( defined($o->{TextWidth}) ) {
+ pgqlw($old_lw);
+ pgslw($o->{TextWidth});
+ }
+
+ # pglab by default goes too far from the plot! If NYPanels > 1
+ # then the bottom label of a higher plot tends to squash the plot
+ # title for the plot below it. To remedy this problem I've
+ # replaced the pglab call with a set of calls to pgmtxt, cribbed
+ # from the pglab.f file. The parameters are shrunk inward if NYPanel > 1
+ # or if the option "TightLabels" is set. You can also explicitly set
+ # it to 0 to get the original broken behavior. [CED 2002 Aug 29]
+
+ $label_params = [ [2.0, 3.2, 2.2], # default
+ [1.0, 2.7, 2.2], # tightened
+ ]
+ unless defined($label_params);
+
+ my($p) = $label_params->[ ( ($self->{NY} > 1 && !defined $o->{TightLabels})
+ || $o->{TightLabels}
+ ) ? 1 : 0 ];
+ my($sz);
+ pgqch($sz);
+
+ pgbbuf(); # Begin a buffered batch output to the device
+ pgsch($sz * ( $o->{TitleSize} || 1 ));
+ # The 'T' offset is computed so that the original
+ # vertical center is maintained.
+ pgmtxt('T', ($p->[0]+0.5)/( $o->{TitleSize} || 1 ) - 0.5 , 0.5, 0.5, $o->{Title});
+
+ pgebuf(); # Flush the buffer to avoid a pgplot bug that produced
+ pgbbuf(); # doubled titles for some devices (notably the ppm device).
+
+ pgsch($sz);
+ pgmtxt('B', $p->[1], 0.5, 0.5, $o->{XTitle});
+ pgmtxt('L', $p->[2], 0.5, 0.5, $o->{YTitle});
+ pgebuf();
+
+# pglab($o->{XTitle}, $o->{YTitle}, $o->{Title});
+
+
+ pgslw($old_lw) if defined $old_lw;
+ $self->_restore_status;
+ &release_signals;
+
+}
+
+
+############ Exported functions #################
+
+# Open/reopen the graphics device
+
+################ Supports two new options::
+## NewWindow and WindowName
+
+
+sub CtoF77coords{ # convert a transform array from zero-offset to unit-offset images
+ my $self = shift;
+ my $tr = pdl(shift); # Copy
+ set($tr, 0, at($tr,0)-at($tr,1)-at($tr,2));
+ set($tr, 3, at($tr,3)-at($tr,4)-at($tr,5));
+ return $tr;
+}
+
+
+
+# set the envelope for plots and put auto-axes on hold
+
+sub env {
+ my $self=shift;
+
+ # Inserted 28/2/01 - JB to avoid having to call release whenever
+ # you want to move to the next panel after using env.
+ $self->release() if $self->held();
+ # The following is necessary to advance the panel if wanted...
+ my ($in, $opt)=_extract_hash(@_);
+ $opt = {} if !defined($opt);
+ my $o = $self->{PlotOptions}->options($opt);
+
+ #
+ # Inserted 06/08/01 - JB to be able to determine whether the user has
+ # specified a particular PlotPosition in which case we do _not_ call
+ # _check_move_or_erase...
+ #
+ my $o2 = $self->{Options}->options($opt);
+ if (!defined($o2->{PlotPosition}) || $o2->{PlotPosition} eq 'Default') {
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+ }
+
+ release_and_barf 'Usage: env ( $xmin, $xmax, $ymin, $ymax, [$just, $axis, $opt] )'
+ if ($#_==-1 && !defined($self->{_env_options}) && !defined($PREVIOUS_ENV)) ||
+ ($#_>=0 && $#_<=2) || $#_>6;
+ my(@args);
+
+ # Set the args. The logic here was extended 13/8 by JB to use the
+ # previous setting of the plot env variables regardless of device
+ # if the current device does not have a setting for env etc.
+ if ($#_ == -1) {
+ if (@{$self->{_env_options}}) {
+ @args = @{$self->{_env_options}};
+ } elsif (defined($PREVIOUS_ENV)) {
+ @args = @{$PREVIOUS_ENV};
+ } else {
+ @args = ();
+ }
+ } else {
+ @args = @_;
+ }
+ $self->initenv( @args );
+ ## The adding to state has to take place here to avoid being cleared
+ ## buy the call to initenv...
+ $self->_add_to_state(\&env, $in, $opt);
+ $self->hold();
+
+
+ 1;
+}
+
+# Plot a histogram with pgbin()
+
+{
+ my $bin_options = undef;
+
+
+ sub bin {
+ my $self = shift;
+ if (!defined($bin_options)) {
+ $bin_options = $self->{PlotOptions}->extend({Centre => 1});
+ $bin_options->add_synonym({Center => 'Centre'});
+ }
+ my ($in, $opt)=_extract_hash(@_);
+ $self->_add_to_state(\&bin, $in, $opt);
+
+
+ &catch_signals;
+
+ release_and_barf 'Usage: bin ( [$x,] $data, [$options] )' if $#$in<0 || $#$in>2;
+ my ($x, $data)=@$in;
+
+ $self->_checkarg($x,1);
+
+ my $n = nelem($x);
+ if ($#$in==1) {
+ $self->_checkarg($data,1); release_and_barf '$x and $y must be same size' if $n!=nelem($data);
+ } else {
+ $data = $x; $x = float(sequence($n));
+ }
+
+ # Parse options
+ $opt={} unless defined($opt);
+ my ($o, $u_opt) = $self->_parse_options($bin_options,$opt);
+
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+ unless ( $self->held() ) {
+ my ($xmin, $xmax)=ref $o->{XRange} eq 'ARRAY' ?
+ @{$o->{XRange}} : minmax($x);
+ my ($ymin, $ymax)=ref $o->{YRange} eq 'ARRAY' ?
+ @{$o->{YRange}} : minmax($data);
+ if ($xmin == $xmax) { $xmin -= 0.5; $xmax += 0.5; }
+ if ($ymin == $ymax) { $ymin -= 0.5; $ymax += 0.5; }
+ $self->initenv( $xmin, $xmax, $ymin, $ymax, $opt );
+ }
+ $self->_save_status();
+
+ my $centre = $o->{Centre};
+
+ # For the standard parser we only want the options that the user set!
+ # $bin_options->full_options(0);
+ # my $u_opt = $bin_options->current();
+ # $bin_options->full_options(1);
+
+ # Let's also parse the options if any.
+ $self->_standard_options_parser($u_opt);
+ pgbin($n, $x->get_dataref, $data->get_dataref, $centre);
+ $self->_restore_status();
+
+ &release_signals;
+ 1;
+ }
+}
+
+
+
+
+{
+ use strict;
+ my $transform_options = undef;
+
+ sub transform {
+ # Compute the transform array needed in contour and image plotting
+ my $self = shift;
+
+ if (!defined($transform_options)) {
+ $transform_options =
+ $self->{PlotOptions}->extend({Angle => undef,
+ ImageDims => undef,
+ Pixinc => undef,
+ ImageCenter => undef,
+ RefPos => undef
+ });
+ $transform_options->synonyms({
+ ImageDimensions => 'ImageDims',
+ ImageCentre => 'ImageCenter',
+ ReferencePosition => 'RefPos',
+ });
+ }
+
+ # parse the input
+ my ($in, $opt)=_extract_hash(@_);
+ my ($x_pix, $y_pix)= @$in;
+
+ # handle options
+ $opt = {} if !defined($opt);
+ my ($o, $u_opt) = $self->_parse_options($transform_options, $opt);
+ $self->_standard_options_parser($u_opt);
+
+ my ($angle, $x_pixinc, $y_pixinc, $xref_pix, $yref_pix, $xref_wrld, $yref_wrld);
+ if (defined($o->{Angle})) {
+ $angle = $o->{Angle};
+ }
+ else {
+ $angle = 0;
+ }
+
+ if (defined($o->{Pixinc})) {
+ if (ref($o->{Pixinc}) eq 'ARRAY') {
+ ($x_pixinc, $y_pixinc) = @{$o->{Pixinc}};
+ }
+ else {
+ $x_pixinc = $y_pixinc = $o->{Pixinc};
+ }
+ }
+ else {
+ $x_pixinc = $y_pixinc = 1;
+ }
+
+ if ( defined $o->{ImageDims} ) {
+ if ( ref($o->{ImageDims}) eq 'ARRAY' ) {
+ ($x_pix, $y_pix) = @{$o->{ImageDims}};
+ }
+ else {
+ release_and_barf "Image dimensions must be given as an array reference!";
+ }
+ }
+
+ # The user has to pass the dimensions of the image somehow, so this
+ # is a good point to check whether he/she/it has done so.
+ unless (defined($x_pix) && defined($y_pix)) {
+ release_and_barf "You must pass the image dimensions to the transform routine\n";
+ }
+
+ # The RefPos option gives more flexibility than
+ # ImageCentre, since ImageCentre => [ a, b ] is the same
+ # as PosReference => [ [(nx-1)/2,(ny-1/2)], [a,b] ].
+ # We use ImageCentre in preference to PosReference
+ #
+ if (defined $o->{ImageCenter}) {
+ print "transform() ignoring RefPos as seen ImageCentre\n"
+ if defined $o->{RefPos} and $PDL::verbose;
+ my $ic = $o->{ImageCenter};
+ if (ref($ic) eq 'ARRAY') {
+ ($xref_wrld, $yref_wrld) = @{$ic};
+ }
+ else {
+ $xref_wrld = $yref_wrld = $ic;
+ }
+
+ $xref_pix = ($x_pix - 1)/2;
+ $yref_pix = ($y_pix - 1)/2;
+
+ }
+ elsif ( defined $o->{RefPos} ) {
+ my $aref = $o->{RefPos};
+ release_and_barf "RefPos option must be sent an array reference.\n"
+ unless ref($aref) eq 'ARRAY';
+ release_and_barf "RefPos must be a 2-element array reference\n"
+ unless $#$aref == 1;
+ my $pixref = $aref->[0];
+ my $wrldref = $aref->[1];
+ release_and_barf "Elements of RefPos must be 2-element array references\n"
+ unless $#$pixref == 1 and $#$wrldref == 1;
+
+ ($xref_pix, $yref_pix) = @{$pixref};
+ ($xref_wrld, $yref_wrld) = @{$wrldref};
+ }
+ else {
+ $xref_wrld = $yref_wrld = 0;
+ $xref_pix = ($x_pix - 1)/2;
+ $yref_pix = ($y_pix - 1)/2;
+ }
+
+ # The elements of the transform piddle,
+ # here labelled t0 to t5, relate to the
+ # following maxtix equation:
+ #
+ # world = zp + matrix * pixel
+ #
+ # world - the position of the point in the world,
+ # ie plot, coordinate system
+ # pixel - the position of the point in pixel
+ # coordinates (bottom-left is 0,0 pixel)
+ # zp - (t0)
+ # (t3)
+ # matrix - (t1 t2)
+ # (t4 t5)
+ #
+ my $ca = cos( $angle );
+ my $sa = sin( $angle );
+ my $t1 = $x_pixinc * $ca;
+ my $t2 = $y_pixinc * $sa;
+ my $t4 = -$x_pixinc * $sa;
+ my $t5 = $y_pixinc * $ca;
+
+ return pdl(
+ $xref_wrld - $t1 * $xref_pix - $t2 * $yref_pix,
+ $t1, $t2,
+ $yref_wrld - $t4 * $xref_pix - $t5 * $yref_pix,
+ $t4, $t5
+ );
+ }
+}
+
+
+# display a contour map of an image using pgconb()
+
+{
+
+ my $cont_options = undef;
+
+
+ sub cont {
+ my $self=shift;
+ if (!defined($cont_options)) {
+ $cont_options = $self->{PlotOptions}->extend({Contours => undef,
+ Follow => 0,
+ Labels => undef,
+ LabelColour => undef,
+ Missing => undef,
+ NContours => undef,
+ FillContours => undef});
+ my $t = {
+ LabelColour => {
+ 'White' => 0, 'Black' => 1, 'Red' => 2,
+ 'Green' => 3, 'Blue' => 4, 'Cyan' => 5,
+ 'Magenta' => 6, 'Yellow' => 7, 'Orange' => 8,
+ 'DarkGray' => 14, 'DarkGrey' => 14,
+ 'LightGray' => 15, 'LightGrey' => 15
+ }
+ };
+ $cont_options->add_translation($t);
+ }
+
+
+ my ($in, $opt)=_extract_hash(@_);
+ $self->_add_to_state(\&cont, $in, $opt);
+
+ release_and_barf 'Usage: cont ( $image, %options )' if $#$in<0;
+
+ &catch_signals;
+
+ # Parse input
+ my ($image, $contours, $tr, $misval) = @$in;
+ $self->_checkarg($image,2);
+ my($nx,$ny) = $image->dims;
+ my ($ncont)=9; # The number of contours by default
+
+ # First save the present status
+ $self->_save_status();
+
+
+ # Then parse the common options
+ #
+ # These will be all options.
+ $opt = {} if !defined($opt);
+ my ($o, $u_opt) = $self->_parse_options($cont_options, $opt);
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+ $self->_standard_options_parser($u_opt);
+ my ($labelcolour);
+ pgqci($labelcolour); # Default let the labels have the chosen colour.
+
+
+ my ($labels, $fillcontours, $angle);
+ my $usepgcont = 0;
+
+ $contours = $o->{Contours} if defined($o->{Contours});
+ $ncont = $o->{NContours} if defined($o->{NContours});
+ $misval = $o->{Missing} if defined($o->{Missing});
+ $tr = $o->{Transform} if defined($o->{Transform});
+ $labelcolour = $o->{LabelColour} if defined($o->{LabelColour});
+ $labels = $o->{Labels} if defined($o->{Labels});
+ $usepgcont = $o->{Follow} if defined($o->{Follow});
+ $fillcontours = $o->{FillContours} if defined($o->{FillContours});
+
+ if (defined($tr)) {
+ $self->_checkarg($tr,1);
+ release_and_barf '$transform incorrect' if nelem($tr)!=6;
+ } else {
+ $tr = float [0,1,0, 0,0,1];
+ }
+
+ $tr = $self->CtoF77coords($tr);
+
+ if (!$self->held()) {
+ $self->initenv( _image_xyrange($tr,$nx,$ny,$o), $o );
+ }
+
+ if (!defined($contours)) {
+ my($minim, $maxim)=minmax($image);
+ $contours = xlinvals(zeroes($ncont), $minim, $maxim)
+ }
+ else {
+ $ncont = nelem($contours);
+ }
+
+ $self->_checkarg($contours,1);
+
+ print "Contouring $nx x $ny image from ",min($contours), " to ",
+ max($contours), " in ",nelem($contours)," steps\n" if $PDL::verbose;
+
+ if (defined($fillcontours)) {
+ pgbbuf();
+ if (ref $fillcontours ne PDL) {
+ $fillcontours = zeroes($ncont - 1)->xlinvals(0,1)->dummy(0,3);
+ } elsif ($fillcontours->getndims == 1) {
+ $fillcontours = $fillcontours->dummy(0,3);
+ } elsif (($fillcontours->getdim(1) != $ncont - 1) ||
+ ($fillcontours->getdim(0) != 3)) {
+ release_and_barf "Argh, wrong dims in filled contours!";
+ }
+ my ($cr, $cg, $cb, $i);
+ pgqcr(16, $cr, $cg, $cb); # Save color index 16
+ # Loop over filled contours (perhaps should be done in PP for speed)
+ # Do not shade negative and 0-levels
+ for ($i = 0; $i < ($ncont - 1); $i++) {
+ pgscr(16, list $fillcontours->(:,$i));
+ pgsci(16);
+ pgconf($image->get_dataref, $nx, $ny,
+ 1, $nx, 1, $ny,
+ list($contours->($i:($i+1))), $tr->get_dataref);
+ }
+ pgscr(16, $cr, $cg, $cb); # Restore color index 16
+ pgebuf();
+ } elsif (defined($misval)) {
+ pgconb( $image->get_dataref, $nx,$ny,1,$nx,1,$ny,
+ $contours->get_dataref,
+ nelem($contours), $tr->get_dataref, $misval);
+ } elsif (abs($usepgcont) == 1) {
+ pgcont( $image->get_dataref, $nx,$ny,1,$nx,1,$ny,
+ $contours->get_dataref,
+ $usepgcont*nelem($contours), $tr->get_dataref);
+ } else {
+ pgcons( $image->get_dataref, $nx,$ny,1,$nx,1,$ny,
+ $contours->get_dataref, nelem($contours), $tr->get_dataref);
+ }
+
+ # Finally label the contours.
+ if (defined($labels) && $#$labels+1==nelem($contours)) {
+
+ my $label=undef;
+ my $count=0;
+ my $minint=long($nx/10)+1; # At least stretch a tenth of the array
+ my $intval=long($nx/3)+1; #
+
+ my $dum;
+ pgqci($dum);
+ $self->_set_colour($labelcolour);
+ foreach $label (@{$labels}) {
+ pgconl( $image->get_dataref, $nx,$ny,1,$nx,1,$ny,
+ $contours->(($count)),
+ $tr->get_dataref, $label, $intval, $minint);
+ $count++;
+ }
+ $self->_set_colour($dum);
+ } elsif (defined($labels)) {
+ #
+ # We must have had the wrong number of labels
+ #
+ warn <<EOD
+ You must specify the same number of labels as contours.
+ Labelling has been ignored.
+EOD
+
+ }
+
+ # Restore attributes
+ $self->redraw_axes unless $self->held(); # Redraw box
+ $self->_restore_status();
+
+ &release_signals;
+
+ 1;
+ }
+}
+
+# Plot errors with pgerrb()
+
+{
+
+ my $errb_options = undef;
+
+ sub errb {
+ my $self = shift;
+ if (!defined($errb_options)) {
+ $errb_options = $self->{PlotOptions}->extend({Term => 1});
+ $errb_options->add_synonym({Terminator => 'Term'});
+ }
+ my ($in, $opt)=_extract_hash(@_);
+ $self->_add_to_state(\&bin, $in, $opt);
+
+ &catch_signals;
+
+ $opt = {} if !defined($opt);
+
+ release_and_barf <<'EOD' if @$in==0 || @$in==1 || @$in > 7;
+ Usage: $w-> errb ( $y, $yerrors [, $options] )
+ $w-> errb ( $x, $y, $yerrors [, $options] )
+ $w-> errb ( $x, $y, $xerrors, $yerrors [, $options])
+ $w-> errb ( $x, $y, $xloerr, $xhierr, $yloerr, $yhierr [, $options])
+EOD
+
+ my @t=@$in;
+ my $n;
+
+ # it's possible the user slipped in undefs as the data position.
+ # that's illegal and won't be caught in next loop
+ barf "Must specify data position"
+ if ! defined $t[0] || ( @t > 2 && ! defined $t[1] );
+
+ # loop over input data; skip undefined values, as they are
+ # used to flag missing error bars. all data should have the
+ # same dims as the first piddle.
+ for ( my $i = 0 ; $i < @t ; $i++ )
+ {
+ next if ! defined $t[$i];
+
+ $self->_checkarg($t[$i], 1);
+
+ $n = nelem($t[$i]) if $i == 0;
+ barf "Args must have same size" if nelem($t[$i]) != $n;
+ }
+
+ my $x = @t < 3 ? float(sequence($n)) : shift @t;
+ my $y = shift @t;
+
+ # store data in a hash to automate operations
+ my %d;
+ $d{x}{data} = $x;
+ $d{y}{data} = $y;
+
+ ( $d{y}{err} ) = @t if @t == 1;
+ ( $d{x}{err}, $d{y}{err} ) = @t if @t == 2;
+ ( $d{x}{loerr}, $d{x}{hierr},
+ $d{y}{loerr}, $d{y}{hierr} ) = @t if @t == 4;
+
+ my ($o, $u_opt) = $self->_parse_options($errb_options, $opt);
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+ unless( $self->held() ) {
+ # Allow for the error bars
+ my ( $xmin, $xmax, $ymin, $ymax );
+
+
+ # Bug fix, JB 03/03/05 - user input ranges were not considered.
+ my @axes_to_do = ();
+
+ if (ref($o->{XRange})) {
+ ($d{'x'}{min}, $d{'x'}{max})=@{$o->{XRange}};
+ if ($d{'x'}{xmin} == $d{'x'}{max}) { $d{'x'}{min} -= 0.5; $d{'x'}{max} += 0.5; }
+ } else {
+ push @axes_to_do, 'x';
+ }
+ if (ref($o->{YRange})) {
+ ($d{'y'}{min}, $d{'y'}{max})=@{$o->{YRange}};
+ if ($d{'y'}{xmin} == $d{'y'}{max}) { $d{'y'}{min} -= 0.5; $d{'y'}{max} += 0.5; }
+ } else {
+ push @axes_to_do, 'y';
+ }
+
+
+ # loop over the axes to calculate plot limits
+ for my $ax (@axes_to_do)
+ {
+ $axis = $d{$ax};
+ $range = uc $ax . 'range';
+
+ # user may have specified range limits already; pull them in
+ ($axis->{min},$axis->{max}) = @{$o->{$range}}
+ if ref $o->{$range} eq 'ARRAY';
+
+ # skip if user specified range limits
+ unless ( exists $axis->{min} )
+ {
+ my ( $min, $max );
+
+ # symmetric error bars
+ if ( defined $axis->{err} )
+ {
+ $min = min( $axis->{data} - $axis->{err} );
+ $max = max( $axis->{data} + $axis->{err} );
+ }
+
+ # assymetric error bars
+ else
+ {
+ # lo error bar specified
+ if ( defined $axis->{loerr} )
+ {
+ $min = min( $axis->{data} - $axis->{loerr} );
+ }
+
+ # hi error bar specified
+ if ( defined $axis->{hierr} )
+ {
+ $max = max( $axis->{data} + $axis->{hierr} );
+ }
+ }
+
+ # handle the case where there is no error bar.
+ $min = $axis->{data}->min unless defined $min;
+ $max = $axis->{data}->max unless defined $max;
+
+ # default range for infinitesimal data range
+ if ($min == $max) { $min -= 0.5; $max += 0.5; }
+
+ $axis->{min} = $min;
+ $axis->{max} = $max;
+ }
+ }
+
+ $self->initenv( $d{x}{min}, $d{x}{max}, $d{y}{min}, $d{y}{max}, $opt );
+ }
+
+ $self->_save_status();
+ # Let us parse the options if any.
+
+ my $term=$o->{Term};
+ my $symbol;
+ my $plot_points=0; # We won't normally plot the points
+
+ if (defined($u_opt->{Symbol})) {
+ $symbol = $u_opt->{Symbol};
+ $plot_points=1;
+ }
+
+ # Parse other standard options.
+ $self->_standard_options_parser($u_opt);
+
+ # map our combination of errors onto pgerrb's DIR parameter. note that
+ # DIR(Y) = DIR(X) + 1 for similar error bar configurations
+ $d{x}{dir} = 0;
+ $d{y}{dir} = 1;
+
+ # loop over axes, plotting the appropriate error bars
+ for my $axis ( $d{x}, $d{y} )
+ {
+ my $dir = $axis->{dir};
+
+ # symmetric error bars
+ if ( defined $axis->{err} )
+ {
+ pgerrb(5 + $dir, $n, $x->get_dataref, $y->get_dataref,
+ $axis->{err}->get_dataref,$term);
+ }
+
+ # assymetric error bars
+ else
+ {
+ if ( defined $axis->{hierr} )
+ {
+ pgerrb(1 + $dir, $n, $x->get_dataref, $y->get_dataref,
+ $axis->{hierr}->get_dataref,$term);
+ }
+
+ if ( defined $axis->{loerr} )
+ {
+ pgerrb(3 + $dir, $n, $x->get_dataref, $y->get_dataref,
+ $axis->{loerr}->get_dataref,$term);
+ }
+
+ }
+ }
+
+ if ($plot_points) {
+ if (exists($opt->{SymbolSize})) { # Set symbol size (2001.10.22 kwi)
+ pgsch($opt->{SymbolSize});
+ }
+ $symbol=long($symbol);
+ my $ns=nelem($symbol);
+ pgpnts($n, $x->get_dataref, $y->get_dataref, $symbol->get_dataref, $ns)
+ }
+
+ $self->_restore_status();
+ &release_signals;
+ 1;
+ }
+}
+
+#
+# A "threaded" line - I cannot come up with a more elegant way of doing
+# this without re-coding bits of thread_over but it might very well be
+# that you may :)
+#
+
+my $line_options = undef;
+sub tline {
+
+ my $self = shift;
+ my ($in, $opt)=_extract_hash(@_);
+ $self->_add_to_state(\&tline, $in, $opt);
+ $opt={} if !defined($opt);
+
+ release_and_barf 'Usage tline ([$x], $y, [, $options])' if $#$in < 0 || $#$in > 2;
+ my ($x, $y)=@$in;
+ if (!defined($line_options)) {
+ $line_options=$self->{PlotOptions}->extend({Missing => undef});
+ }
+
+ if ($#$in==0) {
+ $y = $x; $x = $y->xvals();
+ }
+
+ &catch_signals;
+
+ # This is very very kludgy, but it was the best way I could find..
+ my $o = _thread_options($y->getdim(1), $opt);
+ # We need to keep track of the current status of hold or not since
+ # the tline function automatically enforces a hold to allow for overplots.
+ my $tmp_hold = $self->held();
+ unless ( $self->held() ) {
+ my ($o, $u_opt) = $self->_parse_options($line_options,$opt);
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+ # use Data::Dumper;
+ # print Dumper $o;
+ # print Dumper $u_opt;
+
+ my ($ymin, $ymax, $xmin, $xmax);
+ # Make sure the missing value is used as the min or max value
+ if (defined $o->{Missing} ) {
+ ($ymin, $ymax)=ref $o->{YRange} eq 'ARRAY' ?
+ @{$o->{YRange}} : minmax($y->where($y != $o->{Missing}));
+ ($xmin, $xmax)=ref $o->{XRange} eq 'ARRAY' ?
+ @{$o->{XRange}} : minmax($x->where($x != $o->{Missing}));
+ } else {
+ ($ymin, $ymax)=ref $o->{YRange} eq 'ARRAY' ? @{$o->{YRange}} :
+ minmax($y);
+ ($xmin, $xmax)=ref $o->{XRange} eq 'ARRAY' ? @{$o->{XRange}} :
+ minmax($x);
+ }
+ if ($xmin == $xmax) { $xmin -= 0.5; $xmax += 0.5; }
+ if ($ymin == $ymax) { $ymin -= 0.5; $ymax += 0.5; }
+ # use Data::Dumper;
+ # print "tline options: ", Dumper($opt), "\n";
+ $self->initenv( $xmin, $xmax, $ymin, $ymax, $opt);
+ $self->hold; # we hold for the duration of the threaded plot
+ }
+ _tline($x, $y, PDL->sequence($y->getdim(1)), $self, $o);
+ $self->release unless $tmp_hold;
+
+ &release_signals;
+}
+
+
+PDL::thread_define('_tline(a(n);b(n);ind()), NOtherPars => 2',
+ PDL::over {
+ my ($x, $y, $ind, $self, $opt)=@_;
+ # use Data::Dumper;
+ # print Dumper $opt->[$ind->at(0)];
+ $self->line($x, $y,$opt->[$ind->at(0)] || {}); #
+});
+
+
+#
+# A "threaded" point - I cannot come up with a more elegant way of doing
+# this without re-coding bits of thread_over but it might very well be
+# that you may :)
+#
+
+my $points_options = undef;
+sub tpoints {
+
+ my $self = shift;
+ my ($in, $opt)=_extract_hash(@_);
+ $self->_add_to_state(\&tpoints, $in, $opt);
+ $opt={} if !defined($opt);
+
+ release_and_barf 'Usage tpoints ([$x], $y, [, $options])' if $#$in < 0 || $#$in > 2;
+ my ($x, $y)=@$in;
+
+ &catch_signals;
+
+ if ($#$in==0) {
+ $y = $x; $x = $y->xvals();
+ }
+
+ # This is very very cludgy, but it was the best way I could find..
+ my $o = _thread_options($y->getdim(1), $opt);
+ # We need to keep track of the current status of hold or not since
+ # the tline function automatically enforces a hold to allow for overplots.
+ my $tmp_hold = $self->held();
+ unless ( $self->held() ) {
+ if (!defined($points_options)) {
+ $points_options = $self->{PlotOptions}->extend({PlotLine => 0});
+ }
+ my ($o, $u_opt) = $self->_parse_options($points_options,$opt);
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+ # use Data::Dumper;
+ # print Dumper $o;
+ # print Dumper $u_opt;
+
+ my ($ymin, $ymax, $xmin, $xmax);
+ # Make sure the missing value is used as the min or max value
+ if (defined $o->{Missing} ) {
+ ($ymin, $ymax)=ref $o->{YRange} eq 'ARRAY' ?
+ @{$o->{YRange}} : minmax($y->where($y != $o->{Missing}));
+ ($xmin, $xmax)=ref $o->{XRange} eq 'ARRAY' ?
+ @{$o->{XRange}} : minmax($x->where($x != $o->{Missing}));
+ } else {
+ ($ymin, $ymax)=ref $o->{YRange} eq 'ARRAY' ? @{$o->{YRange}} :
+ minmax($y);
+ ($xmin, $xmax)=ref $o->{XRange} eq 'ARRAY' ? @{$o->{XRange}} :
+ minmax($x);
+ }
+ if ($xmin == $xmax) { $xmin -= 0.5; $xmax += 0.5; }
+ if ($ymin == $ymax) { $ymin -= 0.5; $ymax += 0.5; }
+ $self->initenv( $xmin, $xmax, $ymin, $ymax, $opt);
+ $self->hold; # we hold for the duration of the threaded plot
+ }
+ _tpoints($x, $y, PDL->sequence($y->getdim(1)), $self, $o);
+ $self->release unless $tmp_hold;
+
+ &release_signals;
+
+}
+
+
+PDL::thread_define('_tpoints(a(n);b(n);ind()), NOtherPars => 2',
+ PDL::over {
+ my ($x, $y, $ind, $self, $opt)=@_;
+ $self->points($x, $y, $opt->[$ind->at(0)] || {});
+});
+
+
+
+# Plot a line with pgline()
+
+{
+ my $line_options = undef;
+
+ #
+ # lines: CED 17-Dec-2002
+ #
+ sub lines {
+ my $self = shift;
+
+ if(!defined($line_options)) {
+ $line_options = $self->{PlotOptions}->extend({Missing=>undef});
+ }
+ my($in,$opt) = _extract_hash(@_);
+
+ # Parse out the options and figure out which syntax is being used
+ # This is a pain to look at but the computer does it behind your back so
+ # what do you care? --CED
+ my($x,$y,$p);
+
+ if(@$in == 3) {
+ release_and_barf "lines: inconsistent array refs in \$x,\$y,\$p call\n"
+ if((ref $in->[0] eq 'ARRAY') ^ (ref $in->[1] eq 'ARRAY'));
+
+ ($x,$y) = (ref $in->[0] eq 'ARRAY') ?
+ ($in->[0],$in->[1]) : ([$in->[0]],[$in->[1]]);
+
+ $p = (ref $in->[2] eq 'ARRAY') ? $in->[2] : [$in->[2]];
+ }
+ elsif(@$in == 2) { # $xy, $p or $x,$y (no-$p)
+ my($a) = (ref $in->[0] eq 'ARRAY') ? $in->[0] : [$in->[0]];
+ my($b) = (ref $in->[1] eq 'ARRAY') ? $in->[1] : [$in->[1]];
+
+ release_and_barf " lines: \$xy must be a piddle\n"
+ unless(UNIVERSAL::isa($a->[0],'PDL'));
+
+ if( ( ref $in->[0] ne ref $in->[1] ) ||
+ ( ! UNIVERSAL::isa($b->[0],'PDL') ) ||
+ ( $a->[0]->ndims > $b->[0]->ndims )
+ ) { # $xy, $p case -- split $xy into $x and $y.
+
+ foreach $_(@$a){
+ push(@$x,$_->((0)));
+ push(@$y,$_->((1)));
+ }
+ $p = $b;
+
+ } else { # $x,$y,(omitted $p) case -- make default $p.
+ $x = $a;
+ $y = $b;
+ $p = [1];
+ }
+ }
+
+ elsif(@$in == 1) { # $xyp or $xy,(omitted $p) case
+ my($a) = (ref $in->[0] eq 'ARRAY') ? $in->[0] : [$in->[0]];
+
+ foreach $_(@$a) {
+ push(@$x,$_->((0)));
+ push(@$y,$_->((1)));
+ push(@$p, ($_->dim(0) >= 3) ? $_->((2)) : 1);
+ }
+ }
+
+ else {
+ release_and_barf " lines: ".scalar(@$in)." is not a valid number of args\n";
+ }
+
+ release_and_barf "lines: x and y lists have different numbers of elements"
+ if($#$x != $#$y);
+
+ release_and_barf "lines: \$o->\{Missing\} must be an array ref if specified\n" if (defined $o->{Missing} && ref $o->{Missing} ne 'ARRAY');
+
+ ##############################
+ # Now $x, $y, and $p all have array refs containing their respective
+ # vectors. Set up pgplot (copy-and-pasted from line; this is probably
+ # the Wrong thing to do -- we probably ought to call line directly).
+ #
+ &catch_signals;
+
+ $opt = {} unless defined($opt);
+ my($o,$u_opt) = $self->_parse_options($line_options,$opt);
+
+ $self->_check_move_or_erase($o->{Panel},$o->{Erase});
+
+ my $held = $self->held();
+ unless ($held) {
+ my($ymin,$ymax,$xmin,$xmax) = (
+ zeroes(scalar(@$y)),
+ zeroes(scalar(@$y)),
+ zeroes(scalar(@$y)),
+ zeroes(scalar(@$y))
+ );
+ my $thunk = sub {
+ my($range) = shift;
+ my($vals,$missing,$min,$max,$pp) = @_;
+ if(ref $range eq 'ARRAY') {
+ $min .= $range->[0];
+ $max .= $range->[1];
+ return;
+ }
+ my($mask) = (isfinite $vals);
+ $mask &= ($vals != $missing) if(defined $missing);
+ $mask->(1:-1) &= (($pp->(0:-2) != 0) | ($pp->(1:-1) != 0));
+ my($a,$b) = minmax(where($vals,$mask));
+ $min .= $a;
+ $max .= $b;
+ };
+
+ for my $i(0..$#$x) {
+ my($pp) = $#$p ? $p->[$i] : $p->[0]; # allow scalar pen in array case
+ $pp = pdl($pp) unless UNIVERSAL::isa($pp,'PDL');
+ my $miss = defined $o->{Missing} ? $o->{Missing}->[$i] : undef;
+ &$thunk($u_opt->{XRange},$x->[$i],$miss,$xmin->(($i)),$xmax->(($i)),$pp);
+ &$thunk($u_opt->{YRange},$y->[$i],$miss,$ymin->(($i)),$ymax->(($i)),$pp);
+ }
+
+ $xmin = $xmin->min;
+ $xmax = $xmax->max;
+ $ymin = $ymin->min;
+ $ymax = $ymax->max;
+
+ if($xmin==$xmax) { $xmin -= 0.5; $xmax += 0.5; }
+ if($ymin==$ymax) { $ymin -= 0.5; $ymax += 0.5; }
+
+ print "lines: xmin=$xmin; xmax=$xmax; ymin=$ymin; ymax=$ymax\n"
+ if($PDL::verbose);
+ $self->initenv($xmin,$xmax,$ymin,$ymax,$opt);
+ }
+
+ $self->_save_status();
+ $self->_standard_options_parser($u_opt);
+
+ my($lw); # Save the normal line width
+ pgqlw($lw);
+ my($hh) = 0; # Indicates local window hold
+
+ # Loop over everything in the list
+ for my $i(0..$#$x) {
+ my($xx,$yy) = ($x->[$i],$y->[$i]);
+ next if($xx->nelem < 2);
+
+ my($pp) = $#$p ? $p->[$i] : $p->[0]; # allow scalar pen in array case
+ my($miss) = defined $o->{Missing} ? $o->{Missing}->[$i] : undef;
+ my($n) = $xx->nelem;
+
+ $pp = pdl($pp) unless UNIVERSAL::isa($pp,'PDL');
+
+ $pp = zeroes($xx)+$pp
+ if($pp->nelem == 1);
+
+ $pp = $pp->copy; # Make a duplicate to scribble on
+ $pp->(0:-2) *= ($xx->(0:-2) + $xx->(1:-1))->isfinite;
+ $pp->(0:-2) *= ($yy->(0:-2) + $yy->(1:-1))->isfinite;
+
+ my($pn,$pval) = rle($pp);
+ my($pos,$run,$rl) = (0,0,0);
+
+
+ # Within each list element loop over runs of pen value
+ while(($run<$pn->nelem) && ($rl = $pn->at($run))) { # assignment
+ my($pv);
+ if($pv = $pval->at($run)) { # (assignment) Skip runs with pen value=0
+ my $top = $pos+$rl; $top-- if($top == $xx->dim(0));
+ my $x0 = float $xx->($pos:$top);
+ my $y0 = float $yy->($pos:$top);
+
+ $self->_set_colour(abs($pv)*(defined $o->{Colour} ? $o->{Colour}:1));
+
+ ($x0,$y0) = $self->checklog($x0,$y0) if $self->autolog;
+
+ if($pv > 0) {
+ pgslw($lw);
+ } else {
+ pgslw(1);
+ }
+
+ if(defined($miss)) {
+ my $mpt = defined $miss ? $miss->($pos:$top) : undef;
+ pggapline($x0->nelem,$miss->($pos:$top),$x0->get_dataref, $y0->get_dataref);
+ } else {
+ pgline($x0->nelem,$x0->get_dataref,$y0->get_dataref,);
+ }
+
+ $self->hold() unless $hh++;
+ }
+
+ $pos += $rl;
+ $run++;
+ } # end of within-piddle polyline loop
+ } # end of array ref loop
+
+ pgslw($lw); # undo incredible shrinking line width$
+
+ $self->release() unless($held);
+ $self->_restore_status();
+ $self->_add_to_state(\&lines,$in,$opt);
+
+ &release_signals;
+ 1;
+ }
+
+ sub line {
+ my $self = shift;
+ if (!defined($line_options)) {
+ $line_options=$self->{PlotOptions}->extend({Missing => undef});
+ }
+ my ($in, $opt)=_extract_hash(@_);
+
+ release_and_barf 'Usage: line ( [$x,] $y, [$options] )' if $#$in<0 || $#$in>2;
+ my($x,$y) = @$in;
+ $self->_checkarg($x,1);
+ my $n = nelem($x);
+
+ &catch_signals;
+
+ my ($is_1D, $is_2D);
+ if ($#$in==1) {
+ $is_1D = $self->_checkarg($y,1,undef,1);
+ if (!$is_1D) {
+ $is_2D = $self->_checkarg($y,2,undef,1);
+ release_and_barf '$y must be 1D (or 2D for threading!)'."\n" if !$is_2D;
+
+ # Ok, let us use the threading possibility.
+ $self->tline(@$in, $opt);
+
+ &release_signals;
+ return;
+ } else {
+ release_and_barf '$x and $y must be same size' if $n!=nelem($y);
+ }
+ } else {
+ $y = $x; $x = float(sequence($n));
+ }
+
+ # Let us parse the options if any.
+ $opt = {} if !defined($opt);
+ my ($o, $u_opt) = $self->_parse_options($line_options, $opt);
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+ unless ( $self->held() ) {
+
+ # Make sure the missing value is used as the min or max value.
+ # Also, do autoscaling but avoid infinities.
+ my ($ymin, $ymax, $xmin, $xmax);
+
+ # Thunk for finding max and min X and Y ranges
+ my($thunk) = sub {
+ my($range) = shift; return @{$range} if(ref $range eq 'ARRAY');
+ my($vals, $missing) = @_;
+ my($mask) = (isfinite $vals);
+ $mask &= ($vals != $missing) if(defined $missing);
+ minmax(where($vals,$mask));
+ };
+
+ ($xmin,$xmax) = &$thunk($o->{XRange},$x,$o->{Missing});
+ ($ymin,$ymax) = &$thunk($o->{YRange},$y,$o->{Missing});
+
+ if ($xmin == $xmax) { $xmin -= 0.5; $xmax += 0.5; }
+ if ($ymin == $ymax) { $ymin -= 0.5; $ymax += 0.5; }
+ print("line: xmin=$xmin; xmax=$max; ymin=$ymin; ymax=$ymax\n")
+ if($PDL::verbose);
+ $self->initenv( $xmin, $xmax, $ymin, $ymax, $opt);
+ }
+ $self->_save_status();
+ $self->_standard_options_parser($u_opt);
+
+ # take logs if we are in autolog mode and axis option indicates logs
+ ($x,$y) = $self->checklog($x,$y) if $self->autolog;
+
+ # If there is a missing value specified, use pggapline
+ # to break the line around missing values.
+ if (defined $o->{Missing}) {
+ pggapline ($n, $o->{Missing}, $x->get_dataref, $y->get_dataref);
+ } else {
+ pgline($n, $x->get_dataref, $y->get_dataref);
+ }
+ $self->_restore_status();
+ $self->_add_to_state(\&line, $in, $opt);
+
+ &release_signals;
+ 1;
+ }
+}
+# Plot points with pgpnts()
+
+
+
+sub arrow {
+
+ my $self = shift;
+
+ my ($in, $opt)=_extract_hash(@_);
+ $opt = {} if !defined($opt);
+
+ release_and_barf 'Usage: arrow($x1, $y1, $x2, $y2 [, $options])' if $#$in != 3;
+
+ my ($x1, $y1, $x2, $y2)=@$in;
+
+ &catch_signals;
+
+ my ($o, $u_opt) = $self->_parse_options($self->{PlotOptions}, $opt);
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+ unless ($self->held()) {
+ $self->initenv($x1, $x2, $y1, $y2, $opt);
+ }
+
+ $self->_save_status();
+ $self->_standard_options_parser($u_opt);
+ pgarro($x1, $y1, $x2, $y2);
+ $self->_restore_status();
+ $self->_add_to_state(\&arrow, $in, $opt);
+
+ &release_signals;
+}
+
+
+
+{
+ my $points_options = undef;
+
+ sub points {
+
+ my $self = shift;
+ if (!defined($points_options)) {
+ $points_options = $self->{PlotOptions}->extend({PlotLine => 0});
+ }
+ my ($in, $opt)=_extract_hash(@_);
+ release_and_barf 'Usage: points ( [$x,] $y, $sym, [$options] )' if $#$in<0 || $#$in>2;
+ my ($x, $y, $sym)=@$in;
+ $self->_checkarg($x,1);
+ my $n=nelem($x);
+
+ &catch_signals;
+
+ my ($is_1D, $is_2D);
+ if ($#$in>=1) {
+ $is_1D = $self->_checkarg($y,1,undef,1);
+ if (!$is_1D) {
+ $is_2D = $self->_checkarg($y,2,undef,1);
+ release_and_barf '$y must be 1D (or 2D for threading!)'."\n" if !$is_2D;
+
+ # Ok, let us use the threading possibility.
+ $self->tpoints(@$in, $opt);
+ return;
+
+ } else {
+ release_and_barf '$x and $y must be same size' if $n!=nelem($y);
+ }
+ } else {
+ $y = $x; $x = float(sequence($n));
+ }
+
+ # Let us parse the options if any.
+ $opt = {} if !defined($opt);
+ my ($o, $u_opt) = $self->_parse_options($points_options, $opt);
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+ #
+ # Save some time for large datasets.
+ #
+ unless ( $self->held() ) {
+ my ($xmin, $xmax)=ref $o->{XRange} eq 'ARRAY' ?
+ @{$o->{XRange}} : minmax($x);
+ my ($ymin, $ymax)=ref $o->{YRange} eq 'ARRAY' ?
+ @{$o->{YRange}} : minmax($y);
+ if ($xmin == $xmax) { $xmin -= 0.5; $xmax += 0.5; }
+ if ($ymin == $ymax) { $ymin -= 0.5; $ymax += 0.5; }
+ $self->initenv( $xmin, $xmax, $ymin, $ymax, $opt );
+ }
+ $self->_save_status();
+ $self->_standard_options_parser($u_opt);
+
+ # take logs if we are in autolog mode and axis option indicates logs
+ ($x,$y) = $self->checklog($x,$y) if $self->autolog;
+
+ if (exists($opt->{SymbolSize})) { # Set symbol size (2001.10.22 kwi)
+ pgsch($opt->{SymbolSize});
+ }
+
+ if (exists($opt->{ColorValues})) {
+ my $sym ||= $o->{Symbol} || 0;
+ my $z = $opt->{ColorValues};
+ $self->_checkarg($z,1); # make sure this is a float PDL
+ pgcolorpnts($n, $x->get_dataref, $y->get_dataref, $z->get_dataref, $sym);
+ } else {
+
+ # Set symbol if specified in the options hash.
+ ## $sym ||= $o->{Symbol};
+ $sym = $o->{Symbol} unless defined $sym;
+
+ $self->_checkarg($sym,1); my $ns = nelem($sym); $sym = long($sym);
+
+ pgpnts($n, $x->get_dataref, $y->get_dataref, $sym->get_dataref, $ns);
+
+ }
+
+ #
+ # Sometimes you would like to plot a line through the points straight
+ # away.
+ pgline($n, $x->get_dataref, $y->get_dataref) if $o->{PlotLine}>0;
+
+ $self->_restore_status();
+ $self->_add_to_state(\&points, $in, $opt);
+ &release_signals;
+ 1;
+ }
+}
+
+# add a "wedge" to the image
+# - since this can be called from imag() as well as by the user,
+# we make all parameters defined as options
+#
+# Wedge => {
+# Side => one of B L T R,
+# Displacement => default = 2,
+# Width => default = 3,
+# Fg/Bg => default, values used by imag()
+# Label => default ''
+# }
+#
+# - uses horrible _store()/_retrieve() routines, which need to
+# know (but don't) about changing window focus/erasing/...
+#
+# Want to be able to specify a title (optional)
+# - also, by default want to use the axes colour/size, but want to be able to
+# over-ride this
+#
+# initial version by Doug Burke (11/20/00 ish)
+
+{
+ my $wedge_options = undef;
+
+ sub draw_wedge {
+ my $self = shift;
+ if ( !defined($wegde_options) ) {
+ $wedge_options =
+ $self->{PlotOptions}->extend({
+ Side => 'R',
+ Displacement => 1.5,
+ Width =>3.0,
+ WTitle => undef,
+ Label => undef,
+ ForeGround => undef,
+ BackGround => undef,
+ });
+ $wedge_options->synonyms({ Fg => 'ForeGround', Bg => 'BackGround' });
+ }
+
+ my ( $in, $opt ) = _extract_hash(@_);
+ $opt = {} unless defined($opt);
+ release_and_barf 'Usage: $win->draw_wedge( [$options] )'
+ unless $#$in == -1;
+
+
+ &catch_signals;
+
+ # check imag has been called, and get information
+ # - this is HORRIBLE
+ my $iref = $self->_retrieve( 'imag' );
+ release_and_barf 'draw_wedge() can only be called after a call to imag()'
+ unless defined $iref;
+
+ # Let us parse the options if any.
+ # - not convinced I know what I'm doing
+ my $o;
+ if ( defined $opt->{Wedge} ) {
+ $o = $wedge_options->options( $opt->{Wedge} );
+ } else {
+ $o = $wedge_options->current();
+ }
+ $o->{ForeGround} = $$iref{max} unless defined( $o->{ForeGround} );
+ $o->{BackGround} = $$iref{min} unless defined( $o->{BackGround} );
+
+ # do we really want this?
+ # - (03/15/01 DJB) removed since I assume that draw_wedge()
+ # will be called before the focus has been changed.
+ # Not ideal, but I don't think the current implementation will
+ # handle such cases anyway (ie getting the correct min/max values
+ # for the wedge).
+# $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+ # get the options used to draw the axes
+ # note: use the window object, not the options hash, though we
+ # probably could/should do that
+ my $wo = $self->{_env_options}[4];
+
+ # Save current status
+ $self->_save_status();
+
+ # we use the colour/size of the axes here
+ $self->_set_colour($wo->{AxisColour});
+ pgsch($wo->{CharSize});
+
+ # draw the wedge
+ my $side = $o->{Side} . $$iref{routine};
+ pgwedg( $side, $o->{Displacement}, $o->{Width}, $o->{BackGround}, $o->{ForeGround}, $o->{Label} || $o->{WTitle} || '' );
+
+ # restore character colour & size before returning
+ $self->_restore_status();
+ $self->_add_to_state(\&draw_wedge, $in, $opt);
+
+ &release_signals;
+ 1;
+ } # sub: draw_wedge()
+}
+
+######################################################################
+#
+# imag and related functions
+#
+# display an image using pgimag()/pggray()/pgrgbi() as appropriate.
+#
+# The longish routine '_imag' handles the meat and potatoes of the setup,
+# but hands off the final plot to the PGPLOT routines pgimag() or pgrgbi().
+# It expects a ref to the appropriate function to be passed in. The
+# userland methods 'imag' and 'rgbi' are just trampolines that call _imag
+# with the appropriate function ref.
+#
+# This gets pretty sticky for fits_imag, which is itself a trampoline for
+# _fits_foo -- so if you call fits_imag, it trampolines into fits_foo, which
+# does setup and then bounces into imag, which in turn hands off control
+# to pgimag. What a mess -- but at least it seems to work OK. For now.
+# -- CED 20-Jan-2002
+#
+{
+ # The ITF is in the general options - since other functions might want
+ # it too.
+ #
+ # There is some repetetiveness in the code, but this is to allow the
+ # user to set global defaults when opening a new window.
+ #
+ #
+ #
+
+ my $im_options = undef;
+
+
+ sub _imag {
+ my $self = shift;
+
+ if (!defined($im_options)) {
+ $im_options = $self->{PlotOptions}->extend({
+ Min => undef,
+ Max => undef,
+ Range => undef,
+ CRange => undef,
+ DrawWedge => 0,
+ Wedge => undef,
+ Justify => undef,
+ Transform => undef
+ });
+ }
+
+ ##############################
+ # Unwrap first two arguments: the PGPLOT call and the
+ # dimensions of the image variable (2 or 3 depending
+ # on whether this is called by imag or rgbi)
+ my $pgcall = shift;
+ my $image_dims = shift;
+
+ ##############################
+ # Pull out the rest of the arg list, and parse the options (if any).
+ my ($in, $opt)=_extract_hash(@_);
+
+ $opt = {} if !defined($opt);
+ my ($o, $u_opt) = $self->_parse_options($im_options, $opt);
+
+ ##########
+ # Default to putting tick marks outside the box, so that you don't
+ # scrozzle images.
+
+ $o->{Axis} = 'BCINST'
+ unless (defined($opt->{Axis}) || ($o->{Axis} ne 'BCNST'));
+
+ $self->_add_to_state(\&imag, $in, $opt);
+ release_and_barf 'Usage: (imag|rgbi) ( $image, [$min, $max, $transform] )' if $#$in<0 || $#$in>3;
+
+ my ($image,$min,$max,$tr) = @$in;
+ my ($cmin, $cmax) = (0,1);
+
+ ## Make sure the image has the right number of dims...
+ $self->_checkarg($image,$image_dims);
+
+ my($nx,$ny) = $image->dims;
+ $nx = 1 unless($nx);
+ $ny = 1 unless($ny);
+
+ my $itf = 0;
+
+ $tr = $u_opt->{Transform} if exists($u_opt->{Transform});
+ $min = $u_opt->{Min} if exists($u_opt->{Min});
+ $max = $u_opt->{Max} if exists($u_opt->{Max});
+
+ # Check on ITF value hardcoded in.
+ $itf = $u_opt->{ITF} if exists($u_opt->{ITF});
+ release_and_barf ( "illegal ITF value `$val'") if $itf > 2 || $itf < 0;
+
+ ## Option checker thunk gets defined only on first run-through.
+ our $checker = sub {
+ my($name,$opt,$min,$max) = @_;
+ delete $opt->{$name} unless(defined $opt->{$name});
+ return unless exists($opt->{$name});
+ release_and_barf("$name option must be an array ref if specified.\n")
+ if( ref ($opt->{$name}) ne 'ARRAY' );
+ ($$min,$$max) = @{$opt->{$name}} if defined($min);
+ } unless(defined $checker);
+
+ &$checker("Range", $u_opt, \$min, \$max);
+ &$checker("CRange", $u_opt, \$cmin, \$cmax);
+ &$checker("XRange", $u_opt);
+ &$checker("YRange", $u_opt);
+
+ $min = min($image) unless defined $min;
+ $max = max($image) unless defined $max;
+
+ if (defined($tr)) {
+ $self->_checkarg($tr,1);
+ release_and_barf '$transform incorrect' if nelem($tr)!=6;
+ } else {
+ $tr = float [0,1,0, 0,0,1];
+ }
+ $tr = $self->CtoF77coords($tr);
+
+
+ &catch_signals;
+
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+ $self->initenv( _image_xyrange($tr,$nx,$ny,$o), $o );
+
+
+ #
+ # Commented out, CED, 5-Dec-2003 --
+ # this is handled by redraw_axes, at the bottom.
+ #
+ #if (!$self->held()) {
+ # # Label axes if necessary
+ # if(defined ($u_opt->{Title} ||
+ # $u_opt->{XTitle} ||
+ # $u_opt->{YTitle})) {
+ # $self->label_axes($u_opt->{XTitle},
+ # $u_opt->{YTitle},
+ # $u_opt->{Title},
+ # $u_opt);
+ # }
+ # }
+
+ pgsitf( $itf );
+ my ($i1, $i2);
+
+ pgqcir($i1, $i2); # Default color range
+
+ my($c1,$c2);
+ $c1 = int($i1 + ($i2-$i1) * $cmin + 0.5);
+ $c2 = int($i1 + ($i2-$i1) * $cmax + 0.5);
+
+ print "Displaying $nx x $ny image from $min to $max, using ".($c2-$c1+1)." colors ($c1-$c2)...\n" if $PDL::verbose;
+
+
+ # Disable PS pggray output because the driver is busted in pgplot-2.3
+ # (haven't tested later versions). pgimag seems to work OK for that
+ # output tho'.
+ if ($c2-$c1<16 || $self->{Device} =~ /^v?ps$/i) {
+ print STDERR "_imag: Under 16 colors available; reverting to pggray\n"
+ if($PDL::debug || $PDL::verbose);
+ pggray( $image->get_dataref,
+ $nx,$ny,1,$nx,1,$ny, $min, $max,
+ $tr->get_dataref);
+ $self->_store( imag => { routine => "G", min => $min, max => $max } );
+ } else {
+ $self->ctab('Grey') unless $self->_ctab_set(); # Start with grey
+
+ pgscir($c1,$c2);
+
+ &$pgcall( $image->get_dataref,
+ $nx,$ny,1,$nx,1,$ny, $min, $max,
+ $tr->get_dataref);
+
+ pgscir($i1,$i2);
+
+ $self->_store( imag => { routine => "I", min => $min, max => $max } );
+ }
+
+ # draw the wedge, if requested
+ if ( $u_opt->{DrawWedge} ) {
+ my $hflag = $self->held();
+ $self->hold();
+ $self->draw_wedge( $u_opt );
+ $self->release() unless $hflag;
+ }
+
+ $self->redraw_axes($u_opt) unless $self->held();
+
+ &release_signals;
+
+ 1;
+
+ } # sub: imag()
+
+}
+
+######################################################################
+# Here are the `top-level' imaging routines -- they call _imag to get
+# the job done.
+
+
+##########
+# image - the basic image plotter
+
+sub imag {
+ my $me = shift;
+ my $im = shift;
+ my @a = @_;
+
+ if(UNIVERSAL::isa($im,'PDL') && ($im->ndims == 3) && ($im->dim(2)==3)) {
+ rgbi($me,$im, at a);
+ return;
+ }
+
+ _imag($me,\&pgimag,2,$im, at a);
+}
+
+
+##########
+# imag1 - Plot an image with Justify = 1
+
+sub imag1 {
+ my $self = shift;
+ my ($in,$opt)=_extract_hash(@_);
+
+ if (!defined($im_options)) {
+ $im_options = $self->{PlotOptions}->extend({
+ Min => undef,
+ Max => undef,
+ DrawWedge => 0,
+ Wedge => undef,
+ XTitle => undef,
+ YTitle => undef,
+ Title => undef,
+ Justify => 1
+ });
+ }
+
+ # Let us parse the options if any.
+ $opt = {} if !defined($opt);
+ my ($o, $u_opt) = $self->_parse_options($im_options, $opt);
+
+ release_and_barf 'Usage: imag1 ( $image, [$min, $max, $transform] )' if $#$in<0 || $#$in>3;
+ $o->{Pix} = 1 unless defined($o->{Pix});
+ $self->imag (@$in,$o);
+ # This is not added to the state, because the imag command does that.
+}
+
+
+##########
+# rgbi - Plot an image with 3 color planes
+
+sub rgbi {
+ unless($PGPLOT::RGB_OK) {
+ print STDERR "PGPLOT rgbi called, but RGB support is not present. Using grayscale instead.\n";
+ my $me = shift;
+ my $in = shift;
+ my $in2;
+
+ if($in->dim(0)==3 && $in->dim(1)>3 && $in->dim(2)>3) {
+ $in2 = $in->sumover;
+ } else {
+ $in2 = $in->mv(2,0)->sumover;
+ }
+ my @a = @_;
+ return _imag($me,\&pgimag,2,$in2, at a);
+ }
+
+ release_and_barf("rgbi: RGB-enabled PGPLOT is not present\n")
+ unless($PGPLOT::RGB_OK);
+
+ my $me = shift;
+ my @a = @_;
+ my($in,$opt) = _extract_hash(@_);
+ my($image) = shift @$in;
+ if(UNIVERSAL::isa($image,'PDL')) {
+ @dims = $image->dims;
+ if($dims[0] == 3 && $dims[1] > 3 && $dims[2] > 3) {
+ print "rgbi: Hmmm... Found (rgb,X,Y) [deprecated] rather than (X,Y,rgb) [approved]."
+ if($PDL::debug || $PDL::verbose);
+ $image = $image->mv(0,2);
+ }
+ }
+ $opt->{DrawWedge} = 0;
+
+ # Get rid of nan elements...
+ my $im2;
+ my $m = !(isfinite $image);
+ if(zcheck($m)) {
+ $im2 = $image;
+ } else {
+ $im2 = $image->copy;
+ $im2->range(scalar(whichND $m)) .= 0;
+ }
+
+ _imag($me,\&pgrgbi,3,$im2,@$in,$opt);
+}
+
+
+######################################################################
+# Here are the FITS subroutines
+#
+# They all use _fits_foo as a ``pre-call'' to set up the appropriate
+# image transformations and plot command.
+#
+# by fits_imag, fits_rgbi, and fits_cont.
+#
+{
+ my $f_im_options = undef;
+
+ sub _fits_foo {
+ my $pane = shift;
+ my $cmd = shift;
+ my ($in,$opt_in) = _extract_hash(@_);
+ my ($pdl, at rest) = @$in;
+
+ $opt_in = {} unless defined($opt_in);
+
+ unless ( defined($f_im_options) ) {
+ $f_im_options = $pane->{PlotOptions}->extend({
+ Contours=>undef,
+ Follow=>0,
+ Labels=>undef,
+ LabelColour=>undef,
+ Missing=>undef,
+ NContours=>undef,
+ FillContours=>undef,
+ Min => undef,
+ Max => undef,
+ DrawWedge => 0,
+ Wedge => undef,
+ XRange=>undef,
+ YRange=>undef,
+ XTitle => undef,
+ YTitle => undef,
+ Title => undef,
+ CharSize=>undef,
+ CharThick=>undef,
+ HardCH=>undef,
+ HardLW=>undef,
+ TextThick=>undef,
+
+ WCS => undef,
+ });
+ }
+
+ my($opt,$u_opt) = $pane->_parse_options($f_im_options,$opt_in);
+ my $hdr = $pdl->gethdr();
+
+ # What WCS system are we using?
+ # we could check that the WCS is valid here but we delegate it
+ # to the _FITS_tr() routine.
+ #
+ my $wcs = $$u_opt{WCS} || "";
+
+ %opt2 = %{$u_opt}; # copy options
+ delete $opt2{WCS};
+ $opt2{Transform} = _FITS_tr($pane,$pdl,{WCS => $wcs});
+
+ local($_);
+ foreach $_(keys %opt2){
+ delete $opt2{$_} if (m/title/i);
+ }
+
+ $opt2{Align} = 'CC' unless defined($opt2{Align});
+ $opt2{DrawWedge} = 1 unless defined($opt2{DrawWedge});
+
+ my $min = (defined $opt->{min}) ? $opt->{min} : $pdl->min;
+ my $max = (defined $opt->{max}) ? $opt->{max} : $pdl->max;
+ my $unit = $pdl->gethdr->{BUNIT} || "";
+ my $rangestr = " ($min to $max $unit) ";
+
+ # I am assuming here that CUNIT1<A-Z> is a valid keyword for
+ # 'alternative' WCS mappings (DJB)
+ #
+ $opt2{Pix}=1.0
+ if( (!defined($opt2{Justify}) || !$opt2{Justify}) &&
+ (!defined($opt2{Pix})) &&
+ ( $hdr->{"CUNIT1$wcs"} ?
+ ($hdr->{"CUNIT1$wcs"} eq $hdr->{"CUNIT2$wcs"}) :
+ ($hdr->{"CTYPE1$wcs"} eq $hdr->{"CTYPE2$wcs"})
+ )
+ );
+
+ my $o2 = \%opt2;
+
+ my $cmdstr = '$pane->' . $cmd .
+ '($pdl,' . (scalar(@rest) ? '@rest,' : '') .
+ '$o2);';
+
+ eval $cmdstr;
+
+ my $mkaxis = sub {
+ my ($typ,$unit) = @_;
+ our @templates = ("(arbitrary units)","%u","%t","%t (%u)");
+ $s = $templates[2 * (defined $typ) + (defined $unit && $unit !~ m/^\s+$/)];
+ $s =~ s/\%u/$unit/;
+ $s =~ s/\%t/$typ/;
+ $s;
+ };
+
+ $pane->label_axes(
+ $opt->{XTitle} ||
+ &$mkaxis($hdr->{"CTYPE1$wcs"},$hdr->{"CUNIT1$wcs"}),
+ $opt->{YTitle} ||
+ &$mkaxis($hdr->{"CTYPE2$wcs"},$hdr->{"CUNIT2$wcs"}),
+ $opt->{Title}, $opt
+ );
+
+ } # sub: _fits_foo()
+
+ sub fits_imag {
+ my($self) = shift;
+ _fits_foo($self,'imag', at _);
+ }
+
+ sub fits_rgbi {
+ my($self) = shift;
+ _fits_foo($self,'rgbi', at _);
+ }
+
+ sub fits_cont {
+ my($self) = shift;
+ _fits_foo($self,'cont', at _);
+ }
+
+ sub fits_vect {
+ my($self) = shift;
+ _fits_vect($self,'vect', at _);
+ }
+
+} # closure around _fits_foo and fits_XXXX routines
+
+# Load a colour table using pgctab()
+
+#
+# Modified 7/4/02 JB - having the last colour table as a variable in here
+# did not work. So it is now moved to the $self hash.
+{
+ # This routine doesn't really have any options at the moment, but
+ # it uses the following standard variables
+ my %CTAB = ();
+ $CTAB{Grey} = [ pdl([0,1],[0,1],[0,1],[0,1]) ];
+ $CTAB{Igrey} = [ pdl([0,1],[1,0],[1,0],[1,0]) ];
+ $CTAB{Fire} = [ pdl([0,0.33,0.66,1],[0,1,1,1],[0,0,1,1],[0,0,0,1]) ];
+ $CTAB{Gray} = $CTAB{Grey}; # Alias
+ $CTAB{Igray} = $CTAB{Igrey}; # Alias
+
+ # It would be easy to add options though..
+ sub _ctab_set {
+ my $self = shift;
+ return defined($self->{CTAB});
+ }
+
+ sub ctab {
+ my $self = shift;
+ my ($in, $opt)=_extract_hash(@_);
+
+
+ # No arguments -- print list of tables
+ if (scalar(@$in) == 0) {
+ print "Available 'standard' color tables are:\n",join(",",sort keys %CTAB)
+ ,"\n";
+ return;
+ }
+ # No arguments -- print list of tables
+ if (scalar(@$in) == 0) {
+ print "Available 'standard' color tables are:\n",join(",",sort keys %CTAB)
+ ,"\n";
+ return;
+ }
+
+ # First indirect arg list through %CTAB
+ my(@arg) = @$in;
+
+ my($ctab, $levels, $red, $green, $blue, $contrast, $brightness, @t, $n);
+
+ if ($#arg>=0 && !ref($arg[0])) { # First arg is a name not an object
+ # if first arg is undef or empty string, means use last CTAB.
+ # preload with Grey if no prior CTAB
+ $arg[0] = 'Grey' unless $arg[0] || $self->{CTAB};
+
+ # now check if we're using the last one specified
+ if ( ! $arg[0] ) {
+ shift @arg;
+ unshift @arg, @{$self-{CTAB}->{ctab}};
+ $brightness = $self->{CTAB}->{brightness};
+ $contrast = $self->{CTAB}->{contrast};
+ } else {
+ my $name = ucfirst(lc(shift @arg)); # My convention is $CTAB{Grey} etc...
+ release_and_barf "$name is not a standard colour table" unless defined $CTAB{$name};
+ unshift @arg, @{$CTAB{$name}};
+ }
+ }
+
+
+ if ($#arg<0 || $#arg>5) {
+ my @std = keys %CTAB;
+ release_and_barf <<"EOD";
+ Usage: ctab ( \$name, [\$contrast, $\brightness] ) # Builtin col table
+ [Builtins: @std]
+ ctab ( \$ctab, [\$contrast, \$brightness] ) # $ctab is Nx4 array
+ ctab ( \$levels, \$red, \$green, \$blue, [\$contrast, \$brightness] )
+EOD
+ }
+
+
+ if ($#arg<3) {
+ ($ctab, $contrast, $brightness) = @arg;
+ @t = $ctab->dims; release_and_barf 'Must be a Nx4 array' if $#t != 1 || $t[1] != 4;
+ $n = $t[0];
+ $ctab = float($ctab) if $ctab->get_datatype != $PDL_F;
+ my $nn = $n-1;
+ $levels = $ctab->(0:$nn,0:0);
+ $red = $ctab->(0:$nn,1:1);
+ $green = $ctab->(0:$nn,2:2);
+ $blue = $ctab->(0:$nn,3:3);
+ } else {
+ ($levels, $red, $green, $blue, $contrast, $brightness) = @arg;
+ $self->_checkarg($levels,1); $n = nelem($levels);
+ for ($red,$green,$blue) {
+ $self->_checkarg($_,1); release_and_barf 'Arguments must have same size' unless nelem($_) == $n;
+ }
+ }
+
+ # Now load it
+
+ $contrast = 1 unless defined $contrast;
+ $brightness = 0.5 unless defined $brightness;
+
+ &catch_signals;
+
+ focus( $self );
+
+ pgctab( $levels->get_dataref, $red->get_dataref, $green->get_dataref,
+ $blue->get_dataref, $n, $contrast, $brightness );
+ $self->{CTAB} = { ctab => [ $levels, $red, $green, $blue ],
+ brightness => $brightness,
+ contrast => $contrast
+ }; # Loaded
+ $self->_add_to_state(\&ctab, $in, $opt);
+
+ &release_signals;
+
+ 1;
+ }
+
+ # get information on last CTAB load
+ sub ctab_info {
+ my $self = shift;
+ my ($in, $opt)=_extract_hash(@_);
+ release_and_barf 'Usage: ctab_info( )' if $#$in> -1;
+
+ return () unless $self->{CTAB};
+ return @{$self->{CTAB}->{ctab}}, $self-{CTAB}->{contrast},
+ $self->{CTAB}->{brightness};
+ }
+}
+
+# display an image using pghi2d()
+
+{
+
+ my $hi2d_options = undef;
+
+ sub hi2d {
+ my $self = shift;
+ if (!defined($hi2d_options)) {
+ $hi2d_options = $self->{PlotOptions}->extend({
+ Ioff => undef,
+ Bias => undef
+ });
+ }
+ my ($in, $opt)=_extract_hash(@_);
+ $opt = {} if !defined($opt);
+
+ release_and_barf 'Usage: hi2d ( $image, [$x, $ioff, $bias] [, $options] )' if $#$in<0 || $#$in>3;
+ my ($image, $x, $ioff, $bias) = @$in;
+ $self->_checkarg($image,2);
+ my($nx,$ny) = $image->dims;
+
+ # Let us parse the options if any.
+ my ($o, $u_opt) = $self->_parse_options($hi2d_options, $opt);
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+ if (defined($x)) {
+ $self->_checkarg($x,1);
+ release_and_barf '$x incorrect' if nelem($x)!=$nx;
+ } else {
+ $x = float(sequence($nx));
+ }
+
+ # Parse for options input instead of calling convention
+ $ioff = $o->{Ioff} || 1 unless defined($ioff);
+ $bias = $o->{Bias} if defined($o->{Bias});
+
+ $bias = 5*max($image)/$ny unless defined $bias;
+ my $work = float(zeroes($nx));
+
+
+ &catch_signals;
+
+ $self->_save_status();
+ $self->_standard_options_parser($u_opt);
+
+ $self->initenv( 0 ,2*($nx-1), 0, 10*max($image), $opt ) unless $self->held();
+
+ pghi2d($image->get_dataref, $nx, $ny, 1,$nx,1,$ny, $x->get_dataref, $ioff,
+ $bias, 1, $work->get_dataref);
+
+ $self->_restore_status();
+ $self->_add_to_state(\&hi2d, $in, $opt);
+
+ &release_signals;
+ 1;
+ }
+}
+
+# Plot a rectangle with pgrect()
+sub rect {
+ my $self = shift;
+ my ($in, $opt)=_extract_hash(@_);
+ release_and_barf 'Usage: rect ( $x1, $x2, $y1, $y2 [, $options] )' if( $#$in<0 || $#$in>3);
+ my($x1,$x2,$y1,$y2) = @$in;
+ $self->_checkarg($x1,1);
+ $self->_checkarg($x2,1);
+ $self->_checkarg($y1,1);
+ $self->_checkarg($y2,1);
+ my ($o, $u_opt) = $self->_parse_options($self->{PlotOptions}, ($opt || {}));
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+ &catch_signals;
+
+ unless ( $self->held() ) {
+ my ($xmin, $xmax)=ref $o->{XRange} eq 'ARRAY' ?
+ @{$o->{XRange}} : minmax(pdl($x1->at(0),$x2->at(0)));
+ my ($ymin, $ymax)=ref $o->{YRange} eq 'ARRAY' ?
+ @{$o->{YRange}} : minmax(pdl($y1->at(0),$y2->at(0)));
+ if ($xmin == $xmax) { $xmin -= 0.5; $xmax += 0.5; }
+ if ($ymin == $ymax) { $ymin -= 0.5; $ymax += 0.5; }
+ $self->initenv( $xmin, $xmax, $ymin, $ymax, $opt );
+ }
+
+ $self->_save_status();
+ $self->_standard_options_parser($u_opt);
+
+ pgrect($x1, $x2, $y1, $y2);
+ $self->_restore_status();
+ $self->_add_to_state(\&poly, $in, $opt);
+
+ &release_signals;
+
+ 1;
+}
+
+
+
+# Plot a polygon with pgpoly()
+
+sub poly {
+ my $self = shift;
+ my ($in, $opt)=_extract_hash(@_);
+ release_and_barf 'Usage: poly ( $x, $y [, $options] )' if $#$in<0 || $#$in>2;
+ my($x,$y) = @$in;
+ $self->_checkarg($x,1);
+ $self->_checkarg($y,1);
+ my ($o, $u_opt) = $self->_parse_options($self->{PlotOptions}, $opt);
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+
+ &catch_signals;
+
+ unless ( $self->held() ) {
+ my ($xmin, $xmax)=ref $o->{XRange} eq 'ARRAY' ?
+ @{$o->{XRange}} : minmax($x);
+ my ($ymin, $ymax)=ref $o->{YRange} eq 'ARRAY' ?
+ @{$o->{YRange}} : minmax($y);
+ if ($xmin == $xmax) { $xmin -= 0.5; $xmax += 0.5; }
+ if ($ymin == $ymax) { $ymin -= 0.5; $ymax += 0.5; }
+ $self->initenv( $xmin, $xmax, $ymin, $ymax, $opt );
+ }
+
+ $self->_save_status();
+ $self->_standard_options_parser($u_opt);
+ my $n = nelem($x);
+ pgpoly($n, $x->get_dataref, $y->get_dataref);
+ $self->_restore_status();
+ $self->_add_to_state(\&poly, $in, $opt);
+
+ &release_signals;
+
+ 1;
+}
+
+# Plot a circle using pgcirc
+
+
+
+
+{
+ my $circle_options = undef;
+
+ sub circle {
+ my $self = shift;
+ if (!defined($circle_options)) {
+ $circle_options = $self->{PlotOptions}->extend({Radius => undef,
+ XCenter => undef,
+ YCenter => undef});
+ }
+ my ($in, $opt)=_extract_hash(@_);
+ $opt = {} if !defined($opt);
+ my ($x, $y, $radius)=@$in;
+
+ my ($o, $u_opt) = $self->_parse_options($circle_options, $opt);
+ $o->{XCenter}=$x if defined($x);
+ $o->{YCenter}=$y if defined($y);
+ $o->{Radius} = $radius if defined($radius);
+
+ &catch_signals;
+
+
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+##DAL added this to properly set environment
+ unless ( $self->held() ) {
+ my ($xmin, $xmax)=ref $o->{XRange} eq 'ARRAY' ?
+ @{$o->{XRange}} : ($x-$radius,$x+$radius);
+ my ($ymin, $ymax)=ref $o->{YRange} eq 'ARRAY' ?
+ @{$o->{YRange}} : ($y-$radius,$y+$radius);
+ $self->initenv( $xmin, $xmax, $ymin, $ymax, $opt );
+ }
+##end DAL addition
+
+ $self->_save_status();
+ $self->_standard_options_parser($u_opt);
+ pgcirc($o->{XCenter}, $o->{YCenter}, $o->{Radius});
+ $self->_restore_status();
+ $self->_add_to_state(\&circle, $in, $opt);
+
+ &release_signals;
+ }
+}
+
+
+my $circle_options = undef;
+sub tcircle {
+
+ my $self = shift;
+ my ($in, $opt)=_extract_hash(@_);
+ $self->_add_to_state(\&tcircle,$in,$opt);
+ $opt = {} if !defined($opt);
+
+ release_and_barf 'Usage tcircle ($x,$y,$r,[$options])'
+ if $#$in < 0 || $#$in > 3;
+
+ my ($x, $y, $radius)=@$in;
+ $x=$x->flat;$y=$y->flat;$radius=$radius->flat;
+
+ if (!defined($circle_options)){
+ $circle_options=$self->{PlotOptions}->extend({Missing => undef});
+ }
+
+ &catch_signals;
+
+ my $o = _thread_options($x->nelem,$opt);
+ my $tmp_hold = $self->held();
+
+ unless ( $self->held() ) {
+ my ($o,$u_opt) = $self->_parse_options($circle_options,$opt);
+ $self->_check_move_or_erase($o->{Panel},$o->{Erase});
+
+ my ($ymin, $ymax, $xmin, $xmax);
+
+ if ( defined $o->{Missing} ) {
+ ($ymin, $ymax)=ref $o->{YRange} eq 'ARRAY' ?
+ @{$o->{YRange}} : minmax($y->where($y != $o->{Missing}));
+ ($xmin, $xmax)=ref $o->{XRange} eq 'ARRAY' ?
+ @{$o->{XRange}} : minmax($x->where($x != $o->{Missing}));
+ } else {
+ ($ymin, $ymax)=ref $o->{YRange} eq 'ARRAY' ? @{$o->{YRange}} :
+ (min($y-$radius),max($y+$radius));
+ ($xmin, $xmax)=ref $o->{XRange} eq 'ARRAY' ? @{$o->{XRange}} :
+ (min($x-$radius),max($x+$radius));
+ }
+ if ($xmin == $xmax) { $xmin-=0.5; $xmax +=0.5; }
+ if ($ymin == $ymax) { $ymin-=0.5; $ymax +=0.5; }
+
+ $self->initenv( $xmin, $xmax, $ymin, $ymax, $opt);
+ $self->hold;
+ }
+ _tcircle($x,$y,$radius,PDL->sequence($x->nelem),$self,$o);
+ $self->release unless $tmp_hold;
+
+ &release_signals;
+
+}
+
+PDL::thread_define '_tcircle(a();b();c();ind()), NOtherPars => 2',
+ PDL::over {
+ my ($x,$y,$r,$ind,$self,$opt)=@_;
+ $self->circle($x,$y,$r,$opt->[$ind->at(0)] || {} );
+ };
+
+
+# Plot an ellipse using poly.
+
+{
+ my $ell_options = undef;
+
+ sub ellipse {
+ my $self = shift;
+ if (!defined($ell_options)) {
+ $ell_options = $self->{PlotOptions}->extend({
+ MajorAxis=>undef,
+ MinorAxis=>undef,
+ Theta => 0.0,
+ XCenter => undef,
+ YCenter => undef,
+ NPoints => 100
+ });
+ $ell_options->synonyms({Angle => 'Theta'});
+ }
+ my ($in, $opt)=_extract_hash(@_);
+ $opt = {} unless defined $opt;
+ my ($x, $y, $a, $b, $theta)=@$in;
+
+ my $o = $ell_options->options($opt);
+ $o->{XCenter}=$x if defined($x);
+ $o->{YCenter}=$y if defined($y);
+ $o->{MajorAxis} = $a if defined($a);
+ $o->{MinorAxis} = $b if defined($b);
+ $o->{Theta}=$theta if defined($theta);
+
+ if (!defined($o->{MajorAxis}) || !defined($o->{MinorAxis}) || !defined($o->{XCenter})
+ || !defined($o->{YCenter})) {
+ release_and_barf "The major and minor axis and the center coordinates must be given!";
+ }
+
+
+ &catch_signals;
+
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+ my $t = 2*$PI*sequence($o->{NPoints})/($o->{NPoints}-1);
+ my ($xtmp, $ytmp) = ($o->{MajorAxis}*cos($t), $o->{MinorAxis}*sin($t));
+
+ # Rotate the ellipse and shift it.
+ my ($costheta, $sintheta)=(cos($o->{Theta}), sin($o->{Theta}));
+ $x = $o->{XCenter}+$xtmp*$costheta-$ytmp*$sintheta;
+ $y = $o->{YCenter}+$xtmp*$sintheta+$ytmp*$costheta;
+
+ $self->_add_to_state(\&ellipse, $in, $opt);
+ # Now turn off recording so we don't get this one twice..
+ $self->turn_off_recording();
+ $self->poly($x, $y, $opt);
+ $self->turn_on_recording();
+
+ &release_signals;
+ }
+
+}
+
+
+{
+ my $rect_opt = undef;
+ sub rectangle {
+ my $self = shift;
+ my $usage='Usage: rectangle($xcenter, $ycenter, $xside, $yside, [, $angle, $opt])';
+ if (!defined($rect_opt)) {
+ # No need to use $self->{PlotOptions} here since we
+ # pass control to poly below.
+ $rect_opt = PDL::Options->new({XCenter => undef, YCenter => undef,
+ XSide => undef, YSide => undef,
+ Angle => 0, Side => undef});
+ $rect_opt->synonyms({XCentre => 'XCenter', YCentre => 'YCenter',
+ Theta => 'Angle'});
+ $rect_opt->warnonmissing(0);
+ }
+ my ($in, $opt)=_extract_hash(@_);
+ $opt={} if !defined($opt);
+ my ($xc, $yc, $xside, $yside, $angle)=@$in;
+ my $o=$rect_opt->options($opt);
+
+ $o->{XCenter}=$xc if defined($xc);
+ $o->{YCenter}=$yc if defined($yc);
+ $o->{XSide}=$xside if defined($xside);
+ $o->{YSide}=$yside if defined($yside);
+ $o->{Angle}=$angle if defined($angle);
+
+ ##
+ # Now do some error checking and checks for squares.
+ ##
+ if (defined($o->{XSide}) || defined($o->{YSide})) {
+ # At least one of these are set - let us ignore Side.
+ $o->{XSide}=$o->{YSide} if !defined($o->{XSide});
+ $o->{YSide}=$o->{XSide} if !defined($o->{YSide});
+ } elsif (defined($o->{Side})) {
+ $o->{XSide}=$o->{Side};
+ $o->{YSide}=$o->{Side};
+ } else {
+ print "$usage\n";
+ release_and_barf 'The sides of the rectangle must be specified!';
+ }
+
+ unless (defined($o->{XCenter}) && defined($o->{YCenter})) {
+ print "$usage\n";
+ release_and_barf 'The center of the rectangle must be specified!';
+ }
+
+ &catch_signals;
+
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+ # Ok if we got this far it is about time to do something useful,
+ # namely construct the piddle that contains the sides of the rectangle.
+
+ # We make it first parallell to the coordinate axes around origo
+ # and rotate it subsequently (ala the ellipse routine above).
+ my ($dx, $dy)=(0.5*$o->{XSide}, 0.5*$o->{YSide});
+ my $xtmp = pdl(-$dx, $dx, $dx, -$dx, -$dx);
+ my $ytmp = pdl(-$dy, -$dy, $dy, $dy, -$dy);
+
+ my ($costheta, $sintheta)=(cos($o->{Angle}), sin($o->{Angle}));
+ my $x = $o->{XCenter}+$xtmp*$costheta-$ytmp*$sintheta;
+ my $y = $o->{YCenter}+$xtmp*$sintheta+$ytmp*$costheta;
+
+ $self->_add_to_state(\&rectangle, $in, $opt);
+ # Turn off recording temporarily.
+ $self->turn_off_recording();
+ $self->poly($x, $y, $opt);
+ $self->turn_on_recording();
+
+ &release_signals;
+ }
+}
+
+
+# display a vector map of 2 images using pgvect()
+
+{
+ my $vect_options = undef;
+
+ sub vect {
+ my $self = shift;
+ if (!defined($vect_options)) {
+ $vect_options = $self->{PlotOptions}->extend({
+ Scale => 0,
+ Position => 0,
+ Missing => undef
+ });
+ $vect_options->add_synonym({Pos => 'Position'});
+ }
+ my ($in, $opt)=_extract_hash(@_);
+ release_and_barf 'Usage: vect ( $a, $b, [$scale, $pos, $transform, $misval] )' if $#$in<1 || $#$in>5;
+ my ($a, $b, $scale, $pos, $tr, $misval) = @$in;
+ $self->_checkarg($a,2); $self->_checkarg($b,2);
+ my($nx,$ny) = $a->dims;
+ my($n1,$n2) = $b->dims;
+ release_and_barf 'Dimensions of $a and $b must be the same' unless $n1==$nx && $n2==$ny;
+
+ my ($o, $u_opt) = $self->_parse_options($vect_options, $opt);
+ $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+
+ # Parse for options input instead of calling convention
+ $scale = $o->{Scale} if exists($u_opt->{Scale});
+ $pos = $o->{Position} if exists($u_opt->{Scale});
+ $tr = $o->{Transform} if exists($u_opt->{Transform});
+ $misval = $o->{Missing} if exists($u_opt->{Missing});
+ #What if there's no Missing option supplied and one of the input piddles
+ #contain zero? Then that location will have no arrow, instead of a
+ #horizontal or vertical line. So define $misval, but make it meaningless:
+ $misval = 1 + $a->glue(0,$b)->flat->maximum unless defined $misval; #DAL added 02-Jan-2006
+
+ $scale = 0 unless defined $scale;
+ $pos = 0 unless defined $pos;
+
+ if (defined($tr)) {
+ $self->_checkarg($tr,1);
+ release_and_barf '$transform incorrect' if nelem($tr)!=6;
+ } else {
+ $tr = float [0,1,0, 0,0,1];
+ }
+ $tr = $self->CtoF77coords($tr);
+
+ &catch_signals;
+
+ $self->initenv( 0, $nx-1, 0, $ny-1, $opt ) unless $self->held();
+ print "Vectoring $nx x $ny images ...\n" if $PDL::verbose;
+
+ $self->_save_status();
+ $self->_standard_options_parser($u_opt); # For arrowtype and arrowhead
+ pgvect( $a->get_dataref, $b->get_dataref, $nx,$ny,1,$nx,1,$ny, $scale, $pos,
+ $tr->get_dataref, $misval);
+ $self->_restore_status();
+ $self->_add_to_state(\&vect, $in, $opt);
+
+ &release_signals;
+ 1;
+ }
+}
+
+# ############ Text routines #############
+
+
+
+{
+ # Do not create this object unless necessary.
+ my $text_options = undef;
+
+ sub text {
+ my $self = shift;
+
+ if (!defined($text_options)) {
+ # This is the first time this routine is called so we
+ # have to initialise the options object.
+ $text_options = $self->{PlotOptions}->extend({
+ Angle => 0.0,
+ Justification => 0.0,
+ Text => '',
+ XPos => undef,
+ YPos => undef
+ });
+ $text_options->add_synonym({Justify => 'Justification'});
+ $text_options->add_synonym({Bg => 'BackgroundColour'});
+ }
+
+ # Extract the options hash and separate it from the other input
+ my ($in, $opt)=_extract_hash(@_);
+ $opt = {} if !defined($opt);
+ release_and_barf 'Usage: text ($text, $x, $y, [,$opt])' if
+ (!defined($opt) && $#$in < 2) || ($#$in > 3) || ($#$in < 0);
+ my ($text, $x, $y)=@$in;
+
+ # Next - parse options
+ my ($o, $u_opt) = $self->_parse_options($text_options, $opt);
+
+ # Check for change of panel or request to erase the panel
+ # (Commented out by CED 21-Jun-2002, because this seems
+ # to erase too much -- e.g. it's hard to scribble on a line plot!)
+ # $self->_check_move_or_erase($o->{Panel}, $o->{Erase});
+ # Parse standard options such as colour
+
+ $self->_save_status();
+
+ $self->_standard_options_parser($u_opt);
+
+ # Finally do what the routine needs to do.
+ $o->{Text}=$text if defined($text);
+ $o->{XPos}=$x if defined($x);
+ $o->{YPos}=$y if defined($y);
+ release_and_barf "text: You must specify the X-position!\n" if !defined($o->{XPos});
+ release_and_barf "text: You must specify the Y-position!\n" if !defined($o->{YPos});
+
+
+ &catch_signals;
+
+ # Added support for different background colours..
+ # 2/10/01 JB - To avoid -w noise we use a reg-exp..
+
+ if ($o->{BackgroundColour} !~ m/^-\d+$/) {
+ $self->_set_colour($o->{BackgroundColour}, 1);
+ }
+
+ # what width do we use?
+ # - things are somewhat confused since we have
+ # LineWidth and TextWidth (a recent addition)
+ # and LineWidth is set by _setup_window() - so
+ # _standard_options_parser() uses it - but
+ # TextWidth isn't.
+ #
+ # so for now we over-ride the _standard_options_parser
+ # setting if TextWidth exists
+ # [DJB 2002 Aug 08]
+ my $old_lw;
+ if ( defined($o->{TextWidth}) ) {
+ pgqlw($old_lw);
+ pgslw($o->{TextWidth});
+ }
+
+ my $old_bg;
+
+ pgptxt($o->{XPos}, $o->{YPos}, $o->{Angle}, $o->{Justification},
+ $o->{Text});
+
+ pgslw($old_lw) if defined $old_lw;
+#
+ $self->_restore_status();
+ $self->_add_to_state(\&text, $in, $opt);
+
+ &release_signals;
+
+ 1;
+ }
+}
+
+
+
+{
+ my $legend_options = undef;
+
+ sub legend {
+
+ my $self = shift;
+ if (!defined($legend_options)) {
+ $legend_options = $self->{PlotOptions}->extend({
+ Text => undef,
+ XPos => undef,
+ YPos => undef,
+ Width => 'Automatic',
+ Height => 'Automatic',
+ TextFraction => 0.5,
+ TextShift => 0.1,
+ VertSpace => 0
+ });
+ # should this be synonyms() or add_synonym() ? DJB 09 Apr 03
+ $legend_options->add_synonym({
+ VSpace => 'VertSpace',
+ Fraction => 'TextFraction',
+ Bg => 'BackgroundColour',
+ });
+ }
+ my ($in, $opt)=_extract_hash(@_);
+ $opt = {} if !defined($opt);
+ my ($o, $u_opt) = $self->_parse_options($legend_options, $opt);
+
+ #
+ # In this function there are several options that we do not want
+ # parsed by the standard options parsers so we deal with these
+ # here - we translate the linestyles, symbols and colours below
+ #
+ my %myopt;
+ foreach my $optname ( qw( LineStyle LineWidth Colour Symbol ) ) {
+ my $tmp = $u_opt->{$optname};
+ $myopt{lc($optname)} = ref($tmp) eq "ARRAY" ? $tmp : [$tmp];
+ delete $u_opt->{$optname};
+ }
+
+ my ($text, $x, $y, $width)=@$in;
+ $o->{Text} = $text if defined($text);
+ $o->{XPos} = $x if defined($x);
+ $o->{YPos} = $y if defined($y);
+ $o->{Width} = $width if defined($width);
+
+ # We could keep accessing $o but this is more succint.
+ # [In the following we want to deal with an array of text.]
+ $text = $o->{Text};
+ $text = [$text] unless ref($text) eq 'ARRAY';
+ my $n_lines = $#$text+1;
+
+ if (!defined($o->{XPos}) || !defined($o->{YPos}) || !defined($o->{Text})) {
+ release_and_barf 'Usage: legend $text, $x, $y [,$width, $opt] (styles are given in $opt)';
+ }
+
+ &catch_signals;
+
+ $self->_save_status();
+
+ $self->_standard_options_parser($u_opt); # Set font, charsize, colour etc.
+
+ # Ok, introductory stuff has been done, lets get down to the gritty
+ # details. First let us save the current character size.
+ pgqch(my $chsz);
+
+ ## Now, set the background colour of the text before getting further.
+ ## Added 2/10/01 - JB - test as a regexp to avoid -w noise.
+ if ($o->{BackgroundColour} !~ m/^-?\d+$/) {
+ # Do this unless a negative integer..
+ $self->_set_colour($o->{BackgroundColour}, 1);
+ }
+
+ # The size of the legend can be specified by giving the width or the
+ # height so to calculate the required text size we need to find the
+ # minimum required (since text in PGPLOT cannot have variable width
+ # and height.
+ # Get the window size.
+ pgqwin( my $xmin, my $xmax, my $ymin, my $ymax );
+
+ # note: VertSpace is assumed to be a scalar
+ my $vfactor = 1.0 + $o->{VertSpace};
+
+ my $required_charsize=$chsz*9000;
+
+ if ($o->{Width} eq 'Automatic' && $o->{Height} eq 'Automatic') {
+ # Ok - we just continue with the given character size.
+ $required_charsize = $chsz;
+ # We still need to calculate the width and height of the legend
+ # though. Fixed 20/3/01
+
+ my $t_width = -1; # Very short text...
+ my $t_height = -1; # And very low
+ foreach my $t (@$text) {
+ # Find the bounding box of left-justified text
+ pgqtxt($xmin, $ymin, 0.0, 0.0, $t, my $xbox, my $ybox);
+ my $dx = $$xbox[2] - $$xbox[0];
+ my $dy = $$ybox[2] - $$ybox[0];
+ $t_width = $dx if $dx > $t_width;
+ $t_height = $dy if $dy > $t_height;
+ }
+
+ $o->{Width} = $t_width/$o->{TextFraction};
+ # we include an optional vspace (which is given as a fraction of the
+ # height of a line)
+ $o->{Height} = $t_height*$vfactor*$n_lines; # The height of all lines..
+ } else {
+ # We have some constraint on the size.
+ my ($win_width, $win_height)=($xmax-$xmin, $ymax-$ymin);
+
+ # If either the width or the height is set to automatic we set
+ # the width/height here to be 2 times the width/height of the
+ # plot window - thus ensuring not too large a text size should the
+ # user have done something stupid, but still large enough to
+ # detect an error.
+ $o->{Width} = 2*$win_width/$o->{TextFraction} if $o->{Width} eq 'Automatic';
+ $o->{Height} = 2*$win_height if $o->{Height} eq 'Automatic';
+
+ foreach my $t (@$text) {
+ # Find the bounding box of left-justified text
+ pgqtxt($xmin, $ymin, 0.0, 0.0, $t, my $xbox, my $ybox);
+ my $dx = $$xbox[2] - $$xbox[0];
+ my $dy = $$ybox[2] - $$ybox[0];
+
+ # Find what charactersize is required to fit the height
+ # (accounting for vspace) or fraction*width:
+ my $t_width = $o->{TextFraction}*$o->{Width}/$dx;
+ my $t_height = $o->{Height}/$vfactor/$n_lines/$dy; # XXX is $vfactor==(1+VertSpace) correct?
+
+ $t_chsz = ($t_width < $t_height ? $t_width*$chsz : $t_height*$chsz);
+
+ $required_charsize = $t_chsz if $t_chsz < $required_charsize;
+
+ pgsch($required_charsize*$chsz); # Since we measured relative to $chsz
+ }
+ }
+
+ #
+ # Ok, $required_charsize should now contain the optimal size for the
+ # text. The next step is to create the legend. We can set linestyle,
+ # linewidth, colour and symbol for each of these texts.
+ #
+ my ($xpos, $ypos) = ($o->{XPos}, $o->{YPos});
+ my ($xstart, $xend)=($o->{XPos}+$o->{TextFraction}*$o->{Width}+
+ $o->{TextShift}*$o->{Width}, $o->{XPos}+$o->{Width});
+ my $xmid = 0.5 * ($xstart + $xend);
+
+ # step size in y
+ my $ystep = $o->{Height} / $n_lines;
+
+ # store current settings
+ pgqci(my $col);
+ pgqls(my $ls);
+ pgqlw(my $lw);
+
+ foreach (my $i=0; $i<$n_lines; $i++) {
+ $self->text($text->[$i], $xpos, $ypos);
+ # Since the parsing of options does not go down array references
+ # we need to create a temporary PDL::Options object here to do the
+ # parsing..
+ my $t_o = $self->{PlotOptions}->options({
+ Symbol => $myopt{symbol}[$i],
+ LineStyle => $myopt{linestyle}[$i],
+ LineWidth => $myopt{linewidth}[$i],
+ Colour => $myopt{colour}[$i],
+ });
+
+ $self->_set_colour($t_o->{Colour}) if defined($myopt{colour}[$i]);
+
+ # Use the following to get the lines/symbols centered on the
+ # text.
+ pgqtxt($xpos, $ypos, 0.0, 0.0, $text->[$i], my $xbox, my $ybox);
+ my $ymid = 0.5 * ($$ybox[2] + $$ybox[0]);
+
+ if (defined($myopt{symbol}[$i])) {
+
+ pgpt(1, $xmid, $ymid, $t_o->{Symbol});
+
+ } else {
+ pgsls($t_o->{LineStyle}) if defined $myopt{linestyle}[$i];
+ pgslw($t_o->{LineWidth}) if defined $myopt{linewidth}[$i];
+ pgline(2, [$xstart, $xend], [$ymid, $ymid]);
+ }
+
+ # reset colour, line style & width after each line
+ $self->_set_colour($col);
+ pgsls($ls);
+ pgslw($lw);
+
+ $ypos -= $ystep;
+ }
+
+
+ $self->_restore_status();
+ $self->_add_to_state(\&legend, $in, $opt);
+
+ &release_signals;
+
+ }
+
+}
+
+
+
+
+
+############## Cursor routine ##################
+
+
+
+{
+ $cursor_options = undef;
+ sub cursor {
+
+ my $self = shift;
+ # Let us check if this is a hardcopy device, in which case we will return
+ # with a warning and undefined values.
+ my ($hcopy, $len);
+ pgask(0);
+ pgqinf("HARDCOPY",$hcopy,$len);
+ if ($hcopy eq 'YES') {
+ warn "cursor called on a hardcopy device - returning!\n";
+ return (undef, undef, undef, undef, undef);
+ }
+
+ if (!defined($cursor_options)) {
+ $cursor_options = PDL::Options->new(
+ {
+ 'XRef' => undef,
+ 'YRef' => undef,
+ 'Type' => 0
+ });
+ $cursor_options->translation({Type=>{
+ 'Default' => 0,
+ 'RadialLine' => 1,
+ 'Rectangle' => 2,
+ 'TwoHorizontalLines' => 3,
+ 'TwoVerticalLines' => 4,
+ 'HorizontalLine' => 5,
+ 'VerticalLine' => 6,
+ 'CrossHair' => 7
+ }});
+ }
+
+ my ($opt)=@_;
+
+ $opt = {} unless defined($opt);
+ my $place_cursor=1; # Since X&Y might be uninitialised.
+ my $o = $cursor_options->options($opt);
+
+ my ($x, $y, $ch);
+
+ &catch_signals;
+
+ # The window needs to be focussed before using the cursor commands.
+ # Added 08/08/01 by JB after bug report from Brad Holden.
+ $self->focus();
+
+ if ($o->{Type} eq 'Rectangle' && !defined($o->{XRef})) {
+ #
+ # We use pgcurs to get a first position.
+ #
+ print "Please select a corner of the rectangle\n";
+ pgcurs($x, $y, $ch);
+ $o->{XRef}=$x;
+ $o->{YRef}=$y;
+ }
+
+ if ($o->{Type} > 7 || $o->{Type} < 0) {
+ print "Unknown type of cursor $$o{Type} - using Default\n";
+ $o->{Type}=0;
+ }
+ my ($xmin, $xmax, $ymax, $ymin);
+ pgqwin($xmin, $xmax, $ymin, $ymax);
+
+ $x = $o->{XRef} if defined($o->{XRef});
+ $y = $o->{YRef} if defined($o->{YRef});
+
+ $x = 0.5*($xmin+$xmax) if !defined($x);
+ $y = 0.5*($ymin+$ymax) if !defined($y);
+
+ my ($got_xref, $got_yref)=(defined($o->{XRef}), defined($o->{YRef}));
+ if (!$got_xref || !$got_yref) {
+ # There is a little bit of gritty error-checking
+ # for the users convenience here.
+ if ($o->{Type}==1 || $o->{Type}==2) {
+ release_and_barf "When specifying $$o{Type} as cursor you must specify the reference point";
+ } elsif ($o->{Type}==3 && !$got_yref) {
+ release_and_barf "When specifying two horizontal lines you must specify the Y-reference";
+ } elsif ($o->{Type}==4 && !$got_xref ) {
+ release_and_barf "When specifying two vertical lines you must specify the X-reference";
+ }
+
+ # Ok so we have some valid combination of type and reference point.
+ $o->{XRef}=$xmin if !$got_xref;
+ $o->{YRef}=$ymin if !$got_yref;
+
+ }
+
+
+ $ch = ''; # To silence -w
+ my $istat = pgband($o->{Type}, $place_cursor, $o->{XRef},
+ $o->{YRef}, $x, $y, $ch);
+
+ $self->_add_to_state(\&cursor, [], $opt);
+
+ &release_signals;
+ return ($x, $y, $ch, $o->{XRef}, $o->{YRef});
+
+ }
+}
+
+
+=head1 INTERNAL
+
+The coding tries to follow reasonable standards, so that all functions
+starting with an underscore should be considered as internal and should
+not be called from outside the package. In addition most routines have
+a set of options. These are encapsulated and are not accessible outside
+the routine. This is to avoid collisions between different variables.
+
+
+=head1 AUTHOR
+
+Karl Glazebrook [kgb at aaoepp.aao.gov.au] modified by Jarle Brinchmann
+(jarle at astro.ox.ac.uk) who is also responsible for the OO interface,
+docs mangled by Tuomas J. Lukka (lukka at fas.harvard.edu) and
+Christian Soeller (c.soeller at auckland.ac.nz). Further contributions and
+bugfixes from Kaj Wiik, Doug Burke, Craig DeForest, and many others.
+
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+#
+
+1;
+
+__DATA__
+
diff --git a/Graphics/PGPLOT/Window/Window.xs b/Graphics/PGPLOT/Window/Window.xs
new file mode 100644
index 0000000..fc19ae4
--- /dev/null
+++ b/Graphics/PGPLOT/Window/Window.xs
@@ -0,0 +1,118 @@
+
+/*
+ PGPLOT.xs
+
+ A few routines in C to speed up PDL access to PGPLOT primitives.
+
+*/
+
+#include "EXTERN.h" /* std perl include */
+#include "perl.h" /* std perl include */
+#include "XSUB.h" /* XSUB include */
+#include "ppport.h" /* for backwards comaptibility */
+
+struct PGPLOT_function_handle {
+ I32 binversion;
+ void (*cpgmove) (float x, float y);
+ void (*cpgdraw) (float x, float y);
+ void (*cpgqcir) (int *icilo, int *icihi);
+ void (*cpgsci) (int ci);
+ void (*cpgpt1) (float x, float y, int sym);
+};
+
+typedef struct PGPLOT_function_handle PGPLOT_function_handle;
+
+static I32 PGPLOT_structure_version = 20000302; /* The date the PGPLOT structure changed */
+static PGPLOT_function_handle *myhandle;
+SV *ptr;
+
+MODULE = PDL::Graphics::PGPLOT::Window PACKAGE = PDL::Graphics::PGPLOT::Window
+
+void
+pggapline(n,msgval,xpts,ypts)
+ int n
+ float msgval
+ float * xpts
+ float * ypts
+ CODE:
+ { int i;
+ int start = 0;
+ while (xpts[start] == msgval) start++; /* make sure we have a good starting point */
+ myhandle->cpgmove (xpts[start], ypts[start]);
+ for (i=start+1;i<n;i++) {
+ if (ypts[i] == msgval) {
+ /* check we are not at end of array and we don't move to a missing value */
+ if (i != n-1 && ypts[i+1] != msgval) {
+ myhandle->cpgmove (xpts[i+1], ypts[i+1]);
+ }
+ }
+ else {
+ myhandle->cpgdraw (xpts[i], ypts[i]);
+ }
+ }
+ }
+
+
+
+void
+pgcolorpnts(n,x,y,z,sym)
+ int n
+ float * x
+ float * y
+ float * z
+ int sym
+ CODE:
+ {
+ /* find range of color pallette */
+ int icilo, icihi, i, cirange, ci;
+ float minz, maxz, zrange;
+
+ /* If the structure read from the PGPLOT module is too old */
+ if (myhandle->binversion < PGPLOT_structure_version) {
+ char msg[128];
+ sprintf (msg, "This function requires PGPLOT with a structure version at least %d.\nPlease upgrade your PGPLOT package.",
+ PGPLOT_structure_version);
+
+ Perl_croak(aTHX_ "%s", msg);
+ }
+
+ myhandle->cpgqcir(&icilo, &icihi);
+
+ /* find min and max values of zpts variable */
+ minz = 9.99e30;
+ maxz = -9.99e30;
+ for (i=0;i<n;i++) {
+ if (z[i] < minz) minz = z[i];
+ if (z[i] > maxz) maxz = z[i];
+ }
+
+ /* determine range of available z indices and range of input 'z' values */
+ cirange = icihi - icilo;
+ zrange = maxz - minz;
+
+ /* printf ("cilo = %d, cihi = %d\n", icilo, icihi); */
+
+ /* for each input point, compute a scaled color index and plot the point */
+ for (i=0;i<n;i++) {
+ ci = (int)(icilo + (z[i] - minz) * (float)(cirange/zrange));
+ /* printf ("x = %f, y = %f, ci = %d\n", x[i], y[i], ci); */
+ myhandle->cpgsci(ci);
+ myhandle->cpgpt1(x[i], y[i], sym);
+ }
+ }
+
+
+
+BOOT:
+
+ /* Get pointer to structure of core shared C routines */
+ ptr = get_sv("PGPLOT::HANDLE",FALSE | GV_ADDMULTI); /* SV* value */
+#ifndef aTHX_
+#define aTHX_
+#endif
+ if (ptr==NULL)
+ Perl_croak(aTHX_ "This module requires PGPLOT version 2.16 or later.\nPlease install/upgrade PGPLOT (see the PDL/DEPENDENCIES file).");
+ myhandle = INT2PTR(PGPLOT_function_handle*,SvIV( ptr ));
+
+
+
diff --git a/Graphics/PGPLOT/Window/typemap b/Graphics/PGPLOT/Window/typemap
new file mode 100644
index 0000000..9eec1a3
--- /dev/null
+++ b/Graphics/PGPLOT/Window/typemap
@@ -0,0 +1,8 @@
+TYPEMAP
+float T_NV
+float * T_FLOATS
+
+INPUT
+
+T_FLOATS
+ $var = (float *)(SvPV(SvRV($arg), PL_na))
diff --git a/Graphics/PLplot/Changes b/Graphics/PLplot/Changes
new file mode 100644
index 0000000..48c39a9
--- /dev/null
+++ b/Graphics/PLplot/Changes
@@ -0,0 +1,104 @@
+Revision history for Perl extension PDL::Graphics::PLPLOT
+
+0.01 1/23/2002
+ - original version
+
+0.11 First version released to CPAN. Does line and point plots and Shade plots.
+ Still missing support for 3D plots (but this could easily be added).
+
+0.19 1/31/2003 First version integrated into the PDL distribution. Includes
+ Support for 'mem' driver for in-memory plotting on top of RGB images.
+
+0.20 7/16/2003 Broke package apart from main PDL distribution to allow separate development.
+ Now package should work either as part of PDL distro (with plplot.t moved to PDL/t directory)
+ or independently (with plplot.t in PDL-Graphics-PLplot/t directory).
+ Added controls for tick size, tick spacing and error bars.
+
+0.21 11/21/2003 Fixed test suite to use Test::More, updated to work with plplot-5.2.1.
+ Back-ported to main PDL distro.
+
+0.29 6/22/05 Fixed bug in plcolorpoints in the "bad" code for loop
+
+0.30 8/9/06 No longer use plfill for color wedge--this does not work with some
+ drivers including the 'mem' driver. Also use fewer colors in the color wedge
+ for GIF device plots because of GIF's 256 color limitation
+
+0.31 May 2007 Merge changes from PDL mailing list
+
+0.32 Add TEXTPOSITION support for bargraph
+
+0.33 Added stripplot function for multiple plots with a common X axis. Added extra colors.
+
+0.34 Added Y_BASE and Y_GUTTER options to stripplot.
+
+0.35 Added new low level functions supporting alpha channels.
+
+0.36 Added pltimefmt call for plplot 5.9.0
+
+0.37 10/15/2008 Handle case of missing PDL better
+
+0.38 10/16/2008 Fixed typo in Makefile.PL that broke build, added plgvpd and plgvpw interfaces
+
+0.39 10/29/2008 Added lib64 paths back in to PLplot library search path.
+
+0.40 12/04/2008 Fixed interface to plgcol0, changed plParseOpts to use c_plparseopts (the current standard)
+ Added interface to plhlsrgb.
+ Ported back some changes from PDL-2.4.4 release for backwards compatibility with old plplot
+
+0.41 12/04/2008 Added VERSION in plplot.pd where you can query it from the command line:
+ perl -MPDL::Graphics::PLplot -e 'print "$PDL::Graphics::PLplot::VERSION\n"'
+
+0.42 12/04/2008 Added plimagefr support to allow complete plplot example x20.pl to work.
+
+0.43 12/05/2008 Added support for environment variables: PLPLOT_LIBDIR and PLPLOT_INCDIR
+ to allow the user to specify the plplot location.
+
+0.44 12/05/2008 Added plseed and plrandd interfaces
+
+0.45 12/10/2008 Fixed routines: plgcol0, plgcolbg, plscmap0, plscmap1
+ plgcol0a, plgcolbga, plscmap0a, plscmap1a
+ To handle output parms and SIZE parms consistently
+ Added 3D labelling functions for example 28.
+
+0.46 12/11/2008 Added font handling routines: plgfont, plsfont, plgfci, plsfci
+
+0.47 12/18/2008 Added band-aid to get_standard_pltrcb to avoid failure in plshades reported
+ by Orion Poplawski. Also added interface to plcalc_world and fixed interface to plgfnam.
+
+0.48 1/7/2009 Allow caller of 'colorkey' high level function to set XBOX or YBOX to set
+ color key number scale parameters. Also added logic to allow detection of
+ new plplot routines to prevent failure with plplot 5.9 and earlier.
+
+0.49 2/26/2009 Fix zero-divide bug in plcolorpoints
+
+0.50 06/15/2009 Took out logic depending upon $PDL::Config{WITH_PLPLOT} (which is set in the
+ PDL top-level Makefile.PL) for building and testing PDL::Graphics::PLplot.
+ This dependency required that PLplot detect and build correctly in the original
+ PDL compile. One should be able to install PDL::Graphics::PLplot later.
+ Also stripped a lot of cruft from plplot.t which seems not to be necessary for
+ more recent plplot versions.
+
+0.51 7/13/2009 Added logic to manage a PLstream pool instead of just incremenenting the pool number
+ with each call to 'new'. This allows one to re-use stream numbers after a call to
+ 'close'. Bug found by Marek Gierlinski.
+
+0.52 11/03/2009 Fixes for 64 bit machines: plFree2dGrid, plFreeGrid, plAllocGrid, plAlloc2dGrid, pltr0, pltr1, pltr2
+ Now compiler complains less.
+
+0.53 7/27/2010 Added UNFILLED_BARS option to allow the bargraph routine to plot bars that are not filled.
+
+0.54 12/15/2010 Unified PDL distro version of CPAN stand-alone PDL::Graphics::PLplot version 0.53.
+
+0.55 4/23/2011 Upgraded prior to plplot 5.9.8 release.
+ Added support for many functions: plgradient, plstring, plstring3, plarc, plstransform,
+ plslabelfunc, pllegend, plspal0, plspal1, plbtime,
+ plconfigtime, plctime, pltimefmt, plsesc
+ Removed deprecated functions: plarrows, c_plhls, c_plrgb, c_plrgb1
+ Fixed compiler warnings, did general clean-up.
+0.56 5/06/2011 Added test suite from plplot, plus comparison results from the C tests.
+ Also added META_MERGE in Makefile.PL to try to get PAUSE/CPAN indexing working.
+
+0.57 8/30/2011 Cleaned up OPTIONS! processing for communication from Makefile.PL to plplot.pd--now based on the approach
+ by Sisyphus. Also merged in David Merten's 'NoPthread => 1' option to allow for
+ use of PLplot in a pthreads environment.
+
diff --git a/Graphics/PLplot/Makefile.PL b/Graphics/PLplot/Makefile.PL
new file mode 100644
index 0000000..7c59772
--- /dev/null
+++ b/Graphics/PLplot/Makefile.PL
@@ -0,0 +1,279 @@
+# Makefile.PL for a package defined by PP code.
+
+use ExtUtils::MakeMaker;
+use Config;
+use File::Spec;
+use Data::Dumper;
+
+# comment this block out for PDL internal version
+#eval {
+# require PDL::Core::Dev; # needed for stand-alone version of package.
+# # Need to comment out
+# # for package included in PDL distro.
+#
+# PDL::Core::Dev->import;
+#};
+#my $pdl_installed = ($@) ? 0 : 1; # make always == 1 for install from PDL distro.
+#print "PDL ", ($pdl_installed ? 'is' : 'is not'), " installed\n";
+# end comment this block out for PDL internal version
+
+my $pdl_installed = 1; # uncomment for PDL-internal version
+
+if (!$pdl_installed) {
+ # write dummy makefile if PDL not installed
+ WriteMakefile(
+ 'NAME' => 'PDL::Graphics::PLplot',
+ 'PREREQ_PM' => { PDL => 0 },
+ );
+ exit;
+}
+
+#
+## Search for plplot library and include file
+#
+print "\nChecking PDL::Graphics::PLplot...\n";
+
+unlink ("OPTIONS!"); # remove file used to communicate with plplot.pd
+
+# on OS-X the library is called libplplotd.dylib, so we
+# use $Config{"so"} to get the extension name
+#
+my $libname = "libplplotd." . $Config{"so"};
+my $libname_static = "libplplotd.a";
+my $incname = "plplot.h";
+my $devnull = File::Spec->devnull(); # Portable null device.
+
+# require bad value support. D. Hunt 10/20/2008
+unless ($PDL::Config{WITH_BADVAL}) {
+ buildDummy ("Bad value support required! (Turn on WITH_BADVAL in perldl.conf)");
+ return if (caller); exit;
+}
+
+my $found_plplot =
+ (defined($PDL::Config{WITH_PLPLOT}) && (!$PDL::Config{WITH_PLPLOT}))
+ ? 0 : 1;
+print "found_plplot is $found_plplot\n";
+unless ($found_plplot) {
+ buildDummy ("User requested no PLplot interface!");
+ return if (caller); exit;
+}
+
+foreach my $libdir (
+ $ENV{PLPLOT_LIBDIR},
+ $PDL::Config{WHERE_PLPLOT_LIBS},
+ '/usr/local/plplot/lib64',
+ '/usr/local/plplot/lib',
+ '/usr/local/lib64',
+ '/usr/local/lib',
+ '/opt/local/lib',
+ '/usr/lib64',
+ '/usr/lib',
+ '/opt/lib64',
+ '/opt/lib',
+ '/ops/tools/lib',
+ '/sw/lib/', # default FINK installation
+ # Add new library paths here!!
+ ) {
+
+ if (-e "$libdir/$libname") {
+ $plplot_lib_path = $libdir;
+ $ENV{LD_LIBRARY_PATH} .= ":$libdir";
+ last;
+ } elsif (-e "$libdir/$libname_static") {
+ $plplot_lib_path = $libdir;
+ $ENV{LD_LIBRARY_PATH} .= ":$libdir";
+ $libname = $libname_static;
+ last;
+ }
+
+}
+
+unless (defined ($plplot_lib_path)) {
+ buildDummy ("Cannot find plplot library ($libname), skipping PDL::Graphics::PLplot\n");
+ return if (caller); exit;
+}
+
+foreach my $incdir (
+ $ENV{PLPLOT_INCDIR},
+ $PDL::Config{WHERE_PLPLOT_INCLUDE},
+ '/usr/local/plplot/include',
+ '/usr/local/plplot/include/plplot',
+ '/usr/local/include/plplot',
+ '/usr/local/include',
+ '/opt/local/include',
+ '/usr/include',
+ '/usr/include/plplot',
+ '/opt/include',
+ '/ops/tools/include/plplot',
+ '/ops/tools/include',
+ '/sw/include/plplot/', # default FINK installation
+ # Add new header paths here!!
+ ) {
+
+ if (-e "$incdir/$incname") {
+ $plplot_include_path = "-I$incdir";
+ if ($incdir =~ m|/plplot$|) {
+ $inc2 = $incdir;
+ $inc2 =~ s|/plplot$||;
+ $plplot_include_path .= " -I$inc2";
+ }
+ last;
+ }
+}
+
+unless (defined ($plplot_include_path)) {
+ buildDummy ("Cannot find plplot header file ($incname), skipping PDL::Graphics::PLplot\n");
+ return if (caller); exit;
+}
+
+# Test that PLplot was compiled --with-double (IE, a PLFLT is a double)
+my $size = compileAndRun ("$plplot_include_path", 1, <<'EOC');
+#include <plplot.h>
+main () { printf ("%d", sizeof (PLFLT)); }
+EOC
+
+unless ($size == 8) {
+ print " Sizeof(PLFLT) must be 8. PLplot must be compiled --with-double (IE ./configure --with-double)\n";
+ buildDummy ("Cannot find good set of libraries for linking PLplot, try fiddling perldl.conf\n");
+ return if (caller); exit;
+}
+
+# Try linking with library. New if blocks should be added if necessary
+my $libs;
+foreach my $l (
+ "-L$plplot_lib_path -lplplotd -lX11",
+ "-L$plplot_lib_path -lplplotd",
+ "-L$plplot_lib_path -lplplotd -lqsastime -lcsirocsa -lgdi32 -lcomdlg32",
+ # New lib combinations should be added here!
+ ) {
+ if (trylink( '', '#include <plplot.h>', 'plinit();', "$l $plplot_include_path")) {
+ $libs = $l;
+ print "\tSucceeded linking PLplot with $libs\n";
+ last;
+ }
+}
+
+unless (defined($libs)) {
+ buildDummy ("Cannot find good set of libraries for linking PLplot, try fiddling perldl.conf\n");
+ return if (caller); exit;
+}
+
+#
+## Tests for various PLplot features, present in different versions of PLplot
+#
+my %plversion = (); # Information on which PLplot functions/features available.
+$plversion{'plsmem'} = test_func_exists('plsmem', 'in-memory plotting', 'plsmem( 0, 0, NULL);');
+$plversion{'plsvect'} = test_func_exists('plsvect', 'vector plotting', 'plsvect (NULL, NULL, 0, 0);');
+$plversion{'c_plgcoloa'} = test_func_exists('c_plgcoloa', 'alpha transparency', 'c_plgcol0a(0, 0, 0, 0, NULL);');
+$plversion{'c_plseed'} = test_func_exists('c_plseed', 'random numbers', 'c_plseed (0 );');
+$plversion{'c_plsfont'} = test_func_exists('c_plsfont', 'set font', 'c_plsfont (0, 0, 0);');
+$plversion{'c_plimagefr'} = test_func_exists('c_plimagefr','2d matrix',
+ 'c_plimagefr (NULL, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, NULL, NULL);' );
+$plversion{'c_pllegend'} = test_func_exists('c_pllegend', 'Plot legends',
+ 'c_pllegend(NULL,NULL,0, 0, 0.0, 0.0, 0.0, 0, 0, 0,
+ 0, 0, 0, NULL,0.0, 0.0, 0.0, 0.0, NULL,NULL,
+ NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);');
+# Write these options to a file--used by plplot.pd during the 'make' step
+open my $fh, '>', 'OPTIONS!' or die "Cannot write to OPTIONS! file";
+print {$fh} Dumper(\%plversion);
+close $fh;
+
+$PDL::Config{WITH_PLPLOT} = 1;
+
+
+#
+## new way to get writemakefile args...
+#
+ at pack = (["plplot.pd",PLplot,PDL::Graphics::PLplot]);
+
+#%hash = pdlpp_stdargs_int(@::pack); # use this for module inside PDL source
+%hash = pdlpp_stdargs(@::pack); # use this for separate module
+
+# $hash{'PREREQ_PM'} = { PDL => 0 };
+$hash{'OPTIMIZE'} = '-g'; # If you want to debug, uncomment this.
+$hash{'VERSION_FROM'} = 'plplot.pd';
+$hash{'META_MERGE'} = {provides => {PDL::Graphics::PLplot => {file => 'plplot.pd', version => 0.57}}};
+
+$hash{'LIBS'} = [$libs];
+# add this to allow one to use the /ops/tools/lib plplot libs even when
+# another plplot is installed in /usr/local/lib. D. Hunt 6/4/2004
+$hash{'LDDLFLAGS'} = $^O eq 'darwin' ? " -bundle -undefined dynamic_lookup -L$plplot_lib_path " : " -shared -L$plplot_lib_path -L/usr/local/lib ";
+
+$hash{'INC'} .= " $plplot_include_path";
+$hash{'clean'} = {'FILES' =>
+ 'PLplot.pm PLplot.xs PLplot.o PLplot.c PLplot.bs *svg.* *.xfig temp* OPTIONS! Makefile.old'};
+
+#my $postamble = pdlpp_postamble(@::pack); # use for external module
+my $postamble = pdlpp_postamble_int(@::pack); # use for install inside PDL distro
+
+WriteMakefile(%hash);
+
+# Add genpp rule
+sub MY::postamble { $postamble };
+
+sub test_func_exists {
+
+ my ( $func, $comment, $eval, $option ) = @_;
+
+ $option = $func unless defined $option;
+
+ # Test if PLplot has plsmem, for in memory plotting
+ eval { compileAndRun ("$plplot_include_path $libs", 0, <<"EOC");
+#include <plplot.h>
+main () { $eval }
+EOC
+ };
+
+ my $have_func;
+ if ($@)
+ {
+ print "\t$func function not found, no $comment available\n";
+ $have_func = 0;
+ }
+ else
+ {
+ print "\t$func function found, $comment available!\n";
+ $have_func = 1;
+ }
+
+ return $have_func;
+}
+
+sub compileAndRun {
+ my $flags = shift;
+ my $run = shift;
+ my $code = shift;
+
+ open (OUT, ">temp.c");
+ print OUT $code;
+ close OUT;
+ unlink './temp'; # since we work out whether the compile succeeds by presence of this
+ unlink './temp.exe'; # since we work out whether the compile succeeds by presence of this
+
+ my $cc = $Config{cc};
+ my $ccflags = $Config{ccflags};
+ # print "Trying: $cc $ccflags $flags temp.c -o temp\n";
+
+ # The duplication of $flags seems to be necessary, as some systems
+ # need $flags before temp.c and some after. D. Hunt 2/9/2011
+ system "$cc $ccflags $flags temp.c $flags -o temp > $devnull 2>&1";
+ unlink('./temp.c');
+ die "Cannot compile test program: $code" unless (-e 'temp' or -e 'temp.exe');
+ unless ($run){
+ unlink './temp';
+ unlink './temp.exe';
+ return;
+ }
+ my $res = `./temp`;
+ unlink ('./temp');
+ return $res;
+}
+
+sub buildDummy {
+ my $msg = shift;
+ $msg .= "\n Not building PDL::Graphics::PLplot\n";
+ warn $msg . "\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ $PDL::Config{WITH_PLPLOT} = 0;
+}
diff --git a/Graphics/PLplot/README b/Graphics/PLplot/README
new file mode 100644
index 0000000..1a329eb
--- /dev/null
+++ b/Graphics/PLplot/README
@@ -0,0 +1,77 @@
+PDL::Graphics::PLplot
+
+This is a simple perl/PDL interface to the PLplot plotting library.
+
+http://plplot.sourceforge.net/
+
+I wrote this primarily for web graphics as an alternative to PDL::Graphics::PGPLOT.
+
+The advantages of PLplot over PGPLOT are these:
+
+-- It is written all in (generally well structured, comprehensible) C
+ (so you don't need a FORTRAN compiler as for PGPLOT).
+-- It is in current development
+-- It has a simple autoconf installation with built-in PNG support
+
+(The disadvantage is that it is missing some of PGPLOT's many features).
+
+The interface consists of two levels. A low level interface which maps closely to
+the PLplot C interface, and a high level, object-oriented interface which is easier to
+use.
+
+Examples:
+
+use PDL:
+use PDL::Graphics::PLplot;
+
+# Line plot of two 1D PDLs $x and $y
+my $pl = PDL::Graphics::PLplot->new (DEV => "png", FILE => "test1.png");
+$pl->xyplot($x, $y, PLOTTYPE => 'LINE', COLOR => 'GREEN',
+ TITLE => 'Sample plot', XLAB => 'frobnitz', YLAB => 'widgets/sec');
+$pl->close;
+
+# Shade plot of a 2D PDL in $z
+my $pl = PDL::Graphics::PLplot->new (DEV => 'png', FILE => "test2.png");
+$pl->shadeplot ($z, $nsteps, BOX => [-1, 1, -1, 1], PALETTE => 'RAINBOW');
+$pl->colorkey ($z, 'v', VIEWPORT => [0.93, 0.96, 0.15, 0.85]);
+$pl->close;
+
+For more examples, see the test.pl file.
+
+PREREQUISITES:
+
+perl 5.6 or higher
+PDL 2.3 or more recent
+PLplot 5.1.0 (5.2.0 support is in the works...)
+
+------------------------------------------------------------------------
+Important: plplot *must* be compiled --with-double so that all floating
+ point numbers used are doubles. Install plplot similar to this:
+
+# ./configure --with-double
+# make
+# make install
+
+On some systems (IRIX, for one) it may be necessary to compile plplot
+without fortran support: --disable-f77.
+------------------------------------------------------------------------
+
+INSTALLATION:
+
+Installation should be the normal:
+
+perl Makefile.PL
+make
+make test
+
+(as root)
+make install
+
+Best of luck!
+
+Doug Hunt
+dhunt at ucar.edu
+Software Engineer III
+UCAR - GPS/MET
+
+
diff --git a/Graphics/PLplot/plplot.pd b/Graphics/PLplot/plplot.pd
new file mode 100644
index 0000000..6fb7ef3
--- /dev/null
+++ b/Graphics/PLplot/plplot.pd
@@ -0,0 +1,5263 @@
+use Config;
+
+my $ptrsize = $Config{'ptrsize'};
+my $int_ptr_type = ($ptrsize == 4) ? $Config{i32type} : $Config{i64type}; # pointer type in C code
+my $pp_ptr_type = ($ptrsize == 4) ? 'int' : 'longlong'; # pointer type in pp_def Pars sections
+
+# User can set this global variable to 1 if he wants
+# to use the normal plplot order of arguments, not the PP-required
+# order for functions with OtherPars.
+$PDL::Graphics::PLplot::standard_order = 0;
+
+# Read in options determined by Makefile.PL and written to the OPTIONS! file
+my $plversion = do 'OPTIONS!';
+pp_addpm({At => Top}, <<'EOD');
+
+our $VERSION;
+BEGIN {
+$VERSION = '0.61'
+};
+
+=head1 NAME
+
+PDL::Graphics::PLplot - Object-oriented interface from perl/PDL to the PLPLOT plotting library
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::Graphics::PLplot;
+
+ my $pl = PDL::Graphics::PLplot->new (DEV => "png", FILE => "test.png");
+ my $x = sequence(10);
+ my $y = $x**2;
+ $pl->xyplot($x, $y);
+ $pl->close;
+
+For more information on PLplot, see
+
+ http://www.plplot.org/
+
+Also see the test file, F<t/plplot.pl> in this distribution for some working examples.
+
+=head1 LONG NAMES
+
+If you are annoyed by the long constructor call, consider installing the
+L<aliased|aliased> CPAN package. Using C<aliased>, the above example
+becomes
+
+ use PDL;
+ use aliased 'PDL::Graphics::PLplot';
+
+ my $pl = PLplot->new (DEV => "png", FILE => "test.png");
+ my $x = sequence(10);
+ # etc, as above
+
+=head1 DESCRIPTION
+
+This is the PDL interface to the PLplot graphics library. It provides
+a familiar 'perlish' Object Oriented interface as well as access to
+the low-level PLplot commands from the C-API.
+
+=head1 OPTIONS
+
+The following options are supported. Most options can be used
+with any function. A few are only supported on the call to 'new'.
+
+=head2 Options used upon creation of a PLplot object (with 'new'):
+
+=head3 BACKGROUND
+
+Set the color for index 0, the plot background
+
+=head3 DEV
+
+Set the output device type. To see a list of allowed types, try:
+
+ PDL::Graphics::PLplot->new();
+
+=for example
+
+ PDL::Graphics::PLplot->new(DEV => 'png', FILE => 'test.png');
+
+=head3 FILE
+
+Set the output file or display. For file output devices, sets
+the output file name. For graphical displays (like C<'xwin'>) sets
+the name of the display, eg (C<'hostname.foobar.com:0'>)
+
+=for example
+
+ PDL::Graphics::PLplot->new(DEV => 'png', FILE => 'test.png');
+ PDL::Graphics::PLplot->new(DEV => 'xwin', FILE => ':0');
+
+=head3 OPTS
+
+Set plotting options. See the PLplot documentation for the complete
+listing of available options. The value of C<'OPTS'> must be a hash
+reference, whose keys are the names of the options. For instance, to obtain
+PostScript fonts with the ps output device, use:
+
+=for example
+
+ PDL::Graphics::PLplot->new(DEV => 'ps', OPTS => {drvopt => 'text=1'});
+
+=head3 MEM
+
+This option is used in conjunction with C<< DEV => 'mem' >>. This option
+takes as input a PDL image and allows one to 'decorate' it using PLplot.
+The 'decorated' PDL image can then be written to an image file using,
+for example, L<PDL::IO::Pic|PDL::IO::Pic>. This option may not be available if
+plplot does not include the 'mem' driver.
+
+=for example
+
+ # read in Earth image and draw an equator.
+ my $pl = PDL::Graphics::PLplot->new (MEM => $earth, DEV => 'mem');
+ my $x = pdl(-180, 180);
+ my $y = zeroes(2);
+ $pl->xyplot($x, $y,
+ BOX => [-180,180,-90,90],
+ VIEWPORT => [0.0, 1.0, 0.0, 1.0],
+ XBOX => '', YBOX => '',
+ PLOTTYPE => 'LINE');
+ $pl->close;
+
+=head3 FRAMECOLOR
+
+Set color index 1, the frame color
+
+=head3 JUST
+
+A flag used to specify equal scale on the axes. If this is
+not specified, the default is to scale the axes to fit best on
+the page.
+
+=for example
+
+ PDL::Graphics::PLplot->new(DEV => 'png', FILE => 'test.png', JUST => 1);
+
+=head3 ORIENTATION
+
+The orientation of the plot:
+
+ 0 -- 0 degrees (landscape mode)
+ 1 -- 90 degrees (portrait mode)
+ 2 -- 180 degrees (seascape mode)
+ 3 -- 270 degrees (upside-down mode)
+
+Intermediate values (0.2) are acceptable if you are feeling daring.
+
+=for example
+
+ # portrait orientation
+ PDL::Graphics::PLplot->new(DEV => 'png', FILE => 'test.png', ORIENTATION => 1);
+
+=head3 PAGESIZE
+
+Set the size in pixels of the output page.
+
+=for example
+
+ # PNG 500 by 600 pixels
+ PDL::Graphics::PLplot->new(DEV => 'png', FILE => 'test.png', PAGESIZE => [500,600]);
+
+=head3 SUBPAGES
+
+Set the number of sub pages in the plot, [$nx, $ny]
+
+=for example
+
+ # PNG 300 by 600 pixels
+ # Two subpages stacked on top of one another.
+ PDL::Graphics::PLplot->new(DEV => 'png', FILE => 'test.png', PAGESIZE => [300,600],
+ SUBPAGES => [1,2]);
+
+=head2 Options used after initialization (after 'new')
+
+=head3 BOX
+
+Set the plotting box in world coordinates. Used to explicitly
+set the size of the plotting area.
+
+=for example
+
+ my $pl = PDL::Graphics::PLplot->new(DEV => 'png', FILE => 'test.png');
+ $pl->xyplot ($x, $y, BOX => [0,100,0,200]);
+
+=head3 CHARSIZE
+
+Set the size of text in multiples of the default size.
+C<< CHARSIZE => 1.5 >> gives characters 1.5 times the normal size.
+
+=head3 COLOR
+
+Set the current color for plotting and character drawing.
+Colors are specified not as color indices but as RGB triples.
+Some pre-defined triples are included:
+
+ BLACK GREEN WHEAT BLUE
+ RED AQUAMARINE GREY BLUEVIOLET
+ YELLOW PINK BROWN CYAN
+ TURQUOISE MAGENTA SALMON WHITE
+ ROYALBLUE DEEPSKYBLUE VIOLET STEELBLUE1
+ DEEPPINK MAGENTA DARKORCHID1 PALEVIOLETRED2
+ TURQUOISE1 LIGHTSEAGREEN SKYBLUE FORESTGREEN
+ CHARTREUSE3 GOLD2 SIENNA1 CORAL
+ HOTPINK LIGHTCORAL LIGHTPINK1 LIGHTGOLDENROD
+
+=for example
+
+ # These two are equivalent:
+ $pl->xyplot ($x, $y, COLOR => 'YELLOW');
+ $pl->xyplot ($x, $y, COLOR => [0,255,0]);
+
+=head3 LINEWIDTH
+
+Set the line width for plotting. Values range from 1 to a device dependent maximum.
+
+=head3 LINESTYLE
+
+Set the line style for plotting. Pre-defined line styles use values 1 to 8, one being
+a solid line, 2-8 being various dashed patterns.
+
+=head3 MAJTICKSIZE
+
+Set the length of major ticks as a fraction of the default setting.
+One (default) means leave these ticks the normal size.
+
+=head3 MINTICKSIZE
+
+Set the length of minor ticks (and error bar terminals) as a fraction of the default setting.
+One (default) means leave these ticks the normal size.
+
+=head3 NXSUB
+
+The number of minor tick marks between each major tick mark on the X axis.
+Specify zero (default) to let PLplot compute this automatically.
+
+=head3 NYSUB
+
+The number of minor tick marks between each major tick mark on the Y axis.
+Specify zero (default) to let PLplot compute this automatically.
+
+=head3 PALETTE
+
+Load pre-defined color map 1 color ranges. Currently, values include:
+
+ RAINBOW -- from Red to Violet through the spectrum
+ REVERSERAINBOW -- Violet through Red
+ GREYSCALE -- from black to white via grey.
+ REVERSEGREYSCALE -- from white to black via grey.
+ GREENRED -- from green to red
+ REDGREEN -- from red to green
+
+=for example
+
+ # Plot x/y points with the z axis in color
+ $pl->xyplot ($x, $y, PALETTE => 'RAINBOW', PLOTTYPE => 'POINTS', COLORMAP => $z);
+
+=head3 PLOTTYPE
+
+Specify which type of XY plot is desired:
+
+ LINE -- A line
+ POINTS -- A bunch of symbols
+ LINEPOINTS -- both
+
+=head3 SUBPAGE
+
+Set which subpage to plot on. Subpages are numbered 1 to N.
+A zero can be specified meaning 'advance to the next subpage' (just a call to
+L<pladv()|/pladv>).
+
+=for example
+
+ my $pl = PDL::Graphics::PLplot->new(DEV => 'png',
+ FILE => 'test.png',
+ SUBPAGES => [1,2]);
+ $pl->xyplot ($x, $y, SUBPAGE => 1);
+ $pl->xyplot ($a, $b, SUBPAGE => 2);
+
+
+=head3 SYMBOL
+
+Specify which symbol to use when plotting C<< PLOTTYPE => 'POINTS' >>.
+A large variety of symbols are available, see:
+http://plplot.sourceforge.net/examples-data/demo07/x07.*.png, where * is 01 - 17.
+You are most likely to find good plotting symbols in the 800s:
+http://plplot.sourceforge.net/examples-data/demo07/x07.06.png
+
+=head3 SYMBOLSIZE
+
+Specify the size of symbols plotted in multiples of the default size (1).
+Value are real numbers from 0 to large.
+
+=head3 TEXTPOSITION
+
+Specify the placement of text. Either relative to border, specified as:
+
+ [$side, $disp, $pos, $just]
+
+Where
+
+ side = 't', 'b', 'l', or 'r' for top, bottom, left and right
+ disp is the number of character heights out from the edge
+ pos is the position along the edge of the viewport, from 0 to 1.
+ just tells where the reference point of the string is: 0 = left, 1 = right, 0.5 = center.
+
+or inside the plot window, specified as:
+
+ [$x, $y, $dx, $dy, $just]
+
+Where
+
+ x = x coordinate of reference point of string.
+ y = y coordinate of reference point of string.
+ dx Together with dy, this specifies the inclination of the string.
+ The baseline of the string is parallel to a line joining (x, y) to (x+dx, y+dy).
+ dy Together with dx, this specifies the inclination of the string.
+ just Specifies the position of the string relative to its reference point.
+ If just=0, the reference point is at the left and if just=1,
+ it is at the right of the string. Other values of just give
+ intermediate justifications.
+
+=for example
+
+ # Plot text on top of plot
+ $pl->text ("Top label", TEXTPOSITION => ['t', 4.0, 0.5, 0.5]);
+
+ # Plot text in plotting area
+ $pl->text ("Line label", TEXTPOSITION => [50, 60, 5, 5, 0.5]);
+
+=head3 TITLE
+
+Add a title on top of a plot.
+
+=for example
+
+ # Plot text on top of plot
+ $pl->xyplot ($x, $y, TITLE => 'X vs. Y');
+
+=head3 UNFILLED_BARS
+
+For 'bargraph', if set to true then plot the bars as outlines
+in the current color and not as filled boxes
+
+=for example
+
+ # Plot text on top of plot
+ $pl->bargraph($labels, $values, UNFILLED_BARS => 1);
+
+=head3 VIEWPORT
+
+Set the location of the plotting window on the page.
+Takes a four element array ref specifying:
+
+ xmin -- The coordinate of the left-hand edge of the viewport. (0 to 1)
+ xmax -- The coordinate of the right-hand edge of the viewport. (0 to 1)
+ ymin -- The coordinate of the bottom edge of the viewport. (0 to 1)
+ ymax -- The coordinate of the top edge of the viewport. (0 to 1)
+
+You will need to use this to make color keys or insets.
+
+=for example
+
+ # Make a small plotting window in the lower left of the page
+ $pl->xyplot ($x, $y, VIEWPORT => [0.1, 0.5, 0.1, 0.5]);
+
+ # Also useful in creating color keys:
+ $pl->xyplot ($x, $y, PALETTE => 'RAINBOW', PLOTTYPE => 'POINTS', COLORMAP => $z);
+ $pl->colorkey ($z, 'v', VIEWPORT => [0.93, 0.96, 0.15, 0.85]);
+
+ # Plot an inset; first the primary data and then the inset. In this
+ # case, the inset contains a selection of the orignal data
+ $pl->xyplot ($x, $y);
+ $pl->xyplot (where($x, $y, $x < 1.2), VIEWPORT => [0.7, 0.9, 0.6, 0.8]);
+
+=head3 XBOX
+
+Specify how to label the X axis of the plot as a string of option letters:
+
+ a: Draws axis, X-axis is horizontal line (y=0), and Y-axis is vertical line (x=0).
+ b: Draws bottom (X) or left (Y) edge of frame.
+ c: Draws top (X) or right (Y) edge of frame.
+ f: Always use fixed point numeric labels.
+ g: Draws a grid at the major tick interval.
+ h: Draws a grid at the minor tick interval.
+ i: Inverts tick marks, so they are drawn outwards, rather than inwards.
+ l: Labels axis logarithmically. This only affects the labels, not the data,
+ and so it is necessary to compute the logarithms of data points before
+ passing them to any of the drawing routines.
+ m: Writes numeric labels at major tick intervals in the
+ unconventional location (above box for X, right of box for Y).
+ n: Writes numeric labels at major tick intervals in the conventional location
+ (below box for X, left of box for Y).
+ s: Enables subticks between major ticks, only valid if t is also specified.
+ t: Draws major ticks.
+
+The default is C<'BCNST'> which draws lines around the plot, draws major and minor
+ticks and labels major ticks.
+
+=for example
+
+ # plot two lines in a box with independent X axes labeled
+ # differently on top and bottom
+ $pl->xyplot($x1, $y, XBOX => 'bnst', # bottom line, bottom numbers, ticks, subticks
+ YBOX => 'bnst'); # left line, left numbers, ticks, subticks
+ $pl->xyplot($x2, $y, XBOX => 'cmst', # top line, top numbers, ticks, subticks
+ YBOX => 'cst', # right line, ticks, subticks
+ BOX => [$x2->minmax, $y->minmax]);
+
+=head3 XERRORBAR
+
+Used only with L</xyplot>. Draws horizontal error bars at all points (C<$x>, C<$y>) in the plot.
+Specify a PDL containing the same number of points as C<$x> and C<$y>
+which specifies the width of the error bar, which will be centered at (C<$x>, C<$y>).
+
+=head3 XLAB
+
+Specify a label for the X axis.
+
+=head3 XTICK
+
+Interval (in graph units/world coordinates) between major x axis tick marks.
+Specify zero (default) to allow PLplot to compute this automatically.
+
+=head3 YBOX
+
+Specify how to label the Y axis of the plot as a string of option letters.
+See L</XBOX>.
+
+=head3 YERRORBAR
+
+Used only for xyplot. Draws vertical error bars at all points (C<$x>, C<$y>) in the plot.
+Specify a PDL containing the same number of points as C<$x> and C<$y>
+which specifies the width of the error bar, which will be centered at (C<$x>, C<$y>).
+
+=head3 YLAB
+
+Specify a label for the Y axis.
+
+=head3 YTICK
+
+Interval (in graph units/world coordinates) between major y axis tick marks.
+Specify zero (default) to allow PLplot to compute this automatically.
+
+=head3 ZRANGE
+
+For L</xyplot> (when C<COLORMAP> is specified), for
+L</shadeplot> and for L</colorkey>.
+Normally, the range of the Z variable (color) is taken as
+C<< $z->minmax >>. If a different range is desired,
+specify it in C<ZRANGE>, like so:
+
+ $pl->shadeplot ($z, $nlevels, PALETTE => 'GREENRED', ZRANGE => [0,100]);
+
+or
+
+ $pl->xyplot ($x, $y, PALETTE => 'RAINBOW', PLOTTYPE => 'POINTS',
+ COLORMAP => $z, ZRANGE => [-90,-20]);
+ $pl->colorkey ($z, 'v', VIEWPORT => [0.93, 0.96, 0.13, 0.85],
+ ZRANGE => [-90,-20]);
+
+=head1 METHODS
+
+These are the high-level, object oriented methods for PLplot.
+
+=head2 new
+
+=for ref
+
+Create an object representing a plot.
+
+=for usage
+
+ Arguments:
+ none.
+
+ Supported options:
+ BACKGROUND
+ DEV
+ FILE
+ FRAMECOLOR
+ JUST
+ PAGESIZE
+ SUBPAGES
+
+=for example
+
+ my $pl = PDL::Graphics::PLplot->new(DEV => 'png', FILE => 'test.png');
+
+
+=head2 setparm
+
+=for ref
+
+Set options for a plot object.
+
+=for usage
+
+ Arguments:
+ none.
+
+ Supported options:
+ All options except:
+
+ BACKGROUND
+ DEV
+ FILE
+ FRAMECOLOR
+ JUST
+ PAGESIZE
+ SUBPAGES
+
+(These must be set in call to 'new'.)
+
+=for example
+
+ $pl->setparm (TEXTSIZE => 2);
+
+=head2 xyplot
+
+=for ref
+
+Plot XY lines and/or points. Also supports color scales for points.
+This function works with bad values. If a bad value is specified for
+a points plot, it is omitted. If a bad value is specified for a line
+plot, the bad value makes a gap in the line. This is useful for
+drawing maps; for example C<$x> and C<$y> can be the continent boundary
+latitude and longitude.
+
+=for usage
+
+ Arguments:
+ $x, $y
+
+ Supported options:
+ All options except:
+
+ BACKGROUND
+ DEV
+ FILE
+ FRAMECOLOR
+ JUST
+ PAGESIZE
+ SUBPAGES
+
+(These must be set in call to 'new'.)
+
+=for example
+
+ $pl->xyplot($x, $y, PLOTTYPE => 'POINTS', COLOR => 'BLUEVIOLET', SYMBOL => 1, SYMBOLSIZE => 4);
+ $pl->xyplot($x, $y, PLOTTYPE => 'LINEPOINTS', COLOR => [50,230,30]);
+ $pl->xyplot($x, $y, PALETTE => 'RAINBOW', PLOTTYPE => 'POINTS', COLORMAP => $z);
+
+=head2 stripplots
+
+=for ref
+
+Plot a set of strip plots with a common X axis, but with different Y axes.
+Looks like a stack of long, thin XY plots, all line up on the same X axis.
+
+=for usage
+
+ Arguments:
+ $xs -- 1D PDL with common X axis values, length = N
+ $ys -- reference to a list of 1D PDLs with Y-axis values, length = N
+ or 2D PDL with N x M elements
+ -- OR --
+ $xs -- reference to a list of 1D PDLs with X-axis values
+ $ys -- reference to a list of 1D PDLs with Y-axis values
+ %opts -- Options hash
+
+ Supported options:
+ All options except:
+
+ BACKGROUND
+ DEV
+ FILE
+ FRAMECOLOR
+ JUST
+ PAGESIZE
+ SUBPAGES
+
+(These must be set in call to 'new'.)
+
+=for example
+
+ my $x = sequence(20);
+ my $y1 = $x**2;
+ my $y2 = sqrt($x);
+ my $y3 = $x**3;
+ my $y4 = sin(($x/20) * 2 * $pi);
+ $ys = cat($y1, $y2, $y3, $y4);
+ $pl->stripplots($x, $ys, PLOTTYPE => 'LINE', TITLE => 'functions',
+ YLAB => ['x**2', 'sqrt(x)', 'x**3', 'sin(x/20*2pi)'],
+ COLOR => ['GREEN', 'DEEPSKYBLUE', 'DARKORCHID1', 'DEEPPINK'], XLAB => 'X label');
+ # Equivalent to above:
+ $pl->stripplots($x, [$y1, $y2, $y3, $y4],
+ PLOTTYPE => 'LINE', TITLE => 'functions',
+ YLAB => ['x**2', 'sqrt(x)', 'x**3', 'sin(x/20*2pi)'],
+ COLOR => ['GREEN', 'DEEPSKYBLUE', 'DARKORCHID1', 'DEEPPINK'], XLAB => 'X label');
+
+ # Here's something a bit different. Notice that different xs have
+ # different lengths.
+ $x1 = sequence(20);
+ $y1 = $x1**2;
+
+ $x2 = sequence(18);
+ $y2 = sqrt($x2);
+
+ $x3 = sequence(24);
+ $y3 = $x3**3;
+
+ my $x4 = sequence(27);
+ $a = ($x4/20) * 2 * $pi;
+ my $y4 = sin($a);
+
+ $xs = [$x1, $x2, $x3, $x4];
+ $ys = [$y1, $y2, $y3, $y4];
+ $pl->stripplots($xs, $ys, PLOTTYPE => 'LINE', TITLE => 'functions',
+ YLAB => ['x**2', 'sqrt(x)', 'x**3', 'sin(x/20*2pi)'],
+ COLOR => ['GREEN', 'DEEPSKYBLUE', 'DARKORCHID1', 'DEEPPINK'], XLAB => 'X label');
+
+In addition, COLOR may be specified as a reference to a list of colors. If
+this is done, the colors are applied separately to each plot.
+
+Also, the options Y_BASE and Y_GUTTER can be specified. Y_BASE gives the Y offset
+of the bottom of the lowest plot (0-1, specified like a VIEWPORT, defaults to 0.1) and Y_GUTTER
+gives the gap between the graphs (0-1, default = 0.02).
+
+=head2 colorkey
+
+=for ref
+
+Plot a color key showing which color represents which value
+
+=for usage
+
+ Arguments:
+ $range : A PDL which tells the range of the color values
+ $orientation : 'v' for vertical color key, 'h' for horizontal
+
+ Supported options:
+ All options except:
+
+ BACKGROUND
+ DEV
+ FILE
+ FRAMECOLOR
+ JUST
+ PAGESIZE
+ SUBPAGES
+
+(These must be set in call to 'new'.)
+
+=for example
+
+ # Plot X vs. Y with Z shown by the color. Then plot
+ # vertical key to the right of the original plot.
+ $pl->xyplot ($x, $y, PALETTE => 'RAINBOW', PLOTTYPE => 'POINTS', COLORMAP => $z);
+ $pl->colorkey ($z, 'v', VIEWPORT => [0.93, 0.96, 0.15, 0.85]);
+
+
+=head2 shadeplot
+
+=for ref
+
+Create a shaded contour plot of 2D PDL 'z' with 'nsteps' contour levels.
+Linear scaling is used to map the coordinates of Z(X, Y) to world coordinates
+via the L</BOX> option.
+
+=for usage
+
+ Arguments:
+ $z : A 2D PDL which contains surface values at each XY coordinate.
+ $nsteps : The number of contour levels requested for the plot.
+
+ Supported options:
+ All options except:
+
+ BACKGROUND
+ DEV
+ FILE
+ FRAMECOLOR
+ JUST
+ PAGESIZE
+ SUBPAGES
+
+(These must be set in call to 'new'.)
+
+=for example
+
+ # vertical key to the right of the original plot.
+ # The BOX must be specified to give real coordinate values to the $z array.
+ $pl->shadeplot ($z, $nsteps, BOX => [-1, 1, -1, 1], PALETTE => 'RAINBOW', ZRANGE => [0,100]);
+ $pl->colorkey ($z, 'v', VIEWPORT => [0.93, 0.96, 0.15, 0.85], ZRANGE => [0,100]);
+
+=head2 histogram
+
+=for ref
+
+Create a histogram of a 1-D variable.
+
+=for usage
+
+ Arguments:
+ $x : A 1D PDL
+ $nbins : The number of bins to use in the histogram.
+
+ Supported options:
+ All options except:
+
+ BACKGROUND
+ DEV
+ FILE
+ FRAMECOLOR
+ JUST
+ PAGESIZE
+ SUBPAGES
+
+(These must be set in call to 'new'.)
+
+=for example
+
+ $pl->histogram ($x, $nbins, BOX => [$min, $max, 0, 100]);
+
+=head2 bargraph
+
+=for ref
+
+Simple utility to plot a bar chart with labels on the X axis.
+The usual options can be specified, plus one other: MAXBARLABELS
+specifies the maximum number of labels to allow on the X axis.
+The default is 20. If this value is exceeded, then every other
+label is plotted. If twice MAXBARLABELS is exceeded, then only
+every third label is printed, and so on.
+
+if UNFILLED_BARS is set to true, then plot the bars as outlines
+and not as filled rectangles.
+
+=for usage
+
+ Arguments:
+ $labels -- A reference to a perl list of strings.
+ $values -- A PDL of values to be plotted.
+
+ Supported options:
+ All options except:
+
+ BACKGROUND
+ DEV
+ FILE
+ FRAMECOLOR
+ JUST
+ PAGESIZE
+ SUBPAGES
+
+(These must be set in call to 'new'.)
+
+=for example
+
+ $labels = ['one', 'two', 'three'];
+ $values = pdl(1, 2, 3);
+
+ # Note if TEXTPOSITION is specified, it must be in 4 argument mode (border mode):
+ # [$side, $disp, $pos, $just]
+ #
+ # Where side = 't', 'b', 'l', or 'r' for top, bottom, left and right
+ # 'tv', 'bv', 'lv' or 'rv' for top, bottom, left or right perpendicular to the axis.
+ #
+ # disp is the number of character heights out from the edge
+ # pos is the position along the edge of the viewport, from 0 to 1.
+ # just tells where the reference point of the string is: 0 = left, 1 = right, 0.5 = center.
+ #
+ # The '$pos' entry will be ignored (computed by the bargraph routine)
+ $pl->bargraph($labels, $values, MAXBARLABELS => 30, TEXTPOSITION => ['bv', 0.5, 1.0, 1.0]);
+
+=head2 text
+
+=for ref
+
+Write text on a plot. Text can either be written
+with respect to the borders or at an arbitrary location and angle
+(see the L</TEXTPOSITION> entry).
+
+=for usage
+
+ Arguments:
+ $t : The text.
+
+ Supported options:
+ All options except:
+
+ BACKGROUND
+ DEV
+ FILE
+ FRAMECOLOR
+ JUST
+ PAGESIZE
+ SUBPAGES
+
+(These must be set in call to 'new'.)
+
+=for example
+
+ $pl->text("Count", COLOR => 'PINK',
+ TEXTPOSITION => ['t', 3, 0.5, 0.5]); # top, 3 units out, string ref. pt in
+ # center of string, middle of axis
+
+=head2 close
+
+=for ref
+
+Close a PLplot object, writing out the file and cleaning up.
+
+=for usage
+
+Arguments:
+None
+
+Returns:
+Nothing
+
+This closing of the PLplot object can be done explicitly though the
+'close' method. Alternatively, a DESTROY block does an automatic
+close whenever the PLplot object passes out of scope.
+
+=for example
+
+ $pl->close;
+
+=cut
+
+# pull in low level interface
+use vars qw(%_constants %_actions);
+
+# Colors (from rgb.txt) are stored as RGB triples
+# with each value from 0-255
+sub cc2t { [map {hex} split ' ', shift] }
+%_constants = (
+ BLACK => [ 0, 0, 0],
+ RED => [240, 50, 50],
+ YELLOW => [255,255, 0],
+ GREEN => [ 0,255, 0],
+ AQUAMARINE => [127,255,212],
+ PINK => [255,192,203],
+ WHEAT => [245,222,179],
+ GREY => [190,190,190],
+ BROWN => [165, 42, 42],
+ BLUE => [ 0, 0,255],
+ BLUEVIOLET => [138, 43,226],
+ CYAN => [ 0,255,255],
+ TURQUOISE => [ 64,224,208],
+ MAGENTA => [255, 0,255],
+ SALMON => [250,128,114],
+ WHITE => [255,255,255],
+ ROYALBLUE => cc2t('2B 60 DE'),
+ DEEPSKYBLUE => cc2t('3B B9 FF'),
+ VIOLET => cc2t('8D 38 C9'),
+ STEELBLUE1 => cc2t('5C B3 FF'),
+ DEEPPINK => cc2t('F5 28 87'),
+ MAGENTA => cc2t('FF 00 FF'),
+ DARKORCHID1 => cc2t('B0 41 FF'),
+ PALEVIOLETRED2 => cc2t('E5 6E 94'),
+ TURQUOISE1 => cc2t('52 F3 FF'),
+ LIGHTSEAGREEN => cc2t('3E A9 9F'),
+ SKYBLUE => cc2t('66 98 FF'),
+ FORESTGREEN => cc2t('4E 92 58'),
+ CHARTREUSE3 => cc2t('6C C4 17'),
+ GOLD2 => cc2t('EA C1 17'),
+ SIENNA1 => cc2t('F8 74 31'),
+ CORAL => cc2t('F7 65 41'),
+ HOTPINK => cc2t('F6 60 AB'),
+ LIGHTCORAL => cc2t('E7 74 71'),
+ LIGHTPINK1 => cc2t('F9 A7 B0'),
+ LIGHTGOLDENROD => cc2t('EC D8 72'),
+ );
+
+# a hash of subroutines to invoke when certain keywords are specified
+# These are called with arg(0) = $self (the plot object)
+# and arg(1) = value specified for keyword
+%_actions =
+ (
+
+
+ # Set color for index 0, the plot background
+ BACKGROUND => sub {
+ my $self = shift;
+ my $color = _color(shift);
+ $self->{COLORS}[0] = $color;
+ plscolbg (@$color);
+ },
+
+ # set plotting box in world coordinates
+ BOX => sub {
+ my $self = shift;
+ my $box = shift;
+ die "Box must be a ref to a four element array" unless (ref($box) =~ /ARRAY/ and @$box == 4);
+ $self->{BOX} = $box;
+ },
+
+ CHARSIZE => sub { my $self = shift;
+ $self->{CHARSIZE} = $_[0];
+ plschr (0, $_[0]) }, # 0 - N
+
+ COLOR =>
+ # maintain color map, set to specified rgb triple
+ sub {
+ my $self = shift;
+ my $color = _color(shift);
+
+ # init.
+ $self->{COLORS} = [] unless exists($self->{COLORS});
+
+ my @idx = @{$self->{COLORS}}; # map of color index (0-15) to RGB triples
+ my $found = 0;
+ for (my $i=2;$i<@idx;$i++) { # map entries 0 and 1 are reserved for BACKGROUND and FRAMECOLOR
+ if (_coloreq ($color, $idx[$i])) {
+ $self->{CURRENT_COLOR_IDX} = $i;
+ $found = 1;
+ plscol0 ($self->{CURRENT_COLOR_IDX}, @$color);
+ }
+ }
+ return if ($found);
+
+ die "Too many colors used! (max 15)" if (@{$self->{COLORS}} > 14);
+
+ # add this color as index 2 or greater (entries 0 and 1 reserved)
+ my $idx = (@{$self->{COLORS}} > 1) ? @{$self->{COLORS}} : 2;
+ $self->{COLORS}[$idx] = $color;
+ $self->{CURRENT_COLOR_IDX} = $idx;
+ plscol0 ($self->{CURRENT_COLOR_IDX}, @$color);
+ },
+
+ # set output device type
+ DEV => sub { my $self = shift;
+ my $dev = shift;
+ $self->{DEV} = $dev;
+ plsdev ($dev)
+ }, # this must be specified with call to new!
+
+ # set PDL to plot into (alternative to specifying DEV)
+ MEM => sub { my $self = shift;
+ my $pdl = shift;
+ my $x = $pdl->getdim(1);
+ my $y = $pdl->getdim(2);
+ plsmem ($x, $y, $pdl);
+ },
+
+ # set output file
+ FILE => sub { plsfnam ($_[1]) }, # this must be specified with call to new!
+
+ # set color for index 1, the plot frame and text
+ FRAMECOLOR =>
+ # set color index 1, the frame color
+ sub {
+ my $self = shift;
+ my $color = _color(shift);
+ $self->{COLORS}[1] = $color;
+ plscol0 (1, @$color);
+ },
+
+ # Set flag for equal scale axes
+ JUST => sub {
+ my $self = shift;
+ my $just = shift;
+ die "JUST must be 0 or 1 (defaults to 0)" unless ($just == 0 or $just == 1);
+ $self->{JUST} = $just;
+ },
+
+ LINEWIDTH => sub {
+ my $self = shift;
+ my $wid = shift;
+ die "LINEWIDTH must range from 0 to LARGE8" unless ($wid >= 0);
+ $self->{LINEWIDTH} = $wid;
+ },
+
+ LINESTYLE => sub {
+ my $self = shift;
+ my $sty = shift;
+ die "LINESTYLE must range from 1 to 8" unless ($sty >= 1 and $sty <= 8);
+ $self->{LINESTYLE} = $sty;
+ },
+
+ MAJTICKSIZE => sub {
+ my $self = shift;
+ my $val = shift;
+ die "MAJTICKSIZE must be greater than or equal to zero"
+ unless ($val >= 0);
+ plsmaj (0, $val);
+ },
+
+ MINTICKSIZE => sub {
+ my $self = shift;
+ my $val = shift;
+ die "MINTICKSIZE must be greater than or equal to zero"
+ unless ($val >= 0);
+ plsmin (0, $val);
+ },
+
+ NXSUB => sub {
+ my $self = shift;
+ my $val = shift;
+ die "NXSUB must be an integer greater than or equal to zero"
+ unless ($val >= 0 and int($val) == $val);
+ $self->{NXSUB} = $val;
+ },
+
+ NYSUB => sub {
+ my $self = shift;
+ my $val = shift;
+ die "NYSUB must be an integer greater than or equal to zero"
+ unless ($val >= 0 and int($val) == $val);
+ $self->{NYSUB} = $val;
+ },
+
+ # set driver options, example for ps driver, {text => 1} is accepted
+ OPTS => sub {
+ my $self = shift;
+ my $opts = shift;
+
+ foreach my $opt (keys %$opts) {
+ plsetopt ($opt, $$opts{$opt});
+ }
+ },
+
+ # set driver options, example for ps driver, {text => 1} is accepted
+ ORIENTATION => sub {
+ my $self = shift;
+ my $orient = shift;
+
+ die "Orientation must be between 0 and 4" unless ($orient >= 0 and $orient <= 4);
+ $self->{ORIENTATION} = $orient;
+ },
+
+ PAGESIZE =>
+ # set plot size in mm. Only useful in call to 'new'
+ sub {
+ my $self = shift;
+ my $dims = shift;
+
+ die "plot size must be a 2 element array ref: X size in pixels, Y size in pixels"
+ if ((ref($dims) !~ /ARRAY/) || @$dims != 2);
+ $self->{PAGESIZE} = $dims;
+ },
+
+ PALETTE =>
+
+ # load some pre-done color map 1 setups
+ sub {
+ my $self = shift;
+ my $pal = shift;
+
+ my %legal = (REVERSERAINBOW => 1, REVERSEGREYSCALE => 1, REDGREEN => 1, RAINBOW => 1, GREYSCALE => 1, GREENRED => 1);
+ if ($legal{$pal}) {
+ $self->{PALETTE} = $pal;
+ if ($pal eq 'RAINBOW') {
+ plscmap1l (0, PDL->new(0,1), PDL->new(0,300), PDL->new(0.5, 0.5), PDL->new(1,1), PDL->new(0,0));
+ } elsif ($pal eq 'REVERSERAINBOW') {
+ plscmap1l (0, PDL->new(0,1), PDL->new(270,-30), PDL->new(0.5, 0.5), PDL->new(1,1), PDL->new(0,0));
+ } elsif ($pal eq 'GREYSCALE') {
+ plscmap1l (0, PDL->new(0,1), PDL->new(0,0), PDL->new(0,1), PDL->new(0,0), PDL->new(0,0));
+ } elsif ($pal eq 'REVERSEGREYSCALE') {
+ plscmap1l (0, PDL->new(0,1), PDL->new(0,0), PDL->new(1,0), PDL->new(0,0), PDL->new(0,0));
+ } elsif ($pal eq 'GREENRED') {
+ plscmap1l (0, PDL->new(0,1), PDL->new(120,0), PDL->new(0.5, 0.5), PDL->new(1,1), PDL->new(1,1));
+ } elsif ($pal eq 'REDGREEN') {
+ plscmap1l (0, PDL->new(0,1), PDL->new(0,120), PDL->new(0.5, 0.5), PDL->new(1,1), PDL->new(1,1));
+ }
+ } else {
+ die "Illegal palette name. Legal names are: " . join (" ", keys %legal);
+ }
+ },
+
+ PLOTTYPE =>
+ # specify plot type (LINE, POINTS, LINEPOINTS)
+ sub {
+ my $self = shift;
+ my $val = shift;
+
+ my %legal = (LINE => 1, POINTS => 1, LINEPOINTS => 1);
+ if ($legal{$val}) {
+ $self->{PLOTTYPE} = $val;
+ } else {
+ die "Illegal plot type. Legal options are: " . join (" ", keys %legal);
+ }
+ },
+
+ SUBPAGE =>
+ # specify which subpage to plot on 1-N or 0 (meaning 'next')
+ sub {
+ my $self = shift;
+ my $val = shift;
+ my $err = "SUBPAGE = \$npage where \$npage = 1-N or 0 (for 'next subpage')";
+ if ($val >= 0) {
+ $self->{SUBPAGE} = $val;
+ } else {
+ die $err;
+ }
+ },
+
+ SUBPAGES =>
+ # specify number of sub pages [nx, ny]
+ sub {
+ my $self = shift;
+ my $val = shift;
+ my $err = "SUBPAGES = [\$nx, \$ny] where \$nx and \$ny are between 1 and 127";
+ if (ref($val) =~ /ARRAY/ and @$val == 2) {
+ my ($nx, $ny) = @$val;
+ if ($nx > 0 and $nx < 128 and $ny > 0 and $ny < 128) {
+ $self->{SUBPAGES} = [$nx, $ny];
+ } else {
+ die $err;
+ }
+ } else {
+ die $err;
+ }
+ },
+
+ SYMBOL =>
+ # specify type of symbol to plot
+ sub {
+ my $self = shift;
+ my $val = shift;
+
+ if ($val >= 0 && $val < 3000) {
+ $self->{SYMBOL} = $val;
+ } else {
+ die "Illegal symbol number. Legal symbols are between 0 and 3000";
+ }
+ },
+
+ SYMBOLSIZE => sub {
+ my ($self, $size) = @_;
+ die "symbol size must be a real number from 0 to (large)" unless ($size >= 0);
+ $self->{SYMBOLSIZE} = $size;
+ },
+
+ TEXTPOSITION =>
+ # specify placement of text. Either relative to border, specified as:
+ # [$side, $disp, $pos, $just]
+ # or
+ # inside plot window, specified as:
+ # [$x, $y, $dx, $dy, $just] (see POD doc for details)
+ sub {
+ my $self = shift;
+ my $val = shift;
+
+ die "TEXTPOSITION value must be an array ref with either:
+ [$side, $disp, $pos, $just] or [$x, $y, $dx, $dy, $just]"
+ unless ((ref($val) =~ /ARRAY/) and ((@$val == 4) || (@$val == 5)));
+
+ if (@$val == 4) {
+ $self->{TEXTMODE} = 'border';
+ } else {
+ $self->{TEXTMODE} = 'plot';
+ }
+ $self->{TEXTPOSITION} = $val;
+ },
+
+ # draw a title for the graph
+ TITLE => sub {
+ my $self = shift;
+ my $text = shift;
+ $self->{TITLE} = $text;
+ },
+
+ # Specify outline bars for bargraph
+ UNFILLED_BARS => sub {
+ my $self = shift;
+ my $val = shift;
+ $self->{UNFILLED_BARS} = $val;
+ },
+
+ # set the location of the plotting window on the page
+ VIEWPORT => sub {
+ my $self = shift;
+ my $vp = shift;
+ die "Viewport must be a ref to a four element array"
+ unless (ref($vp) =~ /ARRAY/ and @$vp == 4);
+ $self->{VIEWPORT} = $vp;
+ },
+
+ XBOX =>
+ # set X axis label options. See pod for definitions.
+ sub {
+ my $self = shift;
+ my $opts = lc shift;
+
+ my @opts = split '', $opts;
+ map { 'abcdfghilmnst' =~ /$_/i || die "Illegal option $_. Only abcdfghilmnst permitted" } @opts;
+
+ $self->{XBOX} = $opts;
+ },
+
+ # draw an X axis label for the graph
+ XLAB => sub {
+ my $self = shift;
+ my $text = shift;
+ $self->{XLAB} = $text;
+ },
+
+ XTICK => sub {
+ my $self = shift;
+ my $val = shift;
+ die "XTICK must be greater than or equal to zero"
+ unless ($val >= 0);
+ $self->{XTICK} = $val;
+ },
+
+ YBOX =>
+ # set Y axis label options. See pod for definitions.
+ sub {
+ my $self = shift;
+ my $opts = shift;
+
+ my @opts = split '', $opts;
+ map { 'abcfghilmnstv' =~ /$_/i || die "Illegal option $_. Only abcfghilmnstv permitted" } @opts;
+
+ $self->{YBOX} = $opts;
+ },
+
+ # draw an Y axis label for the graph
+ YLAB => sub {
+ my $self = shift;
+ my $text = shift;
+ $self->{YLAB} = $text;
+ },
+
+ YTICK => sub {
+ my $self = shift;
+ my $val = shift;
+ die "YTICK must be greater than or equal to zero"
+ unless ($val >= 0);
+ $self->{YTICK} = $val;
+ },
+
+ ZRANGE => sub {
+ my $self = shift;
+ my $val = shift;
+ die "ZRANGE must be a perl array ref with min and max Z values"
+ unless (ref($val) =~ /ARRAY/ && @$val == 2);
+ $self->{ZRANGE} = $val;
+ },
+
+);
+
+
+#
+## Internal utility routines
+#
+
+# handle color as string in _constants hash or [r,g,b] triple
+# Input: either color name or [r,g,b] array ref
+# Output: [r,g,b] array ref or exception
+sub _color {
+ my $c = shift;
+ if (ref($c) =~ /ARRAY/) {
+ return $c;
+ } elsif ($c = $_constants{$c}) {
+ return $c;
+ } else {
+ die "Color $c not defined";
+ }
+}
+
+# return 1 if input [r,g,b] triples are equal.
+sub _coloreq {
+ my ($a, $b) = @_;
+ for (my $i=0;$i<3;$i++) { return 0 if ($$a[$i] != $$b[$i]); }
+ return 1;
+}
+
+# Initialize plotting window given the world coordinate box and
+# a 'justify' flag (for equal axis scales).
+sub _setwindow {
+
+ my $self = shift;
+
+ # choose correct subwindow
+ pladv ($self->{SUBPAGE}) if (exists ($self->{SUBPAGE}));
+ delete ($self->{SUBPAGE}); # get rid of SUBPAGE so future plots will stay on same
+ # page unless user asks for specific page
+
+ my $box = $self->{BOX} || [0,1,0,1]; # default window
+
+ sub MAX { ($_[0] > $_[1]) ? $_[0] : $_[1]; }
+
+ # get subpage offsets from page left/bottom of image
+ my ($spxmin, $spxmax, $spymin, $spymax) = (PDL->new(0),PDL->new(0),PDL->new(0),PDL->new(0));
+ plgspa($spxmin, $spxmax, $spymin, $spymax);
+ $spxmin = $spxmin->at(0);
+ $spxmax = $spxmax->at(0);
+ $spymin = $spymin->at(0);
+ $spymax = $spymax->at(0);
+ my $xsize = $spxmax - $spxmin;
+ my $ysize = $spymax - $spymin;
+
+ my @vp = @{$self->{VIEWPORT}}; # view port xmin, xmax, ymin, ymax in fraction of image size
+
+ # if JUSTify is zero, set to the user specified (or default) VIEWPORT
+ if ($self->{JUST} == 0) {
+ plvpor(@vp);
+
+ # compute viewport to allow the same scales for both axes
+ } else {
+ my $p_def = PDL->new(0);
+ my $p_ht = PDL->new(0);
+ plgchr ($p_def, $p_ht);
+ $p_def = $p_def->at(0);
+ my $lb = 8.0 * $p_def;
+ my $rb = 5.0 * $p_def;
+ my $tb = 5.0 * $p_def;
+ my $bb = 5.0 * $p_def;
+ my $dx = $$box[1] - $$box[0];
+ my $dy = $$box[3] - $$box[2];
+ my $xscale = $dx / ($xsize - $lb - $rb);
+ my $yscale = $dy / ($ysize - $tb - $bb);
+ my $scale = MAX($xscale, $yscale);
+ my $vpxmin = MAX($lb, 0.5 * ($xsize - $dx / $scale));
+ my $vpxmax = $vpxmin + ($dx / $scale);
+ my $vpymin = MAX($bb, 0.5 * ($ysize - $dy / $scale));
+ my $vpymax = $vpymin + ($dy / $scale);
+ plsvpa($vpxmin, $vpxmax, $vpymin, $vpymax);
+ $self->{VIEWPORT} = [$vpxmin/$xsize, $vpxmax/$xsize, $vpymin/$ysize, $vpymax/$ysize];
+ }
+
+ # set up world coords in window
+ plwind (@$box);
+
+}
+
+# Add title and axis labels.
+sub _drawlabels {
+
+ my $self = shift;
+
+ plcol0 (1); # set to frame color
+ plmtex (2.5, 0.5, 0.5, 't', $self->{TITLE}) if ($self->{TITLE});
+ plmtex (3.0, 0.5, 0.5, 'b', $self->{XLAB}) if ($self->{XLAB});
+ plmtex (3.5, 0.5, 0.5, 'l', $self->{YLAB}) if ($self->{YLAB});
+ plcol0 ($self->{CURRENT_COLOR_IDX}); # set back
+
+}
+
+
+#
+## user-visible routines
+#
+
+# Pool of PLplot stream numbers. One of these stream numbers is taken when 'new' is called
+# and when the corresponding 'close' is called, it is returned to the pool. The pool is
+# just a queue: 'new' shifts stream numbers from the top of the queue, 'close' pushes them
+# back on the bottom of the queue.
+my @plplot_stream_pool = (0..99);
+
+# This routine starts out a plot. Generally one specifies
+# DEV and FILE (device and output file name) as options.
+sub new {
+ my $type = shift;
+ my $self = {};
+
+ # set up object
+ $self->{PLOTTYPE} = 'LINE';
+ # $self->{CURRENT_COLOR_IDX} = 1;
+ $self->{COLORS} = [];
+
+ bless $self, $type;
+
+ # set stream number first
+ $self->{STREAMNUMBER} = shift @plplot_stream_pool;
+ die "No more PLplot streams left, too many open PLplot objects!" if (!defined($self->{STREAMNUMBER}));
+ plsstrm($self->{STREAMNUMBER});
+
+ # set background and frame color first
+ $self->setparm(BACKGROUND => 'WHITE',
+ FRAMECOLOR => 'BLACK');
+
+ # set defaults, allow input options to override
+ my %opts = (
+ COLOR => 'BLACK',
+ XBOX => 'BCNST',
+ YBOX => 'BCNST',
+ JUST => 0,
+ SUBPAGES => [1,1],
+ VIEWPORT => [0.1, 0.87, 0.13, 0.82],
+ SUBPAGE => 0,
+ PAGESIZE => [600, 500],
+ LINESTYLE => 1,
+ LINEWIDTH => 0,
+ SYMBOL => 751, # a small square
+ NXSUB => 0,
+ NYSUB => 0,
+ ORIENTATION=> 0,
+ XTICK => 0,
+ YTICK => 0,
+ CHARSIZE => 1,
+ @_);
+
+
+ # apply options
+ $self->setparm(%opts);
+
+ # Do initial setup
+ plspage (0, 0, @{$self->{PAGESIZE}}, 0, 0) if (defined($self->{PAGESIZE}));
+ plssub (@{$self->{SUBPAGES}});
+ plfontld (1); # extented symbol pages
+ plscmap0n (16); # set up color map 0 to 16 colors. Is this needed?
+ plscmap1n (128); # set map 1 to 128 colors (should work for devices with 256 colors)
+ plinit ();
+
+ # set page orientation
+ plsdiori ($self->{ORIENTATION});
+
+ # set up plotting box
+ $self->_setwindow;
+
+ return $self;
+}
+
+# set parameters. Called from user directly or from other routines.
+sub setparm {
+ my $self = shift;
+
+ my %opts = @_;
+
+ # Set PLplot to right output stream
+ plsstrm($self->{STREAMNUMBER});
+
+ # apply all options
+ OPTION:
+ foreach my $o (keys %opts) {
+ unless (exists($_actions{$o})) {
+ warn "Illegal option $o, ignoring";
+ next OPTION;
+ }
+ &{$_actions{$o}}($self, $opts{$o});
+ }
+}
+
+# handle 2D plots
+sub xyplot {
+ my $self = shift;
+ my $x = shift;
+ my $y = shift;
+
+ my %opts = @_;
+
+ # Set PLplot to right output stream
+ plsstrm($self->{STREAMNUMBER});
+
+ # only process COLORMAP entries once
+ my $z = $opts{COLORMAP};
+ delete ($opts{COLORMAP});
+
+ # handle ERRORBAR options
+ my $xeb = $opts{XERRORBAR};
+ my $yeb = $opts{YERRORBAR};
+ delete ($opts{XERRORBAR});
+ delete ($opts{YERRORBAR});
+
+ # apply options
+ $self->setparm(%opts);
+
+ unless (exists($self->{BOX})) {
+ $self->{BOX} = [$x->minmax, $y->minmax];
+ }
+
+ # set up viewport, subpage, world coordinates
+ $self->_setwindow;
+
+ # draw labels
+ $self->_drawlabels;
+
+ # plot box
+ plcol0 (1); # set to frame color
+ plbox ($self->{XTICK}, $self->{NXSUB}, $self->{YTICK}, $self->{NYSUB},
+ $self->{XBOX}, $self->{YBOX}); # !!! note out of order call
+
+ # set the color according to the color specified in the object
+ # (we don't do this as an option, because then the frame might
+ # get the color requested for the line/points
+ plcol0 ($self->{CURRENT_COLOR_IDX});
+
+ # set line style for plot only (not box)
+ pllsty ($self->{LINESTYLE});
+
+ # set line width for plot only (not box)
+ plwid ($self->{LINEWIDTH});
+
+ # Plot lines if requested
+ if ($self->{PLOTTYPE} =~ /LINE/) {
+ plline ($x, $y);
+ }
+
+ # set line width back
+ plwid (0);
+
+ # plot points if requested
+ if ($self->{PLOTTYPE} =~ /POINTS/) {
+ my $c = $self->{SYMBOL};
+ unless (defined($c)) {
+
+ # the default for $c is a PDL of ones with shape
+ # equal to $x with the first dimension removed
+ my $z = PDL->zeroes($x->nelem);
+ $c = PDL->ones($z->zcover) unless defined($c);
+ }
+ plssym (0, $self->{SYMBOLSIZE}) if (defined($self->{SYMBOLSIZE}));
+
+ if (defined($z)) { # if a color range plot requested
+ my ($min, $max) = exists ($self->{ZRANGE}) ? @{$self->{ZRANGE}} : $z->minmax;
+ plcolorpoints ($x, $y, $z, $c, $min, $max);
+ } else {
+ plsym ($x, $y, $c);
+ }
+ }
+
+ # Plot error bars, if requested
+ if (defined($xeb)) {
+ # horizontal (X) error bars
+ plerrx ($x->nelem, $x - $xeb/2, $x + $xeb/2, $y);
+ }
+
+ if (defined($yeb)) {
+ # vertical (Y) error bars
+ plerry ($y->nelem, $x, $y - $yeb/2, $y + $yeb/2);
+ }
+
+ # Flush the PLplot stream.
+ plflush();
+}
+
+
+# Handle sets of 2D strip plots sharing one X axis. Input is
+# $self -- PLplot object with existing options
+# $xs -- Ref to list of 1D PDLs with X values
+# $ys -- Ref to list of 1D PDLs with Y values
+# or a 2D PDL
+# %opts -- Options values
+sub stripplots {
+
+ my $self = shift;
+ my $xs = shift;
+ my $yargs = shift;
+
+ my %opts = @_;
+
+ # NYTICK => number of y axis ticks
+ my $nytick = $opts{NYTICK} || 2;
+ delete ($opts{NYTICK});
+
+ # only process COLORMAP entries once
+ my $zs = $opts{COLORMAP};
+ delete ($opts{COLORMAP});
+
+ # handle XLAB, YLAB and TITLE options
+ my $title = $opts{TITLE} || '';
+ my $xlab = $opts{XLAB} || '';
+ my @ylabs = defined($opts{YLAB}) && (ref($opts{YLAB}) =~ /ARRAY/) ? @{$opts{YLAB}} : ();
+ delete @opts{qw(TITLE XLAB YLAB)};
+
+ # Ensure we're dealing with an array reference
+ my $ys;
+ if (ref ($yargs) eq 'ARRAY') {
+ $ys = $yargs;
+ }
+ elsif (ref ($yargs) =~ /PDL/) {
+ $ys = [dog $yargs];
+ }
+ else {
+ barf("stripplots requires that its second argument be either a 2D piddle or\na reference to a list of 1D piddles, but you provided neither.");
+ }
+
+# This doesn't work because $xs can be an anonymous array, too
+# # Let's be sure the user sent us what we expected:
+# foreach (@$ys) {
+# barf ("stripplots needs to have piddles for its y arguments!")
+# unless (ref =~ /PDL/);
+# barf("stripplots requires that the x and y dimensions agree!")
+# unless ($_->nelem == $xs->nelem);
+# }
+
+ my $nplots = @$ys;
+
+ # Use list of colors, or single color. If COLOR not specified, default to BLACK for each graph
+ my @colors = (defined ($opts{COLOR}) && ref($opts{COLOR}) =~ /ARRAY/) ? @{$opts{COLOR}}
+ : defined ($opts{COLOR}) ? ($opts{COLOR}) x $nplots
+ : ('BLACK') x $nplots;
+ delete @opts{qw(COLOR)};
+
+ my $y_base = defined($opts{Y_BASE}) ? $opts{Y_BASE} : 0.1; # Y offset to start bottom plot
+ my $y_gutter = defined($opts{Y_GUTTER}) ? $opts{Y_GUTTER} : 0.02; # Y gap between plots
+ delete @opts{qw(Y_BASE Y_GUTTER)};
+
+ # apply options
+ $self->setparm(%opts);
+
+ my ($xmin, $xmax);
+ if (ref ($xs) =~ /PDL/) {
+ ($xmin, $xmax) = $xs->minmax;
+ }
+ else {
+ $xmin = pdl(map { $_->min } @$xs)->min;
+ $xmax = pdl(map { $_->max } @$xs)->max;
+ }
+
+ SUBPAGE:
+ for (my $subpage=0;$subpage<$nplots;$subpage++) {
+
+ my $y = $ys->[$subpage];
+ my $x = ref ($xs) =~ /PDL/ ? $xs : $xs->[$subpage];
+ my $mask = $y->isgood;
+ $y = $y->where($mask);
+ $x = $x->where($mask);
+ my $z = $zs->slice(":,($subpage)")->where($mask) if (defined($zs));
+ my $yeb = $yebs->slice(":,($subpage)")->where($mask) if (defined($yebs));
+ my $ylab = $ylabs[$subpage];
+
+ my $bottomplot = ($subpage == 0);
+ my $topplot = ($subpage == $nplots-1);
+
+ my $xbox = 'bc';
+ $xbox = 'cstnb' if ($bottomplot);
+
+ my $box = $opts{BOX};
+ my $yrange = defined($box) ? $$box[3] - $$box[2] : $y->max - $y->min;
+ my $del = $yrange ? $yrange * 0.05 : 1;
+ my @ybounds = ($y->min - $del, $y->max + $del);
+ my $ytick = ($yrange/$nytick);
+ my @COLORMAP = (COLORMAP => $z) if defined($z);
+ $self->xyplot($x, $y,
+ COLOR => $colors[$subpage],
+ BOX => defined($box) ? $box : [$xmin, $xmax, @ybounds],
+ XBOX => $xbox,
+ YBOX => 'BCNT',
+ YTICK => $ytick,
+ MAJTICKSIZE => 0.6,
+ CHARSIZE => 0.4,
+ @COLORMAP,
+ VIEWPORT => [
+ 0.15,
+ 0.9,
+ $y_base + ($subpage * (0.8/$nplots)),
+ $y_base - $y_gutter + (($subpage+1) * (0.8/$nplots)),
+ ],
+ );
+
+ $self->text($ylab, TEXTPOSITION => ['L', 4, 0.5, 0.5], COLOR => 'BLACK', CHARSIZE => 0.6) if (defined($ylab));
+ $self->text($xlab, TEXTPOSITION => ['B', 3, 0.5, 0.5], COLOR => 'BLACK', CHARSIZE => 0.6) if ($xlab && $bottomplot);
+ $self->text($title, TEXTPOSITION => ['T', 2, 0.5, 0.5], COLOR => 'BLACK', CHARSIZE => 1.3) if ($title && $topplot);
+
+ }
+
+}
+
+
+# Draw a color key or wedge showing the scale of map1 colors
+sub colorkey {
+ my $self = shift;
+ my $var = shift;
+ my $orientation = shift; # 'v' (for vertical) or 'h' (for horizontal)
+
+ my %opts = @_;
+
+ # Set PLplot to right output stream
+ plsstrm($self->{STREAMNUMBER});
+
+ # apply options
+ $self->setparm(%opts);
+
+ # set up viewport, subpage, world coordinates
+ $self->_setwindow;
+
+ # draw labels
+ $self->_drawlabels;
+
+ # Allow user to set X, Y box type for color key scale. D. Hunt 1/7/2009
+ my $xbox = exists($self->{XBOX}) ? $self->{XBOX} : 'TM';
+ my $ybox = exists($self->{YBOX}) ? $self->{YBOX} : 'TM';
+
+ my @box;
+
+ plcol0 (1); # set to frame color
+
+ my ($min, $max) = exists ($self->{ZRANGE}) ? @{$self->{ZRANGE}} : $var->minmax;
+
+ # plot box
+ if ($orientation eq 'v') {
+ # set world coordinates based on input variable
+ @box = (0, 1, $min, $max);
+ plwind (@box);
+ plbox (0, 0, 0, 0, '', $ybox); # !!! note out of order call
+ } elsif ($orientation eq 'h') {
+ @box = ($min, $max, 0, 1);
+ plwind (@box);
+ plbox (0, 0, 0, 0, $xbox, ''); # !!! note out of order call
+ } else {
+ die "Illegal orientation value: $orientation. Should be 'v' (vertical) or 'h' (horizontal)";
+ }
+
+ # restore color setting
+ plcol0 ($self->{CURRENT_COLOR_IDX});
+
+ # This is the number of colors shown in the color wedge. Make
+ # this smaller for gif images as these are limited to 256 colors total.
+ # D. Hunt 8/9/2006
+ my $ncols = ($self->{DEV} =~ /gif/) ? 32 : 128;
+
+ if ($orientation eq 'v') {
+ my $yinc = ($box[3] - $box[2])/$ncols;
+ my $y0 = $box[2];
+ for (my $i=0;$i<$ncols;$i++) {
+ $y0 = $box[2] + ($i * $yinc);
+ my $y1 = $y0 + $yinc;
+ PDL::Graphics::PLplot::plcol1($i/$ncols);
+
+ # Instead of using plfill (which is not supported on some devices)
+ # use multiple calls to plline to color in the space. D. Hunt 8/9/2006
+ foreach my $inc (0..9) {
+ my $frac = $inc * 0.1;
+ my $y = $y0 + (($y1 - $y0) * $frac);
+ PDL::Graphics::PLplot::plline (PDL->new(0,1), PDL->new($y,$y));
+ }
+
+ }
+ } else {
+ my $xinc = ($box[1] - $box[0])/$ncols;
+ my $x0 = $box[0];
+ for (my $i=0;$i<$ncols;$i++) {
+ $x0 = $box[0] + ($i * $xinc);
+ my $x1 = $x0 + $xinc;
+ PDL::Graphics::PLplot::plcol1($i/$ncols);
+
+ # Instead of using plfill (which is not supported on some devices)
+ # use multiple calls to plline to color in the space. D. Hunt 8/9/2006
+ foreach my $inc (0..9) {
+ my $frac = $inc * 0.1;
+ my $x = $x0 + (($x1 - $x0) * $frac);
+ PDL::Graphics::PLplot::plline (PDL->new($x,$x), PDL->new(0,1));
+ }
+
+ }
+ }
+
+ # Flush the PLplot stream.
+ plflush();
+}
+
+# handle shade plots of gridded (2D) data
+sub shadeplot {
+ my $self = shift;
+ my $z = shift;
+ my $nsteps = shift;
+
+ my %opts = @_;
+
+ # Set PLplot to right output stream
+ plsstrm($self->{STREAMNUMBER});
+
+ # apply options
+ $self->setparm(%opts);
+
+ my ($nx, $ny) = $z->dims;
+
+ unless (exists($self->{BOX})) {
+ $self->{BOX} = [0, $nx, 0, $ny];
+ }
+
+ # set up plotting box
+ $self->_setwindow;
+
+ # draw labels
+ $self->_drawlabels;
+
+ # plot box
+ plcol0 (1); # set to frame color
+ plbox ($self->{XTICK}, $self->{NXSUB}, $self->{YTICK}, $self->{NYSUB},
+ $self->{XBOX}, $self->{YBOX}); # !!! note out of order call
+
+ my ($min, $max) = exists ($self->{ZRANGE}) ? @{$self->{ZRANGE}} : $z->minmax;
+ my $clevel = ((PDL->sequence($nsteps)*(($max - $min)/($nsteps-1))) + $min);
+
+ # may add as options later. Now use constants
+ my $fill_width = 2;
+ my $cont_color = 0;
+ my $cont_width = 0;
+
+ my $rectangular = 1; # only false for non-linear coord mapping (not done yet in perl)
+
+ # map X coords linearly to X range, Y coords linearly to Y range
+ my $xmap = ((PDL->sequence($nx)*(($self->{BOX}[1] - $self->{BOX}[0])/($nx - 1))) + $self->{BOX}[0]);
+ my $ymap = ((PDL->sequence($ny)*(($self->{BOX}[3] - $self->{BOX}[2])/($ny - 1))) + $self->{BOX}[2]);
+
+ my $grid = plAllocGrid ($xmap, $ymap);
+
+ plshades($z, @{$self->{BOX}}, $clevel, $fill_width,
+ $cont_color, $cont_width, $rectangular,
+ 0, \&pltr1, $grid);
+
+ plFreeGrid ($grid);
+
+ # Flush the PLplot stream.
+ plflush();
+}
+
+# handle histograms
+sub histogram {
+ my $self = shift;
+ my $x = shift;
+ my $nbins = shift;
+
+ my %opts = @_;
+
+ # Set PLplot to right output stream
+ plsstrm($self->{STREAMNUMBER});
+
+ # apply options
+ $self->setparm(%opts);
+
+ my ($min, $max) = $x->minmax;
+
+ unless (exists($self->{BOX})) {
+ $self->{BOX} = [$min, $max, 0, $x->nelem]; # box probably too tall!
+ }
+
+ # set up plotting box
+ $self->_setwindow;
+
+ # draw labels
+ $self->_drawlabels;
+
+ # plot box
+ plcol0 (1); # set to frame color
+ plbox ($self->{XTICK}, $self->{NXSUB}, $self->{YTICK}, $self->{NYSUB},
+ $self->{XBOX}, $self->{YBOX}); # !!! note out of order call
+
+ # set line style for plot only (not box)
+ pllsty ($self->{LINESTYLE});
+
+ # set line width for plot only (not box)
+ plwid ($self->{LINEWIDTH});
+
+ # set color for histograms
+ plcol0 ($self->{CURRENT_COLOR_IDX});
+
+ plhist ($x, $min, $max, $nbins, 1); # '1' is oldbins parm: dont call plenv!
+
+ # set line width back
+ plwid (0);
+
+ # Flush the PLplot stream.
+ plflush();
+}
+
+# Draw bar graphs
+sub bargraph {
+ my $self = shift;
+ my $labels = shift; # ref to perl list of labels for bars
+ my $values = shift; # pdl of values for bars
+
+ my %opts = @_;
+
+ # max number of readable labels on x axis
+ my $maxlab = defined($opts{MAXBARLABELS}) ? $opts{MAXBARLABELS} : 20;
+ delete ($opts{MAXBARLABELS});
+
+ # Set PLplot to right output stream
+ plsstrm($self->{STREAMNUMBER});
+ my $xmax = scalar(@$labels);
+
+ # apply options
+ $self->setparm(%opts);
+
+ my ($ymin, $ymax) = $values->minmax;
+
+ unless (exists($self->{BOX})) {
+ $self->{BOX} = [0, $xmax, $ymin, $ymax]; # box probably too tall!
+ }
+
+ # set up plotting box
+ $self->_setwindow;
+
+ # draw labels
+ $self->_drawlabels;
+
+ # plot box
+ plcol0 (1); # set to frame color
+ plbox ($self->{XTICK}, $self->{NXSUB}, $self->{YTICK}, $self->{NYSUB},
+ 'bc', $self->{YBOX}); # !!! note out of order call
+
+ # Now respect TEXTPOSITION setting if TEXTMODE eq 'border'
+ # This allows the user to tweak the label placement. D. Hunt 9/4/2007
+ my ($side, $disp, $foo, $just) = ('BV', 0.2, 0, 1.0);
+ if (defined($self->{TEXTMODE}) && $self->{TEXTMODE} eq 'border') {
+ ($side, $disp, $foo, $just) = @{$self->{TEXTPOSITION}};
+ }
+
+ # plot labels
+ plschr (0, $self->{CHARSIZE} * 0.7); # use smaller characters
+ my $pos = 0;
+ my $skip = int($xmax/$maxlab) + 1;
+ for (my $i=0;$i<$xmax;$i+=$skip) {
+ $pos = ((0.5+$i)/$xmax);
+ my $lab = $$labels[$i];
+ plmtex ($disp, $pos, $just, $side, $lab); # !!! out of order parms
+ }
+
+ plcol0 ($self->{CURRENT_COLOR_IDX}); # set back to line color
+
+ # set line style for plot only (not box)
+ pllsty ($self->{LINESTYLE});
+
+ # set line width for plot only (not box)
+ plwid ($self->{LINEWIDTH});
+
+ # draw bars
+ if ($self->{UNFILLED_BARS}) {
+ plunfbox (PDL->sequence($xmax)+0.5, $values);
+ } else {
+ plfbox (PDL->sequence($xmax)+0.5, $values);
+ }
+
+ # set line width back
+ plwid (0);
+
+ # set char size back
+ plschr (0, $self->{CHARSIZE});
+
+ # Flush the PLplot stream.
+ plflush();
+}
+
+# Add text to a plot
+sub text {
+ my $self = shift;
+ my $text = shift;
+
+ # Set PLplot to right output stream
+ plsstrm($self->{STREAMNUMBER});
+
+ # apply options
+ $self->setparm(@_);
+
+ # set the color according to the color specified in the object
+ plcol0 ($self->{CURRENT_COLOR_IDX});
+
+ # plot either relative to border, or inside view port
+ if ($self->{TEXTMODE} eq 'border') {
+ my ($side, $disp, $pos, $just) = @{$self->{TEXTPOSITION}};
+ plmtex ($disp, $pos, $just, $side, $text); # !!! out of order parms
+ } elsif ($self->{TEXTMODE} eq 'plot') {
+ my ($x, $y, $dx, $dy, $just) = @{$self->{TEXTPOSITION}};
+ plptex ($x, $y, $dx, $dy, $just, $text);
+ }
+
+ # Flush the PLplot stream.
+ plflush();
+}
+
+# Clear the current page. This should only be used with interactive devices!
+sub clear {
+ my $self = shift;
+
+ # Set PLplot to right output stream
+ plsstrm($self->{STREAMNUMBER});
+
+ plclear();
+ return;
+}
+
+# Get mouse click coordinates (OO version). This should only be used with interactive devices!
+sub cursor {
+ my $self = shift;
+
+ # Set PLplot to right output stream
+ plsstrm($self->{STREAMNUMBER});
+
+ # Flush the stream, to make sure the plot is visible & current
+ plflush();
+
+ # Get the cursor position
+ my %gin = plGetCursor();
+
+ # Return an array with the coordinates of the mouse click
+ return ($gin{"wX"}, $gin{"wY"}, $gin{"pX"}, $gin{"pY"}, $gin{"dX"}, $gin{"dY"});
+}
+
+# Explicitly close a plot and free the object
+sub close {
+ my $self = shift;
+
+ # Set PLplot to right output stream
+ plsstrm($self->{STREAMNUMBER});
+
+ plend1 ();
+
+ # Return this stream number to the pool.
+ push (@plplot_stream_pool, $self->{STREAMNUMBER});
+ delete $self->{STREAMNUMBER};
+
+ return;
+}
+EOD
+
+# Used throughout when generating documentation.
+my $doc;
+
+# Necessary includes for .xs file
+pp_addhdr(<<'EOH');
+#include <plplot.h>
+#include <plplotP.h>
+#include <plevent.h>
+#include <stdio.h>
+
+#ifdef plwidth
+#define c_plwid c_plwidth
+#endif
+
+EOH
+
+# The create_low_level_constants function is used to make the #define'd
+# constants in plplot.h available in Perl in the form of functions. It
+# should be then possible to write code like this:
+#
+# plParseOpts (\@ARGV, PL_PARSE_SKIP | PL_PARSE_NOPROGRAM);
+
+sub create_low_level_constants {
+ my $defn = shift;
+ my @lines = split (/\n/, $defn);
+
+ foreach my $line (@lines) {
+ next if (($line =~ /^\#/) or ($line =~ /^\s*$/));
+ foreach my $const ($line =~ /([^\s]+)/g) {
+ my $func = <<"EOC";
+int
+$const()
+PROTOTYPE:
+CODE:
+ RETVAL = $const;
+OUTPUT:
+ RETVAL
+EOC
+ pp_addxs ($func);
+ pp_add_exported ($const);
+ }
+ }
+}
+
+create_low_level_constants (<<'EODEF');
+
+# Definitions used in plParseOpts
+
+PL_PARSE_PARTIAL
+PL_PARSE_FULL
+PL_PARSE_QUIET
+PL_PARSE_NODELETE
+PL_PARSE_SHOWALL
+PL_PARSE_OVERRIDE
+PL_PARSE_NOPROGRAM
+PL_PARSE_NODASH
+PL_PARSE_SKIP
+
+# Definitions for plmesh and plsurf3d
+
+DRAW_LINEX
+DRAW_LINEY
+DRAW_LINEXY
+MAG_COLOR
+BASE_CONT
+TOP_CONT
+SURF_CONT
+DRAW_SIDES
+FACETED
+MESH
+
+# fonts
+
+PL_FCI_SANS
+PL_FCI_MONO
+
+# Input event (especially keyboard) definitions for use from plplot
+# event handlers.
+
+PLK_BackSpace PLK_Tab PLK_Linefeed PLK_Return PLK_Escape PLK_Delete
+PLK_Clear PLK_Pause PLK_Scroll_Lock PLK_Home PLK_Left PLK_Up PLK_Right
+PLK_Down PLK_Prior PLK_Next PLK_End PLK_Begin PLK_Select PLK_Print
+PLK_Execute PLK_Insert PLK_Undo PLK_Redo PLK_Menu PLK_Find PLK_Cancel
+PLK_Help PLK_Break PLK_Mode_switch PLK_script_switch PLK_Num_Lock
+PLK_KP_Space PLK_KP_Tab PLK_KP_Enter PLK_KP_F1 PLK_KP_F2 PLK_KP_F3
+PLK_KP_F4 PLK_KP_Equal PLK_KP_Multiply PLK_KP_Add PLK_KP_Separator
+PLK_KP_Subtract PLK_KP_Decimal PLK_KP_Divide PLK_KP_0 PLK_KP_1
+PLK_KP_2 PLK_KP_3 PLK_KP_4 PLK_KP_5 PLK_KP_6 PLK_KP_7 PLK_KP_8
+PLK_KP_9 PLK_F1 PLK_F2 PLK_F3 PLK_F4 PLK_F5 PLK_F6 PLK_F7 PLK_F8
+PLK_F9 PLK_F10 PLK_F11 PLK_L1 PLK_F12 PLK_L2 PLK_F13 PLK_L3 PLK_F14
+PLK_L4 PLK_F15 PLK_L5 PLK_F16 PLK_L6 PLK_F17 PLK_L7 PLK_F18 PLK_L8
+PLK_F19 PLK_L9 PLK_F20 PLK_L10 PLK_F21 PLK_R1 PLK_F22 PLK_R2 PLK_F23
+PLK_R3 PLK_F24 PLK_R4 PLK_F25 PLK_R5 PLK_F26 PLK_R6 PLK_F27 PLK_R7
+PLK_F28 PLK_R8 PLK_F29 PLK_R9 PLK_F30 PLK_R10 PLK_F31 PLK_R11 PLK_F32
+PLK_R12 PLK_R13 PLK_F33 PLK_F34 PLK_R14 PLK_F35 PLK_R15 PLK_Shift_L
+PLK_Shift_R PLK_Control_L PLK_Control_R PLK_Caps_Lock PLK_Shift_Lock
+PLK_Meta_L PLK_Meta_R PLK_Alt_L PLK_Alt_R PLK_Super_L PLK_Super_R
+PLK_Hyper_L PLK_Hyper_R
+
+# Type of gridding algorithm for plgriddata ()
+
+GRID_CSA
+GRID_DTLI
+GRID_NNI
+GRID_NNIDW
+GRID_NNLI
+GRID_NNAIDW
+
+EODEF
+
+create_low_level_constants (<<'EODEF') if ($plversion->{'c_pllegend'});
+
+# Definitions for plslabelfunc
+
+PL_X_AXIS
+PL_Y_AXIS
+PL_Z_AXIS
+
+# Definitions for colorbar
+
+PL_COLORBAR_SHADE
+PL_COLORBAR_SHADE_LABEL
+PL_COLORBAR_IMAGE
+PL_COLORBAR_GRADIENT
+PL_COLORBAR_CAP_LOW
+PL_COLORBAR_CAP_HIGH
+PL_COLORBAR_LABEL_LEFT
+PL_COLORBAR_LABEL_RIGHT
+PL_COLORBAR_LABEL_TOP
+PL_COLORBAR_LABEL_BOTTOM
+
+# Definitions for pllegend
+
+PL_LEGEND_BACKGROUND
+PL_LEGEND_BOUNDING_BOX
+PL_LEGEND_COLOR_BOX
+PL_LEGEND_LINE
+PL_LEGEND_NONE
+PL_LEGEND_ROW_MAJOR
+PL_LEGEND_SYMBOL
+PL_LEGEND_TEXT_LEFT
+PL_POSITION_BOTTOM
+PL_POSITION_INSIDE
+PL_POSITION_LEFT
+PL_POSITION_OUTSIDE
+PL_POSITION_RIGHT
+PL_POSITION_SUBPAGE
+PL_POSITION_TOP
+PL_POSITION_VIEWPORT
+
+EODEF
+
+# This subroutine is used to reorder PP_DEF arguments into the
+# standard plplot order. This is necessary for some plplot functions
+# with a mixture of PDL and non-PDL arguments, since pp_def requires
+# all non-PDL (OtherPars) arguments to go at the end of the argument list
+pp_addpm (<<'EOPM');
+sub reorder {
+ my $name = shift;
+ my %reorder = (
+ plaxes => [0,1,6,2,3,7,4,5],
+ plbox => [4,0,1,5,2,3], # 4th arg -> 0th arg, 0th arg -> 1st arg, etc
+ plbox3 => [6,7,0,1,8,9,2,3,10,11,4,5],
+ plmtex => [3,0,1,2,4],
+ plmtex3 => [3,0,1,2,4],
+ plstart => [2,0,1],
+ plstripc => [13,14,0,1,2,3,4,5,6,7,8,9,10,11,12,15,16,17,18],
+ plmap => [4,5,0,1,2,3],
+ plmeridians => [6,0,1,2,3,4,5],
+ plshades => [0,10,1,2,3,4,5,6,7,8,9,11,12],
+ plshade1 => [0,15,1,2,3,4,5,6,7,8,9,10,11,12,13,14,16,17],
+ );
+ my $ordering = $reorder{$name};
+ die "Cannot find argument reordering for $name" if (!defined($ordering));
+ my @out;
+ for (my $i=0;$i<@_;$i++) {
+ $out[$$ordering[$i]] = $_[$i];
+ }
+ return @out;
+}
+
+# Routine for users to set normal plplot argument order
+sub plplot_use_standard_argument_order {
+ $PDL::Graphics::PLplot::standard_order = shift;
+}
+EOPM
+pp_add_exported('plplot_use_standard_argument_order');
+
+=head1 LOW-LEVEL INTERFACE
+=cut
+
+pp_addpm (<<'EOPM');
+
+=pod
+
+The PDL low-level interface to the PLplot library closely mimics the C API.
+Users are referred to the PLplot User's Manual, distributed with the source
+PLplot tarball. This manual is also available on-line at the PLplot web
+site (L<http://www.plplot.org/>).
+
+There are three differences in the way the functions are called. The first
+one is due to a limitation in the pp_def wrapper of PDL, which forces all
+the non-piddle arguments to be at the end of the arguments list. It is
+the case of strings (C<char *>) arguments in the C API. This affects the
+following functions:
+
+plaxes
+plbox
+plbox3
+plmtex
+plmtex3
+plstart
+plstripc
+plmap
+plmeridians
+plshades
+plshade1
+
+This difference can be got around by a call to
+
+plplot_use_standard_argument_order(1);
+
+This re-arranges the string arguments to their proper/intuitive position
+compared with the C plplot interface. This can be restored to it's default
+by calling:
+
+plplot_use_standard_argument_order(0);
+
+The second notable different between the C and the PDL APIs is that many of
+the PDL calls do not need arguments to specify the size of the the vectors
+and/or matrices being passed. These size parameters are deduced from the
+size of the piddles, when possible and are just omitted from the C call
+when translating it to perl.
+
+The third difference has to do with output parameters. In C these are
+passed in with the input parameters. In the perl interface, they are omitted.
+For example:
+
+C:
+
+ pllegend(&p_legend_width, &p_legend_height,
+ opt, position, x, y, plot_width, bg_color, bb_color, bb_style, nrow, ncolumn, nlegend,
+ opt_array,
+ text_offset, text_scale, text_spacing, text_justification,
+ text_colors, (const char **)text, box_colors, box_patterns, box_scales, box_line_widths,
+ line_colors, line_styles, line_widths, symbol_colors, symbol_scales, symbol_numbers, (const char **)symbols);
+
+perl:
+
+ my ($legend_width, $legend_height) =
+ pllegend ($position, $opt, $x, $y, $plot_width, $bg_color, $nlegend,
+ \@opt_array,
+ $text_offset, $text_scale, $text_spacing, $test_justification,
+ \@text_colors, \@text, \@box_colors, \@box_patterns, \@box_scales, \@line_colors,
+ \@line_styles, \@line_widths, \@symbol_colors, \@symbol_scales, \@symbol_numbers, \@symbols);
+
+Some of the API functions implemented in PDL have other specificities in
+comparison with the C API and will be discussed below.
+
+=cut
+
+EOPM
+
+pp_def ('pladv',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int page()',
+ OtherPars => '',
+ Code => 'c_pladv($page());'
+ );
+
+sub plaxes { plaxes_pp ($standard_order ? reorder ('plaxes', @_) : @_) } pp_add_exported('plaxes');
+pp_def ('plaxes_pp',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xzero();double yzero();double xtick();int nxsub();double ytick();int nysub()',
+ OtherPars => 'char *xopt;char *yopt',
+ Code => 'c_plaxes($xzero(),$yzero(),$COMP(xopt),$xtick(),$nxsub(),$COMP(yopt),$ytick(),$nysub());'
+ );
+
+pp_def ('plbin',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int nbin();double x(dima);double y(dima);int center()',
+ OtherPars => '',
+ Code => 'c_plbin($nbin(),$P(x),$P(y),$center());'
+ );
+
+pp_addxs (<<"EOC");
+void
+plbop()
+CODE:
+ c_plbop();
+
+EOC
+pp_add_exported('plbop');
+
+pp_addpm ('sub plbox { plbox_pp ($standard_order ? reorder ("plbox", @_) : @_) }'); pp_add_exported('plbox');
+pp_def ('plbox_pp',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xtick();int nxsub();double ytick();int nysub()',
+ OtherPars => 'char *xopt;char *yopt',
+ Code => 'c_plbox($COMP(xopt),$xtick(),$nxsub(),$COMP(yopt),$ytick(),$nysub());'
+ );
+
+pp_addpm ('sub plbox3 { plbox3_pp ($standard_order ? reorder ("plbox3", @_) : @_) }'); pp_add_exported('plbox3');
+pp_def ('plbox3_pp',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xtick();int nsubx();double ytick();int nsuby();double ztick();int nsubz()',
+ OtherPars => 'char *xopt;char *xlabel;char *yopt;char *ylabel;char *zopt;char *zlabel',
+ Code => 'c_plbox3($COMP(xopt),$COMP(xlabel),$xtick(),$nsubx(),$COMP(yopt),$COMP(ylabel),$ytick(),$nsuby(),$COMP(zopt),$COMP(zlabel),$ztick(),$nsubz());'
+ );
+
+pp_addxs (<<"EOC");
+void
+plclear()
+CODE:
+ c_plclear();
+
+EOC
+pp_add_exported('plclear');
+
+pp_def ('plcol0',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int icolzero()',
+ OtherPars => '',
+ Code => 'c_plcol0($icolzero());'
+ );
+
+pp_def ('plcol1',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double colone()',
+ OtherPars => '',
+ Code => 'c_plcol1($colone());'
+ );
+
+pp_def ('plcpstrm',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int iplsr();int flags()',
+ OtherPars => '',
+ Code => 'c_plcpstrm($iplsr(),$flags());'
+ );
+
+pp_def ('pldid2pc',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xmin(dima);double ymin(dima);double xmax(dima);double ymax(dima)',
+ OtherPars => '',
+ Code => 'pldid2pc($P(xmin),$P(ymin),$P(xmax),$P(ymax));'
+ );
+
+pp_def ('pldip2dc',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xmin(dima);double ymin(dima);double xmax(dima);double ymax(dima)',
+ OtherPars => '',
+ Code => 'pldip2dc($P(xmin),$P(ymin),$P(xmax),$P(ymax));'
+ );
+
+pp_addxs (<<"EOC");
+void
+plend()
+CODE:
+ c_plend();
+
+EOC
+pp_add_exported('plend');
+
+pp_addxs (<<"EOC");
+void
+plend1()
+CODE:
+ c_plend1();
+
+EOC
+pp_add_exported('plend1');
+
+pp_def ('plenv',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xmin();double xmax();double ymin();double ymax();int just();int axis()',
+ OtherPars => '',
+ Code => 'c_plenv($xmin(),$xmax(),$ymin(),$ymax(),$just(),$axis());'
+ );
+
+pp_def ('plenv0',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xmin();double xmax();double ymin();double ymax();int just();int axis()',
+ OtherPars => '',
+ Code => 'c_plenv0($xmin(),$xmax(),$ymin(),$ymax(),$just(),$axis());'
+ );
+
+pp_addxs (<<"EOC");
+void
+pleop()
+CODE:
+ c_pleop();
+
+EOC
+pp_add_exported('pleop');
+
+pp_def ('plerrx',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int n();double xmin(dima);double xmax(dima);double y(dima)',
+ OtherPars => '',
+ Code => 'c_plerrx($n(),$P(xmin),$P(xmax),$P(y));'
+ );
+
+pp_def ('plerry',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int n();double x(dima);double ymin(dima);double ymax(dima)',
+ OtherPars => '',
+ Code => 'c_plerry($n(),$P(x),$P(ymin),$P(ymax));'
+ );
+
+pp_addxs (<<"EOC");
+void
+plfamadv()
+CODE:
+ c_plfamadv();
+
+EOC
+pp_add_exported('plfamadv');
+
+pp_def ('plfill3',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int n();double x(dima);double y(dima);double z(dima)',
+ OtherPars => '',
+ Code => 'c_plfill3($n(),$P(x),$P(y),$P(z));'
+ );
+
+pp_addxs (<<"EOC");
+void
+plflush()
+CODE:
+ c_plflush();
+
+EOC
+pp_add_exported('plflush');
+
+pp_def ('plfont',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int ifont()',
+ OtherPars => '',
+ Code => 'c_plfont($ifont());'
+ );
+
+pp_def ('plfontld',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int fnt()',
+ OtherPars => '',
+ Code => 'c_plfontld($fnt());'
+ );
+
+pp_def ('plgchr',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double [o]p_def();double [o]p_ht()',
+ OtherPars => '',
+ Code => 'c_plgchr($P(p_def),$P(p_ht));'
+ );
+
+pp_def ('plgcompression',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int [o]compression()',
+ OtherPars => '',
+ Code => 'c_plgcompression($P(compression));'
+ );
+
+pp_def ('plgdidev',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double [o]p_mar();double [o]p_aspect();double [o]p_jx();double [o]p_jy()',
+ OtherPars => '',
+ Code => 'c_plgdidev($P(p_mar),$P(p_aspect),$P(p_jx),$P(p_jy));'
+ );
+
+pp_def ('plgdiori',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double [o]p_rot()',
+ OtherPars => '',
+ Code => 'c_plgdiori($P(p_rot));'
+ );
+
+pp_def ('plgdiplt',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double [o]p_xmin();double [o]p_ymin();double [o]p_xmax();double [o]p_ymax()',
+ OtherPars => '',
+ Code => 'c_plgdiplt($P(p_xmin),$P(p_ymin),$P(p_xmax),$P(p_ymax));'
+ );
+
+pp_def ('plgfam',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int [o]p_fam();int [o]p_num();int [o]p_bmax()',
+ OtherPars => '',
+ Code => 'c_plgfam($P(p_fam),$P(p_num),$P(p_bmax));'
+ );
+
+pp_def ('plglevel',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int [o]p_level()',
+ OtherPars => '',
+ Code => 'c_plglevel($P(p_level));'
+ );
+
+pp_def ('plgpage',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double [o]p_xp();double [o]p_yp();int [o]p_xleng();int [o]p_yleng();int [o]p_xoff();int [o]p_yoff()',
+ OtherPars => '',
+ Code => 'c_plgpage($P(p_xp),$P(p_yp),$P(p_xleng),$P(p_yleng),$P(p_xoff),$P(p_yoff));'
+ );
+
+pp_addxs (<<"EOC");
+void
+plgra()
+CODE:
+ c_plgra();
+
+EOC
+pp_add_exported('plgra');
+
+pp_def ('plgspa',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double [o]xmin();double [o]xmax();double [o]ymin();double [o]ymax()',
+ OtherPars => '',
+ Code => 'c_plgspa($P(xmin),$P(xmax),$P(ymin),$P(ymax));'
+ );
+
+pp_def ('plgvpd',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double [o]p_xmin();double [o]p_xmax();double [o]p_ymin();double [o]p_ymax()',
+ OtherPars => '',
+ Code => 'c_plgvpd($P(p_xmin),$P(p_xmax),$P(p_ymin),$P(p_ymax));'
+ );
+
+pp_def ('plgvpw',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double [o]p_xmin();double [o]p_xmax();double [o]p_ymin();double [o]p_ymax()',
+ OtherPars => '',
+ Code => 'c_plgvpw($P(p_xmin),$P(p_xmax),$P(p_ymin),$P(p_ymax));'
+ );
+
+pp_def ('plgxax',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int [o]p_digmax();int [o]p_digits()',
+ OtherPars => '',
+ Code => 'c_plgxax($P(p_digmax),$P(p_digits));'
+ );
+
+pp_def ('plgyax',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int [o]p_digmax();int [o]p_digits()',
+ OtherPars => '',
+ Code => 'c_plgyax($P(p_digmax),$P(p_digits));'
+ );
+
+pp_def ('plgzax',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int [o]p_digmax();int [o]p_digits()',
+ OtherPars => '',
+ Code => 'c_plgzax($P(p_digmax),$P(p_digits));'
+ );
+
+pp_addxs (<<"EOC");
+void
+plinit()
+CODE:
+ c_plinit();
+
+EOC
+pp_add_exported('plinit');
+
+pp_def ('pljoin',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xone();double yone();double xtwo();double ytwo()',
+ OtherPars => '',
+ Code => 'c_pljoin($xone(),$yone(),$xtwo(),$ytwo());'
+ );
+
+pp_addxs (<<"EOC");
+void
+pllab(xlabel,ylabel,tlabel)
+ char * xlabel
+ char * ylabel
+ char * tlabel
+CODE:
+ c_pllab(xlabel,ylabel,tlabel);
+
+EOC
+pp_add_exported('pllab');
+
+pp_def ('pllightsource',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double x();double y();double z()',
+ OtherPars => '',
+ Code => 'c_pllightsource($x(),$y(),$z());'
+ );
+
+pp_def ('pllsty',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int lin()',
+ OtherPars => '',
+ Code => 'c_pllsty($lin());'
+ );
+
+pp_addpm ('sub plmtex { plmtex_pp ($standard_order ? reorder ("plmtex", @_) : @_) }'); pp_add_exported('plmtex');
+pp_def ('plmtex_pp',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double disp();double pos();double just()',
+ OtherPars => 'char *side;char *text',
+ Code => 'c_plmtex($COMP(side),$disp(),$pos(),$just(),$COMP(text));'
+ );
+
+pp_addpm ('sub plmtex3 { plmtex3_pp ($standard_order ? reorder ("plmtex3", @_) : @_) }'); pp_add_exported('plmtex3');
+pp_def ('plmtex3_pp',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double disp();double pos();double just()',
+ OtherPars => 'char *side;char *text',
+ Code => 'c_plmtex3($COMP(side),$disp(),$pos(),$just(),$COMP(text));'
+ );
+
+pp_def ('plpat',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int nlin();int inc(dima);int del(dima)',
+ OtherPars => '',
+ Code => 'c_plpat($nlin(),$P(inc),$P(del));'
+ );
+
+pp_def ('plprec',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int setp();int prec()',
+ OtherPars => '',
+ Code => 'c_plprec($setp(),$prec());'
+ );
+
+pp_def ('plpsty',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int patt()',
+ OtherPars => '',
+ Code => 'c_plpsty($patt());'
+ );
+
+pp_def ('plptex',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double x();double y();double dx();double dy();double just()',
+ OtherPars => 'char *text',
+ Code => 'c_plptex($x(),$y(),$dx(),$dy(),$just(),$COMP(text));'
+ );
+
+pp_def ('plptex3',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double x();double y();double z();double dx();double dy();double dz();double sx();double sy();double sz();double just()',
+ OtherPars => 'char *text',
+ Code => 'c_plptex3($x(),$y(),$z(),$dx(),$dy(),$dz(),$sx(),$sy(),$sz(),$just(),$COMP(text));'
+ );
+
+pp_addxs (<<"EOC");
+void
+plreplot()
+CODE:
+ c_plreplot();
+
+EOC
+pp_add_exported('plreplot');
+
+pp_def ('plschr',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double def();double scale()',
+ OtherPars => '',
+ Code => 'c_plschr($def(),$scale());'
+ );
+
+pp_def ('plscmap0n',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int ncolzero()',
+ OtherPars => '',
+ Code => 'c_plscmap0n($ncolzero());'
+ );
+
+pp_def ('plscmap1n',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int ncolone()',
+ OtherPars => '',
+ Code => 'c_plscmap1n($ncolone());'
+ );
+
+pp_def ('plscol0',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int icolzero();int r();int g();int b()',
+ OtherPars => '',
+ Code => 'c_plscol0($icolzero(),$r(),$g(),$b());'
+ );
+
+pp_def ('plscolbg',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int r();int g();int b()',
+ OtherPars => '',
+ Code => 'c_plscolbg($r(),$g(),$b());'
+ );
+
+pp_def ('plscolor',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int color()',
+ OtherPars => '',
+ Code => 'c_plscolor($color());'
+ );
+
+pp_def ('plscompression',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int compression()',
+ OtherPars => '',
+ Code => 'c_plscompression($compression());'
+ );
+
+pp_addxs (<<"EOC");
+void
+plsdev(devname)
+ char * devname
+CODE:
+ c_plsdev(devname);
+
+EOC
+pp_add_exported('plsdev');
+
+pp_def ('plsdidev',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double mar();double aspect();double jx();double jy()',
+ OtherPars => '',
+ Code => 'c_plsdidev($mar(),$aspect(),$jx(),$jy());'
+ );
+
+pp_def ('plsdimap',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int dimxmin();int dimxmax();int dimymin();int dimymax();double dimxpmm();double dimypmm()',
+ OtherPars => '',
+ Code => 'c_plsdimap($dimxmin(),$dimxmax(),$dimymin(),$dimymax(),$dimxpmm(),$dimypmm());'
+ );
+
+pp_def ('plsdiori',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double rot()',
+ OtherPars => '',
+ Code => 'c_plsdiori($rot());'
+ );
+
+pp_def ('plsdiplt',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xmin();double ymin();double xmax();double ymax()',
+ OtherPars => '',
+ Code => 'c_plsdiplt($xmin(),$ymin(),$xmax(),$ymax());'
+ );
+
+pp_def ('plsdiplz',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xmin();double ymin();double xmax();double ymax()',
+ OtherPars => '',
+ Code => 'c_plsdiplz($xmin(),$ymin(),$xmax(),$ymax());'
+ );
+
+pp_def ('pl_setcontlabelparam',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double offset();double size();double spacing();int active()',
+ OtherPars => '',
+ Code => 'c_pl_setcontlabelparam($offset(),$size(),$spacing(),$active());'
+ );
+
+pp_def ('pl_setcontlabelformat',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int lexp();int sigdig()',
+ OtherPars => '',
+ Code => 'c_pl_setcontlabelformat($lexp(),$sigdig());'
+ );
+
+pp_def ('plsfam',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int fam();int num();int bmax()',
+ OtherPars => '',
+ Code => 'c_plsfam($fam(),$num(),$bmax());'
+ );
+
+pp_addxs (<<"EOC");
+void
+plsfnam(fnam)
+ char * fnam
+CODE:
+ c_plsfnam(fnam);
+
+EOC
+pp_add_exported('plsfnam');
+
+pp_def ('plsmaj',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double def();double scale()',
+ OtherPars => '',
+ Code => 'c_plsmaj($def(),$scale());'
+ );
+
+pp_def ('plsmin',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double def();double scale()',
+ OtherPars => '',
+ Code => 'c_plsmin($def(),$scale());'
+ );
+
+pp_def ('plsori',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int ori()',
+ OtherPars => '',
+ Code => 'c_plsori($ori());'
+ );
+
+pp_def ('plspage',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xp();double yp();int xleng();int yleng();int xoff();int yoff()',
+ OtherPars => '',
+ Code => 'c_plspage($xp(),$yp(),$xleng(),$yleng(),$xoff(),$yoff());'
+ );
+
+pp_def ('plspause',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int pause()',
+ OtherPars => '',
+ Code => 'c_plspause($pause());'
+ );
+
+pp_def ('plsstrm',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int strm()',
+ OtherPars => '',
+ Code => 'c_plsstrm($strm());'
+ );
+
+pp_def ('plssub',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int nx();int ny()',
+ OtherPars => '',
+ Code => 'c_plssub($nx(),$ny());'
+ );
+
+pp_def ('plssym',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double def();double scale()',
+ OtherPars => '',
+ Code => 'c_plssym($def(),$scale());'
+ );
+
+pp_def ('plstar',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int nx();int ny()',
+ OtherPars => '',
+ Code => 'c_plstar($nx(),$ny());'
+ );
+
+pp_addpm ('sub plstart { plstart_pp ($standard_order ? reorder ("plstart", @_) : @_) }'); pp_add_exported('plstart');
+pp_def ('plstart_pp',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int nx();int ny()',
+ OtherPars => 'char *devname',
+ Code => 'c_plstart($COMP(devname),$nx(),$ny());'
+ );
+
+pp_def ('plstripa',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int id();int pen();double x();double y()',
+ OtherPars => '',
+ Code => 'c_plstripa($id(),$pen(),$x(),$y());'
+ );
+
+pp_def ('plstripd',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int id()',
+ OtherPars => '',
+ Code => 'c_plstripd($id());'
+ );
+
+pp_def ('plsvpa',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xmin();double xmax();double ymin();double ymax()',
+ OtherPars => '',
+ Code => 'c_plsvpa($xmin(),$xmax(),$ymin(),$ymax());'
+ );
+
+pp_def ('plsxax',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int digmax();int digits()',
+ OtherPars => '',
+ Code => 'c_plsxax($digmax(),$digits());'
+ );
+
+pp_def ('plsxwin',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int window_id()',
+ OtherPars => '',
+ Code => 'plsxwin($window_id());'
+ );
+
+pp_def ('plsyax',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int digmax();int digits()',
+ OtherPars => '',
+ Code => 'c_plsyax($digmax(),$digits());'
+ );
+
+pp_def ('plszax',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int digmax();int digits()',
+ OtherPars => '',
+ Code => 'c_plszax($digmax(),$digits());'
+ );
+
+pp_addxs (<<"EOC");
+void
+pltext()
+CODE:
+ c_pltext();
+
+EOC
+pp_add_exported('pltext');
+
+pp_def ('plvasp',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double aspect()',
+ OtherPars => '',
+ Code => 'c_plvasp($aspect());'
+ );
+
+pp_def ('plvpas',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xmin();double xmax();double ymin();double ymax();double aspect()',
+ OtherPars => '',
+ Code => 'c_plvpas($xmin(),$xmax(),$ymin(),$ymax(),$aspect());'
+ );
+
+pp_def ('plvpor',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xmin();double xmax();double ymin();double ymax()',
+ OtherPars => '',
+ Code => 'c_plvpor($xmin(),$xmax(),$ymin(),$ymax());'
+ );
+
+pp_addxs (<<"EOC");
+void
+plvsta()
+CODE:
+ c_plvsta();
+EOC
+
+pp_add_exported('plvsta');
+
+pp_def ('plw3d',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double basex();double basey();double height();double xminzero();double xmaxzero();double yminzero();double ymaxzero();double zminzero();double zmaxzero();double alt();double az()',
+ OtherPars => '',
+ Code => 'c_plw3d($basex(),$basey(),$height(),$xminzero(),$xmaxzero(),$yminzero(),$ymaxzero(),$zminzero(),$zmaxzero(),$alt(),$az());'
+ );
+
+pp_def ('plwid',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int width()',
+ OtherPars => '',
+ Code => 'c_plwid($width());'
+ );
+
+pp_def ('plwind',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double xmin();double xmax();double ymin();double ymax()',
+ OtherPars => '',
+ Code => 'c_plwind($xmin(),$xmax(),$ymin(),$ymax());'
+ );
+
+pp_addxs (<<"EOC");
+void
+plsetopt(opt,optarg)
+ char * opt
+ char * optarg
+CODE:
+ c_plsetopt(opt,optarg);
+
+EOC
+pp_add_exported('plsetopt');
+
+pp_def ('plP_gpixmm',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double p_x(dima);double p_y(dima)',
+ OtherPars => '',
+ Code => 'plP_gpixmm($P(p_x),$P(p_y));'
+ );
+
+pp_def ('plscolbga',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int r();int g();int b();double a()',
+ OtherPars => '',
+ Code => 'c_plscolbga($r(),$g(),$b(),$a());'
+ );
+
+pp_def ('plscol0a',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int icolzero();int r();int g();int b();double a()',
+ OtherPars => '',
+ Code => 'c_plscol0a($icolzero(),$r(),$g(),$b(),$a());'
+ );
+
+# C routine to draw lines with gaps. This is useful for map continents and other things.
+=head2 plline
+=cut
+
+$doc = <<'EOD';
+=for ref
+
+Draws line segments along (x1,y1)->(x2,y2)->(x3,y3)->...
+
+=for bad
+
+If the nth value of either x or y are bad, then it will be skipped, breaking
+the line. In this way, you can specify multiple line segments with a single
+pair of x and y piddles.
+
+The usage is straight-forward:
+
+=for usage
+
+ plline($x, $y);
+
+For example:
+
+=for example
+
+ # Draw a sine wave
+ $x = sequence(100)/10;
+ $y = sin($x);
+
+ # Draws the sine wave:
+ plline($x, $y);
+
+ # Set values above 3/4 to 'bad', effectively drawing a bunch of detached,
+ # capped waves
+ $y->setbadif($y > 3/4);
+ plline($x, $y);
+
+=cut
+EOD
+
+pp_def ('plline',
+ NoPthread => 1,
+ Pars => 'x(n); y(n)',
+ GenericTypes => [D],
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ Code => 'c_plline($SIZE(n),$P(x),$P(y));',
+ BadCode => 'int i;
+ int j;
+ for (i=1;i<$SIZE(n);i++) {
+ j = i-1; /* PP does not like using i-1 in a PDL ref. Use j instead. */
+ if ($ISGOOD(x(n=>i)) && $ISGOOD(x(n=>j)) && $ISGOOD(y(n=>i)) && $ISGOOD(y(n=>j))) {
+ c_pljoin ($x(n=>j), $y(n=>j), $x(n=>i), $y(n=>i));
+ }
+ }',
+ Doc => $doc,
+ );
+
+=head2 plcolorpoints
+=cut
+
+$doc = <<'EOD';
+=for ref
+
+PDL-specific: Implements what amounts to a threaded version of plsym.
+
+=for bad
+
+Bad values for z are simply skipped; all other bad values are not processed.
+
+In the following usage, all of the piddles must have the same dimensions:
+
+=for usage
+
+ plcolorpoints($x, $y, $z, $symbol_index, $minz, $maxz)
+
+For example:
+
+=for example
+
+ # Generate a parabola some points
+ my $x = sequence(30) / 3; # Regular sampling
+ my $y = $x**2; # Parabolic y
+ my $z = 30 - $x**3; # Cubic coloration
+ my $symbols = floor($x); # Use different symbols for each 1/3 of the plot
+ # These should be integers.
+
+ plcolorpoints($x, $y, $z, $symbols, -5, 20); # Thread over everything
+ plcolorpoints($x, $y, 1, 1, -1, 2); # same color and symbol for all
+
+=cut
+EOD
+
+# C routine to draw points with a color scale
+pp_def ('plcolorpoints',
+ NoPthread => 1,
+ Pars => 'x(n); y(n); z(n); int sym(); minz(); maxz()',
+ GenericTypes => [D],
+ HandleBad => 1,
+ Code => 'int i;
+ int j;
+ int ns = $SIZE(n);
+ PLFLT zrange, ci;
+
+ zrange = $maxz() - $minz();
+
+ for (i=0;i<ns;i++) {
+ ci = (zrange == 0.0) ? 0.5 : ($z(n=>i) - $minz()) / zrange; /* get color idx in 0-1 range */
+ if (ci < 0) ci = 0; /* enforce bounds */
+ if (ci > 1) ci = 1;
+ c_plcol1 (ci); /* set current color */
+ c_plsym (1, &$x(n=>i), &$y(n=>i), $sym()); /* plot it */
+ }',
+ BadCode =>
+ 'int i;
+ int j;
+ int ns = $SIZE(n);
+ PLFLT zrange, ci;
+
+ zrange = $maxz() - $minz();
+
+ for (i=0;i<ns;i++) {
+ if ($ISBAD(z(n=>i))) continue;
+ ci = (zrange == 0.0) ? 0.5 : ($z(n=>i) - $minz()) / zrange; /* get color idx in 0-1 range */
+ if (ci < 0) ci = 0; /* enforce bounds */
+ if (ci > 1) ci = 1;
+ c_plcol1 (ci); /* set current color */
+ c_plsym (1, &$x(n=>i), &$y(n=>i), $sym()); /* plot it */
+
+ }',
+ Doc => $doc,
+ );
+
+
+
+pp_def ('plsmem',
+ NoPthread => 1,
+ GenericTypes => [B],
+ Pars => 'int maxx();int maxy();image(3,x,y)',
+ Code => 'c_plsmem($maxx(),$maxy(),$P(image));'
+ ) if ($plversion->{'plsmem'});
+
+#
+## Box drawing primitive, taken from PLPLOT bar graph example
+#
+
+pp_def ('plfbox',
+ NoPthread => 1,
+ Pars => 'xo(); yo()',
+ GenericTypes => [D],
+ Code => 'PLFLT x[4], y[4];
+ x[0] = $xo() - 0.5;
+ y[0] = 0.;
+ x[1] = $xo() - 0.5;
+ y[1] = $yo();
+ x[2] = $xo() + 0.5;
+ y[2] = $yo();
+ x[3] = $xo() + 0.5;
+ y[3] = 0.;
+ plfill(4, x, y);',
+ );
+
+#
+## Similar box drawing primitive, but without fill (just draw outline of box)
+#
+pp_def ('plunfbox',
+ NoPthread => 1,
+ Pars => 'xo(); yo()',
+ GenericTypes => [D],
+ Code => 'PLFLT x[4], y[4];
+ x[0] = $xo() - 0.5;
+ y[0] = 0.;
+ x[1] = $xo() - 0.5;
+ y[1] = $yo();
+ x[2] = $xo() + 0.5;
+ y[2] = $yo();
+ x[3] = $xo() + 0.5;
+ y[3] = 0.;
+ plline(4, x, y);',
+ );
+
+#
+## Parse PLplot options given in @ARGV-like arrays
+#
+
+pp_def ('plParseOpts',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'int [o] retval()',
+ OtherPars => 'SV* argv; int mode',
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ SV* sv = $COMP (argv);
+ SV* dummy;
+ AV* arr;
+ int argc, newargc, i, retval;
+ char** args;
+
+ if ( !(SvROK (sv) && SvTYPE (SvRV (sv)) == SVt_PVAV)) {
+ barf("plParseOpts requires an array ref");
+ }
+
+ arr = (AV*) SvRV (sv);
+ newargc = argc = av_len (arr) + 1;
+ if (argc > 0) {
+ New(1, args, argc, char *);
+ if(args == NULL) croak("Failed to allocate memory in plParseOpts");
+
+ for (i = 0; i < argc; i++) {
+ STRLEN len;
+ args[i] = SvPV (* av_fetch (arr, i, 0), len);
+ }
+
+ $retval() = c_plparseopts (&newargc, (const char **)args, $COMP (mode));
+
+ for (i = 0; i < newargc; i++)
+ av_push (arr, newSVpv (args[i], 0));
+
+ for (i = 0; i < argc; i++)
+ dummy = av_shift (arr); /* assign to dummy to suppress compile warning */
+
+ Safefree (args);
+ }
+ ',
+);
+
+# Plots a character at the specified points
+
+pp_def ('plpoin',
+ NoPthread => 1,
+ Pars => 'x(n); y(n); int code()',
+ GenericTypes => [D],
+ Code => 'c_plpoin($SIZE(n),$P(x),$P(y),$code());'
+ );
+
+# Plots a character at the specified points in 3 space
+
+pp_def ('plpoin3',
+ NoPthread => 1,
+ Pars => 'x(n); y(n); z(n); int code()',
+ GenericTypes => [D],
+ Code => 'c_plpoin3($SIZE(n),$P(x),$P(y),$P(z),$code());'
+ );
+
+# Draw a line in 3 space
+
+pp_def ('plline3',
+ NoPthread => 1,
+ Pars => 'x(n); y(n); z(n)',
+ GenericTypes => [D],
+ Code => 'c_plline3($SIZE(n),$P(x),$P(y),$P(z));'
+ );
+
+# Draws a polygon in 3 space
+pp_def ('plpoly3',
+ NoPthread => 1,
+ Pars => 'x(n); y(n); z(n); int draw(m); int ifcc()',
+ GenericTypes => [D],
+ Code => 'c_plpoly3($SIZE(n),$P(x),$P(y),$P(z),$P(draw),$ifcc());'
+ );
+
+# Plot a histogram from unbinned data
+pp_def ('plhist',
+ NoPthread => 1,
+ Pars => 'data(n); datmin(); datmax(); int nbin(); int oldwin()',
+ GenericTypes => [D],
+ Code => 'c_plhist($SIZE(n),$P(data),$datmin(),$datmax(),$nbin(),$oldwin());'
+ );
+
+# Area fill
+pp_def ('plfill',
+ NoPthread => 1,
+ Pars => 'x(n); y(n)',
+ GenericTypes => [D],
+ Code => 'c_plfill($SIZE(n),$P(x),$P(y));'
+ );
+
+# Area fill with color gradient
+pp_def ('plgradient',
+ NoPthread => 1,
+ Pars => 'x(n); y(n); angle();',
+ GenericTypes => [D],
+ Code => 'c_plgradient($SIZE(n),$P(x),$P(y),$angle());'
+ ) if ($plversion->{'c_pllegend'});
+
+# Plots a symbol at the specified points
+pp_def ('plsym',
+ NoPthread => 1,
+ Pars => 'x(n); y(n); int code()',
+ GenericTypes => [D],
+ Code => 'c_plsym($SIZE(n),$P(x),$P(y),$code());'
+ );
+
+# Plot shaded 3-d surface plot
+pp_def ('plsurf3d',
+ NoPthread => 1,
+ Pars => 'x(nx); y(ny); z(nx,ny); int opt(); clevel(nlevel);',
+ GenericTypes => [D],
+ Code => '
+ int i, j, size_x, size_y;
+ PLFLT** zz;
+
+ size_x = $SIZE(nx);
+ size_y = $SIZE(ny);
+ plAlloc2dGrid (&zz, size_x, size_y);
+ for (i = 0; i < size_x; i++)
+ for (j = 0; j < size_y; j++)
+ zz[i][j] = $z(nx => i, ny => j);
+ c_plsurf3d ($P(x), $P(y), (const PLFLT **)zz, size_x, size_y, $opt(),
+ $P(clevel), $SIZE(nlevel));
+ plFree2dGrid (zz, size_x, size_y);'
+ );
+
+# Set line style
+
+pp_def ('plstyl',
+ NoPthread => 1,
+ Pars => 'int mark(nms); int space(nms)',
+ GenericTypes => [D],
+ Code => 'c_plstyl ($SIZE(nms), $P(mark), $P(space));'
+ );
+
+# PLplot standard random number generation. Using this
+# helps to keep the demo plots identical.
+
+if ($plversion->{'c_plseed'}) {
+
+ pp_def ('plseed',
+ NoPthread => 1,
+ Pars => 'int seed()',
+ Code => 'unsigned int useed = (unsigned int)$seed(); c_plseed(useed);'
+ );
+
+ pp_def ('plrandd',
+ NoPthread => 1,
+ Pars => 'double [o]rand()',
+ Code => '$rand() = c_plrandd();'
+ );
+
+} # $plversion->{'c_plseed'}
+
+# Plot contours
+
+
+# pltr0: Identity transformation
+# pltr1: Linear interpolation from singly dimensioned coord arrays
+# Linear interpolation from doubly dimensioned coord arrays
+
+for my $func ('pltr0', 'pltr1', 'pltr2') {
+
+ pp_addxs (<<"EOC");
+void
+$func (x, y, grid)
+ double x
+ double y
+ long grid
+PPCODE:
+ PLFLT tx, ty;
+
+ $func (x, y, &tx, &ty, (PLPointer) grid);
+
+ EXTEND (SP, 2);
+ PUSHs (sv_2mortal (newSVnv ((double) tx)));
+ PUSHs (sv_2mortal (newSVnv ((double) ty)));
+EOC
+
+ pp_add_exported ($func);
+}
+
+
+# Allocates a PLcGrid object for use in pltr1
+
+pp_def ('plAllocGrid',
+ NoPthread => 1,
+ Pars => "double xg(nx); double yg(ny); $pp_ptr_type [o] grid()",
+ GenericTypes => [D],
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ PLcGrid *grid;
+ int i, nx, ny;
+
+ nx = $SIZE(nx);
+ ny = $SIZE(ny);
+
+ New(1, grid, 1, PLcGrid);
+ if(grid == NULL) croak("Failed to allocate memory for grid");
+ Newz(2, grid->xg, nx, PLFLT);
+ if(grid->xg == NULL) croak("Failed to allocate memory for grid->xg");
+ Newz(3, grid->yg, ny, PLFLT);
+ if(grid->yg == NULL) croak("Failed to allocate memory for grid->yg");
+ grid->nx = nx;
+ grid->ny = ny;
+
+ for (i = 0; i < nx; i++)
+ grid->xg[i] = $xg(nx => i);
+
+ for (i = 0; i < ny; i++)
+ grid->yg[i] = $yg(ny => i);
+
+ $grid() = ('.$int_ptr_type.') grid;'
+ );
+
+
+# Free a PLcGrid object
+
+pp_addxs (<<"EOC");
+void
+plFreeGrid (pg)
+ long pg
+PPCODE:
+ PLcGrid* grid = (PLcGrid*) pg;
+ free (grid->xg);
+ free (grid->yg);
+ free (grid);
+EOC
+
+pp_add_exported (plFreeGrid);
+
+
+# Allocates a PLcGrid2 object for use in pltr2
+
+pp_def ('plAlloc2dGrid',
+ NoPthread => 1,
+ Pars => "double xg(nx,ny); double yg(nx,ny); $pp_ptr_type [o] grid()",
+ GenericTypes => [D],
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ PLcGrid2 *grid;
+ int i, j, nx, ny;
+
+ nx = $SIZE(nx);
+ ny = $SIZE(ny);
+
+ grid = (PLcGrid2*) malloc (sizeof (PLcGrid2));
+ plAlloc2dGrid (&(grid->xg), nx, ny);
+ plAlloc2dGrid (&(grid->yg), nx, ny);
+
+ for (i = 0; i < nx; i++)
+ for (j = 0; j < ny; j++) {
+ grid->xg[i][j] = $xg(nx => i, ny => j);
+ grid->yg[i][j] = $yg(nx => i, ny => j);
+ }
+
+ grid->nx = nx;
+ grid->ny = ny;
+
+ $grid() = ('.$int_ptr_type.') grid;'
+ );
+
+
+# Free a PLcGrid2 object
+
+pp_addxs (<<"EOC");
+void
+plFree2dGrid (pg)
+ long pg
+PPCODE:
+ PLcGrid2* grid = (PLcGrid2*) pg;
+ plFree2dGrid (grid->xg, grid->nx, grid->ny);
+ plFree2dGrid (grid->yg, grid->nx, grid->ny);
+ free (grid);
+EOC
+
+pp_add_exported (plFree2dGrid);
+
+pp_addhdr (<<'EOH');
+
+#define check_sub_pointer(subptr, errmsg) \
+ if (SvTRUE (subptr) \
+ && (! SvROK (subptr) || SvTYPE (SvRV (subptr)) != SVt_PVCV)) \
+ croak (errmsg);
+
+static SV* pltr_subroutine;
+
+static IV pltr0_iv;
+static IV pltr1_iv;
+static IV pltr2_iv;
+
+static void
+pltr_callback (PLFLT x, PLFLT y, PLFLT* tx, PLFLT* ty, PLPointer pltr_data)
+{
+ I32 count;
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK (SP);
+ XPUSHs (sv_2mortal (newSVnv ((double) x)));
+ XPUSHs (sv_2mortal (newSVnv ((double) y)));
+ XPUSHs ((SV*) pltr_data);
+ PUTBACK;
+
+ count = call_sv (pltr_subroutine, G_ARRAY);
+
+ SPAGAIN;
+
+ if (count != 2)
+ croak ("pltr: must return two scalars");
+
+ *ty = (PLFLT) POPn;
+ *tx = (PLFLT) POPn;
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+static void*
+get_standard_pltrcb (SV* cb)
+{
+ if ( !SvROK(cb) ) return NULL; /* Added to prevent bug in plshades for 0 input. D. Hunt 12/18/2008 */
+ IV sub = (IV) SvRV (cb);
+
+ if (sub == pltr0_iv)
+ return (void*) pltr0;
+ else if (sub == pltr1_iv)
+ return (void*) pltr1;
+ else if (sub == pltr2_iv)
+ return (void*) pltr2;
+ else
+ return SvTRUE (cb) ? (void*) pltr_callback : NULL;
+}
+
+static SV* defined_subroutine;
+
+static PLINT
+defined_callback (PLFLT x, PLFLT y)
+{
+ I32 count, retval;
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK (SP);
+ XPUSHs (sv_2mortal (newSVnv ((double) x)));
+ XPUSHs (sv_2mortal (newSVnv ((double) y)));
+ PUTBACK;
+
+ count = call_sv (defined_subroutine, G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1)
+ croak ("defined: must return one scalar");
+
+ retval = POPi;
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ return retval;
+}
+
+static SV* mapform_subroutine;
+
+static void default_magic (pdl *p, int pa) { p->data = 0; }
+
+static void
+mapform_callback (PLINT n, PLFLT* x, PLFLT* y)
+{
+ pdl *x_pdl, *y_pdl;
+ PLFLT *tx, *ty;
+ SV *x_sv, *y_sv;
+ int dims, i;
+ I32 count, ax;
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+
+ dims = n;
+
+ x_pdl = PDL->pdlnew ();
+ PDL->add_deletedata_magic(x_pdl, default_magic, 0);
+ PDL->setdims (x_pdl, &dims, 1);
+ x_pdl->datatype = PDL_D;
+ x_pdl->data = x;
+ x_pdl->state |= PDL_DONTTOUCHDATA | PDL_ALLOCATED;
+ x_sv = sv_newmortal ();
+ PDL->SetSV_PDL (x_sv, x_pdl);
+
+ y_pdl = PDL->pdlnew ();
+ PDL->add_deletedata_magic(y_pdl, default_magic, 0);
+ PDL->setdims (y_pdl, &dims, 1);
+ y_pdl->datatype = PDL_D;
+ y_pdl->data = y;
+ y_pdl->state |= PDL_DONTTOUCHDATA | PDL_ALLOCATED;
+ y_sv = sv_newmortal ();
+ PDL->SetSV_PDL (y_sv, y_pdl);
+
+ PUSHMARK (SP);
+ XPUSHs (x_sv);
+ XPUSHs (y_sv);
+ PUTBACK;
+
+ count = call_sv (mapform_subroutine, G_ARRAY);
+
+ SPAGAIN;
+ SP -= count ;
+ ax = (SP - PL_stack_base) + 1;
+
+ if (count != 2)
+ croak ("mapform: must return two piddles");
+
+ tx = (PLFLT*) ((PDL->SvPDLV(ST(0)))->data);
+ ty = (PLFLT*) ((PDL->SvPDLV(ST(1)))->data);
+
+ for (i = 0; i < n; i++) {
+ *(x + i) = *(tx + i);
+ *(y + i) = *(ty + i);
+ }
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+EOH
+
+pp_addhdr (<<'EOH') if ($plversion->{'c_pllegend'});
+
+// Subroutines for adding transforms via plstransform
+static SV* xform_subroutine;
+
+static void
+xform_callback ( PLFLT x, PLFLT y, PLFLT *xt, PLFLT *yt, PLPointer data )
+{
+ SV *x_sv, *y_sv; // Perl scalars for the input x and y
+ I32 count, ax;
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+
+ x_sv = newSVnv((double)x);
+ y_sv = newSVnv((double)y);
+
+ PUSHMARK (SP);
+ XPUSHs (x_sv);
+ XPUSHs (y_sv);
+ PUTBACK;
+
+ count = call_sv (xform_subroutine, G_ARRAY);
+
+ SPAGAIN;
+ SP -= count ;
+ ax = (SP - PL_stack_base) + 1;
+
+ if (count != 2)
+ croak ("xform: must return two perl scalars");
+
+ *xt = (PLFLT) SvNV(ST(0));
+ *yt = (PLFLT) SvNV(ST(1));
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+// Subroutines for adding label formatting via plslabelfunc
+static SV* labelfunc_subroutine;
+
+void labelfunc_callback (PLINT axis, PLFLT value, char *label_text, PLINT length, void *data )
+{
+ SV *axis_sv, *value_sv, *length_sv; // Perl scalars for inputs
+ I32 count, ax;
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+
+ axis_sv = newSViv((IV)axis);
+ value_sv = newSVnv((double)value);
+ length_sv = newSViv((IV)length);
+
+ PUSHMARK (SP);
+ XPUSHs (axis_sv);
+ XPUSHs (value_sv);
+ XPUSHs (length_sv);
+ PUTBACK;
+
+ count = call_sv (labelfunc_subroutine, G_ARRAY);
+
+ SPAGAIN;
+ SP -= count ;
+ ax = (SP - PL_stack_base) + 1;
+
+ if (count != 1)
+ croak ("labelfunc: must return one perl scalar");
+
+ // Copy label into output string
+ snprintf( label_text, length, "%s", (char *)SvPV_nolen(ST(0)) );
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+EOH
+
+# The init_pltr is used internally by the PLD::Graphics::PLplot
+# module to set the variables pltr{0,1,2}_iv to the "pointers"
+# of the Perl subroutines pltr{1,2,3}. These variables are later used by
+# get_standard_pltrcb to provide the pointers to the C function pltr{0,1,2}.
+# This accelerates functions like plcont and plshades when those standard
+# transformation functions are used.
+
+pp_def ('init_pltr',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => '',
+ OtherPars => 'SV* p0; SV* p1; SV* p2;',
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ pltr0_iv = (IV) SvRV ($COMP(p0));
+ pltr1_iv = (IV) SvRV ($COMP(p1));
+ pltr2_iv = (IV) SvRV ($COMP(p2));');
+
+pp_addpm (<<'EOPM');
+init_pltr (\&pltr0, \&pltr1, \&pltr2);
+EOPM
+
+# plot continental outline in world coordinates
+
+pp_addpm ('sub plmap { plmap_pp ($standard_order ? reorder ("plmap", @_) : @_) }'); pp_add_exported('plmap');
+pp_def ('plmap_pp',
+ NoPthread => 1,
+ Pars => 'minlong(); maxlong(); minlat(); maxlat();', # 0-3
+ OtherPars => 'SV* mapform; char* type;', # 4,5
+ GenericTypes => [D],
+ Code => '
+ int use_xform;
+ mapform_subroutine = $COMP(mapform);
+ check_sub_pointer (mapform_subroutine,
+ "plmap: mapform must be either 0 or a subroutine pointer");
+
+ use_xform = SvTRUE ($COMP(mapform));
+ plmap (use_xform ? mapform_callback : NULL,
+ $COMP(type), $minlong(), $maxlong(), $minlat(), $maxlat());',
+ );
+
+# plot a string along a line
+pp_def ('plstring',
+ NoPthread => 1,
+ Pars => 'x(na); y(na);',
+ OtherPars => 'char* string;',
+ GenericTypes => [D],
+ Code => 'c_plstring($SIZE(na), $P(x), $P(y), $COMP(string));',
+ ) if ($plversion->{'c_pllegend'});
+
+# plot a string along a 3D line
+pp_def ('plstring3',
+ NoPthread => 1,
+ Pars => 'x(na); y(na); z(na)',
+ OtherPars => 'char* string;',
+ GenericTypes => [D],
+ Code => 'c_plstring3($SIZE(na), $P(x), $P(y), $P(z), $COMP(string));',
+ ) if ($plversion->{'c_pllegend'});
+
+# Plot the latitudes and longitudes on the background
+pp_addpm ('sub plmeridians { plmeridians_pp ($standard_order ? reorder ("plmeridians", @_) : @_) }'); pp_add_exported('plmeridians');
+pp_def ('plmeridians_pp',
+ NoPthread => 1,
+ Pars => 'dlong(); dlat(); minlong(); maxlong(); minlat(); maxlat();', # 0-5
+ OtherPars => 'SV* mapform;', # 6
+ GenericTypes => [D],
+ Code => '
+ mapform_subroutine = $COMP(mapform);
+ check_sub_pointer (mapform_subroutine,
+ "plmeridians: mapform must be either 0 or a subroutine pointer");
+
+ plmeridians (SvTRUE ($COMP(mapform)) ? mapform_callback : NULL,
+ $dlong(), $dlat(), $minlong(), $maxlong(), $minlat(), $maxlat());'
+ );
+
+# Set the global coordinate transform
+
+# Shade regions on the basis of value
+
+pp_addpm ('sub plshades { plshades_pp ($standard_order ? reorder ("plshades", @_) : @_) }'); pp_add_exported('plshades');
+pp_def ('plshades_pp',
+ NoPthread => 1,
+ Pars => 'z(x,y); xmin(); xmax(); ymin(); ymax();
+ clevel(l); int fill_width(); int cont_color();
+ int cont_width(); int rectangular()', # 0-9
+ OtherPars => 'SV* defined; SV* pltr; SV* pltr_data;', # 10-12
+ GenericTypes => [D],
+ Code => '
+ int nx = $SIZE(x);
+ int ny = $SIZE(y);
+ int nlvl = $SIZE(l);
+ int i, j;
+ PLFLT **z;
+ void (*pltrcb) ();
+ PLPointer pltrdt;
+
+ plAlloc2dGrid (&z, nx, ny);
+
+ for (i = 0; i < nx; i++)
+ for (j = 0; j < ny; j++)
+ z[i][j] = (PLFLT) $z(x => i, y => j);
+
+ defined_subroutine = $COMP(defined);
+ check_sub_pointer (defined_subroutine,
+ "plshades: defined must be either 0 or a subroutine pointer");
+
+ pltr_subroutine = $COMP(pltr);
+ check_sub_pointer (pltr_subroutine,
+ "plshades: pltr must be either 0 or a subroutine pointer");
+
+ pltrcb = get_standard_pltrcb ($COMP(pltr));
+ if (pltrcb != pltr_callback)
+ pltrdt = (PLPointer) SvIV ($COMP(pltr_data));
+ else
+ pltrdt = $COMP(pltr_data);
+
+ c_plshades ((const PLFLT **)z, nx, ny,
+ SvTRUE ($COMP(defined)) ? defined_callback : NULL,
+ $xmin(), $xmax(), $ymin(), $ymax(),
+ $P(clevel), nlvl, $fill_width(), $cont_color(), $cont_width(),
+ plfill, $rectangular(), pltrcb, pltrdt);
+
+ plFree2dGrid(z, nx, ny);',
+ );
+
+pp_def ('plcont',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'f(nx,ny); int kx(); int lx(); int ky(); int ly(); '
+ . 'clevel(nlevel)', # 0-5
+ OtherPars => 'SV* pltr; SV* pltr_data;', # 6,7
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ int i, j, size_x, size_y;
+ PLFLT** ff;
+ void (*pltrcb) ();
+ PLPointer pltrdt;
+
+ size_x = $SIZE(nx);
+ size_y = $SIZE(ny);
+
+ plAlloc2dGrid (&ff, size_x, size_y);
+
+ for (i = 0; i < size_x; i++)
+ for (j = 0; j < size_y; j++)
+ ff[i][j] = $f(nx => i, ny => j);
+
+ pltr_subroutine = $COMP(pltr);
+ check_sub_pointer (pltr_subroutine,
+ "plcont: pltr must be either 0 or a subroutine pointer");
+
+ pltrcb = get_standard_pltrcb ($COMP(pltr));
+ if (pltrcb != pltr_callback)
+ pltrdt = (PLPointer) SvIV ($COMP(pltr_data));
+ else
+ pltrdt = $COMP(pltr_data);
+
+ c_plcont ((const PLFLT **)ff, size_x, size_y, $kx(), $lx(), $ky(), $ly(),
+ $P(clevel), $SIZE(nlevel),
+ pltrcb, pltrdt);
+
+ plFree2dGrid (ff, size_x, size_y);'
+ );
+
+
+# Surface mesh
+
+pp_def ('plmesh',
+ NoPthread => 1,
+ Pars => 'x(nx); y(ny); z(nx,ny); int opt()',
+ GenericTypes => [D],
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ int i, j, size_x, size_y;
+ PLFLT** zz;
+
+ size_x = $SIZE(nx);
+ size_y = $SIZE(ny);
+
+ plAlloc2dGrid (&zz, size_x, size_y);
+
+ for (i = 0; i < size_x; i++)
+ for (j = 0; j < size_y; j++)
+ zz[i][j] = $z(nx => i, ny => j);
+
+ c_plmesh ($P(x), $P(y), (const PLFLT **)zz, size_x, size_y, $opt());
+
+ plFree2dGrid (zz, size_x, size_y);'
+ );
+
+# Magnitude colored plot surface mesh with contour
+
+pp_def ('plmeshc',
+ NoPthread => 1,
+ Pars => 'x(nx); y(ny); z(nx,ny); int opt(); clevel(nlevel)',
+ GenericTypes => [D],
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ int i, j, size_x, size_y;
+ PLFLT** zz;
+
+ size_x = $SIZE(nx);
+ size_y = $SIZE(ny);
+
+ plAlloc2dGrid (&zz, size_x, size_y);
+
+ for (i = 0; i < size_x; i++)
+ for (j = 0; j < size_y; j++)
+ zz[i][j] = $z(nx => i, ny => j);
+
+ c_plmeshc ($P(x), $P(y), (const PLFLT **)zz, size_x, size_y, $opt(),
+ $P(clevel), $SIZE(nlevel));
+
+ plFree2dGrid (zz, size_x, size_y);'
+ );
+
+# 3-d surface plot
+
+pp_def ('plot3d',
+ NoPthread => 1,
+ Pars => 'x(nx); y(ny); z(nx,ny); int opt(); int side()',
+ GenericTypes => [D],
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ int i, j, size_x, size_y;
+ PLFLT** zz;
+
+ size_x = $SIZE(nx);
+ size_y = $SIZE(ny);
+
+ plAlloc2dGrid (&zz, size_x, size_y);
+
+ for (i = 0; i < size_x; i++)
+ for (j = 0; j < size_y; j++)
+ zz[i][j] = $z(nx => i, ny => j);
+
+ c_plot3d ($P(x), $P(y), (const PLFLT **)zz, size_x, size_y, $opt(), $side());
+
+ plFree2dGrid (zz, size_x, size_y);'
+ );
+
+
+# Plots a 3-d representation of the function z[x][y] with contour
+
+pp_def ('plot3dc',
+ NoPthread => 1,
+ Pars => 'x(nx); y(ny); z(nx,ny); int opt(); clevel(nlevel)',
+ GenericTypes => [D],
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ int i, j, size_x, size_y;
+ PLFLT** zz;
+
+ size_x = $SIZE(nx);
+ size_y = $SIZE(ny);
+
+ plAlloc2dGrid (&zz, size_x, size_y);
+
+ for (i = 0; i < size_x; i++)
+ for (j = 0; j < size_y; j++)
+ zz[i][j] = $z(nx => i, ny => j);
+
+ c_plot3dc ($P(x), $P(y), (const PLFLT **)zz, size_x, size_y, $opt(),
+ $P(clevel), $SIZE(nlevel));
+
+ plFree2dGrid (zz, size_x, size_y);'
+ );
+
+
+# Set color map1 colors using a piece-wise linear relationship
+
+pp_def ('plscmap1l',
+ NoPthread => 1,
+ Pars => 'int itype(); isty(n); coord1(n); coord2(n); coord3(n);'
+ . ' int rev(nrev)',
+ GenericTypes => [D],
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ PLINT* rev;
+
+ if ($SIZE(nrev) == 0)
+ rev = NULL;
+ else if ($SIZE(nrev) == $SIZE(n))
+ rev = $P(rev);
+ else
+ croak ("plscmap1l: rev must have either lenght == 0 or have the same length of the other input arguments");
+
+ c_plscmap1l ($itype(), $SIZE(n), $P(isty), $P(coord1),
+ $P(coord2), $P(coord3), rev);'
+ );
+
+# Shade individual region on the basis of value
+
+pp_addpm ('sub plshade1 { plshade1_pp ($standard_order ? reorder ("plshade1", @_) : @_) }'); pp_add_exported('plshade1');
+pp_def ('plshade1_pp',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'a(nx,ny); left(); right(); bottom(); top(); shade_min();'
+ . 'shade_max(); sh_cmap(); sh_color(); sh_width();'
+ . 'min_color(); min_width(); max_color(); max_width();'
+ . 'rectangular()', # 0-14
+ OtherPars => 'SV* defined; SV* pltr; SV* pltr_data;',# 15-17
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ int i, j, size_x, size_y;
+ PLFLT* a;
+ void (*pltrcb) ();
+ PLPointer pltrdt;
+
+ size_x = $SIZE(nx);
+ size_y = $SIZE(ny);
+
+ New(3, a, size_x * size_y, PLFLT);
+ if(a == NULL) croak("Failed to allocate memory in plshade1_pp");
+
+ for (i = 0; i < size_x; i++)
+ for (j = 0; j < size_y; j++)
+ a[i * size_y + j] = (PLFLT) $a(nx => i, ny => j);
+
+ defined_subroutine = $COMP(defined);
+ check_sub_pointer (defined_subroutine,
+ "plshade1: defined must be either 0 or a subroutine pointer");
+
+ pltr_subroutine = $COMP(pltr);
+ check_sub_pointer (pltr_subroutine,
+ "plshade1: pltr must be either 0 or a subroutine pointer");
+
+ pltrcb = get_standard_pltrcb ($COMP(pltr));
+ if (pltrcb != pltr_callback)
+ pltrdt = (PLPointer) SvIV ($COMP(pltr_data));
+ else
+ pltrdt = $COMP(pltr_data);
+
+ c_plshade1 (a, size_x, size_y,
+ SvTRUE ($COMP(defined)) ? defined_callback : NULL,
+ $left(), $right(), $bottom(), $top(),
+ $shade_min(), $shade_max(), $sh_cmap(), $sh_color(), $sh_width(),
+ $min_color(), $min_width(), $max_color(), $max_width(),
+ plfill, $rectangular(), pltrcb, pltrdt);
+
+ Safefree (a);'
+ );
+
+# Plot gray-level image
+
+pp_def ('plimage',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'idata(nx,ny); xmin(); xmax(); ymin(); ymax();'
+ . 'zmin(); zmax(); Dxmin(); Dxmax(); Dymin(); Dymax();',
+ Code => '
+ int i, j, size_x, size_y;
+ PLFLT** idata;
+
+ size_x = $SIZE(nx);
+ size_y = $SIZE(ny);
+
+ plAlloc2dGrid (&idata, size_x, size_y);
+
+ for (i = 0; i < size_x; i++)
+ for (j = 0; j < size_y; j++)
+ idata[i][j] = $idata(nx => i, ny => j);
+
+ plimage ((const PLFLT **)idata, size_x, size_y,
+ $xmin(), $xmax(), $ymin(), $ymax(), $zmin(), $zmax(),
+ $Dxmin(), $Dxmax(), $Dymin(), $Dymax());
+
+ plFree2dGrid (idata, size_x, size_y);'
+ );
+
+
+# Plot image with transformation
+
+if ($plversion->{'c_plimagefr'}) {
+
+ pp_def ('plimagefr',
+ NoPthread => 1,
+ GenericTypes => [D],
+ # plimagefr (idata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax, pltr, pltr_data);
+ # plimagefr ($img, 0, $width, 0, $height, 0, 0, $img_min, $img_max, \&pltr2, $grid);
+ Pars => 'idata(nx,ny); xmin(); xmax(); ymin(); ymax();'
+ . 'zmin(); zmax(); valuemin(); valuemax();', # 0-8
+ OtherPars => 'SV* pltr; SV* pltr_data;', # 9,10
+ Code => '
+ int i, j, size_x, size_y;
+ PLFLT** idata;
+ void (*pltrcb) ();
+ PLPointer pltrdt;
+
+ size_x = $SIZE(nx);
+ size_y = $SIZE(ny);
+
+ pltr_subroutine = $COMP(pltr);
+ check_sub_pointer (pltr_subroutine, "plimagefr: pltr must be either 0 or a subroutine pointer");
+
+ pltrcb = get_standard_pltrcb ($COMP(pltr));
+ if (pltrcb != pltr_callback)
+ pltrdt = (PLPointer) SvIV ($COMP(pltr_data));
+ else
+ pltrdt = $COMP(pltr_data);
+
+ plAlloc2dGrid (&idata, size_x, size_y);
+
+ for (i = 0; i < size_x; i++)
+ for (j = 0; j < size_y; j++)
+ idata[i][j] = $idata(nx => i, ny => j);
+
+ c_plimagefr ((const PLFLT **)idata, size_x, size_y,
+ $xmin(), $xmax(), $ymin(), $ymax(), $zmin(), $zmax(),
+ $valuemin(), $valuemax(),
+ (SvTRUE ($COMP(pltr)) ? pltrcb : NULL),
+ (SvTRUE ($COMP(pltr)) ? pltrdt : NULL));
+
+ plFree2dGrid (idata, size_x, size_y);'
+ );
+
+} # $plversion->{'c_plimagefr'}
+
+# Set xor mode:
+# mode = 1-enter, 0-leave, status = 0 if not interactive device
+
+pp_addpm (<<'EOPM');
+=head2 plxormod
+
+=for sig
+
+ $status = plxormod ($mode)
+
+=for ref
+
+See the PLplot manual for reference.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+int
+plxormod (mode)
+ int mode
+CODE:
+ PLINT status;
+ c_plxormod (mode, &status);
+ RETVAL = status;
+OUTPUT:
+ RETVAL
+EOC
+
+pp_add_exported ('plxormod');
+
+# Wait for graphics input event and translate to world coordinates
+
+pp_addpm (<<'EOPM');
+=head2 plGetCursor
+
+=for sig
+
+ %gin = plGetCursor ()
+
+=for ref
+
+plGetCursor waits for graphics input event and translate to world
+coordinates and returns a hash with the following keys:
+
+ type: of event (CURRENTLY UNUSED)
+ state: key or button mask
+ keysym: key selected
+ button: mouse button selected
+ subwindow: subwindow (alias subpage, alias subplot) number
+ string: translated string
+ pX, pY: absolute device coordinates of pointer
+ dX, dY: relative device coordinates of pointer
+ wX, wY: world coordinates of pointer
+
+Returns an empty hash if no translation to world coordinates is possible.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+void
+plGetCursor ()
+PPCODE:
+ PLGraphicsIn gin;
+ if (plGetCursor (&gin)) {
+ EXTEND (SP, 24);
+ PUSHs (sv_2mortal (newSVpv ("type", 0)));
+ PUSHs (sv_2mortal (newSViv ((IV) gin.type)));
+ PUSHs (sv_2mortal (newSVpv ("state", 0)));
+ PUSHs (sv_2mortal (newSVuv ((UV) gin.state)));
+ PUSHs (sv_2mortal (newSVpv ("keysym", 0)));
+ PUSHs (sv_2mortal (newSVuv ((UV) gin.keysym)));
+ PUSHs (sv_2mortal (newSVpv ("button", 0)));
+ PUSHs (sv_2mortal (newSVuv ((UV) gin.button)));
+ PUSHs (sv_2mortal (newSVpv ("subwindow", 0)));
+ PUSHs (sv_2mortal (newSViv ((IV) gin.subwindow)));
+ PUSHs (sv_2mortal (newSVpv ("string", 0)));
+ PUSHs (sv_2mortal (newSVpv (gin.string, 0)));
+ PUSHs (sv_2mortal (newSVpv ("pX", 0)));
+ PUSHs (sv_2mortal (newSViv ((IV) gin.pX)));
+ PUSHs (sv_2mortal (newSVpv ("pY", 0)));
+ PUSHs (sv_2mortal (newSViv ((IV) gin.pY)));
+ PUSHs (sv_2mortal (newSVpv ("dX", 0)));
+ PUSHs (sv_2mortal (newSVnv ((double) gin.dX)));
+ PUSHs (sv_2mortal (newSVpv ("dY", 0)));
+ PUSHs (sv_2mortal (newSVnv ((double) gin.dY)));
+ PUSHs (sv_2mortal (newSVpv ("wX", 0)));
+ PUSHs (sv_2mortal (newSVnv ((double) gin.wX)));
+ PUSHs (sv_2mortal (newSVpv ("wY", 0)));
+ PUSHs (sv_2mortal (newSVnv ((double) gin.wY)));
+ }
+EOC
+
+pp_add_exported ('plGetCursor');
+
+pp_addpm (<<'EOPM');
+=head2 plgstrm
+
+=for sig
+
+ $strm = plgstrm ()
+
+=for ref
+
+Returns the number of the current output stream.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+int
+plgstrm ()
+CODE:
+ PLINT strm;
+ c_plgstrm (&strm);
+ RETVAL = strm;
+OUTPUT:
+ RETVAL
+EOC
+
+pp_add_exported ('plgstrm');
+
+pp_addpm (<<'EOPM');
+=head2 plgsdev
+
+=for sig
+
+ $driver = plgdev ()
+
+=for ref
+
+Returns the current driver name.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+char*
+plgdev ()
+CODE:
+ char driver[80];
+ c_plgdev (driver);
+ RETVAL = driver;
+OUTPUT:
+ RETVAL
+EOC
+
+pp_add_exported ('plgdev');
+
+pp_addxs (<<"EOC");
+char*
+plgfnam ()
+CODE:
+ char driver[80];
+ c_plgfnam (driver);
+ RETVAL = driver;
+OUTPUT:
+ RETVAL
+EOC
+
+pp_add_exported ('plgfnam');
+
+pp_addpm (<<'EOPM');
+=head2 plmkstrm
+
+=for sig
+
+ $strm = plmkstrm ()
+
+=for ref
+
+Creates a new stream and makes it the default. Returns the number of
+the created stream.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+int
+plmkstrm ()
+CODE:
+ PLINT strm;
+ c_plmkstrm (&strm);
+ RETVAL = strm;
+OUTPUT:
+ RETVAL
+EOC
+
+pp_add_exported ('plmkstrm');
+
+# Get the current library version number
+
+pp_addpm (<<'EOPM');
+=head2 plgver
+
+=for sig
+
+ $version = plgver ()
+
+=for ref
+
+See the PLplot manual for reference.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+char*
+plgver ()
+CODE:
+ char ver[80];
+ c_plgver (ver);
+ RETVAL = ver;
+OUTPUT:
+ RETVAL
+EOC
+
+pp_add_exported ('plgver');
+
+
+#----------------------------------------------------------------------------
+
+pp_addpm ('sub plstripc { plstripc_pp ($standard_order ? reorder ("plstripc", @_) : @_) }'); pp_add_exported('plstripc');
+pp_def ('plstripc_pp',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'xmin(); xmax(); xjump(); ymin(); ymax();'
+ . 'xlpos(); ylpos(); int y_ascl(); int acc();'
+ . 'int colbox(); int collab();'
+ . 'int colline(n); int styline(n); int [o] id()', # 0-12
+ OtherPars => 'char* xspec; char* yspec; SV* legline;' # 13-18
+ . 'char* labx; char* laby; char* labtop',
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ I32 i;
+ PLINT id;
+ char* legline[4];
+ SV* sv_legline = $COMP(legline);
+ AV* av_legline;
+
+ if (! SvROK (sv_legline)
+ || SvTYPE (SvRV (sv_legline)) != SVt_PVAV)
+ croak ("plstripc: legline must be a reference to an array");
+
+ av_legline = (AV*) SvRV (sv_legline);
+
+ if (av_len (av_legline) != 3)
+ croak ("plstripc: legline must have four elements");
+
+ if ($SIZE(n) != 4)
+ croak ("plstripc: colline and styline must have four elements");
+
+ for (i = 0; i < 4; i++) {
+ SV** elem = av_fetch (av_legline, i, 0);
+ legline[i] = (char *) SvPV_nolen (*elem);
+ }
+
+ c_plstripc (&id, $COMP(xspec), $COMP(yspec),
+ $xmin(), $xmax(), $xjump(), $ymin(), $ymax(),
+ $xlpos(), $ylpos(),$y_ascl(), $acc(), $colbox(), $collab(),
+ $P(colline), $P(styline), (const char **)legline,
+ $COMP(labx), $COMP(laby), $COMP(labtop));
+
+ $id() = (int) id;'
+ );
+
+#----------------------------------------------------------------------------
+
+pp_def ('plgriddata',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'x(npts); y(npts); z(npts); xg(nptsx); yg(nptsy);'
+ . 'int type(); data(); [o] zg(nptsx,nptsy)',
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ int i, j, size_x, size_y;
+ PLFLT** zg;
+
+ size_x = $SIZE(nptsx);
+ size_y = $SIZE(nptsy);
+
+ plAlloc2dGrid (&zg, size_x, size_y);
+
+ c_plgriddata ($P(x), $P(y), $P(z), $SIZE(npts),
+ $P(xg), size_x, $P(yg), size_y,
+ zg, $type(), $data());
+
+ for (i = 0; i < size_x; i++)
+ for (j = 0; j < size_y; j++)
+ $zg(nptsx => i, nptsy => j) = zg[i][j];
+
+ plFree2dGrid (zg, size_x, size_y);
+ '
+ );
+
+#-----------------------------------------------------------------------------
+
+if ($plversion->{'c_pllegend'}) {
+
+# Draw an arc
+pp_addpm (<<'EOPM');
+=head2 plarc
+
+=for sig
+
+ plarc ($x, $y, $a, $b, $angle1, $angle2, $rotate, $fill);
+
+=for ref
+
+Draw a (possibly) filled arc centered at x, y with semimajor axis a and semiminor axis b, starting at angle1 and ending at angle2.
+See the PLplot manual for reference.
+
+=cut
+EOPM
+pp_addxs (<<"EOC");
+int
+plarc (x, y, a, b, angle1, angle2, rotate, fill)
+ double x
+ double y
+ double a
+ double b
+ double angle1
+ double angle2
+ double rotate
+ int fill
+CODE:
+ plarc (x, y, a, b, angle1, angle2, rotate, fill);
+EOC
+pp_add_exported ('plarc');
+
+#----------------------------------------------------------------------------
+
+pp_addpm (<<'EOPM');
+=head2 plstransform
+
+=for sig
+
+ plstransform ($subroutine_reference);
+
+=for ref
+
+Sets the default transformation routine for plotting.
+
+ sub mapform {
+ my ($x, $y) = @_;
+
+ my $radius = 90.0 - $y;
+ my $xp = $radius * cos ($x * pi / 180);
+ my $yp = $radius * sin ($x * pi / 180);
+
+ return ($xp, $yp);
+ }
+ plstransform (\&mapform);
+
+See the PLplot manual for more details.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+int
+plstransform (xform)
+ SV* xform
+CODE:
+ check_sub_pointer (xform_subroutine, "plstransform: xform must be either 0 or a subroutine pointer");
+ if (SvTRUE(xform)) xform_subroutine = SvRV(xform);
+ plstransform (SvTRUE(xform) ? xform_callback : NULL, NULL);
+EOC
+pp_add_exported ('plstransform');
+
+#----------------------------------------------------------------------------
+
+pp_addpm (<<'EOPM');
+=head2 plslabelfunc
+
+=for sig
+
+ plslabelfunc ($subroutine_reference);
+
+=for ref
+
+ # A custom axis labeling function for longitudes and latitudes.
+ sub geolocation_labeler {
+ my ($axis, $value, $length) = @_;
+ my ($direction_label, $label_val);
+ if (($axis == PL_Y_AXIS) && $value == 0) {
+ return "Eq";
+ } elsif ($axis == PL_Y_AXIS) {
+ $label_val = $value;
+ $direction_label = ($label_val > 0) ? " N" : " S";
+ } elsif ($axis == PL_X_AXIS) {
+ my $times = floor((abs($value) + 180.0 ) / 360.0);
+ $label_val = ($value < 0) ? $value + 360.0 * $times : $value - 360.0 * $times;
+ $direction_label = ($label_val > 0) ? " E"
+ : ($label_val < 0) ? " W"
+ : "";
+ }
+ return substr (sprintf ("%.0f%s", abs($label_val), $direction_label), 0, $length);
+ }
+ plslabelfunc(\&geolocation_labeler);
+
+See the PLplot manual for more details.
+
+=cut
+EOPM
+
+# The PDL version of plslabelfunc only has one argument--the perl subroutine
+# to do the label translation: my $labeltext = perl_labelfunc($axis, $value, $length);
+# No 'data' argument is used, it is assumed that global data or a closure containing
+# necessary data can be used in 'perl_labelfunc'.
+pp_addxs (<<"EOC");
+int
+plslabelfunc (labelfunc)
+ SV* labelfunc
+CODE:
+ check_sub_pointer (labelfunc_subroutine, "plslabelfunc: labelfunc must be either 0 or a subroutine pointer");
+ if (SvTRUE(labelfunc)) labelfunc_subroutine = SvRV(labelfunc);
+ plslabelfunc (SvTRUE(labelfunc) ? labelfunc_callback : NULL, NULL);
+EOC
+pp_add_exported ('plslabelfunc');
+
+#----------------------------------------------------------------------------
+
+pp_addpm (<<'EOPM');
+=head2 pllegend
+
+=for sig
+
+my ($legend_width, $legend_height) =
+ pllegend ($position, $opt, $x, $y, $plot_width, $bg_color, $nlegend,
+ \@opt_array,
+ $text_offset, $text_scale, $text_spacing, $test_justification,
+ \@text_colors, \@text, \@box_colors, \@box_patterns, \@box_scales, \@line_colors,
+ \@line_styles, \@line_widths, \@symbol_colors, \@symbol_scales, \@symbol_numbers, \@symbols);
+
+=for ref
+
+See the PLplot manual for more details.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+void
+pllegend(opt, position, x, y, plot_width, bg_color, bb_color, bb_style, nrow, ncolumn, nlegend, opt_array_rv, text_offset, text_scale, text_spacing, text_justification, text_colors_rv, text_rv, box_colors_rv, box_patterns_rv, box_scales_rv, box_line_widths_rv, line_colors_rv, line_styles_rv, line_widths_rv, symbol_colors_rv, symbol_scales_rv, symbol_numbers_rv, symbols_rv)
+ int opt
+ int position
+ double x
+ double y
+ double plot_width
+ int bg_color
+ int bb_color
+ int bb_style
+ int nrow
+ int ncolumn
+ int nlegend
+ SV* opt_array_rv
+ double text_offset
+ double text_scale
+ double text_spacing
+ double text_justification
+ SV* text_colors_rv
+ SV* text_rv
+ SV* box_colors_rv
+ SV* box_patterns_rv
+ SV* box_scales_rv
+ SV* box_line_widths_rv
+ SV* line_colors_rv
+ SV* line_styles_rv
+ SV* line_widths_rv
+ SV* symbol_colors_rv
+ SV* symbol_scales_rv
+ SV* symbol_numbers_rv
+ SV* symbols_rv
+PPCODE:
+ int i;
+ double p_legend_width;
+ double p_legend_height;
+ int opt_array[nlegend];
+ int text_colors[nlegend];
+ char *text[nlegend];
+ int box_colors[nlegend];
+ int box_patterns[nlegend];
+ double box_scales[nlegend];
+ int box_line_widths[nlegend];
+ int line_colors[nlegend];
+ int line_styles[nlegend];
+ int line_widths[nlegend];
+ int symbol_colors[nlegend];
+ double symbol_scales[nlegend];
+ int symbol_numbers[nlegend];
+ char *symbols[nlegend];
+ SV **elem;
+
+ for (i = 0; i < nlegend; i++) {
+
+ elem = av_fetch((AV *)SvRV(opt_array_rv), i, 0); opt_array[i] = (int)SvIV(*elem);
+ elem = av_fetch((AV *)SvRV(text_colors_rv), i, 0); text_colors[i] = (int)SvIV(*elem);
+ elem = av_fetch((AV *)SvRV(text_rv), i, 0); text[i] = (char *)SvPV_nolen(*elem);
+ box_colors[i] = 0;
+ if (SvROK(box_colors_rv)) {
+ elem = av_fetch((AV *)SvRV(box_colors_rv), i, 0);
+ if (elem && SvOK(*elem)) {
+ box_colors[i] = (int)SvIV(*elem);
+ }
+ }
+ box_patterns[i] = 0;
+ if (SvROK(box_patterns_rv)) {
+ elem = av_fetch((AV *)SvRV(box_patterns_rv), i, 0);
+ if (elem && SvOK(*elem)) {
+ box_patterns[i] = (int)SvIV(*elem);
+ }
+ }
+ box_scales[i] = 0.0;
+ if (SvROK(box_scales_rv)) {
+ elem = av_fetch((AV *)SvRV(box_scales_rv), i, 0);
+ if (elem && SvOK(*elem)) {
+ box_scales[i] = (double)SvNV(*elem);
+ }
+ }
+ box_line_widths[i] = 0;
+ if (SvROK(box_line_widths_rv)) {
+ elem = av_fetch((AV *)SvRV(box_line_widths_rv), i, 0);
+ if (elem && SvOK(*elem)) {
+ box_line_widths[i] = (int)SvIV(*elem);
+ }
+ }
+ line_colors[i] = 0;
+ if (SvROK(line_colors_rv)) {
+ elem = av_fetch((AV *)SvRV(line_colors_rv), i, 0);
+ if (elem && SvOK(*elem)) {
+ line_colors[i] = (int)SvIV(*elem);
+ }
+ }
+
+ line_styles[i] = 0;
+ if (SvROK(line_styles_rv)) {
+ elem = av_fetch((AV *)SvRV(line_styles_rv), i, 0);
+ if (elem && SvOK(*elem)) {
+ line_styles[i] = (int)SvIV(*elem);
+ }
+ }
+
+ line_widths[i] = 0;
+ if (SvROK(line_widths_rv)) {
+ elem = av_fetch((AV *)SvRV(line_widths_rv), i, 0);
+ if (elem && SvOK(*elem)) {
+ line_widths[i] = (int)SvIV(*elem);
+ }
+ }
+
+ symbol_colors[i] = 0;
+ if (SvROK(symbol_colors_rv)) {
+ elem = av_fetch((AV *)SvRV(symbol_colors_rv), i, 0);
+ if (elem && SvOK(*elem)) {
+ symbol_colors[i] = (int)SvIV(*elem);
+ }
+ }
+
+ symbol_scales[i] = 0.0;
+ if (SvROK(symbol_scales_rv)) {
+ elem = av_fetch((AV *)SvRV(symbol_scales_rv), i, 0);
+ if (elem && SvOK(*elem)) {
+ symbol_scales[i] = (double)SvNV(*elem);
+ }
+ }
+
+ symbol_numbers[i] = 0;
+ if (SvROK(symbol_numbers_rv)) {
+ elem = av_fetch((AV *)SvRV(symbol_numbers_rv), i, 0);
+ if (elem && SvOK(*elem)) {
+ symbol_numbers[i] = (int)SvIV(*elem);
+ }
+ }
+
+ symbols[i] = "0";
+ if (SvROK(symbols_rv)) {
+ elem = av_fetch((AV *)SvRV(symbols_rv), i, 0);
+ if (elem && SvOK(*elem)) {
+ symbols[i] = (char *)SvPV_nolen(*elem);
+ }
+ }
+ }
+
+ pllegend(&p_legend_width, &p_legend_height,
+ opt, position, x, y, plot_width, bg_color, bb_color, bb_style, nrow, ncolumn, nlegend,
+ opt_array,
+ text_offset, text_scale, text_spacing, text_justification,
+ text_colors, (const char **)text, box_colors, box_patterns, box_scales, box_line_widths,
+ line_colors, line_styles, line_widths, symbol_colors, symbol_scales, symbol_numbers, (const char **)symbols);
+
+ EXTEND (SP, 2);
+ PUSHs (sv_2mortal (newSVnv (p_legend_width)));
+ PUSHs (sv_2mortal (newSVnv (p_legend_height)));
+EOC
+pp_add_exported ('pllegend');
+
+#----------------------------------------------------------------------------
+
+pp_addpm (<<'EOPM');
+=head2 plspal0
+
+=for sig
+
+ plspal0($filename);
+
+=for ref
+
+Set color palette 0 from the input .pal file. See the PLplot manual for more details.
+
+=cut
+EOPM
+
+# The PDL version of plspal0
+pp_addxs (<<"EOC");
+int
+plspal0 (filename)
+ char* filename
+PPCODE:
+ plspal0((const char *)filename);
+EOC
+pp_add_exported ('plspal0');
+
+#----------------------------------------------------------------------------
+
+# The PDL version of plspal1
+pp_addpm (<<'EOPM');
+=head2 plspal1
+
+=for sig
+
+ plspal1($filename);
+
+=for ref
+
+Set color palette 1 from the input .pal file. See the PLplot manual for more details.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+int
+plspal1 (filename, interpolate)
+ char* filename
+ int interpolate
+PPCODE:
+ plspal1((const char *)filename, (PLBOOL)interpolate);
+EOC
+pp_add_exported ('plspal1');
+
+} # if $plversion->{'c_pllegend'}
+
+#-----------------------------------------------------------------------------------------
+
+pp_addpm (<<'EOPM');
+=head2 plbtime
+
+=for sig
+
+ my ($year, $month, $day, $hour, $min, $sec) = plbtime($ctime);
+
+=for ref
+
+ Calculate broken-down time from continuous time for current stream.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+void
+plbtime (ctime)
+ double ctime
+PPCODE:
+ PLINT year;
+ PLINT month;
+ PLINT day;
+ PLINT hour;
+ PLINT min;
+ PLFLT sec;
+ c_plbtime(&year, &month, &day, &hour, &min, &sec, ctime);
+ EXTEND (SP, 6);
+ PUSHs (sv_2mortal (newSViv (year)));
+ PUSHs (sv_2mortal (newSViv (month)));
+ PUSHs (sv_2mortal (newSViv (day)));
+ PUSHs (sv_2mortal (newSViv (hour)));
+ PUSHs (sv_2mortal (newSViv (min)));
+ PUSHs (sv_2mortal (newSVnv (sec)));
+EOC
+pp_add_exported ('plbtime');
+
+#-----------------------------------------------------------------------------------------
+
+pp_addpm (<<'EOPM');
+=head2 plconfigtime
+
+=for sig
+
+ plconfigtime($scale, $offset1, $offset2, $ccontrol, $ifbtime_offset, $year, $month, $day, $hour, $min, $sec);
+
+=for ref
+
+Configure transformation between continuous and broken-down time (and
+vice versa) for current stream.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+void
+plconfigtime(scale, offset1, offset2, ccontrol, ifbtime_offset, year, month, day, hour, min, sec)
+ double scale
+ double offset1
+ double offset2
+ int ccontrol
+ int ifbtime_offset
+ int year
+ int month
+ int day
+ int hour
+ int min
+ double sec
+PPCODE:
+ c_plconfigtime((PLFLT) scale, (PLFLT) offset1, (PLFLT) offset2,
+ (PLINT) ccontrol, (PLBOOL) ifbtime_offset, (PLINT) year,
+ (PLINT) month, (PLINT) day, (PLINT) hour, (PLINT) min, (PLFLT) sec);
+EOC
+pp_add_exported ('plconfigtime');
+
+#-----------------------------------------------------------------------------------------
+
+pp_addpm (<<'EOPM');
+=head2 plctime
+
+=for sig
+
+ my $ctime = plctime($year, $month, $day, $hour, $min, $sec);
+
+=for ref
+
+ Calculate continuous time from broken-down time for current stream.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+void
+plctime(year, month, day, hour, min, sec)
+ int year
+ int month
+ int day
+ int hour
+ int min
+ double sec
+PPCODE:
+ PLFLT ctime;
+ c_plctime(year, month, day, hour, min, sec, &ctime);
+ EXTEND (SP, 1);
+ PUSHs (sv_2mortal (newSVnv (ctime)));
+EOC
+pp_add_exported ('plctime');
+
+#-----------------------------------------------------------------------------------------
+
+pp_addpm (<<'EOPM');
+=head2 pltimefmt
+
+=for sig
+
+ pltimefmt($fmt);
+
+=for ref
+
+Set format for date / time labels. See the PLplot manual for more details.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+void
+pltimefmt(fmt)
+ char *fmt
+PPCODE:
+ c_pltimefmt((const char *)fmt);
+EOC
+pp_add_exported ('pltimefmt');
+
+#-----------------------------------------------------------------------------------------
+
+pp_addpm (<<'EOPM');
+=head2 plsesc
+
+=for sig
+
+ plsesc($esc);
+
+=for ref
+
+
+Set the escape character for text strings. See the PLplot manual for more details.
+
+=cut
+EOPM
+
+pp_addxs (<<"EOC");
+void
+plsesc (esc)
+ SV* esc
+PPCODE:
+ char *esc_c;
+ esc_c = (char *)SvPV_nolen(esc);
+ c_plsesc((char)*esc_c);
+
+EOC
+pp_add_exported ('plsesc');
+
+if ($plversion->{'plsvect'}) {
+
+# Vector field plots
+
+ pp_def ('plvect',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'u(nx,ny); v(nx,ny); scale();',
+ OtherPars => 'SV* pltr; SV* pltr_data;',
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ int i, j, size_x, size_y;
+ PLFLT** u;
+ PLFLT** v;
+ void (*pltrcb) ();
+ PLPointer pltrdt;
+
+ size_x = $SIZE(nx);
+ size_y = $SIZE(ny);
+
+ plAlloc2dGrid (&u, size_x, size_y);
+ plAlloc2dGrid (&v, size_x, size_y);
+
+ for (i = 0; i < size_x; i++)
+ for (j = 0; j < size_y; j++) {
+ u[i][j] = $u(nx => i, ny => j);
+ v[i][j] = $v(nx => i, ny => j);
+ }
+
+ pltr_subroutine = $COMP(pltr);
+ check_sub_pointer (pltr_subroutine,
+ "plvect: pltr must be either 0 or a subroutine pointer");
+
+ pltrcb = get_standard_pltrcb ($COMP(pltr));
+ if (pltrcb != pltr_callback)
+ pltrdt = (PLPointer) SvIV ($COMP(pltr_data));
+ else
+ pltrdt = $COMP(pltr_data);
+
+ plvect ((const PLFLT **)u, (const PLFLT **)v, size_x, size_y, $scale(), pltrcb, pltrdt);
+
+ plFree2dGrid (u, size_x, size_y);
+ plFree2dGrid (v, size_x, size_y);'
+ );
+
+ pp_def ('plsvect',
+ NoPthread => 1,
+ Pars => 'arrowx(npts); arrowy(npts); int fill()',
+ GenericTypes => [D],
+ Code => 'c_plsvect ($P(arrowx), $P(arrowy), $SIZE(npts), $fill());'
+ );
+ }
+
+ pp_def ('plhlsrgb',
+ NoPthread => 1,
+ GenericTypes => [D],
+ Pars => 'double h();double l();double s();double [o]p_r();double [o]p_g();double [o]p_b()',
+ Code => 'c_plhlsrgb($h(),$l(),$s(),$P(p_r),$P(p_g),$P(p_b));'
+ );
+
+ # void c_plgcol0(PLINT icol0, PLINT *r, PLINT *g, PLINT *b);
+ pp_def ('plgcol0',
+ NoPthread => 1,
+ Pars => 'int icolzero(); int [o]r(); int [o]g(); int [o]b()',
+ Code => 'c_plgcol0($icolzero(),$P(r),$P(g),$P(b));'
+ );
+
+ # void c_plgcolbg(PLINT *r, PLINT *g, PLINT *b);
+ pp_def ('plgcolbg',
+ NoPthread => 1,
+ Pars => 'int [o]r(); int [o]g(); int [o]b()',
+ Code => 'c_plgcolbg($P(r),$P(g),$P(b));'
+ );
+
+ # void c_plscmap0(PLINT *r, PLINT *g, PLINT *b, PLINT ncol0);
+ pp_def ('plscmap0',
+ NoPthread => 1,
+ Pars => 'int r(n); int g(n); int b(n)',
+ Code => 'c_plscmap0($P(r),$P(g),$P(b), $SIZE(n));'
+ );
+
+ # void c_plscmap1(PLINT *r, PLINT *g, PLINT *b, PLINT ncol1);
+ pp_def ('plscmap1',
+ NoPthread => 1,
+ Pars => 'int r(n); int g(n); int b(n)',
+ Code => 'c_plscmap1($P(r),$P(g),$P(b), $SIZE(n));'
+ );
+
+ if (!$noalpha) {
+
+ # void c_plgcol0a(PLINT icol0, PLINT *r, PLINT *g, PLINT *b, PLFLT *a);
+ pp_def ('plgcol0a',
+ NoPthread => 1,
+ Pars => 'int icolzero(); int [o]r(); int [o]g(); int [o]b(); double [o]a()',
+ Code => 'c_plgcol0a($icolzero(),$P(r),$P(g),$P(b),$P(a));'
+ );
+
+ # void c_plgcolbga(PLINT *r, PLINT *g, PLINT *b, PLFLT *a);
+ pp_def ('plgcolbga',
+ NoPthread => 1,
+ Pars => 'int [o]r(); int [o]g(); int [o]b(); double [o]a()',
+ Code => 'c_plgcolbga($P(r),$P(g),$P(b),$P(a));'
+ );
+
+ # void c_plscmap0a(PLINT *r, PLINT *g, PLINT *b, PLFLT *a, PLINT ncol0);
+ pp_def ('plscmap0a',
+ NoPthread => 1,
+ Pars => 'int r(n); int g(n); int b(n); double a(n)',
+ Code => 'c_plscmap0a($P(r),$P(g),$P(b),$P(a),$SIZE(n));'
+ );
+
+ # void c_plscmap1a(PLINT *r, PLINT *g, PLINT *b, PLFLT *a, PLINT ncol1);
+ pp_def ('plscmap1a',
+ NoPthread => 1,
+ Pars => 'int r(n); int g(n); int b(n); double a(n)',
+ Code => 'c_plscmap1a($P(r),$P(g),$P(b),$P(a),$SIZE(n));'
+ );
+
+ # Set color map1 colors using a piece-wise linear relationship, include alpha channel
+
+ pp_def ('plscmap1la',
+ NoPthread => 1,
+ Pars => 'int itype(); isty(n); coord1(n); coord2(n); coord3(n); coord4(n);'
+ . ' int rev(nrev)',
+ GenericTypes => [D],
+ Doc => 'FIXME: documentation here!',
+ Code => '
+ PLINT* rev;
+
+ if ($SIZE(nrev) == 0)
+ rev = NULL;
+ else if ($SIZE(nrev) == $SIZE(n))
+ rev = $P(rev);
+ else
+ croak ("plscmap1la: rev must have either length == 0 or have the same length of the other input arguments");
+
+ c_plscmap1la ($itype(), $SIZE(n), $P(isty), $P(coord1),
+ $P(coord2), $P(coord3), $P(coord4), rev);'
+ );
+ }
+
+
+ #
+ ## UNICODE font manipulation
+ #
+
+ if ($plversion->{'c_plsfont'}) {
+
+ # plgfont(PLINT *p_family, PLINT *p_style, PLINT *p_weight);
+ pp_def ('plgfont',
+ NoPthread => 1,
+ Pars => 'int [o]p_family(); int [o]p_style(); int [o]p_weight();',
+ Code => 'c_plgfont($P(p_family),$P(p_style),$P(p_weight));'
+ );
+
+ # plsfont (PLINT family, PLINT style, PLINT weight);
+ pp_def ('plsfont',
+ NoPthread => 1,
+ Pars => 'int family(); int style(); int weight();',
+ Code => 'c_plsfont($family(),$style(),$weight());'
+ );
+ } # $plversion->{'c_plsfont'}
+
+ # plcalc_world (PLFLT rx, PLFLT ry, PLFLT *wx, PLFLT *wy, PLINT *window);
+ pp_def ('plcalc_world',
+ NoPthread => 1,
+ Pars => 'double rx(); double ry(); double [o]wx(); double [o]wy(); int [o]window()',
+ Code => 'c_plcalc_world($rx(), $ry(), $P(wx), $P(wy), $P(window));'
+ );
+
+
+pp_addxs (<<"EOC");
+unsigned int plgfci ()
+ CODE:
+ {
+ unsigned int RETVAL;
+ unsigned int fci;
+ c_plgfci(&fci);
+ RETVAL = fci;
+
+ XSprePUSH; PUSHu((UV)RETVAL);
+ }
+ XSRETURN(1);
+EOC
+pp_add_exported('', 'plgfci');
+
+pp_addxs (<<'EOC');
+void
+plsfci(fci)
+ unsigned int fci
+ CODE:
+ c_plsfci(fci);
+EOC
+pp_add_exported('', 'plsfci');
+
+pp_addpm (<<'EOPM');
+
+=pod
+
+=head1 WARNINGS AND ERRORS
+
+PLplot gives many errors and warnings. Some of these are given by the
+PDL interface while others are internal PLplot messages. Below are
+some of these messages, and what you need to do to address them:
+
+=over
+
+=item *
+Box must be a ref to a four element array
+
+When specifying a box, you must pass a reference to a
+four-element array, or use an anonymous four-element array.
+
+ # Gives trouble:
+ $pl->xyplot($x, $y, BOX => (0, 0, 100, 200) );
+ # What you meant to say was:
+ $pl->xyplot($x, $y, BOX => [0, 0, 100, 200] );
+
+=item *
+Too many colors used! (max 15)
+
+
+=back
+
+=head1 AUTHORS
+
+ Doug Hunt <dhunt at ucar.edu>
+ Rafael Laboissiere <rlaboiss at users.sourceforge.net>
+ David Mertens <mertens2 at illinois.edu>
+
+=head1 SEE ALSO
+
+perl(1), PDL(1), L<http://www.plplot.org/>
+
+The other common graphics packages include L<PDL::PGPLOT>
+and L<PDL::TriD>.
+
+=cut
+
+EOPM
+
+pp_done();
+
+# Local Variables:
+# mode: cperl
+# End:
diff --git a/Graphics/State.pm b/Graphics/State.pm
new file mode 100644
index 0000000..f126328
--- /dev/null
+++ b/Graphics/State.pm
@@ -0,0 +1,141 @@
+=head1 NAME
+
+State - A package to keep track of plotting commands
+
+=head1 SYNOPSIS
+
+ use PDL::Graphics::State;
+
+=head1 DESCRIPTION
+
+This is a very simple, at present almost trivial, package to keep track
+of the current set of plotting commands.
+
+=head1 USAGE
+
+You create a new object by calling the C<new> operator
+
+ $state = PDL::Graphics::State->new();
+
+Then for each new command you call C<add> on this object so that for a
+call to C<line> of the form
+
+ line $x, $y, $opt;
+
+the call to C<add> would be like
+
+ $state->add(\&line, 'line', [$x, $y], $opt);
+
+which is stored internally as:
+
+ [\&line, 'line', [$x, $y], $opt]
+
+The state can later be extracted using C<get> which returns the state
+object which is an array of anonymous arrays like the one above where
+the first object is a reference to the function, the second an anomymous
+array of arguments to the function and finally an anonymous hash with
+options to the command.
+
+If you know the order in which you inserted commands they can be removed
+by calling C<remove> with the number in the stack. No further interaction
+is implmented except C<clear> which clears the stack and C<copy> which
+returns a "deep" copy of the state.
+
+
+
+=head1 AUTHOR
+
+Jarle Brinchmann (jarle at astro.ox.ac.uk) after some prodding by
+Karl Glazebrook.
+
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
+
+package PDL::Graphics::State;
+
+#
+# This is a very simple package to deal with the graphics state.
+#
+
+sub new {
+ my $type = shift;
+
+ my $self = {
+ 'Commands' => [],
+ };
+
+ bless $self, ref($type) || $type;
+ return $self;
+}
+
+
+sub DESTROY {
+ my $self = shift;
+ $self->clear();
+}
+
+sub add {
+ my $self = shift;
+ # The command is a reference to the subroutine, the data is an
+ # anonymous array containing the data passed to the routine and
+ # opt is the options hash PASSED TO THE ROUTINE..
+ my ($command, $command_name, $data, $opt) = @_;
+
+ # Compact and not user-friendly storage.
+ push @{$self->{Commands}}, [$command, $command_name, $data, $opt];
+
+# return $#{$self->{Commands}}+1;
+}
+
+
+sub remove {
+ my $self = shift;
+ my $num = shift;
+
+ # Remove entry #1
+ splice @{$self->{Commands}}, $num, 1;
+}
+
+sub get {
+ my $self = shift;
+ return @{$self->{Commands}};
+}
+
+sub info {
+ my $self = shift;
+ print "The state has ".($#{$self->{Commands}}+1)." commands in the stack\n";
+}
+
+sub show {
+ my $self = shift;
+ my $count=0;
+ foreach my $arg (@{$self->{Commands}}) {
+ print "$count - Func=$$arg[1]\n";
+ $count++;
+ }
+
+}
+
+sub clear {
+ my $self = shift;
+ # Do I need to do more?
+ $self->{Commands}=[];
+}
+
+
+sub copy {
+ my $self = shift;
+ my $new = PDL::Graphics::State->new();
+ foreach my $arg (@{$self->{Commands}}) {
+ $new->add(@$arg);
+ }
+ return $new;
+}
+
+1;
diff --git a/Graphics/TriD/Makefile.PL b/Graphics/TriD/Makefile.PL
new file mode 100644
index 0000000..e2b6f8d
--- /dev/null
+++ b/Graphics/TriD/Makefile.PL
@@ -0,0 +1,35 @@
+
+use strict;
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+# do we build the OpenGL/OpenGLQ stuff
+# (rather than have these 2 modules do it themselves)
+#
+# try and find out whether we should build the OpenGL/Mesa stuff
+# - first check is to dump win32 systems
+#
+my $gl_build = 0;
+my $gl_msg = "";
+my $gl_dir = "";
+
+my @subdirs = qw( Rout VRML );
+
+if ( $PDL::Config{USE_POGL} ) { # build with OpenGL for GL bindings and compile/link info
+ print "Graphics/TriD/Makefile.PL: using POGL for OpenGL bindings and compile options\n";
+ @subdirs = ( @subdirs, qw( POGL OpenGLQ ) );
+ $gl_build = 1;
+} else {
+ print "Graphics/TriD/Makefile.PL: skipping build of TriD::OpenGL(Q) modules - no POGL\n";
+}
+
+$PDL::Config{GL_BUILD} = $gl_build; # record for Config.pm
+
+WriteMakefile (
+ 'NAME' => "PDL::Graphics::TriD",
+ 'VERSION_FROM' => '../../Basic/Core/Version.pm',
+ 'DIR' => [ @subdirs ],
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
diff --git a/Graphics/TriD/OpenGLQ/Makefile.PL b/Graphics/TriD/OpenGLQ/Makefile.PL
new file mode 100644
index 0000000..c75060e
--- /dev/null
+++ b/Graphics/TriD/OpenGLQ/Makefile.PL
@@ -0,0 +1,41 @@
+
+use ExtUtils::MakeMaker;
+
+BEGIN {
+ if ( $PDL::Config{USE_POGL} ) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw()";
+ if (!$@) {
+ eval "use OpenGL::Config";
+ }
+ }
+}
+
+PDL::Core::Dev->import();
+
+ at pack = (["openglq.pd",OpenGLQ,PDL::Graphics::OpenGLQ]);
+%hash = pdlpp_stdargs_int(@::pack);
+
+if ( $PDL::Config{USE_POGL} ) {
+ push @{$hash{LIBS}}, $OpenGL::Config->{LIBS};
+ $hash{DEFINE} .= ' '.$OpenGL::Config->{DEFINE};
+ $hash{INC} .= ' '.$OpenGL::Config->{INC};
+ if($^O eq 'MSWin32') {
+ $hash{LDFROM} .= ' '. $OpenGL::Config->{LDFROM};
+ $hash{LDFROM} =~ s/\-lfreeglut//g;
+ }
+} else {
+ warn "Graphics/TriD/OpenGLQ/Makefile.PL: will not compile bindings without Perl OpenGL\n\n";
+ ## push @{$hash{LIBS}}, $PDL::Config{OPENGL_LIBS};
+ ## $hash{DEFINE} .= ' '.$PDL::Config{OPENGL_DEFINE};
+ ## $hash{INC} .= ' '.$PDL::Config{OPENGL_INC};
+}
+
+${$hash{LIBS}}[0] .= ' -lm';
+
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
+# SKIP: return;
diff --git a/Graphics/TriD/OpenGLQ/openglq.pd b/Graphics/TriD/OpenGLQ/openglq.pd
new file mode 100644
index 0000000..0b32b88
--- /dev/null
+++ b/Graphics/TriD/OpenGLQ/openglq.pd
@@ -0,0 +1,322 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+ PDL::Graphics::OpenGLQ - quick routines to plot lots of stuff from piddles.
+
+=head1 SYNOPSIS
+
+ only for internal use - see source
+
+=head1 DESCRIPTION
+
+only for internal use - see source
+
+=head1 AUTHOR
+
+Copyright (C) 1997,1998 Tuomas J. Lukka.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
+
+
+EOD
+
+pp_addhdr('
+#ifdef HAVE_AGL_GLUT
+#include <OpenGL/gl.h>
+#include <OpenGL/glu.h>
+#else
+#include <GL/gl.h>
+#include <GL/glu.h>
+#endif
+/* #include <GL/glx.h> */
+
+/* #include "../OpenGL/OpenGL.m" */
+/* D_OPENGL; */
+');
+
+#pp_add_boot('
+# I_OPENGL;
+#');
+
+
+ at internal = (Doc => 'internal');
+
+pp_def(
+ 'line_3x_3c',
+ GenericTypes => [F,D],
+ Pars => 'coords(tri=3,n); colors(tri,n);',
+ Code => '
+ glBegin(GL_LINE_STRIP);
+ loop(n) %{
+ glColor3f(
+ $colors(tri => 0),
+ $colors(tri => 1),
+ $colors(tri => 2)
+ );
+ glVertex3f(
+ $coords(tri => 0),
+ $coords(tri => 1),
+ $coords(tri => 2)
+ );
+ %}
+ glEnd();
+ ',
+ @internal
+);
+
+sub TRI {return "$_[0]$_[1](tri => 0),
+ $_[0]$_[1](tri => 1),
+ $_[0]$_[1](tri => 2)"}
+sub COLOR{ "
+ glColor3f(
+ ". TRI('$colors',$_[0])
+ ."
+ );
+ " };
+sub ADCOLOR{ "
+ {
+ GLfloat ad[4];
+ ".(join '',map {"ad[$_] = \$colors$_[0](tri => $_);"} 0..2).
+ "ad[3] = 1.0;
+ glMaterialfv(GL_FRONT_AND_BACK,GL_AMBIENT_AND_DIFFUSE,
+ ad);
+ }
+ " };
+sub VERTEX{ "
+ glVertex3f(
+ ". TRI('$coords',$_[0])
+ ."
+ );
+" };
+sub NORMAL{ "
+ glNormal3f(
+ ". TRI('$norm',$_[0])
+ ."
+ );
+ " };
+sub RPOS{ "
+ glRasterPos3f(
+ ". TRI('$coords',$_[0])
+ ."
+ );
+ " };
+
+pp_def('gl_points',
+ GenericTypes => [F,D],
+ Pars => 'coords(tri=3); colors(tri);',
+ Code => '
+ glBegin(GL_POINTS);
+ threadloop %{'.COLOR().VERTEX().'
+ %}
+ glEnd();
+ ',
+ @internal
+);
+
+pp_def(
+ 'gl_lines',
+ GenericTypes => [F,D],
+ Pars => 'coords(tri,x);colors(tri,x);',
+ Code => '
+ glBegin(GL_LINES);
+ loop(x) %{ '.COLOR().VERTEX().'
+ %}
+ glEnd();
+ ',
+ @internal
+);
+
+pp_def(
+ 'gl_line_strip',
+ GenericTypes => [F,D],
+ Pars => 'coords(tri,x);colors(tri,x);',
+ Code => '
+ glBegin(GL_LINE_STRIP);
+ loop(x) %{ '.COLOR().VERTEX().'
+ %}
+ glEnd();
+ ',
+ @internal
+);
+
+pp_def(
+ 'gl_texts',
+ GenericTypes => [F,D],
+ Pars => 'coords(tri,x); ',
+ OtherPars => 'int base; SV *arr',
+ Code => '
+ SV *sv = $COMP(arr);
+ AV *arr;
+ if(!(SvROK(sv) && SvTYPE(SvRV(sv))==SVt_PVAV)) {
+ barf("gl_texts requires an array ref");
+ }
+ arr = (AV *)SvRV(sv);
+
+ glPushAttrib(GL_LIST_BIT);
+ glListBase($COMP(base));
+
+ loop(x) %{
+ STRLEN n_a;
+ SV *elem = *(av_fetch(arr, x, 0));
+ if(elem) {
+ char *str = SvPV(elem,n_a);
+ '.RPOS().'
+ glCallLists(strlen(str),GL_UNSIGNED_BYTE,
+ (GLubyte*)str);
+ }
+ %}
+
+ glPopAttrib();
+ ',
+ @internal
+);
+
+for $m (
+{Suf => '_mat',
+ Func => \&ADCOLOR},
+{Suf => '',
+ Func => \&COLOR},
+) {
+for(
+{Name => 'gl_triangles',
+ NormalCode => ''},
+{Name => 'gl_triangles_n',
+ NormalCode => '
+ tmp1[0] = $coordsb(tri => 0) - $coordsa(tri => 0);
+ tmp1[1] = $coordsb(tri => 1) - $coordsa(tri => 1);
+ tmp1[2] = $coordsb(tri => 2) - $coordsa(tri => 2);
+ tmp2[0] = $coordsc(tri => 0) - $coordsa(tri => 0);
+ tmp2[1] = $coordsc(tri => 1) - $coordsa(tri => 1);
+ tmp2[2] = $coordsc(tri => 2) - $coordsa(tri => 2);
+ glNormal3f(
+ tmp1[1]*tmp2[2] - tmp2[1]*tmp1[2],
+ -(tmp1[0]*tmp2[2] - tmp2[0]*tmp1[2]),
+ tmp1[0]*tmp2[1] - tmp2[0]*tmp1[1]
+ );
+ '
+},
+{Name => 'gl_triangles_wn',
+ NormalArgs => 'norma(tri); normb(tri); normc(tri);',
+ (map {("NormalCode".($_ eq 'A'?'':$_),NORMAL(lc $_))} (A..C)),
+}) {
+# This may be suboptimal but should still be fast enough..
+# We only do triangles with this.
+pp_def(
+ $_->{Name}.$m->{Suf},
+ GenericTypes => [F,D],
+ Pars => 'coordsa(tri=3); coordsb(tri);
+ coordsc(tri);'.
+ $_->{NormalArgs}.
+ 'colorsa(tri); colorsb(tri);
+ colorsc(tri);
+ ',
+ Code => '
+ float tmp1[3]; float tmp2[3];
+ glBegin(GL_TRIANGLES);
+ threadloop %{'.
+ $_->{NormalCode}
+ .&{$m->{Func}}("a").VERTEX("a").
+ $_->{NormalCodeB}
+ .&{$m->{Func}}("b").VERTEX("b").
+ $_->{NormalCodeC}
+ .&{$m->{Func}}("c").VERTEX("c").'
+ %}
+ glEnd();
+ ',
+ @internal
+);
+}
+}
+
+pp_def('gl_arrows',
+ Pars => 'coords(tri=3,n); int indsa(); int indsb();',
+ OtherPars => 'float headlen; float width;',
+ Code => '
+ float hl = $COMP(headlen);
+ float w = $COMP(width);
+ float tmp2[3]; tmp2[0] = 0.000001; tmp2[1] = -0.0001; tmp2[2] = 1;
+ glBegin(GL_LINES);
+ threadloop %{
+ int a = $indsa();
+ int b = $indsb();
+ float tmp1[3];
+ float norm[3];
+ float norm2[3];
+ float normlen,origlen,norm2len;
+ tmp1[0] = $coords(tri => 0, n => a) -
+ $coords(tri => 0, n => b);
+ tmp1[1] = $coords(tri => 1, n => a) -
+ $coords(tri => 1, n => b);
+ tmp1[2] = $coords(tri => 2, n => a) -
+ $coords(tri => 2, n => b);
+
+ norm[0] = tmp1[1]*tmp2[2] - tmp2[1]*tmp1[2];
+ norm[1] = -(tmp1[0]*tmp2[2] - tmp2[0]*tmp1[2]);
+ norm[2] = tmp1[0]*tmp2[1] - tmp2[0]*tmp1[1];
+
+ norm2[0] = tmp1[1]*norm[2] - norm[1]*tmp1[2];
+ norm2[1] = -(tmp1[0]*norm[2] - norm[0]*tmp1[2]);
+ norm2[2] = tmp1[0]*norm[1] - norm[0]*tmp1[1];
+
+ normlen = sqrt(norm[0] * norm[0] +
+ norm[1] * norm[1] + norm[2] * norm[2]);
+ norm2len = sqrt(norm2[0] * norm2[0] +
+ norm2[1] * norm2[1] + norm2[2] * norm2[2]);
+ origlen = sqrt(tmp1[0] * tmp1[0] +
+ tmp1[1] * tmp1[1] + tmp1[2] * tmp1[2]);
+ norm[0] *= w/normlen;
+ norm[1] *= w/normlen;
+ norm[2] *= w/normlen;
+ norm2[0] *= w/norm2len;
+ norm2[1] *= w/norm2len;
+ norm2[2] *= w/norm2len;
+ tmp1[0] /= origlen;
+ tmp1[1] /= origlen;
+ tmp1[2] /= origlen;
+ glVertex3d( $coords(tri => 0, n => a) ,
+ $coords(tri => 1, n => a) ,
+ $coords(tri => 2, n => a) );
+ glVertex3d( $coords(tri => 0, n => b) ,
+ $coords(tri => 1, n => b) ,
+ $coords(tri => 2, n => b) );
+ if(w!=0) {
+ glVertex3d( $coords(tri => 0, n => b) ,
+ $coords(tri => 1, n => b) ,
+ $coords(tri => 2, n => b) );
+ glVertex3d( $coords(tri => 0, n => b) + hl*tmp1[0] + norm[0],
+ $coords(tri => 1, n => b) + hl*tmp1[1] + norm[1],
+ $coords(tri => 2, n => b) + hl*tmp1[2] + norm[2]);
+ glVertex3d( $coords(tri => 0, n => b) ,
+ $coords(tri => 1, n => b) ,
+ $coords(tri => 2, n => b) );
+ glVertex3d( $coords(tri => 0, n => b) + hl*tmp1[0] - norm[0],
+ $coords(tri => 1, n => b) + hl*tmp1[1] - norm[1],
+ $coords(tri => 2, n => b) + hl*tmp1[2] - norm[2]);
+ glVertex3d( $coords(tri => 0, n => b) ,
+ $coords(tri => 1, n => b) ,
+ $coords(tri => 2, n => b) );
+ glVertex3d( $coords(tri => 0, n => b) + hl*tmp1[0] + norm2[0],
+ $coords(tri => 1, n => b) + hl*tmp1[1] + norm2[1],
+ $coords(tri => 2, n => b) + hl*tmp1[2] + norm2[2]);
+ glVertex3d( $coords(tri => 0, n => b) ,
+ $coords(tri => 1, n => b) ,
+ $coords(tri => 2, n => b) );
+ glVertex3d( $coords(tri => 0, n => b) + hl*tmp1[0] - norm2[0],
+ $coords(tri => 1, n => b) + hl*tmp1[1] - norm2[1],
+ $coords(tri => 2, n => b) + hl*tmp1[2] - norm2[2]);
+ }
+ %}
+ glEnd();
+ ',
+ @internal
+);
+
+pp_done();
+
+
diff --git a/Graphics/TriD/POGL/MANIFEST b/Graphics/TriD/POGL/MANIFEST
new file mode 100644
index 0000000..e89263a
--- /dev/null
+++ b/Graphics/TriD/POGL/MANIFEST
@@ -0,0 +1,6 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+OpenGL.pm
+t/00-load.t
diff --git a/Graphics/TriD/POGL/Makefile.PL b/Graphics/TriD/POGL/Makefile.PL
new file mode 100644
index 0000000..a3152e7
--- /dev/null
+++ b/Graphics/TriD/POGL/Makefile.PL
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'PDL::Graphics::OpenGL::Perl::OpenGL',
+ 'VERSION_FROM' => 'OpenGL.pm',
+ 'ABSTRACT_FROM' => 'OpenGL.pm',
+ (eval($ExtUtils::MakeMaker::VERSION) >= 6.3002
+ ? ('LICENSE'=> 'perl')
+ : ()),
+ 'PL_FILES' => {},
+ 'PREREQ_PM' => {
+ 'Test::More' => 0,
+ 'OpenGL' => 0.58004, # TODO: this should be from perldl.conf value
+ },
+ 'dist' => { 'COMPRESS' => 'gzip -9f', 'SUFFIX' => 'gz', },
+ 'clean' => { 'FILES' => 'PDL-Graphics-OpenGL-Perl-OpenGL-*' },
+);
diff --git a/Graphics/TriD/POGL/OpenGL.pm b/Graphics/TriD/POGL/OpenGL.pm
new file mode 100644
index 0000000..ae6bcea
--- /dev/null
+++ b/Graphics/TriD/POGL/OpenGL.pm
@@ -0,0 +1,437 @@
+package PDL::Graphics::OpenGL::Perl::OpenGL;
+
+BEGIN {
+ use PDL::Config;
+ if ($PDL::Config{USE_POGL}) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw()";
+ use OpenGL::Config;
+ }
+}
+
+BEGIN {
+ eval 'OpenGL::ConfigureNotify()';
+ if ($@) {
+ # Set up some X11 and GLX constants for fake XEvent emulation
+ {
+ no warnings 'redefine';
+ eval "sub OpenGL::GLX_DOUBLEBUFFER () { 5 }";
+ eval "sub OpenGL::GLX_RGBA () { 4 }";
+ eval "sub OpenGL::GLX_RED_SIZE () { 8 }";
+ eval "sub OpenGL::GLX_GREEN_SIZE () { 9 }";
+ eval "sub OpenGL::GLX_BLUE_SIZE () { 10 }";
+ eval "sub OpenGL::GLX_DEPTH_SIZE () { 12 }";
+ eval "sub OpenGL::KeyPressMask () { (1<<0 ) }";
+ eval "sub OpenGL::KeyReleaseMask () { (1<<1 ) }";
+ eval "sub OpenGL::ButtonPressMask () { (1<<2 ) }";
+ eval "sub OpenGL::ButtonReleaseMask () { (1<<3 ) }";
+ eval "sub OpenGL::PointerMotionMask () { (1<<6 ) }";
+ eval "sub OpenGL::Button1Mask () { (1<<8 ) }";
+ eval "sub OpenGL::Button2Mask () { (1<<9 ) }";
+ eval "sub OpenGL::Button3Mask () { (1<<10) }";
+ eval "sub OpenGL::ButtonMotionMask () { (1<<13) }";
+ eval "sub OpenGL::ExposureMask () { (1<<15) }";
+ eval "sub OpenGL::StructureNotifyMask { (1<<17) }";
+ eval "sub OpenGL::KeyPress () { 2 }";
+ eval "sub OpenGL::KeyRelease () { 3 }";
+ eval "sub OpenGL::ButtonPress () { 4 }";
+ eval "sub OpenGL::ButtonRelease () { 5 }";
+ eval "sub OpenGL::MotionNotify () { 6 }";
+ eval "sub OpenGL::Expose () { 12 }";
+ eval "sub OpenGL::GraphicsExpose () { 13 }";
+ eval "sub OpenGL::NoExpose () { 14 }";
+ eval "sub OpenGL::VisibilityNotify () { 15 }";
+ eval "sub OpenGL::ConfigureNotify () { 22 }";
+ }
+ }
+}
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+PDL::Graphics::OpenGL::Perl::OpenGL - PDL TriD OpenGL interface using POGL
+
+=head1 VERSION
+
+Version 0.01_10
+
+=cut
+
+our $VERSION = '0.01_10';
+$VERSION = eval $VERSION;
+
+
+=head1 SYNOPSIS
+
+This module provides the glue between the Perl
+OpenGL functions and the API defined by the internal
+PDL::Graphics::OpenGL one. It also supports any
+miscellaneous OpenGL or GUI related functionality to
+support PDL::Graphics::TriD refactoring.
+
+You should eventually be able to replace:
+
+ use PDL::Graphics::OpenGL
+by
+ use PDL::Graphics::OpenGL::Perl::OpenGL;
+
+This module also includes support for FreeGLUT and
+GLUT instead of X11+GLX as mechanism for creating
+windows and graphics contexts.
+
+=head1 EXPORT
+
+See the documentation for the OpenGL module.
+More details to follow as the refactored TriD module
+interface and build environment matures
+
+=head1 FUNCTIONS
+
+=head2 TBD
+
+=cut
+
+*glpOpenWindow = \&OpenGL::glpOpenWindow;
+
+*glpcOpenWindow = \&OpenGL::glpcOpenWindow;
+
+
+=head2 TBD
+
+=cut
+
+package PDL::Graphics::OpenGL::OO;
+use PDL::Graphics::TriD::Window qw();
+use PDL::Options;
+use strict;
+my $debug = 0;
+my (@fakeXEvents) = ();
+my (@winObjects) = ();
+#
+# This is a list of all the fields of the opengl object
+#
+#use fields qw/Display Window Context Options GL_Vendor GL_Version GL_Renderer/;
+
+=head2 new($class,$options,[$window_type])
+
+Returns a new OpenGL object with attributes specified in the options
+field, and of the 3d window type, if specified. These attributes are:
+
+=for ref
+
+ x,y - the position of the upper left corner of the window (0,0)
+ width,height - the width and height of the window in pixels (500,500)
+ parent - the parent under which the new window should be opened (root)
+ mask - the user interface mask (StructureNotifyMask)
+ attributes - attributes to pass to glXChooseVisual
+
+Allowed 3d window types, case insensitive, are:
+
+=for ref
+
+ glut - use Perl OpenGL bindings and GLUT windows (no Tk)
+ x11 - use Perl OpenGL (POGL) bindings with X11 (disabled)
+
+=cut
+
+sub new {
+ my($class_or_hash,$options,$window_type) = @_;
+
+ my $isref = ref($class_or_hash);
+ my $p;
+# OpenGL::glpSetDebug(1);
+
+ if($isref and defined $class_or_hash->{Options}){
+ $p = $class_or_hash->{Options};
+ }else{
+ my $opt = new PDL::Options(default_options());
+ $opt->incremental(1);
+ $opt->options($options) if(defined $options);
+ $p = $opt->options;
+ }
+
+ # Use GLUT windows and event handling as the TriD default
+ $window_type ||= $PDL::Config{POGL_WINDOW_TYPE};
+ # $window_type ||= 'x11'; # use X11 default until glut code is ready
+
+ my $self;
+ if ( $window_type =~ /x11/i ) { # X11 windows
+ print STDERR "Creating X11 OO window\n" if $debug;
+ $self = OpenGL::glpcOpenWindow(
+ $p->{x},$p->{y},$p->{width},$p->{height},
+ $p->{parent},$p->{mask}, $p->{steal}, @{$p->{attributes}});
+ } else { # GLUT or FreeGLUT windows
+ print STDERR "Creating GLUT OO window\n" if $debug;
+ OpenGL::glutInit() unless OpenGL::done_glutInit(); # make sure glut is initialized
+ OpenGL::glutInitWindowPosition( $p->{x}, $p->{y} );
+ OpenGL::glutInitWindowSize( $p->{width}, $p->{height} );
+ OpenGL::glutInitDisplayMode( OpenGL::GLUT_RGBA() | OpenGL::GLUT_DOUBLE() | OpenGL::GLUT_DEPTH() ); # hardwire for now
+ if ($^O ne 'MSWin32' and not $OpenGL::Config->{DEFINE} =~ /-DHAVE_W32API/) { # skip these MODE checks on win32, they don't work
+ if (not OpenGL::glutGet(OpenGL::GLUT_DISPLAY_MODE_POSSIBLE()))
+ {
+ warn "glutInitDisplayMode(GLUT_RGBA | GLUT_DOUBLE | GLUT_DEPTH | GLUT_ALPHA) not possible";
+ warn "...trying without GLUT_ALPHA";
+ # try without GLUT_ALPHA
+ OpenGL::glutInitDisplayMode( OpenGL::GLUT_RGBA() | OpenGL::GLUT_DOUBLE() | OpenGL::GLUT_DEPTH() );
+ if ( not OpenGL::glutGet( OpenGL::GLUT_DISPLAY_MODE_POSSIBLE() ) )
+ {
+ die "display mode not possible";
+ }
+ }
+ }
+
+ my($glutwin) = OpenGL::glutCreateWindow( "GLUT TriD" );
+ OpenGL::glutSetWindowTitle("GLUT TriD #$glutwin"); # add GLUT window id to title
+
+ $self = { 'glutwindow' => $glutwin, 'xevents' => \@fakeXEvents, 'winobjects' => \@winObjects };
+
+ OpenGL::glutReshapeFunc( \&_pdl_fake_ConfigureNotify );
+ OpenGL::glutCloseFunc( \&_pdl_fake_exit_handler );
+ OpenGL::glutKeyboardFunc( \&_pdl_fake_KeyPress );
+ OpenGL::glutMouseFunc( \&_pdl_fake_button_event );
+ OpenGL::glutMotionFunc( \&_pdl_fake_MotionNotify );
+ OpenGL::glutDisplayFunc( \&_pdl_display_wrapper );
+
+ OpenGL::glutSetOption(OpenGL::GLUT_ACTION_ON_WINDOW_CLOSE(), OpenGL::GLUT_ACTION_GLUTMAINLOOP_RETURNS()) if OpenGL::_have_freeglut();
+
+ OpenGL::glutMainLoopEvent(); # pump event loop so window appears
+ }
+ if(ref($self) ne 'HASH'){
+ die "Could not create OpenGL window";
+ }
+
+# psuedo-hash style see note above
+# no strict 'refs';
+# my $self = bless [ \%{"$class\::FIELDS"}], $class;
+ #
+ $self->{Options} = $p;
+ $self->{window_type} = $window_type;
+ if($isref){
+ if(defined($class_or_hash->{Options})){
+ return bless $self,ref($class_or_hash);
+ }else{
+ foreach(keys %$self){
+ $class_or_hash->{$_} = $self->{$_};
+ }
+ return $class_or_hash;
+ }
+ }
+ bless $self,$class_or_hash;
+}
+
+=head2 default GLUT callbacks
+
+These routines are set as the default GLUT callbacks for when GLUT windows
+are used for PDL/POGL. Their only function at the moment is to drive an
+fake XEvent queue to feed the existing TriD GUI controls. At some point,
+the X11 stuff will the deprecated and we can rewrite this more cleanly.
+
+=cut
+
+sub _pdl_display_wrapper {
+ my ($win) = OpenGL::glutGetWindow();
+ if ( defined($win) and defined($winObjects[$win]) ) {
+ $winObjects[$win]->display();
+ }
+}
+
+sub _pdl_fake_exit_handler {
+ my ($win) = shift;
+ print "_pdl_fake_exit_handler: clicked for window $win\n" if $debug;
+ # Need to clean up better and exit/transition cleanly
+}
+
+sub _pdl_fake_ConfigureNotify {
+ print "_pdl_fake_ConfigureNotify: got (@_)\n" if $debug;
+ OpenGL::glutPostRedisplay();
+ push @fakeXEvents, [ 22, @_ ];
+}
+
+sub _pdl_fake_KeyPress {
+ print "_pdl_fake_KeyPress: got (@_)\n" if $debug;
+ push @fakeXEvents, [ 2, chr($_[0]) ];
+}
+
+{
+ my @button_to_mask = (256,512,1024);
+ my $fake_mouse_state = 16; # default have EnterWindowMask set;
+ my $last_fake_mouse_state;
+
+ sub _pdl_fake_button_event {
+ print "_pdl_fake_button_event: got (@_)\n" if $debug;
+ $last_fake_mouse_state = $fake_mouse_state;
+ if ( $_[1] == 0 ) { # a press
+ $fake_mouse_state |= $button_to_mask[$_[0]];
+ push @fakeXEvents, [ 4, $_[0]+1, @_[2,3], -1, -1, $last_fake_mouse_state ];
+ } elsif ( $_[1] == 1 ) { # a release
+ $fake_mouse_state &= ~$button_to_mask[$_[0]];
+ push @fakeXEvents, [ 5, $_[0]+1 , @_[2,3], -1, -1, $last_fake_mouse_state ];
+ } else {
+ die "ERROR: _pdl_fake_button_event got unexpected value!";
+ }
+ }
+
+ sub _pdl_fake_MotionNotify {
+ print "_pdl_fake_MotionNotify: got (@_)\n" if $debug;
+ push @fakeXEvents, [ 6, $fake_mouse_state, @_ ];
+ }
+
+}
+
+=head2 default_options
+
+default options for object oriented methods
+
+=cut
+
+sub default_options{
+ { 'x' => 0,
+ 'y' => 0,
+ 'width' => 500,
+ 'height'=> 500,
+ 'parent'=> 0,
+ 'mask' => eval '&OpenGL::StructureNotifyMask',
+ 'steal' => 0,
+ 'attributes' => eval '[ &OpenGL::GLX_DOUBLEBUFFER, &OpenGL::GLX_RGBA ]',
+ }
+}
+
+
+=head2 XPending()
+
+OO interface to XPending
+
+=cut
+
+sub XPending {
+ my($self) = @_;
+ if ( $self->{window_type} eq 'glut' ) {
+ # monitor state of @fakeXEvents, return number on queue
+ print STDERR "OO::XPending: have " . scalar( @{$self->{xevents}} ) . " xevents\n" if $debug > 1;
+ scalar( @{$self->{xevents}} );
+ } else {
+ OpenGL::XPending($self->{Display});
+ }
+}
+
+
+=head2 XResizeWindow(x,y)
+
+OO interface to XResizeWindow
+
+=cut
+
+sub XResizeWindow {
+ my($self,$x,$y) = @_;
+ OpenGL::glpResizeWindow($x,$y,$self->{Window},$self->{Display});
+}
+
+
+=head2 glpXNextEvent()
+
+OO interface to glpXNextEvent
+
+=cut
+
+
+sub glpXNextEvent {
+ my($self) = @_;
+ if ( $self->{window_type} eq 'glut' ) {
+ while ( !scalar( @{$self->{xevents}} ) ) {
+ # If no events, we keep pumping the event loop
+ OpenGL::glutMainLoopEvent();
+ }
+ # Extract first event from fake event queue and return
+ return @{ shift @{$self->{xevents}} };
+ } else {
+ return OpenGL::glpXNextEvent($self->{Display});
+ }
+}
+
+
+=head2 glpRasterFont()
+
+OO interface to the glpRasterFont function
+
+=cut
+
+sub glpRasterFont{
+ my($this, at args) = @_;
+ OpenGL::glpRasterFont($args[0],$args[1],$args[2],$this->{Display});
+}
+
+
+=head2 AUTOLOAD
+
+If the function is not prototyped in OO we assume there is
+no explicit mention of the three identifying parameters (Display, Window, Context)
+and try to load the OpenGL function.
+
+=cut
+
+sub AUTOLOAD {
+ my($self, at args) = @_;
+ use vars qw($AUTOLOAD);
+ my $sub = $AUTOLOAD;
+ return if($sub =~ /DESTROY/);
+ $sub =~ s/.*:://;
+ $sub = "OpenGL::$sub";
+ if(defined $debug){
+ print "In AUTOLOAD: $sub at ",__FILE__," line ",__LINE__,".\n";
+ }
+ no strict 'refs';
+ return(&{$sub}(@args));
+}
+
+
+=head2 glXSwapBuffers
+
+OO interface to the glXSwapBuffers function
+
+=cut
+
+sub glXSwapBuffers {
+ my($this, at args) = @_;
+ OpenGL::glXSwapBuffers($this->{Window},$this->{Display}); # Notice win and display reversed [sic]
+}
+
+
+=head1 AUTHOR
+
+Chris Marshall, C<< <devel dot chm dot 01 at gmail.com> >>
+
+=head1 BUGS
+
+Bugs and feature requests may be submitted through the PDL sourceforge
+project page at L<http://sourceforge.net/tracker/?group_id=612> .
+
+
+=head1 SUPPORT
+
+PDL uses a mailing list support model. The Perldl mailing list
+is the best for questions, problems, and feature discussions with
+other PDL users and PDL developers.
+
+To subscribe see the page at L<http://mailman.jach.hawaii.edu/mailman/listinfo/perldl>
+
+
+
+=head1 ACKNOWLEDGEMENTS
+
+TBD including PDL TriD developers and POGL developers...thanks to all.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2009 Chris Marshall.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+
+
+=cut
+
+1; # End of PDL::Graphics::OpenGL::Perl::OpenGL
diff --git a/Graphics/TriD/POGL/README b/Graphics/TriD/POGL/README
new file mode 100644
index 0000000..4ba0bf6
--- /dev/null
+++ b/Graphics/TriD/POGL/README
@@ -0,0 +1,40 @@
+PDL-Graphics-OpenGL-Perl-OpenGL
+
+This module provides an alternative OpenGL API interface
+to the internal PDL::Graphics::OpenGL one. It curently
+requires that you have a recent version of the Perl OpenGL
+module (a.k.a. POGL) installed.
+
+
+INSTALLATION
+
+The current source for this module resides in the PDL
+source tree. To have it build, edit the perldl.conf file
+and set the USE_POGL option to 1.
+
+To install this module separately via CPAN, run the
+following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+ perldoc PDL::Graphics::OpenGL::Perl::OpenGL
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2009 Chris Marshall
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+
diff --git a/Graphics/TriD/POGL/ignore.txt b/Graphics/TriD/POGL/ignore.txt
new file mode 100644
index 0000000..94367eb
--- /dev/null
+++ b/Graphics/TriD/POGL/ignore.txt
@@ -0,0 +1,10 @@
+blib*
+Makefile
+Makefile.old
+Build
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+PDL-Graphics-OpenGL-Perl-OpenGL-*
+cover_db
diff --git a/Graphics/TriD/POGL/t/00-load.t b/Graphics/TriD/POGL/t/00-load.t
new file mode 100644
index 0000000..a1e6cd1
--- /dev/null
+++ b/Graphics/TriD/POGL/t/00-load.t
@@ -0,0 +1,7 @@
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'PDL::Graphics::OpenGL::Perl::OpenGL' );
+}
+
+diag( "Testing PDL::Graphics::OpenGL::Perl::OpenGL $PDL::Graphics::OpenGL::Perl::OpenGL::VERSION, Perl $], $^X" );
diff --git a/Graphics/TriD/Rout/Makefile.PL b/Graphics/TriD/Rout/Makefile.PL
new file mode 100644
index 0000000..db0bb8d
--- /dev/null
+++ b/Graphics/TriD/Rout/Makefile.PL
@@ -0,0 +1,16 @@
+
+use ExtUtils::MakeMaker;
+ PDL::Core::Dev->import();
+
+ at pack = (["rout.pd",Rout,PDL::Graphics::TriD::Rout]);
+
+#WriteMakefile(
+# pdlpp_stdargs_int(@::pack)
+#);
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{LIBS} = ['-lm'];
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Graphics/TriD/Rout/rout.pd b/Graphics/TriD/Rout/rout.pd
new file mode 100644
index 0000000..a033a22
--- /dev/null
+++ b/Graphics/TriD/Rout/rout.pd
@@ -0,0 +1,491 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+ PDL::Graphics::TriD::Rout - Helper routines for Three-dimensional graphics
+
+
+=head1 DESCRIPTION
+
+This module is for miscellaneous PP-defined utility routines for
+the PDL::Graphics::TriD module. Currently, there are
+
+EOD
+
+pp_def(
+ 'combcoords',
+ GenericTypes => [F,D],
+ DefaultFlow => 1,
+ Pars => 'x(); y(); z();
+ float [o]coords(tri=3);',
+ Code => '
+ $coords(tri => 0) = $x();
+ $coords(tri => 1) = $y();
+ $coords(tri => 2) = $z();
+ ',
+ Doc => <<EOT
+=for ref
+
+Combine three coordinates into a single piddle.
+
+Combine x, y and z to a single piddle the first dimension
+of which is 3. This routine does dataflow automatically.
+
+=cut
+
+
+EOT
+
+);
+
+# checks all neighbouring boxes.
+# Returns (r = |dist|+d) a*r^-2 + b*r^-1 + c*r^-0.5
+pp_def(
+ 'repulse',
+ GenericTypes => [F,D],
+ Pars => 'coords(nc,np);
+ [o]vecs(nc,np);
+ int [t]links(np);',
+ OtherPars => '
+ double boxsize;
+ int dmult;
+ double a;
+ double b;
+ double c;
+ double d;
+ ',
+ Code => '
+ double a = $COMP(a);
+ double b = $COMP(b);
+ double c = $COMP(c);
+ double d = $COMP(d);
+ int ind; int x,y,z; SV **svp; SV *sv;
+ int npv;
+ HV *hv = newHV();
+ double boxsize = $COMP(boxsize);
+ int dmult = $COMP(dmult);
+ loop(np) %{
+ int index = 0;
+ $links() = -1;
+ loop(nc) %{
+ $vecs() = 0;
+ index *= dmult;
+ index += (int)($coords()/boxsize);
+ %}
+ /* Repulse old (shame to use x,y,z...) */
+ for(x=-1; x<=1; x++) {
+ for(y=-1; y<=1; y++) {
+ for(z=-1; z<=1; z++) {
+ int ni = index + x + dmult * y +
+ dmult * dmult * z;
+ svp = hv_fetch(hv, (char *)&ni, sizeof(int),
+ 0);
+ if(svp && *svp) {
+ ind = SvIV(*svp) - 1;
+ while(ind>=0) {
+ double dist = 0;
+ double dist2;
+ double tmp;
+ double func;
+ loop(nc) %{
+ tmp =
+ ($coords() -
+ $coords(np => ind));
+ dist += tmp * tmp;
+ %}
+ dist = sqrt(1/(sqrt(dist)+d));
+ func = c * dist;
+ dist2 = dist * dist;
+ func += b * dist2;
+ dist2 *= dist2;
+ func += a * dist2;
+ loop(nc) %{
+ tmp =
+ ($coords() -
+ $coords(np => ind));
+ $vecs() -=
+ func * tmp;
+ $vecs(np => ind) +=
+ func * tmp;
+ %}
+ ind = $links(np => ind);
+ }
+ }
+ }
+ }
+ }
+ /* Store new */
+ svp = hv_fetch(hv, (char *)&index, sizeof(int), 1);
+ if(svp == NULL) {
+ die("Invalid sv from hvfetch");
+ }
+ sv = *svp;
+ if(npv = SvIV(sv)) {
+ npv --;
+ $links() = $links(np => npv);
+ $links(np => npv) = np;
+ } else {
+ sv_setiv(sv,np+1);
+ $links() = -1;
+ }
+ %}
+ hv_undef(hv);
+ ', Doc => '
+=for ref
+
+Repulsive potential for molecule-like constructs.
+
+C<repulse> uses a hash table of cubes to quickly calculate
+a repulsive force that vanishes at infinity for many
+objects. For use by the module L<PDL::Graphics::TriD::MathGraph|PDL::Graphics::TriD::MathGraph>.
+For definition of the potential, see the actual function.
+
+=cut
+
+
+'
+);
+
+pp_def(
+ 'attract',
+ GenericTypes => [F,D],
+ Pars => 'coords(nc,np);
+ int from(nl);
+ int to(nl);
+ strength(nl);
+ [o]vecs(nc,np);',
+ OtherPars => '
+ double m;
+ double ms;
+ ',
+ Code => '
+ double m = $COMP(m);
+ double ms = $COMP(ms);
+ loop(nc,np) %{ $vecs() = 0; %}
+ loop(nl) %{
+ int f = $from();
+ int t = $to();
+ double s = $strength();
+ double dist = 0;
+ double tmp;
+ loop(nc) %{
+ tmp = $coords(np => f) -
+ $coords(np => t);
+ dist += tmp * tmp;
+ %}
+ s *= ms * dist + m * sqrt(dist);
+ loop(nc) %{
+ tmp = $coords(np => f) -
+ $coords(np => t);
+ $vecs(np => f) -= tmp * s;
+ $vecs(np => t) += tmp * s;
+ %}
+ %}
+ ', Doc => '
+=for ref
+
+Attractive potential for molecule-like constructs.
+
+C<attract> is used to calculate
+an attractive force for many
+objects, of which some attract each other (in a way
+like molecular bonds).
+For use by the module L<PDL::Graphics::TriD::MathGraph|PDL::Graphics::TriD::MathGraph>.
+For definition of the potential, see the actual function.
+
+=cut
+
+
+'
+);
+
+sub trid {
+ my ($par,$ind) = @_;
+ join ',', map {"\$$par($ind => $_)"} (0..2);
+}
+
+pp_def('vrmlcoordsvert',
+ Pars => 'vertices(n=3)',
+ OtherPars => 'char* space; char* fd',
+ GenericTypes => [F,D],
+ Code => q@
+ PerlIO *fp;
+ IO *io;
+ PDL_Byte *buf, *bp;
+ char *spc = $COMP(space);
+ char formchar = $TFD(' ','l');
+ char formatstr[25];
+
+ io = GvIO(gv_fetchpv($COMP(fd),FALSE,SVt_PVIO));
+ if (!io || !(fp = IoIFP(io)))
+ barf("Can\'t figure out FP");
+ sprintf(formatstr,"%s%%.3%cf %%.3%cf %%.3%cf,\n",spc,
+ formchar,formchar,formchar);
+
+ threadloop %{
+ PerlIO_printf(fp,formatstr, at .trid(vertices,n).');
+ %}'
+);
+
+pp_addpm(<<'EOD');
+
+=head2 contour_segments
+
+=for ref
+
+This is the interface for the pp routine contour_segments_internal
+- it takes 3 piddles as input
+
+C<$c> is a contour value (or a list of contour values)
+
+C<$data> is an [m,n] array of values at each point
+
+C<$points> is a list of [3,m,n] points, it should be a grid
+monotonically increasing with m and n.
+
+contour_segments returns a reference to a Perl array of
+line segments associated with each value of C<$c>. It does not (yet) handle
+missing data values.
+
+=over 4
+
+=item Algorthym
+
+The data array represents samples of some field observed on the surface described
+by points. For each contour value we look for intersections on the line segments
+joining points of the data. When an intersection is found we look to the adjoining
+line segments for the other end(s) of the line segment(s). So suppose we find an
+intersection on an x-segment. We first look down to the left y-segment, then to the
+right y-segment and finally across to the next x-segment. Once we find one in a
+box (two on a point) we can quit because there can only be one. After we are done
+with a given x-segment, we look to the leftover possibilities for the adjoining y-segment.
+Thus the contours are built as a collection of line segments rather than a set of closed
+polygons.
+
+=back
+
+=cut
+
+use strict;
+sub PDL::Graphics::TriD::Contours::contour_segments {
+ my($this,$c,$data,$points) = @_;
+# pre compute space for output of pp routine
+
+ my $segdim = ($data->getdim(0)-1)*($data->getdim(1)-1)*4;
+# print "segdim = $segdim\n";
+ my $segs = zeroes(3,$segdim,$c->nelem);
+ my $cnt = zeroes($c->nelem);
+ contour_segments_internal($c,$data,$points,$segs,$cnt);
+
+# print "contour segments done ",$points->info,"\n";
+
+ $this->{Points} = pdl->null;
+
+ my $pcnt=0;
+ my $ncnt;
+ for(my $i=0; $i<$c->nelem; $i++){
+ $ncnt = $cnt->slice("($i)");
+ next if($ncnt==-1);
+
+ $pcnt = $pcnt+$ncnt;
+
+ $this->{ContourSegCnt}[$i] = $pcnt;
+ $pcnt=$pcnt+1;
+ $this->{Points} = $this->{Points}->append($segs->slice(":,0:$ncnt,($i)")->xchg(0,1));
+ }
+ $this->{Points} = $this->{Points}->xchg(0,1);
+
+}
+EOD
+
+
+pp_def('contour_segments_internal',
+ Pars => 'c();
+ data(m,n);
+ points(d,m,n);
+ float [o]segs(d,q);
+ int [o] cnt();',
+ GenericTypes => [F],
+ Code => '
+ int ds, ms, ns;
+ float dist;
+ float a_int[3];
+ int i, j, m1, n1, mr, ml, p, found, p1, a;
+
+ ds = $SIZE(d);
+ ms = $SIZE(m);
+ ns = $SIZE(n);
+
+ if(ds != 3){
+ croak("Bad first dimension in contour_segments");
+ }
+ p=0;
+ p1=1;
+ loop(m) %{
+ if(m<ms-1){
+ m1=m+1;
+ loop(n)%{
+ if(n<ns-1){
+ n1=n+1;
+
+ /* printf("found %d %d %d\n",found,ml,mr); */
+ found=0;
+
+ if((a=($data() < $c() && $data(m=>m1) >= $c())) ||
+ ($data() >= $c() && $data(m=>m1) < $c())){
+
+ /* circle the high if there is a choice of direction */
+ if(a==0){
+ ml=m;
+ mr=m1;
+ }else{
+ ml=m1;
+ mr=m;
+ }
+
+ /* found an x intersect */
+
+ dist = ($c()-$data())/($data(m=>m1)-$data());
+ loop(d) %{
+ a_int[d]=$points()+dist*($points(m=>m1)-$points());
+ %}
+ /* now look for the connecting point */
+ /* First down and to the left (right) */
+
+
+ if(($data(m=>ml) < $c() && $data(m=>ml,n=>n1) >= $c()) ||
+ ($data(m=>ml) >= $c() && $data(m=>ml,n=>n1) < $c())){
+ found=(m==ml)? 1:-1;
+ dist = ($c()-$data(m=>ml))/($data(m=>ml,n=>n1)-$data(m=>ml));
+ loop(d) %{
+ $segs(q=>p1)=$points(m=>ml)+dist*($points(m=>ml,n=>n1)-$points(m=>ml));
+ $segs(q=>p) = a_int[d];
+ %}
+ p+=2;
+ p1=p+1;
+ /* printf("found1 %d %d %d\n",found,ml,mr); */
+ }else{
+ /* down and to the right (left)*/
+ if(($data(m=>mr) < $c() && $data(m=>mr,n=>n1) >= $c()) ||
+ ($data(m=>mr) >= $c() && $data(m=>mr,n=>n1) < $c())){
+
+ dist = ($c()-$data(m=>mr))/($data(m=>mr,n=>n1)-$data(m=>mr));
+ found=(m==mr)? 1:-1;
+ loop(d) %{
+ $segs(q=>p1)=$points(m=>mr)+dist*($points(m=>mr,n=>n1)-$points(m=>mr));
+ $segs(q=>p) = a_int[d];
+ %}
+ p+=2;
+ p1=p+1;
+ /* printf("found2 %d %d %d\n",found,ml,mr);*/
+ }else{
+ /* straight down */
+ found=2;
+ if(($data(n=>n1) < $c() && $data(m=>m1,n=>n1) >= $c()) ||
+ ($data(n=>n1) >= $c() && $data(m=>m1,n=>n1) < $c())){
+ dist = ($c()-$data(n=>n1))/($data(m=>m1,n=>n1)-$data(n=>n1));
+ loop(d) %{
+ $segs(q=>p1)=$points(n=>n1)+dist*($points(m=>m1,n=>n1)-$points(n=>n1));
+ $segs(q=>p) = a_int[d];
+ %}
+ p+=2;
+ p1=p+1;
+
+ }/* straight down */
+ } /* down and to the right */
+ } /* First down and to the left */
+ } /* found an x intersect */
+ if(found<=0){ /* need to check the y-pnt */
+ if(($data() < $c() && $data(n=>n1) >= $c()) ||
+ ($data() >= $c() && $data(n=>n1) < $c())){
+ dist = ($c()-$data())/($data(n=>n1)-$data());
+ loop(d) %{
+ a_int[d]=$points()+dist*($points(n=>n1)-$points());
+ %}
+ if(($data(n=>n1) < $c() && $data(m=>m1,n=>n1) >= $c()) ||
+ ($data(n=>n1)>= $c() && $data(m=>m1,n=>n1) < $c())){
+ dist = ($c()-$data(n=>n1))/($data(m=>m1,n=>n1)-$data(n=>n1));
+
+ loop(d) %{
+ $segs(q=>p1)=$points(n=>n1)+dist*($points(m=>m1,n=>n1)-$points(n=>n1));
+ $segs(q=>p) = a_int[d];
+ %}
+ p+=2;
+ p1=p+1;
+ found = (found==-1)?-3:3;
+ }else if(found==0){
+ if(($data(m=>m1) < $c() && $data(m=>m1,n=>n1) >= $c()) ||
+ ($data(m=>m1) >= $c() && $data(m=>m1,n=>n1) < $c())){
+ dist = ($c()-$data(m=>m1))/($data(m=>m1,n=>n1)-$data(m=>m1));
+
+ loop(d) %{
+ $segs(q=>p1) = $points(m=>m1)+dist*($points(m=>m1,n=>n1)-$points(m=>m1));
+ $segs(q=>p) = a_int[d];
+ %}
+ p+=2;
+ p1=p+1;
+ found = 4;
+ }
+ }
+ }
+
+ } /* need to check the y-pnt */
+
+ if(found==0 || found==1 || found == 3){
+ if((($data(m=>m1) < $c() && $data(m=>m1,n=>n1) >= $c()) ||
+ ($data(m=>m1) >= $c() && $data(m=>m1,n=>n1) < $c())) &&
+ (($data(n=>n1) < $c() && $data(m=>m1,n=>n1) >= $c()) ||
+ ($data(n=>n1) >= $c() && $data(m=>m1,n=>n1) < $c()))){
+ float dist2;
+ dist = ($c()-$data(m=>m1))/($data(m=>m1,n=>n1)-$data(m=>m1));
+ dist2 = ($c()-$data(n=>n1))/($data(m=>m1,n=>n1)-$data(n=>n1));
+
+ loop(d) %{
+ $segs(q=>p) = $points(m=>m1)+dist*($points(m=>m1,n=>n1)-$points(m=>m1));
+ $segs(q=>p1)=$points(n=>n1)+dist2*($points(m=>m1,n=>n1)-$points(n=>n1));
+ %}
+ found=5;
+ p+=2;
+ p1=p+1;
+ }
+ }
+ } /* n<ns-1 */
+ %}
+ }
+ %}
+ /*printf("p= %d \n",p); */
+ $cnt()=p-1;'
+,
+ Doc => undef,
+#'
+#=for ref
+#
+#Internal support for contour_segments above.
+#
+#=cut
+#'
+
+
+);
+
+
+pp_addpm({At=>Bot},<<'EOD');
+
+=head1 AUTHOR
+
+Copyright (C) 2000 James P. Edwards
+Copyright (C) 1997 Tuomas J. Lukka.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+
+EOD
+
+pp_done();
+
+
+
diff --git a/Graphics/TriD/TriD.pm b/Graphics/TriD/TriD.pm
new file mode 100644
index 0000000..732a0de
--- /dev/null
+++ b/Graphics/TriD/TriD.pm
@@ -0,0 +1,1076 @@
+=head1 NAME
+
+PDL::Graphics::TriD -- PDL 3D interface
+
+=head1 SYNOPSIS
+
+ use PDL::Graphics::TriD;
+
+ # Generate a somewhat interesting sequence of points:
+ $t = sequence(100)/10;
+ $x = sin($t); $y = cos($t), $z = $t;
+ $coords = cat($x, $y, $z)->xchg(0,1);
+ $r = cos(2*$t); $g = sin($t); $b = $t;
+ $colors = cat($r, $g, $b)->xchg(0,1);
+
+ # After each graph, let the user rotate and
+ # wait for him to press 'q', then make new graph
+ line3d($coords); # $coords = (3,n,...)
+ line3d($coords,$colors); # $colors = (3,n,...)
+ line3d([$x,$y,$z]);
+
+ # Generate a somewhat interesting sequence of surfaces
+ $surf1 = (rvals(100, 100) / 50)**2 + sin(xvals(100, 100) / 10);
+ $surf2 = sqrt(rvals(zeroes(50,50))/2);
+ $x = sin($surface); $y = cos($surface), $z = $surface;
+ $coords = cat($x, $y, $z)->xchg(0,1);
+ $r = cos(2*$surface); $g = sin($surface); $b = $surface;
+ $colors = cat($r, $g, $b)->xchg(0,1);
+ imagrgb([$r,$g,$b]); # 2-d piddles
+ lattice3d([$surf1]);
+ points3d([$x,$y,$z]);
+ spheres3d([$x,$y,$z]); # preliminary implementation
+
+ hold3d(); # the following graphs are on top of each other and the previous
+ line3d([$x,$y,$z]);
+ line3d([$x,$y,$z+1]);
+ $pic = grabpic3d(); # Returns the picture in a (3,$x,$y) float piddle (0..1).
+
+ release3d(); # the next graph will again wipe out things.
+
+
+=head1 WARNING
+
+These modules are still in a somewhat unfocused state: don't use them yet
+if you don't know how to make them work if they happen to do something
+strange.
+
+=head1 DESCRIPTION
+
+This module implements a generic 3D plotting interface for PDL.
+Points, lines and surfaces (among other objects) are supported.
+
+With OpenGL, it is easy to manipulate the resulting 3D objects
+with the mouse in real time - this helps data visualization a lot.
+
+=for comment
+With VRML, you can generate objects for everyone to see with e.g.
+Silicon Graphics' Cosmo Player. You can find out more about VRML
+at C<http://vrml.sgi.com/> or C<http://www.vrml.org/>
+
+=head1 SELECTING A DEVICE
+
+The default device for TriD is currently OpenGL.
+You can specify a different device either in your program
+or in the environment variable C<PDL_3D_DEVICE>.
+The one specified in the program takes priority.
+
+The currently available devices are
+
+=over 8
+
+=item GL
+
+OpenGL
+
+=item GLpic
+
+OpenGL but off-line (pixmap) rendering and writing to
+a graphics file.
+
+=item VRML (I< Not available this release >)
+
+VRML objects rendering. This writes a VRML file describing the
+scene. This VRML file can then be read with a browser.
+
+=back
+
+=head1 ONLINE AND OFFLINE VISUALIZATION
+
+TriD offers both on- and off-line visualization.
+Currently the interface w.r.t. this division is still much
+in motion.
+
+For OpenGL you can select either on- or off-line rendering.
+VRML is currently always offline (this may change later,
+if someone bothers to write the java(script) code to contact
+PDL and wait for the next PDL image over the network.
+
+=head1 COORDINATE SPECIFICATIONS
+
+Specifying a set of coordinates is generally a context-dependent operation.
+For a traditional 3D surface plot, you'll want two of the coordinates
+to have just the xvals and yvals of the piddle, respectively.
+For a line, you would generally want to have one coordinate held
+at zero and the other advancing.
+
+This module tries to make a reasonable way of specifying the context
+while letting you do whatever you want by overriding the default
+interpretation.
+
+The alternative syntaxes for specifying a set of coordinates (or colors) are
+
+ $piddle # MUST have 3 as first dim.
+ [$piddle]
+ [$piddle1,$piddle2]
+ [$piddle1,$piddle2,$piddle3]
+ [CONTEXT,$piddle]
+ [CONTEXT,$piddle1,$piddle2]
+ [CONTEXT,$piddle1,$piddle2,$piddle3]
+
+where C<CONTEXT> is a string describing in which context you wish these
+piddles to be interpreted. Each routine specifies a default context
+which is explained in the routines documentation.
+Context is usually used only to understand what the user wants
+when he/she specifies less than 3 piddles.
+
+The following contexts are currently supported:
+
+=over 8
+
+=item SURF2D
+
+A 2-D lattice. C< [$piddle] > is interpreted as the Z coordinate over
+a lattice over the first dimension. Equivalent to
+C< [$piddle->xvals, $piddle->yvals, $piddle] >.
+
+=item POLAR2D
+
+A 2-D polar coordinate system. C< [$piddle] > is interpreted as the
+z coordinate over theta and r (theta = the first dimension of the piddle).
+
+=item COLOR
+
+A set of colors. C< [$piddle] > is interpreted as grayscale color
+(equivalent to C< [$piddle,$piddle,$piddle] >).
+
+=item LINE
+
+A line made of 1 or 2 coordinates. C< [$piddle] > is interpreted as
+C< [$piddle->xvals,$piddle,0] >. C< [$piddle1,$piddle2] > is interpreted as
+C< [$piddle1,$piddle2,$piddle1->xvals] >.
+
+=back
+
+What makes contexts useful is that if you want to plot points
+instead of the full surface you plotted with
+
+ imag3d([$zcoords]);
+
+you don't need to start thinking about where to plot the points:
+
+ points3d([SURF2D,$zcoords]);
+
+will do exactly the same.
+
+=head2 Wrapping your head around 3d surface specifications
+
+Let's begin by thnking about how you might make a 2d data plot.
+If you sampled your data at regular intervals, you would have
+a time serires y(t) = (y0, y1, y2, ...). You could plot y vs t
+by computing t0 = 0, t1 = dt, t2 = 2 * dt, and then plotting
+(t0, y0), (t1, y1), etc.
+
+Next suppose that you measured x(t) and y(t). You can still
+plot y vs t, but you can also plot y vs x by plotting (x0, y0),
+(x1, y1), etc. The x-values don't have to increase monotonically:
+they could back-track on each other, for example, like the
+latitude and longitude of a boat on a lake. If you use plplot,
+you would plot this data using
+C<< $pl->xyplot($x, $y, PLOTTYPE => 'POINTS') >>.
+
+Good. Now let's add a third coordinate, z(t). If you actually
+sampled x and y at regular intervals, so that x and y lie on a
+grid, then you can construct a grid for z(x, y), and you would
+get a surface. This is the situation in which you would use
+C<mesh3d([$surface])>.
+
+Of course, your data is not required to be regularly gridded.
+You could, for example, be measuring the flight path of a bat
+flying after mosquitos, which could be wheeling and arching
+all over the space. This is what you might plot using
+C<line3d([$x, $y, $z])>. You could plot the trajectories of
+multiple bats, in which case C<$x>, C<$y>, and C<$z> would have
+multiple columns, but in general you wouldn't expect them to be
+coordinated.
+
+Finally, imagine that you have an air squadron flying in
+formation. Your (x, y, z) data is not regularly gridded, but
+the (x, y, z) data for each plane should be coordinated and
+we can imagine that their flight path sweep out a surface.
+We could draw this data using C<line3d([$x, $y, $z])>, where
+each column in the variables corresponds to a different plane,
+but it would also make sense to draw this data using
+C<mesh3d([$x, $y, $z])>, since the planes' proximity to each
+other should be fairly consistent. In other words, it makes
+sense to think of the planes as sweeping out a coordinated
+surface, which C<mesh3d> would draw for you, whereas you would
+not expect the trajectories of the various bats to describe a
+meaningful surface (unless you're into fractals, perhaps).
+
+ #!/usr/bin/perl
+
+ use PDL;
+ use PDL::Graphics::TriD;
+
+ # Draw out a trajectory in three-space
+ $t = sequence(100)/10;
+ $x = sin($t); $y = cos($t); $z = $t;
+
+ # Plot the trajectory as (x(t), y(t), z(t))
+ print "using line3d to plot a trajectory (press q when you're done twiddling)\n";
+ line3d [$x,$y,$z];
+
+ # If you give it a single piddle, it expects
+ # the data to look like
+ # ((x1, y1, z1), (x2, y2, z2), ...)
+ # which is why we have to do the exchange:
+ $coords = cat($x, $y, $z)->xchg(0,1);
+ print "again, with a different coordinate syntax (press q when you're done twiddling)\n";
+ line3d $coords;
+
+ # Draw a regularly-gridded surface:
+ $surface = sqrt(rvals(zeroes(50,50))/2);
+ print "draw a mesh of a regularly-gridded surface using mesh3d\n";
+ mesh3d [$surface];
+ print "draw a regularly-gridded surface using imag3d\n";
+ imag3d [$surface], {Lines=>0};
+
+ # Draw a mobius strip:
+ $two_pi = 8 * atan2(1,1);
+ $t = sequence(50) / 50 * $two_pi;
+ # We want two paths:
+ $mobius1_x = cos($t) + 0.5 * sin($t/2);
+ $mobius2_x = cos($t);
+ $mobius3_x = cos($t) - 0.5 * sin($t/2);
+ $mobius1_y = sin($t) + 0.5 * sin($t/2);
+ $mobius2_y = sin($t);
+ $mobius3_y = sin($t) - 0.5 * sin($t/2);
+ $mobius1_z = $t - $two_pi/2;
+ $mobius2_z = zeroes($t);
+ $mobius3_z = $two_pi/2 - $t;
+
+ $mobius_x = cat($mobius1_x, $mobius2_x, $mobius3_x);
+ $mobius_y = cat($mobius1_y, $mobius2_y, $mobius3_y);
+ $mobius_z = cat($mobius1_z, $mobius2_z, $mobius3_z);
+
+ $mobius_surface = cat($mobius_x, $mobius_y, $mobius_z)->mv(2,0);
+
+ print "A mobius strip using line3d one way\n";
+ line3d $mobius_surface;
+ print "A mobius strip using line3d the other way\n";
+ line3d $mobius_surface->xchg(1,2);
+ print "A mobius strip using mesh3d\n";
+ mesh3d $mobius_surface;
+ print "The same mobius strip using imag3d\n";
+ imag3d $mobius_surface, {Lines => 0};
+
+
+=head1 SIMPLE ROUTINES
+
+Because using the whole object-oriented interface for doing
+all your work might be cumbersome, the following shortcut
+routines are supported:
+
+=head1 FUNCTIONS
+
+=head2 line3d
+
+=for ref
+
+3D line plot, defined by a variety of contexts.
+
+=for usage
+
+ line3d piddle(3,x), {OPTIONS}
+ line3d [CONTEXT], {OPTIONS}
+
+=for example
+
+Example:
+
+ pdl> line3d [sqrt(rvals(zeroes(50,50))/2)]
+ - Lines on surface
+ pdl> line3d [$x,$y,$z]
+ - Lines over X, Y, Z
+ pdl> line3d $coords
+ - Lines over the 3D coordinates in $coords.
+
+Note: line plots differ from mesh plots in that lines
+only go in one direction. If this is unclear try both!
+
+See module documentation for more information on
+contexts and options
+
+=head2 imag3d
+
+=for ref
+
+3D rendered image plot, defined by a variety of contexts
+
+=for usage
+
+ imag3d piddle(3,x,y), {OPTIONS}
+ imag3d [piddle,...], {OPTIONS}
+
+=for example
+
+Example:
+
+ pdl> imag3d [sqrt(rvals(zeroes(50,50))/2)], {Lines=>0};
+
+ - Rendered image of surface
+
+See module documentation for more information on
+contexts and options
+
+=head2 mesh3d
+
+=for ref
+
+3D mesh plot, defined by a variety of contexts
+
+=for usage
+
+ mesh3d piddle(3,x,y), {OPTIONS}
+ mesh3d [piddle,...], {OPTIONS}
+
+=for example
+
+Example:
+
+ pdl> mesh3d [sqrt(rvals(zeroes(50,50))/2)]
+
+ - mesh of surface
+
+Note: a mesh is defined by two sets of lines at
+right-angles (i.e. this is how is differs from
+line3d).
+
+See module documentation for more information on
+contexts and options
+
+=head2 lattice3d
+
+=for ref
+
+alias for mesh3d
+
+=head2 points3d
+
+=for ref
+
+3D points plot, defined by a variety of contexts
+
+=for usage
+
+ points3d piddle(3), {OPTIONS}
+ points3d [piddle,...], {OPTIONS}
+
+=for example
+
+Example:
+
+ pdl> points3d [sqrt(rvals(zeroes(50,50))/2)];
+ - points on surface
+
+See module documentation for more information on
+contexts and options
+
+=head2 spheres3d
+
+=for ref
+
+3D spheres plot (preliminary implementation)
+
+=for usage
+
+ spheres3d piddle(3), {OPTIONS}
+ spheres3d [piddle,...], {OPTIONS}
+
+=for example
+
+Example:
+
+ pdl> spheres3d ndcoords(10,10,10)->clump(1,2,3)
+
+ - lattice of spheres at coordinates on 10x10x10 grid
+
+This is a preliminary implementation as a proof of
+concept. It has fixed radii for the spheres being
+drawn and no control of color or transparency.
+
+=head2 imagrgb
+
+=for ref
+
+2D RGB image plot (see also imag2d)
+
+=for usage
+
+ imagrgb piddle(3,x,y), {OPTIONS}
+ imagrgb [piddle,...], {OPTIONS}
+
+This would be used to plot an image, specifying
+red, green and blue values at each point. Note:
+contexts are very useful here as there are many
+ways one might want to do this.
+
+=for example
+
+e.g.
+
+ pdl> $a=sqrt(rvals(zeroes(50,50))/2)
+ pdl> imagrgb [0.5*sin(8*$a)+0.5,0.5*cos(8*$a)+0.5,0.5*cos(4*$a)+0.5]
+
+=head2 imagrgb3d
+
+=for ref
+
+2D RGB image plot as an object inside a 3D space
+
+=for usage
+
+ imagrdb3d piddle(3,x,y), {OPTIONS}
+ imagrdb3d [piddle,...], {OPTIONS}
+
+The piddle gives the colors. The option allowed is Points,
+which should give 4 3D coordinates for the corners of the polygon,
+either as a piddle or as array ref.
+The default is [[0,0,0],[1,0,0],[1,1,0],[0,1,0]].
+
+=for example
+
+e.g.
+
+ pdl> imagrgb3d $colors, {Points => [[0,0,0],[1,0,0],[1,0,1],[0,0,1]]};
+ - plot on XZ plane instead of XY.
+
+=head2 grabpic3d
+
+=for ref
+
+Grab a 3D image from the screen.
+
+=for usage
+
+ $pic = grabpic3d();
+
+The returned piddle has dimensions (3,$x,$y) and is of type float
+(currently). XXX This should be altered later.
+
+=head2 hold3d, release3d
+
+=for ref
+
+Keep / don't keep the previous objects when plotting new 3D objects
+
+=for usage
+
+ hold3d();
+ release3d();
+
+or
+
+ hold3d(1);
+ hold3d(0);
+
+=head2 keeptwiddling3d, nokeeptwiddling3d
+
+=for ref
+
+Wait / don't wait for 'q' after displaying a 3D image.
+
+Usually, when showing 3D images, the user is given a chance
+to rotate it and then press 'q' for the next image. However,
+sometimes (for e.g. animation) this is undesirable and it is
+more desirable to just run one step of the event loop at
+a time.
+
+=for usage
+
+ keeptwiddling3d();
+ nokeeptwiddling3d();
+
+or
+
+ keeptwiddling3d(1);
+ keeptwiddling3d(0);
+
+When an image is added to the screen, keep twiddling it until
+user explicitly presses 'q'.
+
+=for example
+
+ keeptwiddling3d();
+ imag3d(..);
+ nokeeptwiddling3d();
+ $o = imag3d($c);
+ while(1) {
+ $c .= nextfunc($c);
+ $o->data_changed();
+ twiddle3d(); # animate one step, then return.
+ }
+
+=head2 twiddle3d
+
+=for ref
+
+Wait for the user to rotate the image in 3D space.
+
+Let the user rotate the image in 3D space, either for one step
+or until (s)he presses 'q', depending on the 'keeptwiddling3d'
+setting. If 'keeptwiddling3d' is not set the routine returns
+immediately and indicates that a 'q' event was received by
+returning 1. If the only events received were mouse events,
+returns 0.
+
+=head1 CONCEPTS
+
+The key concepts (object types) of TriD are explained in the following:
+
+=head2 Object
+
+In this 3D abstraction, everything that you can "draw"
+without using indices is an Object. That is, if you have a surface,
+each vertex is not an object and neither is each segment of a long
+curve. The whole curve (or a set of curves) is the lowest level Object.
+
+Transformations and groups of Objects are also Objects.
+
+A Window is simply an Object that has subobjects.
+
+=head2 Twiddling
+
+Because there is no eventloop in Perl yet and because it would
+be hassleful to do otherwise, it is currently not possible to
+e.g. rotate objects with your mouse when the console is expecting
+input or the program is doing other things. Therefore, you need
+to explicitly say "$window->twiddle()" in order to display anything.
+
+=head1 OBJECTS
+
+The following types of objects are currently supported.
+Those that do not have a calling sequence described here should
+have their own manual pages.
+
+There are objects that are not mentioned here; they are either internal
+to PDL3D or in rapidly changing states. If you use them, you do so at
+your own risk.
+
+The syntax C<PDL::Graphics::TriD::Scale(x,y,z)> here means that you create
+an object like
+
+ $a = new PDL::Graphics::TriD::Scale($x,$y,$z);
+
+=head2 PDL::Graphics::TriD::LineStrip
+
+This is just a line or a set of lines. The arguments are 3 1-or-more-D
+piddles which describe the vertices of a continuous line and an
+optional color piddle (which is 1-D also and simply
+defines the color between red and blue. This will probably change).
+
+=head2 PDL::Graphics::TriD::Lines
+
+This is just a line or a set of lines. The arguments are 3 1-or-more-D
+piddles where each contiguous pair of vertices describe a line segment
+and an optional color piddle (which is 1-D also and simply
+defines the color between red and blue. This will probably change).
+
+=head2 PDL::Graphics::TriD::Image
+
+This is a 2-dimensional RGB image consisting of colored
+rectangles. With OpenGL, this is implemented by texturing so this should
+be relatively memory and execution-time-friendly.
+
+=head2 PDL::Graphics::TriD::Lattice
+
+This is a 2-D set of points connected by lines in 3-space.
+The constructor takes as arguments 3 2-dimensional piddles.
+
+=head2 PDL::Graphics::TriD::Points
+
+This is simply a set of points in 3-space. Takes as arguments
+the x, y and z coordinates of the points as piddles.
+
+=head2 PDL::Graphics::TriD::Scale(x,y,z)
+
+Self-explanatory
+
+=head2 PDL::Graphics::TriD::Translation(x,y,z)
+
+Ditto
+
+=head2 PDL::Graphics::TriD::Quaternion(c,x,y,z)
+
+One way of representing rotations is with quaternions. See the appropriate
+man page.
+
+=head2 PDL::Graphics::TriD::ViewPort
+
+This is a special class: in order to obtain a new viewport, you
+need to have an earlier viewport on hand. The usage is:
+
+ $new_vp = $old_vp->new_viewport($x0,$y0,$x1,$y1);
+
+where $x0 etc are the coordinates of the upper left and lower right
+corners of the new viewport inside the previous (relative
+to the previous viewport in the (0,1) range.
+
+Every implementation-level window object should implement the new_viewport
+method.
+
+=head1 EXAMPLE SCRIPT FOR VARIOUS
+
+=cut
+
+#KGB: NEEDS DOCS ON COMMON OPTIONS!!!!!
+
+# List of global variables
+#
+# $PDL::Graphics::TriD::offline
+# $PDL::Graphics::TriD::Settings
+# $PDL::Graphics::TriD::verbose
+# $PDL::Graphics::TriD::keeptwiddling
+# $PDL::Graphics::TriD::hold_on
+# $PDL::Graphics::TriD::curgraph
+# $PDL::Graphics::TriD::cur
+# $PDL::Graphics::TriD::create_window_sub
+# $PDL::Graphics::TriD::current_window
+#
+# '
+
+package PDL::Graphics::TriD::Basic;
+package PDL::Graphics::TriD;
+
+use PDL::Exporter;
+use PDL::Core ''; # barf
+use vars qw/@ISA @EXPORT_OK %EXPORT_TAGS/;
+ at ISA = qw/PDL::Exporter/;
+ at EXPORT_OK = qw/imag3d_ns imag3d line3d mesh3d lattice3d points3d
+ spheres3d describe3d imagrgb imagrgb3d hold3d release3d
+ keeptwiddling3d nokeeptwiddling3d
+ twiddle3d grabpic3d tridsettings/;
+%EXPORT_TAGS = (Func=>[@EXPORT_OK]);
+
+#use strict;
+use PDL::Graphics::TriD::Object;
+use PDL::Graphics::TriD::Window;
+use PDL::Graphics::TriD::ViewPort;
+use PDL::Graphics::TriD::Graph;
+use PDL::Graphics::TriD::Quaternion;
+use PDL::Graphics::TriD::Objects;
+use PDL::Graphics::TriD::Rout;
+
+
+# Then, see which display method are we using:
+
+BEGIN {
+ my $dev;
+ $dev ||= $::PDL::Graphics::TriD::device; # First, take it from this variable.
+ $dev ||= $::ENV{PDL_3D_DEVICE};
+
+ if(!defined $dev) {
+# warn "Default PDL 3D device is GL (OpenGL):
+# Set PDL_3D_DEVICE=GL in your environment in order not to see this warning.
+# You must have OpenGL or Mesa installed and the PDL::Graphics::OpenGL extension
+# compiled. Otherwise you will get strange warnings.";
+
+ $dev = "GL"; # default GL works on all platforms now
+ }
+ my $dv;
+# The following is just a sanity check.
+ for($dev) {
+# (/^OOGL$/ and $dv="PDL::Graphics::TriD::OOGL") or
+ (/^GL$/ and $dv="PDL::Graphics::TriD::GL") or
+ (/^GLpic$/ and $dv="PDL::Graphics::TriD::GL" and $PDL::Graphics::TriD::offline=1) or
+ (/^VRML$/ and $dv="PDL::Graphics::TriD::VRML" and $PDL::Graphics::TriD::offline=1) or
+ (barf "Invalid PDL 3D device '$_' specified!");
+ }
+ my $mod = $dv;
+ $mod =~ s|::|//|g;
+ print "dev = $dev mod=$mod\n" if($verbose);
+
+ require "$mod.pm";
+ $dv->import;
+ my $verbose;
+}
+
+
+# currently only used by VRML backend
+sub tridsettings {return $PDL::Graphics::TriD::Settings}
+
+# Allowable forms:
+# x(3,..) [x(..),y(..),z(..)]
+sub realcoords {
+ my($type,$c) = @_;
+ if(ref $c ne "ARRAY") {
+ if($c->getdim(0) != 3) {
+ barf "If one piddle given for coordinate, must be (3,...) or have default interpretation";
+ }
+ return $c ;
+ }
+ if(!ref $c->[0]) {$type = shift @$c}
+ if($#$c < 0 || $#$c>2) {
+ barf "Must have 1..3 array members for coordinates";
+ }
+ if($#$c == 0 and $type =~ /^SURF2D$/) {
+ # surf2d -> this is z axis
+ @$c = ($c->[0]->xvals,$c->[0]->yvals,$c->[0]);
+ } elsif($#$c == 0 and $type eq "POLAR2D") {
+ my $t = 6.283 * $c->[0]->xvals / ($c->[0]->getdim(0)-1);
+ my $r = $c->[0]->yvals / ($c->[0]->getdim(1)-1);
+ @$c = ($r * sin($t), $r * cos($t), $c->[0]);
+ } elsif($#$c == 0 and $type eq "COLOR") {
+ # color -> 1 piddle = grayscale
+ @$c = ($c->[0], $c->[0], $c->[0]);
+ } elsif($#$c == 0 and $type eq "LINE") {
+ @$c = ($c->[0]->xvals, $c->[0], 0);
+ } elsif($#$c == 1 and $type eq "LINE") {
+ @$c = ($c->[0], $c->[1], $c->[0]->xvals);
+ }
+ # XXX
+ if($#$c != 2) {
+ barf("Must have 3 coordinates if no interpretation (here '$type')");
+ }
+ # allow a constant (either pdl or not) to be introduced in one dimension
+ foreach(0..2){
+ if(ref($c->[$_]) ne "PDL" or $c->[$_]->nelem==1){
+ $c->[$_] = $c->[$_]*(PDL->ones($c->[($_+1)%3]->dims));
+ }
+ }
+ my $g = PDL->null;
+ &PDL::Graphics::TriD::Rout::combcoords(@$c,$g);
+ $g->dump if $PDL::Graphics::TriD::verbose;
+ return $g;
+}
+
+sub objplotcommand {
+ my($object) = @_;
+ my $win = PDL::Graphics::TriD::get_current_window();
+ my $world = $win->world();
+}
+
+sub checkargs {
+ if(ref $_[$#_] eq "HASH" and $PDL::Graphics::TriD::verbose) {
+
+ print "enter checkargs \n";
+ for([KeepTwiddling,\&keeptwiddling3d]) {
+ print "checkargs >$_<\n";
+ if(defined $_[$#_]{$_->[0]}) {
+ &{$_->[1]}(delete $_[$#_]{$_->[0]});
+ }
+ }
+ }
+}
+
+*keeptwiddling3d = \&PDL::keeptwiddling3d;
+sub PDL::keeptwiddling3d {
+ $PDL::Graphics::TriD::keeptwiddling = (defined $_[0] ? $_[0] : 1);
+}
+*nokeeptwiddling3d = \&PDL::nokeeptwiddling3d;
+sub PDL::nokeeptwiddling3d {
+ $PDL::Graphics::TriD::keeptwiddling = 0 ;
+}
+keeptwiddling3d();
+*twiddle3d = \&PDL::twiddle3d;
+sub PDL::twiddle3d {
+ twiddle_current();
+}
+
+sub graph_object {
+ my($obj) = @_;
+ if(!defined $obj or !ref $obj) {
+ barf("Invalid object to TriD::graph_object");
+ }
+ print "graph_object: calling get_new_graph\n" if($PDL::debug_trid);
+ my $g = get_new_graph();
+ print "graph_object: back from get_new_graph\n" if($PDL::debug_trid);
+
+ my $name = $g->add_dataseries($obj);
+ $g->bind_default($name);
+ $g->scalethings();
+ print "ADDED TO GRAPH: '$name'\n" if $PDL::Graphics::TriD::verbose;
+
+ twiddle_current();
+ return $obj;
+}
+
+# Plotting routines that use the whole viewport
+
+*describe3d=\&PDL::describe3d;
+sub PDL::describe3d {
+ require PDL::Graphics::TriD::TextObjects;
+ my ($text) = @_;
+ my $win = PDL::Graphics::TriD::get_current_window();
+ my $imag = new PDL::Graphics::TriD::Description($text);
+ $win->add_object($imag);
+# $win->twiddle();
+}
+
+*imagrgb=\&PDL::imagrgb;
+sub PDL::imagrgb {
+ require PDL::Graphics::TriD::Image;
+ my (@data) = @_; &checkargs;
+ my $win = PDL::Graphics::TriD::get_current_window();
+ my $imag = new PDL::Graphics::TriD::Image(@data);
+
+ $win->clear_viewports();
+
+ $win->current_viewport()->add_object($imag);
+ $win->twiddle();
+}
+
+# Plotting routines that use the 3D graph
+
+# Call: line3d([$x,$y,$z],[$color]);
+*line3d=\&PDL::line3d;
+sub PDL::line3d {
+ &checkargs;
+ my $obj = new PDL::Graphics::TriD::LineStrip(@_);
+ print "line3d: object is $obj\n" if($PDL::debug_trid);
+ &graph_object($obj);
+}
+
+*contour3d=\&PDL::contour3d;
+sub PDL::contour3d {
+# &checkargs;
+ require PDL::Graphics::TriD::Contours;
+ &graph_object(new PDL::Graphics::TriD::Contours(@_));
+}
+
+# XXX Should enable different positioning...
+*imagrgb3d=\&PDL::imagrgb3d;
+sub PDL::imagrgb3d { &checkargs;
+ require PDL::Graphics::TriD::Image;
+ &graph_object(new PDL::Graphics::TriD::Image(@_));
+}
+
+*imag3d_ns=\&PDL::imag3d_ns;
+sub PDL::imag3d_ns { &checkargs;
+ &graph_object(new PDL::Graphics::TriD::SLattice(@_));
+}
+
+*imag3d=\&PDL::imag3d;
+sub PDL::imag3d { &checkargs;
+ &graph_object(new PDL::Graphics::TriD::SLattice_S(@_));
+}
+
+####################################################################
+################ JNK 15mar11 added section start ###################
+*STrigrid_S_imag3d=\&PDL::STrigrid_S_imag3d;
+sub PDL::STrigrid_S_imag3d { &checkargs;
+ &graph_object(new PDL::Graphics::TriD::STrigrid_S(@_)); }
+
+*STrigrid_imag3d=\&PDL::STrigrid_imag3d;
+sub PDL::STrigrid_imag3d { &checkargs;
+ &graph_object(new PDL::Graphics::TriD::STrigrid(@_)); }
+################ JNK 15mar11 added section finis ###################
+####################################################################
+
+*mesh3d=\&PDL::mesh3d;
+*lattice3d=\&PDL::mesh3d;
+*PDL::lattice3d=\&PDL::mesh3d;
+sub PDL::mesh3d { &checkargs;
+ &graph_object(new PDL::Graphics::TriD::Lattice(@_));
+}
+
+*points3d=\&PDL::points3d;
+sub PDL::points3d { &checkargs;
+ &graph_object(new PDL::Graphics::TriD::Points(@_));
+}
+
+
+*spheres3d=\&PDL::spheres3d;
+sub PDL::spheres3d { &checkargs;
+ &graph_object(new PDL::Graphics::TriD::Spheres(@_));
+}
+
+*grabpic3d=\&PDL::grabpic3d;
+sub PDL::grabpic3d {
+ my $win = PDL::Graphics::TriD::get_current_window();
+ barf "backend doesn't support grabing the rendered scene"
+ unless $win->can('read_picture');
+ my $pic = $win->read_picture();
+ return ($pic->float) / 255;
+}
+
+$PDL::Graphics::TriD::hold_on = 0;
+
+sub PDL::hold3d {$PDL::Graphics::TriD::hold_on =(!defined $_[0] ? 1 : $_[0]);}
+sub PDL::release3d {$PDL::Graphics::TriD::hold_on = 0;}
+
+*hold3d=\&PDL::hold3d;
+*release3d=\&PDL::release3d;
+
+sub get_new_graph {
+ print "get_new_graph: calling PDL::Graphics::TriD::get_current_window...\n" if($PDL::debug_trid);
+ my $win = PDL::Graphics::TriD::get_current_window();
+
+ print "get_new_graph: calling get_current_graph...\n" if($PDL::debug_trid);
+ my $g = get_current_graph($win);
+ print "get_new_graph: back get_current_graph returned $g...\n" if($PDL::debug_trid);
+
+ if(!$PDL::Graphics::TriD::hold_on) {
+ $g->clear_data();
+ $win->clear_viewport();
+ }
+ $g->default_axes();
+
+ $win->add_object($g);
+ return $g;
+}
+
+sub get_current_graph {
+ my $win = shift;
+ my $g = $win->current_viewport()->graph();
+
+ if(!defined $g) {
+ $g = new PDL::Graphics::TriD::Graph();
+ $g->default_axes();
+ $win->current_viewport()->graph($g);
+ }
+ return $g;
+}
+
+
+# $PDL::Graphics::TriD::cur = {};
+# $PDL::Graphics::TriD::create_window_sub = undef;
+sub get_current_window {
+ my $opts = shift @_;
+ my $win = $PDL::Graphics::TriD::cur;
+
+ if(!defined $win) {
+ if(!$PDL::Graphics::TriD::create_window_sub) {
+ barf("PDL::Graphics::TriD must be used with a display mechanism: for example PDL::Graphics::TriD::GL!\n");
+ }
+ print "get_current_window - creating window...\n" if($PDL::debug_trid);
+ $win = new PDL::Graphics::TriD::Window($opts);
+
+ print "get_current_window - calling set_material...\n" if($PDL::debug_trid);
+ $win->set_material(new PDL::Graphics::TriD::Material);
+ $PDL::Graphics::TriD::current_window = $win;
+ $PDL::Graphics::TriD::cur = $win
+ }
+ return $PDL::Graphics::TriD::current_window;
+}
+
+# Get the current graphbox
+sub get_current_graphbox {
+ die "get_current_graphbox: ERROR graphbox is not implemented! \n";
+ my $graph = $PDL::Graphics::TriD::curgraph;
+ if(!defined $graph) {
+ $graph = new PDL::Graphics::TriD::Graph();
+ $graph->default_axes();
+ $PDL::Graphics::TriD::curgraph = $graph;
+ }
+ return $graph;
+}
+
+sub twiddle_current {
+ my $win = get_current_window();
+ $win->twiddle();
+}
+
+###################################
+#
+#
+package PDL::Graphics::TriD::Material;
+
+sub new {
+ my ($type,%ops) = @_;
+ my $this = bless {}, $type;
+ for (['Shine',40],
+ ['Specular',[1,1,0.3,0]],
+ ['Ambient',[0.3,1,1,0]],
+ ['Diffuse',[1,0.3,1,0]],
+ ['Emissive',[0,0,0]]) {
+ if (!defined $ops{$_->[0]}) {
+ $this->{$_->[0]} = $_->[1];
+ } else {
+ $this->{$_->[0]} = $ops{$_->[0]};
+ }
+ }
+ return $this;
+}
+
+package PDL::Graphics::TriD::BoundingBox;
+use base qw/PDL::Graphics::TriD::Object/;
+use fields qw/Box/;
+
+sub new {
+ my($type,$x0,$y0,$z0,$x1,$y1,$z1) = @_;
+ my $this = $type->SUPER::new();
+ $this->{Box} = [$x0,$y0,$z0,$x1,$y1,$z1];
+}
+
+sub normalize {my($this,$x0,$y0,$z0,$x1,$y1,$z1) = @_;
+ $this = $this->{Box};
+ my $trans = PDL::Graphics::TriD::Transformation->new();
+ my $sx = ($x1-$x0)/($this->[3]-$this->[0]);
+ my $sy = ($y1-$y0)/($this->[4]-$this->[1]);
+ my $sz = ($z1-$z0)/($this->[5]-$this->[2]);
+ $trans->add_transformation(
+ PDL::Graphics::TriD::Translation->new(
+ ($x0-$this->[0]*$sx),
+ ($y0-$this->[1]*$sy),
+ ($z0-$this->[2]*$sz)
+ ));
+ $trans->add_transformation(PDL::Graphics::TriD::Scale->new($sx,$sy,$sz));
+ return $trans;
+}
+
+
+###################################
+#
+#
+package PDL::Graphics::TriD::OneTransformation;
+use fields qw/Args/;
+
+sub new {
+ my($type, at args) = @_;
+ my $this = fields::new($type);
+
+ $this->{Args} = [@args];
+
+ $this;
+}
+
+package PDL::Graphics::TriD::Scale;
+use base qw/PDL::Graphics::TriD::OneTransformation/;
+
+package PDL::Graphics::TriD::Translation;
+use base qw/PDL::Graphics::TriD::OneTransformation/;
+
+
+package PDL::Graphics::TriD::Transformation;
+use base qw/PDL::Graphics::TriD::Object/;
+
+#sub new {
+# my($type) = @_;
+# bless {},$type;
+#}
+
+sub add_transformation {
+ my($this,$trans) = @_;
+ push @{$this->{Transforms}},$trans;
+}
+
+
+
+=head1 BUGS
+
+Not enough is there yet.
+
+=head1 AUTHOR
+
+Copyright (C) 1997 Tuomas J. Lukka (lukka at husc.harvard.edu). Documentation
+contributions from Karl Glazebrook (kgb at aaoepp.aao.gov.au).
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
diff --git a/Graphics/TriD/TriD/ArcBall.pm b/Graphics/TriD/TriD/ArcBall.pm
new file mode 100644
index 0000000..3ab4c98
--- /dev/null
+++ b/Graphics/TriD/TriD/ArcBall.pm
@@ -0,0 +1,122 @@
+###################################################
+#
+# ArcBall.pm
+#
+# From Graphics Gems IV.
+#
+# This is an example of the controller class:
+# the routines set_wh and mouse_moved are the standard routines.
+#
+# This needs a faster implementation (?)
+
+package PDL::Graphics::TriD::QuaterController;
+use base qw(PDL::Graphics::TriD::ButtonControl);
+use fields qw /Inv Quat/;
+
+sub new {
+ my($type,$win,$inv,$quat) = @_;
+ my $this = $type->SUPER::new($win);
+
+
+ $this->{Inv} = $inv;
+ $this->{Quat} = (defined($quat) ? $quat :
+ new PDL::Graphics::TriD::Quaternion(1,0,0,0));
+ $win->add_resizecommand(sub {$this->set_wh(@_)});
+ return $this;
+}
+
+sub xy2qua {
+ my($this,$x,$y) = @_;
+ $x -= $this->{W}/2; $y -= $this->{H}/2;
+ $x /= $this->{SC}; $y /= $this->{SC};
+ $y = -$y;
+ return $this->normxy2qua($x,$y);
+}
+
+sub mouse_moved {
+ my($this,$x0,$y0,$x1,$y1) = @_;
+
+ # Copy the size of the owning viewport to our size, in case it changed...
+ $this->{H} = $this->{Win}->{H};
+ $this->{W} = $this->{Win}->{W};
+
+ if($PDL::Graphics::TriD::verbose) {
+ print "QuaterController: mouse-moved: $this: $x0,$y0,$x1,$y1,$this->{W},$this->{H},$this->{SC}\n" if($PDL::Graphics::TriD::verbose);
+ if($PDL::Graphics::TriD::verbose > 1) {
+ print "\tthis is:\n";
+ foreach my $k(sort keys %$this) {
+ print "\t$k\t=>\t$this->{$k}\n";
+ }
+ }
+ }
+
+# Convert both to quaternions.
+
+ my ($qua0,$qua1) = ($this->xy2qua($x0,$y0),$this->xy2qua($x1,$y1));
+
+# print "ARCBALLQ: ",(join ', ',@$qua0)," ",(join ', ',@$qua1),"\n";
+
+ my $arc = $qua1->multiply($qua0->invert());
+
+# my $arc = $qua0->invert()->multiply($qua1);
+
+ if($this->{Inv}) {
+ $arc->invert_rotation_this();
+ }
+ $this->{Quat}->set($arc->multiply($this->{Quat}));
+
+ # print "ARCBALLQ: ",(join ', ',@$arc)," ",(join ', ',@{$this->{Quat}}),"\n";
+ # $this->{Quat}->set($this->{Quat}->multiply($arc));
+ 1; # signals a refresh
+}
+
+#
+# Original ArcBall
+#
+package PDL::Graphics::TriD::ArcBall;
+use base qw/PDL::Graphics::TriD::QuaterController/;
+
+# x,y to unit quaternion on the sphere.
+sub normxy2qua {
+ my($this,$x,$y) = @_;
+ my $dist = sqrt ($x ** 2 + $y ** 2);
+ if($dist > 1.0) {$x /= $dist; $y /= $dist; $dist = 1.0;}
+ my $z = sqrt(1-$dist**2);
+ return PDL::Graphics::TriD::Quaternion->new(0,$x,$y,$z);
+}
+
+# Tjl's version: a cone - more even change of
+package PDL::Graphics::TriD::ArcCone;
+
+use base qw/PDL::Graphics::TriD::QuaterController/;
+
+# x,y to unit quaternion on the sphere.
+sub normxy2qua {
+ my($this,$x,$y) = @_;
+ my $dist = sqrt ($x ** 2 + $y ** 2);
+ if($dist > 1.0) {$x /= $dist; $y /= $dist; $dist = 1.0;}
+ my $z = 1-$dist;
+ my $qua = PDL::Graphics::TriD::Quaternion->new(0,$x,$y,$z);
+ $qua->normalize_this();
+ return $qua;
+}
+
+# Tjl's version2: a bowl -- angle is proportional to displacement.
+package PDL::Graphics::TriD::ArcBowl;
+
+use base qw/PDL::Graphics::TriD::QuaterController/;
+
+# x,y to unit quaternion on the sphere.
+sub normxy2qua {
+ my($this,$x,$y) = @_;
+ my $dist = sqrt ($x ** 2 + $y ** 2);
+ if($dist > 1.0) {$x /= $dist; $y /= $dist; $dist = 1.0;}
+ my $z = cos($dist*3.142/2);
+ my $qua = PDL::Graphics::TriD::Quaternion->new(0,$x,$y,$z);
+ $qua->normalize_this();
+ return $qua;
+}
+
+
+
+1;
diff --git a/Graphics/TriD/TriD/ButtonControl.pm b/Graphics/TriD/TriD/ButtonControl.pm
new file mode 100644
index 0000000..9eea25e
--- /dev/null
+++ b/Graphics/TriD/TriD/ButtonControl.pm
@@ -0,0 +1,126 @@
+#!/usr/bin/perl
+#
+# PDL::Graphics::TriD::ButtonControl - This package simply defines
+# default event handler subroutines. $Revision$
+#
+# James P. Edwards
+# Instituto Nacional de Meteorologia
+# Brasilia, DF, Brasil
+# jedwards at inmet.gov.br
+#
+# This distribution is free software; you can
+# redistribute it and/or modify it under the same terms as Perl itself.
+#
+
+=head1 NAME
+
+PDL::Graphics::TriD::ButtonControl - default event handler subroutines
+
+=head1 FUNCTIONS
+
+=head2 new()
+
+=for ref
+
+Bless an oject into the class ButtonControl, expects the associated
+Window object to be supplied as an argument.
+
+=for usage
+
+The ButtonControl class is a base class which all TriD event
+controllers should inherit from. By itself it does not do much. It
+defines ButtonPressed and ButtonRelease functions which are expected by
+the Event loop.
+
+
+
+=cut
+
+package PDL::Graphics::TriD::ButtonControl;
+use strict;
+use fields qw/Win W H SC/;
+
+sub new {
+ my ($class,$win) = @_;
+
+ my $self = fields::new($class);
+ $self->{Win} = $win;
+
+ $self;
+}
+
+
+=head2 mouse_moved
+
+=for ref
+ A do nothing function to prevent errors if not defined in a subclass
+
+=cut
+
+sub mouse_moved{
+ print "mouse_moved @_\n" if $PDL::Graphics::TriD::verbose;
+}
+
+=head2 ButtonRelease
+
+=for ref
+ A do nothing function to prevent errors if not defined in a subclass
+
+=cut
+
+sub ButtonRelease{
+ my ($this,$x,$y) = @_;
+ $this->{Win}{Active} = 0;
+ print "ButtonRelease @_\n" if $PDL::Graphics::TriD::verbose;
+}
+
+=head2 ButtonPressed
+
+=for ref
+
+ Activates the viewport the mouse is inside when pressed
+
+=cut
+
+sub ButtonPress{
+ my ($this,$x,$y) = @_;
+
+
+#
+# GL (0,0) point is Lower left X and Tk is upper left.
+#
+ $y = $PDL::Graphics::TriD::cur->{Height}-$y;
+
+# print "$x $y ",$this->{Win}{X0}," ",$this->{Win}{Y0}," ",$this->{Win}{W}," ",$this->{Win}{H},"\n";
+
+ if($this->{Win}{X0} <= $x && $this->{Win}{X0}+$this->{Win}{W}>=$x
+ && $this->{Win}{Y0} <= $y && $this->{Win}{Y0}+$this->{Win}{H}>=$y ){
+ $this->{Win}{Active} = 1;
+ }
+ print "ButtonPress @_ ",ref($this->{Win}),"\n" if $PDL::Graphics::TriD::verbose;
+}
+
+=head2 set_wh
+
+=for ref
+
+ Define the width and Height of the window for button control
+
+=cut
+
+sub set_wh {
+ my($this,$w,$h) = @_;
+ print ref($this)," $w,$h\n" if $PDL::Graphics::TriD::verbose;
+ $this->{W} = $w;
+ $this->{H} = $h;
+ $w = 0 unless defined $w;
+ $h = 0 unless defined $h;
+ if($w > $h) {
+ $this->{SC} = $h/2;
+ } else {
+ $this->{SC} = $w/2;
+ }
+}
+
+
+1;
diff --git a/Graphics/TriD/TriD/Contours.pm b/Graphics/TriD/TriD/Contours.pm
new file mode 100644
index 0000000..85aabd0
--- /dev/null
+++ b/Graphics/TriD/TriD/Contours.pm
@@ -0,0 +1,333 @@
+=head1 NAME
+
+ PDL::Graphics::TriD::Contours - 3D Surface contours for TriD
+
+=head1 SYNOPSIS
+
+=for usage
+
+ # A simple contour plot in black and white
+
+ use PDL::Graphics::TriD;
+ use PDL::Graphics::TriD::Contours;
+ $size = 25;
+ $x = (xvals zeroes $size,$size) / $size;
+ $y = (yvals zeroes $size,$size) / $size;
+ $z = (sin($x*6.3) * sin($y*6.3)) ** 3;
+ $data=new PDL::Graphics::TriD::Contours($z,
+ [$z->xvals/$size,$z->yvals/$size,0]);
+ PDL::Graphics::TriD::graph_object($data)
+
+=cut
+
+package PDL::Graphics::TriD::Contours;
+use strict;
+use PDL;
+use PDL::Graphics::TriD;
+use PDL::Graphics::TriD::Rout;
+use PDL::Graphics::TriD::Labels;
+#use Data::Dumper;
+
+use base qw/PDL::Graphics::TriD::GObject/;
+use fields qw/ContourSegCnt Labels LabelStrings/;
+
+=head1 FUNCTIONS
+
+=head2 new()
+
+=for ref
+
+Define a new contour plot for TriD.
+
+=for example
+
+ $data=new PDL::Graphics::TriD::Contours($d,[$x,$y,$z],[$r,$g,$b],$options);
+
+where $d is a 2D pdl of data to be contoured. [$x,$y,$z] define a 3D
+map of $d into the visualization space [$r,$g,$b] is an optional [3,1]
+piddle specifing the contour color and $options is a hash reference to
+a list of options documented below. Contours can also be colored by
+value using the set_color_table function.
+
+=for opt
+
+ ContourInt => 0.7 # explicitly set a contour interval
+ ContourMin => 0.0 # explicitly set a contour minimum
+ ContourMax => 10.0 # explicitly set a contour maximum
+ ContourVals => $pdl # explicitly set all contour values
+ Label => [1,5,$myfont] # see addlabels below
+ Font => $font # explicitly set the font for contour labels
+
+ If ContourVals is specified ContourInt, ContourMin, and ContourMax
+ are ignored. If no options are specified, the algorthym tries to
+ choose values based on the data supplied. Font can also be specified or
+ overwritten by the addlabels() function below.
+
+=cut
+
+sub new{
+ my($type,$data,$points,$colors,$options) = @_;
+
+ if(! defined $points){
+ $points = [$data->xvals,$data->yvals,$data->zvals];
+ }
+
+ if(ref($colors) eq "HASH"){
+ $options=$colors ;
+ undef $colors;
+ }
+
+ $colors = PDL::Graphics::TriD::realcoords("COLOR",pdl[1,1,1]) unless defined $colors;
+
+ my $this = $type->SUPER::new($points,$colors,$options);
+
+ my $grid = $this->{Points};
+
+ $this->{ContourSegCnt} = [];
+
+ my @lines;
+ my($xmin,$dx,$ymin,$dy);
+
+ my @dims = $data->dims();
+
+ my $d0 = $dims[0]-1;
+ my $d1 = $dims[1]-1;
+
+
+ my ($min,$max) = $data->minmax();
+
+
+ my $fac=1;
+
+ unless(defined $this->{Options}{ContourMin}){
+ while($fac*($max-$min)<10){
+ $fac*=10;
+ }
+ if(int($fac*$min) == $fac*$min){
+ $this->{Options}{ContourMin} = $min;
+ }else{
+ $this->{Options}{ContourMin} = int($fac*$min+1)/$fac;
+ print "ContourMin = ",$this->{Options}{ContourMin},"\n"
+ if($PDL::Graphics::TriD::verbose);
+ }
+ }
+ unless(defined $this->{Options}{ContourMax} &&
+ $this->{Options}{ContourMax} > $this->{Options}{ContourMin} ){
+ if(defined $this->{Options}{ContourInt}){
+ $this->{Options}{ContourMax} = $this->{Options}{ContourMin};
+ while($this->{Options}{ContourMax}+$this->{Options}{ContourInt} < $max){
+ $this->{Options}{ContourMax}= $this->{Options}{ContourMax}+$this->{Options}{ContourInt};
+ }
+ }else{
+ if(int($fac*$max) == $fac*$max){
+ $this->{Options}{ContourMax} = $max;
+ }else{
+ $this->{Options}{ContourMax} = (int($fac*$max)-1)/$fac;
+ print "ContourMax = ",$this->{Options}{ContourMax},"\n"
+ if($PDL::Graphics::TriD::verbose);
+ }
+ }
+ }
+ unless(defined $this->{Options}{ContourInt} && $this->{Options}{ContourInt}>0){
+ $this->{Options}{ContourInt} = int($fac*($this->{Options}{ContourMax}-$this->{Options}{ContourMin}))/(10*$fac);
+ print "ContourInt = ",$this->{Options}{ContourInt},"\n"
+ if($PDL::Graphics::TriD::verbose);
+ }
+#
+# The user could also name cvals
+#
+ my $cvals;
+ if( !defined($this->{Options}{ContourVals}) || $this->{Options}{ContourVals}->isempty){
+ $cvals=zeroes(int(($this->{Options}{ContourMax}-$this->{Options}{ContourMin})/$this->{Options}{ContourInt}+1));
+ $cvals = $cvals->xlinvals($this->{Options}{ContourMin},$this->{Options}{ContourMax});
+ }else{
+ $cvals = $this->{Options}{ContourVals};
+ $this->{Options}{ContourMax}=$cvals->max;
+ $this->{Options}{ContourMin}=$cvals->min;
+ }
+ $this->{Options}{ContourVals} = $cvals;
+
+ print "Cvals = $cvals\n" if($PDL::Graphics::TriD::verbose);
+
+ $this->contour_segments($cvals,$data,$grid);
+
+ $this->addlabels($this->{Options}{Labels}) if(defined $this->{Options}{Labels});
+
+ return $this;
+}
+
+
+
+sub get_valid_options{
+ return{ ContourInt => undef,
+ ContourMin => undef,
+ ContourMax=> undef,
+ ContourVals=> pdl->null,
+ UseDefcols=>1,
+ Labels=> undef,
+ Font=>$PDL::Graphics::TriD::GL::fontbase}
+}
+
+
+
+
+=head2 addlabels()
+
+=for ref
+
+Add labels to a contour plot
+
+=for usage
+
+ $contour->addlabels($labelint,$segint,$font);
+
+$labelint is the integer interval between labeled contours. If you
+have 8 countour levels and specify $labelint=3 addlabels will attempt
+to label the 1st, 4th, and 7th contours. $labelint defaults to 1.
+
+$segint specifies the density of labels on a single contour
+level. Each contour level consists of a number of connected
+line segments, $segint defines how many of these segments get labels.
+$segint defaults to 5, that is every fifth line segment will be labeled.
+
+
+=cut
+
+sub addlabels{
+ my ($self,$labelint, $segint ,$font) = @_;
+
+ $labelint = 1 unless(defined $labelint);
+ $font = $self->{Options}{Font} unless(defined $font);
+ $segint = 5 unless(defined $segint);
+
+ my $cnt=0;
+
+ my $strlist;
+ my $lp=pdl->null;
+
+ my $pcnt = 0;
+ my $cnt;
+ my $offset = pdl[0.5,0.5,0.5];
+
+ for(my $i=0; $i<= $#{$self->{ContourSegCnt}}; $i++){
+ next unless defined $self->{ContourSegCnt}[$i];
+ $cnt = $self->{ContourSegCnt}[$i];
+ my $val = $self->{Options}{ContourVals}->slice("($i)");
+
+ my $leg = $self->{Points}->slice(":,$pcnt:$cnt");
+ $pcnt=$cnt+1;
+
+ next if($i % $labelint);
+
+ for(my $j=0; $j< $leg->getdim(1); $j+=2){
+ next if(($j/2) % $segint);
+
+ my $j1=$j+1;
+
+ my $lp2 = $leg->slice(":,($j)") +
+ $offset*($leg->slice(":,($j1)") -
+ $leg->slice(":,($j)"));
+
+
+ $lp = $lp->append($lp2);
+# need a label string for each point
+ push(@$strlist,$val);
+
+ }
+
+ }
+ if($lp->nelem>0){
+ $self->{Points} = $self->{Points}->xchg(0,1)
+ ->append($lp->reshape(3,$lp->nelem/3)->xchg(0,1))->xchg(0,1);
+ $self->{Labels} = [$cnt+1,$cnt+$lp->nelem/3];
+ $self->{LabelStrings} = $strlist;
+ $self->{Options}{Font}=$font;
+ }
+
+}
+
+=head2 set_colortable($table)
+
+=for ref
+
+Sets contour level colors based on the color table.
+
+=for usage
+
+$table is passed in as either a piddle of [3,n] colors, where n is the
+number of contour levels, or as a reference to a function which
+expects the number of contour levels as an argument and returns a
+[3,n] piddle. It should be straight forward to use the
+L<PDL::Graphics::LUT> tables in a function which subsets the 256
+colors supplied by the look up table into the number of colors needed
+by Contours.
+
+=cut
+
+sub set_colortable{
+ my($self,$table) = @_;
+ my $colors;
+ if(ref($table) eq "CODE"){
+ my $min = $self->{Options}{ContourMin};
+ my $max = $self->{Options}{ContourMax};
+ my $int = $self->{Options}{ContourInt};
+ my $ncolors=($max-$min)/$int+1;
+ $colors= &$table($ncolors);
+ }else{
+ $colors = $table;
+ }
+
+ if($colors->getdim(0)!=3){
+ $colors->reshape(3,$colors->nelem/3);
+ }
+ print "Color info ",$self->{Colors}->info," ",$colors->info,"\n" if($PDL::Graphics::TriD::verbose);
+
+ $self->{Colors} = $colors;
+}
+
+=head2 coldhot_colortable()
+
+=for ref
+
+A simple colortable function for use with the set_colortable function.
+
+=for usage
+
+coldhot_colortable defines a blue red spectrum of colors where the
+smallest contour value is blue, the highest is red and the others are
+shades in between.
+
+=cut
+
+sub coldhot_colortable{
+ my($ncolors) = @_;
+ my $colorpdl;
+ # 0 red, 1 green, 2 blue
+ for(my $i=0;$i<$ncolors;$i++){
+ my $color = zeroes(float,3);
+ (my $t = $color->slice("0")) .= 0.75*($i)/$ncolors;
+ ($t = $color->slice("2")) .= 0.75*($ncolors-$i)/$ncolors;
+ if($i==0){
+ $colorpdl = $color;
+ }else{
+ $colorpdl = $colorpdl->append($color);
+ }
+ }
+ return($colorpdl);
+}
+
+1;
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Graphics/TriD/TriD/Control3D.pm b/Graphics/TriD/TriD/Control3D.pm
new file mode 100644
index 0000000..8b014f9
--- /dev/null
+++ b/Graphics/TriD/TriD/Control3D.pm
@@ -0,0 +1,65 @@
+package PDL::Graphics::TriD::Control3D;
+
+# Mustn't have empty package in some perl versions.
+
+##############################################
+#
+# A quaternion-based controller framework with the following transformations:
+# 1. world "origin". This is what the world revolves around
+# 2. world "rotation" at origin.
+# 3. camera "distance" along z axis after that (camera looks
+# at negative z axis).
+# 4. camera "rotation" after that (not always usable).
+
+
+package PDL::Graphics::TriD::SimpleController;
+use strict;
+use fields qw/WOrigin WRotation CDistance CRotation/;
+
+sub new{
+ my ($class) = @_;
+
+ my $self = fields::new($class);
+ $self->reset();
+
+ $self;
+}
+
+sub normalize { my($this) = @_;
+ $this->{WRotation}->normalize_this();
+ $this->{CRotation}->normalize_this();
+}
+
+sub reset {
+ my($this) = @_;
+ $this->{WOrigin} = [0,0,0];
+ $this->{WRotation} = PDL::Graphics::TriD::Quaternion->new(1,0,0,0);
+# $this->{WRotation} = PDL::Graphics::TriD::Quaternion->new(
+# 0.847, -0.458, -0.161, -0.216);
+# $this->{WRotation} = PDL::Graphics::TriD::Quaternion->new(
+# 0.347, -0.458, -0.161, -0.216);
+
+ $this->{CDistance} = 5;
+ $this->{CRotation} = PDL::Graphics::TriD::Quaternion->new(1,0,0,0);
+}
+
+sub set {
+ my($this,$options) = @_;
+
+ foreach my $what (keys %$options){
+ if($what =~ /Rotation/){
+ $this->{$what}[0] = $options->{$what}[0];
+ $this->{$what}[1] = $options->{$what}[1];
+ $this->{$what}[2] = $options->{$what}[2];
+ $this->{$what}[3] = $options->{$what}[3];
+ }elsif($what eq 'WOrigin'){
+ $this->{$what}[0] = $options->{$what}[0];
+ $this->{$what}[1] = $options->{$what}[1];
+ $this->{$what}[2] = $options->{$what}[2];
+ }else{
+ $this->{$what} = $options->{$what};
+ }
+ }
+}
+
+1;
diff --git a/Graphics/TriD/TriD/GL.pm b/Graphics/TriD/TriD/GL.pm
new file mode 100644
index 0000000..110a027
--- /dev/null
+++ b/Graphics/TriD/TriD/GL.pm
@@ -0,0 +1,1178 @@
+#
+#
+# ToDo:
+# - multiple windows - requires editing generate.pl in OpenGL/
+# - clean up
+#
+#package PDL::Graphics::TriD::GL;
+
+
+BEGIN {
+ use PDL::Config;
+ if ( $PDL::Config{USE_POGL} ) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw(:all)";
+ eval 'use PDL::Graphics::OpenGL::Perl::OpenGL';
+ } else {
+ eval 'use PDL::Graphics::OpenGL';
+ }
+}
+
+$PDL::Graphics::TriD::create_window_sub = sub {
+ return new PDL::Graphics::TriD::GL::Window(@_);
+};
+
+sub PDL::Graphics::TriD::Material::togl{
+ my $this = shift;
+ my $shin = pack "f*",$this->{Shine};
+ glMaterialfv(GL_FRONT_AND_BACK,GL_SHININESS,$shin);
+ my $spec = pack "f*",@{$this->{Specular}};
+ glMaterialfv(GL_FRONT_AND_BACK,GL_SPECULAR,$spec);
+ my $amb = pack "f*",@{$this->{Ambient}};
+ glMaterialfv(GL_FRONT_AND_BACK,GL_AMBIENT,$amb);
+ my $diff = pack "f*",@{$this->{Diffuse}};
+ glMaterialfv(GL_FRONT_AND_BACK,GL_DIFFUSE,$diff);
+}
+
+$PDL::Graphics::TriD::any_cannots = 0;
+
+sub PDL::Graphics::TriD::Object::cannot_mklist {
+ return 0;
+}
+
+sub PDL::Graphics::TriD::Object::gl_update_list {
+ my($this) = @_;
+ if($this->{List}) {
+ glDeleteLists($this->{List},1);
+ }
+ my $lno = glGenLists(1);
+ $this->{List} = $lno;
+ print "GENLIST $lno\n" if($PDL::Graphics::TriD::verbose);
+ glNewList($lno,GL_COMPILE);
+ if ($PDL::Graphics::TriD::any_cannots) {
+ for(@{$this->{Objects}}) {
+ if(!$_->cannot_mklist()) {
+ $_->togl();
+ }
+ }
+ } else {
+ for (@{$this->{Objects}}) {
+ $_->togl()
+ }
+ }
+ print "EGENLIST $lno\n" if($PDL::Graphics::TriD::verbose);
+ # pdltotrianglemesh($pdl, 0, 1, 0, ($pdl->{Dims}[1]-1)*$mult);
+ glEndList();
+ print "VALID1 $this\n" if($PDL::Graphics::TriD::verbose);
+ $this->{ValidList} = 1;
+}
+
+sub PDL::Graphics::TriD::Object::gl_call_list {
+ my($this) = @_;
+ print "CALLIST ",$this->{List},"!\n" if($PDL::Graphics::TriD::verbose);
+ print "CHECKVALID $this\n" if($PDL::Graphics::TriD::verbose);
+
+ if(!$this->{ValidList}) {
+ $this->gl_update_list();
+ }
+ glCallList($this->{List});
+ if ($PDL::Graphics::TriD::any_cannots) {
+ for(@{$this->{Objects}}) {
+ if($_->cannot_mklist()) {
+
+ print ref($_)," cannot mklist\n";
+
+ $_->togl();
+ }
+ }
+ }
+}
+
+sub PDL::Graphics::TriD::Object::delete_displist {
+ my($this) = @_;
+ if($this->{List}) {
+ glDeleteLists($this->{List},1);
+ undef $this->{List};
+ }
+}
+
+sub PDL::Graphics::TriD::Object::togl {
+ my($this) = @_;
+ for(@{$this->{Objects}}) { $_->togl() }
+}
+
+
+sub PDL::Graphics::TriD::BoundingBox::togl {
+ my($this) = @_;
+ $this = $this->{Box};
+ glDisable(GL_LIGHTING);
+ glColor3d(1,1,1);
+ glBegin(GL_LINES);
+ for([0,4,2],[0,1,2],[0,1,5],[0,4,5],[0,4,2],[3,4,2],
+ [3,1,2],[3,1,5],[3,4,5],[3,4,2]) {
+ &glVertex3d(@{$this}[@$_]);
+ }
+ glEnd();
+ glBegin(GL_LINE_STRIP);
+ for([0,1,2],[3,1,2],[0,1,5],[3,1,5],[0,4,5],[3,4,5]) {
+ &glVertex3d(@{$this}[@$_]);
+ }
+ glEnd();
+ glEnable(GL_LIGHTING);
+}
+
+sub PDL::Graphics::TriD::Graph::togl {
+ my($this) = @_;
+# print "TOGL Axis\n";
+ for(keys %{$this->{Axis}}) {
+ if($_ eq "Default") {next}
+ $this->{Axis}{$_}->togl_axis($this);
+ }
+# print "TOGL DATA\n";
+ for(keys %{$this->{Data}}) {
+# print "TOGL $_, $this->{Data}{$_} $this->{Data}{$_}{Options}{LineWidth}\n";
+ $this->{Data}{$_}->togl_graph($this,$this->get_points($_));
+ }
+}
+
+use PDL;
+sub PDL::Graphics::TriD::CylindricalEquidistantAxes::togl_axis {
+ my($this,$graph) = @_;
+
+ my $fontbase = $PDL::Graphics::TriD::GL::fontbase;
+
+
+ my (@nadd, at nc, at ns);
+
+ for $dim (0..1) {
+ my $width = $this->{Scale}[$dim][1]-$this->{Scale}[$dim][0];
+ if($width > 100){
+ $nadd[$dim] = 10;
+ }elsif($width>30){
+ $nadd[$dim] = 5;
+ }elsif($width>20){
+ $nadd[$dim] = 2;
+ }else{
+ $nadd[$dim] = 1;
+ }
+ $nc[$dim] = int($this->{Scale}[$dim][0]/$nadd[$dim])*$nadd[$dim];
+ $ns[$dim] = int($width/$nadd[$dim])+1;
+ }
+
+ # can be changed to topo heights?
+ my $verts = zeroes(3,$ns[0],$ns[1]);
+
+ ($t = $verts->slice("2")) .= 1012.5;
+ ($t = $verts->slice("0")) .= $verts->ylinvals($nc[0],$nc[0]+$nadd[0]*($ns[0]-1));
+ ($t = $verts->slice("1")) .= $verts->zlinvals($nc[1],$nc[1]+$nadd[1]*($ns[1]-1));
+
+
+ my $tverts = zeroes(3,$ns[0],$ns[1]);
+
+ $tverts = $this->transform($tverts,$verts,[0,1,2]);
+
+ glDisable(GL_LIGHTING);
+ glColor3d(1,1,1);
+ for(my $j=0;$j<$tverts->getdim(2)-1;$j++){
+ my $j1=$j+1;
+ glBegin(GL_LINES);
+ for(my $i=0;$i<$tverts->getdim(1)-1;$i++){
+ my $i1=$i+1;
+
+ glVertex2f($tverts->at(0,$i,$j),$tverts->at(1,$i,$j));
+ glVertex2f($tverts->at(0,$i1,$j),$tverts->at(1,$i1,$j));
+
+ glVertex2f($tverts->at(0,$i1,$j),$tverts->at(1,$i1,$j));
+ glVertex2f($tverts->at(0,$i1,$j1),$tverts->at(1,$i1,$j1));
+
+ glVertex2f($tverts->at(0,$i1,$j1),$tverts->at(1,$i1,$j1));
+ glVertex2f($tverts->at(0,$i,$j1),$tverts->at(1,$i,$j1));
+
+ glVertex2f($tverts->at(0,$i,$j1),$tverts->at(1,$i,$j1));
+ glVertex2f($tverts->at(0,$i,$j),$tverts->at(1,$i,$j));
+
+ }
+
+ glEnd();
+ }
+
+ glEnable(GL_LIGHTING);
+}
+
+
+
+
+sub PDL::Graphics::TriD::EuclidAxes::togl_axis {
+ my($this,$graph) = @_;
+
+ print "togl_axis: got object type " . ref($this) . "\n" if $PDL::debug_trid;
+# print "TOGLAX\n";
+ my $fontbase = $PDL::Graphics::TriD::GL::fontbase;
+# print "TOGL EUCLID\n";
+ glLineWidth(1); # ought to be user defined
+ glDisable(GL_LIGHTING);
+ glColor3d(1,1,1);
+ glBegin(GL_LINES);
+ my $dim;
+ for $dim (0..2) {
+ glVertex3f(0,0,0);
+ &glVertex3f(map {$_==$dim} 0..2);
+ }
+ glEnd();
+ for $dim (0..2) {
+ my @coords = (0,0,0);
+ my @coords0 = (0,0,0);
+ for(0..2) {if($dim != $_) {
+ $coords[$_] -= 0.1;
+ }
+ }
+ my $s = $this->{Scale}[$dim];
+ my $ndiv = 3;
+ my $radd = 1.0/$ndiv;
+ my $nadd = ($s->[1]-$s->[0])/$ndiv;
+ my $nc = $s->[0];
+ for(0..$ndiv) {
+ &glRasterPos3f(@coords);
+ if ( $PDL::Config{USE_POGL} ) {
+ if ( OpenGL::done_glutInit() ) {
+ OpenGL::glutBitmapString($fontbase, sprintf("%.3f",$nc));
+ } else {
+ OpenGL::glpPrintString($fontbase, sprintf("%.3f",$nc));
+ }
+ } else {
+ PDL::Graphics::OpenGL::glpPrintString($fontbase, sprintf("%.3f",$nc));
+ }
+ glBegin(GL_LINES);
+ &glVertex3f(@coords0);
+ &glVertex3f(@coords);
+ glEnd();
+# print "PUT: $nc\n";
+ $coords[$dim] += $radd;
+ $coords0[$dim] += $radd;
+ $nc += $nadd;
+ }
+ $coords0[$dim] = 1.1;
+ &glRasterPos3f(@coords0);
+ if ( $PDL::Config{USE_POGL} ) {
+ if ( OpenGL::done_glutInit() ) {
+ OpenGL::glutBitmapString($fontbase, $this->{Names}[$dim]);
+ } else {
+ OpenGL::glpPrintString($fontbase, $this->{Names}[$dim]);
+ }
+ } else {
+ PDL::Graphics::OpenGL::glpPrintString($fontbase, $this->{Names}[$dim]);
+ }
+ }
+ glEnable(GL_LIGHTING);
+}
+
+
+
+use POSIX qw//;
+sub PDL::Graphics::TriD::Quaternion::togl {
+ my($this) = @_;
+ if(abs($this->[0]) == 1) { return ; }
+ if(abs($this->[0]) >= 1) {
+ # die "Unnormalized Quaternion!\n";
+ $this->normalize_this();
+ }
+ &glRotatef(2*POSIX::acos($this->[0])/3.14*180, @{$this}[1..3]);
+}
+
+##################################
+# Graph Objects
+#
+#
+
+sub PDL::Graphics::TriD::GObject::togl {
+ $_[0]->gdraw($_[0]->{Points});
+}
+
+# (this,graphs,points)
+sub PDL::Graphics::TriD::GObject::togl_graph {
+# print "TOGLGRAPH: $_[0]\n";
+ $_[0]->gdraw($_[2]);
+}
+
+sub PDL::Graphics::TriD::Points::gdraw {
+ my($this,$points) = @_;
+# print "DRAWPOINTS: \n",$points;
+
+ $this->glOptions();
+ glDisable(GL_LIGHTING);
+ PDL::gl_points($points,$this->{Colors});
+ glEnable(GL_LIGHTING);
+}
+
+sub PDL::gl_spheres {
+ my ($coords,$colors) = @_;
+ for (my $np=0; $np<$coords->dim(1); $np++) {
+ glPushMatrix();
+ my ($x,$y,$z) = ($coords->slice(":,($np)"))->float->list;
+ glTranslatef($x,$y,$z);
+ glutSolidSphere(0.025,15,15);
+ glPopMatrix();
+ }
+}
+
+sub PDL::Graphics::TriD::Spheres::gdraw {
+ my($this,$points) = @_;
+ $this->glOptions();
+ glShadeModel(GL_SMOOTH);
+ PDL::gl_spheres($points,$this->{Colors});
+}
+
+sub PDL::Graphics::TriD::Lattice::gdraw {
+ my($this,$points) = @_;
+
+ $this->glOptions();
+ glDisable(GL_LIGHTING);
+ PDL::gl_line_strip($points,$this->{Colors});
+ PDL::gl_line_strip($points->xchg(1,2),$this->{Colors}->xchg(1,2));
+ glEnable(GL_LIGHTING);
+}
+
+
+sub PDL::Graphics::TriD::LineStrip::gdraw {
+ my($this,$points) = @_;
+
+ $this->glOptions();
+ glDisable(GL_LIGHTING);
+ PDL::gl_line_strip($points,$this->{Colors});
+ glEnable(GL_LIGHTING);
+}
+
+sub PDL::Graphics::TriD::Lines::gdraw {
+ my($this,$points) = @_;
+
+ $this->glOptions();
+ glDisable(GL_LIGHTING);
+ PDL::gl_lines($points,$this->{Colors});
+ glEnable(GL_LIGHTING);
+}
+
+sub PDL::Graphics::TriD::GObject::glOptions {
+ my ($this) = @_;
+
+ if($this->{Options}{LineWidth}){
+ glLineWidth($this->{Options}{LineWidth});
+ }else{
+ glLineWidth(1);
+ }
+
+ if($this->{Options}{PointSize}){
+ glPointSize($this->{Options}{PointSize});
+ }else{
+ glPointSize(1);
+ }
+
+
+
+
+
+}
+
+
+sub PDL::Graphics::TriD::Contours::gdraw {
+ my($this,$points) = @_;
+
+ $this->glOptions();
+
+ glDisable(GL_LIGHTING);
+ my $pcnt=0;
+ my $i=0;
+
+
+ foreach(@{$this->{ContourSegCnt}}){
+ my $colors;
+ if($this->{Colors}->getndims==2){
+ $colors = $this->{Colors}->slice(":,($i)");
+ }else{
+ $colors = $this->{Colors};
+ }
+ next unless(defined $_);
+ PDL::gl_lines($points->slice(":,$pcnt:$_"),$colors);
+ $i++;
+ $pcnt=$_+1;
+ }
+ if(defined $this->{Labels}){
+ glColor3d(1,1,1);
+ my $seg = sprintf(":,%d:%d",$this->{Labels}[0],$this->{Labels}[1]);
+ PDL::Graphics::OpenGLQ::gl_texts($points->slice($seg),
+ $this->{Options}{Font}
+ ,$this->{LabelStrings});
+ }
+
+ glEnable(GL_LIGHTING);
+}
+
+sub PDL::Graphics::TriD::SLattice::gdraw {
+ my($this,$points) = @_;
+
+ $this->glOptions();
+
+ glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
+ glDisable(GL_LIGHTING);
+# By-vertex doesn't make sense otherwise.
+ glShadeModel (GL_SMOOTH);
+ my @sls1 = (":,0:-2,0:-2",
+ ":,1:-1,0:-2",
+ ":,0:-2,1:-1");
+ my @sls2 = (":,1:-1,1:-1",
+ ":,0:-2,1:-1",
+ ":,1:-1,0:-2"
+ );
+ PDL::gl_triangles(
+ (map {$points->slice($_)} @sls1),
+ (map {$this->{Colors}->slice($_)} @sls1)
+ );
+ PDL::gl_triangles(
+ (map {$points->slice($_)} @sls2),
+ (map {$this->{Colors}->slice($_)} @sls2)
+ );
+ if ($this->{Options}{Lines}) {
+ my $black = PDL->pdl(0,0,0)->dummy(1)->dummy(1);
+ PDL::gl_line_strip($points,$black);
+ PDL::gl_line_strip($points->xchg(1,2),$black);
+ }
+ glPopAttrib();
+}
+
+sub PDL::Graphics::TriD::SCLattice::gdraw {
+ my($this,$points) = @_;
+
+ $this->glOptions();
+
+ glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
+ glDisable(GL_LIGHTING);
+# By-vertex doesn't make sense otherwise.
+ glShadeModel (GL_FLAT);
+ my @sls1 = (":,0:-2,0:-2",
+ ":,1:-1,0:-2",
+ ":,0:-2,1:-1");
+ my @sls2 = (":,1:-1,1:-1",
+ ":,0:-2,1:-1",
+ ":,1:-1,0:-2"
+ );
+ PDL::gl_triangles(
+ (map {$points->slice($_)} @sls1),
+ (map {$this->{Colors}} @sls1)
+ );
+ PDL::gl_triangles(
+ (map {$points->slice($_)} @sls2),
+ (map {$this->{Colors}} @sls2)
+ );
+ if ($this->{Options}{Lines}) {
+ my $black = PDL->pdl(0,0,0)->dummy(1)->dummy(1);
+ PDL::gl_line_strip($points,$black);
+ PDL::gl_line_strip($points->xchg(1,2),$black);
+ }
+ glPopAttrib();
+}
+
+sub PDL::Graphics::TriD::SLattice_S::gdraw {
+ my($this,$points) = @_;
+
+
+ $this->glOptions();
+
+ glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
+# For some reason, we need to set this here as well.
+ glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE);
+# By-vertex doesn't make sense otherwise.
+ glShadeModel (GL_SMOOTH);
+ my @sls1 = (":,0:-2,0:-2",
+ ":,1:-1,0:-2",
+ ":,0:-2,1:-1");
+ my @sls2 = (":,1:-1,1:-1",
+ ":,0:-2,1:-1",
+ ":,1:-1,0:-2"
+ );
+ if ($this->{Options}{Smooth}) {
+ $this->{Normals} = $this->smoothn($points)
+ unless defined($this->{Normals});
+ my $n = $this->{Normals};
+ my $f = (!$this->{Options}{Material} ?
+ \&PDL::gl_triangles_wn : \&PDL::gl_triangles_wn_mat);
+ &$f(
+ (map {$points->slice($_)} @sls1),
+ (map {$n->slice($_)} @sls1),
+ (map {$this->{Colors}->slice($_)} @sls1)
+ );
+ &$f(
+ (map {$points->slice($_)} @sls2),
+ (map {$n->slice($_)} @sls2),
+ (map {$this->{Colors}->slice($_)} @sls2)
+ );
+ } else {
+ my $f = (!$this->{Options}{Material} ?
+ \&PDL::gl_triangles_n : \&PDL::gl_triangles_n_mat);
+ &$f(
+ (map {$points->slice($_)} @sls1),
+ (map {$this->{Colors}->slice($_)} @sls1)
+ );
+ &$f(
+ (map {$points->slice($_)} @sls2),
+ (map {$this->{Colors}->slice($_)} @sls2)
+ );
+ }
+ glDisable(GL_LIGHTING);
+ if ($this->{Options}{Lines}) {
+ my $black = PDL->pdl(0,0,0)->dummy(1)->dummy(1);
+ PDL::gl_line_strip($points,$black);
+ PDL::gl_line_strip($points->xchg(1,2),$black);
+ }
+ glPopAttrib();
+}
+
+####################################################################
+################### JNK 15mar11 added section start ################
+sub PDL::Graphics::TriD::STrigrid_S::gdraw {
+ my($this,$points) = @_;
+ glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
+ # For some reason, we need to set this here as well.
+ glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE);
+ # By-vertex doesn't make sense otherwise.
+ glShadeModel (GL_SMOOTH);
+ my @sls = (":,(0)",":,(1)",":,(2)");
+ my $idx = [0,1,2,0]; # for lines, below
+ if ($this->{Options}{Smooth}) {
+ $this->{Normals}=$this->smoothn($this->{Points})
+ unless defined($this->{Normals});
+ my $f=(!$this->{Options}{Material}?\&PDL::gl_triangles_wn
+ :\&PDL::gl_triangles_wn_mat);
+ my $tmpn=$this->{Normals}->dice_axis(1,$this->{Faceidx}->clump(-1))
+ ->splitdim(1,($this->{Faceidx}->dims)[0]);
+ my @args=((map {$this->{Faces}->slice($_)} @sls), # faces is a slice of points
+ (map {$tmpn->slice($_)} @sls),
+ (map {$this->{Colors}->slice($_)} @sls) );&$f(@args); }
+ else {
+ my $f=(!$this->{Options}{Material}?\&PDL::gl_triangles_n
+ :\&PDL::gl_triangles_n_mat);
+ &$f( (map {$this->{Faces}->slice($_)} @sls), # faces is a slice of points
+ (map {$this->{Colors}->slice($_)} @sls) ); }
+ glDisable(GL_LIGHTING);
+ if ($this->{Options}{Lines}) {
+ my $black = PDL->pdl(0,0,0)->dummy(1)->dummy(1);
+ PDL::gl_lines($this->{Faces}->dice_axis(1,$idx),$black); } glPopAttrib(); }
+
+sub PDL::Graphics::TriD::STrigrid::gdraw {
+ my($this,$points) = @_;
+ glPushAttrib(GL_LIGHTING_BIT | GL_ENABLE_BIT);
+ glDisable(GL_LIGHTING);
+# By-vertex doesn't make sense otherwise.
+ glShadeModel (GL_SMOOTH);
+ my @sls = (":,(0)",":,(1)",":,(2)");
+ my $idx = [0,1,2,0];
+ PDL::gl_triangles(
+ (map {$this->{Faces}->slice($_)} @sls), # faces is a slice of points
+ (map {$this->{Colors}->slice($_)} @sls));
+ if ($this->{Options}{Lines}) {
+ my $black = PDL->pdl(0,0,0)->dummy(1)->dummy(1);
+ PDL::gl_lines($this->{Faces}->dice_axis(1,$idx),$black); }
+ glPopAttrib(); }
+################### JNK 15mar11 added section finis ################
+####################################################################
+
+##################################
+# PDL::Graphics::TriD::Image
+#
+#
+
+sub PDL::Graphics::TriD::Image::togl {
+# glDisable(GL_LIGHTING);
+#
+# A special construct which always faces the display and takes the entire window
+#
+ glMatrixMode(GL_MODELVIEW);
+ glLoadIdentity();
+
+ glMatrixMode(GL_PROJECTION);
+ glLoadIdentity();
+ gluOrtho2D(0,1,0,1);
+ &PDL::Graphics::TriD::Image::togl_graph;
+}
+
+sub PDL::Graphics::TriD::Image::togl_graph {
+ $_[0]->gdraw();
+}
+
+
+# The quick method is to use texturing for the good effect.
+sub PDL::Graphics::TriD::Image::gdraw {
+ my($this,$vert) = @_;
+ my ($p,$xd,$yd,$txd,$tyd) = $this->flatten(1); # do binary alignment
+ glColor3d(1,1,1);
+ if ( $PDL::Config{USE_POGL} ) {
+ glTexImage2D_s(GL_TEXTURE_2D, 0, GL_RGB, $txd, $tyd, 0, GL_RGB, GL_FLOAT, $p->get_dataref());
+ } else {
+ glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, $txd, $tyd, 0, GL_RGB, GL_FLOAT, $p->get_dataref());
+ }
+ glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST );
+ glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST );
+ glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT );
+ glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT );
+
+ glDisable(GL_LIGHTING);
+ glNormal3d(0,0,1);
+ glEnable(GL_TEXTURE_2D);
+ glBegin(GL_QUADS);
+ my @texvert = (
+ [0,0],
+ [$xd/$txd, 0],
+ [$xd/$txd, $yd/$tyd],
+ [0, $yd/$tyd]
+ );
+ if(!defined $vert) {$vert = $this->{Points}}
+ for(0..3) {
+ &glTexCoord2f(@{$texvert[$_]});
+ &glVertex3f($vert->slice(":,($_)")->list);
+ }
+ glEnd();
+ glEnable(GL_LIGHTING);
+ glDisable(GL_TEXTURE_2D);
+}
+
+sub PDL::Graphics::TriD::SimpleController::togl {
+ my($this) = @_;
+
+ $this->{CRotation}->togl();
+ glTranslatef(0,0,-$this->{CDistance});
+
+ $this->{WRotation}->togl();
+ &glTranslatef(map {-$_} @{$this->{WOrigin}});
+}
+
+
+##############################################
+#
+# A window with mouse control over rotation.
+#
+#
+package PDL::Graphics::TriD::Window;
+
+BEGIN {
+ use PDL::Config;
+ if ( $PDL::Config{USE_POGL} ) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw(:all)";
+ eval 'use PDL::Graphics::OpenGL::Perl::OpenGL';
+ } else {
+ eval 'use PDL::Graphics::OpenGL';
+ }
+}
+
+use base qw/PDL::Graphics::TriD::Object/;
+use fields qw/Ev Width Height Interactive _GLObject
+ _ViewPorts _CurrentViewPort /;
+
+sub i_keep_list {return 1} # For Object, so I will be notified of changes.
+use strict;
+
+sub gdriver {
+ my($this, $options) = @_;
+
+ print "GL gdriver...\n" if($PDL::debug_trid);
+
+ if(defined $this->{_GLObject}){
+ print "WARNING: Graphics Driver already defined for this window \n";
+ return;
+ }
+ my @db = GLX_DOUBLEBUFFER;
+
+ if($PDL::Graphics::TriD::offline) {$options->{x} = -1; @db=()}
+
+ $options->{attributes} = [GLX_RGBA, @db,
+ GLX_RED_SIZE,1,
+ GLX_GREEN_SIZE,1,
+ GLX_BLUE_SIZE,1,
+ GLX_DEPTH_SIZE,1,
+ # Alpha size?
+ ] unless defined $options->{attributes};
+
+ $options->{mask} = (KeyPressMask | ButtonPressMask |
+ ButtonMotionMask | ButtonReleaseMask |
+ ExposureMask | StructureNotifyMask |
+ PointerMotionMask) unless defined $options->{mask};
+
+
+ print "STARTING OPENGL $options->{width} $options->{height}\n" if($PDL::Graphics::TriD::verbose);
+
+ print "gdriver: Calling OpengGL::OO($options)...\n" if ($PDL::debug_trid);
+
+ $this->{_GLObject}= new PDL::Graphics::OpenGL::OO($options);
+
+ if (exists $this->{_GLObject}->{glutwindow}) {
+ if ($PDL::debug_trid) {
+ print "gdriver: Got OpenGL::OO object(GLUT window ID# " . $this->{_GLObject}->{glutwindow} . ")\n";
+ }
+ $this->{_GLObject}->{winobjects}->[$this->{_GLObject}->{glutwindow}] = $this; # circular ref
+ }
+
+#glpOpenWindow(%$options);
+
+ print "gdriver: Calling glClearColor...\n" if ($PDL::debug_trid);
+ glClearColor(0,0,0,1);
+
+ print "gdriver: Calling glpRasterFont...\n" if ($PDL::debug_trid);
+ if ( $this->{_GLObject}->{window_type} eq 'glut' ) {
+ print STDERR "gdriver: window_type => 'glut' so not actually setting the rasterfont\n" if ($PDL::debug_trid);
+ eval '$PDL::Graphics::TriD::GL::fontbase = GLUT_BITMAP_8_BY_13';
+ } else {
+ # NOTE: glpRasterFont() will die() if the requested font cannot be found
+ # The new POGL+GLUT TriD implementation uses the builtin GLUT defined
+ # fonts and does not have this failure mode.
+
+ my $lb = eval { $this->{_GLObject}->glpRasterFont( ($ENV{PDL_3D_FONT} or "5x8"), 0, 256 ) };
+ if ( $@ ) {
+ die "glpRasterFont: unable to load font '%s', please set PDL_3D_FONT to an existing X11 font.";
+ }
+ $PDL::Graphics::TriD::GL::fontbase = $lb
+ }
+ # glDisable(GL_DITHER);
+ glShadeModel (GL_FLAT);
+ glEnable(GL_DEPTH_TEST);
+ glEnable(GL_NORMALIZE);
+ glEnable(GL_LIGHTING);
+ glEnable(GL_LIGHT0);
+ glLightModeli(GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE);
+
+ # Will this bring us trouble?
+ # if(defined *PDL::Graphics::TriD::GL::Window::glPolygonOffsetEXT{CODE}) {
+# glEnable(GL_POLYGON_OFFSET_EXT);
+# glPolygonOffsetEXT(0.0000000000001,0.000002);
+ # }
+
+ # Inherits attributes of Object class
+# my $this = $type->SUPER::new();
+# $this->reshape($options->{width},$options->{height});
+
+ my $light = pack "f*",1.0,1.0,1.0,0.0;
+ if ( $PDL::Config{USE_POGL} ) {
+ glLightfv_s(GL_LIGHT0,GL_POSITION,$light);
+ } else {
+ glLightfv(GL_LIGHT0,GL_POSITION,$light);
+ }
+
+ glColor3f(1,1,1);
+
+# $this->{Interactive} = 1;
+ print "STARTED OPENGL!\n" if($PDL::Graphics::TriD::verbose);
+
+ if($PDL::Graphics::TriD::offline) {
+ $this->doconfig($options->{width}, $options->{height});
+ }
+
+ return 1; # Interactive Window
+}
+
+sub ev_defaults{
+ return { ConfigureNotify => \&doconfig,
+ MotionNotify => \&domotion,
+ }
+}
+
+sub reshape {
+ my($this,$x,$y) = @_;
+ my $pw = $this->{Width};
+ my $ph = $this->{Height};
+ $this->{Width} = $x; $this->{Height} = $y;
+
+ for my $vp (@{$this->{_ViewPorts}}){
+ my $nw = $vp->{W} + ($x-$pw) * $vp->{W}/$pw;
+ my $nx0 = $vp->{X0} + ($x-$pw) * $vp->{X0}/$pw;
+ my $nh = $vp->{H} + ($y-$ph) * $vp->{H}/$ph;
+ my $ny0 = $vp->{Y0} + ($y-$ph) * $vp->{Y0}/$ph;
+ print "reshape: resizing viewport to $nx0,$ny0,$nw,$nh\n" if($PDL::Graphics::TriD::verbose);
+ $vp->resize($nx0,$ny0,$nw,$nh);
+ }
+
+}
+
+
+
+sub get_size {
+ my $this=shift;
+ return ($this->{Width},$this->{Height});
+}
+
+
+sub twiddle {
+ my($this,$getout,$dontshow) = @_;
+ my (@e);
+ my $quit;
+ if($PDL::Graphics::TriD::offline) {
+ $PDL::Graphics::TriD::offlineindex ++;
+ $this->display();
+ require PDL::IO::Pic;
+ wpic($this->read_picture(),"PDL_$PDL::Graphics::TriD::offlineindex.jpg");
+ return;
+ }
+ if ($getout and $dontshow) {
+ if ( !$this->{_GLObject}->XPending() ) {
+ return;
+ }
+ }
+ if(!defined $getout) {
+ $getout = not $PDL::Graphics::TriD::keeptwiddling;
+ }
+
+ $this->display();
+ TWIDLOOP: while(1) {
+ print "EVENT!\n" if($PDL::Graphics::TriD::verbose);
+ my $hap = 0;
+ my $gotev = 0;
+
+ # Run a MainLoop event if GLUT windows
+ # this pumps the system allowing callbacks to populate
+ # the fake XEvent queue.
+ #
+ glutMainLoopEvent() if $this->{_GLObject}->{window_type} eq 'glut' and not $this->{_GLObject}->XPending();
+
+ if ($this->{_GLObject}->XPending() or !$getout) {
+ @e = $this->{_GLObject}->glpXNextEvent();
+ $gotev=1;
+ }
+ print "e= ".join(",", at e)."\n" if($PDL::Graphics::TriD::verbose);
+
+ if(@e){
+ if ($e[0] == VisibilityNotify || $e[0] == Expose) {
+ $hap = 1;
+ } elsif ($e[0] == ConfigureNotify) {
+ print "CONFIGNOTIFE\n" if($PDL::Graphics::TriD::verbose);
+ $this->reshape($e[1],$e[2]);
+ $hap=1;
+ } elsif($e[0] == KeyPress) {
+ print "KEYPRESS: '$e[1]'\n" if($PDL::Graphics::TriD::verbose);
+ if((lc $e[1]) eq "q") {
+ $quit = 1;
+ }
+ if((lc $e[1]) eq "c") {
+ $quit = 2;
+ }
+ if((lc $e[1]) eq "q" and not $getout) {
+ last TWIDLOOP;
+ }
+ $hap=1;
+ }
+ }
+
+ if($gotev){
+ # print "HANDLING $this->{EHandler}\n";
+ foreach my $vp (@{$this->{_ViewPorts}}) {
+ if(defined($vp->{EHandler})) {
+ $hap += $vp->{EHandler}->event(@e);
+ }
+ }
+ }
+ if(! $this->{_GLObject}->XPending()) {
+ if($hap) {
+ $this->display();
+ }
+ if($getout) {last TWIDLOOP}
+ }
+ undef @e;
+ }
+ print "STOPTWIDDLE\n" if($PDL::Graphics::TriD::verbose);
+ return $quit;
+}
+
+
+
+
+sub setlist { my($this,$list) = @_;
+ $this->{List} = $list;
+
+}
+
+# Resize window.
+sub doconfig {
+ my($this,$x,$y) = @_;
+ $this->reshape($x,$y);
+ print "CONFIGURENOTIFY\n" if($PDL::Graphics::TriD::verbose);
+}
+
+sub domotion {
+ my($this) = @_;
+ print "MOTIONENOTIFY\n" if($PDL::Graphics::TriD::verbose);
+}
+
+sub display {
+ my($this) = @_;
+
+ return unless defined($this);
+
+ # set GLUT context to current window (for multiwindow support
+ if ( $this->{_GLObject}->{window_type} eq 'glut' ) {
+ glutSetWindow($this->{_GLObject}->{glutwindow});
+ }
+
+ print "display: calling glClear()\n" if ($PDL::Graphics::TriD::verbose);
+ glClear(GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT);
+ glMatrixMode(GL_MODELVIEW);
+
+
+ for my $vp (@{$this->{_ViewPorts}}) {
+
+ glPushMatrix();
+
+
+ $vp->do_perspective();
+
+
+ if($vp->{Transformer}) {
+ print "display: transforming viewport!\n" if ($PDL::Graphics::TriD::verbose);
+ $vp->{Transformer}->togl();
+ }
+
+ glTranslatef(-1,-1,-1);
+ glScalef(2,2,2); # double the scale in each direction ?
+
+ $vp->gl_call_list();
+
+ glPopMatrix();
+
+ }
+
+ if ( $PDL::Config{USE_POGL} ) {
+
+ print "display: SwapBuffers() call on return\n" if ($PDL::Graphics::TriD::verbose);
+ if ( $this->{_GLObject}->{window_type} eq 'glut' ) { # need to make method call
+ glutSwapBuffers();
+ } elsif ( $this->{_GLObject}->{window_type} eq 'x11' ) { # need to make method call
+ $this->{_GLObject}->glXSwapBuffers();
+ } else {
+ print "display: got object with inconsistent _GLObject info\n";
+ }
+
+ } else {
+ $this->{_GLObject}->glXSwapBuffers();
+ }
+# $this->{Angle}+= 3;
+}
+
+# should this reallyt be in viewport?
+sub read_picture {
+ my($this) = @_;
+ my($w,$h) = @{$this}{qw/Width Height/};
+ my $res = PDL->zeroes(PDL::byte,3,$w,$h);
+ glPixelStorei(GL_UNPACK_ALIGNMENT,1);
+ glPixelStorei(GL_PACK_ALIGNMENT,1);
+
+ if ( $PDL::Config{USE_POGL} ) {
+ glReadPixels_s(0,0,$w,$h,GL_RGB,GL_UNSIGNED_BYTE,$res->get_dataref);
+ } else {
+ glReadPixels(0,0,$w,$h,GL_RGB,GL_UNSIGNED_BYTE,$res->get_dataref);
+ }
+
+ return $res;
+}
+
+######################################################################
+######################################################################
+# EVENT HANDLER MINIPACKAGE FOLLOWS!
+
+package PDL::Graphics::TriD::EventHandler;
+
+BEGIN {
+ use PDL::Config;
+ if ( $PDL::Config{USE_POGL} ) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw(ConfigureNotify MotionNotify ButtonPress ButtonRelease Button1Mask Button2Mask Button3Mask)";
+ eval 'use PDL::Graphics::OpenGL::Perl::OpenGL';
+ } else {
+ eval 'use PDL::Graphics::OpenGL';
+ }
+}
+
+use fields qw/X Y Buttons VP/;
+use strict;
+sub new {
+ my $class = shift;
+ my $vp = shift;
+ no strict 'refs';
+ my $self = fields::new($class);
+ $self->{X} = -1;
+ $self->{Y} = -1;
+ $self->{Buttons} = [];
+ $self->{VP} = $vp;
+
+ $self;
+}
+
+sub event {
+ my($this,$type, at args) = @_;
+
+ print "EH: ",ref($this)," $type (",join(",", at args),")\n" if($PDL::Graphics::TriD::verbose);
+ my $retval;
+
+ if($type == MotionNotify) {
+ my $but = -1;
+
+ SWITCH: {
+ $but = 0, last SWITCH if ($args[0] & (Button1Mask));
+ $but = 1, last SWITCH if ($args[0] & (Button2Mask));
+ $but = 2, last SWITCH if ($args[0] & (Button3Mask));
+ print "No button pressed...\n" if($PDL::Graphics::TriD::verbose);
+ goto NOBUT;
+ }
+
+ print "MOTION $but $args[0]\n" if($PDL::Graphics::TriD::verbose);
+ if($this->{Buttons}[$but]) {
+ if($this->{VP}->{Active}){
+ print "calling ".($this->{Buttons}[$but])."->mouse_moved ($this->{X},$this->{Y},$args[1],$args[2])...\n" if($PDL::Graphics::TriD::verbose);
+ $retval = $this->{Buttons}[$but]->mouse_moved(
+ $this->{X},$this->{Y},
+ $args[1],$args[2]);
+ }
+ }
+ $this->{X} = $args[1]; $this->{Y} = $args[2];
+ NOBUT:
+
+ } elsif($type == ButtonPress) {
+
+ my $but = $args[0]-1;
+ print "BUTTONPRESS $but\n" if($PDL::Graphics::TriD::verbose);
+ $this->{X} = $args[1]; $this->{Y} = $args[2];
+ $retval = $this->{Buttons}[$but]->ButtonPress($args[1],$args[2])
+ if($this->{Buttons}[$but]);
+
+ } elsif($type == ButtonRelease) {
+
+ my $but = $args[0]-1;
+ print "BUTTONRELEASE $but\n" if($PDL::Graphics::TriD::verbose);
+ $retval = $this->{Buttons}[$but]->ButtonRelease($args[1],$args[2])
+ if($this->{Buttons}[$but]);
+
+ } elsif($type== ConfigureNotify) {
+
+ # Kludge to force reshape of the viewport associated with the window -CD
+ print "ConfigureNotify (".join(",", at args).")\n" if($PDL::Graphics::TriD::verbose);
+ print "viewport is $this->{VP}\n" if($PDL::Graphics::TriD::verbose);
+# $retval = $this->reshape(@args);
+
+ }
+ $retval;
+}
+
+sub set_button {
+ my($this,$butno,$act) = @_;
+ $this->{Buttons}[$butno] = $act;
+}
+
+
+######################################################################
+######################################################################
+# VIEWPORT MINI_PACKAGE FOLLOWS!
+
+package PDL::Graphics::TriD::ViewPort;
+use base qw/PDL::Graphics::TriD::Object/;
+use fields qw/X0 Y0 W H Transformer EHandler Active ResizeCommands
+ DefMaterial AspectRatio Graphs/;
+
+BEGIN {
+ use PDL::Config;
+ if ( $PDL::Config{USE_POGL} ) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw(:all)";
+ eval 'use PDL::Graphics::OpenGL::Perl::OpenGL';
+ } else {
+ eval 'use PDL::Graphics::OpenGL';
+ }
+}
+
+use PDL::Graphics::OpenGLQ;
+
+
+sub highlight {
+ my ($vp) = @_;
+
+ my $pts = new PDL [[0,0,0],
+ [$vp->{W},0,0],
+ [$vp->{W},$vp->{H},0],
+ [0,$vp->{H},0],
+ [0,0,0]];
+ my $colors;
+
+ $colors = PDL->ones(3,5);
+
+ glDisable(GL_LIGHTING);
+
+ glMatrixMode(GL_MODELVIEW);
+ glLoadIdentity();
+
+ glMatrixMode(GL_PROJECTION);
+ glLoadIdentity();
+ gluOrtho2D(0,$vp->{W},0,$vp->{H});
+ glLineWidth(4);
+
+ gl_line_strip($pts,$colors);
+
+ glLineWidth(1);
+
+ glEnable(GL_LIGHTING);
+
+}
+
+
+
+sub do_perspective {
+ my($this) = @_;
+
+ print "do_perspective ",$this->{W}," ",$this->{H} ,"\n" if($PDL::Graphics::TriD::verbose);
+
+ if($PDL::Graphics::TriD::verbose>1){
+ my ($i,$package,$filename,$line);
+ $i = 0;
+ do {
+ ($package,$filename,$line) = caller($i++);
+ print "$package ($filename, line $line)\n";
+ } while($package);
+ print "\n";
+ }
+
+
+ unless($this->{W}>0 and $this->{H}>0) {return;}
+# if($this->{W}==0 or $this->{H}==0) {return;}
+ $this->{AspectRatio} = (1.0*$this->{W})/$this->{H};
+# glResizeBuffers();
+
+ glViewport($this->{X0},$this->{Y0},$this->{W},$this->{H});
+
+ $this->highlight() if($this->{Active});
+
+ glMatrixMode(GL_PROJECTION);
+ glLoadIdentity();
+
+ gluPerspective(40.0, $this->{AspectRatio} , 0.1, 200000.0);
+ glMatrixMode(GL_MODELVIEW);
+ glLoadIdentity ();
+}
+
+
+###############
+#
+# Because of the way GL does texturing, this must be the very last thing
+# in the object stack before the actual surface. There must not be any
+# transformations after this.
+#
+# There may be several of these but all of these must have just one texture.
+
+ at PDL::Graphics::TriD::GL::SliceTexture::ISA = qw/PDL::Graphics::TriD::Object/;
+
+sub PDL::Graphics::TriD::GL::SliceTexture::new {
+ my $image;
+ glPixelStorei(GL_UNPACK_ALIGNMENT,1);
+ glTexImage1D(GL_TEXTURE_1D,0 , 4, 2,0,GL_RGBA,GL_UNSIGNED_BYTE,
+ $image);
+ glTexParameterf(GL_TEXTURE_1D,GL_TEXTURE_WRAP_S,GL_CLAMP);
+ glTexEnvf(GL_TEXTURE_ENV,GL_TEXTURE_ENV_MODE,GL_DECAL);
+}
+
+sub PDL::Graphics::TriD::GL::SliceTexture::togl {
+ my ($this) = @_;
+ glEnable(GL_TEXTURE_1D);
+ glTexGen();
+ $this->SUPER::togl();
+ glDisable(GL_TEXTURE_1D);
+}
+
+
+
+1;
diff --git a/Graphics/TriD/TriD/GoBoard.pm b/Graphics/TriD/TriD/GoBoard.pm
new file mode 100644
index 0000000..f6637b9
--- /dev/null
+++ b/Graphics/TriD/TriD/GoBoard.pm
@@ -0,0 +1,100 @@
+
+# Some 3D/2D representations of Go Boards.
+# this may not be of great interest to people who don't play Go
+# except in some strange visualization senses.
+
+# Also Go players will not find this to look too much like a real go board.
+
+package PDL::Graphics::TriD::GoBoard;
+
+use base qw/PDL::Graphics::TriD::Object/;
+use fields qw /Data InLays BG/;
+
+BEGIN {
+ use PDL::Config;
+ if ( $PDL::Config{USE_POGL} ) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw(:all)";
+ eval 'use PDL::Graphics::OpenGL::Perl::OpenGL';
+ } else {
+ eval 'use PDL::Graphics::OpenGL';
+ }
+}
+
+use PDL::Lite;
+
+
+sub new {
+ my($type,$opts) = @_;
+ my $this = $type->SUPER::new();
+ $this->{Data} = $opts->{Data};
+
+ my $d = $opts->{Data};
+ my $eo = ($d->slice("(3)")+0.000005) /
+ ($d->slice("(2)") + $d->slice("(3)") + 0.00001);
+ $this->{BG} = new PDL::Graphics::TriD::Image([$eo*0, $eo, 0*$eo]);
+ return $this;
+}
+
+sub add_inlay {
+ my($this,$data,$x,$y,$z) = @_;
+ push @{$this->{InLays}},[$z,(new PDL::Graphics::TriD::GoBoard({Data => $data})),
+ $x,$y, $data->dims];
+}
+
+sub togl {
+ my($this) = @_;
+# my $z = 0.5;
+# my $z = 0.001;
+ my $z = 0.01;
+ print "BOARD2GL\n" if $PDL::Graphics::TriD::verbose;
+# 0 = white, 1 = black, 2 = outside, 3 = empty.
+ my $d = $this->{Data};
+ $this->{BG}->togl();
+ glDisable(GL_LIGHTING);
+# 1. stones.
+ my $hass = $d->slice("(0)") + $d->slice("(1)");
+ my $stoc = $d->slice("(0)") / ($hass+0.00001);
+ my ($x,$y);
+ my ($foo,$nx,$ny) = ($this->{Data}->dims);
+ my $xs = 0.5/$nx; my $ys = 0.5/$ny;
+ glBegin(GL_QUADS);
+ for $x (0..$nx-1) {
+ for $y (0..$ny-1) {
+ my $c = $stoc->at($x,$y);
+ my $s = $hass->at($x,$y);
+ my $cx = ($x+0.5)/$nx;
+ my $cy = ($y+0.5)/$ny;
+# glColor3f($c,$c,$c);
+ glColor3f($c,0.3,1-$c);
+ glVertex3d($cx+$s*$xs,$cy,$z);
+ glVertex3d($cx,$cy+$s*$ys,$z);
+ glVertex3d($cx-$s*$xs,$cy,$z);
+ glVertex3d($cx,$cy-$s*$ys,$z);
+ }
+ }
+ glEnd();
+ for (@{$this->{InLays}}) {
+ glEnable(&GL_DEPTH_TEST);
+ glPushMatrix();
+ glTranslatef($xs*2*$_->[2],$ys*2*$_->[3],
+ $_->[0]);
+ my $z = -$_->[0];
+ glScalef($_->[5]/$nx,$_->[6]/$ny,1);
+ $_->[1]->togl();
+ glDisable(&GL_LIGHTING);
+ glColor3d(1,1,1);
+ glBegin(&GL_LINES);
+ glVertex3d(0,0,0);
+ glVertex3d(0,0,$z);
+ glVertex3d(0,1,0);
+ glVertex3d(0,1,$z);
+ glVertex3d(1,0,0);
+ glVertex3d(1,0,$z);
+ glVertex3d(1,1,0);
+ glVertex3d(1,1,$z);
+ glEnd();
+ glPopMatrix();
+ }
+ glEnable(&GL_LIGHTING);
+}
+1;
diff --git a/Graphics/TriD/TriD/Graph.pm b/Graphics/TriD/TriD/Graph.pm
new file mode 100644
index 0000000..5607312
--- /dev/null
+++ b/Graphics/TriD/TriD/Graph.pm
@@ -0,0 +1,416 @@
+package PDL::Graphics::TriD::Graph;
+use base qw/PDL::Graphics::TriD::Object/;
+use PDL::LiteF; # XXX F needed?
+
+use fields qw(Data DataBind UnBound DefaultAxes Axis );
+
+
+sub add_dataseries {
+ my($this,$data,$name) = @_;
+ if(!defined $name) {
+ $name = "Data0";
+ while(defined $this->{Data}{$name}) {$name++;}
+ }
+
+ $this->{Data}{$name} = $data;
+ $this->{DataBind}{$name} = [];
+ $this->{UnBound}{$name} = 1;
+
+ $this->add_object($data);
+ $this->changed();
+
+ return $name;
+}
+
+sub bind_data {
+ my($this,$dser,$axes,$axis) = @_;
+ push @{$this->{DataBind}{$dser}},[$axis,$axes];
+ delete $this->{UnBound}{$dser};
+ $this->changed();
+}
+
+sub bind_default {
+ my($this,$dser,$axes) = @_;
+ if(!defined $axes) {$axes = $this->{DefaultAxes}};
+ $this->{DataBind}{$dser} = [['Default',$axes]];
+ delete $this->{UnBound}{$dser};
+}
+
+sub set_axis {
+ my($this,$axis,$name) = @_;
+ $this->{Axis}{$name} = $axis;
+ $this->changed();
+}
+
+# Bind all unbound things here...
+sub scalethings {
+ my($this) = @_;
+ for(keys %{$this->{UnBound}}) {
+ $this->bind_default($_);
+ }
+ for(values %{$this->{Axis}}) {
+ $_->init_scale() ;
+ }
+ my ($k,$v);
+ while(($k,$v) = each %{$this->{DataBind}}) {
+ for(@$v) {
+ $this->{Axis}{$_->[0]}->add_scale(
+ $this->{Data}{$k}->get_points(), $_->[1]);
+ }
+ }
+ for(values %{$this->{Axis}}) {
+ $_->finish_scale();
+ }
+}
+
+# use Data::Dumper;
+sub get_points {
+ my($this,$name) = @_;
+# print Dumper($this->{Axis});
+
+ my $d = $this->{Data}{$name}->get_points();
+
+
+ my @ddims = $d->dims; shift @ddims;
+ my $p = PDL->zeroes(&PDL::float(),3, at ddims);
+ my $pnew;
+ for(@{$this->{DataBind}{$name}}) {
+ defined($this->{Axis}{$_->[0]}) or die("Axis not defined: $_->[0]");
+# Transform can return the same or a different piddle.
+ $pnew = $this->{Axis}{$_->[0]}->transform($p,$d,$_->[1]);
+ $p = $pnew;
+ }
+ return $pnew;
+}
+
+sub clear_data {
+ my($this) = @_;
+ $this->{Data} = {};
+ $this->{DataBind} = {};
+ $this->{UnBound} = {};
+ $this->changed();
+}
+
+sub delete_data {
+ my($this,$name) = @_;
+ delete $this->{Data}{$name};
+ delete $this->{DataBind}{$name};
+ delete $this->{UnBound}{$name};
+ $this->changed();
+}
+
+sub default_axes {
+ my($this) = @_;
+ $this->set_axis(PDL::Graphics::TriD::EuclidAxes->new(),"Euclid3");
+ $this->set_default_axis("Euclid3",[0,1,2]);
+}
+
+sub set_default_axis {
+ my($this,$name,$axes) = @_;
+ $this->{Axis}{Default} = $this->{Axis}{$name};
+ $this->{DefaultAxes} = $axes;
+}
+
+sub changed {}
+
+
+package PDL::Graphics::TriD::EuclidAxes;
+
+sub new {
+ my($type) = @_; bless {Names => [X,Y,Z]},$type;
+}
+
+sub init_scale {
+ my($this) = @_;
+ $this->{Scale} = [];
+}
+
+sub add_scale {
+ my($this,$data,$inds) = @_;
+ my $i = 0;
+ for(@$inds) {
+ my $d = $data->slice("($_)");
+ my $max = $d->max;
+ my $min = $d->min;
+ if(!defined $this->{Scale}[$i]) {
+ $this->{Scale}[$i] = [$min,$max];
+ } else {
+ if($min < $this->{Scale}[$i][0]) {
+ $this->{Scale}[$i][0] = $min;
+ }
+ if($max > $this->{Scale}[$i][1]) {
+ $this->{Scale}[$i][1] = $max;
+ }
+ }
+ $i++;
+ }
+}
+
+sub finish_scale {
+ my($this) = @_;
+# Normalize the smallest differences away.
+ for(@{$this->{Scale}}) {
+ if(abs($_->[0] - $_->[1]) < 0.000001) {
+ $_->[1] = $_->[0] + 1;
+ } else {
+ my $shift = ($_->[1]-$_->[0])*0.05;
+ $_->[0] -= $shift;
+ $_->[1] += $shift;
+ }
+ }
+}
+
+# Add 0..1 to each axis.
+sub transform {
+ my($this,$point,$data,$inds) = @_;
+ my $i = 0;
+ for(@$inds) {
+ (my $tmp = $point->slice("($i)")) +=
+ ($data->slice("($_)") - $this->{Scale}[$i][0]) /
+ ($this->{Scale}[$i][1] - $this->{Scale}[$i][0]) ;
+ $i++;
+ }
+ return $point;
+}
+
+
+#
+# projects from the sphere to a cylinder
+#
+
+package PDL::Graphics::TriD::CylindricalEquidistantAxes;
+use PDL::Core '';
+
+
+sub new {
+ my($type) = @_;
+ bless {Names => [LON,LAT,Pressure]},$type;
+}
+
+sub init_scale {
+ my($this) = @_;
+ $this->{Scale} = [];
+}
+
+
+sub add_scale {
+ my($this,$data,$inds) = @_;
+ my $i = 0;
+ for(@$inds) {
+ my $d = $data->slice("($_)");
+ my $max = $d->max;
+ my $min = $d->min;
+
+
+
+ if($i==1){
+ if($max > 89.9999 or $min < -89.9999){
+ barf "Error in Latitude $max $min\n";
+
+ }
+ }
+ elsif($i==2){
+ $max = 1012.5 if($max<1012.5);
+ $min = 100 if($min>100);
+ }
+
+ if(!defined $this->{Scale}[$i]) {
+ $this->{Scale}[$i] = [$min,$max];
+ } else {
+ if($min < $this->{Scale}[$i][0]) {
+ $this->{Scale}[$i][0] = $min;
+ }
+ if($max > $this->{Scale}[$i][1]) {
+ $this->{Scale}[$i][1] = $max;
+ }
+ }
+ $i++;
+ }
+
+# $this->{Center} = [$this->{Scale}[0][0]+($this->{Scale}[0][1]-$this->{Scale}[0][0])/2,
+# $this->{Scale}[1][0]+($this->{Scale}[1][1]-$this->{Scale}[1][0])/2];
+#
+# Should make the projection center an option
+#
+ $this->{Center} = [$this->{Scale}[0][0]+($this->{Scale}[0][1]-$this->{Scale}[0][0])/2,
+ 0];
+}
+
+sub finish_scale {
+ my($this) = @_;
+ my @dist;
+ # Normalize the smallest differences away.
+ for(@{$this->{Scale}}) {
+ if(abs($_->[0] - $_->[1]) < 0.000001) {
+ $_->[1] = $_->[0] + 1;
+ }
+ push(@dist,$_->[1]-$_->[0]);
+ }
+ # for the z coordiniate reverse the min and max values
+ my $max = $this->{Scale}[2][0];
+ if($max < $this->{Scale}[2][1]){
+ $this->{Scale}[2][0] = $this->{Scale}[2][1];
+ $this->{Scale}[2][1] = $max;
+ }
+
+# Normalize longitude and latitude scale
+
+ if($dist[1] > $dist[0]){
+ $this->{Scale}[0][0] -= ($dist[1]-$dist[0])/2;
+ $this->{Scale}[0][1] += ($dist[1]-$dist[0])/2;
+ }elsif($dist[0] > $dist[1] && $dist[0]<90){
+ $this->{Scale}[1][0] -= ($dist[0]-$dist[1])/2;
+ $this->{Scale}[1][1] += ($dist[0]-$dist[1])/2;
+ }elsif($dist[0] > $dist[1]){
+ $this->{Scale}[1][0] -= (90-$dist[1])/2;
+ $this->{Scale}[1][1] += (90-$dist[1])/2;
+ }
+
+
+}
+
+sub transform {
+ my($this,$point,$data,$inds) = @_;
+ my $i = 0;
+
+ if($#$inds!=2){
+ barf("Wrong number of arguments to transform $this\n");
+ exit;
+ }
+ my $pio180 = 0.017453292;
+
+ (my $tmp1 = $point->slice("(0)")) +=
+ 0.5+($data->slice("($inds->[0])")-$this->{Center}[0]) /
+ ($this->{Scale}[0][1] - $this->{Scale}[0][0])
+ *cos($data->slice("($inds->[1])")*$pio180);
+ (my $tmp2 = $point->slice("(1)")) +=
+ 0.5+($data->slice("($inds->[1])")-$this->{Center}[1]) /
+ ($this->{Scale}[1][1] - $this->{Scale}[1][0]);
+
+ (my $tmp3 = $point->slice("(2)")) .=
+ log($data->slice("($inds->[2])")/1012.5)/log($this->{Scale}[2][1]/1012.5);
+ return $point;
+}
+
+
+package PDL::Graphics::TriD::PolarStereoAxes;
+use PDL::Core '';
+
+
+sub new {
+ my($type) = @_;
+ bless {Names => [LONGITUDE,LATITUDE,HEIGHT]},$type;
+}
+
+sub init_scale {
+ my($this) = @_;
+ $this->{Scale} = [];
+}
+
+
+sub add_scale {
+ my($this,$data,$inds) = @_;
+ my $i = 0;
+
+ for(@$inds) {
+ my $d = $data->slice("($_)");
+ my $max = $d->max;
+ my $min = $d->min;
+
+ if($i==1){
+ if($max > 89.9999 or $min < -89.9999){
+ barf "Error in Latitude $max $min\n";
+
+ }
+ }
+ elsif($i==2){
+ $max = 1012.5 if($max<1012.5);
+ $min = 100 if($min>100);
+ }
+
+ if(!defined $this->{Scale}[$i]) {
+ $this->{Scale}[$i] = [$min,$max];
+ } else {
+ if($min < $this->{Scale}[$i][0]) {
+ $this->{Scale}[$i][0] = $min;
+ }
+ if($max > $this->{Scale}[$i][1]) {
+ $this->{Scale}[$i][1] = $max;
+ }
+ }
+ $i++;
+ }
+
+ $this->{Center} = [$this->{Scale}[0][0]+($this->{Scale}[0][1]-$this->{Scale}[0][0])/2,
+ $this->{Scale}[1][0]+($this->{Scale}[1][1]-$this->{Scale}[1][0])/2];
+}
+
+sub finish_scale {
+ my($this) = @_;
+ my @dist;
+ # Normalize the smallest differences away.
+ for(@{$this->{Scale}}) {
+ if(abs($_->[0] - $_->[1]) < 0.000001) {
+ $_->[1] = $_->[0] + 1;
+ }
+ push(@dist,$_->[1]-$_->[0]);
+ }
+ # for the z coordiniate reverse the min and max values
+ my $max = $this->{Scale}[2][0];
+ if($max < $this->{Scale}[2][1]){
+ $this->{Scale}[2][0] = $this->{Scale}[2][1];
+ $this->{Scale}[2][1] = $max;
+ }
+
+# Normalize longitude and latitude scale
+
+ if($dist[1] > $dist[0]){
+ $this->{Scale}[0][0] -= ($dist[1]-$dist[0])/2;
+ $this->{Scale}[0][1] += ($dist[1]-$dist[0])/2;
+ }elsif($dist[0] > $dist[1] && $dist[0]<90){
+ $this->{Scale}[1][0] -= ($dist[0]-$dist[1])/2;
+ $this->{Scale}[1][1] += ($dist[0]-$dist[1])/2;
+ }elsif($dist[0] > $dist[1]){
+ $this->{Scale}[1][0] -= (90-$dist[1])/2;
+ $this->{Scale}[1][1] += (90-$dist[1])/2;
+ }
+
+
+}
+
+sub transform {
+ my($this,$point,$data,$inds) = @_;
+ my $i = 0;
+
+ if($#$inds!=2){
+ barf("Wrong number of arguments to transform $this\n");
+ exit;
+ }
+ my $pio180 = 0.017453292;
+
+ (my $tmp1 = $point->slice("(0)")) +=
+ 0.5+($data->slice("($inds->[0])")-$this->{Center}[0]) /
+ ($this->{Scale}[0][1] - $this->{Scale}[0][0])
+ *cos($data->slice("($inds->[1])")*$pio180);
+ (my $tmp2 = $point->slice("(1)")) +=
+ 0.5+($data->slice("($inds->[1])")-$this->{Center}[1]) /
+ ($this->{Scale}[1][1] - $this->{Scale}[1][0])
+ *cos($data->slice("($inds->[1])")*$pio180);
+
+
+# Longitude transformation
+# (my $tmp = $point->slice("(0)")) =
+# ($this->{Center}[0]-$point->slice("(0)"))*cos($data->slice("(1)"));
+
+# Latitude transformation
+# (my $tmp = $point->slice("(1)")) =
+# ($this->{Center}[1]-$data->slice("(1)"))*cos($data->slice("(1)"));
+# Vertical transformation
+# -7.2*log($data->slice("(2)")/1012.5
+
+ (my $tmp3 = $point->slice("(2)")) .=
+ log($data->slice("($inds->[2])")/1012.5)/log($this->{Scale}[2][1]/1012.5);
+
+ return $point;
+}
+1;
diff --git a/Graphics/TriD/TriD/Image.pm b/Graphics/TriD/TriD/Image.pm
new file mode 100644
index 0000000..57f1fdd
--- /dev/null
+++ b/Graphics/TriD/TriD/Image.pm
@@ -0,0 +1,141 @@
+
+# What makes this complicated is that we want
+# imag(3,x,y,z,q,d,f)
+# appear in one 2D image, flattened out appropriately, with
+# one black space between the subimages.
+# The X coordinate will be ((x+1)*z+1)*d and the
+# Y coordinate ((y+1)*q+1)*f. We need to use splitdim to obtain
+# a piddle of the imag dimensions from the flat piddle.
+
+package PDL::Graphics::TriD::Image;
+ at ISA=qw/PDL::Graphics::TriD::Object/;
+use PDL::Lite;
+
+my $defaultvert = PDL->pdl([
+ [0,0,0],
+ [1,0,0],
+ [1,1,0],
+ [0,1,0]
+]);
+
+# r,g,b = 0..1
+sub new {
+ my($type,$color,$opts) = @_;
+ my $im = PDL::Graphics::TriD::realcoords(COLOR,$color);
+ my $this = {
+ Im => $im,
+ Opts => $opts,
+ Points => $defaultvert,
+ };
+ if(defined $opts->{Points}) {
+ $this->{Points} = $opts->{Points};
+ if("ARRAY" eq ref $this->{Points}) {
+ $this->{Points} = PDL->pdl($this->{Points});
+ }
+ }
+ bless $this,$type;
+}
+
+sub get_points {
+ return $_[0]->{Points};
+}
+
+# In the future, have this happen automatically by the piddles.
+sub data_changed {
+ my($this) = @_;
+ $this->changed();
+}
+
+# ND piddle -> 2D
+sub flatten {
+ my ($this,$bin_align) = @_;
+ my @dims = $this->{Im}->dims;
+ shift @dims; # get rid of the '3'
+ my $xd = $dims[0]; my $yd = $dims[1];
+ my $xdr = $xd; my $ydr = $yd;
+# Calculate the whole width of the image.
+ my $ind = 0;
+ my $xm = 0; my $ym = 0;
+ for(@dims[2..$#dims]) {
+ if($ind % 2 == 0) {
+ $xd ++; # = $dims[$ind-2];
+ $xd *= $_;
+ $xdr ++;
+ $xdr *= $_;
+# $xd --; # = $dims[$ind-2];
+ $xm++;
+ } else {
+ $yd ++; # = $dims[$ind-2];
+ $yd *= $_;
+ $ydr ++;
+ $ydr *= $_;
+# $yd --; # = $dims[$ind-2];
+ $ym++;
+ }
+ $ind++;
+ }
+ $xd -= $xm; $yd -= $ym;
+
+# R because the final texture must be 2**x-aligned ;(
+ my ($txd ,$tyd, $xxd, $yyd);
+ if ($bin_align) {
+ for($txd = 0; $txd < 12 and 2**$txd < $xdr; $txd++) {};
+ for($tyd = 0; $tyd < 12 and 2**$tyd < $ydr; $tyd++) {};
+ $txd = 2**$txd; $tyd = 2**$tyd;
+ $xxd = ($xdr > $txd ? $xdr : $txd);
+ $yyd = ($ydr > $tyd ? $ydr : $tyd);
+
+ if($#dims > 1) {
+# print "XALL: $xd $yd $xdr $ydr $txd $tyd\n";
+# print "DIMS: ",(join ',',$this->{Im}->dims),"\n";
+ }
+
+# $PDL::debug=1;
+ } else {
+ $xxd=$txd=$xdr; $yyd=$tyd=$ydr;
+ }
+
+ my $p = PDL->zeroes(PDL::float(),3,$xxd,$yyd);
+
+
+ if(defined $this->{Opts}{Bg}) {
+ $p .= $this->{Opts}{Bg};
+ }
+
+# print "MKFOOP\n";
+ my $foop = $p->slice(":,0:".($xdr-1).",0:".($ydr-1));
+
+
+ $ind = $#dims;
+ my $firstx = 1;
+ my $firsty = 1;
+ my $spi;
+ for(@dims[reverse(2..$#dims)]) {
+ $foop->make_physdims();
+# print "FOOP: \n"; $foop->dump;
+ if($ind % 2 == 0) {
+ $spi = $foop->getdim(1)/$_;
+ $foop = $foop->splitdim(1,$spi)->slice(":,0:-2")->
+ mv(2,3);
+ } else {
+ $spi = $foop->getdim(2)/$_;
+ $foop = $foop->splitdim(2,$spi)->slice(":,:,0:-2");
+ }
+# print "IND+\n";
+ $ind++; # Just to keep even/odd correct
+ }
+# $foop->dump;
+ print "ASSGNFOOP!\n" if $PDL::debug;
+
+ $foop .= $this->{Im};
+# print "P: $p\n";
+ return wantarray() ? ($p,$xd,$yd,$txd,$tyd) : $p;
+}
+
+sub toimage {
+ # initially very simple implementation
+ my ($this) = @_;
+ return $this->flatten(0);
+}
+
+1;
diff --git a/Graphics/TriD/TriD/Labels.pm b/Graphics/TriD/TriD/Labels.pm
new file mode 100644
index 0000000..b5122fe
--- /dev/null
+++ b/Graphics/TriD/TriD/Labels.pm
@@ -0,0 +1,61 @@
+=head1 NAME
+
+PDL::Graphics::TriD::Labels -- Text tools
+
+=head1 SYNOPSIS
+
+ my $l = new PDL::Graphics::TriD::Labels($lablepoints,
+ {Strings=>$strlist
+ ,Font=>$font});
+
+
+=head1 WARNING
+
+This module is experimental and the interface will probably change.
+
+=head1 DESCRIPTION
+
+This module is used to write Labels on the graphs of TriD
+
+=head1 AUTHOR
+
+Copyright (C) 1997 Tuomas J. Lukka (lukka at husc.harvard.edu).
+ 2000 James P. Edwards (jedwards at inmet.gov.br)
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
+package PDL::Graphics::TriD::Labels;
+
+BEGIN {
+ use PDL::Config;
+ if ( $PDL::Config{USE_POGL} ) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw(:all)";
+ eval 'use PDL::Graphics::OpenGL::Perl::OpenGL';
+ } else {
+ eval 'use PDL::Graphics::OpenGL';
+ }
+}
+
+
+use PDL::Graphics::OpenGLQ;
+use base qw/PDL::Graphics::TriD::GObject/;
+
+sub gdraw {
+ my($this,$points) = @_;
+ glDisable(&GL_LIGHTING);
+ glColor3d(1,1,1);
+ PDL::Graphics::OpenGLQ::gl_texts($points,$this->{Options}{Font},$this->{Options}{Strings});
+ glEnable(&GL_LIGHTING);
+}
+
+sub get_valid_options {
+ return {UseDefcols => 0, Font=>$PDL::Graphics::TriD::GL::fontbase, Strings => [] }
+}
+
+
+1;
diff --git a/Graphics/TriD/TriD/Lines.pm b/Graphics/TriD/TriD/Lines.pm
new file mode 100644
index 0000000..4a10ebd
--- /dev/null
+++ b/Graphics/TriD/TriD/Lines.pm
@@ -0,0 +1,61 @@
+
+package PDL::Graphics::TriD::LinesFOOOLD;
+ at ISA=qw/PDL::Graphics::TriD::Object/;
+
+BEGIN {
+ use PDL::Config;
+ if ( $PDL::Config{USE_POGL} ) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw(:all)";
+ eval 'use PDL::Graphics::OpenGL::Perl::OpenGL';
+ } else {
+ eval 'use PDL::Graphics::OpenGL';
+ }
+}
+
+use PDL::Lite;
+
+sub new {
+ my($type,$x,$y,$z,$color) = @_;
+ my @xdims = $x->dims;
+ $color = PDL->pdl(1) if !defined $color;
+ my $this = {
+ X => $x, Y => $y, Z => $z,
+ Color => $color,
+ };
+ bless $this,$type;
+}
+
+sub get_boundingbox {
+ my ($this) = @_;
+ my (@mins, at maxs);
+ for (X,Y,Z) {
+ push @mins, $this->{$_}->min();
+ push @maxs, $this->{$_}->max();
+ }
+ print "LineBound: ",(join ',', at mins, at maxs),"\n";
+ return PDL::Graphics::TriD::BoundingBox->new( @mins, at maxs );
+}
+
+# XXX Color is ignored.
+sub togl {
+ my($this) = @_;
+ glDisable(GL_LIGHTING);
+ glBegin(&GL_LINE_STRIP);
+ my $first = 1;
+ PDL::threadover_n($this->{X},$this->{Y},$this->{Z},$this->{Color},sub {
+ if(shift > 0) {
+ if(!$first) {
+ glEnd();
+ glBegin(&GL_LINE_STRIP);
+ } else {$first = 0;}
+ }
+ my $color = pop @_;
+ glColor3f($color,0,1-$color);
+ glVertex3d(@_);
+# print "VERTEX: ",(join ",", at _),"\n";
+ }) ;
+ glEnd();
+ glEnable(GL_LIGHTING);
+}
+
+1;
diff --git a/Graphics/TriD/TriD/Logo.pm b/Graphics/TriD/TriD/Logo.pm
new file mode 100644
index 0000000..d3dad08
--- /dev/null
+++ b/Graphics/TriD/TriD/Logo.pm
@@ -0,0 +1,481 @@
+package PDL::Graphics::TriD::Logo;
+use PDL::Lite;
+
+ at ISA=qw/PDL::Graphics::TriD::Object/;
+
+sub new {
+ my ($type,$pos,$size) = @_;
+ $this = bless {},$type;
+ $this->{Points} = PDL->pdl ([
+ [ 0.843, 0.852, 0],
+ [ 0.843, 0.852, -1],
+ [ 1.227, 0.891, 0],
+ [ 1.227, 0.891, -1],
+ [ 1.56, 1.071, 0],
+ [ 1.56, 1.071, -1],
+ [ 1.722, 1.488, 0],
+ [ 1.722, 1.488, -1],
+ [ 1.656, 1.776, 0],
+ [ 1.656, 1.776, -1],
+ [ 1.488, 1.956, 0],
+ [ 1.488, 1.956, -1],
+ [ 0.942, 2.076, 0],
+ [ 0.942, 2.076, -1],
+ [ 0.105, 2.076, 0],
+ [ 0.105, 2.076, -1],
+ [ 0.105, 1.989, 0],
+ [ 0.105, 1.989, -1],
+ [ 0.339, 1.95, 0],
+ [ 0.339, 1.95, -1],
+ [ 0.375, 1.797, 0],
+ [ 0.375, 1.797, -1],
+ [ 0.375, 0.279, 0],
+ [ 0.375, 0.279, -1],
+ [ 0.339, 0.126, 0],
+ [ 0.339, 0.126, -1],
+ [ 0.105, 0.087, 0],
+ [ 0.105, 0.087, -1],
+ [ 0.105, 0, 0],
+ [ 0.105, 0, -1],
+ [ 0.99, 0, 0],
+ [ 0.99, 0, -1],
+ [ 0.99, 0.087, 0],
+ [ 0.99, 0.087, -1],
+ [ 0.714, 0.126, 0],
+ [ 0.714, 0.126, -1],
+ [ 0.672, 0.279, 0],
+ [ 0.672, 0.279, -1],
+ [ 0.672, 0.852, 0],
+ [ 0.672, 0.852, -1],
+ [ 0.714, 1.947, 0],
+ [ 0.714, 1.947, -1],
+ [ 0.9, 1.971, 0],
+ [ 0.9, 1.971, -1],
+ [ 1.266, 1.842, 0],
+ [ 1.266, 1.842, -1],
+ [ 1.398, 1.467, 0],
+ [ 1.398, 1.467, -1],
+ [ 1.242, 1.071, 0],
+ [ 1.242, 1.071, -1],
+ [ 0.894, 0.957, 0],
+ [ 0.894, 0.957, -1],
+ [ 0.717, 0.975, 0],
+ [ 0.717, 0.975, -1],
+ [ 0.672, 1.074, 0],
+ [ 0.672, 1.074, -1],
+ [ 0.672, 1.86, 0],
+ [ 0.672, 1.86, -1],
+ [ 2.526, 1.944, 0],
+ [ 2.526, 1.944, -1],
+ [ 2.82, 1.971, 0],
+ [ 2.82, 1.971, -1],
+ [ 3.222, 1.896, 0],
+ [ 3.222, 1.896, -1],
+ [ 3.48, 1.701, 0],
+ [ 3.48, 1.701, -1],
+ [ 3.657, 1.062, 0],
+ [ 3.657, 1.062, -1],
+ [ 3.591, 0.594, 0],
+ [ 3.591, 0.594, -1],
+ [ 3.411, 0.3, 0],
+ [ 3.411, 0.3, -1],
+ [ 3.132, 0.147, 0],
+ [ 3.132, 0.147, -1],
+ [ 2.784, 0.105, 0],
+ [ 2.784, 0.105, -1],
+ [ 2.529, 0.15, 0],
+ [ 2.529, 0.15, -1],
+ [ 2.472, 0.375, 0],
+ [ 2.472, 0.375, -1],
+ [ 2.472, 1.8, 0],
+ [ 2.472, 1.8, -1],
+ [ 1.905, 1.989, 0],
+ [ 1.905, 1.989, -1],
+ [ 2.139, 1.95, 0],
+ [ 2.139, 1.95, -1],
+ [ 2.175, 1.797, 0],
+ [ 2.175, 1.797, -1],
+ [ 2.175, 0.279, 0],
+ [ 2.175, 0.279, -1],
+ [ 2.139, 0.126, 0],
+ [ 2.139, 0.126, -1],
+ [ 1.905, 0.087, 0],
+ [ 1.905, 0.087, -1],
+ [ 1.905, 0, 0],
+ [ 1.905, 0, -1],
+ [ 2.841, 0, 0],
+ [ 2.841, 0, -1],
+ [ 3.603, 0.192, 0],
+ [ 3.603, 0.192, -1],
+ [ 3.882, 0.522, 0],
+ [ 3.882, 0.522, -1],
+ [ 3.993, 1.074, 0],
+ [ 3.993, 1.074, -1],
+ [ 3.927, 1.491, 0],
+ [ 3.927, 1.491, -1],
+ [ 3.723, 1.815, 0],
+ [ 3.723, 1.815, -1],
+ [ 3.375, 2.013, 0],
+ [ 3.375, 2.013, -1],
+ [ 2.901, 2.076, 0],
+ [ 2.901, 2.076, -1],
+ [ 1.905, 2.076, 0],
+ [ 1.905, 2.076, -1],
+ [ 4.848, 1.95, 0],
+ [ 4.848, 1.95, -1],
+ [ 5.097, 1.989, 0],
+ [ 5.097, 1.989, -1],
+ [ 5.097, 2.076, 0],
+ [ 5.097, 2.076, -1],
+ [ 4.242, 2.076, 0],
+ [ 4.242, 2.076, -1],
+ [ 4.242, 1.989, 0],
+ [ 4.242, 1.989, -1],
+ [ 4.476, 1.95, 0],
+ [ 4.476, 1.95, -1],
+ [ 4.512, 1.797, 0],
+ [ 4.512, 1.797, -1],
+ [ 4.512, 0.279, 0],
+ [ 4.512, 0.279, -1],
+ [ 4.476, 0.126, 0],
+ [ 4.476, 0.126, -1],
+ [ 4.242, 0.087, 0],
+ [ 4.242, 0.087, -1],
+ [ 4.242, 0, 0],
+ [ 4.242, 0, -1],
+ [ 5.799, 0, 0],
+ [ 5.799, 0, -1],
+ [ 5.835, 0.537, 0],
+ [ 5.835, 0.537, -1],
+ [ 5.745, 0.537, 0],
+ [ 5.745, 0.537, -1],
+ [ 5.571, 0.174, 0],
+ [ 5.571, 0.174, -1],
+ [ 5.205, 0.105, 0],
+ [ 5.205, 0.105, -1],
+ [ 4.884, 0.135, 0],
+ [ 4.884, 0.135, -1],
+ [ 4.809, 0.36, 0],
+ [ 4.809, 0.36, -1],
+ [ 4.809, 1.797, 0],
+ [ 4.809, 1.797, -1]]);
+ $this->{Index} = PDL->pdl([
+ [ 0, 1, 2],
+ [ 3, 2, 1],
+ [ 2, 3, 4],
+ [ 5, 4, 3],
+ [ 4, 5, 6],
+ [ 7, 6, 5],
+ [ 6, 7, 8],
+ [ 9, 8, 7],
+ [ 8, 9, 10],
+ [ 11, 10, 9],
+ [ 10, 11, 12],
+ [ 13, 12, 11],
+ [ 12, 13, 14],
+ [ 15, 14, 13],
+ [ 14, 15, 16],
+ [ 17, 16, 15],
+ [ 16, 17, 18],
+ [ 19, 18, 17],
+ [ 18, 19, 20],
+ [ 21, 20, 19],
+ [ 20, 21, 22],
+ [ 23, 22, 21],
+ [ 22, 23, 24],
+ [ 25, 24, 23],
+ [ 24, 25, 26],
+ [ 27, 26, 25],
+ [ 26, 27, 28],
+ [ 29, 28, 27],
+ [ 28, 29, 30],
+ [ 31, 30, 29],
+ [ 30, 31, 32],
+ [ 33, 32, 31],
+ [ 32, 33, 34],
+ [ 35, 34, 33],
+ [ 34, 35, 36],
+ [ 37, 36, 35],
+ [ 36, 37, 38],
+ [ 39, 38, 37],
+ [ 38, 39, 0],
+ [ 1, 0, 39],
+ [ 40, 41, 42],
+ [ 43, 42, 41],
+ [ 42, 43, 44],
+ [ 45, 44, 43],
+ [ 44, 45, 46],
+ [ 47, 46, 45],
+ [ 46, 47, 48],
+ [ 49, 48, 47],
+ [ 48, 49, 50],
+ [ 51, 50, 49],
+ [ 50, 51, 52],
+ [ 53, 52, 51],
+ [ 52, 53, 54],
+ [ 55, 54, 53],
+ [ 54, 55, 56],
+ [ 57, 56, 55],
+ [ 56, 57, 40],
+ [ 41, 40, 57],
+ [ 58, 59, 60],
+ [ 61, 60, 59],
+ [ 60, 61, 62],
+ [ 63, 62, 61],
+ [ 62, 63, 64],
+ [ 65, 64, 63],
+ [ 64, 65, 66],
+ [ 67, 66, 65],
+ [ 66, 67, 68],
+ [ 69, 68, 67],
+ [ 68, 69, 70],
+ [ 71, 70, 69],
+ [ 70, 71, 72],
+ [ 73, 72, 71],
+ [ 72, 73, 74],
+ [ 75, 74, 73],
+ [ 74, 75, 76],
+ [ 77, 76, 75],
+ [ 76, 77, 78],
+ [ 79, 78, 77],
+ [ 78, 79, 80],
+ [ 81, 80, 79],
+ [ 80, 81, 58],
+ [ 59, 58, 81],
+ [ 82, 83, 84],
+ [ 85, 84, 83],
+ [ 84, 85, 86],
+ [ 87, 86, 85],
+ [ 86, 87, 88],
+ [ 89, 88, 87],
+ [ 88, 89, 90],
+ [ 91, 90, 89],
+ [ 90, 91, 92],
+ [ 93, 92, 91],
+ [ 92, 93, 94],
+ [ 95, 94, 93],
+ [ 94, 95, 96],
+ [ 97, 96, 95],
+ [ 96, 97, 98],
+ [ 99, 98, 97],
+ [ 98, 99,100],
+ [101,100, 99],
+ [100,101,102],
+ [103,102,101],
+ [102,103,104],
+ [105,104,103],
+ [104,105,106],
+ [107,106,105],
+ [106,107,108],
+ [109,108,107],
+ [108,109,110],
+ [111,110,109],
+ [110,111,112],
+ [113,112,111],
+ [112,113, 82],
+ [ 83, 82,113],
+ [114,115,116],
+ [117,116,115],
+ [116,117,118],
+ [119,118,117],
+ [118,119,120],
+ [121,120,119],
+ [120,121,122],
+ [123,122,121],
+ [122,123,124],
+ [125,124,123],
+ [124,125,126],
+ [127,126,125],
+ [126,127,128],
+ [129,128,127],
+ [128,129,130],
+ [131,130,129],
+ [130,131,132],
+ [133,132,131],
+ [132,133,134],
+ [135,134,133],
+ [134,135,136],
+ [137,136,135],
+ [136,137,138],
+ [139,138,137],
+ [138,139,140],
+ [141,140,139],
+ [140,141,142],
+ [143,142,141],
+ [142,143,144],
+ [145,144,143],
+ [144,145,146],
+ [147,146,145],
+ [146,147,148],
+ [149,148,147],
+ [148,149,150],
+ [151,150,149],
+ [150,151,114],
+ [115,114,151],
+ [ 13, 43, 41],
+ [ 13, 45, 43],
+ [ 11, 45, 13],
+ [ 11, 47, 45],
+ [ 5, 47, 11],
+ [ 5, 49, 47],
+ [ 3, 49, 5],
+ [ 3, 51, 49],
+ [ 1, 51, 3],
+ [ 1, 53, 51],
+ [ 39, 53, 1],
+ [ 39, 55, 53],
+ [ 57, 55, 39],
+ [ 57, 39, 37],
+ [ 21, 57, 37],
+ [ 23, 21, 37],
+ [ 35, 23, 37],
+ [ 21, 41, 57],
+ [ 21, 13, 41],
+ [ 19, 13, 21],
+ [ 19, 15, 13],
+ [ 17, 15, 19],
+ [ 5, 11, 9],
+ [ 7, 5, 9],
+ [ 35, 33, 31],
+ [ 23, 35, 31],
+ [ 25, 23, 31],
+ [ 27, 25, 31],
+ [ 29, 27, 31],
+ [111, 61, 59],
+ [111, 63, 61],
+ [109, 63,111],
+ [109, 65, 63],
+ [107, 65,109],
+ [107, 67, 65],
+ [101, 67,107],
+ [101, 99, 67],
+ [ 97, 75, 73],
+ [ 97, 77, 75],
+ [ 89, 77, 97],
+ [ 89, 79, 77],
+ [ 87, 79, 89],
+ [ 87, 81, 79],
+ [ 59, 81, 87],
+ [ 59, 87, 85],
+ [111, 59, 85],
+ [113,111, 85],
+ [ 83,113, 85],
+ [101,107,105],
+ [103,101,105],
+ [ 69, 67, 99],
+ [ 71, 69, 99],
+ [ 73, 71, 99],
+ [ 97, 73, 99],
+ [ 91, 89, 97],
+ [ 93, 91, 97],
+ [ 95, 93, 97],
+ [125,121,119],
+ [127,125,119],
+ [115,127,119],
+ [117,115,119],
+ [149,127,151],
+ [149,129,127],
+ [147,129,149],
+ [147,131,129],
+ [137,131,147],
+ [137,133,131],
+ [135,133,137],
+ [141,139,137],
+ [143,141,137],
+ [145,143,137],
+ [147,145,137],
+ [123,121,125],
+ [151,127,115],
+ [ 40, 42, 12],
+ [ 12, 42, 44],
+ [ 12, 44, 10],
+ [ 10, 44, 46],
+ [ 10, 46, 4],
+ [ 4, 46, 48],
+ [ 4, 48, 2],
+ [ 2, 48, 50],
+ [ 2, 50, 0],
+ [ 0, 50, 52],
+ [ 0, 52, 38],
+ [ 38, 52, 54],
+ [ 38, 54, 56],
+ [ 36, 38, 56],
+ [ 36, 56, 20],
+ [ 36, 20, 22],
+ [ 36, 22, 34],
+ [ 56, 40, 20],
+ [ 20, 40, 12],
+ [ 20, 12, 18],
+ [ 18, 12, 14],
+ [ 18, 14, 16],
+ [ 8, 10, 4],
+ [ 8, 4, 6],
+ [ 30, 32, 34],
+ [ 30, 34, 22],
+ [ 30, 22, 24],
+ [ 30, 24, 26],
+ [ 30, 26, 28],
+ [ 58, 60,110],
+ [110, 60, 62],
+ [110, 62,108],
+ [108, 62, 64],
+ [108, 64,106],
+ [106, 64, 66],
+ [106, 66,100],
+ [100, 66, 98],
+ [ 72, 74, 96],
+ [ 96, 74, 76],
+ [ 96, 76, 88],
+ [ 88, 76, 78],
+ [ 88, 78, 86],
+ [ 86, 78, 80],
+ [ 86, 80, 58],
+ [ 84, 86, 58],
+ [ 84, 58,110],
+ [ 84,110,112],
+ [ 84,112, 82],
+ [104,106,100],
+ [104,100,102],
+ [ 98, 66, 68],
+ [ 98, 68, 70],
+ [ 98, 70, 72],
+ [ 98, 72, 96],
+ [ 96, 88, 90],
+ [ 96, 90, 92],
+ [ 96, 92, 94],
+ [118,120,124],
+ [118,124,126],
+ [118,126,114],
+ [118,114,116],
+ [150,126,148],
+ [148,126,128],
+ [148,128,146],
+ [146,128,130],
+ [146,130,136],
+ [136,130,132],
+ [136,132,134],
+ [136,138,140],
+ [136,140,142],
+ [136,142,144],
+ [136,144,146],
+ [124,120,122],
+ [114,126,150]]);
+ $this->{Material} = new PDL::Graphics::TriD::Material(
+ Shine => 0.212766,
+ Specular =>[0.753217,0.934416,1],
+ Ambient =>[0,0,0],
+ Diffuse =>[0.09855,0.153113,0.191489],
+ Emissive =>[0, 0, 0]);
+ $this->{Pos} = defined($pos) ? $pos : [0,1.2,0];
+ $this->{Size} = defined($size) ? $size : 0.1;
+ return $this;
+}
+
+1;
+
+
+# ***add these lines to, e.g. tvrml2.pl
+#
+# use PDL::Graphics::TriD::Logo;
+# $win->add_object(new PDL::Graphics::TriD::Logo);
+
diff --git a/Graphics/TriD/TriD/MathGraph.pm b/Graphics/TriD/TriD/MathGraph.pm
new file mode 100644
index 0000000..e7fd9a3
--- /dev/null
+++ b/Graphics/TriD/TriD/MathGraph.pm
@@ -0,0 +1,177 @@
+=head1 NAME
+
+PDL::Graphics::TriD::MathGraph -- Mathematical Graph objects for PDL
+
+=head1 SYNOPSIS
+
+see the file Demos/TriD/tmathgraph.p in the PDL distribution.
+
+=head1 WARNING
+
+This module is experimental and the interface will probably change.
+
+=head1 DESCRIPTION
+
+This module exists for plotting mathematical graphs (consisting
+of nodes and arcs between them) in 3D and optimizing the placement of
+the nodes so that the graph is visualizable in a clear way.
+
+=head1 AUTHOR
+
+Copyright (C) 1997 Tuomas J. Lukka (lukka at husc.harvard.edu).
+
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
+package PDL::Graphics::TriD::MathGraph;
+use base qw/PDL::Graphics::TriD::GObject/;
+use fields qw/ArrowLen ArrowWidth/;
+
+BEGIN {
+ use PDL::Config;
+ if ( $PDL::Config{USE_POGL} ) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw(:all)";
+ eval 'use PDL::Graphics::OpenGL::Perl::OpenGL';
+ } else {
+ eval 'use PDL::Graphics::OpenGL';
+ }
+}
+
+
+sub gdraw {
+ my($this,$points) = @_;
+ glDisable(&GL_LIGHTING);
+# print "Color: $this->{Color} @{$this->{Color}}\n";
+ glColor3d(@{$this->{Options}{Color}});
+ PDL::Graphics::OpenGLQ::gl_arrows($points,$this->{Options}{From},
+ $this->{Options}{To},$this->{ArrowLen},$this->{ArrowWidth});
+ glEnable(&GL_LIGHTING);
+}
+
+sub get_valid_options {
+ return {UseDefcols => 0,From => [],To => [],Color => [1,1,1],
+ ArrowWidth => 0.05, ArrowLen => 0.1}
+}
+
+package PDL::GraphEvolverOLD;
+use PDL::LiteF;
+
+sub new {
+ my($type,$nnodes) = @_;
+ bless {NNodes => $nnodes,Coords => 500*PDL::random(PDL->zeroes(3,$nnodes))},
+ $type;
+}
+
+sub set_links {
+ my($this,$from,$to,$strength) = @_;
+ my $cd = $this->{NNodes};
+ $this->{DistMult} = PDL->zeroes($cd,$cd);
+ $distmult = PDL->zeroes($cd,$cd);
+ (my $t1 = $this->{DistMult}->index2d($from,$to)) += $strength;
+ (my $t2 = $this->{DistMult}->index2d($to,$from)) += $strength;
+ print "DM: $distmult\n" if $verbose;
+}
+
+sub set_distmult {
+ my($this,$mat) = @_;
+ $this->{DistMult} = $mat;
+}
+
+sub set_fixed {
+ my($this,$ind,$coord) = @_;
+ $this->{FInd} = $ind; $this->{FCoord} = $coord;
+}
+
+sub step {
+# $verbose=1;
+ my($this) = @_;
+ my $c = $this->{Coords};
+ my $vecs = $c - $c->dummy(1);
+ my $dists = sqrt(($vecs**2)->sumover)+0.0001;
+ print "D: $dists\n" if $verbose;
+ (my $t1 = $dists->diagonal(0,1)) .= 1000000;
+ my $d2 = $dists ** -0.5; # inverse
+ my $m = $d2**4 - 2*($this->{DistMult})*($dists+5*$dists**2) + 0.00001
+ - 0.000001 * $dists;
+ print "DN: $m\n" if $verbose;
+ print "V: $vecs\n" if $verbose;
+ my $tst = 1;
+ $this->{Velo} -= $tst * 0.04 * (inner($m->dummy(1), $vecs->mv(1,0)));
+ $this->{Velo} *=
+ ((0.96*50/(50+sqrt(($this->{Velo}**2)->sumover->dummy(0)))))**$tst;
+ $c += $tst * 0.05 * $this->{Velo};
+ (my $tmp = $c->xchg(0,1)->index($this->{FInd}->dummy(0)))
+ .= $this->{FCoord}
+ if (defined $this->{FInd});
+ print "C: $c\n" if $verbose;
+}
+
+sub getcoords {return $_[0]{Coords}}
+
+package PDL::GraphEvolver;
+use PDL::Lite;
+use PDL::Graphics::TriD::Rout ":Func";
+
+sub new {
+ my($type,$nnodes) = @_;
+ bless {NNodes => $nnodes,Coords => PDL::random(PDL->zeroes(3,$nnodes)),
+ BoxSize => 3, DMult => 5000,
+ A => -100.0, B => -5, C => -0.1, D => 0.01,
+ M => 30, MS => 1,
+ },$type;
+}
+
+sub set_links {
+ my($this,$from,$to,$strength) = @_;
+ $this->{From} = $from;
+ $this->{To} = $to;
+ $this->{Strength} = $strength;
+}
+
+sub set_fixed {
+ my($this,$ind,$coord) = @_;
+ $this->{FInd} = $ind; $this->{FCoord} = $coord;
+}
+
+sub step {
+# $verbose=1;
+ my($this) = @_;
+ my $c = $this->{Coords};
+ my $velr = repulse($c,@{$this}{BoxSize,DMult,A,B,C,D});
+ my $vela;
+ if("ARRAY" eq ref $this->{From}) {
+ my $ind;
+ for $_ (0..$#{$this->{From}}) {
+ $vela += attract($c,
+ $this->{From}[$_],
+ $this->{To}[$_],
+ $this->{Strength}[$_],$this->{M},$this->{MS});
+ }
+ } else {
+ $vela = attract($c,@{$this}{From,To,Strength},$this->{M},
+ $this->{MS});
+ }
+
+# print "V: $velr $vela\n";
+
+ $tst = 0.10;
+ $this->{Velo} += $tst * 0.02 * ($velr + $vela);
+ $this->{Velo} *=
+ ((0.92*50/(50+sqrt(($this->{Velo}**2)->sumover->dummy(0)))))**$tst;
+ $c += $tst * 0.05 * $this->{Velo};
+ (my $tmp = $c->xchg(0,1)->index($this->{FInd}->dummy(0)))
+ .= $this->{FCoord}
+ if (defined $this->{FInd});
+ print "C: $c\n" if $verbose;
+}
+
+sub getcoords {return $_[0]{Coords}}
+
+1;
+
+1;
diff --git a/Graphics/TriD/TriD/Mesh.pm b/Graphics/TriD/TriD/Mesh.pm
new file mode 100644
index 0000000..bbc7798
--- /dev/null
+++ b/Graphics/TriD/TriD/Mesh.pm
@@ -0,0 +1,208 @@
+##############################################
+#
+# Given 2D data, make a mesh.
+#
+# This is only for a set of rectangular meshes.
+#
+# Use PDL::Graphics::TriD::Surface for more general stuff.
+#
+# I try to make this general enough that all Surface methods
+# work on this data also.
+#
+
+# The different types of normals are a headache.
+# If we have a normal per vertex, we get smoothing.
+# If we want flat shading, ... need normal / square or triangle.
+
+# But: if we have
+# normal(3, polygons, vertices, @overdims),
+# we could possibly map it for both cases.
+# Flat: normal(3,polygon, (), @)
+# Smooth: normal(3,(), vertex, @)
+
+package PDL::Graphics::TriD::Mesh;
+
+BEGIN {
+ use PDL::Config;
+ if ( $PDL::Config{USE_POGL} ) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw(:all)";
+ eval 'use PDL::Graphics::OpenGL::Perl::OpenGL';
+ } else {
+ eval 'use PDL::Graphics::OpenGL';
+ }
+}
+
+use PDL::LiteF;
+ at ISA=qw/PDL::Graphics::TriD::Object/;
+
+# For now, x and y coordinates = values.
+
+sub new {
+ my($type,$data,$xaxis,$yaxis) = @_;
+ my @dims = $data->dims;
+ my @xydims = splice @dims,0,2;
+ my @overdims = @dims;
+ my $this = {
+ Vertices => PDL->zeroes(3, at xydims, at overdims)->double,
+ XYDims => [@xydims],
+ OverDims => [@overdims],
+ Data => $data,
+ };
+ PDL::Primitive::axisvalues($this->{Vertices}->slice('(0),:,:'));
+ PDL::Primitive::axisvalues($this->{Vertices}->slice('(1),:,:')->xchg(0,1));
+ PDL::Ops::assgn($this->{Data},$this->{Vertices}->slice('(2),:,:'));
+ bless $this,$type;
+}
+
+sub printdims {print $_[0].": ".(join ', ',$_[1]->dims)," and ",
+ (join ', ',$_[1]->threadids),"\n"}
+
+sub get_boundingbox {
+ my($this) = @_;
+ my $foo = PDL->zeroes(6)->double;
+ $a = $this->{Vertices}; printdims "A",$a;
+ $b = $a->thread(0); printdims "B",$b;
+ $c = $b->clump(-1); printdims "C",$c;
+ $d = $c->unthread(1); printdims "D",$d;
+
+ $this->{Vertices}->thread(0);
+
+ PDL::Primitive::minimum($this->{Vertices}->thread(0)->clump(-1)->unthread(1),
+ $foo->slice('0:2'));
+ PDL::Primitive::maximum($this->{Vertices}->thread(0)->clump(-1)->unthread(1),
+ $foo->slice('3:5'));
+ print "MeshBound: ",(join ',',$foo->list()),"\n";
+ return PDL::Graphics::TriD::BoundingBox->new( $foo->list() );
+}
+
+sub normals_flat {
+ my($this) = @_;
+ $this->_allocnormalspoly();
+ my $v00 = $this->{Vertices}->slice('(2),0:-2,0:-2');
+ my $v01 = $this->{Vertices}->slice('(2),0:-2,1:-1');
+ my $v10 = $this->{Vertices}->slice('(2),1:-1,0:-2');
+ my $v11 = $this->{Vertices}->slice('(2),1:-1,1:-1');
+# $this->{Normals}->printdims("NORMALS");
+ my $nx = $this->{Normals}->slice('(0),:,:,(0),(0)');
+# $nx->printdims("NX"); $v00->printdims("V0");
+ $nx *= PDL->pdl(0);
+ $nx += $v11; $nx -= $v01; $nx += $v10; $nx -= $v00;
+ $nx *= PDL->pdl(-0.5);
+ my $ny = $this->{Normals}->slice('(1),:,:,(0),(0)');
+ $ny *= PDL->pdl(0);
+ $ny += $v11; $ny -= $v10; $ny += $v01; $ny -= $v00;
+ $ny *= PDL->pdl(-0.5);
+ my $nz = $this->{Normals}->slice('(2),:,:,(0),(0)');
+ $nz .= PDL->pdl(1);
+ print $this->{Vertices};
+ print $this->{Normals};
+ print $nx,$ny,$nz;
+}
+
+sub _allocnormalspoly {
+ my($this) = @_;
+ $this->{Normals} = (PDL->zeroes(3, (map {$_-1} @{$this->{XYDims}}),
+ @{$this->{OverDims}})->double )
+ -> dummy(3,$this->{XYDims}[1])
+ -> dummy(3,$this->{XYDims}[0]);
+}
+
+sub _allocnormalsvertex {
+ my($this) = @_;
+ $this->{Normals} = (double zeroes(3, (@{$this->{XYDims}}),
+ @{$this->{OverDims}}))
+ -> dummy(1,$this->{XYDims}[1]-1)
+ -> dummy(1,$this->{XYDims}[0]-1);
+}
+
+# Right now, I assume the flat model.
+sub togl {
+ my($this) = @_;
+ my ($x,$y);
+# forextradims ([$this->{Vertices},_],
+ for $x (0..$this->{XYDims}[0]-2) {
+ for $y (0..$this->{XYDims}[1]-2) {
+ my ($x1,$y1) = ($x+1,$y+1);
+ glBegin(GL_TRIANGLE_STRIP);
+ print "ONESTRIP\n", (join '',
+ $this->{Normals}->slice(":,($x),($y),($x),($y)")
+ ),"\n";
+ glNormal3d(
+ $this->{Normals}->slice(":,($x),($y),($x),($y)")
+ ->list());
+# print "VERTEX0: ",(join ',',
+# $this->{Vertices}->slice(":,($x),($y)")->list()),
+# "\n";
+ glVertex3d($this->{Vertices}->slice(":,($x),($y)")->list());
+ glVertex3d($this->{Vertices}->slice(":,($x1),($y)")->list());
+ glVertex3d($this->{Vertices}->slice(":,($x),($y1)")->list());
+ glVertex3d($this->{Vertices}->slice(":,($x1),($y1)")->list());
+ glEnd();
+# Show normal
+# glBegin(&GL_LINES);
+# glVertex3d($this->{Vertices}->slice(":,($x),($y)")->list());
+# glVertex3d(
+# ($this->{Vertices}->slice(":,($x),($y)") +
+# $this->{Normals}->slice(":,($x),($y),($x),($y)"))
+# ->list());
+# glEnd();
+ }
+ }
+}
+
+package PDL::Graphics::TriD;
+#use PDL::Graphics::OpenGL;
+use PDL::Graphics::OpenGL::Perl::OpenGL;
+use PDL::Core '';
+
+sub pdltotrianglemesh {
+ my($pdl,$x0,$x1,$y0,$y1) = @_;
+ if($#{$pdl->{Dims}} != 1) { barf "Too many dimensions for PDL::GL::Mesh: $#{$pdl->{Dims}} \n"; }
+ my ($d0,$d1); my($x,$y);
+ $xincr = ($x1 - $x0) / ($pdl->{Dims}[0]-1.0);
+ $yincr = ($y1 - $y0) / ($pdl->{Dims}[1]-1.0);
+ $x = $x0;
+ my($v00,$v01,$v11,$v10);
+ my($nx,$ny);
+ for $d0 (0..$pdl->{Dims}[0]-2) {
+ $y = $y0;
+ for $d1 (0..$pdl->{Dims}[1]-2) {
+ glBegin(GL_TRIANGLE_STRIP);
+ ($v00,$v01,$v11,$v10) =
+ (PDL::Core::at($pdl,$d0,$d1)
+ ,PDL::Core::at($pdl,$d0,$d1+1)
+ ,PDL::Core::at($pdl,$d0+1,$d1+1)
+ ,PDL::Core::at($pdl,$d0+1,$d1));
+
+ ($nx,$ny) = (-0.5*($v11+$v10-$v01-$v00)/$xincr,
+ -0.5*($v11-$v10+$v01-$v00)/$yincr);
+ glNormal3d($nx,$ny,1);
+ glVertex3d($x,$y,$v00);
+ glVertex3d($x+$xincr,$y,$v10);
+ glVertex3d($x,$y+$yincr,$v01);
+ glVertex3d($x+$xincr,$y+$yincr,$v11);
+ glEnd();
+ if(0) {
+ glBegin(GL_LINES);
+ glVertex3d($x,$y,$v00);
+ glVertex3d($x+$nx/10,$y+$ny/10,$v00+1/10);
+ glEnd();
+ }
+ $y += $yincr;
+ }
+ $x += $xincr;
+ }
+}
+
+sub pdl2normalizedmeshlist {
+ my($pdl) = @_;
+ my $mult = 1.0/($pdl->{Dims}[0]-1);
+ my $lno = glGenLists(1);
+ glNewList($lno,GL_COMPILE);
+ pdltotrianglemesh($pdl, 0, 1, 0, ($pdl->{Dims}[1]-1)*$mult);
+ glEndList();
+ return $lno;
+}
+
+
+1;
diff --git a/Graphics/TriD/TriD/OOGL.pm b/Graphics/TriD/TriD/OOGL.pm
new file mode 100644
index 0000000..c4bac5c
--- /dev/null
+++ b/Graphics/TriD/TriD/OOGL.pm
@@ -0,0 +1,44 @@
+package PDL::Graphics::TriD::OOGL;
+
+$PDL::Graphics::TriD::create_window_sub = sub {
+ return new PDL::Graphics::TriD::OOGL::Window;
+};
+
+
+package PDL::Graphics::TriD::Object;
+
+#use PDL::Graphics::OpenGL;
+
+BEGIN {
+ use PDL::Config;
+ if ($PDL::Config{USE_POGL}) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw(:all)";
+ }
+}
+
+use PDL::Graphics::OpenGL::Perl::OpenGL;
+sub tooogl {
+ my($this) = @_;
+ join "\n",map { $_->togl() } (@{$this->{Objects}})
+}
+
+package PDL::Graphics::TriD::GL::Window;
+use FileHandle;
+
+sub new {my($type) = @_;
+ my($this) = bless {},$type;
+}
+
+sub update_list {
+
+ local $SIG{PIPE}= sub {}; # Prevent crashing if user exits the pager
+
+ my($this) = @_;
+ my $fh = new FileHandle("|togeomview");
+ my $str = join "\n",map {$_->tooogl()} (@{$this->{Objects}}) ;
+ print $str;
+ $fh->print($str);
+}
+
+sub twiddle {
+}
diff --git a/Graphics/TriD/TriD/Object.pm b/Graphics/TriD/TriD/Object.pm
new file mode 100644
index 0000000..ff68963
--- /dev/null
+++ b/Graphics/TriD/TriD/Object.pm
@@ -0,0 +1,110 @@
+###################################
+#
+#
+package PDL::Graphics::TriD::Object;
+
+use strict;
+
+use fields qw(Objects ValidList ChangedSub List VRML);
+sub new{
+ my $class = shift;
+ my $self = fields::new($class);
+
+ $self;
+}
+
+sub clear_objects {
+ my($this) = @_;
+ $this->{Objects} = [];
+ $this->{ValidList} = 0;
+}
+
+
+sub delete_object {
+ my($this,$object) = @_;
+ return unless(defined $object && defined $this->{Objects});
+ for(0..$#{$this->{Objects}}){
+ if($object == $this->{Objects}[$_]){
+ splice(@{$this->{Objects}},$_,1);
+ redo;
+ }
+ }
+}
+
+# XXXXXXXXX sub {} makes all these objects and this window immortal!
+sub add_object {
+ my($this,$object) = @_;
+ push @{$this->{Objects}},$object;
+ $this->{ValidList} = 0;
+ for(@{$this->{ChangedSub}}) {
+ $object->add_changedsub($_);
+ }
+ if($this->i_keep_list) {
+ $object->add_changedsub(sub {$this->changed_from_above()});
+ }
+}
+
+sub changed_from_above {
+ my($this) = @_;
+ print "CHANGED_FROM_ABOVE\n" if $PDL::Graphics::TriD::verbose;
+ $this->changed();
+}
+
+sub add_changedsub {
+ my($this,$chsub) = @_;
+ push @{$this->{ChangedSub}}, $chsub;
+ for (@{$this->{Objects}}) {
+ $_->add_changedsub($chsub);
+ }
+}
+
+
+sub clear {
+ my($this) = @_;
+ # print "Clear: $this\n";
+ for(@{$this->{Objects}}) {
+ $_->clear();
+ }
+ $this->delete_displist();
+ delete $this->{ChangedSub};
+ delete $this->{Objects};
+}
+
+sub changed {
+ my($this) = @_;
+ print "VALID0 $this\n" if $PDL::Graphics::TriD::verbose;
+ $this->{ValidList} = 0;
+ for(@{$this->{ChangedSub}}) {
+ &$_($this);
+ }
+}
+
+sub i_keep_list {
+ return 0;
+}
+
+
+sub vrml_update {
+ my ($this) = @_;
+ use PDL::Graphics::VRML;
+
+ $this->{VRML} = new PDL::Graphics::VRMLNode('Transform',
+ 'translation' => "-1 -1 -1",
+ 'scale' => "2 2 2");
+ $this->{ValidList} = 1;
+}
+
+sub tovrml {
+ my($this) = @_;
+
+ print ref($this)," valid=",$this->{ValidList}," tovrml\n";
+
+ if (!$this->{ValidList}) {
+ $this->vrml_update();
+ }
+ $this->{VRML}->add('children',
+ [map {$_->tovrml()} @{$this->{Objects}}]);
+}
+
+
+1;
diff --git a/Graphics/TriD/TriD/Objects.pm b/Graphics/TriD/TriD/Objects.pm
new file mode 100644
index 0000000..c6becbe
--- /dev/null
+++ b/Graphics/TriD/TriD/Objects.pm
@@ -0,0 +1,306 @@
+=head1 NAME
+
+ PDL::Graphics::TriD::Objects - Simple Graph Objects for TriD
+
+=head1 SYNOPSIS
+
+ Look in PDL/Demos/TkTriD_demo.pm for several examples, the code
+ in PDL/Demos/TriD1.pm and PDL/Demos/TriD2.pm also uses objects
+ but it hides them from the user.
+
+=head1 DESCRIPTION
+
+GObjects can be either stand-alone or in Graphs, scaled properly.
+All the points used by the object must be in the member {Points}.
+I guess we can afford to force data to be copied (X,Y,Z) -> (Points)...
+
+=head1 OBJECTS
+
+=head2 PDL::Graphics::TriD::GObject
+
+Inherits from base PDL::Graphics::TriD::Object and adds fields Points, Colors and
+Options. Need lots more here...
+
+=cut
+
+package PDL::Graphics::TriD::GObject;
+use base qw/PDL::Graphics::TriD::Object/;
+use fields qw/Points Colors Options/;
+
+sub new {
+ my($type,$points,$colors,$options) = @_;
+
+ print "GObject new.. calling SUPER::new...\n" if($PDL::debug_trid);
+ my $this = $type->SUPER::new();
+ print "GObject new - back (SUPER::new returned $this)\n" if($PDL::debug_trid);
+
+ if(!defined $options and ref $colors eq "HASH") {
+ $options = $colors;
+ undef $colors;
+ }
+
+ print "GObject new - calling realcoords\n" if($PDL::debug_trid);
+ $points = PDL::Graphics::TriD::realcoords($type->r_type,$points);
+ print "GObject new - back from realcoords\n" if($PDL::debug_trid);
+
+ if(!defined $colors) {$colors = PDL->pdl(1,1,1);
+ $colors = $type->cdummies($colors,$points);
+ $options->{UseDefcols} = 1; # for VRML efficiency
+ } else {
+ $colors = PDL::Graphics::TriD::realcoords("COLOR",$colors);
+ }
+
+ $this->{Options} = $options;
+ $this->{Points} = $points;
+ $this->{Colors} = $colors;
+
+ $this->check_options();
+
+ print "GObject new - returning\n" if($PDL::debug_trid);
+ return $this;
+}
+
+
+sub check_options {
+ my($this) = @_;
+ my %newopts;
+ my $opts = $this->get_valid_options();
+ print "FETCHOPT: $this ".(join ',',%$opts)."\n" if $PDL::Graphics::TriD::verbose;
+ for(keys %$opts) {
+ if(!exists $this->{Options}{$_}) {
+ $newopts{$_} = $opts->{$_};
+ } else {
+ $newopts{$_} = delete $this->{Options}{$_};
+ }
+ }
+ if(keys %{$this->{Options}}) {
+ die("Invalid options left: ".(join ',',%{$this->{Options}}));
+ }
+ $this->{Options} = \%newopts;
+}
+
+
+sub set_colors {
+ my($this,$colors) = @_;
+ if(ref($colors) eq "ARRAY"){
+ $colors = PDL::Graphics::TriD::realcoords("COLOR",$colors);
+ }
+ $this->{Colors}=$colors;
+ $this->data_changed;
+}
+
+sub get_valid_options {
+ return {UseDefcols => 0};
+}
+
+sub get_points {
+ return $_[0]->{Points};
+}
+
+
+# In the future, have this happen automatically by the piddles.
+sub data_changed {
+ my($this) = @_;
+ $this->changed();
+}
+
+sub cdummies {return $_[1];}
+
+sub r_type { return ""; }
+
+sub defcols {
+ return defined($_[0]->{Options}->{UseDefcols}) &&
+ $_[0]->{Options}->{UseDefcols};
+}
+1;
+
+package PDL::Graphics::TriD::Points;
+use base qw/PDL::Graphics::TriD::GObject/;
+sub get_valid_options {
+ return {UseDefcols => 0, PointSize=> 1};
+}
+
+
+package PDL::Graphics::TriD::Spheres;
+use base qw/PDL::Graphics::TriD::GObject/;
+sub get_valid_options { # need to add radius
+ return {UseDefcols => 0, PointSize=> 1};
+}
+
+###########################################################################
+################# JNK 15mar11 added section start #########################
+# JNK 06dec00 -- edited from PDL::Graphics/TriD/GObject in file Objects.pm
+# GObjects can be either stand-alone or in Graphs, scaled properly.
+# All the points used by the object must be in the member {Points}.
+# I guess we can afford to force data to be copied (X,Y,Z) -> (Points)...
+# JNK: I don't like that last assumption for all cases..
+
+# JNK 27nov00 new object type:
+package PDL::Graphics::TriD::GPObject;
+# @ISA=qw/PDL::Graphics::TriD::GObject/;
+use base qw/PDL::Graphics::TriD::GObject/;
+# use fields qw/.../;
+
+sub new { my($type,$points,$faceidx,$colors,$options) = @_;
+ # faceidx is 2D pdl of indices into points for each face
+ if(!defined $options and ref $colors eq "HASH") {
+ $options = $colors;undef $colors; }
+ $points = PDL::Graphics::TriD::realcoords($type->r_type,$points);
+ $faces = $points->dice_axis(1,$faceidx->clump(-1))->splitdim(1,3);
+ # faces is 3D pdl slices of points, giving cart coords of face verts
+ if(!defined $colors) { $colors = PDL->pdl(1,1,1);
+ $colors = $type->cdummies($colors,$faces);
+ $options->{ UseDefcols } = 1; } # for VRML efficiency
+ else { $colors = PDL::Graphics::TriD::realcoords("COLOR",$colors); }
+ my $this = bless { Points => $points, Faceidx => $faceidx, Faces => $faces,
+ Colors => $colors, Options => $options},$type;
+ $this->check_options();return $this; }
+
+sub get_valid_options {
+ return { UseDefcols=>0, Lines=>0, Smooth=>1, Material=>0 }; }
+
+sub cdummies {
+ return $_[1]->dummy(1,$_[2]->getdim(2))->dummy(1,$_[2]->getdim(1)); }
+
+# JNK 13dec00 new object type:
+package PDL::Graphics::TriD::STrigrid_S;
+# @ISA=qw/PDL::Graphics::TriD::GPObject/;
+use base qw/PDL::Graphics::TriD::GPObject/;
+# use fields qw/.../;
+
+sub cdummies {
+ return $_[1]->dummy(1,$_[2]->getdim(2))->dummy(1,$_[2]->getdim(1)); }
+
+sub get_valid_options {
+ return { UseDefcols=>0, Lines=>0, Smooth=>1, Material=>0 }; }
+
+# calculate smooth normals
+sub smoothn { my ($this,$ddd) = @_;
+ my $v=$this->{Points};my $f=$this->{Faces};my $fvi=$this->{Faceidx};
+# ----------------------------------------------------------------------------
+ my @p = map { $f->slice(":,($_),:") } (0..(($fvi->dims)[0]-1));
+# ----------------------------------------------------------------------------
+ # the following line assumes all faces are triangles
+ my $fn = ($p[1]-$p[0])->crossp($p[2]-$p[1])->norm;
+# my $vfi = PDL::cat(map {PDL::cat(PDL::whichND($fvi==$_))->slice(':,(1)')}
+# (0..(($v->dims)[1]-1)));
+# the above, spread into several statements:
+# my @vfi2=();for my $idx (0..($v->dims)[1]-1) {
+# my @vfi0=PDL::whichND($fvi==$idx);
+# my $vfi1=PDL::cat(@vfi0);
+# $vfi2[$idx]=$vfi1->slice(':,(1)'); }
+# my $vfi=PDL::cat(@vfi2);
+# my $vmn = $fn->dice_axis(1,$vfi->clump(-1))->splitdim(1,($fvi->dims)[0]);
+# my $vn = $vmn->mv(1,0)->sumover->norm;
+# ----------------------------------------------------------------------------
+ my $vn=PDL::cat(
+ map { my $vfi=PDL::cat(PDL::whichND($fvi==$_))->slice(':,(1)');
+ $fn->dice_axis(1,$vfi)->mv(1,0)->sumover->norm }
+ (0..(($v->dims)[1]-1)) );
+# ----------------------------------------------------------------------------
+ return $vn; }
+# JNK 06dec00 new object type:
+package PDL::Graphics::TriD::STrigrid;
+# @ISA=qw/PDL::Graphics::TriD::GPObject/;
+use base qw/PDL::Graphics::TriD::GPObject/;
+# use fields qw/.../;
+
+sub cdummies { # copied from SLattice_S; not yet modified...
+ # called with (type,colors,faces)
+ return $_[1]->dummy(1,$_[2]->getdim(2))->dummy(1,$_[2]->getdim(1)); }
+
+sub get_valid_options { # copied from SLattice_S; not yet modified...
+ return { UseDefcols => 0, Lines => 1, Smooth => 0, Material => 0 }; }
+
+################# JNK 15mar11 added section finis #########################
+###########################################################################
+
+package PDL::Graphics::TriD::Lattice;
+use base qw/PDL::Graphics::TriD::GObject/;
+
+sub r_type {return "SURF2D";}
+
+sub cdummies { return $_[1]->dummy(1)->dummy(1); }
+
+package PDL::Graphics::TriD::Lines;
+use base qw/PDL::Graphics::TriD::GObject/;
+
+sub cdummies { return $_[1]->dummy(1); }
+
+sub r_type { return "SURF2D";}
+
+sub get_valid_options { return {UseDefcols => 0, LineWidth => 1}; }
+
+package PDL::Graphics::TriD::LineStrip;
+use base qw/PDL::Graphics::TriD::GObject/;
+
+sub cdummies { return $_[1]->dummy(1); }
+
+sub r_type { return "SURF2D";}
+
+sub get_valid_options { return {UseDefcols => 0, LineWidth => 1}; }
+
+package PDL::Graphics::TriD::GObject_Lattice;
+use base qw/PDL::Graphics::TriD::GObject/;
+
+sub r_type {return "SURF2D";}
+
+sub get_valid_options { return {UseDefcols => 0,Lines => 1}; }
+
+# colors associated with vertices, smooth
+package PDL::Graphics::TriD::SLattice;
+use base qw/PDL::Graphics::TriD::GObject_Lattice/;
+
+sub cdummies { return $_[1]->dummy(1,$_[2]->getdim(2))
+ -> dummy(1,$_[2]->getdim(1)); }
+
+# colors associated with surfaces
+package PDL::Graphics::TriD::SCLattice;
+use base qw/PDL::Graphics::TriD::GObject_Lattice/;
+
+sub cdummies { return $_[1]->dummy(1,$_[2]->getdim(2)-1)
+ -> dummy(1,$_[2]->getdim(1)-1); }
+
+
+# colors associated with vertices
+package PDL::Graphics::TriD::SLattice_S;
+use base qw/PDL::Graphics::TriD::GObject_Lattice/;
+use fields qw/Normals/;
+
+sub cdummies { return $_[1]->dummy(1,$_[2]->getdim(2))
+ -> dummy(1,$_[2]->getdim(1)); }
+
+
+sub get_valid_options { return {UseDefcols => 0,Lines => 1, Smooth => 0,
+ Material => 0}; }
+
+# calculate smooth normals
+sub smoothn {
+ my ($this,$p) = @_;
+ # coords of parallel sides (left and right via 'lags')
+ my $trip = $p->lags(1,1,2)->slice(':,:,:,1:-1') -
+ $p->lags(1,1,2)->slice(':,:,:,0:-2');
+ # coords of diagonals with dim 2 having original and reflected diags
+ my $tmp;
+ my $trid = ($p->slice(':,0:-2,1:-1')-$p->slice(':,1:-1,0:-2'))
+ ->dummy(2,2);
+ # $ortho is a (3D,x-1,left/right triangle,y-1) array that enumerates
+ # all triangles
+ my $ortho = $trip->crossp($trid);
+ $ortho->norm($ortho); # normalise inplace
+
+ # now add to vertices to smooth
+ my $aver = ref($p)->zeroes($p->dims);
+ # step 1, upper right tri0, upper left tri1
+ ($tmp=$aver->lags(1,1,2)->slice(':,:,:,1:-1')) += $ortho;
+ # step 2, lower right tri0, lower left tri1
+ ($tmp=$aver->lags(1,1,2)->slice(':,:,:,0:-2')) += $ortho;
+ # step 3, upper left tri0
+ ($tmp=$aver->slice(':,0:-2,1:-1')) += $ortho->slice(':,:,(0)');
+ # step 4, lower right tri1
+ ($tmp=$aver->slice(':,1:-1,0:-2')) += $ortho->slice(':,:,(1)');
+ $aver->norm($aver);
+ return $aver;
+}
+
+1;
diff --git a/Graphics/TriD/TriD/Polygonize.pm b/Graphics/TriD/TriD/Polygonize.pm
new file mode 100644
index 0000000..288dc78
--- /dev/null
+++ b/Graphics/TriD/TriD/Polygonize.pm
@@ -0,0 +1,134 @@
+# XXXX NOTHING BUT stupidpolygonize WORKS!!!!
+
+package PDL::Graphics::TriD::StupidPolygonize;
+
+use PDL::Core '';
+
+# A very simplistic polygonizer...
+# Center = positive, outside = negative.
+
+sub stupidpolygonize {
+ my($center, $initrad, $npatches, $nrounds, $func) = @_;
+ $a = PDL->zeroes(PDL::float(),3,$npatches,$npatches);
+ $mult = 2*3.14 / ($npatches-1);
+ my $ya = ($a->slice("(0)"))->xvals;
+ $ya *= $mult;
+ my $za = ($a->slice("(0)"))->yvals;
+ $za *= $mult/2;
+ $za -= 3.14/2;
+ (my $tmp0 = $a->slice("(0)")) += cos($ya);
+ (my $tmp1 = $a->slice("(1)")) += sin($ya);
+ (my $tmp01 = $a->slice("0:1")) *= cos($za)->dummy(0);
+ (my $tmp2 = $a->slice("(2)")) += sin($za);
+ my $add = $a->copy;
+ $a *= $initrad;
+ $a += $center;
+ my $cur = $initrad;
+ my $inita = $a->copy;
+ for(1..$nrounds) {
+ $cur /= 2;
+ $vp = $func->($a);
+ my $vps = ($vp > 0);
+ $vps -= 0.5; $vps *= 2;
+ $a += $vps->dummy(0) * $cur * $add;
+ }
+ return $a;
+}
+
+sub polygonizeraw {
+ my($data,$coords) = @_;
+}
+
+sub contours {
+}
+
+package PDL::Graphics::TriD::ContourPolygonize;
+
+#
+# First compute contours.
+use vars qw/$cube $cents/;
+$cube = PDL->pdl([
+ [-1,-1,-1],
+ [-1,-1,1],
+ [-1,1,-1],
+ [-1,1,1],
+ [1,-1,-1],
+ [1,-1,1],
+ [1,1,-1],
+ [1,1,1]
+]);
+
+$cents = PDL->pdl([
+ [0,0,-1],
+ [0,0,1],
+ [0,-1,0],
+ [0,1,0],
+ [-1,0,0],
+ [1,0,0],
+]);
+
+sub contourpolygonize {
+ my($in,$oscale,$scale,$func) = @_;
+ my $ccube = $cube * $oscale;
+ my $maxstep=0;
+ while(($func->($ccube)>=0)->sum > 0) {
+ $ccube *= 1.5;
+ if($maxstep ++ > 30) {
+ die("Too far inside");
+ }
+ }
+# Now, we have a situation with a cube that has inside a I point
+# and as corners O points. This does not guarantee that we have all
+# the surface but it's enough for now.
+
+}
+
+#############
+
+#sub trianglepolygonize {
+#
+# find_3nn(
+#}
+
+package PDL::Graphics::TriD::Polygonize;
+
+use PDL::Core '';
+
+# Inside positive, outside negative!
+#
+# XXX DOESN'T WORK
+
+sub polygonize {
+ my($inv,$outv,$cubesize,$func) = @_;
+ barf "Must be positive" if $cubesize <= 0;
+ my $iv = $func->($inv);
+ my $ov = $func->($outv);
+ my $s;
+# Find a close enough point to zero.
+ while(((sqrt(($iv-$ov))**2))->sum > $cubesize) {
+ my $s = $iv + $ov; $s /= 2;
+ my $v = $func->($s);
+ $v->sum < 0 ?
+ $ov = $s :
+ $iv = $s;
+ }
+# Correct the smaller distance to cubesize.
+ $iv = $ov + ($iv-$ov) * $cubesize / sqrt(($iv-$ov)**2)
+# If it went outside, do it the other way around.
+# if($func->($iv)->sum < 0) {
+# $ov = $iv + ($ov-$iv) * $cubesize / sqrt(($iv-$ov)**2)
+# }
+# Now, |$iv-$ov| = $cubesize
+# Make the first cube
+
+
+# Then, start the cubes march.
+}
+
+# Cube coordinates.
+sub marchcubes {
+ my($init) = @_;
+
+}
+
+1;
diff --git a/Graphics/TriD/TriD/Quaternion.pm b/Graphics/TriD/TriD/Quaternion.pm
new file mode 100644
index 0000000..3880e74
--- /dev/null
+++ b/Graphics/TriD/TriD/Quaternion.pm
@@ -0,0 +1,174 @@
+##############################################
+#
+# Quaternions... inefficiently.
+#
+# Should probably use PDL and C... ?
+#
+# Stored as [c,x,y,z].
+#
+# XXX REMEMBER!!!! First component = cos(angle*2), *NOT* cos(angle)
+
+package PDL::Graphics::TriD::Quaternion;
+
+sub new {
+ my($type,$c,$x,$y,$z) = @_;
+ my $this;
+
+ if(ref($type)){
+ $this = $type;
+ }else{
+ $this = bless [$c,$x,$y,$z],$type;
+ }
+ return $this;
+}
+
+sub copy {
+ return new PDL::Graphics::TriD::Quaternion(@{$_[0]});
+}
+
+sub new_vrmlrot {
+ my($type,$x,$y,$z,$a) = @_;
+ my $l = sqrt($x**2+$y**2+$z**2);
+ my $this = bless [cos($a/2),map {sin($a/2)*$_/$l} $x,$y,$z],$type;
+ $this->normalize_this();
+ return $this;
+}
+
+sub to_vrmlrot {
+ my($this) = @_;
+ my $d = POSIX::acos($this->[0]);
+ if(abs($d) < 0.0000001) {
+ return [0,0,1,0];
+ }
+ return [(map {$_/sin($d)} @{$this}[1..3]),2*$d];
+}
+
+# Yuck
+sub multiply {
+ my($this,$with) = @_;
+ return PDL::Graphics::TriD::Quaternion->new(
+ $this->[0] * $with->[0] -
+ $this->[1] * $with->[1] -
+ $this->[2] * $with->[2] -
+ $this->[3] * $with->[3],
+ $this->[2] * $with->[3] -
+ $this->[3] * $with->[2] +
+ $this->[0] * $with->[1] +
+ $this->[1] * $with->[0],
+ $this->[3] * $with->[1] -
+ $this->[1] * $with->[3] +
+ $this->[0] * $with->[2] +
+ $this->[2] * $with->[0],
+ $this->[1] * $with->[2] -
+ $this->[2] * $with->[1] +
+ $this->[0] * $with->[3] +
+ $this->[3] * $with->[0],
+ );
+}
+
+sub multiply_scalar {
+ my($this,$scalar) = @_;
+ my $ang = POSIX::acos($this->[0]);
+ my $d = sin($ang);
+ if(abs($d) < 0.0000001) {
+ return new PDL::Graphics::TriD::Quaternion(1,0,0,0);
+ }
+ $ang *= $scalar;
+ my $d2 = sin($ang);
+ return new PDL::Graphics::TriD::Quaternion(
+ cos($ang), map {$_*$d2/$d} @{$this}[1..3]
+ );
+}
+
+sub set {
+ my($this,$new) = @_;
+ @$this = @$new;
+}
+
+sub add {
+ my($this,$with) = @_;
+ return PDL::Graphics::TriD::Quaternion->new(
+ $this->[0] * $with->[0],
+ $this->[1] * $with->[1],
+ $this->[2] * $with->[2],
+ $this->[3] * $with->[3]);
+}
+
+sub abssq {
+ my($this) = @_;
+ return $this->[0] ** 2 +
+ $this->[1] ** 2 +
+ $this->[2] ** 2 +
+ $this->[3] ** 2 ;
+}
+
+sub invert {
+ my($this) = @_;
+ my $abssq = $this->abssq();
+ return PDL::Graphics::TriD::Quaternion->new(
+ 1/$abssq * $this->[0] ,
+ -1/$abssq * $this->[1] ,
+ -1/$abssq * $this->[2] ,
+ -1/$abssq * $this->[3] );
+}
+
+sub invert_rotation_this {
+ my($this) = @_;
+ $this->[0] = - $this->[0];
+}
+
+sub normalize_this {
+ my($this) = @_;
+ my $abs = sqrt($this->abssq());
+ @$this = map {$_/$abs} @$this;
+}
+
+sub rotate {
+ my($this,$vec) = @_;
+ my $q = (PDL::Graphics::TriD::Quaternion)->new(0,@$vec);
+ my $m = $this->multiply($q->multiply($this->invert));
+ return [@$m[1..3]];
+}
+
+sub rotate_foo {
+ my ($this,$vec) = @_;
+# print "CP: ",(join ',',@$this)," and ",(join ',',@$vec),"\n";
+ return $vec if $this->[0] == 1 or $this->[0] == -1;
+# 1. cross product of my vector and rotated vector
+# XXX I'm not sure of any signs!
+ my @u = @$this[1..3];
+ my @v = @$vec;
+ my $tl = sqrt($u[0]**2 + $u[1]**2 + $u[2]**2);
+ my $up = sqrt($v[0]**2 + $v[1]**2 + $v[2]**2);
+ my @cp = (
+ $u[1] * $v[2] - $u[2] * $v[1],
+ $u[0] * $v[2] - $u[2] * $v[0],
+ $u[0] * $v[1] - $u[1] * $v[0],
+ );
+# Cross product of this and my vector
+ my @cp2 = (
+ $u[1] * $cp[2] - $u[2] * $cp[1],
+ $u[0] * $cp[2] - $u[2] * $cp[0],
+ $u[0] * $cp[1] - $u[1] * $cp[0],
+ );
+ my $cpl = 0.00000001 + sqrt($cp[0]**2 + $cp[1]**2 + $cp[2]**2);
+ my $cp2l = 0.0000001 + sqrt($cp2[0]**2 + $cp2[1]**2 + $cp2[2]**2);
+ for(@cp) {$_ /= $cpl}
+ for(@cp2) {$_ /= $cp2l}
+ my $mult1 = $up * sqrt(1-$this->[0]**2);
+ # my $mult1 = $up * sqrt(1-$this->[0]**2);
+ my $mult2 = $up * $this->[0];
+ print "ME: ",(join ' ', at u),"\n";
+ print "VEC: ",(join ' ', at v),"\n";
+ print "CP: ",(join ' ', at cp),"\n";
+ print "CP2: ",(join ' ', at cp2),"\n";
+ print "MULT1: $mult1, MULT2: $mult2\n";
+ print "CPL: ",$cpl, " TL: $tl CPLTL: ",$cpl/$tl,"\n";
+ my $res = [map {
+ $v[$_] + $mult1 * $cp[$_] + ($mult2 - $cpl/$tl)* $cp2[$_]
+ } 0..2];
+# print "RES: ",(join ',',@$res),"\n";
+ return $res;
+}
+
+1;
diff --git a/Graphics/TriD/TriD/SimpleScaler.pm b/Graphics/TriD/TriD/SimpleScaler.pm
new file mode 100644
index 0000000..b213b65
--- /dev/null
+++ b/Graphics/TriD/TriD/SimpleScaler.pm
@@ -0,0 +1,59 @@
+######################################################################
+######################################################################
+## ScaleController -- this is the module that controls 3-D window scaling
+## when you drag the mouse in the display window.
+
+
+
+package PDL::Graphics::TriD::ScaleController;
+use base qw/PDL::Graphics::TriD::ButtonControl/;
+use fields qw/Dist/;
+
+sub new {
+ my($type,$win,$dist) = @_;
+
+ my $this = $type->SUPER::new( $win);
+
+ $this->{Dist} = $dist;
+ $win->add_resizecommand(sub {print "Resized window: ",join(",", at _),"\n" if $PDL::debug_trid; $this->set_wh(@_); });
+ return $this;
+}
+
+# coordinates normalised relative to center
+sub xy2norm {
+ my($this,$x,$y) = @_;
+ print "xy2norm: this->{W}=$this->{W}; this->{H}=$this->{H}; this->{SC}=$this->{SC}\n" if($PDL::Graphics::TriD::verbose);
+ $x -= $this->{W}/2; $y -= $this->{H}/2;
+ $x /= $this->{SC}; $y /= $this->{SC};
+ return ($x,$y);
+}
+
+sub mouse_moved {
+ my($this,$x0,$y0,$x1,$y1) = @_;
+# $this->{Dist} *=
+ ${$this->{Dist}} *=
+ $this->xy2fac($this->xy2norm($x0,$y0),$this->xy2norm($x1,$y1));
+}
+
+##############################################################
+#
+# a very simple unsophisticated scaler that
+# takes advantage of the nice infrastructure provided by
+# TJL
+#
+##############################################################
+package PDL::Graphics::TriD::SimpleScaler;
+
+use base qw/PDL::Graphics::TriD::ScaleController/;
+
+# x,y to distance from center
+sub xy2fac {
+ my($this,$x0,$y0,$x1,$y1) = @_;
+ my $dy = $y0-$y1;
+ return $dy>0 ? 1+2*$dy : 1/(1-2*$dy);
+}
+
+
+
+
+1;
diff --git a/Graphics/TriD/TriD/Surface.pm b/Graphics/TriD/TriD/Surface.pm
new file mode 100644
index 0000000..2fee7a0
--- /dev/null
+++ b/Graphics/TriD/TriD/Surface.pm
@@ -0,0 +1,48 @@
+
+package PDL::Graphics::TriD::Surface;
+
+BEGIN {
+ use PDL::Config;
+ if ( $PDL::Config{USE_POGL} ) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw(:all)";
+ eval 'use PDL::Graphics::OpenGL::Perl::OpenGL';
+ } else {
+ eval 'use PDL::Graphics::OpenGL';
+ }
+}
+
+use PDL::Lite;
+
+sub new {
+ my($nvertices,$nfaces,$nvertpface) = @_;
+ my $this = {
+ NVertices => $nvertices,
+ NFaces => $nfaces,
+ NVPF => $nvertpface,
+ Vertices => zeroes(3,$nvertices),
+ Faces => -1*ones($nvertices,$nvertpface)
+ };
+}
+
+# XXX Refit to use
+sub new_pdl2d {
+ my($pdl,%opts) = @_;
+ defined($opts{X}) or $opts{X} = xvals zeroes $pdl->getdim(0);
+ defined($opts{Y}) or $opts{Y} = xvals zeroes $pdl->getdim(1);
+}
+
+# Make normals as with no shared vertices.
+# 1 normal / face.
+sub normals_flat {
+}
+
+# Make normals as with round objects
+# 1 normal / vertice
+sub normals_smooth {
+}
+
+sub togl {
+}
+
+
+1;
diff --git a/Graphics/TriD/TriD/TextObjects.pm b/Graphics/TriD/TriD/TextObjects.pm
new file mode 100644
index 0000000..fbe3fcd
--- /dev/null
+++ b/Graphics/TriD/TriD/TextObjects.pm
@@ -0,0 +1,19 @@
+# These objects contain textual descriptions of the graph.
+# Placed suitably in relation to origin to be used with a graph.
+
+package PDL::Graphics::TriD::Description;
+
+ at ISA=qw/PDL::Graphics::TriD::Object/;
+
+sub new {
+ my($type,$text) = @_;
+ local $_ = $text;
+ s/\\/\\\\/g;
+ s/"/\\"/g;
+ my $this = bless {
+ TText => "[".(join ',',map {"\"$_\""} split "\n",$_)."]"
+ },$type;
+ return $this;
+}
+
+1;
diff --git a/Graphics/TriD/TriD/VRML.pm b/Graphics/TriD/TriD/VRML.pm
new file mode 100644
index 0000000..d06d346
--- /dev/null
+++ b/Graphics/TriD/TriD/VRML.pm
@@ -0,0 +1,761 @@
+=head1 NAME
+
+PDL::Graphics::TriD::VRML -- TriD VRML backend
+
+=head1 SYNOPSIS
+
+ BEGIN { $PDL::Graphics::TriD::device = "VRML"; }
+
+ use PDL::Graphics::TriD;
+ use PDL::LiteF;
+
+ # set some vrml parameters
+ my $set = tridsettings(); # get the defaults
+ $set->browser_com('netscape/unix');
+ $set->compress();
+ $set->file('/www-serv/vrml/dynamic_scene.wrl.gz');
+
+ line3d([$x,$y,$z]); # plot some lines and view the scene with a browser
+
+=head1 DESCRIPTION
+
+This module implements the VRML for PDL::Graphics::TriD (the generic
+3D plotting interface for PDL). You can use this backend either (a)
+for generating 3D graphics on your machine which can be directly
+viewed with a VRML browser or (b) generate dynamic VRML worlds to
+distribute over the web.
+
+With VRML, you can generate objects for everyone to see with e.g.
+Silicon Graphics' Cosmo Player. You can find out more about VRML
+at C<http://vrml.sgi.com/> or C<http://www.vrml.org/>
+
+=cut
+
+#'
+
+###################################
+##
+package PDL::Graphics::TriD::VRML;
+
+use PDL::Core ''; # barf
+use PDL::Graphics::VRML;
+use PDL::LiteF;
+use PDL::Config;
+PDL::Graphics::VRMLNode->import();
+PDL::Graphics::VRMLProto->import();
+
+$PDL::homepageURL = 'http://pdl.perl.org/';
+
+sub PDL::Graphics::TriD::Logo::tovrml {
+ my ($this) = @_;
+ my ($p,$tri) = ("","");
+ PDL::Graphics::VRMLPdlNode::v3array($this->{Points},\$p,"");
+ PDL::Graphics::VRMLPdlNode::triangles((map
+ {$this->{Index}->slice("($_)")} (0..2)),\$tri,"");
+ my $indface = vrn('IndexedFaceSet',
+ 'coord' => vrn('Coordinate',
+ 'point' => "[ $p ]"),
+ 'coordIndex' => "[ $tri ]",
+ 'solid' => 'TRUE');
+ return vrn('Transform',
+ 'children' => [vrn('Anchor',
+ 'description' => "\"The PDL Homepage\"",
+ 'url' => "\"$PDL::homepageURL\"",
+ 'children' =>
+ vrn('Shape',
+ 'appearance' =>
+ vrn('Appearance',
+ 'material' =>
+ $this->{Material}->tovrml),
+ 'geometry' => $indface)),
+ vrn(Viewpoint,
+ position => '0 0 25',
+ description => "\"PDL Logo\""
+ )
+
+ ],
+ 'translation' => vrml3v($this->{Pos}),
+ 'scale' => vrml3v([map {$this->{Size}} (0..2)]));
+}
+
+sub PDL::Graphics::TriD::Description::tovrml {
+ my($this) = @_;
+# print "DESCRTIPTION : TOVRML\n";
+ return vrn(Transform,
+ rotation => '1 0.1 0 1.1',
+ translation => '1.5 0 0.5',
+ children => [
+ vrn(Shape,
+ geometry => vrn(Text,
+ string => $this->{TText},
+ fontStyle => vrn(FontStyle,
+ 'family' => "\"SANS\"",
+ size => '0.075',
+ spacing => '1.33',
+ justify => '["BEGIN","MIDDLE"]'
+ ),
+ ),
+ appearance => vrn(Appearance,
+ material => vrn(Material,
+ diffuseColor => '0.9 0.9 0.9',
+ ambientIntensity => '0.1'
+ )
+ )
+ ),
+ vrn(Viewpoint,
+ position => '0 0 3',
+ description => "\"Description\""
+ )
+ ]
+ );
+}
+
+sub PDL::Graphics::VRML::vrmltext {
+ my ($this,$text,$coords) = @_;
+ $this->uses('TriDGraphText');
+ return vrn('TriDGraphText',
+ 'text' => "\"$text\"",
+ 'position' => vrml3v($coords));
+}
+
+sub PDL::Graphics::TriD::Material::tovrml {
+ my $this = shift;
+ my $ambi = (pdl(@{$this->{Ambient}})**2)->sum /
+ (pdl(@{$this->{Diffuse}})**2)->sum;
+ $ambi = sqrt($ambi);
+ new PDL::Graphics::VRMLNode('Material',
+ 'diffuseColor' => vrml3v($this->{Diffuse}),
+ 'emissiveColor' => vrml3v($this->{Emissive}),
+ 'shininess' => $this->{Shine},
+ 'ambientIntensity' => $ambi,
+ 'specularColor' => vrml3v($this->{Specular}),
+ );
+}
+
+sub PDL::Graphics::TriD::Scale::tovrml {my ($this) = @_;
+ print "Scale ",(join ',',@{$this->{Args}}),"\n";
+ new PDL::Graphics::VRMLNode('Transform',
+ 'scale',vrml3v(@{$this->{Args}}));
+ }
+
+
+sub PDL::Graphics::TriD::Translation::tovrml {
+ my ($this) = @_;
+ new PDL::Graphics::VRMLNode('Transform',
+ 'translation',vrml3v(@{$this->{Args}}));
+}
+
+# XXXXX this has to be fixed -> wrap in one transform + children
+sub PDL::Graphics::TriD::Transformation::tovrml {
+ my($this) = @_;
+ my @nodes = map {$_->tovrml()} @{$this->{Transforms}};
+ push @nodes,$this->SUPER::tovrml();
+}
+
+
+sub PDL::Graphics::TriD::Quaternion::tovrml {my($this) = @_;
+ if(abs($this->[0]) == 1) { return ; }
+ if(abs($this->[0]) >= 1) {
+ # die "Unnormalized Quaternion!\n";
+ $this->normalize_this();
+ }
+ new PDL::Graphics::VRMLNode('Transform',
+ 'rotation',vrml3v(@{$this}[1..3])." $this->[0]");
+}
+
+
+# this 'poor mans viewport' implementation makes an image from its objects
+# and writes it as a gif file
+sub PDL::Graphics::TriD::ViewPort::togif_vp {
+ require PDL::IO::Pic;
+ my ($this,$win,$rec,$file) = @_;
+ my $p;
+ # this needs more thinking
+ for (@{$this->{Objects}}) {
+ barf "can't display object type" unless $_->can('toimage');
+ $p = $_->toimage;
+ }
+ $p->wpic($file);
+}
+
+sub PDL::Graphics::TriD::GObject::tovrml {
+ return $_[0]->vdraw($_[0]->{Points});
+}
+
+sub PDL::Graphics::TriD::GObject::tovrml_graph {
+ return $_[0]->vdraw($_[2]);
+}
+
+sub PDL::Graphics::TriD::Points::vdraw {
+ my($this,$points) = @_;
+ new PDL::Graphics::VRMLNode('Shape',
+ 'geometry' =>
+ new PDL::Graphics::VRMLPdlNode($points,$this->{Colors},
+ {Title => 'PointSet',
+ DefColors => $this->defcols}));
+}
+
+sub PDL::Graphics::TriD::LineStrip::vdraw {
+ my($this,$points) = @_;
+ new PDL::Graphics::VRMLNode('Shape',
+ 'geometry' =>
+ new PDL::Graphics::VRMLPdlNode($points,$this->{Colors},
+ {Title => 'IndexedLineSet',
+ DefColors => $this->defcols}));
+}
+
+sub PDL::Graphics::TriD::Lattice::vdraw {
+ my($this,$points) = @_;
+ new PDL::Graphics::VRMLNode('Shape',
+ 'geometry' =>
+ new PDL::Graphics::VRMLPdlNode($points,$this->{Colors},
+ {Title => 'IndexedLineSet',
+ DefColors => $this->defcols,
+ IsLattice => 1}));
+}
+
+sub PDL::Graphics::TriD::SLattice::vdraw {
+ my($this,$points) = @_;
+ my $children = [vrn('Shape',
+ 'geometry' =>
+ new PDL::Graphics::VRMLPdlNode($points,$this->{Colors},
+ {Title => 'IndexedFaceSet',
+ DefColors => $this->defcols,
+ IsLattice => 1,
+ }))];
+ push @$children, vrn('Shape',
+ 'geometry' =>
+ new PDL::Graphics::VRMLPdlNode($points,$this->{Colors},
+ {Title => 'IndexedLineSet',
+ DefColors => 0,
+ Surface => 1,
+ Lines => 1,
+ IsLattice => 1,
+ }))
+ if $this->{Options}->{Lines};
+ vrn('Group',
+ 'children' => $children);
+}
+
+sub PDL::Graphics::TriD::SLattice_S::vdraw {
+ my($this,$points) = @_;
+ my $vp = &PDL::Graphics::TriD::get_current_window()->current_viewport;
+ my $mat = $vp->{DefMaterial}->tovrml;
+ my $children = [vrn('Shape',
+ 'appearance' => vrn('Appearance',
+ 'material' => $mat),
+ 'geometry' =>
+ new PDL::Graphics::VRMLPdlNode($points,$this->{Colors},
+ {Title => 'IndexedFaceSet',
+ DefColors => 1,
+ IsLattice => 1,
+ Smooth => $this->{Options}->{Smooth},
+ }))];
+ push @$children, vrn('Shape',
+ 'geometry' =>
+ new PDL::Graphics::VRMLPdlNode($points,$this->{Colors},
+ {Title => 'IndexedLineSet',
+ DefColors => 0,
+ Surface => 1,
+ Lines => 1,
+ IsLattice => 1,
+ }))
+ if $this->{Options}->{Lines};
+ vrn('Group',
+ 'children' => $children);
+}
+
+##################################
+# PDL::Graphics::TriD::Image
+#
+#
+
+sub PDL::Graphics::TriD::Image::tovrml {
+ $_[0]->vdraw();
+}
+
+sub PDL::Graphics::TriD::Image::tovrml_graph {
+ &PDL::Graphics::TriD::Image::tovrml;
+}
+
+
+# The quick method is to use texturing for the good effect.
+# XXXXXXXXXXXX wpic currently rescales $im 0..255, that's not correct (in $url->save)! fix
+sub PDL::Graphics::TriD::Image::vdraw {
+ my ($this,$vert) = @_;
+ my $p = $this->flatten(0); # no binary alignment
+ if(!defined $vert) {$vert = $this->{Points}}
+ my $url = new PDL::Graphics::TriD::VRML::URL('image/JPG');
+ $url->save($p);
+ vrn('Shape',
+ 'appearance' => vrn('Appearance',
+ 'texture' => vrn('ImageTexture',
+ 'url' => '"'.$url->totext.'"')),
+ 'geometry' =>
+ vrn('IndexedFaceSet',
+ 'coord' => vrn('Coordinate',
+ 'point' =>
+ [map {vrml3v([$vert->slice(":,($_)")->list])}
+ (0..3)]),
+ 'coordIndex' => '[0, 1, 2, 3, -1]',
+ 'solid' => 'FALSE'),
+ );
+}
+
+sub PDL::Graphics::TriD::Graph::tovrml {
+ my($this) = @_;
+ my @children = ();
+ for(keys %{$this->{Axis}}) {
+ if($_ eq "Default") {next}
+ push @children, @{$this->{Axis}{$_}->tovrml_axis($this)};
+ }
+ for(keys %{$this->{Data}}) {
+ push @children,
+ $this->{Data}{$_}->tovrml_graph($this,$this->get_points($_));
+ }
+ return vrn('Group', 'children' => [@children]);
+}
+
+
+sub PDL::Graphics::TriD::EuclidAxes::tovrml_axis {
+ my($this,$graph) = @_;
+ my $vrml = $PDL::Graphics::VRML::cur;
+ my $lset = vrn('Shape',
+ 'geometry' => vrn('IndexedLineSet',
+ 'coord',
+ vrn('Coordinate',
+ 'point',["0 0 0",
+ "1 0 0",
+ "0 1 0",
+ "0 0 1"]),
+ 'coordIndex',["0,1,-1",
+ "0,2,-1",
+ "0,3,-1"]));
+ my ($vert,$indx,$j) = ([],[],0);
+ my @children = ($lset);
+ for $dim (0..2) {
+ my @coords = (0,0,0);
+ my @coords0 = (0,0,0);
+ for(0..2) {
+ if($dim != $_) { $coords[$_] -= 0.1 }
+ }
+ my $s = $this->{Scale}[$dim];
+ my $ndiv = 3;
+ my $radd = 1.0/$ndiv;
+ my $nadd = ($s->[1]-$s->[0])/$ndiv;
+ my $nc = $s->[0];
+ for(0..$ndiv) {
+ push @children, $vrml->vrmltext(sprintf("%.3f",$nc),[@coords]);
+ push @$vert,(vrml3v([@coords0]),vrml3v([@coords]));
+ push @$indx,$j++.", ".$j++.", -1";
+ $coords[$dim] += $radd;
+ $coords0[$dim] += $radd;
+ $nc += $nadd;
+ }
+ $coords0[$dim] = 1.1;
+ push @children, $vrml->vrmltext($this->{Names}[$dim],[@coords0]);
+ }
+ push @children, vrn('Shape',
+ 'geometry' => vrn('IndexedLineSet',
+ 'coord' =>
+ vrn('Coordinate',
+ 'point' => $vert),
+ 'coordIndex' => $indx));
+ return [@children];
+}
+
+sub PDL::Graphics::TriD::SimpleController::tovrml {
+ # World origin is disregarded XXXXXXX
+ my $this = shift;
+ my $inv = new PDL::Graphics::TriD::Quaternion(@{$this->{WRotation}});
+ $inv->invert_rotation_this;
+ my $pos = $inv->rotate([0,0,1]);
+# print "SC: POS0:",(join ',',@$pos),"\n";
+ for (@$pos) { $_ *= $this->{CDistance}}
+# print "SC: POS:",(join ',',@$pos),"\n";
+# ASSUME CRotation 0 for now
+ return vrn('Viewpoint',
+ 'position' => vrml3v($pos),
+# 'orientation' => vrml3v(@{$this->{CRotation}}[1..3]).
+# " $this->{CRotation}->[0]",
+ 'orientation' => vrml3v([@{$inv}[1..3]])." ".
+ -atan2(sqrt(1-$this->{WRotation}[0]**2),
+ $this->{WRotation}[0]),
+ 'description' => "\"Home\"");
+}
+
+
+package #split this line so the
+ # CPAN indexer doesn't complain
+ Win32;
+
+sub Win32::fn_win32_format {
+ my ($file) = @_;
+ $file =~ s|\\|/|g;
+ $file = "//$file" if $file =~ m|^[a-z,A-Z]+:|;
+ return $file;
+}
+
+package Win32::DDE::Netscape;
+use PDL::Core ''; # barf
+require Win32::DDE::Client if $^O =~ /win32/i;
+
+
+sub checkerr {
+ my $this = shift;
+ if ($this->Error) {
+ print Win32::DDE::ErrorText($this->Error), "\n# ",
+ $this->ErrorText;
+ barf "client: couldn't connect to netscape";
+ }
+ return $this;
+}
+
+sub activate {
+ my $client = new Win32::DDE::Client ('Netscape','WWW_Activate');
+ checkerr($client);
+ $client->Request('0xFFFFFFFF,0x0');
+ barf "can't disconnect" unless $client->Disconnect;
+}
+
+sub geturl {
+ my ($url) = @_;
+ my $client = new Win32::DDE::Client ('Netscape','WWW_OpenURL');
+ checkerr($client);
+ $status = $client->Request("\"$url\",,0xFFFFFFFF,0x1");
+ barf "can't disconnect" unless $client->Disconnect;
+}
+
+package PDL::Graphics::TriD::VRML::Parameter;
+use PDL::Core ''; # barf
+
+sub new {
+ my ($type,%hash) = @_;
+ my $this = bless {},$type;
+ $this->{Mode} = 'VRML';
+ for (keys %hash) { $this->{$_} = $hash{$_} }
+ return $this;
+}
+
+sub gifmode {
+ my ($this) = @_;
+ $this->{Mode} = 'GIF';
+}
+
+sub vrmlmode {
+ my ($this) = @_;
+ $this->{Mode} = 'VRML';
+}
+
+sub set {
+ my ($this,%hash) = @_;
+ for (keys %hash) { $this->{$_} = $hash{$_} }
+ return $this;
+}
+
+sub browser {
+ my ($this) = @_;
+ $this->{'Browser'} = $_[1] if $#_ > 0;
+ return $this->{'Browser'};
+}
+
+sub file {
+ my ($this) = @_;
+ if ($#_ > 0) {
+ $this->{'GifFile'} = $_[1];
+ $this->{'GifFile'} =~ s/[.][^.]+$/.gif/;
+ $this->{'HTMLFile'} = $_[1];
+ $this->{'HTMLFile'} =~ s/[.][^.]+$/.html/;
+ $this->{'File'} = $_[1];
+ $this->{'File'} =~ s/[.][^.]+$/.wrl/;
+ }
+ if ($this->{Mode} eq 'VRML') {
+ return $this->{'File'};
+ } elsif ($this->{Mode} eq 'GIF') {
+ return $this->{'HTMLFile'};
+ } else {
+ barf "wfile error: unknown mode";
+ }
+}
+
+sub wfile {
+ my ($this) = @_;
+ my $file = $this->{Mode} eq 'GIF' ? $this->{GifFile} : $this->{File};
+ if (defined $this->{Compress} && $this->{Compress}) {
+ $file .= '.gz' unless $file =~ /[.]gz$/; $this->file($file);
+ $file = '|gzip -c' . ($file =~ /^\s*>/ ? '' : '>') . $file;
+ }
+ return $file;
+}
+
+
+$PDL::Graphics::TriD::VRML::Parameter::lastfile = '';
+
+my %subs = (
+ 'netscape/unix' =>
+ sub {my $file = $_[0]->file; my $cmd;
+ if ($file eq
+ $PDL::Graphics::TriD::VRML::Parameter::lastfile)
+ { $cmd = 'reload' }
+ else { my $target = $#_ > 0 ? "#$_[1]" : '';
+ $cmd = "openURL(file:$file$target)"}
+ system('netscape','-remote',$cmd);
+ $PDL::Graphics::TriD::VRML::Parameter::lastfile = $file},
+ 'netscape/win32' =>
+ sub {my $file = $_[0]->file; $file = Win32::fn_win32_format $file;
+ Win32::DDE::Netscape::activate;
+ my $target = $#_ > 0 ? "#$_[1]" : '';
+ Win32::DDE::Netscape::geturl("file:$file$target");
+ },
+ 'none' => sub {print STDERR "not sending it anywhere\n"},
+);
+
+sub browser_com {
+ my ($this,$browser) = @_;
+ barf("unknown browser '$browser'") unless defined $subs{$browser};
+ $this->{'Browser'} = $subs{$browser};
+}
+
+sub send_to_browser {my $this=$_[0]; &{$this->{'Browser'}}(@_)
+ if defined $this->{'Browser'}}
+
+
+package PDL::Graphics::TriD::VRML::URL;
+use PDL::Core ''; # barf
+
+my %types = (
+ 'image/JPG' => {'save' => sub {local $PDL::debug=0; $_[1]->wpic($_[0]->wfile)},
+ 'ext' => 'jpg',
+ 'setup' => sub {require PDL::IO::Pic},
+ },
+);
+
+my $urlnum = 0;
+
+sub new {
+ my ($type,$mime) = @_;
+ my $this = bless {},$type;
+ barf "unknown mime type '$mime'" unless defined $types{$mime};
+ $this->{'Type'} = $types{$mime};
+ &{$this->{'Type'}->{'setup'}} if defined $this->{'Type'}->{'setup'};
+ $this->{'Binding'} = 'local';
+ $this->{'Filestem'} = $PDL::Config{TEMPDIR} . "/tridim_$urlnum";
+ $urlnum++;
+ return $this;
+}
+
+sub wfile {
+ my ($this) = @_;
+ return $this->{'Filestem'}.'.'.$this->{'Type'}->{'ext'};
+}
+
+sub totext {
+ my ($this) = @_;
+ my $proto;
+ if ($this->{'Binding'} eq 'local') { $proto = 'file' }
+ elsif ($this->{'Binding'} eq 'publish') {
+ $proto = 'http'; barf "not yet implemented" }
+ else { barf "unknown binding" }
+ return "$proto:".$this->wfile;
+}
+
+sub save { &{$_[0]->{Type}->{save}}(@_) }
+
+package PDL::Graphics::TriD::VRML;
+$PDL::Graphics::VRML::cur = undef;
+$PDL::Graphics::TriD::create_window_sub = sub {
+ return new PDL::Graphics::TriD::Window;
+};
+
+# set up the default parameters for VRML
+my $tmpdir = $PDL::Config{TEMPDIR} ||
+ die "TEMPDIR not found in %PDL::Config";
+my $tmpname = "$tmpdir/tridvrml_$$.wrl";
+my $para = $PDL::Graphics::TriD::Settings =
+ PDL::Graphics::TriD::VRML::Parameter->new() ;
+$para->file($tmpname);
+$para->browser_com($^O =~ /win32/i ? 'netscape/win32' : 'none');
+
+
+package PDL::Graphics::TriD::VRMLObject;
+use base qw/PDL::Graphics::TriD::Object/;
+use fields qw/Node/;
+
+sub new {
+ my($type,$node) = @_;
+ my $this = $type->SUPER::new();
+ $this->{Node} = $node;
+ return $this;
+
+}
+
+sub tovrml {
+ return $_[0]->{Node};
+}
+
+#package PDL::Graphics::TriD::VRML::Window;
+package PDL::Graphics::TriD::Window;
+
+use PDL::Graphics::TriD::Control3D;
+PDL::Graphics::VRMLNode->import();
+PDL::Graphics::VRMLProto->import();
+use PDL::Core ''; # barf
+
+use base qw/PDL::Graphics::TriD::Object/;
+use fields qw/Width Height Interactive _ViewPorts _CurrentViewPort
+ VRMLTop DefMaterial/;
+use strict;
+
+sub gdriver {
+ my($this) = @_;
+
+ require PDL::Version if not defined $PDL::Version::VERSION;
+ $this->{Width} = 300; $this->{Height} = 300;
+ $this->{VRMLTop} = new PDL::Graphics::VRML("\"PDL::Graphics::TriD::VRML Scene\"",
+ ["\"generated by the PDL::Graphics::TriD module\"",
+ "\"version $PDL::Version::VERSION\""]);
+ my $fontstyle = new PDL::Graphics::VRMLNode('FontStyle',
+ 'size' => 0.04,
+ 'family' => "\"SANS\"",
+ 'justify' => "\"MIDDLE\"");
+ $PDL::Graphics::TriD::VRML::fontstyle = $fontstyle;
+ $this->{VRMLTop}->add_proto(PDL::Graphics::TriD::SimpleController->new->tovrml);
+ $PDL::Graphics::VRML::cur = $this->{VRMLTop};
+ $this->{VRMLTop}->register_proto(
+ vrp('TriDGraphText',
+ [fv3f('position',"0 0 0"),
+ fmstr('text')],
+ vrn('Transform',
+ 'translation' => "IS position",
+ 'children' =>
+ [vrn('Billboard',
+ 'axisOfRotation' => '0 0 0',
+ 'children' =>
+ [vrn('Shape',
+ 'geometry' =>
+ vrn('Text',
+ 'string' => "IS text",
+ 'fontStyle' => $fontstyle))])])));
+ return 0;
+}
+
+#sub set_material {
+# $_[0]->{DefMaterial} = $_[1];
+#}
+
+# we only allow [0,0,1,1] viewports and just write a gif of the write size
+# for any children
+sub new_viewport {
+ my($this,$x0,$y0,$x1,$y1) = @_;
+ # print STDERR "Installing new viewport\n";
+ barf "only allowing [0,1,0,1] viewports with VRML backend"
+ if abs(PDL->pdl($x0,$y0,$x1-1,$y1-1))->max > 0.01;
+
+ my $vp = new PDL::Graphics::TriD::ViewPort($x0,$y0,$x1,$y1);
+ push @{$this->{_ViewPorts}},$vp;
+ return $vp;
+}
+
+sub clear_viewports {
+ my($this) = @_;
+ $this->{_ViewPorts} = [];
+}
+
+
+sub display {
+ my $this = shift;
+ my $vrmlparam = $PDL::Graphics::TriD::Settings;
+
+# if (@{$this->{_ViewPorts}}) {
+ if (0) {
+ # show the image
+ $vrmlparam->gifmode();
+ # print STDERR "writing a GIF image\n";
+ # print STDERR "Filename: ",$vrmlparam->wfile,"\n";
+ for(@{$this->{_ViewPorts}}) {
+ $_->togif_vp($this,$_,$vrmlparam->wfile);
+ }
+ my ($hfile,$gfile) = ($vrmlparam->file,$vrmlparam->wfile);
+ $hfile = '>'.$hfile unless $hfile =~ /^\s*[>|]/;
+ $gfile = Win32::fn_win32_format($gfile) if $^O =~ /win32/i;
+ open HTML, $hfile or barf "couldn't open html file $hfile";
+ print HTML <<"EOH";
+
+<HTML>
+<HEAD>
+ <TITLE> PDL::Graphics::TriD Display </TITLE>
+ <META NAME="GENERATOR" CONTENT="PDL::Graphics::TriD::VRML">
+</HEAD>
+<BODY>
+<TD align="center"><IMG SRC="$gfile" ALT="Gif image" HEIGHT=$this->{H}
+ WIDTH=$this->{W}></TD>
+</BODY>
+</HTML>
+
+EOH
+ close HTML;
+ $vrmlparam->send_to_browser();
+ } else {
+ # a 'normal' world
+ # print STDERR "printing a VRML world\n";
+ # print STDERR "Filename: ",$vrmlparam->wfile,"\n";
+ my $vp = $this->current_viewport;
+ $vp->tovrml;
+ if ($vp->{Transformer}) {
+ $this->{VRMLTop}->addview($vp->{Transformer}->tovrml)
+ }
+
+ $this->{VRMLTop}->ensure_protos();
+
+# use Data::Dumper;
+# my $out = Dumper($this->{VRML});
+# print $out;
+
+
+
+
+ $this->{VRMLTop}->set_vrml($vp->{VRML});
+ $vrmlparam->vrmlmode();
+ local $| = 1;
+ print "*********starting output\n";
+ $this->{VRMLTop}->print($vrmlparam->wfile);
+ print "*********finished output\n";
+ $vrmlparam->send_to_browser('Home'); #XXX make target selectable
+ }
+}
+
+sub twiddle {
+ my $this = shift;
+ if ($PDL::Graphics::TriD::keeptwiddling) {
+ $this->display();
+ print "---- (press enter)";
+ <>
+ }
+ # should probably wait for input of character 'q' ?
+}
+
+package PDL::Graphics::TriD::ViewPort;
+use base qw/PDL::Graphics::TriD::Object/;
+use fields qw/X0 Y0 W H Transformer EHandler Active ResizeCommands
+ DefMaterial AspectRatio Graphs/;
+
+
+
+
+1;
+
+=head1 BUGS
+
+Probably incomplete/buggy implementation of some TriD features.
+
+=head1 AUTHOR
+
+Copyright (C) 1997, 1998 Christian Soeller (c.soeller at auckland.ac.nz).
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
diff --git a/Graphics/TriD/TriD/ViewPort.pm b/Graphics/TriD/TriD/ViewPort.pm
new file mode 100644
index 0000000..bdbb245
--- /dev/null
+++ b/Graphics/TriD/TriD/ViewPort.pm
@@ -0,0 +1,118 @@
+#
+# The PDL::Graphics::TriD::ViewPort is already partially defined in
+# the appropriate gdriver (GL or VRML), items defined here are common
+# to both
+#
+package PDL::Graphics::TriD::ViewPort;
+use strict;
+
+sub new {
+ my($type,$x0,$y0,$w,$h) = @_;
+
+ my $this= $type->SUPER::new();
+
+ $this->{X0} = $x0;
+ $this->{Y0} = $y0;
+ $this->{W} = $w;
+ $this->{H} = $h;
+ $this->{DefMaterial} = new PDL::Graphics::TriD::Material;
+
+ return $this;
+}
+
+
+sub graph {
+ my($this,$graph) = @_;
+
+ if(defined($graph)){
+ $this->add_object($graph);
+ push(@{$this->{Graphs}},$graph);
+ }elsif(defined $this->{Graphs}){
+ $graph = $this->{Graphs}[0];
+ }
+ return($graph);
+
+}
+
+sub delete_graph {
+ my($this,$graph) = @_;
+
+ $this->delete_object($graph);
+ for(0..$#{$this->{Graphs}}){
+ if($graph == $this->{Graphs}[$_]){
+ splice(@{$this->{Graphs}},$_,1);
+ redo;
+ }
+ }
+
+
+}
+
+
+sub resize {
+ my($this,$x0,$y0,$w,$h) = @_;
+
+ $this->{X0} = $x0;
+ $this->{Y0} = $y0;
+ $this->{W} = $w;
+ $this->{H} = $h;
+ return $this;
+}
+
+
+
+sub add_resizecommand {
+ my($this,$com) = @_;
+ push @{$this->{ResizeCommands}},$com;
+ print "ARC: $this->{W},$this->{H}\n" if($PDL::Graphics::TriD::verbose);
+ &$com($this->{W},$this->{H});
+}
+
+sub set_material {
+ $_[0]->{DefMaterial} = $_[1];
+}
+
+sub eventhandler {
+ my ($this,$eh) = @_;
+ if(defined $eh){
+ $this->{EHandler} = $eh;
+ }
+ return $this->{EHandler};
+}
+
+sub set_transformer {
+ $_[0]->transformer($_[1]);
+}
+
+sub transformer {
+ my ($this,$t) = @_;
+ if(defined $t){
+ $this->{Transformer} = $t;
+ }
+ return $this->{Transformer};
+}
+
+
+#
+# restore the image view to a known value
+#
+sub setview{
+ my($vp,$view) = @_;
+
+ my $transformer = $vp->transformer();
+
+ if(ref($view) eq "ARRAY"){
+ $transformer->set({WRotation=>$view});
+ }elsif($view eq "Top"){
+ $transformer->set({WRotation=>[1,0,0,0]});
+ }elsif($view eq "East"){
+ $transformer->set({WRotation=>[0.5,-0.5,-0.5,-0.5]});
+ }elsif($view eq "South"){
+ $transformer->set({WRotation=>[0.6,-0.6,0,0]});
+ }
+
+}
+
+
+
+1;
diff --git a/Graphics/TriD/TriD/Window.pm b/Graphics/TriD/TriD/Window.pm
new file mode 100644
index 0000000..8c93005
--- /dev/null
+++ b/Graphics/TriD/TriD/Window.pm
@@ -0,0 +1,249 @@
+#
+# The PDL::Graphics::TriD::Window is already partially defined in
+# the appropriate gdriver (GL or VRML) items defined here are common
+# to both
+#
+
+# A function declaration so indirect object method works when defining $ev
+# in new_viewport:
+sub PDL::Graphics::TriD::EventHandler::new;
+
+package PDL::Graphics::TriD::Window;
+use PDL::Graphics::TriD::ViewPort;
+use Data::Dumper;
+use strict;
+
+sub new {
+ my($arg,$options) = @_;
+
+ print "PDL::Graphics::TriD::Window - calling SUPER::new...\n" if($PDL::debug_trid);
+ my $this = $arg->SUPER::new();
+
+ print "PDL::Graphics::TriD::Window - got back $this\n" if($PDL::debug_trid);
+ # Make sure the Graphics has been initialized
+ $options->{width} = 300 unless defined $options->{width};
+ $options->{height} = 300 unless defined $options->{height};
+ $this->{Width} = $options->{width};
+ $this->{Height} = $options->{height};
+
+ print "PDL::Graphics::TriD::Window: calling gdriver....\n" if($PDL::debug_trid);
+ $this->{Interactive} = $this->gdriver($options);
+ print "PDL::Graphics::TriD::Window: gdriver gave back $this->{Interactive}....\n" if($PDL::debug_trid);
+
+ # set default values
+ if($this->{Interactive}){
+ print "\tIt's interactive... calling ev_defaults...\n" if($PDL::debug_trid);
+ $this->{Ev} = $this->ev_defaults();
+ print "\tcalling new_viewport...\n" if($PDL::debug_trid);
+ $this->new_viewport(0,0,$this->{Width},$this->{Height});
+ }else{
+ $this->new_viewport(0,0,1,1);
+ }
+
+ $this->current_viewport(0);
+
+ return($this);
+}
+
+#
+# adds to all viewports
+#
+sub add_object {
+ my($this,$object) = @_;
+# print "add_object ",ref($this),"\n";
+
+ for(@{$this->{_ViewPorts}}) {
+ $_->add_object($object);
+ }
+}
+
+
+
+sub new_viewport {
+ my($this,$x0,$y0,$x1,$y1, $options) = @_;
+ my $vp = new PDL::Graphics::TriD::ViewPort($x0,$y0,$x1,$y1);
+#
+ print "Adding viewport $x0,$y0,$x1,$y1\n" if($PDL::Graphics::TriD::verbose);
+ push @{$this->{_ViewPorts}}, $vp;
+#
+
+ if($this->{Interactive} ){
+ # set a default controller
+ use PDL::Graphics::TriD::ArcBall;
+ use PDL::Graphics::TriD::SimpleScaler;
+ use PDL::Graphics::TriD::Control3D;
+ if (defined($PDL::Graphics::TriD::offline) and $PDL::Graphics::TriD::offline==1 ) {
+ eval "use PDL::Graphics::TriD::VRML";
+ } else {
+ eval "use PDL::Graphics::TriD::GL";
+ }
+
+ my $ev = $options->{EHandler};
+ $ev = new PDL::Graphics::TriD::EventHandler($vp) unless defined($ev);
+ my $cont = $options->{Transformer};
+ $cont = new PDL::Graphics::TriD::SimpleController() unless defined($cont);
+
+ $vp->transformer($cont);
+ if(ref($ev)){
+ $ev->set_button(0,new PDL::Graphics::TriD::ArcCone(
+ $vp, 0,
+ $cont->{WRotation}));
+ $ev->set_button(2,new PDL::Graphics::TriD::SimpleScaler(
+ $vp,
+ \$cont->{CDistance}));
+
+ $vp->eventhandler($ev);
+ }
+ }
+ print "new_viewport: ",ref($vp)," ",$#{$this->{_ViewPorts}},"\n" if($PDL::Graphics::TriD::verbose);
+
+ return $vp;
+}
+
+sub resize_viewport {
+ my($this,$x0,$y0,$x1,$y1,$vpnum) = @_;
+
+ $vpnum = $this->{_CurrentViewPort} unless(defined $vpnum);
+
+ my $vp;
+ if(defined($this->{_ViewPorts}[$vpnum])){
+ $vp = $this->{_ViewPorts}[$vpnum]->resize($x0,$y0,$x1,$y1);
+ }
+ return $vp;
+
+}
+
+sub current_viewport {
+ my($this,$num) = @_;
+
+ if(defined $num){
+ if(ref($num)){
+ my $cnt=0;
+ foreach (@{$this->{_ViewPorts}}){
+ if($num == $_){
+ $this->{_CurrentViewPort} = $cnt;
+ $_->{Active}=1;
+ }elsif(defined $_){
+ $_->{Active}=0;
+ }
+ $cnt++;
+ }
+ }else{
+ if(defined $this->{_ViewPorts}[$num]){
+ $this->{_CurrentViewPort} = $num;
+ $this->{_ViewPorts}[$num]->{Active}=1;
+ }else{
+ print "ERROR: ViewPort $num undefined\n";
+ }
+ }
+ }
+ return $this->{_ViewPorts}[$this->{_CurrentViewPort}];
+}
+
+
+sub viewports {
+ my ($this) = shift;
+ return $this->{_ViewPorts};
+}
+
+sub _vp_num_fromref {
+ my ($this,$vp) = @_;
+
+ if(! defined $vp){
+ $vp = $this->{_CurrentViewPort};
+ }elsif(ref($vp)){
+ my $cnt=0;
+ foreach(@{$this->{_ViewPorts}}){
+ last if($vp == $_);
+ $cnt++;
+ }
+ $vp = $cnt;
+ }
+ return $vp;
+}
+
+
+sub delete_viewport {
+ my($this, $vp) = @_;
+ my $cnt;
+ if(($cnt=$#{$this->{_ViewPorts}})<= 0){
+ print "WARNING: Cannot delete final viewport - request ignored\n";
+ return;
+ }
+ $vp = $this->_vp_num_fromref($vp);
+
+ $this->{_ViewPorts}[$vp]->DESTROY();
+
+ splice(@{$this->{_ViewPorts}},$vp,1);
+
+ if($vp == $cnt){
+ $this->current_viewport($vp-1);
+ }
+}
+
+
+
+
+
+sub clear_viewports {
+ my($this) = @_;
+ foreach(@{$this->{_ViewPorts}}){
+ $_->clear_objects();
+ }
+}
+
+sub clear_viewport {
+ my($this, $vp) = @_;
+ my $cnt;
+
+ $vp = $this->_vp_num_fromref($vp);
+ $this->{_ViewPorts}[$vp]->clear_objects();
+
+}
+
+sub set_eventhandler {
+ my($this,$handler) = @_;
+
+ $this->{EHandler} = $handler;
+
+# for(@{$this->{_ViewPorts}}) {
+# $_->eventhandler($handler);
+# }
+}
+
+#sub set_transformer {
+# my($this,$transformer) = @_;
+#
+# for(@{$this->{_ViewPorts}}) {
+# $_->transformer($transformer);
+# }
+#}
+
+
+sub AUTOLOAD {
+ my ($self, at args)=@_;
+ use vars qw($AUTOLOAD);
+ my $sub = $AUTOLOAD;
+
+# If an unrecognized function is called for window it trys to apply it
+# to all of the defined ViewPorts
+
+ $sub =~ s/.*:://;
+
+ print "AUTOLOAD: $sub at ",__FILE__," line ", __LINE__ ,".\n"
+ if($PDL::Graphics::TriD::verbose);
+
+ print "Window AUTOLOADing '$sub': self=$self, args='".join("','", at args),"'\n" if($PDL::debug_trid);
+
+ if($sub =~ /^gl/ && defined $self->{_GLObject}){
+ return $self->{_GLObject}->$sub(@args);
+ }
+
+
+ for(@{$self->{_ViewPorts}}) {
+ next unless defined $_;
+ $_->$sub(@args);
+ }
+}
+
+1;
diff --git a/Graphics/TriD/VRML/Makefile.PL b/Graphics/TriD/VRML/Makefile.PL
new file mode 100644
index 0000000..582a428
--- /dev/null
+++ b/Graphics/TriD/VRML/Makefile.PL
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => "PDL::Graphics::VRML",
+ 'VERSION_FROM' => '../../../Basic/Core/Version.pm',
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
diff --git a/Graphics/TriD/VRML/VRML.pm b/Graphics/TriD/VRML/VRML.pm
new file mode 100644
index 0000000..2221787
--- /dev/null
+++ b/Graphics/TriD/VRML/VRML.pm
@@ -0,0 +1,346 @@
+# XXXXX print methods need to be changed to
+# reduce memory consumption
+
+###################
+#
+# VRMLProto
+
+package PDL::Graphics::VRMLProto;
+use Exporter;
+use PDL::Core '';
+
+ at ISA = qw/ Exporter /;
+ at EXPORT = qw/ vrp fv3f fmstr /;
+
+sub new {
+ my $type = shift;
+ my ($name,$fields,$node) = @_;
+ my $this = bless {},$type;
+ $this->{Name} = $name;
+ $this->{Fields} = $fields;
+ $this->{Node} = $node;
+ return $this;
+}
+
+sub vrp {
+ return PDL::Graphics::VRMLProto->new(@_);
+}
+
+sub fv3f {
+ my ($name,$def) = @_;
+ return ["field SFVec3f", "$name", "$def"];
+}
+
+sub fmstr {
+ my ($name,$def) = @_;
+ return ["field MFString", "$name", defined $def ? "$def" : "[]"];
+}
+
+sub to_text {
+ my $this = shift;
+ my $text = "PROTO $this->{Name} [\n";
+ for (@{$this->{Fields}}) {
+ $text .= " $_->[0] $_->[1]\t$_->[2]\n";
+ }
+ $text .= "]\n{\n";
+ $text .= $this->{Node}->to_text;
+ return $text . "}\n";
+}
+
+#####################
+#
+# VRMLNode
+
+package PDL::Graphics::VRMLNode;
+use Exporter;
+
+ at ISA = qw/ Exporter /;
+ at EXPORT = qw/ vrn vrml3v /;
+ at EXPORT_OK = qw/ tabs postfix prefix /;
+
+sub vrn {
+ return PDL::Graphics::VRMLNode->new(@_);
+}
+
+sub new {
+ my $type = shift;
+ my $title = shift;
+ my $this = bless {},$type;
+ $this->{'Container'} = {};
+ $this->{'Title'} = $title;
+ $this->add(@_);
+ return $this;
+}
+
+sub add {
+ my ($this,%items) = @_;
+ for (keys %items) {
+ $this->{Container}{$_} = $items{$_};
+ }
+ return $this;
+}
+
+sub add_children {
+ my ($this) = shift;
+ for(@_) {
+ push @{$this->{Container}{children}}, $_;
+ }
+}
+
+sub to_text {
+ my $this = shift;
+ my $level = $#_ > -1 ? shift : 1;
+ my $text = $this->prefix($level);
+ my($k,$v);
+ while (($k,$v) = each %{$this->{Container}}) {
+ $text .= tabs($level) . "$k".
+ (ref $v ?
+ ref $v eq "ARRAY" ?
+ $this->array_out($v,$level+1) :
+ (" ".$v->to_text($level+1)) :
+ "\t$v\n");
+ }
+ return $text.$this->postfix($level);
+}
+
+sub array_out {
+ my ($this,$array,$level) = @_;
+ my $text = " [\n";
+ for (@$array) {
+ $text .= tabs($level) . (ref $_ ?
+ $_->to_text($level+1) : "$_,\n")
+ }
+ $text .= tabs($level-1) . "]\n";
+ return $text;
+}
+
+sub prefix {
+ return $_[0]->{Title}." {\n";
+}
+
+sub postfix {
+ return "\t"x($_[1]-1)."}\n";
+}
+
+sub tabs {
+ return "\t"x$_[0];
+}
+
+sub vrml3v {
+ my $list = shift;
+ return sprintf '%.3f %.3f %.3f', @{$list}[0..2];
+}
+
+#################
+#
+# VRMLPdlNode
+
+package PDL::Graphics::VRMLPdlNode;
+ at ISA = qw/ PDL::Graphics::VRMLNode /;
+use PDL::Lite;
+use PDL::Core qw(barf);
+use PDL::Dbg;
+PDL::Graphics::VRMLNode->import(qw/tabs vrml3v postfix prefix/);
+
+sub new {
+ my ($type,$points,$colors,$options) = @_;
+ my $this = bless {},$type;
+ $this->{'Points'} = $points;
+ $this->{'Colors'} = $colors;
+ $this->checkoptions($options);
+ return $this;
+}
+
+sub checkoptions {
+ my ($this,$options) = @_;
+ my $aopts = $this->getvopts();
+ for (keys %$aopts) {
+ if (!defined $options->{$_}) {
+ $this->{$_} = $aopts->{$_};
+ } else {
+ $this->{$_} = delete $options->{$_};
+ }
+ }
+
+ if (keys %$options) {
+ barf "Invalid options left: ".(join ',',%$options);
+ }
+}
+
+sub getvopts {
+ my ($this) = @_;
+ return {Title => 'PointSet',
+ PerVertex => 0,
+ Lighting => 0,
+ Surface => 0,
+ Lines => 1,
+ Smooth => 0,
+ IsLattice => 0,
+ DefColors => 0};
+}
+
+sub to_text {
+ my $this = shift;
+ my $level = $#_ > -1 ? shift : 1;
+ my $text = $this->prefix($level);
+ my ($vtxt,$vidx,$ctxt,$extra,$useidx) = ("","","","",0);
+ if ($this->{Title} eq 'PointSet') {
+ coords($this->{Points},$this->{Colors},\$vtxt,\$ctxt,tabs($level+2));
+ } elsif ($this->{Title} eq 'IndexedLineSet') {
+ my @dims = $this->{Points}->dims;
+ shift @dims;
+ my $cols = $this->{Colors};
+ my $seq = PDL->sequence(@dims);
+ require PDL::Dbg;
+ local $PDL::debug = 0;
+ $cols = pdl(0,0,0)->dummy(1)->dummy(2)->px
+ if $this->{IsLattice} && $this->{Surface} && $this->{Lines};
+ lines($this->{Points},$cols,$seq,
+ \$vtxt,\$ctxt,\$vidx,tabs($level+1));
+ lines($this->{Points}->xchg(1,2),$cols->xchg(1,2),
+ $seq->xchg(0,1),undef,\$ctxt,\$vidx,
+ tabs($level+1)) if $this->{IsLattice};
+ $useidx = 1;
+ } elsif ($this->{Title} eq 'IndexedFaceSet') {
+ my @dims = $this->{Points}->dims;
+ shift @dims;
+ my @sls1 = ("0:-2,0:-2",
+ "1:-1,0:-2",
+ "0:-2,1:-1");
+ my @sls2 = ("1:-1,1:-1",
+ "0:-2,1:-1",
+ "1:-1,0:-2"
+ );
+ my $seq = PDL->sequence(@dims);
+ coords($this->{Points},$this->{Colors},\$vtxt,\$ctxt,tabs($level+2));
+ triangles((map {$seq->slice($_)} @sls1),\$vidx,tabs($level+1));
+ triangles((map {$seq->slice($_)} @sls2),\$vidx,tabs($level+1));
+ $useidx = 1;
+ $extra = tabs($level)."colorPerVertex\tTRUE\n".
+ tabs($level)."solid\tFALSE\n";
+ $extra .= tabs($level)."creaseAngle\t3.14\n" if $this->{Smooth};
+ }
+ $text .= vprefix('coord',$level).$vtxt.vpostfix('coord',$level);
+ $text .= vprefix('index',$level).$vidx.vpostfix('index',$level)
+ if $useidx;
+ $text .= vprefix('color',$level).$ctxt.vpostfix('color',$level)
+ unless $this->{DefColors};
+ return $text.$extra.$this->postfix($level);
+}
+
+sub vprefix {
+ my ($type,$level) = @_;
+ return tabs($level) . "coord Coordinate {\n" . tabs($level+1) .
+ "point [\n" if $type eq 'coord';
+ return tabs($level) . "color Color {\n" . tabs($level+1) .
+ "color [\n" if $type eq 'color';
+ return tabs($level) . "coordIndex [\n" if $type eq 'index';
+}
+
+sub vpostfix {
+ my ($type,$level) = @_;
+ return tabs($level+1)."]\n".tabs($level)."}\n" unless $type eq 'index';
+ return tabs($level)."]\n";
+}
+
+PDL::thread_define 'coords(vertices(n=3); colors(n)) NOtherPars => 3',
+ PDL::over {
+ ${$_[2]} .= $_[4] . sprintf("%.3f %.3f %.3f,\n",$_[0]->list);
+ ${$_[3]} .= $_[4] . sprintf("%.3f %.3f %.3f,\n",$_[1]->list);
+};
+
+PDL::thread_define 'v3array(vecs(n=3)) NOtherPars => 2',
+ PDL::over {
+ ${$_[1]} .= $_[2] . sprintf("%.3f %.3f %.3f,\n",$_[0]->list);
+};
+
+PDL::thread_define 'lines(vertices(n=3,m); colors(n,m); index(m))'.
+ 'NOtherPars => 4',
+ PDL::over {
+ my ($lines,$cols,$index,$vt,$ct,$it,$sp) = @_;
+ v3array($lines,$vt,$sp."\t") if defined $vt;
+ v3array($cols,$ct,$sp."\t") if defined $ct;
+ $$it .= $sp.join(',',$index->list).",-1,\n" if defined $it;
+};
+
+PDL::thread_define 'triangles(inda();indb();indc()), NOtherPars => 2',
+ PDL::over {
+ ${$_[3]} .= $_[4].join(',',map {$_->at} @_[0..2]).",-1,\n";
+};
+
+#####################
+#
+# VRML
+
+package PDL::Graphics::VRML;
+use PDL::Core '';
+
+%PDL::Graphics::VRML::Protos = ();
+
+sub new {
+ my ($type,$title,$info) = @_;
+ my $this = bless {},$type;
+ $this->{Header} = '#VRML V2.0 utf8';
+ $this->{Info} = new PDL::Graphics::VRMLNode('WorldInfo',
+ 'title' => $title,
+ 'info' => $info);
+ $this->{NaviInfo} = new PDL::Graphics::VRMLNode('NavigationInfo',
+ 'type' => '["EXAMINE", "ANY"]');
+ $this->{Protos} = {};
+ $this->{Uses} = {};
+ $this->{Scene} = undef;
+ return $this;
+}
+
+sub register_proto {
+ my ($this, at protos) = @_;
+ for (@protos) {
+ barf "proto already registered"
+ if defined $PDL::Graphics::VRML::Protos{$_->{Name}};
+ $PDL::Graphics::VRML::Protos{$_->{Name}} = $_;
+ }
+}
+
+sub set_vrml {
+ print "set_vrml ",ref($_[0]),"\n";
+
+ $_[0]->{Scene} = $_[1];
+}
+
+sub uses {
+ $_[0]->{Uses}->{$_[1]} = 1;
+}
+
+sub ensure_protos {
+ my $this = shift;
+ for (keys %{$this->{Uses}}) {
+ barf "unknown Prototype $_" unless defined $PDL::Graphics::VRML::Protos{$_};
+ delete $this->{Uses}->{$_};
+ $this->add_proto($PDL::Graphics::VRML::Protos{$_});
+ }
+}
+
+sub add_proto {
+ my ($this,$proto) = @_;
+ $this->{Protos}->{$proto->{Name}} = $proto
+ unless exists $this->{Protos}->{$proto->{Name}};
+ return $this;
+}
+
+sub print {
+ my $this = shift;
+ if ($#_ > -1) {
+ my $file = ($_[0] =~ /^\s*[|>]/ ? '' : '>') .$_[0];
+ open VRML,"$file" or barf "can't open $file";
+ } else { *VRML = *STDOUT }
+ print VRML "$this->{Header}\n";
+ print VRML $this->{Info}->to_text;
+ print VRML $this->{NaviInfo}->to_text;
+ for (keys %{$this->{Protos}}) { print VRML $this->{Protos}->{$_}->to_text }
+ barf "no scene hierarchy" unless defined $this->{Scene};
+ print VRML $this->{Scene}->to_text;
+ close VRML if $#_ > -1;
+}
+
+
+1;
diff --git a/Graphics/TriD/VRML/VRML/Protos.pm b/Graphics/TriD/VRML/VRML/Protos.pm
new file mode 100644
index 0000000..fb84d26
--- /dev/null
+++ b/Graphics/TriD/VRML/VRML/Protos.pm
@@ -0,0 +1,55 @@
+
+package PDL::Graphics::VRML::Protos;
+PDL::Graphics::VRMLNode->import();
+PDL::Graphics::VRMLProto->import();
+
+sub PDLBlockText10 {
+ vrp('PDLBlockText10',
+ [fv3f('position',"0 0 0"),
+ fv3f('size',"1 1 0.1"),
+ fmstr('text','["TESTING PDL","TEXTBLOCK","LONG LONG LONG LONG LONG TEXT","Short","FOOOOOOOOOOOOOOOO"]')],
+ vrn('Transform',
+ 'translation' => 'IS position',
+ 'scale' => 'IS size',
+ 'children' => [
+ vrn(Transform,
+ translation => '0 0 -0.55',
+ 'children' => [vrn('Shape',
+ geometry => vrn('Box', size => '1 1 0.45'),
+ appearance => vrn(Appearance,
+ material => vrn(Material,
+ diffuseColor => '0.9 0.9 0.9',
+ ambientIntensity => '0.1'
+ )
+ )
+ )]
+ ),
+ vrn(Transform,
+ translation => '-0.45 0.35 0',
+ scale => '0.9 0.9 0',
+ children => [
+ vrn(Shape,
+ geometry => vrn(Text,
+ string => 'IS text',
+ maxExtent => '1.0',
+ fontStyle =>
+ vrn(FontStyle,
+ size => '0.075',
+ spacing => '1.33',
+ justify => 'end'
+ ),
+ ),
+ appearance => vrn(Appearance,
+ material => vrn(Material,
+ diffuseColor => '0 0 0',
+ ambientIntensity => '0'
+ )
+ )
+ )
+ ])
+ ]
+ )
+ );
+}
+
+1;
diff --git a/INSTALL b/INSTALL
new file mode 100644
index 0000000..92f0460
--- /dev/null
+++ b/INSTALL
@@ -0,0 +1,217 @@
+HINT
+----
+For the latest install and per-platform guidance on
+how to get and install PDL, see the Install PDL page at:
+http://pdl.perl.org/?page=install
+
+
+
+INSTALLATION
+------------
+To install PDL on your machine, first check that you
+have a recent enough version of Perl. 5.8.x and above
+is required.
+
+See win32/INSTALL for details on installing PDL on
+windows platforms.
+
+See cygwin/INSTALL for details on installing PDL on
+cygwin platforms.
+
+The file DEPENDENCIES summarizes the dependencies of
+various PDL modules on libraries/other packages. The
+location of some of these files needs to be specified
+in the file perldl.conf.
+
+PDL depends on a number of other Perl modules for
+feature complete operation. These modules are generally
+available at the CPAN. The easiest way to resolve these
+dependencies is to use the CPAN module to install PDL.
+Installation should be as simple as
+
+ cpan install PDL # if the cpan script is in your path
+
+or if you don't have the cpan script try
+
+ perl -MCPAN -e shell
+ cpan> install PDL
+
+NOTE: if this is your first time running the cpan shell,
+you'll be prompted to configure the running environment.
+
+IMPORTANT: Be sure your cpan build_dir location does not have
+white space in the name. To check or change the setting, start
+the cpan shell as above, then to check:
+
+ cpan> o conf build_dir
+ build_dir [/your/build dir/.cpan]
+ Type 'o conf' to view all configuration items
+
+And to change to something better:
+
+ cpan> o conf build_dir '/your/build_dir/.cpan'
+ build_dir [/your/build_dir/.cpan]
+ Please use 'o conf commit' to make the config permanent!
+
+
+
+perldl.conf
+-----------
+Edit the file perldl.conf in the PDL source directory
+to specify configuration options for building PDL. The
+comments in this file specify what the options are and
+give examples.
+
+NOTE: If you are happy with your perldl.conf you can
+keep the file handy for future reference. Place it in
+~/.perldl.conf where it will be picked up automatically
+or use this command
+
+ perl Makefile.PL PDLCONF=your_conf_file
+
+the next time you configure PDL. (You should check if
+new config flags were introduced when installing a new
+version of PDL by consulting its perldl.conf.)
+
+After editing the configuration options just say
+
+ perl Makefile.PL
+
+in the directory this file is in. (See 'perldoc ExtUtils::MakeMaker'
+for info on how to configure the installation location, etc.)
+and if that seems ok, try:
+
+ make
+
+If there are any strange error messages, please contact
+the developers with a full bug report; response is
+often rapid (We would like to have PDL work right out
+of the box on as many platforms as possible).
+
+If the make command completed successfully, try:
+
+ make test
+
+to run the regression tests. If you have issues,
+please read Known_problems to see if they have been
+seen before. Again, if there are
+errors, please contact the developers (via the
+pdl-porters mailing list, see Basic/Pod/FAQ.pod).
+
+If everything works and you wish to install PDL, type
+
+ make install
+
+There is also another make item:
+
+ make doctest
+
+which creates the documentation database for use
+in the PDL shell (pdl2 or perldl). It will be run
+automatically on PDL install, but you may wish to
+run it by hand to have access to PDL on-line docs
+when running from the build directory before/without
+install.
+
+
+
+F77 Configuration
+-----------------
+F77 configuration information is normally picked up
+from ExtUtils::F77 to build modules like PDL::Slatec
+that rely on a working fortran compiler.
+
+In cases where you don't want to rely on ExtUtils::F77
+for one reason or another (e.g., a win32 build or other
+platform without ExtUtils::F77 support) there is now
+the config variable F77CONF. It is supposed to point
+to a perl file that implements a minimal F77Conf class
+(see debian/f77conf.pl for an example). The use of
+F77CONF is similar to the PDLCONF variable, e.g.
+
+ perl Makefile.PL F77CONF=debian/f77conf.pl
+
+Note that almost always it is better to use ExtUtils::F77.
+Only use the F77CONF mechanism if you have a good reason to.
+Win32 is special. See win32/INSTALL.
+
+
+
+COMMON PROBLEMS
+---------------
+If you have problems building or installing PDL, we
+suggest contacting the PDL users and developers via
+the PDL mailing lists. See
+
+ http://pdl.perl.org/?page=mailing-lists
+
+to get started. Links to searchable archives of the lists
+are available on the same page.
+
+The build process has been significantly cleaned up
+since PDL-2.4.3. If you are unable to install PDL,
+even after consulting the list archives or other users
+and developers on the PDL lists, please do submit
+a bug report (see the BUGS file for directions).
+
+* Test failures in t/gis_proj.t, t/proj_transform.t, or
+ t/proj_transform2.t with error messages that look like
+ this (in the body of the test output, not the summary):
+
+ ...
+ not found
+ _fwd_trans_inplace[BADCODE](): Projection initialization
+ failed: major axis or radius = 0 or not given
+ ...
+
+ This indicates that the PROJ4 library on the system is
+ either missing or cannot find the transformation parameter
+ files. They are typically in a directory like
+ /usr/share/proj and contain files with names like:
+ epsg, nad27, nad83, conus,...
+
+ If you find such a directory, try setting the PROJ_LIB
+ environment variable to that location.
+
+ If you do not have that directory, you may need to use
+ your platform's package manager to install the missing
+ component. E.g.:
+
+ - Ubuntu: These are included in the libproj-dev.
+ - Fedora: You have to install the proj-nad package.
+
+* make failures for PDL with error messages like:
+
+ make: Warning: File `Makefile.PL' has modification
+ time 3.1e+05 s in the future
+ Makefile out-of-date with respect to Makefile.PL
+
+ This problem has been seen on some Linux Virtual Machines
+ where there was a problem with the synchronization of the
+ VM time with the host OS system time. A quick work-
+ around for the problem is to 'touch Makefile.PL' which
+ updates the file time for Makefile.PL to "now" so make
+ runs correctly.
+
+* If you wish to avoid interactive prompts during the PDL
+ configure process (e.g., the perl Makefile.PL stage),
+ you can set the environment variable PERL_MM_USE_DEFAULT
+ to 1 so the default values are taken automatically.
+
+* For some versions of MinGW gcc (on win32 perl platforms),
+ gcc crashes during the build of Primitive.o (or Ufunc.o).
+ The problem appears to be related to the -O3 optimize
+ option. If you edit the Makefile created in the affected
+ code directory to change '-O3' to '-g3' that should allow
+ the build to complete successfully. E.g.:
+
+ cd PDL-2.4.11 # or whatever the build dir is
+ perl Makefile.PL # configure the build
+ make
+ # ... gcc dies building Primitive.o ...
+ cd Basic/Primitive
+ vi Makefile # change -O3 to -g3 w favorite editor
+ cd ../..
+ make
+ # ... gcc should now succeed in building Primitive.o ...
+
diff --git a/INTERNATIONALIZATION b/INTERNATIONALIZATION
new file mode 100644
index 0000000..4a0569f
--- /dev/null
+++ b/INTERNATIONALIZATION
@@ -0,0 +1,11 @@
+TODO
+
+PDL currently does not have internationalization support for
+its error messages although perl itself does support i18n
+and locales. Some of the tests for names and strings are
+specific to ASCII and English. Please report any issues
+regarding internationalization to the perldl mailing lists.
+
+Of course, volunteers to implement this or help with the
+translations would be welcome. We need to see how other
+perl modules handle this.
diff --git a/IO/Browser/Makefile.PL b/IO/Browser/Makefile.PL
new file mode 100644
index 0000000..796eff5
--- /dev/null
+++ b/IO/Browser/Makefile.PL
@@ -0,0 +1,72 @@
+
+# Makefile.PL for PDL::IO module.
+#
+# - check for win32 systems is now done in ../Makefile.PL
+local $| = 1;
+
+use ExtUtils::MakeMaker;
+use File::Spec;
+
+my $libdir;
+
+BEGIN {
+ if (defined $PDL::Config{PDL_BUILD_DIR}) {
+ print STDERR "IO/Browser: got root build dir $PDL::Config{PDL_BUILD_DIR}\n";
+ $libdir = File::Spec->catfile($PDL::Config{PDL_BUILD_DIR},'inc');
+ print STDERR "IO/Browser: adding $libdir\n";
+ }
+}
+
+use lib $libdir;
+
+use Devel::CheckLib;
+
+require PDL::Core::Dev;
+PDL::Core::Dev->import();
+
+ at pack = (["browser.pd",Browser,PDL::IO::Browser]);
+
+%hash = pdlpp_stdargs_int(@::pack);
+
+$hash{'OBJECT'} .= ' browse$(OBJ_EXT)';
+$hash{'clean'}{FILES} .= ' browse$(OBJ_EXT) browse$(EXE_EXT) Browser.c Browser.pm Browser.xs Browser$(OBJ_EXT)';
+
+# Here we check for working curses/ncurses
+# and the corresponding "curses.h" and "ncurses/curses.h"
+#
+# (1) Determine which library we have: curses or ncurses
+# (2) determine which include path
+# (3) determine which include file
+# (4) confirm configuration
+# (5) write Makefile or dummy as appropriate
+
+my $incstring;
+foreach my $incl ( qw( curses.h ncurses/curses.h ncurses.h ncurses/ncurses.h ) ) {
+ if (check_lib(header=>$incl)) {
+ print STDERR "IO/Browser: have '$incl'\n";
+ $incstring = $incl;
+ last;
+ }
+};
+$hash{DEFINE} .= ' -DCURSES=' . '\\"' . $incstring . '\\"' if defined $incstring;
+
+my $libstring;
+foreach my $libr ( qw( curses ncurses ) ) {
+ if (check_lib(lib=>$libr)) {
+ print STDERR "IO/Browser: have -l$libr\n";
+ $libstring = '-l' . $libr;
+ last;
+ }
+}
+push @{$hash{LIBS}} , $libstring if defined $libstring;
+
+if (defined($incstring) && defined($libstring)) {
+ WriteMakefile(%hash);
+} else {
+ write_dummy_make("Curses capable library not found, not building PDL::IO::Browser");
+}
+
+# Add genpp rule
+sub MY::postamble { pdlpp_postamble_int(@::pack); }
+
+
diff --git a/IO/Browser/browse.c b/IO/Browser/browse.c
new file mode 100644
index 0000000..35ab7e9
--- /dev/null
+++ b/IO/Browser/browse.c
@@ -0,0 +1,408 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+#ifdef bool
+#undef bool
+#endif
+
+#ifdef CURSES
+#define CURSES_INC CURSES
+#else
+#define CURSES_INC "ncurses/curses.h"
+#endif
+
+#include CURSES_INC
+
+#include <string.h>
+
+#include "EXTERN.h"
+// #include "perl.h"
+// #include "XSUB.h"
+
+#include "pdl.h"
+
+#define CHBUF 256
+#ifndef MIN
+#define MIN(a,b) ((a)<(b)?(a):(b))
+#endif
+
+#define HLAB 4
+
+static int colwid, dcols, drows;
+
+/* enum pdl_datatypes { PDL_B, PDL_S, PDL_US, PDL_L, PDL_LL, PDL_F, PDL_D }; */
+char *format[] = { "%3d", "%6d", "%6hd", "%11ld", "%11lld", "%10.4g", "%11.4g" };
+int width[] = { 4, 7, 7, 12, 12, 11, 12 };
+
+char *str_value(int x, int y,
+ int type, int nx, void *data, char *str)
+{
+ switch (type) {
+ case PDL_B:
+ sprintf(str,format[type],*(((char *)data)+y*nx+x));
+ break;
+ case PDL_S:
+ sprintf(str,format[type],*(((short *)data)+y*nx+x));
+ break;
+ case PDL_US:
+ sprintf(str,format[type],*(((unsigned short *)data)+y*nx+x));
+ break;
+ case PDL_L:
+ sprintf(str,format[type],*(((int *)data)+y*nx+x));
+ break;
+ case PDL_LL:
+ sprintf(str,format[type],*(((long long *)data)+y*nx+x));
+ break;
+ case PDL_F:
+ sprintf(str,format[type],*(((float *)data)+y*nx+x));
+ break;
+ case PDL_D:
+ sprintf(str,format[type],*(((double *)data)+y*nx+x));
+ break;
+ default:
+ Perl_croak("type (val=%d) not implemented",type);
+ break;
+ }
+ return str;
+}
+
+void set_value(int x, int y,
+ int type, int nx, void *data, char *str)
+{
+ switch (type) {
+ case PDL_B:
+ *(((PDL_Byte *)data)+y*nx+x) = atol(str);
+ break;
+ case PDL_S:
+ *(((PDL_Short *)data)+y*nx+x) = atol(str);
+ break;
+ case PDL_US:
+ *(((PDL_Ushort *)data)+y*nx+x) = atol(str);
+ break;
+ case PDL_L:
+ *(((PDL_Long *)data)+y*nx+x) = atol(str);
+ break;
+ case PDL_LL:
+ *(((PDL_LongLong *)data)+y*nx+x) = atol(str);
+ break;
+ case PDL_F:
+ *(((PDL_Float *)data)+y*nx+x) = atof(str);
+ break;
+ case PDL_D:
+ *(((PDL_Double *)data)+y*nx+x) = atof(str);
+ break;
+ default:
+ Perl_croak("type (val=%d) not implemented",type);
+ break;
+ }
+ return;
+}
+
+void update_vlab(WINDOW *win, int x, int ioff)
+{
+ char line[BUFSIZ];
+ int len, k, d;
+ chtype chline[BUFSIZ];
+ extern int colwid;
+
+ for (k=0;k<colwid;k++)
+ chline[k] = ' ';
+
+ sprintf(line,"%d",ioff+x);
+ len = strlen(line);
+ d = (colwid-len)/2;
+ for (k=0;k<len;k++)
+ chline[k+d] = line[k] | A_BOLD;
+ chline[colwid-1] = '|' | A_BOLD;
+ chline[colwid] = 0;
+
+ mvwaddchnstr(win,0,x*colwid,chline,colwid);
+}
+void update_hlab(WINDOW *win, int y, int joff)
+{
+ char line[BUFSIZ];
+ int len, k, d;
+ chtype chline[BUFSIZ];
+
+ for (k=0;k<HLAB;k++)
+ chline[k] = ' ';
+
+ sprintf(line,"%-4d",joff+y);
+ len = strlen(line);
+ d = (HLAB-len)/2;
+
+ for (k=0;k<len;k++)
+ chline[k+d] = line[k] | A_BOLD;
+ chline[HLAB] = 0;
+ mvwaddchnstr(win,y,0,chline,HLAB);
+}
+void clear_cell(WINDOW *win, int i, int j)
+{
+ char line[BUFSIZ];
+ int len, k, d;
+ chtype chline[BUFSIZ];
+ extern int colwid;
+
+ for (k=0;k<colwid-1;k++)
+ chline[k] = ' ';
+ chline[colwid-1] = '|' | A_BOLD;
+ chline[colwid] = '\0';
+ mvwaddchnstr(win,j,i*colwid,chline,colwid);
+}
+void set_cell(WINDOW *win, int i, int j, int ioff, int joff,
+ int type, int nx, void *data)
+{
+ char line[BUFSIZ];
+ int len, k, d;
+ chtype chline[BUFSIZ];
+ extern int colwid;
+
+ for (k=0;k<colwid-1;k++)
+ chline[k] = ' ';
+ str_value(i,j,type,nx,data,line);
+ len = strlen(line);
+ for (k=0;k<len;k++)
+ chline[k] = line[k];
+ chline[len] = ' ';
+ chline[colwid-1] = '|' | A_BOLD;
+ chline[colwid] = '\0';
+ mvwaddchnstr(win,j-joff,(i-ioff)*colwid,chline,colwid);
+}
+
+void update_row(WINDOW *win, int y, int ioff, int joff,
+ int type, int nx, void *data)
+{
+ char line[BUFSIZ];
+ int len, k, d, i;
+ chtype chline[BUFSIZ];
+ extern int colwid, dcols;
+
+ for (i=0;i<dcols;i++) {
+ for (k=0;k<colwid-1;k++)
+ chline[k] = ' ';
+ str_value(i+ioff,y+joff,type,nx,data,line);
+ len = strlen(line);
+ for (k=0;k<len;k++)
+ chline[k] = line[k];
+ chline[len] = ' ';
+ chline[colwid-1] = '|' | A_BOLD;
+ chline[colwid] = '\0';
+ mvwaddchnstr(win,y,i*colwid,chline,colwid);
+ }
+}
+void update_col(WINDOW *win, int x, int ioff, int joff,
+ int type, int nx, void *data)
+{
+ char line[BUFSIZ];
+ int len, k, d, j;
+ chtype chline[BUFSIZ];
+ extern int colwid, drows;
+
+ for (j=0;j<drows;j++) {
+ for (k=0;k<colwid-1;k++)
+ chline[k] = ' ';
+ str_value(x+ioff,j+joff,type,nx,data,line);
+ len = strlen(line);
+ for (k=0;k<len;k++)
+ chline[k] = line[k];
+ chline[len] = ' ';
+ chline[colwid-1] = '|' | A_BOLD;
+ chline[colwid] = '\0';
+ mvwaddchnstr(win,j,x*colwid,chline,colwid);
+ }
+}
+
+
+
+void browse(int type, int nc, int nr, void *in)
+{
+ WINDOW *pdlscr, *wmenu, *wscroll, *warray, *whlab, *wvlab, *wtmp;
+ char s[CHBUF],echobuf[CHBUF],line[CHBUF];
+ chtype ch;
+ int i,j,eps,ioff,joff,iecho;
+ int ncols, nrows, mycols;
+ extern int colwid, dcols, drows, width[];
+
+ pdlscr = initscr(); /* sets LINES, COLS (which aren't macro constants...) */
+ clear(); /* Clear the screen before we start drawing */
+
+ colwid = width[type];
+ ncols = (COLS-HLAB)/colwid;
+ dcols = MIN(nc,ncols);
+ mycols = dcols*colwid;
+
+ nrows = LINES-3;
+ drows = MIN(nr,nrows);
+
+ cbreak();
+ noecho();
+ nonl();
+ intrflush(pdlscr,FALSE);
+ keypad(pdlscr,TRUE);
+ /* Menu bar */
+ wmenu = subwin(pdlscr,1,COLS,0,0);
+ wvlab = subwin(pdlscr,1,mycols,1,HLAB);
+ wscroll= subwin(pdlscr,drows,mycols+HLAB,2,0);
+ warray = subwin(wscroll,drows,mycols,2,HLAB);
+ whlab = subwin(wscroll,drows,HLAB,2,0);
+
+ keypad(warray,TRUE);
+ scrollok(pdlscr,TRUE);
+ scrollok(wscroll,TRUE);
+
+ wmenu = subwin(pdlscr,1,COLS,0,0);
+
+ sprintf(s,"Perldl data browser: type %d, (%d,%d), type q to quit\n",
+ type,nc,nr);
+ mvwaddstr(wmenu,0,10,s);
+ wrefresh(wmenu);
+
+ for (i=0;i<dcols;i++) {
+ update_vlab(wvlab,i,0);
+ }
+ wrefresh(wvlab);
+
+ for (j=0;j<drows;j++) {
+ update_hlab(whlab,j,0);
+ }
+ wrefresh(whlab);
+
+ for (j=0;j<drows;j++) {
+ update_row(warray,j,0,0,type,nc,in);
+ }
+
+ i = j = eps = 0;
+ ioff = joff = 0;
+ while (tolower(ch=mvwgetch(warray,j-joff,(i-ioff)*colwid+
+ MIN(eps,colwid-2))) != 'q') {
+ /* #define ECHOCH */
+#ifdef ECHOCH
+ sprintf(echobuf,"%8o",ch);
+ mvwaddstr(wmenu,0,iecho,echobuf);
+ iecho = (iecho < 72) ? iecho+8 :0;
+ wrefresh(wmenu);
+#endif
+ switch (ch) {
+ case KEY_LEFT:
+ case KEY_RIGHT:
+ case KEY_UP:
+ case KEY_DOWN:
+ case '\t':
+ case '\015':
+ if (eps) {
+ line[eps] = '\0';
+ set_value(i,j,type,nc,in,line);
+ }
+ set_cell(warray,i,j,ioff,joff,type,nc,in);
+ eps = 0;
+ wrefresh(warray);
+ break;
+ case '\b':
+ case KEY_DL:
+ case 0177:
+ if (eps) {
+ eps--;
+ mvwaddch(warray,j-joff,(i-ioff)*colwid+MIN(eps,colwid-2),' ');
+ wrefresh(warray);
+ }
+ continue;
+ default:
+ if (!eps && ch >= 32 && ch <= 127) {
+ clear_cell(warray,i-ioff,j-joff);
+ wrefresh(warray);
+ }
+ mvwaddch(warray,j-joff,(i-ioff)*colwid+MIN(eps,colwid-2),ch|A_UNDERLINE);
+ line[eps++]=ch;
+ continue;
+ }
+
+ switch (ch) {
+ case KEY_LEFT:
+ i = (i<2)?0:i-1;
+ if (i-ioff == -1) {
+ ioff--;
+ wtmp = newwin(1,mycols-colwid,1,HLAB);
+ overwrite(wvlab,wtmp);
+ mvwin(wtmp,1,HLAB+colwid);
+ overwrite(wtmp,wvlab);
+ delwin(wtmp);
+ update_vlab(wvlab,0,ioff);
+ wtmp = newwin(drows,mycols-colwid,2,HLAB);
+ overwrite(warray,wtmp);
+ mvwin(wtmp,2,HLAB+colwid);
+ overwrite(wtmp,warray);
+ delwin(wtmp);
+ update_col(warray,0,ioff,joff,type,nc,in);
+ wrefresh(warray);
+ wrefresh(wvlab);
+ }
+ break;
+ case KEY_RIGHT:
+ case '\t':
+ i = (i>nc-2)?nc-1:i+1;
+ if (i-ioff == dcols) {
+ ioff++;
+ wtmp = newwin(1,mycols-colwid,1,HLAB+colwid);
+ overwrite(wvlab,wtmp);
+ mvwin(wtmp,1,HLAB);
+ overwrite(wtmp,wvlab);
+ delwin(wtmp);
+ update_vlab(wvlab,dcols-1,ioff);
+ wtmp = newwin(drows,mycols-colwid,2,HLAB+colwid);
+ overwrite(warray,wtmp);
+ mvwin(wtmp,2,HLAB);
+ overwrite(wtmp,warray);
+ delwin(wtmp);
+ update_col(warray,dcols-1,ioff,joff,type,nc,in);
+ wrefresh(warray);
+ wrefresh(wvlab);
+ }
+ break;
+ case KEY_UP:
+ j = (j<2)?0:j-1;
+ if (j-joff == -1) {
+ joff--;
+ wscrl(wscroll,-1);
+ wrefresh(wscroll);
+ update_hlab(whlab,0,joff);
+ wrefresh(whlab);
+ update_row(warray,0,ioff,joff,type,nc,in);
+ wrefresh(warray);
+ }
+ break;
+ case KEY_DOWN:
+ case '\015':
+ j = (j>nr-2)?nr-1:j+1;
+ if (j-joff == drows) {
+ joff++;
+ wscrl(wscroll,1);
+ wrefresh(wscroll);
+ update_hlab(whlab,drows-1,joff);
+ wrefresh(whlab);
+ update_row(warray,drows-1,ioff,joff,type,nc,in);
+ wrefresh(warray);
+ }
+ break;
+ }
+ }
+ nl();
+ echo();
+ nocbreak();
+ endwin();
+}
+
+#ifdef WITH_IO_BROWSER_MAIN
+main ()
+{
+ double b[27*15];
+
+ int i, j;
+
+ j = 0;
+ for (i=0; i<27*15; i++) {
+ b[i] = j++;
+ }
+
+ browse(PDL_D, 27, 15, &b);
+}
+#endif
diff --git a/IO/Browser/browser.pd b/IO/Browser/browser.pd
new file mode 100644
index 0000000..10229d6
--- /dev/null
+++ b/IO/Browser/browser.pd
@@ -0,0 +1,66 @@
+pp_addpm({At=>Top},<<'EOD');
+
+=head1 NAME
+
+PDL::IO::Browser -- 2D data browser for PDL
+
+=head1 DESCRIPTION
+
+cursor terminal browser for piddles.
+
+=head1 SYNOPSIS
+
+ use PDL::IO::Browser;
+
+=cut
+
+
+EOD
+
+use PDL::Types;
+
+pp_def(
+ 'browse',
+ Pars => 'a(n,m);',
+ Code => "
+ browse(\$TBSULQFD($PDL_B,$PDL_S,$PDL_US,$PDL_L,$PDL_LL,$PDL_F,$PDL_D),
+ \$SIZE(n),\$SIZE(m),\$P(a));
+ ",
+Doc=><<'EOD');
+=head2 browse
+
+=for ref
+
+browse a 2D array using terminal cursor keys
+
+=for usage
+
+ browse $data
+
+This uses the CURSES library to allow one to scroll
+around a PDL array using the cursor keys.
+
+
+
+=cut
+
+
+EOD
+pp_addpm({At=>Bot},<<'EOD');
+
+=head1 AUTHOR
+
+Copyright (C) Robin Williams 1997 (rjrw at ast.leeds.ac.uk).
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/IO/Browser/hints/dec_osf.pl b/IO/Browser/hints/dec_osf.pl
new file mode 100644
index 0000000..a4e88d1
--- /dev/null
+++ b/IO/Browser/hints/dec_osf.pl
@@ -0,0 +1,10 @@
+# Achim Bohnet <ach at mpe.mpg.de>:
+#
+# /usr/include/curses.h claims that derwin() is part of:
+#
+# #ifdef _XOPEN_SOURCE_EXTENDED
+#
+# /* These are the ENHANCED CURSES interfaces in X/Open Curses, Issue 4 */
+#
+
+$self->{'DEFINE'} .= ' -D_XOPEN_SOURCE_EXTENDED -D_POSIX_C_SOURCE=199506L';
diff --git a/IO/Dicom/Dicom.pm b/IO/Dicom/Dicom.pm
new file mode 100644
index 0000000..5d9aa7c
--- /dev/null
+++ b/IO/Dicom/Dicom.pm
@@ -0,0 +1,388 @@
+=pod
+
+=head1 NAME
+
+PDL::IO::Dicom - a module for reading DICOM images.
+
+=head1 DESCRIPTION
+
+The PDL::IO::Dicom module enables reading 16-bit gray level Dicom
+images into PDL. As Dicom is an extremely complex format, this module
+can unfortunately not handle all different image types included in the
+DICOM standard. One common format that is currently not supported is
+the Papyrus format.
+
+=head1 USAGE
+
+ use PDL;
+ use PDL::IO::Dicom;
+
+ $img = rdcm("image.dcm");
+
+=head1 AUTHOR
+
+Copyright (C) Dov Grobgeld <dov at imagic.weizmann.ac.il> 2002.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+package PDL::IO::Dicom;
+
+use PDL;
+use PDL::Core;
+use PDL::IO::Misc;
+
+use Exporter;
+ at ISA = qw( Exporter );
+ at EXPORT = qw( rdcm );
+
+use strict;
+
+my $debug = 0;
+
+my %element_table =
+ (
+ "0002,0000" => ["Group length","UL"],
+ "0002,0001" => ["File Meta Information Version","OB"],
+ "0002,0002" => ["Media Storage SOP Class UID","UI"],
+ "0002,0003" => ["Media Storage SOP Instance UID","UI"],
+ "0002,0010" => ["Transfer Syntax UID","UI"],
+ "0002,0012" => ["Implementation Class UID","UI"],
+ "0002,0013" => ["Implementation Version Name","SH"],
+ "0002,0016" => ["Source Application Entity Title","AE"],
+ "0008,0000" => ["Identifying Group Length", "UL"],
+ "0008,0001" => ["Length to End"],
+ "0008,0005" => ["Specific Character Set","CS"],
+ "0008,0008" => ["Image Type","CS"],
+ "0008,0010" => ["Recognition Code"],
+ "0008,0012" => ["Instance Creation Date"],
+ "0008,0013" => ["Instance Creation Time"],
+ "0008,0014" => ["Instance Creator UID"],
+ "0008,0016" => ["SOP Class UID","UI"],
+ "0008,0018" => ["SOP Instance UID","UI"],
+ "0008,0020" => ["Study Date","DA"],
+ "0008,0021" => ["Series date","DA"],
+ "0008,0022" => ["Acquisition Date","DA"],
+ "0008,0023" => ["Image Date","DA"],
+ "0008,0030" => ["Study Time","TM"],
+ "0008,0031" => ["Series Time","TM"],
+ "0008,0032" => ["Acquisition Time","TM"],
+ "0008,0033" => ["Image Time","TM"],
+ "0008,103e" => ["Series Description"],
+ "0008,1030" => ["Study Description"],
+ "0008,0050" => ["Accession Number","SH"],
+ "0008,0060" => ["Modality","CS"],
+ "0008,0070" => ["Manufacturer","LO"],
+ "0008,0080" => ["Institution Name","LO"],
+ "0008,0090" => ["Referring Physician's Name","PN"],
+ "0008,1010" => ["Station Name","SH"],
+ "0008,1030" => ["Study Description","LO"],
+ "0008,103e" => ["Series Description","LO"],
+ "0008,1060" => ["Name of Physician(s)","PN"],
+ "0008,1090" => ["Manufacturers Model Name",],
+ "0010,0000" => ["Patient Information Group"],
+ "0010,0010" => ["Patient Name","PN"],
+ "0010,0020" => ["Patient ID"],
+ "0010,0030" => ["Patient Birth Date"],
+ "0010,0040" => ["Patient's Sex"],
+ "0010,1010" => ["Patient Age"],
+ "0010,1030" => ["Patient Weight"],
+ "0018,0000" => ["Acquisition Gnformation Group"],
+ "0018,0010" => ["Contrast/Bolus Agent"],
+ "0018,0020" => ["Scanning Sequence"],
+ "0018,0022" => ["Scan Options"],
+ "0018,0050" => ["Slice thickness"],
+ "0018,1050" => ["Spatial Resolution", "lO"],
+ "0008,1060" => ["Name of Physician(s) Reading Study"],
+ "0008,1070" => ["Operator's Name"],
+ "0018,0080" => ["Repetition Time"],
+ "0018,0081" => ["Echo Time"],
+ "0018,0082" => ["Inversion Time"],
+ "0018,0083" => ["Number of Averages"],
+ "0018,0084" => ["Imaging Frequency"],
+ "0018,0085" => ["Imaged Nucleus"],
+ "0018,0086" => ["Echo Number(s)"],
+ "0018,0087" => ["Magnetic Field Strength"],
+ "0018,0088" => ["Spacing Between Slices"],
+ "0018,0089" => ["Number of Phase Encoding Steps"],
+ "0018,0090" => ["Data Collection Diameter"],
+ "0018,0091" => ["Echo Train Length"],
+ "0018,0093" => ["Percent Sampling"],
+ "0018,0094" => ["Percent Phase Field of View"],
+ "0018,0095" => ["Pixel Bandwidth"],
+ "0018,1088" => ["Heart Rate","US"],
+ "0018,1090" => ["Cardiac Number of Images","US"],
+ "0018,1094" => ["Trigger Window","US"],
+ "0018,1100" => ["Reconstruction Diameter"],
+ "0018,1314" => ["Flip Angle"],
+ "0018,1315" => ["Variable Flip Angle Flag"],
+ "0018,1316" => ["SAR"],
+ "0020,0000" => ["Relationship information group"],
+ "0020,000d" => ["Study Instance UID"],
+ "0020,000e" => ["Series Instance UID"],
+ "0020,0010" => ["Study ID"],
+ "0020,0011" => ["Series Number"],
+ "0020,0012" => ["Acquisition Number"],
+ "0020,0013" => ["Image Number"],
+ "0020,0014" => ["Isotope Number"],
+ "0020,0015" => ["Phase Number"],
+ "0020,0016" => ["Interval Number"],
+ "0020,0017" => ["Time Slot Number"],
+ "0020,0018" => ["Angle Number"],
+ "0020,0020" => ["Patient Orientation"],
+ "0020,0022" => ["Overlay Number"],
+ "0020,0024" => ["Curve Number"],
+ "0020,0026" => ["LUT Number"],
+ "0020,0030" => ["Image Position"],
+ "0020,0032" => ["Image Position (Patient)"],
+ "0020,0035" => ["Image Orientation"],
+ "0020,0037" => ["Image Orientation (Patient)"],
+ "0020,0050" => ["Location"],
+ "0020,0052" => ["Frame of Reference UID"],
+ "0020,0060" => ["Laterality"],
+ "0020,1002" => ["Images in acqusition"],
+ "0020,1040" => ["Position Reference Indicator"],
+ "0020,1041" => ["Slice Location"],
+ "0028,0000" => ["Relationship information group"],
+ "0028,0002" => ["Samples per Pixel"],
+ "0028,0004" => ["Photometric Interpretation"],
+ "0028,0005" => ["Image Dimensions"],
+ "0028,0010" => ["Rows", "US"],
+ "0028,0011" => ["Columns", "US"],
+ "0028,0030" => ["Pixel Spacing"],
+ "0028,0100" => ["Bits Allocated","US"],
+ "0028,0101" => ["Bits Stored", "US"],
+ "0028,0102" => ["High Bit","US"],
+ "0028,0103" => ["Pixel Representation","US"],
+ "0028,1052" => ["Rescale Intercept"],
+ "0028,1053" => ["Rescale Slope"],
+ "0033,1002" => ["IMGF"],
+ "7fe0,0000" => ["Pixel Data Information Group", "UL"],
+ "7fe0,0010" => ["Pixel Data","OW"]
+ );
+
+=head1 FUNCTIONS
+
+=head2 rdcm
+
+=for ref
+
+Read a dicom image.
+
+=for usage
+
+ $dcm = rdcm("filename")
+
+=cut
+
+sub rdcm {
+ my $file = shift;
+ my $options = shift;
+ my $do_print_info = 0;
+ my (%info, %bin);
+ my $do_raw = 0; # Only for debugging
+ my ($rescale_intercept, $rescale_slope) = (0, 1);
+ my $do_explicit = 0;
+ my $do_guess_endian = 1;
+
+ # options
+ if ($options) {
+ if (defined $options->{do_print_info}) {
+ $do_print_info = $options->{do_print_info};
+ }
+ }
+
+ open(IN, $file) || die "Failed opening image $file!\n";
+ binmode IN;
+ # read the whole image
+ my $header;
+ read(IN, $header, -s $file);
+
+ # File preamble - a fixed 128 byte field
+ my $hpos = 0x80;
+
+ # Next four bytes should be DICM
+ if (substr($header, $hpos, 4) ne 'DICM') {
+ die "This is not a DICM file!\n";
+ }
+ $hpos+= 4;
+
+ # Precheck if the first entry has explicit vr. Unfortunately this
+ # is not enough to determine if the file always has explicit value
+ # representation.
+ if (substr($header, $hpos+4, 2)=~ /[A-Z]{2}/) {
+ $do_explicit++;
+ }
+
+ while($hpos < length($header)) {
+ my $is_binary = 0;
+ my $groupword = unpack("v", substr($header, $hpos, 2)); $hpos+=2;
+ my $elementword = unpack("v", substr($header, $hpos, 2)); $hpos+=2;
+ my $value_rep = substr($header, $hpos, 2);
+ my $key = sprintf("%04x,%04x", $groupword, $elementword);
+ my ($lookup) = $element_table{$key};
+ my $override_vr = 0;
+
+ # Check for explicit value representation. There must be a different
+ # way to figure this out, but I still haven't figured out how!
+ if ($value_rep =~ /[A-Z][A-Z]/) {
+ $hpos+=2;
+ }
+ else {
+ $override_vr++;
+ $value_rep = $lookup->[1] || "UN";
+ }
+
+ my $elementlength;
+ if (substr($header, $hpos, 4) eq "IMGF") {
+ die "No support for IMGF files at the moment!\n";
+ }
+
+ # The following calculation agrees with dicom3tools
+ if ($override_vr) {
+ $elementlength = unpack("V", substr($header, $hpos, 4));
+ $hpos+= 4;
+ }
+ elsif (grep($value_rep eq $_, qw(OB OW SQ UN))) {
+ # Long length
+ $is_binary = 1;
+ $hpos+= 2; # Always zero
+ $elementlength = unpack("V", substr($header, $hpos, 4));
+ $hpos+= 4;
+ }
+ else {
+ # Short length
+ $elementlength = unpack("v", substr($header, $hpos, 2));
+ $hpos+= 2;
+ }
+
+ my ($descr) = "";
+ my $contents = substr($header, $hpos, $elementlength) . "";
+
+ ($descr) = @$lookup if $lookup;
+
+ # recode contents
+ if ($value_rep eq "UL") { $contents = unpack("V", $contents); }
+ elsif ($value_rep eq "US") { $contents = unpack("v", $contents); }
+ elsif ($value_rep eq "TM") { $contents = clean_time($contents); }
+ elsif ($value_rep eq "DA") { $contents = clean_date($contents); }
+ elsif (!$is_binary) {
+ $contents=~ s/\s+$//;
+ }
+
+ # store the contents
+ if ($key eq "7fe0,0010") { # Pixel data
+ $bin{$descr} = $contents;
+ }
+ else {
+ $info{$descr} = $contents if $descr;
+ }
+
+ if ($do_print_info) {
+ $contents = "" unless $contents;
+ $contents = "<<Binary>>" if $is_binary;
+ $contents=~ tr/\0-\037\200-\377//d;
+ $contents= substr($contents, 0, 40) unless $do_raw;
+ $contents=~ s/[\0-\037\200]/?/g;
+ $value_rep=~ s/[\0-\037]/?/g;
+ printf STDERR "%04x> %04x,%04x (%04x,$value_rep) %-30s : %s\n",
+ $hpos, $groupword, $elementword, $elementlength, $descr, $contents;
+ }
+
+ $hpos+= $elementlength;
+ }
+
+ my($width, $height) = ($info{Columns}, $info{Rows});
+ my($bs) = $info{"Bits Allocated"}/8;
+ my $img = $bin{"Pixel Data"};
+ # The following logics works on Intel endian
+ my $do_toggle_endian = $info{"Pixel Representation"};
+ $rescale_intercept = $info{"Rescale Intercept"} if defined $info{"Rescale Intercept"};
+ $rescale_slope = $info{"Rescale Slope"} if defined $info{"Rescale Slope"};
+
+ my $pdl;
+
+ # Create a pdl from the raw data
+ if ($bs == 2) {
+ $pdl = zeroes(ushort, $width,$height);
+ my $hdr = $pdl->gethdr;
+ $pdl->make_physical();
+
+ # Store the pixel data
+ ${$pdl->get_dataref()} = $img;
+
+ # Guess endian
+ if ($do_guess_endian) {
+ # Compare spread of high byte with low byte
+ my $high_byte = ($pdl>>8)->byte;
+ my $low_byte = ($pdl & 0xff)->byte;
+ my $max_high = $high_byte->max;
+ my $max_low = $low_byte->max;
+
+ # print STDERR "max_high max-low = $max_high $max_low\n";
+
+ # The following might need to be adjusted on different
+ # architectures.
+ $do_toggle_endian = $max_high > $max_low;
+ }
+
+ # Endian swap
+ if ($do_toggle_endian) {
+ bswap2($pdl);
+ }
+
+ # Rescale and convert to double
+ if ($rescale_intercept != 0
+ || $rescale_slope != 1) {
+ print STDERR "scaling with $rescale_slope and $rescale_intercept\n";
+ $pdl = 1.0*($pdl * $rescale_slope) + $rescale_intercept;
+ }
+ } else {
+ die "Sorry! PDL::IO::Dicom currently only supported DICOM with bs=2. bs = $bs\n";
+ }
+
+ # Store the info in the pdl header
+ $pdl->sethdr(\%info);
+
+ return $pdl;
+}
+
+sub clean_time {
+ my $time = shift;
+ my ($hour, $min, $sec, $sec_frac);
+ if ($time=~ /(\d+):(\d+):(\d+)\.?(\d*)/) {
+ ($hour,$min,$sec,$sec_frac) = ($1,$2,$3,$4);
+ }
+ elsif ($time=~ /(\d\d)(\d\d)(\d\d)\.?(\d+)/) {
+ ($hour,$min,$sec,$sec_frac) = ($1,$2,$3,$4);
+ }
+
+ if (defined $hour) {
+ $time = sprintf("%02d:%02d:%02d", $hour, $min, $sec);
+ $time .= ".$sec_frac" if $sec_frac;
+ }
+ return $time;
+}
+
+sub clean_date {
+ my $date = shift;
+ $date=~ s/(\d\d\d\d)(\d\d)(\d\d)/$1-$2-$3/;
+ return $date;
+}
+
+=head1 AUTHOR
+
+Copyright (C) Dov Grobgeld <dov at imagic.weizmann.ac.il> 1997.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+1;
diff --git a/IO/Dicom/Makefile.PL b/IO/Dicom/Makefile.PL
new file mode 100644
index 0000000..57ab462
--- /dev/null
+++ b/IO/Dicom/Makefile.PL
@@ -0,0 +1,14 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => "PDL::IO::Dicom",
+ 'VERSION_FROM' => '../../Basic/Core/Version.pm',
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
+# With dmake a postamble is sometimes (incorrectly) written
+# in the Makefile. The following prevents that:
+
+sub MY::postamble {
+ return "";
+}
diff --git a/IO/Dumper.pm b/IO/Dumper.pm
new file mode 100644
index 0000000..e3404cd
--- /dev/null
+++ b/IO/Dumper.pm
@@ -0,0 +1,630 @@
+=head1 NAME
+
+PDL::IO::Dumper -- data dumping for structs with PDLs
+
+=head1 DESCRIPTION
+
+This package allows you cleanly to save and restore complex data structures
+which include PDLs, as ASCII strings and/or transportable ASCII files. It
+exports four functions into your namespace: sdump, fdump, frestore, and
+deep_copy.
+
+PDL::IO::Dumper traverses the same types of structure that Data::Dumper
+knows about, because it uses a call to Data::Dumper. Unlike Data::Dumper
+it doesn't crash when accessing PDLs.
+
+The PDL::IO::Dumper routines have a slightly different syntax than
+Data::Dumper does: you may only dump a single scalar perl expression
+rather than an arbitrary one. Of course, the scalar may be a ref to
+whatever humongous pile of spaghetti you want, so that's no big loss.
+
+The output string is intended to be about as readable as Dumper's
+output is for non-PDL expressions. To that end, small PDLs (up to 8
+elements) are stored as inline perl expressions, midsized PDLs (up to
+200 elements) are stored as perl expressions above the main data
+structure, and large PDLs are stored as FITS files that are uuencoded
+and included in the dump string. (You have to have access to either
+uuencode(1) or the CPAN module Convert::UU for this to work).
+
+No attempt is made to shrink the output string -- for example, inlined
+PDL expressions all include explicit reshape() and typecast commands,
+and uuencoding expands stuff by a factor of about 1.5. So your data
+structures will grow when you dump them.
+
+=head1 Bugs
+
+It's still possible to break this code and cause it to dump core, for
+the same reason that Data::Dumper crashes. In particular, other
+external-hook variables aren't recognized (for that a more universal
+Dumper would be needed) and will still exercise the Data::Dumper crash.
+This is by choice: (A) it's difficult to recognize which objects
+are actually external, and (B) most everyday objects are quite safe.
+
+Another shortfall of Data::Dumper is that it doesn't recognize tied objects.
+This might be a Good Thing or a Bad Thing depending on your point of view,
+but it means that PDL::IO::Dumper includes a kludge to handle the tied
+Astro::FITS::Header objects associated with FITS headers (see the rfits
+documentation in PDL::IO::Misc for details).
+
+There's currently no reference recursion detection, so a non-treelike
+reference topology will cause Dumper to buzz forever. That will
+likely be fixed in a future version. Meanwhile a warning message finds
+likely cases.
+
+
+=head1 Author, copyright, no warranty
+
+Copyright 2002, Craig DeForest.
+
+This code may be distributed under the same terms as Perl itself
+(license available at L<http://ww.perl.org>). Copying, reverse
+engineering, distribution, and modification are explicitly allowed so
+long as this notice is preserved intact and modified versions are
+clearly marked as such.
+
+This package comes with NO WARRANTY.
+
+=head1 HISTORY
+
+=over 3
+
+=item * 1.0: initial release
+
+=item * 1.1 (26-Feb-2002): Shorter form for short PDLs; more readability
+
+=item * 1.2 (28-Feb-2002): Added deep_copy() -- exported convenience function
+ for "eval sdump"
+
+=item * 1.3 (15-May-2002): Added checking for tied objects in gethdr()
+ [workaround for hole in Data::Dumper]
+
+=item * 1.4 (15-Jan-2003): Added support for Convert::UU as well as
+ command-line uu{en|de}code
+
+=back
+
+=head1 FUNCTIONS
+
+=cut
+
+# use PDL::NiceSlice;
+
+package PDL::IO::Dumper;
+use File::Temp;
+
+
+BEGIN{
+ use Exporter ();
+
+ package PDL::IO::Dumper;
+
+ $PDL::IO::Dumper::VERSION = '1.3.2';
+
+ @PDL::IO::Dumper::ISA = ( Exporter ) ;
+ @PDL::IO::Dumper::EXPORT_OK = qw( fdump sdump frestore deep_copy);
+ @PDL::IO::Dumper::EXPORT = @EXPORT_OK;
+ %PDL::IO::Dumper::EXPORT_TAGS = ( Func=>[@EXPORT_OK]);
+
+ eval "use Convert::UU;";
+ $PDL::IO::Dumper::convert_ok = !$@;
+
+ my $checkprog = sub {
+ my($prog) = $_[0];
+ my $pathsep = $^O =~ /win32/i ? ';' : ':';
+ my $exe = $^O =~ /win32/i ? '.exe' : '';
+ for(split $pathsep,$ENV{PATH}){return 1 if -x "$_/$prog$exe"}
+ return 0;
+ };
+ # make sure not to use uuencode/uudecode
+ # on MSWin32 systems (it doesn't work)
+ # Force Convert::UU for BSD systems to see if that fixes uudecode problem
+ if ($^O !~ /(MSWin32|bsd)$/) {
+ $PDL::IO::Dumper::uudecode_ok = &$checkprog('uudecode') and &$checkprog('uuencode') and ($^O !~ /MSWin32/);
+ }
+
+ use PDL;
+ use PDL::Exporter;
+ use PDL::Config;
+ use Data::Dumper 2.121;
+ use Carp;
+ use IO::File;
+}
+
+######################################################################
+
+=head2 sdump
+
+=for ref
+
+Dump a data structure to a string.
+
+=for usage
+
+ use PDL::IO::Dumper;
+ $s = sdump(<VAR>);
+ ...
+ <VAR> = eval $s;
+
+=for description
+
+sdump dumps a single complex data structure into a string. You restore
+the data structure by eval-ing the string. Since eval is a builtin, no
+convenience routine exists to use it.
+
+=cut
+
+sub PDL::IO::Dumper::sdump {
+# Make an initial dump...
+ my($s) = Data::Dumper->Dump([@_]);
+ my(%pdls);
+# Find the bless(...,'PDL') lines
+ while($s =~ s/bless\( do\{\\\(my \$o \= '?(-?\d+)'?\)\}\, \'PDL\' \)/sprintf('$PDL_%u',$1)/e) {
+ $pdls{$1}++;
+ }
+
+## Check for duplicates -- a weak proxy for recursion...
+ my($v);
+ my($dups);
+ foreach $v(keys %pdls) {
+ $dups++ if($pdls{$v} >1);
+ }
+ print STDERR "Warning: duplicated PDL ref. If sdump hangs, you have a circular reference.\n" if($dups);
+
+ # This next is broken into two parts to ensure $s is evaluated *after* the
+ # find_PDLs call (which modifies $s using the s/// operator).
+
+ my($s2) = "{my(\$VAR1);\n".&PDL::IO::Dumper::find_PDLs(\$s, at _)."\n\n";
+ return $s2.$s."\n}";
+
+#
+}
+
+######################################################################
+
+=head2 fdump
+
+=for ref
+
+Dump a data structure to a file
+
+=for usage
+
+ use PDL::IO::Dumper;
+ fdump(<VAR>,$filename);
+ ...
+ <VAR> = frestore($filename);
+
+=for description
+
+fdump dumps a single complex data structure to a file. You restore the
+data structure by eval-ing the perl code put in the file. A convenience
+routine (frestore) exists to do it for you.
+
+I suggest using the extension '.pld' or (for non-broken OS's) '.pdld'
+to distinguish Dumper files. That way they are reminiscent of .pl
+files for perl, while still looking a little different so you can pick
+them out. You can certainly feed a dump file straight into perl (for
+syntax checking) but it will not do much for you, just build your data
+structure and exit.
+
+=cut
+
+sub PDL::IO::Dumper::fdump {
+ my($struct,$file) = @_;
+ my $fh = IO::File->new( ">$file" );
+ unless ( defined $fh ) {
+ Carp::cluck ("fdump: couldn't open '$file'\n");
+ return undef;
+ }
+ $fh->print( "####################\n## PDL::IO::Dumper dump file -- eval this in perl/PDL.\n\n" );
+ $fh->print( sdump($struct) );
+ $fh->close();
+ return $struct;
+}
+
+######################################################################
+
+=head2 frestore
+
+=for ref
+
+Restore a dumped file
+
+=for usage
+
+ use PDL::IO::Dumper;
+ fdump(<VAR>,$filename);
+ ...
+ <VAR> = frestore($filename);
+
+=for description
+
+frestore() is a convenience function that just reads in the named
+file and executes it in an eval. It's paired with fdump().
+
+=cut
+
+sub PDL::IO::Dumper::frestore {
+ local($_);
+ my($fname) = shift;
+
+ my $fh = IO::File->new( "<$fname" );
+ unless ( defined $fh ) {
+ Carp::cluck("frestore: couldn't open '$file'\n");
+ return undef;
+ }
+
+ my($file) = join("",<$fh>);
+
+ $fh->close;
+
+ return eval $file;
+}
+
+######################################################################
+
+=head2 deep_copy
+
+=for ref
+
+Convenience function copies a complete perl data structure by the
+brute force method of "eval sdump".
+
+=cut
+
+sub PDL::IO::Dumper::deep_copy {
+ return eval sdump @_;
+}
+
+######################################################################
+
+=head2 PDL::IO::Dumper::big_PDL
+
+=for ref
+
+Identify whether a PDL is ``big'' [Internal routine]
+
+Internal routine takes a PDL and returns a boolean indicating whether
+it's small enough for direct insertion into the dump string. If 0,
+it can be inserted. Larger numbers yield larger scopes of PDL.
+1 implies that it should be broken out but can be handled with a couple
+of perl commands; 2 implies full uudecode treatment.
+
+PDLs with Astro::FITS::Header objects as headers are taken to be FITS
+files and are always treated as huge, regardless of size.
+
+=cut
+
+$PDL::IO::Dumper::small_thresh = 8; # Smaller than this gets inlined
+$PDL::IO::Dumper::med_thresh = 400; # Smaller than this gets eval'ed
+ # Any bigger gets uuencoded
+
+sub PDL::IO::Dumper::big_PDL {
+ my($a) = shift;
+
+ return 0
+ if($a->nelem <= $PDL::IO::Dumper::small_thresh
+ && !(keys %{$a->hdr()})
+ );
+
+ return 1
+ if($a->nelem <= $PDL::IO::Dumper::med_thresh
+ && ( !( ( (tied %{$a->hdr()}) || '' ) =~ m/^Astro::FITS::Header\=/) )
+ );
+
+ return 2;
+}
+
+######################################################################
+
+=head2 PDL::IO::Dumper::stringify_PDL
+
+=for ref
+
+Turn a PDL into a 1-part perl expr [Internal routine]
+
+Internal routine that takes a PDL and returns a perl string that evals to the
+PDL. It should be used with care because it doesn't dump headers and
+it doesn't check number of elements. The point here is that numbers are
+dumped with the correct precision for their storage class. Things we
+don't know about get stringified element-by-element by their builtin class,
+which is probably not a bad guess.
+
+=cut
+
+%PDL::IO::Dumper::stringify_formats = (
+ "byte"=>"%d",
+ "short"=>"%d",
+ "long"=>"%d",
+ "float"=>"%.6g",
+ "double"=>"%.16g"
+ );
+
+
+sub PDL::IO::Dumper::stringify_PDL{
+ my($pdl) = shift;
+
+ if(!ref $pdl) {
+ confess "PDL::IO::Dumper::stringify -- got a non-pdl value!\n";
+ die;
+ }
+
+ ## Special case: empty PDL
+ if($pdl->nelem == 0) {
+ return "which(pdl(0))";
+ }
+
+ ## Normal case: Figure out how to dump each number and dump them
+ ## in sequence as ASCII strings...
+
+ my($pdlflat) = $pdl->flat;
+ my($t) = $pdl->type;
+
+ my($s);
+ my(@s);
+ my($dmp_elt);
+
+ if(defined $PDL::IO::Dumper::stringify_formats{$t}) {
+ $dmp_elt = eval "sub { sprintf '$PDL::IO::Dumper::stringify_formats{$t}',shift }";
+ } else {
+ if(!$PDL::IO::Dumper::stringify_warned) {
+ print STDERR "PDL::IO::Dumper: Warning, stringifying a '$t' PDL using default method\n\t(Will be silent after this)\n";
+ $PDL::IO::Dumper::stringify_warned = 1;
+ }
+ $dmp_elt = sub { my($a) = shift; "$a"; };
+ }
+ $i = 0;
+
+ my($i);
+ for($i = 0; $i < $pdl->nelem; $i++) {
+ push(@s, &{$dmp_elt}( $pdlflat->slice("($i)") ) );
+ }
+
+
+ ## Assemble all the strings and bracket with a pdl() call.
+
+ $s = ($PDL::IO::Dumper::stringify_formats{$t}?$t:'pdl').
+ "(" . join( "," , @s ) . ")".
+ (($_->getndims > 1) && ("->reshape(" . join(",",$pdl->dims) . ")"));
+
+ return $s;
+}
+
+
+######################################################################
+
+=head2 PDL::IO::Dumper::uudecode_PDL
+
+=for ref
+
+Recover a PDL from a uuencoded string [Internal routine]
+
+This routine encapsulates uudecoding of the dumped string for large piddles.
+It's separate to encapsulate the decision about which method of uudecoding
+to try (both the built-in Convert::UU and the shell command uudecode(1)
+are supported).
+
+=cut
+
+# should we use OS/library-level routines for creating
+# a temporary filename?
+#
+sub _make_tmpname () {
+ # should we use File::Spec routines to create the file name?
+ return File::Temp::tmpnam() . ".fits";
+}
+
+# For uudecode_PDL:
+#
+# uudecode on OS-X needs the -s option otherwise it strips off the
+# path of the data file - which messes things up. We could change the
+# logic so that we explicitly tell uudecode where to create the output
+# file, except that this is also OS-dependent (-o <filename> on OS-X/linux,
+# -p on solaris/OS-X to write to stdout, any others?),
+# so we go this way for now as it is less-likely to break things
+#
+my $uudecode_string = "|uudecode";
+$uudecode_string .= " -s" if $^O =~ m/darwin|((free|open)bsd)|dragonfly/;
+
+sub PDL::IO::Dumper::uudecode_PDL {
+ my $lines = shift;
+ my $out;
+ my $fname = _make_tmpname();
+ if($PDL::IO::Dumper::uudecode_ok) {
+ local $SIG{PIPE}= sub {}; # Prevent crashing if uudecode exits
+ my $fh = IO::File->new( $uudecode_string );
+ $lines =~ s/^[^\n]*\n/begin 664 $fname\n/o;
+ $fh->print( $lines );
+ $fh->close;
+ }
+ elsif($PDL::IO::Dumper::convert_ok) {
+ my $fh = IO::File->new(">$fname");
+ my $fits = Convert::UU::uudecode($lines);
+ $fh->print( $fits );
+ $fh->close();
+ } else {
+ barf("Need either uudecode(1) or Convert::UU to decode dumped PDL.\n");
+ }
+
+ $out = rfits($fname);
+ unlink($fname);
+
+ $out;
+}
+
+=head2 PDL::IO::Dumper::dump_PDL
+
+=for ref
+
+Generate 1- or 2-part expr for a PDL [Internal routine]
+
+Internal routine that produces commands defining a PDL. You supply
+(<PDL>, <name>) and get back two strings: a prepended command string and an
+expr that evaluates to the final PDL. PDL is the PDL you want to dump.
+<inline> is a flag whether dump_PDL is being called inline or before
+the inline dump string (0 for before; 1 for in). <name> is the
+name of the variable to be assigned (for medium and large PDLs,
+which are defined before the dump string and assigned unique IDs).
+
+=cut
+
+sub PDL::IO::Dumper::dump_PDL {
+ local($_) = shift;
+ my($pdlid) = @_;
+ my(@out);
+
+ my($style) = &PDL::IO::Dumper::big_PDL($_);
+
+ if($style==0) {
+ @out = ("", "( ". &PDL::IO::Dumper::stringify_PDL($_). " )");
+ }
+
+ else {
+ my(@s);
+
+ ## midsized case
+ if($style==1){
+ @s = ("my(\$$pdlid) = (",
+ &PDL::IO::Dumper::stringify_PDL($_),
+ ");\n");
+ }
+
+ ## huge case
+ else {
+
+ ##
+ ## Write FITS file, uuencode it, snarf it up, and clean up the
+ ## temporary directory
+ ##
+ my $fname = _make_tmpname();
+ wfits($_,$fname);
+ my(@uulines);
+
+ if($PDL::IO::Dumper::uudecode_ok) {
+ my $fh = IO::File->new( "uuencode $fname $fname |" );
+ @uulines = <$fh>;
+ $fh->close;
+ } elsif($PDL::IO::Dumper::convert_ok) {
+ # Convert::UU::uuencode does not accept IO::File handles
+ # (at least in version 0.52 of the module)
+ #
+ open(FITSFILE,"<$fname");
+ @uulines = ( Convert::UU::uuencode(*FITSFILE) );
+ } else {
+ barf("dump_PDL: Requires either uuencode or Convert:UU");
+ }
+ unlink $fname;
+
+ ##
+ ## Generate commands to uudecode the FITS file and resnarf it
+ ##
+ @s = ("my(\$$pdlid) = PDL::IO::Dumper::uudecode_PDL(<<'DuMPERFILE'\n",
+ @uulines,
+ "\nDuMPERFILE\n);\n",
+ "\$$pdlid->hdrcpy(".$_->hdrcpy().");\n"
+ );
+
+ ##
+ ## Unfortunately, FITS format mangles headers (and gives us one
+ ## even if we don't want it). Delete the FITS header if we don't
+ ## want one.
+ ##
+ if( !scalar(keys %{$_->hdr()}) ) {
+ push(@s,"\$$pdlid->sethdr(undef);\n");
+ }
+ }
+
+ ##
+ ## Generate commands to reconstitute the header
+ ## information in the PDL -- common to midsized and huge case.
+ ##
+ ## We normally want to reconstitute, because FITS headers mangle
+ ## arbitrary hashes and we can reconsitute efficiently with a private
+ ## sdump(). The one known exception to this is when there's a FITS
+ ## header object (Astro::FITS::Header) tied to the original
+ ## PDL's header. Other types of tied object will get handled just
+ ## like normal hashes.
+ ##
+ ## Ultimately, Data::Dumper will get fixed to handle tied objects,
+ ## and this kludge will go away.
+ ##
+
+ if( scalar(keys %{$_->hdr()}) ) {
+ if( ((tied %{$_->hdr()}) || '') =~ m/Astro::FITS::Header\=/) {
+ push(@s,"# (Header restored from FITS file)\n");
+ } else {
+ push(@s,"\$$pdlid->sethdr( eval <<'EndOfHeader_${pdlid}'\n",
+ &PDL::IO::Dumper::sdump($_->hdr()),
+ "\nEndOfHeader_${pdlid}\n);\n",
+ "\$$pdlid->hdrcpy(".$_->hdrcpy().");\n"
+ );
+ }
+ }
+
+ @out = (join("", at s), undef);
+ }
+
+ return @out;
+}
+
+######################################################################
+
+=head2 PDL::IO::Dumper::find_PDLs
+
+=for ref
+
+Walk a data structure and dump PDLs [Internal routine]
+
+Walks the original data structure and generates appropriate exprs
+for each PDL. The exprs are inserted into the Data::Dumper output
+string. You shouldn't call this unless you know what you're doing.
+(see sdump, above).
+
+=cut
+
+sub PDL::IO::Dumper::find_PDLs {
+ local($_);
+ my($out)="";
+ my($sp) = shift;
+
+ findpdl:foreach $_(@_) {
+ next findpdl unless ref($_);
+
+ if(UNIVERSAL::isa($_,'ARRAY')) {
+ my($a);
+ foreach $a(@{$_}) {
+ $out .= find_PDLs($sp,$a);
+ }
+ }
+ elsif(UNIVERSAL::isa($_,'HASH')) {
+ my($a);
+ foreach $a(values %{$_}) {
+ $out .= find_PDLs($sp,$a)
+ }
+ } elsif(UNIVERSAL::isa($_,'PDL')) {
+
+ # In addition to straight PDLs,
+ # this gets subclasses of PDL, but NOT magic-hash subclasses of
+ # PDL (because they'd be gotten by the previous clause).
+ # So if you subclass PDL but your actual data structure is still
+ # just a straight PDL (and not a hash with PDL field), you end up here.
+ #
+
+ my($pdlid) = sprintf('PDL_%u',$$_);
+ my(@strings) = &PDL::IO::Dumper::dump_PDL($_,$pdlid);
+
+ $out .= $strings[0];
+ $$sp =~ s/\$$pdlid/$strings[1]/g if(defined($strings[1]));
+ }
+ elsif(UNIVERSAL::isa($_,'SCALAR')) {
+ # This gets other kinds of refs -- PDLs have already been gotten.
+ # Naked PDLs are themselves SCALARs, so the SCALAR case has to come
+ # last to let the PDL case run.
+ $out .= find_PDLs( $sp, ${$_} );
+ }
+
+ }
+ return $out;
+}
+
+1;
diff --git a/IO/ENVI/readenvi.pdl b/IO/ENVI/readenvi.pdl
new file mode 100755
index 0000000..2bc5a35
--- /dev/null
+++ b/IO/ENVI/readenvi.pdl
@@ -0,0 +1,344 @@
+#!/usr/bin/perl
+#
+# Created on: Wed 31 Mar 2010 02:30:20 PM
+# Last saved: Mon 28 Nov 2011 01:35:30 PM
+#
+# This file is the first step of an ENVI file IO module
+# to be named PDL::IO::ENVI. We read the header file
+# corresponding to the input file, parse the keywords
+# values structures, and return a hash ref of the file.
+#
+# Then we can use readflex to read the data
+#
+# TODO
+#
+# (1) verify that all required fields are present
+# (2) parse map_info for pixel geolocation
+# - handle keyword=value inside list
+# (3) check that all sensor keywords are parsed
+# (4) add support for offset/stride/count/reshape
+# (5) implement writeenvi/wenvi routine
+# (6) LATER: add support for complex data input, e.g. [2,S,L,B]
+# (7) LATER: support unsigned long long
+
+use strict;
+
+use PDL;
+use PDL::NiceSlice;
+use PDL::IO::FlexRaw;
+use FileHandle;
+use Config;
+
+my $verbose = 1; # for diagnostics
+my $run_envi_main = 0; # set to 1 for testing
+
+# This is a hash ref of the known/allowed keywords
+# in an ENVI header file. While these are the current
+# values, this implementation allows for new keywords
+# by parsing according to the following rules:
+#
+# (1) keywords are between the start of line and the =
+# (2) keywords are case insensitive
+# (3) white space is significant but amount and type is not
+# (4) string values will have leading and trailing whitespace removed
+# (5) canonical whitespace is a single ASCII space char
+# (6) single spaces in hash keywords will be replace by underscore
+# (7) canonical case for normalized keywords is lowercase
+# (8) required key-value pairs are always on a single line
+# (9) brace starting lists must be on same line as keyword =
+# (10) comment lines begin with ; in the first column
+#
+# Initially, we will parse all keyword = values but only fully
+# process for the required and optional entries needed for the
+# scissor data files. A hash value of 1 indicates required..
+#
+my $envi_keywords = {
+ 'band_names' => 0, # optional, CSV str of band names
+ 'bands' => 1, # required, num of bands in image file
+ 'bbl' => 0, # optional, (tbd)
+ 'byte_order' => 1, # required, num 0 or 1 for LSF or MSF order
+ 'class_lookup' => 0, # optional, (tbd)
+ 'class_names' => 0, # optional, (tbd)
+ 'classes' => 0, # optional, num of classes, including unclassified
+ 'complex_function' => 0, # optional, (tbd)
+ 'coordinate_system string' => 0, # optional, (tbd, for georeferencing)
+ 'data_gain_values' => 0, # optional, CSV of gain vals for each band
+ 'data_ignore_value' => 0, # optional, value of bad/missing element in data
+ 'data_offset_values' => 0, # optional, CSV of offset vals for each band
+ 'data_type' => 1, # required, id number in 1-6,9,12-15
+ 'default_bands' => 0, # optional, CSV of 1 or 3 band numbers to display
+ 'default_stretch' => 0, # optional, str of stretch to use for image display
+ 'dem_band' => 0, # optional, (tbd)
+ 'dem_file' => 0, # optional, (tbd)
+ 'description' => 0, # optional, str describing the image or processing
+ 'file_type' => 1, # required, ENVI Standard or from filetype.txt
+ 'fwhm' => 0, # optional, CSV of band widths in wavelength units
+ 'geo_points' => 0, # optional, CSV of x,y,lat,long of 1-4 image pts
+ 'header_offset' => 1, # required, num bytes imbedded hdr in image file
+ 'interleave' => 1, # required, str/num of BSQ/0, BIL/1, or BIP/2
+ 'lines' => 1, # required, num lines in image
+ 'map_info' => 0, # optional, CSV of values, as in
+ # UTM, x0, y0, east0, north0, xpixsize, ypixsize,
+ # UTM zone #, N or S (UTM only), datum,
+ # units=str, rotation=val
+ 'pixel_size' => 0, # optional, CSV of x and y pixel size in meters
+ 'major_frame_offsets' => 0, # optional, (tbd)
+ 'minor_frame_offsets' => 0, # optional, (tbd)
+ 'projection_info' => 0, # optional, (tbd)
+ 'reflectance_scale_factor' => 0, # optional, (tbd)
+ 'rpc_info' => 0, # optional, (tbd)
+ 'samples' => 1, # required, num samples per image line each band
+ 'sensor_type' => 0, # optional, str Unknown or exact match in sensor.txt
+ 'spectra_names' => 0, # optional, (tbd)
+ 'wavelength' => 0, # optional, CSV of band center value in image
+ 'wavelength_units' => 0, # optional, str with units for wavelength and fwhm
+ 'x_start' => 0, # optional, (tbd)
+ 'y_start' => 0, # optional, (tbd)
+ 'z_plot_average' => 0, # optional, (tbd)
+ 'z_plot_range' => 0, # optional, (tbd)
+ 'z_plot_titles' => 0, # optional, (tbd)
+};
+
+my $envi_required_keywords = [];
+foreach (keys %$envi_keywords) {
+ push @$envi_required_keywords, $_ if $envi_keywords->{$_};
+}
+
+my $interleave = {
+ 'bsq' => [ qw( samples lines bands ) ],
+ 'bil' => [ qw( samples bands lines ) ],
+ 'bip' => [ qw( bands samples lines ) ],
+};
+
+my $envi_data_types = [];
+$envi_data_types->[1] = 'byte';
+$envi_data_types->[2] = 'short';
+$envi_data_types->[3] = 'long';
+$envi_data_types->[4] = 'float';
+$envi_data_types->[5] = 'double';
+$envi_data_types->[6] = undef; # complex, not supported, [2,shape]
+$envi_data_types->[9] = undef; # double complex, not supported, [2,shape]
+$envi_data_types->[12] = 'ushort';
+$envi_data_types->[13] = 'ulong';
+$envi_data_types->[14] = 'longlong';
+$envi_data_types->[15] = undef; # unsigned long64, not supported, longlong?
+
+# Takes one arg, an ENVI hdr filename and
+# returns a hash reference of the header data
+#
+sub _read_envihdr {
+ my $hdrname = $_[0];
+ my $hdr = {};
+
+ # an easy progress message
+ if ($verbose>1) {
+ print STDERR "_read_envihdr: reading ENVI hdr data from '@_'\n";
+ print STDERR "_read_envihdr: required ENVI keywords are:\n";
+ print STDERR " @{ [sort @$envi_required_keywords] }\n";
+ }
+
+ # open hdr file
+ my $hdrfile = FileHandle->new("$hdrname")
+ or barf "_read_envihdr: couldn't open '$hdrname' for reading";
+ binmode $hdrfile;
+
+ if ( eof($hdrfile) ) {
+ barf "_read_envihdr: WARNING '$hdrname' is empty, invalid ENVI format"
+ }
+
+ ITEM:
+ while (!eof($hdrfile)) {
+ # check for ENVI hdr start word on first line
+ my $line = <$hdrfile>;
+ if ($line !~ /^ENVI\r?$/) {
+ barf "_read_envihdr: '$hdrname' is not in ENVI hdr format"
+ }
+ $hdr->{ENVI} = 1; # this marks this header as ENVI
+
+ # collect key=values into a hash
+ my ($keyword,$val);
+ my $in_list = 0; # used to track when we re reading a { } list
+ LINE:
+ while (defined($line = <$hdrfile>)) {
+
+ next LINE if $line =~ /^;/; # skip comment line (maybe print?)
+
+ $line =~ s/\s+$//;
+ $line =~ s/^\s+//;
+ next LINE if $line =~ /^$/;
+
+ chomp $line;
+
+ if ($in_list>0) {
+ # append to value string
+ $val .= " $line"; # need to keep whitespace for separation
+ if ($line =~ /{/) {
+ barf "_read_envihdr: warning, found nested braces for line '$line'\n";
+ }
+ if ( $val =~ /}$/ ) { # got to end of list
+ # parse $val list
+ print STDERR "_read_envihdr: got list value = $val\n" if $verbose>1;
+ # clear list parse flag
+ $in_list--;
+ }
+ } else {
+ # look for next keyword = line
+ ($keyword,$val) = (undef, undef);
+ ($keyword,$val) = $line =~ /^\s*([^=]+)=\s*(.*)$/;
+ if (defined $keyword) {
+ # warning exit in case underscores are used in keywords
+ if ($keyword =~ /_/) {
+ barf "_read_envihdr: WARNING keyword '$keyword' contains underscore!"
+ }
+ # normalize to lc and single underscore for whitespace
+ $keyword =~ s/\s+$//;
+ $keyword =~ s/\s+/_/g;
+ $keyword = lc $keyword;
+
+ $val =~ s/^\s+//;
+ $val =~ s/\s+$//;
+
+ $in_list++ if $val =~ /^{/ and not $in_list;
+ $in_list-- if $val =~ /}$/ and $in_list;
+
+ next LINE if $in_list>0;
+
+ # parse ENVI hdr lists and convert to perl array ref
+ if ($val =~ /^{/) {
+ # strip off braces
+ $val =~ s/^{\s*//;
+ $val =~ s/\s*}$//;
+ my @listval = split ',\s*', $val;
+ print STDERR "_read_envihdr: expanded $keyword list value to (@listval)\n" if $verbose;
+ $val = [@listval];
+ }
+
+ my $reqoropt = $envi_keywords->{$keyword} ? 'required' : 'optional';
+ print STDERR " got $reqoropt $keyword = $val\n" if $verbose;
+
+ # replace ignore_value by data_ignore_value
+ $keyword =~ s/^ignore_value$/data_ignore_value/;
+ $hdr->{$keyword} = $val;
+
+ } else {
+
+ print STDERR " NOT a 'keyword =' line: '$line'\n" if $verbose;
+
+ }
+ }
+ }
+
+ }
+ # close hdr file
+ close $hdrfile;
+
+ return $hdr;
+}
+
+=head2 readenvi
+
+=for ref
+
+ reads ENVI standard format image files
+
+=for usage
+
+ $im = readenvi( filename ); # read image data
+ ($im, $hdr) = readenvi( filename ); # read image data and hdr data hashref
+
+ readenvi will look for an ENVI header file named filename.hdr
+
+ If that file is not found, it will try with the windows
+ convention of replacing the suffix of the filename by .hdr
+
+ If valid header data is found, the image will be read and
+ returned, with a ref to a hash of the hdr data in list
+ context.
+
+ NOTE: This routine only supports raw binary data at this time.
+
+=cut
+
+sub readenvi {
+ barf 'Usage ($x [,$hdr]) = readenvi("filename")' if $#_ > 0;
+ my $enviname = $_[0];
+
+ my $envi; # image data to return
+ my $filehdr; # image file header (before ENVI image data)
+ my $envihdr; # image hdr to return
+ my $flexhdr = [];
+
+ # an easy progress message
+ print STDERR "readenvi: reading ENVI data from '@_'\n" if $verbose;
+
+ # read ENVI header
+ my $envihdrname;
+
+ $envihdrname = $enviname . '.hdr';
+ if (! -f $envihdrname ) {
+ $envihdrname = $enviname;
+ $envihdrname =~ s/\.\w+$/.hdr/;
+ }
+
+ print STDERR "readenvi: ERROR could not find ENVI hdr file\n" unless -r $envihdrname;
+
+ $envihdr = _read_envihdr($envihdrname);
+
+ # add read of imbedded_header data if have header_offset non-zero
+ if ($envihdr->{header_offset}) {
+ push @$flexhdr, { Type => 'byte', NDims => 1, Dims=>$envihdr->{header_offset} }
+ }
+
+ # see if we need to swap
+ my $byteorder = ($Config{byteorder} =~ /4321$/) ? 1 : 0;
+ print STDERR "readenvi: Config{byteorder} is $Config{byteorder}\n" if $verbose>1;
+ if ($byteorder != $envihdr->{byte_order}) {
+ print STDERR "readenvi: got byteorder of $byteorder, ENVI file has $envihdr->{byte_order}\n" if $verbose;
+ print STDERR "readenvi: adding { Type => 'swap' } to \$flexhdr\n" if $verbose;
+ push @$flexhdr, { Type => 'swap' } if $byteorder != $envihdr->{byte_order};
+ }
+
+ # determine data type for readflex from interleave header value
+ my $imagespec = { };
+ my $imagetype = $envi_data_types->[$envihdr->{data_type}];
+ print STDERR "readenvi: setting image { Type => $imagetype }\n" if $verbose;
+ $imagespec->{Type} = $imagetype;
+
+ # construct Dims for readflex
+ my @imagedims = ();
+ @imagedims = @{$interleave->{lc($envihdr->{interleave})}};
+ print STDERR "readenvi: Need Dims => @imagedims\n" if $verbose;
+ my $imagedims = [ map { $envihdr->{$_} } @imagedims ];
+ print STDERR "readenvi: computed Dims => [", join( ', ', @{$imagedims} ), "]\n" if $verbose;
+ $imagespec->{Dims} = $imagedims;
+ $imagespec->{Ndims} = scalar(@$imagedims);
+ push @$flexhdr, $imagespec;
+
+ # read file using readflex
+ my (@envidata) = readflex( $enviname, $flexhdr );
+ if (2==@envidata) {
+ ($filehdr,$envi) = @envidata;
+ $envihdr->{imbedded_header} = $filehdr;
+ } else {
+ ($envi) = @envidata;
+ }
+
+ # attach ENVI hdr to piddle
+ $envi->sethdr($envihdr);
+
+ # handle ignore values by mapping to BAD
+ if ( exists $envihdr->{data_ignore_value} ) {
+ $envi->inplace->badflag; # set badflag for image
+ $envi->inplace->setvaltobad($envihdr->{data_ignore_value});
+ }
+
+ # return data and optionally header if requested
+ return wantarray ? ($envi, $envihdr) : $envi;
+}
+
+if ($run_envi_main) {
+ my ($data,$hdr) = readenvi('envi-data');
+ print "Got " . $data->dims . " of data\n";
+}
+
+1;
diff --git a/IO/FITS/FITS.pm b/IO/FITS/FITS.pm
new file mode 100644
index 0000000..78d29b1
--- /dev/null
+++ b/IO/FITS/FITS.pm
@@ -0,0 +1,2862 @@
+=head1 NAME
+
+PDL::IO::FITS -- Simple FITS support for PDL
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::IO::FITS;
+
+ $a = rfits('foo.fits'); # read a FITS file
+ $a->wfits('bar.fits'); # write a FITS file
+
+=head1 DESCRIPTION
+
+This module provides basic FITS support for PDL, in the sense of
+reading and writing whole FITS files. (For more complex operations,
+such as prefiltering rows out of tables or performing operations on
+the FITS file in-place on disk), you can use the Astro::FITS::CFITSIO
+module that is available on CPAN.
+
+Basic FITS image files are supported, along with BINTABLE and IMAGE extensions.
+ASCII Table support is planned, as are the HEASARC bintable extensions that
+are recommended in the 1999 FITS standard.
+
+Table support is based on hashes and named columns, rather than the
+less convenient (but slightly more congruent) technique of perl lists
+of numbered columns.
+
+The principle interface routines are C<rfits> and C<wfits>, for
+reading and writing respectively. FITS headers are returned as perl
+hashes or (if the module is present) Astro::FITS::Header objects that
+are tied to perl hashes. Astro::FITS::Header objects provide
+convenient access through the tied hash interface, but also allow you
+to control the card structure in more detail using a separate method
+interface; see the L<Astro::FITS::Header|Astro::FITS::Header>
+documentation for details.
+
+=head1 AUTHOR
+
+Copyright (C) Karl Glazebrook, Craig DeForest, and Doug Burke, 1997-2010.
+There is no warranty. You are allowed to redistribute and/or modify
+this software under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be pasted into in this file.
+
+=head1 FUNCTIONS
+
+=cut
+
+use strict;
+
+BEGIN {
+
+ package PDL::IO::FITS;
+
+ $PDL::IO::FITS::VERSION = 0.92; # Will be 1.0 when ascii table read/write works.
+
+ our @EXPORT_OK = qw( rfits rfitshdr wfits );
+ our %EXPORT_TAGS = (Func=>[@EXPORT_OK]);
+ our @ISA = ('PDL::Exporter');
+
+ use PDL::Core;
+ use PDL::Config;
+ use PDL::IO::Misc;
+ use PDL::Exporter;
+ use PDL::Primitive;
+ use PDL::Types;
+ use PDL::Options;
+ use PDL::Bad;
+# use PDL::NiceSlice;
+ use Carp;
+ use strict;
+
+ ##############################
+ #
+ # Check if there's Astro::FITS::Header support, and set flag.
+ # Kludgy but it only has to run once, on first load. --CED
+ #
+ eval "use Astro::FITS::Header;";
+ $PDL::Astro_FITS_Header = (defined $Astro::FITS::Header::VERSION);
+ if($PDL::Astro_FITS_Header) {
+ my($a) = $Astro::FITS::Header::VERSION;
+ $a =~ s/[^0-9\.].*//;
+ $PDL::Astro_FITS_Header = 0 if($a < 1.12);
+ }
+
+ unless($PDL::Astro_FITS_Header) {
+ unless($ENV{"PDL_FITS_LEGACY"} || $PDL::Config{FITS_LEGACY}) {
+ print(STDERR "\n\nWARNING: Can't find the Astro::FITS::Header module, limiting FITS support.\n\n PDL will use the deprecated legacy perl hash handling code but will not\n properly support tables, FITS extensions, or COMMENT cards. You really\n ought to install the Astro::FITS::Header module, available from\n 'http://www.cpan.org'. (You can also get rid of this message by setting\n the environment variable 'PDL_FITS_LEGACY' or the global PDL config value (in perldl.conf)\n \$ [...]
+ }
+ }
+}
+
+package PDL::IO::FITS;
+
+## declare subroutines
+
+sub _wfits_nullhdu ($);
+sub _wfits_table ($$$);
+
+=head2 rfits()
+
+=for ref
+
+Simple piddle FITS reader.
+
+=for example
+
+ $pdl = rfits('file.fits'); # Read a simple FITS image
+
+Suffix magic:
+
+ $pdl = rfits('file.fits.gz'); # Read a file with gunzip(1)
+ $pdl = rfits('file.fits.Z'); # Read a file with uncompress(1)
+
+ $pdl = rfits('file.fits[2]'); # Read 2nd extension
+ $pdl = rfits('file.fits.gz[3]'); # Read 3rd extension
+ @pdls = rfits('file.fits'); # Read primary data and extensions
+
+ $hdr = rfits('file.fits',{data=>0}); # Options hash changes behavior
+
+In list context, C<rfits> reads the primary image and all possible
+extensions, returning them in the same order that they occurred in the
+file -- except that, by default, the primary HDU is skipped if it
+contains no data. In scalar context, the default is to read the first
+HDU that contains data. One can read other HDU's by using the [n]
+syntax. Using the [0] syntax forces a read of the first HDU,
+regardless of whether it contains data or no. Currently recognized
+extensions are IMAGE and BINTABLE. (See the addendum on EXTENSIONS
+for details).
+
+C<rfits> accepts several options that may be passed in as a hash ref
+if desired:
+
+=over 3
+
+=item bscale (default=1)
+
+Determines whether the data are linearly scaled using the BSCALE/BZERO keywords
+in the FITS header. To read in the exact data values in the file, set this
+to 0.
+
+=item data (default=1)
+
+Determines whether to read the data, or just the header. If you set this to
+0, you will get back the FITS header rather than the data themselves. (Note
+that the header is normally returned as the C<hdr> field of the returned PDL;
+this causes it to be returned as a hash ref directly.)
+
+=item hdrcpy (default=0)
+
+Determines whether the L<hdrcpy|PDL::Core/hdrcpy> flag is set in the returned
+PDL. Setting the flag will cause an explicit deep copy of the header whenever
+you use the returned PDL in an arithmetic or slicing operation. That is useful
+in many circumstances but also causes a hit in speed. When two or more PDLs
+with hdrcpy set are used in an expression, the result gets the header of the
+first PDL in the expression. See L<hdrcpy|PDL::Core/hdrcpy> for an example.
+
+=item expand (default=1)
+
+Determines whether auto-expansion of tile-compressed images should happen.
+Tile-compressed images are transmitted as binary tables with particular
+fields ("ZIMAGE") set. Leaving this alone does what you want most of the
+time, unpacking such images transparently and returning the data and header
+as if they were part of a normal IMAGE extension. Setting "expand" to 0
+delivers the binary table, rather than unpacking it into an image.
+
+=item afh (default=1)
+
+By default rfits uses Astro::FITS::Header tied-hash objects to contain
+the FITS header information. This permits explicit control over FITS
+card information, and conforms well with the FITS specification. But
+Astro::FITS::Header objects are about 40-60x more memory intensive
+than comparable perl hashes, and also use ~10x more CPU to manage.
+For jobs where header processing performance is important (e.g. reading
+just the headers of 1,000 FITS files), set afh to 0 to use the legacy parser
+and get a large boost in speed.
+
+=back
+
+FITS image headers are stored in the output PDL and can be retrieved
+with L<hdr|PDL::Core/hdr> or L<gethdr|PDL::Core/gethdr>. The
+L<hdrcpy|PDL::Core/hdrcpy> flag of the PDL is set so that the header
+is copied to derived piddles by default. (This is inefficient if you
+are planning to do lots of small operations on the data; clear
+the flag with "->hcpy(0)" or via the options hash if that's the case.)
+
+The header is a hash whose keys are the keywords in the FITS header.
+If you have the "Astro::FITS::Header" module installed, the header is
+actually a tied hash to a FITS header object, which can give you
+more control over card order, comment fields, and variable types.
+(see L<Astro::FITS::Header> for details).
+
+The header keywords are converted to I<uppercase> per the FITS
+standard. Access is case-insensitive on the perl side, provided that
+Astro::FITS::Header is installed.
+
+If Astro::FITS::Header is not installed, then a built-in legacy parser
+is used to generate the header hash. Keyword-associated comments in
+the headers are stored under the hash key
+C<< <keyword>_COMMENT> >>. All HISTORY cards in the header are
+collected into a single multiline string stored in the C<HISTORY> key.
+All COMMENT cards are similarly collected under the C<COMMENT> key.
+
+=head3 BSCALE/BZERO
+
+If the BSCALE and/or BZERO keywords are set, they are applied to the
+image before it is returned. The returned PDL is promoted as
+necessary to contain the multiplied values, and the BSCALE and BZERO
+keywords are deleted from the header for clarity. If you don't want
+this type of processing, set 'bscale=>0' in the options hash.
+
+=head3 EXTENSIONS
+
+Sometimes a FITS file contains only extensions and a stub header in
+the first header/data unit ("primary HDU"). In scalar context, you
+normally only get back the primary HDU -- but in this special case,
+you get back the first extension HDU. You can force a read of the
+primary HDU by adding a '[0]' suffix to the file name.
+
+=head3 BINTABLE EXTENSIONS
+
+Binary tables are handled. Currently only the following PDL
+datatypes are supported: byte, short, ushort, long, float, and
+double. At present ushort() data is written as a long rather than
+as a short with TSCAL/ZERO; this may change.
+
+The return value for a binary table is a hash ref containing the names
+of the columns in the table (in UPPER CASE as per the FITS standard).
+Each element of the hash contains a PDL (for numerical values) or a
+perl list (for string values). The PDL's 0th dimension runs across
+rows; the 1st dimension runs across the repeat index within the row
+(for rows with more than one value). (Note that this is different from
+standard threading order - but it allows Least Surprise to work when
+adding more complicated objects such as collections of numbers (via
+the repeat count) or variable length arrays.)
+
+Thus, if your table contains a column named C<FOO> with type C<5D>,
+the expression
+
+ $a->{FOO}->((2))
+
+returns a 5-element double-precision PDL containing the values of FOO
+from the third row of the table.
+
+The header of the table itself is parsed as with a normal FITS HDU,
+and is returned in the element 'hdr' of the returned hash. You can
+use that to preserve the original column order or access the table at a low
+level, if you like.
+
+Scaling and zero-point adjustment are performed as with BSCALE/BZERO:
+the appropriate keywords are deleted from the as-returned header. To avoid
+this behavior, set 'bscale=>0' in the options hash.
+
+As appropriate, TSCAL/ZERO and TUNIT are copied into each column-PDL's
+header as BSCALE/BZERO and BUNIT.
+
+The main hash also contains the element 'tbl', which is set
+to 'binary' to distinguish it from an ASCII table.
+
+Because different columns in the table might have identical names in a
+FITS file, the binary table reader practices collision avoidance. If
+you have multiple columns named "FOO", then the first one encountered
+(numerically) gets the name "FOO", the next one gets "FOO_1", and the
+next "FOO_2", etc. The appropriate TTYPEn fields in the header are
+changed to match the renamed column fields.
+
+Columns with no name are assigned the name "COL_<n>", where <n> starts
+at 1 and increments for each no-name column found.
+
+Variable-length arrays are supported for reading. They are unpacked
+into PDLs that appear exactly the same as the output for fixed-length
+rows, except that each row is padded to the maximum length given
+in the extra characters -- e.g. a row with TFORM of 1PB(300) will
+yield an NAXIS2x300 output field in the final hash. The padding
+uses the TNULL<n> keyword for the column, or 0 if TNULL<n> is not
+present. The output hash also gets an additional field, "len_<name>",
+that contains the number of elements in each table row.
+
+=head3 TILE-COMPRESSED IMAGES
+
+CFITSIO and several large projects (including NASA's Solar Dynamics
+Observatory) now support an unofficial extension to FITS that stores
+images as a collection of individually compressed tiles within a
+BINTABLE extension. These images are automagically uncompressed by
+default, and delivered as if they were normal image files. You can
+override this behavior by supplying the "expand" key in the options hash.
+
+Currently, only Rice compression is supported, though there is a framework
+in place for adding other compression schemes.
+
+=for bad
+
+=head3 BAD VALUE HANDLING
+
+If a FITS file contains the C<BLANK> keyword (and has C<BITPIX E<gt> 0>),
+the piddle will have its bad flag set, and those elements which equal the
+C<BLANK> value will be set bad. For C<BITPIX E<lt> 0>, any NaN's are
+converted to bad (if necessary).
+
+
+=head2 rfitshdr()
+
+=for ref
+
+Read only the header of a FITS file or an extension within it.
+
+This is syntactic sugar for the C<data=E<gt>0> option to L<rfits|/rfits()>.
+
+See L<rfits|/rfits()> for details on header handling. rfitshdr() runs
+the same code to read the header, but returns it rather than
+reading in a data structure as well.
+
+=cut
+
+our $rfits_options = new PDL::Options( { bscale=>1, data=>1, hdrcpy=>0, expand=>1, afh=>1 } );
+
+sub PDL::rfitshdr {
+ my $class = shift;
+ my $file = shift;
+ my $u_opt = ifhref(shift);
+ $u_opt->{data} = 0;
+ PDL::rfits($class,$file,$u_opt);
+}
+
+sub PDL::rfits {
+
+ my $class = shift;
+
+ barf 'Usage: $a = rfits($file) -or- $a = PDL->rfits($file)' if (@_ < 1 || @_ > 2);
+
+ my $file = shift;
+
+ my $u_opt = ifhref(shift);
+ my $opt = $rfits_options->options($u_opt);
+
+ my($nbytes, $line, $name, $rest, $size, $i, $bscale, $bzero, $extnum);
+
+ $nbytes = 0;
+
+ # Modification 02/04/2005 - JB. Earlier version stripped the extension
+ # indicator which cancelled the check for empty primary data array at the end.
+ my $explicit_extension = ($file =~ m/\[\d+\]$/ ? 1 : 0);
+ $extnum = ( ($file =~ s/\[(\d+)\]$//) ? $1 : 0 );
+
+ $file = "gunzip -c $file |" if $file =~ /\.gz$/; # Handle compression
+ $file = "uncompress -c $file |" if $file =~ /\.Z$/;
+
+ my $fh = IO::File->new( $file )
+ or barf "FITS file $file not found";
+ binmode $fh;
+
+ my @extensions; # This accumulates the list in list context...
+ my $currentext=0;
+ my $pdl;
+
+ hdu:{do { # Runs over extensions, in list context
+ my $ext_type = 'IMAGE'; # Gets the type of XTENSION if one is detected.
+ my $foo={}; # To go in pdl
+ my @history=();
+ my @cards = ();
+
+ $pdl = $class->new;
+
+
+ # If $opt->{data} is false, then the reading routines leave the
+ # file alone, so the file pointer is left at the end of the last
+ # header. Skip over the unread data to the next extension...
+
+ if( wantarray and !$opt->{data} and @extensions) {
+ while( $fh->read($line,80) && ($line !~ /^XTENSION=/) && !$fh->eof() ) {
+ $fh->read($line,2880-80);
+ };
+
+ return @extensions
+ if($fh->eof());
+
+ } else {
+ my $ct = $fh->read($line,80);
+ barf "file $file is not in FITS-format:\n$line\n"
+ if( $nbytes==0 && ($line !~ /^SIMPLE = +T/));
+ last hdu if($fh->eof() || !$ct);
+ }
+
+ $nbytes = 80; # Number of bytes read from this extension (1 line so far)
+
+ if($line =~ /^XTENSION= \'(\w+)\s*\'/) {
+ $ext_type = $1;
+ } elsif( @extensions ) {
+
+ print "Warning: expected XTENSION, found '$line'. Exiting.\n"
+ if($PDL::verbose);
+ last hdu;
+ }
+
+ push(@cards,$line) if($PDL::Astro_FITS_Header);
+
+ #
+ # If we are in scalar context, skip to the desired extension
+ # number. [This implementation is really slow since we have
+ # to read the whole file. Someone Really Ought To rework it to
+ # read individual headers and skip forward an extension at a
+ # a time with seek() calls. ]
+ # --CD
+ #
+
+ if(!wantarray and $currentext != $extnum) {
+
+ skipper: while(1) {
+ # Move to next record
+ $nbytes += $fh->read($line,2880-80);
+ barf "Unexpected end of FITS file\n" if $fh->eof();
+ # Read start of next record
+ $nbytes += $fh->read($line,80);
+ barf "Unexpected end of FITS file\n" if $fh->eof();
+ # Check if we have found the new extension
+ # if not move on
+
+ $currentext++ if $line =~ /^XTENSION\= \'(\w+)\s*\'/;
+ if ($currentext == $extnum) {
+ $ext_type = $1;
+ last skipper;
+ }
+ }
+ } # End of skipping to desired extension
+
+ #
+ # Snarf up the found header, and parse it if Astro::FITS::Header
+ # does not exist.
+ #
+
+ if($PDL::Astro_FITS_Header and $opt->{afh}) {
+
+ ## Astro::FITS::Header parsing. Snarf lines to the END card,
+ ## and pass them to Astro::FITS::Header.
+
+ do {
+ $nbytes += $fh->read($line, 80);
+ push(@cards,$line);
+ } while(!$fh->eof() && $line !~ m/^END(\s|\000)/);
+
+ $nbytes += $fh->read(my $dummy, 2879 - ($nbytes-1)%2880);
+
+ my($hdr) = Astro::FITS::Header->new(Cards => \@cards);
+ my(%hdrhash);
+ tie %hdrhash,"Astro::FITS::Header",$hdr;
+ $foo = \%hdrhash;
+
+ } else {
+
+ ## Legacy (straight header-to-hash-ref) parsing.
+ ## Cheesy but fast.
+
+ hdr_legacy: { do {
+ no strict 'refs';
+ # skip if the first eight characters are ' '
+ # - as seen in headers from the DSS at STScI
+ if (substr($line,0,8) ne " " x 8) { # If non-blank
+
+ $name = (split(' ',substr($line,0,8)))[0];
+
+ $rest = substr($line,8);
+
+ if ($name =~ m/^HISTORY/) {
+ push @history, $rest;
+ } else {
+ $$foo{$name} = "";
+
+ $$foo{$name}=$1 if $rest =~ m|^= +([^\/\' ][^\/ ]*) *( +/(.*))?$| ;
+ $$foo{$name}=$1 if $rest =~ m|^= \'(.*)\' *( +/(.*))?$| ;
+ $$foo{COMMENT}{$name} = $3 if defined($3);
+ }
+ } # non-blank
+ last hdr_legacy if ((defined $name) && $name eq "END");
+ $nbytes += $fh->read($line, 80);
+ } while(!$fh->eof()); }
+
+ # Clean up HISTORY card
+ $$foo{"HISTORY"} = \@history if $#history >= 0;
+
+ # Step to end of header block in file
+ my $skip = 2879 - ($nbytes-1)%2880;
+ $fh->read(my $dummy, $skip) if $skip;
+ $nbytes += $skip;
+
+ } # End of legacy header parsing
+
+
+
+ ##############################
+ # Special case: if the file only contains
+ # extensions then read the first extension in scalar context,
+ # instead of the null zeroth extension.
+ #
+ if( !(defined $foo->{XTENSION}) # Primary header
+ and $foo->{NAXIS} == 0 # No data
+ and !wantarray # Scalar context
+ and !$explicit_extension # No HDU specifier
+ ) {
+ print "rfits: Skipping null primary HDU (use [0] to force read of primary)...\n"
+ if($PDL::verbose);
+ return PDL::rfits($class,$file.'[1]',$opt);
+ }
+
+
+ ##########
+ # If we don't want data, return the header from the HDU. Likewise,
+ # if NAXIS is 0 then there are no data, so return the header instead.
+ if( ! $opt->{data} || $foo->{NAXIS}==0 ) {
+ # If we're NOT reading data, then return the header instead of the
+ # image.
+
+ $pdl = $foo;
+
+ } else {
+
+ ##########
+ # Switch based on extension type to do the dirty work of reading
+ # the data. Handlers are listed in the _Extension patch-panel.
+
+ if (ref $PDL::IO::FITS::_Extension->{$ext_type} ) {
+
+ # Pass $pdl into the extension reader for easier use -- but
+ # it just gets overwritten (and disappears) if ignored.
+
+ $pdl = &{$PDL::IO::FITS::_Extension->{$ext_type}}($fh,$foo,$opt,$pdl);
+
+ } else {
+
+ print STDERR "rfits: Ignoring unknown extension '$ext_type'...\n"
+ if($PDL::verbose || $PDL::debug);
+
+ $pdl = undef;
+
+ }
+ }
+
+ #
+ # Note -- $pdl isn't necessarily a PDL. It's only a $pdl if
+ # the extension was an IMAGE.
+ #
+ push(@extensions,$pdl) if(wantarray);
+ $currentext++;
+
+ } while( wantarray && !$fh->eof() );} # Repeat if we are in list context
+
+ $fh->close;
+
+ if(wantarray) {
+ ## By default, ditch primary HDU placeholder
+ if( ref($extensions[0]) eq 'HASH' and
+ $extensions[0]->{SIMPLE} and
+ exists($extensions[0]->{NAXIS}) and
+ $extensions[0]->{NAXIS} == 0
+ ) {
+ shift @extensions;
+ }
+ # Return all the extensions
+ return @extensions;
+ }
+ return $pdl;
+}
+
+
+sub rfits { PDL->rfits(@_); }
+
+sub rfitshdr {
+ my($file,$opt) = shift;
+ $opt->{data} =0;
+ PDL->rfitshdr($file,$opt);
+}
+
+
+##############################
+#
+# FITS extensions patch-table links extension name to the supported reader.
+# IMAGE extensions are a special case that gets read just like a normal
+# FITS file.
+#
+
+$PDL::IO::FITS::_Extension = {
+ IMAGE => \&_rfits_image
+ , BINTABLE => \&_rfits_bintable
+ };
+
+
+
+##############################
+#
+# IMAGE extension -- this is also the default reader.
+our $type_table = {
+ 8=>$PDL_B,
+ 16=>$PDL_S,
+ 32=>$PDL_L,
+ -32=>$PDL_F,
+ -64=>$PDL_D
+};
+
+our $type_table_2 = {
+ 8=>byte,
+ 16=>short,
+ 32=>long,
+ -32=>float,
+ -64=>double
+};
+
+sub _rfits_image($$$$) {
+ print "Reading IMAGE data...\n" if($PDL::verbose);
+ my $fh = shift; # file handle to read from
+ my $foo = shift; # $foo contains the pre-read header
+ my $opt = shift; # $opt contains the option hash
+ my $pdl = shift; # $pdl contains a pre-blessed virgin PDL
+
+ # Setup piddle structure
+
+ if( defined($type_table->{0 + $foo->{"BITPIX"}}) ) {
+ $pdl->set_datatype( $type_table->{$foo->{"BITPIX"}} );
+ } else {
+ die("rfits: strange BITPIX value ".$foo->{"BITPIX"}." in header - I give up!\n");
+ }
+
+ my @dims; # Store the dimenions 1..N, compute total number of pixels
+ my $i = 1;
+ my $size = 1;
+
+##second part of the conditional guards against a poorly-written hdr.
+ while(defined( $$foo{"NAXIS$i"} ) && $i <= $$foo{"NAXIS"}) {
+ $size *= $$foo{"NAXIS$i"};
+ push @dims, $$foo{"NAXIS$i"} ; $i++;
+ }
+ $pdl->setdims([@dims]);
+
+ my $dref = $pdl->get_dataref();
+
+ print "BITPIX = ",$$foo{"BITPIX"}," size = $size pixels \n"
+ if $PDL::verbose;
+
+ # Slurp the FITS binary data
+
+ print "Reading ",$size*PDL::Core::howbig($pdl->get_datatype) , " bytes\n"
+ if $PDL::verbose;
+
+ # Read the data and pad to the next HDU
+ my $rdct = $size * PDL::Core::howbig($pdl->get_datatype);
+ $fh->read( $$dref, $rdct );
+ $fh->read( my $dummy, 2880 - (($rdct-1) % 2880) - 1 );
+ $pdl->upd_data();
+
+ if (!isbigendian() ) {
+ # Need to byte swap on little endian machines
+ bswap2($pdl) if $pdl->get_datatype == $PDL_S;
+ bswap4($pdl) if $pdl->get_datatype == $PDL_L ||
+ $pdl->get_datatype == $PDL_F;
+ bswap8($pdl) if $pdl->get_datatype == $PDL_D;
+ }
+
+ if(exists $opt->{bscale}) {
+ $pdl = treat_bscale($pdl, $foo);
+ }
+
+ # Header
+
+ $pdl->sethdr($foo);
+
+ $pdl->hdrcpy($opt->{hdrcpy});
+
+ return $pdl;
+}
+
+sub treat_bscale($$){
+ my $pdl = shift;
+ my $foo = shift;
+
+ print "treating bscale...\n" if($PDL::debug);
+
+ if ( $PDL::Bad::Status ) {
+ # do we have bad values? - needs to be done before BSCALE/BZERO
+ # (at least for integers)
+ #
+ if ( $$foo{BITPIX} > 0 and exists $$foo{BLANK} ) {
+ # integer, so bad value == BLANK keyword
+ my $blank = $foo->{BLANK};
+ # do we have to do any conversion?
+ if ( $blank == $pdl->badvalue() ) {
+ $pdl->badflag(1);
+ } else {
+ # we change all BLANK values to the current bad value
+ # (would not be needed with a per-piddle bad value)
+ $pdl->inplace->setvaltobad( $blank );
+ }
+ } elsif ( $foo->{BITPIX} < 0 ) {
+ # bad values are stored as NaN's in FITS
+ # let setnanbad decide if we need to change anything
+ $pdl->inplace->setnantobad();
+ }
+ print "FITS file may contain bad values.\n"
+ if $pdl->badflag() and $PDL::verbose;
+ } # if: PDL::Bad::Status
+
+ my ($bscale, $bzero);
+ $bscale = $$foo{"BSCALE"}; $bzero = $$foo{"BZERO"};
+ print "BSCALE = $bscale && BZERO = $bzero\n" if $PDL::verbose;
+ $bscale = 1 if (!defined($bscale) || $bscale eq "");
+ $bzero = 0 if (!defined($bzero) || $bzero eq "");
+
+ # Be clever and work out the final datatype before eating
+ # memory
+ #
+ # ensure we pick an element that is not equal to the bad value
+ # (is this OTT?)
+ my $tmp;
+
+ if ( $pdl->badflag() == 0 ) {
+ $tmp = $pdl->flat()->slice("0:0");
+ } elsif ( $pdl->ngood > 0 ) {
+ my $index = which( $pdl->flat()->isbad() == 0 )->at(0);
+ $tmp = $pdl->flat()->slice("${index}:${index}");
+ } else {
+ # all bad, so ignore the type conversion and return
+ # -- too lazy to include this check in the code below,
+ # so just copy the header clean up stuff
+ print "All elements are bad.\n" if $PDL::verbose;
+
+ delete $$foo{"BSCALE"}; delete $$foo{"BZERO"};
+ $tmp = $pdl;
+ } #end of BSCALE section (whew!)
+
+
+ $tmp = $tmp*$bscale if $bscale != 1; # Dummy run on one element
+ $tmp = $tmp+$bzero if $bzero != 0;
+
+ $pdl = $pdl->convert($tmp->type) if $tmp->get_datatype != $pdl->get_datatype;
+
+ $pdl *= $bscale if $bscale != 1;
+ $pdl += $bzero if $bzero != 0;
+
+ delete $$foo{"BSCALE"}; delete $$foo{"BZERO"};
+ return $pdl;
+}
+
+
+##########
+#
+# bintable_handlers -- helper table for bintable_row, below.
+#
+# Each element of the table is named by the appropriate type letter
+# from the FITS specification. The value is a list containing the
+# reading and writing methods.
+#
+# This probably ought to be a separate class, but instead it's a tawdry
+# imitation. Too bad -- except that the ersatz really does run faster than
+# genuine.
+#
+# 0: either a data type or a constructor.
+# 1: either a length per element or a read method.
+# 2: either a length per element or a write method.
+# 3: 'finish' contains finishing-up code or a byte-count to swap.
+#
+# Main bintable type handler table.
+# Elements: (constructor or type, reader or nbytes, writer or nbytes,
+# finisher or nbytes). The finisher should convert the internal reading
+# format into the final output format, e.g. by swapping (which is done
+# automatically in the basic case). Output has row in the 0th dim.
+#
+# If present, the constructor should
+# accept ($rowlen $extra, $nrows, $$size), where $rowlen is the repeat
+# specifier in the TFORM field, $extra is the extra characters if any
+# (for added flavor later, if desired), and $nrows is the number of rows in
+# the table. $$size points to a scalar value that should be incremented by the
+# size (in bytes) of a single row of the data, for accounting purposes.
+#
+# If a read method is specified, it should accept:
+# ($thing, $rownum, $strptr, $rpt, $extra)
+# where $rpt is the repeat count and $extra is the extra characters in the
+# specifier; and it should cut the used characters off the front of the string.
+#
+# If a writer is specified it should accept:
+# ($thing, $row, $rpt, $extra)
+# and return the generated binary string.
+#
+# The finisher just takes the data itself. It should:
+# * Byteswap
+# * Condition the data to final dimensional form (if necessary)
+# * Apply TSCAL/TZERO keywords (as necessary)
+#
+# The magic numbers in the table (1,2,4,8, etc.) are kludgey -- they break
+# the isolation of PDL size and local code -- but they are a part of the FITS
+# standard. The code will break anyway (damn) on machines that have other
+# sizes for these datatypes.
+#
+
+$PDL::IO::FITS_bintable_handlers = {
+ 'X' => [ byte # Packed bit field
+ , sub {
+ my( $pdl, $row, $strptr ) = @_; # (ignore repeat and extra)
+ my $n = $pdl->dim(0);
+ my $s = unpack( "B".$n, substr(${$strptr}, 0, int(($n+7)/8),''));
+ $s =~ tr/[01]/[\000\001]/;
+ substr( ${$pdl->get_dataref}, $n * $row, length($s)) = $s;
+ }
+ , sub {
+ my( $pdl, $row ) = @_; # Ignore extra and rpt
+ my $n = $pdl->dim(0);
+ my $p2 = byte(($pdl->slice("($row)") != 0));
+ my $s = ${$p2->get_dataref};
+ $s =~ tr/[\000\001]/[01]/;
+ pack( "B".$pdl->dim(0), $s );
+ }
+ , 1
+ ]
+ ,'A' => [ sub { # constructor # String - handle as perl list
+ my($rowlen, $extra, $nrows, $szptr) = @_;
+ my($i, at a);
+ $$szptr += $rowlen;
+ for $i(1..$nrows) { push(@a,' 'x$rowlen); }
+ \@a;
+ }
+ , sub { # reader
+ my( $list, $row, $strptr, $rpt ) = @_;
+ $list->[$row] = substr(${$strptr},0,$rpt,'');
+ }
+ , sub { # writer
+ my($strs, $row, $rpt ) = @_;
+ my $s = substr($strs->[$row],0,$rpt);
+ $s . ' 'x($rpt - length $s);
+ }
+ , undef # no finisher needed
+ ]
+ ,'B' => [ byte, 1, 1, 1 ] # byte
+ ,'L' => [ byte, 1, 1, 1 ] # logical - treat as byte
+ ,'I' => [ short, 2, 2, 2 ] # short (no unsigned shorts?)
+ ,'J' => [ long, 4, 4, 4 ] # long
+ ,'E' => [ float, 4, 4, 4 ] # single-precision
+ ,'D' => [ double, 8, 8, 8 ] # double-precision
+ ,'C' => [ sub { _nucomplx(float, eval '@_') }, sub { _rdcomplx(float, eval '@_') },
+ sub { _wrcomplx(float, eval '@_') }, sub { _fncomplx(float, eval '@_') }
+ ]
+ ,'M' => [ sub { _nucomplx(double, eval '@_') }, sub { _rdcomplx(double, eval '@_') },
+ sub { _wrcomplx(double, eval '@_') }, sub { _fncomplx(double, eval '@_') }
+ ]
+ ,'PB' => [ sub { _nuP(byte, eval '@_') }, sub { _rdP(byte, eval '@_') },
+ sub { _wrP(byte, eval '@_') }, sub { _fnP(byte, eval '@_') }
+ ]
+ ,'PL' => [ sub { _nuP(byte, eval '@_') }, sub { _rdP(byte, eval '@_') },
+ sub { _wrP(byte, eval '@_') }, sub { _fnP(byte, eval '@_') }
+ ]
+ ,'PI' => [ sub { _nuP(short, eval '@_') }, sub { _rdP(short, eval '@_') },
+ sub { _wrP(short, eval '@_') }, sub { _fnP(short, eval '@_') }
+ ]
+ ,'PJ' => [ sub { _nuP(long, eval '@_') }, sub { _rdP(long, eval '@_') },
+ sub { _wrP(long, eval '@_') }, sub { _fnP(long, eval '@_') }
+ ]
+ ,'PE' => [ sub { _nuP(float, eval '@_') }, sub { _rdP(float, eval '@_') },
+ sub { _wrP(float, eval '@_') }, sub { _fnP(float, eval '@_') }
+ ]
+ ,'PD' => [ sub { _nuP(double, eval '@_') }, sub { _rdP(double, eval '@_') },
+ sub { _wrP(double, eval '@_') }, sub { _fnP(double, eval '@_') }
+ ]
+};
+
+
+##############################
+# Helpers for complex numbers (construct/read/write/finish)
+sub _nucomplx { # complex-number constructor
+ my($type, $rowlen, $extra, $nrows, $szptr) = @_;
+ $szptr += PDL::Core::howbig($type) * $nrows * 2;
+ return PDL->new_from_specification($type,2,$rowlen,$nrows);
+}
+sub _rdcomplx { # complex-number reader
+ my( $type, $pdl, $row, $strptr, $rpt ) = @_; # ignore extra
+ my $s = $pdl->get_dataref;
+ my $rlen = 2 * PDL::Core::howbig($type) * $rpt;
+ substr($$s, $row*$rlen, $rlen) = substr($strptr, 0, $rlen, '');
+}
+sub _wrcomplx { # complex-number writer
+ my( $type, $pdl, $row, $rpt ) = @_; # ignore extra
+ my $rlen = 2 * PDL::Core::howbig($type) * $rpt;
+ substr( ${$pdl->get_dataref}, $rlen * $row, $rlen );
+}
+sub _fncomplx { # complex-number finisher-upper
+ my( $type, $pdl, $n, $hdr, $opt) = shift;
+ eval 'bswap'.(PDL::Core::howbig($type)).'($pdl)';
+ print STDERR "Ignoring poorly-defined TSCAL/TZERO for complex data in col. $n (".$hdr->{"TTYPE$n"}.").\n"
+ if( length($hdr->{"TSCAL$n"}) or length($hdr->{"TZERO$n"}) );
+ return $pdl->reorder(2,1,0);
+}
+
+##############################
+# Helpers for variable-length array types (construct/read/write/finish)
+# These look just like the complex-number case, except that they use $extra to determine the
+# size of the 0 dimension.
+sub _nuP {
+ my( $type, $rowlen, $extra, $nrows, $szptr, $hdr, $i, $tbl ) = @_;
+ $extra =~ s/\((.*)\)/$1/; # strip parens from $extra in-place
+ $$szptr += 8;
+
+ if($rowlen != 1) {
+ die("rfits: variable-length record has a repeat count that isn't unity! (got $rowlen); I give up.");
+ }
+
+ # declare the PDL. Fill it with the blank value or (failing that) 0.
+ # Since P repeat count is required to be 0 or 1, we don't need an additional dimension for the
+ # repeat count -- the variable-length rows take that role.
+ my $pdl = PDL->new_from_specification($type, $extra, $nrows);
+ $pdl .= ($hdr->{"TNULL$i"} || 0);
+
+ my $lenpdl = zeroes(long, $nrows);
+ $tbl->{"len_".$hdr->{"TTYPE$i"}} = $lenpdl;
+
+ return $pdl;
+}
+sub _rdP {
+ my( $type, $pdl, $row, $strptr, $rpt, $extra, $heap_ptr, $tbl, $i ) = @_;
+ $extra =~ s/\((.*)\)/$1/;
+ my $s = $pdl->get_dataref;
+
+ # Read current offset and length
+ my $oflen = pdl(long,0,0);
+ my $ofs = $oflen->get_dataref;
+ substr($$ofs,0,8) = substr($$strptr, 0, 8, '');
+ $oflen->upd_data;
+ bswap4($oflen);
+
+ # Now get 'em
+ my $rlen = $extra * PDL::Core::howbig($type); # rpt should be unity, otherwise we'd have to multiply it in.
+ my $readlen = $oflen->at(0) * PDL::Core::howbig($type);
+
+ # Store the length of this row in the header field.
+ $tbl->{"len_".$tbl->{hdr}->{"TTYPE$i"}}->dice_axis(0,$row) .= $oflen->at(0);
+
+ print "_rdP: pdl is ",join("x",$pdl->dims),"; reading row $row - readlen is $readlen\n"
+ if($PDL::debug);
+
+ # Copy the data into the output PDL.
+ my $of = $oflen->at(1);
+ substr($$s, $row*$rlen, $readlen) = substr($$heap_ptr, $of, $readlen);
+ $pdl->upd_data;
+}
+
+sub _wrP {
+ die "This code path should never execute - you are trying to write a variable-length array via direct handler, which is wrong. Check the code path in PDL::wfits.\n";
+}
+
+sub _fnP {
+ my( $type, $pdl, $n, $hdr, $opt ) = @_;
+ my $post = PDL::Core::howbig($type);
+ unless( isbigendian() ) {
+ if( $post == 2 ) { bswap2($pdl); }
+ elsif( $post == 4 ) { bswap4($pdl); }
+ elsif( $post == 8 ) { bswap8($pdl); }
+ elsif( $post != 1 ) {
+ print STDERR "Unknown swapsize $post! This is a bug. You (may) lose..\n";
+ }
+ }
+
+ my $tzero = defined($hdr->{"TZERO$n"}) ? $hdr->{"TZERO$n"} : 0.0;
+ my $tscal = defined($hdr->{"TSCAL$n"}) ? $hdr->{"TSCAL$n"} : 1.0;
+ my $valid_tzero = ($tzero != 0.0);
+ my $valid_tscal = ($tscal != 1.0);
+ if( length($hdr->{"TZERO$n"}) or length($hdr->{"TSCAL$n"})) {
+ print STDERR "Ignoring TSCAL/TZERO keywords for binary table array column - sorry, my mind is blown!\n";
+ }
+ return $pdl->mv(-1,0);
+}
+
+##############################
+#
+# _rfits_bintable -- snarf up a binary table, returning the named columns
+# in a hash ref, each element of which is a PDL or list ref according to the
+# header.
+#
+
+sub _rfits_bintable ($$$$) {
+ my $fh = shift;
+ my $hdr = shift;
+ my $opt = shift;
+ ##shift; ### (ignore $pdl argument)
+
+ print STDERR "Warning: BINTABLE extension should have BITPIX=8, found ".$hdr->{BITPIX}.". Winging it...\n" unless($hdr->{BITPIX} == 8);
+
+ ### Allocate the main table hash
+ my $tbl = {}; # Table is indexed by name
+ $tbl->{hdr} = $hdr;
+ $tbl->{tbl} = 'binary';
+
+ my $tmp = []; # Temporary space is indexed by col. no.
+
+
+ ### Allocate all the columns of the table, checking for consistency
+ ### and name duplication.
+
+ barf "Binary extension has no fields (TFIELDS=0)" unless($hdr->{TFIELDS});
+ my $rowlen = 0;
+
+ for my $i(1..$hdr->{TFIELDS}) {
+ my $iter;
+ my $name = $tmp->[$i]->{name} = $hdr->{"TTYPE$i"} || "COL";
+
+ ### Allocate some temp space for dealing with this column
+ my $tmpcol = $tmp->[$i] = {};
+
+ ### Check for duplicate name and change accordingly...
+ while( defined( $tbl->{ $name } ) || ($name eq "COL") ) {
+ $iter++;
+ $name = ($hdr->{"TTYPE$i"} )."_$iter";
+ }
+
+ # (Check avoids scrozzling comment fields unnecessarily)
+ $hdr->{"TTYPE$i"} = $name unless($hdr->{"TTYPE$i"} eq $name);
+ $tmpcol->{name} = $name;
+
+ if( ($hdr->{"TFORM$i"}) =~ m/(\d*)(P?.)(.*)/ ) {
+ ($tmpcol->{rpt}, $tmpcol->{type}, $tmpcol->{extra}) = ($1,$2,$3);
+ # added by DJB 03.18/04 - works for my data file but is it correct?
+ $tmpcol->{rpt} ||= 1;
+ } else {
+ barf "Couldn't parse BINTABLE form '"
+ . $hdr->{"TFORM$i"}
+ . "' for column $i ("
+ . $hdr->{"TTYPE$i"}
+ . ")\n" if($hdr->{"TFORM$i"});
+ barf "BINTABLE header is missing a crucial field, TFORM$i. I give up.\n";
+ }
+
+ # "A bit array consists of an integral number of bytes with trailing bits zero"
+ $tmpcol->{rpt} = PDL::ceil($tmpcol->{rpt}/8) if ($tmpcol->{type} eq 'X');
+
+ $tmpcol->{handler} = # sic - assignment
+ $PDL::IO::FITS_bintable_handlers->{ $tmpcol->{type} }
+ or
+ barf "Unknown type ".$hdr->{"TFORM$i"}." in BINTABLE column $i "."("
+ . $hdr->{"TTYPE$i"}
+ . ")\n That invalidates the byte count, so I give up.\n" ;
+
+
+ ### Allocate the actual data space and increment the row length
+
+ my $foo = $tmpcol->{handler}->[0];
+ if( ref ($foo) eq 'CODE' ) {
+ $tmpcol->{data} = $tbl->{$name} =
+ &{$foo}( $tmpcol->{rpt}
+ , $tmpcol->{extra}
+ , $hdr->{NAXIS2}
+ , \$rowlen
+ , $hdr # hdr and column number are passed in, in case extra info needs to be gleaned.
+ , $i
+ , $tbl
+ );
+ } else {
+ $tmpcol->{data} = $tbl->{$name} =
+ PDL->new_from_specification(
+ $foo
+ , $tmpcol->{rpt},
+ , $hdr->{NAXIS2} || 1
+ );
+
+ $rowlen += PDL::Core::howbig($foo) * $tmpcol->{rpt};
+ }
+
+ print "Prefrobnicated col. $i "."(".$hdr->{"TTYPE$i"}.")\ttype is ".$hdr->{"TFORM$i"}."\t length is now $rowlen\n" if($PDL::debug);
+
+
+ } ### End of prefrobnication loop...
+
+
+ barf "Calculated row length is $rowlen, hdr claims ".$hdr->{NAXIS1}
+ . ". Giving up. (Set \$PDL::debug for more detailed info)\n"
+ if($rowlen != $hdr->{NAXIS1});
+
+ ### Snarf up the whole extension, and pad to 2880 bytes...
+ my ($rawtable, $heap, $n1, $n2);
+
+ # n1 gets number of bytes in table plus gap
+ $n1 = $hdr->{NAXIS1} * $hdr->{NAXIS2};
+ if($hdr->{THEAP}) {
+ if($hdr->{THEAP} < $n1) {
+ die("Inconsistent THEAP keyword in binary table\n");
+ } else {
+ $n1 = $hdr->{THEAP};
+ }
+ }
+
+ # n2 gets number of bytes in heap (PCOUNT - gap).
+ $n2 = $hdr->{PCOUNT} + ($hdr->{THEAP} ? ($hdr->{NAXIS1}*$hdr->{NAXIS2} - $hdr->{THEAP}) : 0);
+ $n2 = ($n1+$n2-1)+2880 - (($n1+$n2-1) % 2880) - $n1;
+
+ print "Reading $n1 bytes of table data and $n2 bytes of heap data....\n"
+ if($PDL::verbose);
+ $fh->read($rawtable, $n1);
+
+ if($n2) {
+ $fh->read($heap, $n2)
+ } else {
+ $heap = which(pdl(0)); # empty PDL
+ }
+
+ ### Frobnicate the rows, one at a time.
+ for my $row(0..$hdr->{NAXIS2}-1) {
+ my $prelen = length($rawtable);
+ for my $i(1..$hdr->{TFIELDS}) {
+ my $tmpcol = $tmp->[$i];
+ my $reader = $tmpcol->{handler}->[1];
+ if(ref $reader eq 'CODE') {
+ &{$reader}( $tmpcol->{data}
+ , $row
+ , \$rawtable
+ , $tmpcol->{rpt}
+ , $tmpcol->{extra}
+ , \$heap
+ , $tbl
+ , $i
+ );
+ } elsif(ref $tmpcol->{data} eq 'PDL') {
+ my $rlen = $reader * $tmpcol->{rpt};
+
+ substr( ${$tmpcol->{data}->get_dataref()}, $rlen * $row, $rlen ) =
+ substr( $rawtable, 0, $rlen, '');
+ $tmpcol->{data}->upd_data;
+
+ } else {
+ die ("rfits: Bug detected: inconsistent types in BINTABLE reader\n");
+ }
+
+ } # End of TFIELDS loop
+
+ if(length($rawtable) ne $prelen - $hdr->{NAXIS1}) {
+ die "rfits BINTABLE: Something got screwed up -- expected a length of $prelen - $hdr->{NAXIS1}, got ".length($rawtable).". Giving up.\n";
+ }
+ } # End of NAXIS2 loop
+
+ #
+ # Note: the above code tickles a bug in most versions of the emacs
+ # prettyprinter. The following "for my $i..." should be indented
+ # two spaces.
+ #
+
+ ### Postfrobnicate the columns.
+ for my $i(1..$hdr->{TFIELDS}) { # Postfrobnication loop
+ my $tmpcol = $tmp->[$i];
+ my $post = $tmpcol->{handler}->[3];
+
+ if(ref $post eq 'CODE') {
+ # Do postprocessing on all special types
+
+ $tbl->{$tmpcol->{name}} = &$post($tmpcol->{data}, $i, $hdr, $opt);
+
+ } elsif( (ref ($tmpcol->{data})) eq 'PDL' ) {
+ # Do standard PDL-type postprocessing
+
+ ## Is this call to upd_data necessary?
+ ## I think not. (reinstate if there are bugs)
+ # $tmpcol->{data}->upd_data;
+
+
+ # Do swapping as necessary
+ unless( isbigendian() ) {
+ if( $post == 2 ) { bswap2($tmpcol->{data}); }
+ elsif( $post == 4 ) { bswap4($tmpcol->{data}); }
+ elsif( $post == 8 ) { bswap8($tmpcol->{data}); }
+ elsif( $post != 1 ) {
+ print STDERR "Unknown swapsize $post for column $i ("
+ . $tmpcol->{name} . ")! This is a bug. Winging it.\n";
+ }
+ }
+
+ # Apply scaling and badval keys, which are illegal for A, L, and X
+ # types but legal for anyone else. (A shouldn't be here, L and X
+ # might be)
+
+ if($opt->{bscale}) {
+ my $tzero = defined($hdr->{"TZERO$i"}) ? $hdr->{"TZERO$i"} : 0.0;
+ my $tscal = defined($hdr->{"TSCAL$i"}) ? $hdr->{"TSCAL$i"} : 1.0;
+
+ # The $valid_<foo> flags let us avoid unnecessary arithmetic.
+ my $valid_tzero = ($tzero != 0.0);
+ my $valid_tscal = ($tscal != 1.0);
+
+ if ( $valid_tzero or $valid_tscal ) {
+ if ( $tmpcol->{type} =~ m/[ALX]/i ) {
+
+ print STDERR "Ignoring illegal TSCAL/TZERO keywords for col $i (" .
+ $tmpcol->{name} . "); type is $tmpcol->{type})\n";
+
+ } else { # Not an illegal type -- do the scaling
+
+ # (Normal execution path)
+ # Use PDL's cleverness to work out the final datatype...
+
+ my $tmp;
+ my $pdl = $tmpcol->{data};
+
+ if($pdl->badflag() == 0) {
+
+ $tmp = $pdl->flat()->slice("0:0");
+
+ } elsif($pdl->ngood > 0) {
+
+ my $index = which( $pdl->flat()->isbad()==0 )->at(0);
+ $tmp = $pdl->flat()->slice("${index}:${index}");
+
+ } else { # Do nothing if it's all bad....
+ $tmp = $pdl;
+ }
+
+ # Figure out the type by scaling the single element.
+ $tmp = ($tmp - $tzero) * $tscal;
+
+ # Convert the whole PDL as necessary for the scaling.
+ $tmpcol->{data} = $pdl->convert($tmp->type)
+ if($tmp->get_datatype != $pdl->get_datatype);
+
+ # Do the scaling.
+ $tmpcol->{data} -= $tzero;
+ $tmpcol->{data} *= $tscal;
+
+ } # End of legal-type conditional
+ } # End of valid_<foo> conditional
+
+ delete $hdr->{"TZERO$i"};
+ delete $hdr->{"TSCAL$i"};
+
+ } else { # $opt->{bscale} is zero; don't scale.
+ # Instead, copy factors into individual column headers.
+ my %foo = ("TZERO$i"=>"BZERO",
+ "TSCAL$i"=>"BSCALE",
+ "TUNIT$i"=>"BUNIT");
+ for my $a(keys %foo) {
+ $tmpcol->{data}->hdr->{$foo{$a}} = $hdr->{$a}
+ if( defined($hdr->{$a}) );
+ }
+ } # End of bscale checking...
+
+ # Try to grab a TDIM dimension list...
+ my @tdims = ();
+ $tmpcol->{data}->hdrcpy(1);
+
+ if(exists($hdr->{"TDIM$i"})) {
+ if($hdr->{"TDIM$i"} =~ m/\((\s*\d+(\s*\,\s*\d+)*\s*)\)/) {
+ my $a = $1;
+ @tdims = map { $_+0 } split(/\,/,$a);
+ my $tdims = pdl(@tdims);
+ my $tds = $tdims->prodover;
+ if($tds > $tmpcol->{data}->dim(0)) {
+ die("rfits: TDIM$i is too big in binary table. I give up.\n");
+ } elsif($tds < $tmpcol->{data}->dim(0)) {
+ print STDERR "rfits: WARNING: TDIM$i is too small in binary table. Carrying on...\n";
+ }
+
+ $tmpcol->{data}->hdrcpy(1);
+ my $td = $tmpcol->{data}->xchg(0,1);
+ $tbl->{$tmpcol->{name}} = $td->reshape($td->dim(0), at tdims);
+ } else {
+ print STDERR "rfits: WARNING: invalid TDIM$i field in binary table. Ignoring.\n";
+ }
+ } else {
+ # Copy the PDL out to the table itself.
+ if($hdr->{NAXIS2} > 0 && $tmpcol->{rpt}>0) {
+ $tbl->{$tmpcol->{name}} =
+ ( ( $tmpcol->{data}->dim(0) == 1 )
+ ? $tmpcol->{data}->slice("(0)")
+ : $tmpcol->{data}->xchg(0,1)
+ );
+ }
+ }
+
+ # End of PDL postfrobnication case
+ } elsif(defined $post) {
+
+ print STDERR "Postfrobnication bug detected in column $i ("
+ . $tmpcol->{name}. "). Winging it.\n";
+
+ }
+ } # End of postfrobnication loop over columns
+
+ ### Check whether this is actually a compressed image, in which case we hand it off to the image decompressor
+ if($hdr->{ZIMAGE} && $hdr->{ZCMPTYPE} && $opt->{expand}) {
+ eval 'use PDL::Compression;';
+ if($@) {
+ die "rfits: error while loading PDL::Compression to unpack tile-compressed image.\n\t$@\n\tUse option expand=>0 to get the binary table.\n";
+ }
+ return _rfits_unpack_zimage($tbl,$opt);
+ }
+
+ ### Done!
+ return $tbl;
+}
+
+
+##############################
+##############################
+#
+# _rfits_unpack_zimage - unpack a binary table that actually contains a compressed image
+#
+# This is implemented to support the partial spec by White, Greenfield, Pence, & Tody dated Oct 21, 1999,
+# with reverse-engineered bits from the CFITSIO3240 library where the spec comes up short.
+#
+
+## keyword is a compression algorithm name; value is an array ref containing tile compressor/uncompressor.
+## The compressor/uncompressor takes (nx, ny, data) and returns the compressed/uncompressed data.
+## The four currently (2010) supported-by-CFITSIO compressors are listed. Not all have been ported, hence
+## the "undef"s in the table. --CED.
+
+## Master jump table for compressors/uncompressors.
+## 0 element of each array ref is the compressor; 1 element is the uncompressor.
+## Uncompressed tiles are reshaped to rows of a tile table handed in (to the compressor)
+## or out (of the uncompressor); actual tile shape is fed in as $params->{tiledims}, so
+## higher-than-1D compression algorithms can be used.
+our $tile_compressors = {
+ 'GZIP_1' => undef
+ , 'RICE_1' => [ ### RICE_1 compressor
+ sub { my ($tiles, $tbl, $params) = @_;
+ my ($compressed,$len) = $tiles->rice_compress($params->{BLOCKSIZE} || 32);
+ $tbl->{ZNAME1} = "BLOCKSIZE";
+ $tbl->{ZVAL1} = $params->{BLOCKSIZE};
+ $tbl->{ZNAME2} = "BYTEPIX";
+ $tbl->{ZVAL2} = PDL::howbig($tiles->get_datatype);
+ # Convert the compressed data to a byte array...
+ if($tbl->{ZVAL2} != 1) {
+ my @dims = $compressed->dims;
+ $dims[0] *= $tbl->{ZVAL2};
+ my $cd2 = zeroes( byte, @dims );
+ my $cdr = $compressed->get_dataref;
+ my $cd2r = $cd2->get_dataref;
+ $$cd2r = $$cdr;
+ $cd2->upd_data;
+ $compressed = $cd2;
+ }
+ $tbl->{COMPRESSED_DATA} = $compressed->mv(0,-1);
+ $tbl->{len_COMPRESSED_DATA} = $len;
+ },
+ ### RICE_1 expander
+ sub { my ($tilesize, $tbl, $params) = @_;
+ my $compressed = $tbl->{COMPRESSED_DATA} -> mv(-1,0);
+ my $bytepix = $params->{BYTEPIX} || 4;
+
+ # Put the compressed tile bitstream into a variable of appropriate type.
+ # This works by direct copying of the PDL data, which sidesteps local
+ # byteswap issues in the usual case that the compressed stream is type
+ # byte. But it does add the extra complication that we have to pad the
+ # compressed array out to a factor-of-n elements in certain cases.
+
+ if( PDL::howbig($compressed->get_datatype) != $bytepix ) {
+ my @dims = $compressed->dims;
+ my $newdim0;
+ my $scaledim0;
+
+ $scaledim0 = $dims[0] * PDL::howbig($compressed->get_datatype) / $bytepix;
+ $newdim0 = pdl($scaledim0)->ceil;
+
+ if($scaledim0 != $newdim0) {
+ my $padding = zeroes($compressed->type,
+ ($newdim0-$scaledim0) * $bytepix / PDL::howbig($compressed->get_datatype),
+ @dims[1..$#dims]
+ );
+ $compressed = $compressed->append($padding);
+ }
+
+ my $c2 = zeroes( $type_table_2->{$bytepix * 8}, $newdim0, @dims[1..$#dims] );
+
+ my $c2dr = $c2->get_dataref;
+ my $cdr = $compressed->get_dataref;
+ substr($$c2dr,0,length($$cdr)) = $$cdr;
+ $c2->upd_data;
+ $compressed = $c2;
+ }
+
+ return $compressed->rice_expand( $tilesize, $params->{BLOCKSIZE} || 32);
+ }
+ ]
+ , 'PLIO_1' => undef
+ , 'HCOMPRESS_1' => undef
+};
+
+## List of the eight mandatory keywords and their ZIMAGE preservation pigeonholes, for copying after we
+## expand an image.
+our $hdrconv = {
+ "ZSIMPLE" => "SIMPLE",
+ "ZTENSION" => "XTENSION",
+ "ZEXTEND" => "EXTEND",
+ "ZBLOCKED" => "BLOCKED",
+ "ZPCOUNT" => "PCOUNT",
+ "ZGCOUNT" => "GCOUNT",
+ "ZHECKSUM" => "CHECKSUM",
+ "ZDATASUM" => "DATASUM"
+};
+
+
+sub _rfits_unpack_zimage($$$) {
+ my $tbl = shift;
+ my $opt = shift;
+
+ my $hdr = $tbl->{hdr};
+
+ my $tc = $tile_compressors->{$hdr->{ZCMPTYPE}};
+ unless(defined $tc) {
+ print STDERR "WARNING: rfits: Compressed image has unsupported comp. type ('$hdr->{ZCMPTYPE}').\n";
+ return $tbl;
+ }
+
+ #############
+ # Declare the output image
+ my $type;
+ unless($type_table->{$hdr->{ZBITPIX}}) {
+ print STDERR "WARNING: rfits: unrecognized ZBITPIX value $hdr->{ZBITPIX} in compressed image. Assuming -64.\n";
+ $type = $type_table_2->{-64};
+ } else {
+ $type = $type_table_2->{$hdr->{ZBITPIX}};
+ }
+ my @dims;
+ for my $i(1..$hdr->{ZNAXIS}) {
+ push(@dims,$hdr->{"ZNAXIS$i"});
+ }
+
+ my $pdl = PDL->new_from_specification( $type, @dims );
+
+ ############
+ # Calculate tile size and allocate a working tile.
+ my @tiledims;
+ for my $i(1..$hdr->{ZNAXIS}) {
+ if($hdr->{"ZTILE$i"}) {
+ push(@tiledims, $hdr->{"ZTILE$i"});
+ } else {
+ push(@tiledims, (($i==1) ? $hdr->{ZNAXIS1} : 1) );
+ }
+ }
+
+
+# my $tile = PDL->new_from_specification( $type, @tiledims );
+ my $tiledims = pdl(@tiledims);
+ my $tilesize = $tiledims->prodover;
+ ###########
+ # Calculate tile counts and compare to the number of stored tiles
+ my $ntiles = ( pdl(@dims) / pdl(@tiledims) )->ceil;
+ my $tilecount = $ntiles->prodover;
+
+ if($tilecount != $tbl->{COMPRESSED_DATA}->dim(0)) {
+ printf STDERR "WARNING: rfits: compressed data has $hdr->{NAXIS2} rows; we expected $tilecount (",join("x",list $ntiles),"). Winging it...\n";
+ }
+
+ ##########
+ # Quantization - ignore for now
+ if($hdr->{ZQUANTIZ}) {
+ printf STDERR "WARNING: rfits: ignoring quantization/dithering (ZQUANTIZ=$hdr->{ZQUANTIZ})\n";
+ }
+
+ ##########
+ # Snarf up compression parameters
+ my $params = {};
+ my $i = 1;
+ while( $hdr->{"ZNAME$i"} ) {
+ $params->{ $hdr->{"ZNAME$i"} } = $hdr->{"ZVAL$i"};
+ $i++;
+ }
+
+ ##########
+ # Enumerate tile coordinates for looping, and the corresponding row number
+ my ($step, @steps, $steps);
+ $step = 1;
+ for my $i(0..$ntiles->nelem-1) {
+ push(@steps, $step);
+ $step *= $ntiles->at($i);
+ }
+ $step = pdl(@steps);
+
+ # $tiledex is 2-D (coordinate-index, list-index) and enumerates all tiles by image
+ # location; $tilerow is 1-D (list-index) and enumerates all tiles by row in the bintable
+ my $tiledex = PDL::ndcoords($ntiles->list)->mv(0,-1)->clump($ntiles->dim(0))->mv(-1,0);
+ $TMP::tiledex = $tiledex;
+ my $tilerow = ($tiledex * $step)->sumover;
+
+ ##########
+ # Restore all the tiles at once
+ my $tiles = &{$tc->[1]}( $tilesize, $tbl, $params ); # gets a (tilesize x ntiles) output
+ my $patchup = which($tbl->{len_COMPRESSED_DATA} <= 0);
+ if($patchup->nelem) {
+ unless(defined $tbl->{UNCOMPRESSED_DATA}) {
+ die "rfits: need some uncompressed data for missing compressed rows, but none were found!\n";
+ }
+ if($tbl->{UNCOMPRESSED_DATA}->dim(1) != $tilesize) {
+ die "rfits: tile size is $tilesize, but uncompressed data rows have size ".$tbl->{UNCOMPRESSED_DATA}->dim(1)."\n";
+ }
+ $tiles->dice_axis(1,$patchup) .= $tbl->{UNCOMPRESSED_DATA}->dice_axis(0,$patchup)->xchg(0,1);
+ }
+
+ ##########
+ # Slice up the output image plane into tiles, and use the threading engine
+ # to assign everything to them.
+ my $cutup = $pdl->range( $tiledex, [@tiledims], 't') # < ntiles, tilesize0..tilesizen >
+ ->mv(0,-1) # < tilesize0..tilesizen, ntiles >
+ ->clump($tiledims->nelem); # < tilesize, ntiles >
+
+ $cutup .= $tiles; # dump all the tiles at once into the image - they flow back to $pdl.
+ undef $cutup; # sever connection to prevent expensive future dataflow.
+
+ ##########
+ # Perform scaling if necessary ( Just the ZIMAGE quantization step )
+ # bscaling is handled farther down with treat_bscale.
+
+ $pdl *= $hdr->{ZSCALE} if defined($hdr->{ZSCALE});
+ $pdl += $hdr->{ZZERO} if defined($hdr->{ZZERO});
+
+ ##########
+ # Put the FITS header into the newly reconstructed image.
+ delete $hdr->{PCOUNT};
+ delete $hdr->{GCOUNT};
+
+ # Copy the mandated name-conversions
+ for my $k(keys %$hdrconv) {
+ if($hdr->{$k}) {
+ $hdr->{$hdrconv->{$k}} = $hdr->{$k};
+ delete $hdr->{$k};
+ }
+ }
+
+ # Clean up the ZFOO extensions and table cruft
+ for my $k(keys %{$pdl->hdr}) {
+ delete $pdl->hdr->{$k} if(
+ $k=~ m/^Z/ ||
+ $k eq "TFIELDS" ||
+ $k =~ m/^TTYPE/ ||
+ $k =~ m/^TFORM/
+ );
+ }
+
+ if(exists $hdr->{BSCALE}) {
+ $pdl = treat_bscale($pdl, $hdr);
+ }
+ $pdl->sethdr($hdr);
+ $pdl->hdrcpy($opt->{hdrcpy});
+
+ return $pdl;
+}
+
+
+
+
+=head2 wfits()
+
+=for ref
+
+Simple PDL FITS writer
+
+=for example
+
+ wfits $pdl, 'filename.fits', [$BITPIX], [$COMPRESSION_OPTIONS];
+ wfits $hash, 'filename.fits', [$OPTIONS];
+ $pdl->wfits('foo.fits',-32);
+
+Suffix magic:
+
+ # Automatically compress through pipe to gzip
+ wfits $pdl, 'filename.fits.gz';
+ # Automatically compress through pipe to compress
+ wfits $pdl, 'filename.fits.Z';
+
+=over 3
+
+=item * Ordinary (PDL) data handling:
+
+If the first argument is a PDL, then the PDL is written out as an
+ordinary FITS file with a single Header/Data Unit of data.
+
+$BITPIX is then optional and coerces the output data type according to
+the standard FITS convention for the BITPIX field (with positive
+values representing integer types and negative values representing
+floating-point types).
+
+If C<$pdl> has a FITS header attached to it (actually, any hash that
+contains a C<< SIMPLE=>T >> keyword), then that FITS header is written
+out to the file. The image dimension tags are adjusted to the actual
+dataset. If there's a mismatch between the dimensions of the data and
+the dimensions in the FITS header, then the header gets corrected and
+a warning is printed.
+
+If C<$pdl> is a slice of another PDL with a FITS header already
+present (and header copying enabled), then you must be careful.
+C<wfits> will remove any extraneous C<NAXISn> keywords (per the FITS
+standard), and also remove the other keywords associated with that
+axis: C<CTYPEn>, C<CRPIXn>, C<CRVALn>, C<CDELTn>, and C<CROTAn>. This
+may cause confusion if the slice is NOT out of the last dimension:
+C<wfits($a(:,(0),:),'file.fits');> and you would be best off adjusting
+the header yourself before calling C<wfits>.
+
+You can tile-compress images according to the CFITSIO extension to the
+FITS standard, by adding an option hash to the arguments:
+
+=over 3
+
+=item compress
+
+This can be either unity, in which case Rice compression is used,
+or a (case-insensitive) string matching the CFITSIO compression
+type names. Currently supported compression algorithms are:
+
+=over 3
+
+=item * RICE_1 - linear Rice compression
+
+This uses limited-symbol-length Rice compression, which works well on
+low entropy image data (where most pixels differ from their neighbors
+by much less than the dynamic range of the image).
+
+=back
+
+=item tilesize (default C<[-1,1]>)
+
+This specifies the dimension of the compression tiles, in pixels. You
+can hand in a PDL, a scalar, or an array ref. If you specify fewer
+dimensions than exist in the image, the last dim is repeated - so "32"
+yields 32x32 pixel tiles in a 2-D image. A dim of -1 in any dimension
+duplicates the image size, so the default C<[-1,1]> causes compression
+along individual rows.
+
+=item tilesize (RICE_1 only; default C<32>)
+
+For RICE_1, BLOCKSIZE indicates the number of pixel samples to use
+for each compression block within the compression algorithm. The
+blocksize is independent of the tile dimensions. For RICE
+compression the pixels from each tile are arranged in normal pixel
+order (early dims fastest) and compressed as a linear stream.
+
+=back
+
+=item * Table handling:
+
+If you feed in a hash ref instead of a PDL, then the hash ref is
+written out as a binary table extension. The hash ref keys are
+treated as column names, and their values are treated as the data to
+be put in each column.
+
+For numeric information, the hash values should contain PDLs. The 0th
+dim of the PDL runs across rows, and higher dims are written as
+multi-value entries in the table (e.g. a 7x5 PDL will yield a single
+named column with 7 rows and 5 numerical entries per row, in a binary
+table). Note that this is slightly different from the usual concept
+of threading, in which dimension 1 runs across rows.
+
+ASCII tables only allow one entry per column in each row, so
+if you plan to write an ASCII table then all of the values of C<$hash>
+should have at most one dim.
+
+All of the columns' 0 dims must agree in the threading sense. That is to
+say, the 0th dimension of all of the values of C<$hash> should be the
+same (indicating that all columns have the same number of rows). As
+an exception, if the 0th dim of any of the values is 1, or if that
+value is a PDL scalar (with 0 dims), then that value is "threaded"
+over -- copied into all rows.
+
+Data dimensions higher than 2 are preserved in binary tables,
+via the TDIMn field (e.g. a 7x5x3 PDL is stored internally as
+seven rows with 15 numerical entries per row, and reconstituted
+as a 7x5x3 PDL on read).
+
+Non-PDL Perl scalars are treated as strings, even if they contain
+numerical values. For example, a list ref containing 7 values is
+treated as 7 rows containing one string each. There is no such thing
+as a multi-string column in FITS tables, so any nonscalar values in
+the list are stringified before being written. For example, if you
+pass in a perl list of 7 PDLs, each PDL will be stringified before
+being written, just as if you printed it to the screen. This is
+probably not what you want -- you should use L<glue|glue> to connect
+the separate PDLs into a single one. (e.g. C<$a-E<gt>glue(1,$b,$c)-E<gt>mv(1,0)>)
+
+The column names are case-insensitive, but by convention the keys of
+C<$hash> should normally be ALL CAPS, containing only digits, capital
+letters, hyphens, and underscores. If you include other characters,
+then case is smashed to ALL CAPS, whitespace is converted to
+underscores, and unrecognized characters are ignored -- so if you
+include the key "Au Purity (%)", it will be written to the file as a
+column that is named "AU_PURITY". Since this is not guaranteed to
+produce unique column names, subsequent columns by the same name are
+disambiguated by the addition of numbers.
+
+You can specify the use of variable-length rows in the output, saving
+space in the file. To specify variable length rows for a column named
+"FOO", you can include a separate key "len_FOO" in the hash to be
+written. The key's value should be a PDL containing the number of
+actual samples in each row. The result is a FITS P-type variable
+length column that, upon read with C<rfits()>, will restore to a field
+named FOO and a corresponding field named "len_FOO". Invalid data in
+the final PDL consist of a padding value (which defaults to 0 but
+which you may set by including a TNULL field in the hdr specificaion).
+Variable length arrays must be 2-D PDLs, with the variable length in
+the 1 dimension.
+
+Two further special keys, 'hdr' and 'tbl', can contain
+meta-information about the type of table you want to write. You may
+override them by including an C<$OPTIONS> hash with a 'hdr' and/or
+'tbl' key.
+
+The 'tbl' key, if it exists, must contain either 'ASCII' or 'binary'
+(case-insensitive), indicating whether to write an ascii or binary
+table. The default is binary. [ASCII table writing is planned but
+does not yet exist].
+
+You can specify the format of the table quite specifically with the
+'hdr' key or option field. If it exists, then the 'hdr' key should
+contain fields appropriate to the table extension being used. Any
+field information that you don't specify will be filled in
+automatically, so (for example) you can specify that a particular
+column name goes in a particular position, but allow C<wfits> to
+arrange the other columns in the usual alphabetical order into any
+unused slots that you leave behind. The C<TFORMn>, C<TFIELDS>,
+C<PCOUNT>, C<GCOUNT>, C<NAXIS>, and C<NAXISn> keywords are ignored:
+their values are calculated based on the hash that you supply. Any
+other fields are passed into the final FITS header verbatim.
+
+As an example, the following
+
+ $a = long(1,2,4);
+ $b = double(1,2,4);
+ wfits { 'COLA'=>$a, 'COLB'=>$b }, "table1.fits";
+
+will create a binary FITS table called F<table1.fits> which
+contains two columns called C<COLA> and C<COLB>. The order
+of the columns is controlled by setting the C<TTYPEn>
+keywords in the header array, so
+
+ $h = { 'TTYPE1'=>'Y', 'TTYPE2'=>'X' };
+ wfits { 'X'=>$a, 'Y'=>$b, hdr=>$h }, "table2.fits";
+
+creates F<table2.fits> where the first column is
+called C<Y> and the second column is C<X>.
+
+=item * multi-value handling
+
+If you feed in a perl list rather than a PDL or a hash, then
+each element is written out as a separate HDU in the FITS file.
+Each element of the list must be a PDL or a hash. [This is not implemented
+yet but should be soon!]
+
+=item * DEVEL NOTES
+
+ASCII tables are not yet handled but should be.
+
+Binary tables currently only handle one vector (up to 1-D array)
+per table entry; the standard allows more, and should be fully implemented.
+This means that PDL::Complex piddles currently can not be written to
+disk.
+
+Handling multidim arrays implies that perl multidim lists should also be
+handled.
+
+=back
+
+=for bad
+
+For integer types (ie C<BITPIX E<gt> 0>), the C<BLANK> keyword is set
+to the bad value. For floating-point types, the bad value is
+converted to NaN (if necessary) before writing.
+
+=cut
+
+*wfits = \&PDL::wfits;
+
+BEGIN {
+ @PDL::IO::FITS::wfits_keyword_order =
+ ('SIMPLE','BITPIX','NAXIS','NAXIS1','BUNIT','BSCALE','BZERO');
+ @PDL::IO::FITS::wfits_numbered_keywords =
+ ('CTYPE','CRPIX','CRVAL','CDELT','CROTA');
+}
+
+# Until we do a rewrite these have to be file global since they
+# are used by the wheader routine
+my (%hdr, $nbytes);
+
+# Local utility routine of wfits()
+sub wheader ($$) {
+ my $fh = shift;
+ my $k = shift;
+
+ if ($k =~ m/(HISTORY|COMMENT)/) {
+ my $hc = $1;
+ return unless ref($hdr{$k}) eq 'ARRAY';
+ foreach my $line (@{$hdr{$k}}) {
+ $fh->printf( "$hc %-72s", substr($line,0,72) );
+ $nbytes += 80;
+ }
+ delete $hdr{$k};
+ } else {
+ # Check that we are dealing with a scalar value in the header
+ # Need to make sure that the header does not include PDLs or
+ # other structures. Return unless $hdr{$k} is a scalar.
+ my($hdrk) = $hdr{$k};
+
+ if(ref $hdrk eq 'ARRAY') {
+ $hdrk = join("\n",@$hdrk);
+ }
+
+ return unless not ref($hdrk);
+
+ if ($hdrk eq "") {
+ $fh->printf( "%-80s", substr($k,0,8) );
+ } else {
+ $fh->printf( "%-8s= ", substr($k,0,8) );
+
+ my $com = ( ref $hdr{COMMENT} eq 'HASH' ) ?
+ $hdr{COMMENT}{$k} : undef;
+
+ if ($hdrk =~ /^ *([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))? *$/) { # Number?
+ my $cl=60-($com ? 2 : 0);
+ my $end=' ' x $cl;
+ $end =' /'. $com if($com);
+ $fh->printf( "%20s%-50s", substr($hdrk,0,20),
+ substr($end, 0, 50) );
+ } elsif ($hdrk eq 'F' or $hdrk eq 'T') {
+ # Logical flags ?
+ $fh->printf( "%20s", $hdrk );
+ my $end=' ' x 50;
+ $end =' /'.$com if($com);
+ $fh->printf( "%-50s", $end );
+ } else {
+ # Handle strings, truncating as necessary
+ # (doesn't do multicard strings like Astro::FITS::Header does)
+
+ # Convert single quotes to doubled single quotes
+ # (per FITS standard)
+ my($st) = $hdrk;
+ $st =~ s/\'/\'\'/g;
+
+ my $sl=length($st)+2;
+ my $cl=70-$sl-($com ? 2 : 0);
+ $fh->print( "'$st'" );
+
+ if (defined $com) {
+ $fh->printf( " /%-$ {cl}s", substr($com, 0, $cl) );
+ } else {
+ $fh->printf( "%-$ {cl}s", ' ' x $cl );
+ }
+ }
+ }
+ $nbytes += 80; delete $hdr{$k};
+ }
+ delete $hdr{COMMENT}{$k} if ref $hdr{COMMENT} eq 'HASH';
+ 1;
+}
+
+# Write a PDL to a FITS format file
+#
+sub PDL::wfits {
+ barf 'Usage: wfits($pdl,$file,[$BITPIX],[{options}])' if $#_<1 || $#_>3;
+ my ($pdl,$file,$a,$b) = @_;
+ my ($opt, $BITPIX);
+
+ local $\ = undef; # fix sf.net bug #3394327
+
+ if(ref $a eq 'HASH') {
+ $a = $opt;
+ $BITPIX = $b;
+ } elsif(ref $b eq 'HASH') {
+ $BITPIX = $a;
+ $opt = $b;
+ }
+
+ my ($k, $buff, $off, $ndims, $sz);
+
+ local $SIG{PIPE};
+
+ if ($file =~ /\.gz$/) { # Handle suffix-style compression
+ $SIG{PIPE}= sub {}; # Prevent crashing if gzip dies
+ $file = "|gzip -9 > $file";
+ }
+ elsif ($file =~ /\.Z$/) {
+ $SIG{PIPE}= sub {}; # Prevent crashing if compress dies
+ $file = "|compress > $file";
+ }
+ else{
+ $file = ">$file";
+ }
+
+ #### Figure output type
+
+# unless( UNIVERSAL::isa($pdl,'PDL') ) {
+# my $ref = ref($pdl) || "";
+# if($ref eq 'HASH') {
+# my $fh = IO::File->new( $file )
+# or barf "Could not open $file\n";
+# _wfits_nullhdu($fh);
+# # default to binary table if none specified
+# my $table_type = exists $pdl->{tbl} ?
+# ($pdl->{tbl} =~ m/^a/i ? 'ascii' : 'binary') :
+# "binary";
+# _wfits_table($fh,$pdl,$table_type);
+# $fh->close;
+# return;
+# } else {
+# barf('wfits: multiple output xtensions not supported\n')
+# }
+# }
+
+ my @outputs = ();
+ my $issue_nullhdu;
+
+ if( UNIVERSAL::isa($pdl,'PDL') ) {
+ $issue_nullhdu = 0;
+ push(@outputs, $pdl);
+ } elsif( ref($pdl) eq 'HASH' ) {
+ $issue_nullhdu = 1;
+ push(@outputs, $pdl);
+ } elsif( ref($pdl) eq 'ARRAY' ) {
+ $issue_nullhdu = 1;
+ @outputs = @$pdl;
+ } elsif( length(ref($pdl))==0 ) {
+ barf "wfits: needs a HASH or PDL argument to write out\n";
+ } else {
+ barf "wfits: unknown ref type ".ref($pdl)."\n";
+ }
+
+ ## Open file & prepare to write binary info
+ my $fh = IO::File->new( $file )
+ or barf "Unable to create FITS file $file\n";
+ binmode $fh;
+
+ if($issue_nullhdu) {
+ _wfits_nullhdu($fh);
+ }
+
+ for $pdl(@outputs) {
+
+ if(ref($pdl) eq 'HASH') {
+ my $table_type = ( exists($pdl->{tbl}) ?
+ ($pdl->{tbl} =~ m/^a/i ? 'ascii' : 'binary') :
+ "binary"
+ );
+ _wfits_table($fh,$pdl,$table_type);
+ } elsif( UNIVERSAL::isa($pdl,'PDL') ) {
+
+ ### Regular image writing.
+
+ $BITPIX = "" unless defined $BITPIX;
+ if ($BITPIX eq "") {
+ $BITPIX = 8 if $pdl->get_datatype == $PDL_B;
+ $BITPIX = 16 if $pdl->get_datatype == $PDL_S || $pdl->get_datatype == $PDL_US;
+ $BITPIX = 32 if $pdl->get_datatype == $PDL_L;
+ $BITPIX = -32 if $pdl->get_datatype == $PDL_F;
+ $BITPIX = -64 if $pdl->get_datatype == $PDL_D;
+ }
+ my $convert = sub { return $_[0] }; # Default - do nothing
+ $convert = sub {byte($_[0])} if $BITPIX == 8;
+ $convert = sub {short($_[0])} if $BITPIX == 16;
+ $convert = sub {long($_[0])} if $BITPIX == 32;
+ $convert = sub {float($_[0])} if $BITPIX == -32;
+ $convert = sub {double($_[0])} if $BITPIX == -64;
+
+ # Automatically figure output scaling
+
+ my $bzero = 0; my $bscale = 1;
+ if ($BITPIX>0) {
+ my $min = $pdl->min;
+ my $max = $pdl->max;
+ my ($dmin,$dmax) = (0, 2**8-1) if $BITPIX == 8;
+ ($dmin,$dmax) = (-2**15, 2**15-1) if $BITPIX == 16;
+ ($dmin,$dmax) = (-2**31, 2**31-1) if $BITPIX == 32;
+
+ if ($min<$dmin || $max>$dmax) {
+ $bzero = $min - $dmin;
+ $max -= $bzero;
+ $bscale = $max/$dmax if $max>$dmax;
+ }
+ print "BSCALE = $bscale && BZERO = $bzero\n" if $PDL::verbose;
+ }
+
+ # Check for tile-compression format for the image, and handle it.
+ # We add the image-compression format tags and reprocess the whole
+ # shebang as a binary table.
+ if($opt->{compress}) {
+ croak "Placeholder -- tile compression not yet supported\n";
+ }
+
+
+ ##############################
+ ## Check header and prepare to write it out
+
+ my($h) = $pdl->gethdr();
+
+ # Extra logic: if we got handed a vanilla hash that that is *not* an Astro::FITS::Header, but
+ # looks like it's a FITS header encoded in a hash, then attempt to process it with
+ # Astro::FITS::Header before writing it out -- this helps with cleanup of tags.
+ if($PDL::Astro_FITS_Header and
+ defined($h) and
+ ref($h) eq 'HASH' and
+ !defined( tied %$h )
+ ) {
+
+ my $all_valid_fits = 1;
+ for my $k(keys %$h) {
+ if(length($k) > 8 or
+ $k !~ m/^[A-Z_][A-Z\d\_]*$/i
+ ) {
+ $all_valid_fits = 0;
+ last;
+ }
+ }
+
+ if($all_valid_fits) {
+ # All the keys look like valid FITS header keywords -- so
+ # create a tied FITS header object and use that instead.
+ my $afh = new Astro::FITS::Header( );
+ my %hh;
+ tie %hh, "Astro::FITS::Header", $afh;
+ for (keys %$h) {
+ $hh{$_} = $h->{$_};
+ }
+ $h = \%hh;
+ }
+ }
+
+ # Now decide whether to emit a hash or an AFH object
+ if(defined($h) &&
+ ( (defined (tied %$h)) &&
+ (UNIVERSAL::isa(tied %$h,"Astro::FITS::Header")))
+ ){
+ my $k;
+
+ ##n############################
+ ## Tied-hash code -- I'm too lazy to incorporate this into KGB's
+ ## direct hash handler below, so I've more or less just copied and
+ ## pasted with some translation. --CED
+ ##
+ my $hdr = tied %$h;
+
+ #
+ # Put advertising comment in the SIMPLE field
+ #n
+ if($issue_nullhdu) {
+ $h->{XTENSION} = "IMAGE";
+ } else {
+ $h->{SIMPLE} = 'T';
+ my(@a) = $hdr->itembyname('SIMPLE');
+ $a[0]->comment('Created with PDL (http://pdl.perl.org)');
+ # and register it as a LOGICAL rather than a string
+ $a[0]->type('LOGICAL');
+ }
+
+ #
+ # Use tied interface to set all the keywords. Note that this
+ # preserves existing per-line comments, only changing the values.
+ #
+ $h->{BITPIX} = $BITPIX;
+ $h->{NAXIS} = $pdl->getndims;
+ my $correction = 0;
+ for $k(1..$h->{NAXIS}) {
+ $correction |= (exists $h->{"NAXIS$k"} and
+ $h->{"NAXIS$k"} != $pdl->dim($k-1)
+ );
+ $h->{"NAXIS$k"} = $pdl->getdim($k-1);
+ }
+ carp("Warning: wfits corrected dimensions of FITS header")
+ if($correction);
+
+ $h->{BUNIT} = "Data Value" unless exists $h->{BUNIT};
+ $h->{BSCALE} = $bscale if($bscale != 1);
+ $h->{BZERO} = $bzero if($bzero != 0);
+
+ if ( $pdl->badflag() ) {
+ if ( $BITPIX > 0 ) { my $a = &$convert(pdl(0.0));
+ $h->{BLANK} = $a->badvalue(); }
+ else { delete $h->{BLANK}; }
+ }
+
+ # Use object interface to sort the lines. This is complicated by
+ # the need for an arbitrary number of NAXIS<n> lines in the middle
+ # of the sorting. Keywords with a trailing '1' in the sorted-order
+ # list get looped over.
+ my($kk) = 0;
+ my(@removed_naxis) = ();
+ for $k(0..$#PDL::IO::FITS::wfits_keyword_order) {
+ my($kn) = 0;
+
+ my @index;
+ do { # Loop over numericised keywords (e.g. NAXIS1)
+
+ my $kw = $PDL::IO::FITS::wfits_keyword_order[$k]; # $kw get keyword
+ $kw .= (++$kn) if( $kw =~ s/\d$//); # NAXIS1 -> NAXIS<n>
+ @index = $hdr->index($kw);
+
+ if(defined $index[0]) {
+ if($kn <= $pdl->getndims){
+ $hdr->insert($kk, $hdr->remove($index[0]))
+ unless ($index[0] == $kk) ;
+ $kk++;
+ }
+ else{ #remove e.g. NAXIS3 from hdr if NAXIS==2
+ $hdr->removebyname($kw);
+ push(@removed_naxis,$kw);
+ }
+ }
+ } while((defined $index[0]) && $kn);
+ }
+
+ foreach my $naxis(@removed_naxis){
+ $naxis =~ m/(\d)$/;
+ my $n = $1;
+ foreach my $kw(@PDL::IO::FITS::wfits_numbered_keywords){
+ $hdr->removebyname($kw . $n);
+ }
+ }
+ #
+ # Delete the END card if necessary (for later addition at the end)
+ #
+ $hdr->removebyname('END');
+
+ #
+ # Make sure that the HISTORY lines all come at the end
+ #
+ my @hindex = $hdr->index('HISTORY');
+ for $k(0..$#hindex) {
+ $hdr->insert(-1-$k, $hdr->remove($hindex[-1-$k]));
+ }
+
+ #
+ # Make sure the last card is an END
+ #
+ $hdr->insert(scalar($hdr->cards),
+ Astro::FITS::Header::Item->new(Keyword=>'END'));
+
+ #
+ # Write out all the cards, and note how many bytes for later padding.
+ #
+ my $s = join("",$hdr->cards);
+
+ $fh->print( $s );
+ $nbytes = length $s;
+ } else {
+ ##
+ ## Legacy emitter (note different advertisement in the SIMPLE
+ ## comment, for debugging!)
+ ##
+
+ if($issue_nullhdu) {
+ $fh->printf( "%-80s", "XTENSION= 'IMAGE'" );
+ } else {
+ $fh->printf( "%-80s", "SIMPLE = T / PDL::IO::FITS::wfits (http://pdl.perl.org)" );
+ }
+
+ $nbytes = 80; # Number of bytes written so far
+
+ # Write FITS header
+
+ %hdr = ();
+ if (defined($h)) {
+ for (keys %$h) { $hdr{uc $_} = $$h{$_} } # Copy (ensuring keynames are uppercase)
+ }
+
+ delete $hdr{SIMPLE}; delete $hdr{'END'};
+
+ $hdr{BITPIX} = $BITPIX;
+ $hdr{BUNIT} = "Data Value" unless exists $hdr{BUNIT};
+ wheader($fh, 'BITPIX');
+
+ $ndims = $pdl->getndims; # Dimensions of data array
+ $hdr{NAXIS} = $ndims;
+ wheader($fh, 'NAXIS');
+ for $k (1..$ndims) { $hdr{"NAXIS$k"} = $pdl->getdim($k-1) }
+ for $k (1..$ndims) { wheader($fh,"NAXIS$k") }
+
+ if ($bscale != 1 || $bzero != 0) {
+ $hdr{BSCALE} = $bscale;
+ $hdr{BZERO} = $bzero;
+ wheader($fh,'BSCALE');
+ wheader($fh,'BZERO');
+ }
+ wheader($fh,'BUNIT');
+
+ # IF badflag is set
+ # and BITPIX > 0 - ensure the header contains the BLANK keyword
+ # (make sure it's for the correct type)
+ # otherwise - make sure the BLANK keyword is removed
+ if ( $pdl->badflag() ) {
+ if ( $BITPIX > 0 ) { my $a = &$convert(pdl(0.0)); $hdr{BLANK} = $a->badvalue(); }
+ else { delete $hdr{BLANK}; }
+ }
+
+ for $k (sort fits_field_cmp keys %hdr) {
+ wheader($fh,$k) unless $k =~ m/HISTORY/;
+ }
+ wheader($fh, 'HISTORY'); # Make sure that HISTORY entries come last.
+ $fh->printf( "%-80s", "END" );
+ $nbytes += 80;
+ }
+
+ #
+ # Pad the header to a legal value and write the rest of the FITS file.
+ #
+ $nbytes %= 2880;
+ $fh->print( " "x(2880-$nbytes) )
+ if $nbytes != 0; # Fill up HDU
+
+ # Decide how to byte swap - note does not quite work yet. Needs hack
+ # to IO.xs
+
+ my $bswap = sub {}; # Null routine
+ if ( !isbigendian() ) { # Need to set a byte swap routine
+ $bswap = \&bswap2 if $BITPIX==16;
+ $bswap = \&bswap4 if $BITPIX==32 || $BITPIX==-32;
+ $bswap = \&bswap8 if $BITPIX==-64;
+ }
+
+ # Write FITS data
+
+ my $p1d = $pdl->copy->reshape($pdl->nelem); # Data as 1D stream;
+
+ $off = 0;
+ $sz = PDL::Core::howbig(&$convert($p1d->slice('0:0'))->get_datatype);
+
+ $nbytes = $p1d->getdim(0) * $sz;
+
+ # Transfer data in blocks (because might need to byte swap)
+ # Buffer is also type converted on the fly
+
+ my $BUFFSZ = 360*2880; # = ~1Mb - must be multiple of 2880
+ my $tmp;
+
+ if ( $pdl->badflag() and $BITPIX < 0 and $PDL::Bad::UseNaN == 0 ) {
+ # just print up a message - conversion is actually done in the loop
+ print "Converting PDL bad value to NaN\n" if $PDL::verbose;
+ }
+
+ while ($nbytes - $off > $BUFFSZ) {
+
+ # Data to be transferred
+
+ $buff = &$convert( ($p1d->slice( ($off/$sz).":". (($off+$BUFFSZ)/$sz-1))
+ -$bzero)/$bscale );
+
+ # if there are bad values present, and output type is floating-point,
+ # convert the bad values to NaN's. We can ignore integer types, since
+ # we have set the BLANK keyword
+ #
+ if ( $pdl->badflag() and $BITPIX < 0 and $PDL::Bad::UseNaN == 0 ) {
+ $buff->inplace->setbadtonan();
+ }
+
+ &$bswap($buff);
+ $fh->print( ${$buff->get_dataref} );
+ $off += $BUFFSZ;
+ }
+ $buff = &$convert( ($p1d->slice($off/$sz.":-1") - $bzero)/$bscale );
+
+ if ( $pdl->badflag() and $BITPIX < 0 and $PDL::Bad::UseNaN == 0 ) {
+ $buff->inplace->setbadtonan();
+ }
+
+ &$bswap($buff);
+ $fh->print( ${$buff->get_dataref} );
+ # Fill HDU and close
+ # note that for the data space the fill character is \0 not " "
+ #
+ $fh->print( "\0"x(($BUFFSZ - $buff->getdim(0) * $sz)%2880) );
+ } # end of image writing block
+ else {
+ # Not a PDL and not a hash ref
+ barf("wfits: unknown data type - quitting");
+ }
+ } # end of output loop
+ $fh->close();
+ 1;
+}
+
+######################################################################
+######################################################################
+
+# Compare FITS headers in a sensible manner.
+
+=head2 fits_field_cmp
+
+=for ref
+
+fits_field_cmp
+
+Sorting comparison routine that makes proper sense of the digits at the end
+of some FITS header fields. Sort your hash keys using "fits_field_cmp" and
+you will get (e.g.) your "TTYPE" fields in the correct order even if there
+are 140 of them.
+
+This is a standard kludgey perl comparison sub -- it uses the magical
+$a and $b variables, rather than normal argument passing.
+
+=cut
+
+sub fits_field_cmp {
+ if( $a=~m/^(.*[^\d])(\d+)$/ ) {
+ my ($an,$ad) = ($1,$2);
+ if( $b=~m/^(.*[^\d])(\d+)$/ ) {
+ my($bn,$bd) = ($1,$2);
+
+ if($an eq $bn) {
+ return $ad<=>$bd;
+ }
+ }
+ }
+ $a cmp $b;
+}
+
+=head2 _rows()
+
+=for ref
+
+Return the number of rows in a variable for table entry
+
+You feed in a PDL or a list ref, and you get back the 0th dimension.
+
+=cut
+
+sub _rows {
+ my $var = shift;
+
+ return $var->dim(0) if( UNIVERSAL::isa($var,'PDL') );
+ return 1+$#$var if(ref $var eq 'ARRAY');
+ return 1 unless(ref $var);
+
+ print STDERR "Warning: _rows found an unacceptable ref. ".ref $var.". Ignoring...\n"
+ if($PDL::verbose);
+
+ return undef;
+}
+
+
+
+=head2 _prep_table()
+
+=for ref
+
+Accept a hash ref containing a table, and return a header describing the table
+and a string to be written out as the table, or barf.
+
+You can indicate whether the table should be binary or ascii. The default
+is binary; it can be overridden by the "tbl" field of the hash (if present)
+or by parameter.
+
+=cut
+
+our %bintable_types = (
+ 'byte'=>['B',1],
+ 'short'=>['I',2],
+ 'ushort'=>['J',4, sub {return long shift;}],
+ 'long'=>['J',4],
+ 'longlong'=>['D', 8, sub {return double shift;}],
+ 'float'=>['E',4],
+ 'double'=>['D',8],
+# 'complex'=>['M',8] # Complex doubles are supported (actually, they aren't at the moment)
+);
+
+
+sub _prep_table {
+ my ($hash,$tbl,$nosquish) = @_;
+
+ my $ohash;
+
+ my $hdr = $hash->{hdr};
+
+ my $heap = "";
+
+ # Make a local copy of the header.
+ my $h = {};
+ if(defined $hdr) {
+ local $_;
+ for (keys %$hdr) {$h->{$_} = $hdr->{$_}};
+ }
+ $hdr = $h;
+
+ $tbl = $hash->{tbl} unless defined($tbl);
+
+ barf "_prep_table called without a HASH reference as the first argument"
+ unless ref $hash eq 'HASH';
+
+ #####
+ # Figure out how many columns are in the table
+ my @colkeys = grep( ( !m/^(hdr|tbl)$/ and !m/^len_/ and defined $hash->{$_}),
+ sort fits_field_cmp keys %$hash
+ );
+ my $cols = @colkeys;
+
+ print "Table seems to have $cols columns...\n"
+ if($PDL::verbose);
+
+ #####
+ # Figure out how many rows are in the table, and store counts...
+ #
+ my $rows;
+ my $rkey;
+ for my $key(@colkeys) {
+ my $r = _rows($hash->{$key});
+ ($rows,$rkey) = ($r,$key) unless(defined($rows) && $rows != 1);
+ if($r != $rows && $r != 1) {
+ barf "_prep_table: inconsistent number of rows ($rkey: $rows vs. $key: $r)\n";
+ }
+ }
+
+ print "Table seems to have $rows rows...\n"
+ if($PDL::verbose);
+
+ #####
+ # Squish and disambiguate column names
+ #
+ my %keysbyname;
+ my %namesbykey;
+
+ print "Renaming hash keys...\n"
+ if($PDL::debug);
+
+ for my $key(@colkeys) {
+ my $name = $key;
+
+ $name =~ tr/[a-z]/[A-Z]/; # Uppercaseify (required by FITS standard)
+ $name =~ s/\s+/_/g; # Remove whitespace (required by FITS standard)
+
+ unless($nosquish) {
+ $name =~ s/[^A-Z0-9_-]//g; # Squish (recommended by FITS standard)
+ }
+
+ ### Disambiguate...
+ if(defined $ohash->{$name}) {
+ my $iter = 1;
+ my $name2;
+ do { $name2 = $name."_".($iter++); }
+ while(defined $ohash->{$name2});
+ $name = $name2;
+ }
+
+ $ohash->{$name} = $hash->{$key};
+ $keysbyname{$name} = $key;
+ $namesbykey{$key} = $name;
+
+ print "\tkey '$key'\t-->\tname '$name'\n"
+ if($PDL::debug || (($name ne $key) and $PDL::verbose));
+ }
+
+
+ # The first element of colnames is ignored (since FITS starts the
+ # count at 1)
+ #
+ my @colnames; # Names by number
+ my %colnums; # Numbers by name
+
+ ### Allocate any table columns that are already in the header...
+ local $_;
+ map { for my $a(1) { # [Shenanigans to make next work right]
+ next unless m/^TTYPE(\d*)$/;
+
+ my $num = $1;
+
+ if($num > $cols || $num < 1) {
+ print "Ignoring illegal column number $num ( should be in range 1..$cols )\n"
+ if($PDL::verbose);
+ delete $hdr->{$_};
+ next;
+ }
+
+ my $key = $hdr->{$_};
+
+ my $name;
+ unless( $name = $namesbykey{$key}) { # assignment
+ $name = $key;
+ unless( $key = $keysbyname{$key}) {
+ print "Ignoring column $num in existing header (unknown name '$key')\n"
+ if($PDL::verbose);
+ next;
+ }
+ }
+
+ $colnames[$num] = $name;
+ $colnums{$name} = $num;
+ } } sort fits_field_cmp keys %$hdr;
+
+ ### Allocate all other table columns in alphabetical order...
+ my $i = 0;
+ for my $k (@colkeys) {
+ my $name = $namesbykey{$k};
+
+ unless($colnums{$name}) {
+ while($colnames[++$i]) { }
+ $colnames[$i] = $name;
+ $colnums{$name} = $i;
+ } else { $i++; }
+ }
+
+ print "Assertion failed: i ($i) != colnums ($cols)\n"
+ if($PDL::debug && $i != $cols);
+
+ print "colnames: " .
+ join(",", map { $colnames[$_]; } (1..$cols) ) ."\n"
+ if($PDL::debug);
+
+ ########
+ # OK, now the columns are allocated -- spew out a header.
+
+ my @converters = (); # Will fill up with conversion routines for each column
+ my @field_len = (); # Will fill up with field lengths for each column
+ my @internaltype = (); # Gets flag for PDLhood
+ my @fieldvars = (); # Gets refs to all the fields of the hash.
+
+ if($tbl eq 'binary') {
+ $hdr->{XTENSION} = 'BINTABLE';
+ $hdr->{BITPIX} = 8;
+ $hdr->{NAXIS} = 2;
+ #$hdr->{NAXIS1} = undef; # Calculated below; inserted here as placeholder.
+ $hdr->{NAXIS2} = $rows;
+ $hdr->{PCOUNT} = 0; # Change this is variable-arrays are adopted
+ $hdr->{GCOUNT} = 1;
+ $hdr->{TFIELDS} = $cols;
+
+ # Figure out data types, and accumulate a row length at the same time.
+
+ my $rowlen = 0;
+
+ # NOTE:
+ # the conversion from ushort to long below is a hack to work
+ # around the issue that otherwise perl treats it as a 2-byte
+ # NOT 4-byte string on writing out, which leads to data corruption
+ # Really ushort arrays should be written out using SCALE/ZERO
+ # so that it can be written as an Int2 rather than Int4
+ #
+ for my $i(1..$cols) {
+ $fieldvars[$i] = $hash->{$keysbyname{$colnames[$i]}};
+ my $var = $fieldvars[$i];
+
+ $hdr->{"TTYPE$i"} = $colnames[$i];
+ my $tform;
+
+ my $tstr;
+ my $rpt;
+ my $bytes;
+
+ if( UNIVERSAL::isa($var,'PDL') ) {
+
+ $internaltype[$i] = 'P';
+
+ my $t;
+
+ my $dims = pdl($var->dims);
+ ($t = $dims->slice("(0)")) .= 1;
+ $rpt = $dims->prod;
+
+=pod
+
+=begin WHENCOMPLEXVALUESWORK
+
+ if( UNIVERSAL::isa($var,'PDL::Complex') ) {
+ $rpt = $var->dim(1);
+ $t = 'complex'
+ } else {
+ $t = type $var;
+ }
+
+=end WHENCOMPLEXVALUESWORK
+
+=cut
+
+ barf "Error: wfits() currently can not handle PDL::Complex arrays (column $colnames[$i])\n"
+ if UNIVERSAL::isa($var,'PDL::Complex');
+ $t = $var->type;
+
+ $t = $bintable_types{$t};
+
+ unless(defined($t)) {
+ print "Warning: converting unknown type $t (column $colnames[$i]) to double...\n"
+ if($PDL::verbose);
+ $t = $bintable_types{'double'};
+ }
+
+ ($tstr, $bytes, $converters[$i]) = @$t;
+
+ } elsif( ref $var eq 'ARRAY' ) {
+
+ $internaltype[$i] = 'A';
+ $bytes = 1;
+
+ # Got an array (of strings) -- find the longest element
+ $rpt = 0;
+ for(@$var) {
+ my $l = length($_);
+ $rpt = $l if($l>$rpt);
+ }
+ ($tstr, $bytes, $converters[$i]) = ('A',1,undef);
+
+ } elsif( ref $var ) {
+ barf "You seem to be writing out a ".(ref $var)." as a table column. I\ndon't know how to do that (yet).\n";
+
+ } else { # Scalar
+ $internaltype[$i] = 'A';
+ ($tstr, $bytes, $converters[$i]) = ('A',1,undef);
+ $rpt = length($var);
+ }
+
+
+ # Now check if it's a variable-length array and, if so, insert an
+ # extra converter
+ my $lname = "len_".$keysbyname{$colnames[$i]};
+ if(exists $hash->{$lname}) {
+ my $lengths = $hash->{$lname};
+
+ # Variable length array - add extra handling logic.
+
+ # First, check we're legit
+ if( !UNIVERSAL::isa($var, 'PDL') ||
+ $var->ndims != 2 ||
+ !UNIVERSAL::isa($lengths,'PDL') ||
+ $lengths->ndims != 1 ||
+ $lengths->dim(0) != $var->dim(0)
+ ) {
+ die <<'FOO';
+wfits(): you specified a 'len_$keysbyname{$colnames[$i]}' field in
+ your binary table output hash, indicating a variable-length array for
+ each row of the output table, but I'm having trouble interpreting it.
+ Either your source column isn't a 2-D PDL, or your length column isn't
+ a 1-D PDL, or the two lengths don't match. I give up.
+FOO
+ }
+
+ # The definition below wraps around the existing converter,
+ # dumping the variable to the heap and returning the length
+ # and index of the data for the current row as a PDL LONG.
+ # This does the Right Thing below in the write loop, with
+ # the side effect of putting the data into the heap.
+ #
+ # The main downside here is that the heap gets copied
+ # multiple times as we accumulate it, since we are using
+ # string concatenation to add onto it. It might be better
+ # to preallocate a large heap, but I'm too lazy to figure
+ # out how to do that.
+ my $csub = $converters[$i];
+ $converters[$i] = sub {
+ my $var = shift;
+ my $row = shift;
+ my $col = shift;
+
+ my $len = $hash->{"len_".$keysbyname{$colnames[$i]}};
+ my $l;
+ if(ref $len eq 'ARRAY') {
+ $l = $len->[$row];
+ } elsif( UNIVERSAL::isa($len,'PDL') ) {
+ $l = $len->dice_axis(0,$row);
+ } elsif( ref $len ) {
+ die "wfits: Couldn't understand length spec 'len_".$keysbyname{$colnames[$i]}."' in bintable output (length spec must be a PDL or array ref).\n";
+ } else {
+ $l = $len;
+ }
+
+ # The standard says we should give a zero-offset
+ # pointer if the current row is zero-length; hence
+ # the ternary operator.
+ my $ret = pdl( $l, $l ? length($heap) : 0)->long;
+
+
+ if($l) {
+ # This echoes the normal-table swap and accumulation
+ # stuff below, except we're accumulating into the heap.
+ my $tmp = $csub ? &$csub($var, $row, $col) : $var;
+ $tmp = $tmp->slice("0:".($l-1))->sever;
+
+ if(!isbigendian()) {
+ bswap2($tmp) if($tmp->get_datatype == $PDL_S);
+ bswap4($tmp) if($tmp->get_datatype == $PDL_L ||
+ $tmp->get_datatype == $PDL_F);
+ bswap8($tmp) if($tmp->get_datatype == $PDL_D);
+ }
+ my $t = $tmp->get_dataref;
+ $heap .= $$t;
+ }
+
+ return $ret;
+ };
+
+ # Having defined the conversion routine, now modify tstr to make this a heap-array
+ # reference.
+ $tstr = sprintf("P%s(%d)",$tstr, $hash->{"len_".$keysbyname{$colnames[$i]}}->max );
+ $rpt = 1;
+ $bytes = 8; # two longints per row in the main table.
+ }
+
+
+ $hdr->{"TFORM$i"} = "$rpt$tstr";
+
+ if(UNIVERSAL::isa($var, 'PDL') and $var->ndims > 1) {
+ $hdr->{"TDIM$i"} = "(".join(",",$var->slice("(0)")->dims).")";
+ }
+
+ $rowlen += ($field_len[$i] = $rpt * $bytes);
+ }
+
+ $hdr->{NAXIS1} = $rowlen;
+
+ ## Now accumulate the binary table
+
+ my $table = "";
+
+ for my $r(0..$rows-1) {
+ my $row = "";
+ for my $c(1..$cols) {
+ my $tmp;
+ my $a = $fieldvars[$c];
+
+ if($internaltype[$c] eq 'P') { # PDL handling
+ $tmp = $converters[$c]
+ ? &{$converters[$c]}($a->slice("$r")->flat->sever, $r, $c)
+ : $a->slice("$r")->flat->sever ;
+
+ ## This would go faster if moved outside the loop but I'm too
+ ## lazy to do it Right just now. Perhaps after it actually works.
+ ##
+ if(!isbigendian()) {
+ bswap2($tmp) if($tmp->get_datatype == $PDL_S);
+ bswap4($tmp) if($tmp->get_datatype == $PDL_L ||
+ $tmp->get_datatype == $PDL_F);
+ bswap8($tmp) if($tmp->get_datatype == $PDL_D);
+ }
+
+ my $t = $tmp->get_dataref;
+ $tmp = $$t;
+ } else { # Only other case is ASCII just now...
+ $tmp = ( ref $a eq 'ARRAY' ) ? # Switch on array or string
+ ( $#$a == 0 ? $a->[0] : $a->[$r] ) # Thread arrays as needed
+ : $a;
+
+ $tmp .= " " x ($field_len[$c] - length($tmp));
+ }
+
+ # Now $tmp contains the bytes to be written out...
+ #
+ $row .= substr($tmp,0,$field_len[$c]);
+ } # for: $c
+ $table .= $row;
+ } # for: $r
+
+ my $table_size = $rowlen * $rows;
+ if( (length $table) != $table_size ) {
+ print "Warning: Table length is ".(length $table)."; expected $table_size\n";
+ }
+
+ return ($hdr,$table, $heap);
+
+ } elsif($tbl eq 'ascii') {
+ barf "ASCII tables not yet supported...\n";
+ } else {
+ barf "unknown table type '$tbl' -- giving up.";
+ }
+}
+
+# the header fill value can be blanks, but the data fill value must
+# be zeroes in non-ASCII tables
+#
+sub _print_to_fits ($$$) {
+ my $fh = shift;
+ my $data = shift;
+ my $blank = shift;
+
+ my $len = ((length $data) - 1) % 2880 + 1;
+ $fh->print( $data . ($blank x (2880-$len)) );
+}
+
+{
+ my $ctr = 0;
+
+ sub reset_hdr_ctr() { $ctr = 0; }
+
+ sub add_hdr_item ($$$$;$) {
+ my ( $hdr, $key, $value, $type, $comment ) = @_;
+ $type = uc($type) if defined $type;
+ my $item = Astro::FITS::Header::Item->new( Keyword=>$key,
+ Value=>$value,
+ Type=>$type );
+ $item->comment( $comment ) if defined $comment;
+ $hdr->replace( $ctr++, $item );
+ };
+}
+
+##############################
+#
+# _wfits_table -- given a hash ref, try to write it out as a
+# table extension. The file FITS should be open when you call it.
+# Most of the work of creating the extension header, and all of
+# the work of creating the table, is handled by _prep_table().
+#
+# NOTE:
+# can not think of a sensible name for the extension so calling
+# it TABLE for now
+#
+sub _wfits_table ($$$) {
+ my $fh = shift;
+ my $hash = shift;
+ my $tbl = shift;
+
+ barf "FITS BINTABLES are not supported without the Astro::FITS::Header module.\nGet it from www.cpan.org.\n"
+ unless($PDL::Astro_FITS_Header);
+
+ my ($hdr,$table, $heap) = _prep_table($hash,$tbl,0);
+ $heap="" unless defined($heap);
+
+ # Copy the prepared fields into the extension header.
+ tie my %newhdr,'Astro::FITS::Header',my $h = Astro::FITS::Header->new;
+
+ reset_hdr_ctr();
+ add_hdr_item $h, "XTENSION", ($tbl eq 'ascii'?"TABLE":"BINTABLE"), 'string', "from perl hash";
+ add_hdr_item $h, "BITPIX", $hdr->{BITPIX}, 'int';
+ add_hdr_item $h, "NAXIS", 2, 'int';
+ add_hdr_item $h, "NAXIS1", $hdr->{NAXIS1}, 'int', 'Bytes per row';
+ add_hdr_item $h, "NAXIS2", $hdr->{NAXIS2}, 'int', 'Number of rows';
+ add_hdr_item $h, "PCOUNT", length($heap), 'int', ($tbl eq 'ascii' ? undef : "No heap") ;
+ add_hdr_item $h, "THEAP", "0", "(No gap before heap)" if(length($heap));
+ add_hdr_item $h, "GCOUNT", 1, 'int';
+ add_hdr_item $h, "TFIELDS", $hdr->{TFIELDS},'int';
+ add_hdr_item $h, "HDUNAME", "TABLE", 'string';
+
+ for my $field( sort fits_field_cmp keys %$hdr ) {
+ next if( defined $newhdr{$field} or $field =~ m/^end|simple|xtension$/i);
+ my $type = (UNIVERSAL::isa($hdr->{field},'PDL') ?
+ $hdr->{$field}->type :
+ ((($hdr->{$field})=~ m/^[tf]$/i) ?
+ 'logical' :
+ undef ## 'string' seems to have a bug - 'undef' works OK
+ ));
+
+ add_hdr_item $h, $field, $hdr->{$field}, $type, $hdr->{"${field}_COMMENT"};
+ }
+
+ add_hdr_item $h, "END", undef, 'undef';
+
+ $hdr = join("",$h->cards);
+ _print_to_fits( $fh, $hdr, " " );
+ _print_to_fits( $fh, $table.$heap, "\0" ); # use " " if it is an ASCII table
+ # Add heap dump
+}
+
+sub _wfits_nullhdu ($) {
+ my $fh = shift;
+ if($Astro::FITS::Header) {
+ my $h = Astro::FITS::Header->new();
+
+ reset_hdr_ctr();
+ add_hdr_item $h, "SIMPLE", "T", 'logical', "Null HDU (no data, only extensions)";
+ add_hdr_item $h, "BITPIX", -32, 'int', "Needed to make fverify happy";
+ add_hdr_item $h, "NAXIS", 0, 'int';
+ add_hdr_item $h, "EXTEND", "T", 'logical', "File contains extensions";
+ add_hdr_item $h, "COMMENT", "", "comment",
+ " File written by perl (PDL::IO::FITS::wfits)";
+ #
+ # The following seems to cause a problem so removing for now (I don't
+ # believe it is required, but may be useful for people who aren't
+ # FITS connoisseurs). It could also be down to a version issue in
+ # Astro::FITS::Header since it worked on linux with a newer version
+ # than on Solaris with an older version of the header module)
+ #
+ ## add_hdr_item $h, "COMMENT", "", "comment",
+ ## " FITS (Flexible Image Transport System) format is defined in 'Astronomy";
+ ## add_hdr_item $h, "COMMENT", "", "comment",
+ ## " and Astrophysics', volume 376, page 359; bibcode: 2001A&A...376..359H";
+ add_hdr_item $h, "HDUNAME", "PRIMARY", 'string';
+ add_hdr_item $h, "END", undef, 'undef';
+
+ my $hdr = join("",$h->cards);
+ _print_to_fits( $fh, $hdr, " " );
+ } else {
+ _print_to_fits( $fh,
+ q+SIMPLE = T / Null HDU (no data, only extensions) BITPIX = -32 / Needed to make fverify happy NAXIS = 0 EXTEND = T / File contains extensions COMMENT Written by perl (PDL::IO::FITS::wfits) legacy code. COMMENT For best results, install Astro::FITS::Header. HDUN [...]
+ " ");
+ }
+}
+
+
+1;
+
diff --git a/IO/FITS/Makefile.PL b/IO/FITS/Makefile.PL
new file mode 100644
index 0000000..e04a8d0
--- /dev/null
+++ b/IO/FITS/Makefile.PL
@@ -0,0 +1,52 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => "PDL::IO::FITS",
+ 'VERSION_FROM' => '../../Basic/Core/Version.pm',
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+ );
+
+#
+# Check whether FITS modules are available (external to PDL)
+#
+BEGIN {
+ $PDL::IO::FITS::wstr = '';
+ # no warnings; # pre 5.6 does not like this
+ eval "use Astro::FITS::Header";
+ if((defined $Astro::FITS::Header::VERSION)){
+ # $Astro::FITS::Header::VERSION =~ m/^(\d*)/;
+ # dist v2.1 has CVS derived VERSION 1.12 in Header.pm
+ if($Astro::FITS::Header::VERSION < 1.12) {
+ $PDL::IO::FITS::wstr = << "EOW";
+Hmmm. You appear to have the Astro::FITS::Header module installed, which
+is good, but it's version $Astro::FITS::Header::VERSION --
+which doesn't help PDL (need >= 1.12, i.e. distribution >= v2.1).
+Using internal fallback code.
+EOW
+ }
+ } else {
+ $PDL::IO::FITS::wstr = << 'EOW';
+Hmmm. You don't appear to have the Astro::FITS::Header module installed.
+You'll be able to read and write simple FITS files anyway, but FITS support is
+greatly improved if you install it.
+EOW
+ }
+
+} # BEGIN
+
+# collate all warning messages at the end
+# where the user has a chance to see them
+END {
+ if($PDL::IO::FITS::wstr) {
+ warn << "EOF";
+
+* Gentle warning from PDL::IO::FITS: *
+
+$PDL::IO::FITS::wstr
+You can get the latest Astro::FITS::Header module from CPAN --
+point your browser at http://www.cpan.org.
+
+EOF
+ }
+} # END
+
diff --git a/IO/FastRaw/FastRaw.pm b/IO/FastRaw/FastRaw.pm
new file mode 100644
index 0000000..883186b
--- /dev/null
+++ b/IO/FastRaw/FastRaw.pm
@@ -0,0 +1,462 @@
+=head1 NAME
+
+PDL::IO::FastRaw -- A simple, fast and convenient io format for PerlDL.
+
+=head1 VERSION
+
+This documentation refers to PDL::IO::FastRaw version 0.0.2, I guess.
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::IO::FastRaw;
+
+ writefraw($pdl,"fname"); # write a raw file
+
+ $pdl2 = readfraw("fname"); # read a raw file
+ $pdl2 = PDL->readfraw("fname");
+
+ $pdl3 = mapfraw("fname2",{ReadOnly => 1}); # mmap a file, don't read yet
+
+ $pdl4 = maptextfraw("fname3",{...}); # map a text file into a 1-D pdl.
+
+
+=head1 DESCRIPTION
+
+This is a very simple and fast io format for PerlDL.
+The disk data consists of two files, a header metadata file
+in ASCII and a binary file consisting simply of consecutive
+bytes, shorts or whatever.
+
+It is hoped that this will not only make for a simple PerlDL module
+for saving and retrieving these files but also make it easy
+for other programs to use these files.
+
+The format of the ASCII header is simply
+
+ <typeid>
+ <ndims>
+ <dim0> <dim1> ...
+
+You should probably stick with the default header name. You may want
+to specify your own header, however, such as when you have a large
+collection of data files with identical dimensions and data types.
+Under these circumstances, simply specify the C<Header> option in the
+options hash.
+
+The binary files are in general
+NOT interchangeable between different architectures since the binary
+file is simply dumped from the memory region of the piddle.
+This is what makes the approach efficient.
+
+It is also possible to mmap the file which can give a large
+speedup in certain situations as well as save a lot of memory
+by using a disk file as virtual memory. When a file is mapped,
+parts of it are read only as they are accessed in the memory
+(or as the kernel decides: if you are reading the pages in order,
+it may well preread some for you).
+
+Note that memory savings and copy-on-write are operating-system
+dependent - see Core.xs and your operating system documentation
+for exact semantics of whatever. Basically, if you write to a
+mmapped file without C<ReadOnly>, the change will be reflected
+in the file immediately. C<ReadOnly> doesn't really make it impossible
+to write to the piddle but maps the memory privately so the file
+will not be changed when you change the piddle. Be aware though
+that mmapping a 40Mb file without C<ReadOnly> spends no virtual
+memory but with C<ReadOnly> it does reserve 40Mb.
+
+=head2 Example: Converting ASCII to raw
+
+You have a whole slew of data files in ASCII from an experiment
+that you ran in your lab. You're still tweaking the analysis
+and plots, so you'd like if your data could load as fast as
+possible. Eventually you'll read the data into your scripts
+using C<readfraw>, but the first thing you might do is create
+a script that converts all the data files to raw files:
+
+ #!/usr/bin/perl
+ # Assumes that the data files end with a .asc or .dat extension
+ # and saves the raw file output with a .bdat extension.
+ # call with
+ # >./convert_to_raw.pl file1.dat file2.dat ...
+ # or
+ # >./convert_to_raw.pl *.dat
+
+ use PDL;
+ use PDL::IO::FastRaw; # for saving raw files
+ use PDL::IO::Misc; # for reading ASCII files with rcols
+ while(shift) { # run through the entire supplied list of file names
+ ($newName = $_) =~ s/\.(asc|dat)/.bdat/;
+ print "Saving contents of $_ to $newName\n";
+ $data = rcols($_);
+ writefraw($data, $newName);
+ }
+
+
+=head2 Example: readfraw
+
+Now that you've gotten your data into a raw file format, you can
+start working on your analysis scripts. If you scripts used C<rcols>
+in the past, the reading portion of the script should go much,
+much faster now:
+
+ #!/usr/bin/perl
+ # My plotting script.
+ # Assume I've specified the files to plot on the command line like
+ # >./plot_script.pl file1.bdat file2.bdat ...
+ # or
+ # >./plot_script.pl *.bdat
+
+ use PDL;
+ use PDL::IO::FastRaw;
+ while(shift) { # run through the entire supplied list of file names
+ $data = readfraw($_);
+ my_plot_func($data);
+ }
+
+=head2 Example: Custom headers
+
+In the first example, I allow C<writefraw> to use the standard header
+file name, which would be C<file.bdat.hdr>. However, I often measure
+time series that have identical length, so all of those header files
+are redundant. To fix that, I simply pass the Header option to the
+C<writefraw> command. A modified script would look like this:
+
+ #!/usr/bin/perl
+ # Assumes that the data files end with a .asc or .dat extension
+ # and saves the raw file output with a .bdat extension.
+ # call with
+ # >./convert_to_raw.pl [-hHeaderFile] <fileglob> [-hHeaderFile] <fileglob> ...
+
+ use PDL;
+ use PDL::IO::FastRaw; # for saving raw files
+ use PDL::IO::Misc; # for reading ASCII files with rcols
+ my $header_file = undef;
+ CL_OPTION: while($_ = shift @ARGV) { # run through the entire list of command-line options
+ if(/-h(.*)/) {
+ $header_file = $1;
+ next CL_OPTION;
+ }
+ ($newName = $_) =~ s/\.(asc|dat)/.bdat/;
+ print "Saving contents of $_ to $newName\n";
+ $data = rcols($_);
+ writefraw($data, $newName, {Header => $header_file});
+ }
+
+Modifying the read script is left as an exercise for the reader. :]
+
+
+=head2 Example: Using mapfraw
+
+Sometimes you'll want to use C<mapfraw> rather than the read/write
+functions. In fact, the original author of the module doesn't
+use the read/write functions anymore, prefering to always use
+C<mapfraw>. How would you go about doing this?
+
+Assuming you've already saved your data into the raw format, the
+only change you would have to make to the script in example 2 would
+be to change the call to C<readfraw> to C<mapfraw>. That's it.
+You will probably see differences in performance, though I (David
+Mertens) couldn't tell you about them because I haven't played
+around with C<mapfraw> much myself.
+
+What if you eschew the use of C<writefraw> and prefer to only use
+C<mapfraw>? How would you save your data to a raw format? In that
+case, you would have to create a C<mapfraw> piddle with the correct
+dimensions first using
+
+ $piddle_on_hd = mapfraw('fname', {Creat => 1, Dims => [dim1, dim2, ...]});
+
+Note that you must specify the dimensions and you must tell
+C<mapfraw> to create the new piddle for you by setting the
+C<Creat> option to a true value, not C<Create> (note the missing
+final 'e').
+
+
+=head1 FUNCTIONS
+
+=head2 readfraw
+
+=for ref
+
+Read a raw format binary file
+
+=for usage
+
+ $pdl2 = readfraw("fname");
+ $pdl2 = PDL->readfraw("fname");
+ $pdl2 = readfraw("fname", {Header => 'headerfname'});
+
+=for options
+
+The C<readfraw> command
+supports the following option:
+
+=over 8
+
+=item Header
+
+Specify the header file name.
+
+=back
+
+=head2 writefraw
+
+=for ref
+
+Write a raw format binary file
+
+=for usage
+
+ writefraw($pdl,"fname");
+ writefraw($pdl,"fname", {Header => 'headerfname'});
+
+=for options
+
+The C<writefraw> command
+supports the following option:
+
+=over 8
+
+=item Header
+
+Specify the header file name.
+
+=back
+
+=head2 mapfraw
+
+=for ref
+
+Memory map a raw format binary file (see the module docs also)
+
+=for usage
+
+ $pdl3 = mapfraw("fname2",{ReadOnly => 1});
+
+=for options
+
+The C<mapfraw> command
+supports the following options (not all combinations make sense):
+
+=over 8
+
+=item Dims, Datatype
+
+If creating a new file or if you want to specify your own header
+data for the file, you can give an array reference and a scalar,
+respectively.
+
+=item Creat
+
+Create the file. Also writes out a header for the file.
+
+=item Trunc
+
+Set the file size. Automatically enabled with C<Creat>. NOTE: This also
+clears the file to all zeroes.
+
+=item ReadOnly
+
+Disallow writing to the file.
+
+=item Header
+
+Specify the header file name.
+
+=back
+
+=head2 maptextfraw
+
+=for ref
+
+Memory map a text file (see the module docs also).
+
+Note that this function maps the raw format so if you are
+using an operating system which does strange things to e.g.
+line delimiters upon reading a text file, you get the raw (binary)
+representation.
+
+The file doesn't really need to be text but it is just mapped
+as one large binary chunk.
+
+This function is just a convenience wrapper which firsts C<stat>s
+the file and sets the dimensions and datatype.
+
+=for usage
+
+ $pdl4 = maptextfraw("fname", {options}
+
+=for options
+
+The options other than Dims, Datatype of C<mapfraw> are
+supported.
+
+=head1 BUGS
+
+Should be documented better. C<writefraw> and C<readfraw> should
+also have options (the author nowadays only uses C<mapfraw> ;)
+
+=head1 AUTHOR
+
+Copyright (C) Tuomas J. Lukka 1997.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
+
+package PDL::IO::FastRaw;
+
+## use version; our $VERSION = qv('0.0.3');
+our $VERSION = '0.000003';
+$VERSION = eval $VERSION;
+
+BEGIN {
+ our $have_file_map = 0;
+
+ eval "use File::Map 0.57 qw(:all)";
+ $have_file_map = 1 unless $@;
+}
+
+require Exporter;
+use PDL::Core '';
+use PDL::Exporter;
+use FileHandle;
+
+ at PDL::IO::FastRaw::ISA = qw/PDL::Exporter/;
+
+ at EXPORT_OK = qw/writefraw readfraw mapfraw maptextfraw/;
+%EXPORT_TAGS = (Func=>[@EXPORT_OK]);
+
+# Exported functions
+
+*writefraw = \&PDL::writefraw;
+sub readfraw {PDL->readfraw(@_)}
+sub mapfraw {PDL->mapfraw(@_)}
+sub maptextfraw {PDL->maptextfraw(@_)}
+
+sub _read_frawhdr {
+ my($name,$opts) = @_;
+ my $hname = $opts->{Header} || "$name.hdr";
+ my $h = new FileHandle "$hname"
+ or barf "Couldn't open '$hname' for reading";
+ chomp(my $tid = <$h>);
+ chomp(my $ndims = <$h>);
+ chomp(my $str = <$h>); if(!defined $str) {barf("Format error in '$hname'");}
+ my @dims = split ' ',$str;
+ if($#dims != $ndims-1) {
+ barf("Format error reading fraw header file '$hname'");
+ }
+ return {
+ Type => $tid,
+ Dims => \@dims,
+ NDims => $ndims
+ };
+}
+
+sub _writefrawhdr {
+ my($pdl,$name,$opts) = @_;
+ my $hname = $opts->{Header} || "$name.hdr";
+ my $h = new FileHandle ">$hname"
+ or barf "Couldn't open '$hname' for writing";
+ print $h map {"$_\n"} ($pdl->get_datatype,
+ $pdl->getndims, (join ' ',$pdl->dims));
+}
+
+sub PDL::writefraw {
+ my($pdl,$name,$opts) = @_;
+ _writefrawhdr($pdl,$name,$opts);
+ my $d = new FileHandle ">$name"
+ or barf "Couldn't open '$name' for writing";
+ binmode $d;
+ print $d ${$pdl->get_dataref};
+}
+
+sub PDL::readfraw {
+ my $class = shift;
+ my($name,$opts) = @_;
+ my $d = new FileHandle "$name"
+ or barf "Couldn't open '$name' for reading";
+ binmode $d;
+ my $hdr = _read_frawhdr($name,$opts);
+ my $pdl = $class->zeroes ((new PDL::Type($hdr->{Type})), @{$hdr->{Dims}});
+ my $len = length ${$pdl->get_dataref};
+# wrong.
+# $d->sysread(${$pdl->get_dataref},$len) == $len
+# or barf "Couldn't read enough data from '$name'";
+ my $index = 0;
+ my $data;
+ my $retlen;
+ while (($retlen = $d->sysread($data, $len)) != 0) {
+ substr(${$pdl->get_dataref},$index,$len) = $data;
+ $index += $retlen;
+ $len -= $retlen;
+ }
+ $pdl->upd_data();
+ return $pdl;
+}
+
+sub PDL::mapfraw {
+ my $class = shift;
+ my($name,$opts) = @_;
+ my $hdr;
+ if($opts->{Dims}) {
+ my $datatype = $opts->{Datatype};
+ if(!defined $datatype) {$datatype = $PDL_D;}
+ $hdr->{Type} = $datatype;
+ $hdr->{Dims} = $opts->{Dims};
+ $hdr->{NDims} = scalar(@{$opts->{Dims}});
+ } else {
+ $hdr = _read_frawhdr($name,$opts);
+ }
+ $s = PDL::Core::howbig($hdr->{Type});
+ for(@{$hdr->{Dims}}) {
+ $s *= $_;
+ }
+ my $pdl = $class->zeroes(new PDL::Type($hdr->{Type}));
+ $pdl->setdims($hdr->{Dims});
+
+ if ($have_file_map and not defined($PDL::force_use_mmap_code) ) {
+ $pdl->set_data_by_file_map(
+ $name,
+ $s,
+ 1,
+ ($opts->{ReadOnly}?0:1),
+ ($opts->{Creat}?1:0),
+ (0644),
+ ($opts->{Creat} || $opts->{Trunc} ? 1:0)
+ );
+ } else {
+ warn "mapfraw: direct mmap support will be deprecated, please install File::Map\n";
+ $pdl->set_data_by_mmap(
+ $name,
+ $s,
+ 1,
+ ($opts->{ReadOnly}?0:1),
+ ($opts->{Creat}?1:0),
+ (0644),
+ ($opts->{Creat} || $opts->{Trunc} ? 1:0)
+ );
+ }
+
+ if($opts->{Creat}) {
+ _writefrawhdr($pdl,$name,$opts);
+ }
+ return $pdl;
+}
+
+sub PDL::maptextfraw {
+ my($class, $name, $opts) = @_;
+ $opts = {%$opts}; # Copy just in case
+ my @s = stat $name;
+ $opts->{Dims} = [$s[7]];
+ $opts->{Datatype} = &PDL::byte;
+ return PDL::mapfraw($class, $name, $opts);
+}
+
+1;
diff --git a/IO/FastRaw/Makefile.PL b/IO/FastRaw/Makefile.PL
new file mode 100644
index 0000000..508615b
--- /dev/null
+++ b/IO/FastRaw/Makefile.PL
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => "PDL::IO::FastRaw",
+ 'VERSION_FROM' => '../../Basic/Core/Version.pm',
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
diff --git a/IO/FlexRaw/FlexRaw.pm b/IO/FlexRaw/FlexRaw.pm
new file mode 100644
index 0000000..bd8a8cd
--- /dev/null
+++ b/IO/FlexRaw/FlexRaw.pm
@@ -0,0 +1,864 @@
+=head1 NAME
+
+PDL::IO::FlexRaw -- A flexible binary I/O format for PerlDL
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::IO::FlexRaw;
+
+ # To obtain the header for reading (if multiple files use the
+ # same header, for example):
+ #
+ $hdr = PDL::IO::FlexRaw::_read_flexhdr("filename.hdr")
+
+ ($x,$y,...) = readflex("filename" [, $hdr])
+ ($x,$y,...) = mapflex("filename" [, $hdr] [, $opts])
+
+ $hdr = writeflex($file, $pdl1, $pdl2,...)
+ writeflexhdr($file, $hdr)
+
+ # if $PDL::IO::FlexRaw::writeflexhdr is true and
+ # $file is a filename, writeflexhdr() is called automatically
+ #
+ $hdr = writeflex($file, $pdl1, $pdl2,...) # need $hdr for something
+ writeflex($file, $pdl1, $pdl2,...) # ..if $hdr not needed
+
+=head1 DESCRIPTION
+
+FlexRaw is a generic method for the input and output of `raw' data
+arrays. In particular, it is designed to read output from FORTRAN 77
+UNFORMATTED files and the low-level C write function, even if the
+files are compressed or gzipped. As in FastRaw, the data file is
+supplemented by a header file (although this can be replaced by the
+optional C<$hdr> argument). More information can be included in the
+header file than for FastRaw -- the description can be extended to
+several data objects within a single input file.
+
+For example, to read the output of a FORTRAN program
+
+ real*4 a(4,600,600)
+ open (8,file='banana',status='new',form='unformatted')
+ write (8) a
+ close (8)
+
+the header file (`banana.hdr') could look like
+
+ # FlexRaw file header
+ # Header word for F77 form=unformatted
+ Byte 1 4
+ # Data
+ Float 3 # this is ignored
+ 4 600 600
+ Byte 1 4 As is this, as we've got all dims
+
+The data can then be input using
+
+ $a = (readflex('banana'))[1];
+
+The format of the hdr file is an extension of that used by FastRaw.
+Comment lines (starting with #) are allowed, as are descriptive names
+(as elsewhere: byte, short, ushort, long, float, double) for the data
+types -- note that case is ignored by FlexRaw. After the type, one
+integer specifies the number of dimensions of the data `chunk', and
+subsequent integers the size of each dimension. So the specifier
+above (`Float 3 4 600 600') describes our FORTRAN array. A scalar can
+be described as `float 0' (or `float 1 1', or `float 2 1 1', etc.).
+
+When all the dimensions are read -- or a # appears after whitespace --
+the rest of the current input line is ignored, I<unless> badvalues
+are being read or written. In that case, the next token will be the
+string C<badvalue> followed by the bad value used, if needed.
+
+What about the extra 4 bytes at the head and tail, which we just threw
+away? These are added by FORTRAN (at least on Suns, Alphas and
+Linux), and specify the number of bytes written by each WRITE -- the
+same number is put at the start and the end of each chunk of data.
+You I<may> need to know all this in some cases. In general, FlexRaw
+tries to handle it itself, if you simply add a line saying `f77' to
+the header file, I<before> any data specifiers:
+
+ # FlexRaw file header for F77 form=unformatted
+ F77
+ # Data
+ Float 3
+ 4 600 600
+
+-- the redundancy in FORTRAN data files even allows FlexRaw to
+automatically deal with files written on other machines which use
+back-to-front byte ordering. This won't always work -- it's a 1 in 4
+billion chance it won't, even if you regularly read 4Gb files! Also,
+it currently doesn't work for compressed files, so you can say `swap'
+(again before any data specifiers) to make certain the byte order is
+swapped.
+
+The optional C<$hdr> argument allows the use of an anonymous array to
+give header information, rather than using a .hdr file. For example,
+
+ $header = [
+ {Type => 'f77'},
+ {Type => 'float', NDims => 3, Dims => [ 4,600,600 ] }
+ ];
+ @a = readflex('banana',$header);
+
+reads our example file again. As a special case, when NDims is 1, Dims
+may be given as a scalar.
+
+Within PDL, readflex and writeflex can be used to write several pdls
+to a single file -- e.g.
+
+ use PDL;
+ use PDL::IO::FlexRaw;
+
+ @pdls = ($pdl1, $pdl2, ...);
+ $hdr = writeflex("fname", at pdls);
+ @pdl2 = readflex("fname",$hdr);
+
+ writeflexhdr("fname",$hdr); # not needed if $PDL::IO::FlexRaw::writeflexhdr is set
+ @pdl3 = readflex("fname");
+
+-- C<writeflex> produces the data file and returns the file header as an
+anonymous hash, which can be written to a .hdr file using
+C<writeflexhdr>.
+
+If the package variable C<$PDL::IO::FlexRaw::writeflexhdr>
+is true, and the C<writeflex> call was with a I<filename> and not
+a handle, C<writeflexhdr> will be called automatically (as done by
+C<writefraw>.
+
+The reading of compressed data is switched on automatically if the
+filename requested ends in .gz or .Z, or if the originally specified
+filename does not exist, but one of these compressed forms does.
+
+If C<writeflex> and C<readflex> are given a reference to a
+file handle as a first parameter instead of a filename, then
+the data is read or written to the open filehandle. This
+gives an easy way to read an arbitrary slice in a big data
+volume, as in the following example:
+
+ use PDL;
+ use PDL::IO::FastRaw;
+
+ open(DATA, "raw3d.dat");
+ binmode(DATA);
+
+ # assume we know the data size from an external source
+ ($width, $height, $data_size) = (256,256, 4);
+
+ my $slice_num = 64; # slice to look at
+ # Seek to slice
+ seek(DATA, $width*$height*$data_size * $slice_num, 0);
+ $pdl = readflex \*DATA, [{Dims=>[$width, $height], Type=>'long'}];
+
+WARNING: In later versions of perl (5.8 and up) you must
+be sure that your file is in "raw" mode (see the perlfunc
+man page entry for "binmode", for details). Both readflex
+and writeflex automagically switch the file to raw mode for
+you -- but in code like the snipped above, you could end up
+seeking the wrong byte if you forget to make the binmode() call.
+
+C<mapflex> memory maps, rather than reads, the data files. Its interface
+is similar to C<readflex>. Extra options specify if the data is to be
+loaded `ReadOnly', if the data file is to be `Creat'-ed anew on the
+basis of the header information or `Trunc'-ated to the length of the
+data read. The extra speed of access brings with it some limitations:
+C<mapflex> won't read compressed data, auto-detect f77 files, or read f77
+files written by more than a single unformatted write statement. More
+seriously, data alignment constraints mean that C<mapflex> cannot read
+some files, depending on the requirements of the host OS (it may also
+vary depending on the setting of the `uac' flag on any given machine).
+You may have run into similar problems with common blocks in FORTRAN.
+
+For instance, floating point numbers may have to align on 4 byte
+boundaries -- if the data file consists of 3 bytes then a float, it
+cannot be read. C<mapflex> will warn about this problem when it occurs,
+and return the PDLs mapped before the problem arose. This can be
+dealt with either by reorganizing the data file (large types first
+helps, as a rule-of-thumb), or more simply by using C<readflex>.
+
+=head1 BUGS
+
+The test on two dimensional byte arrays fail using g77 2.7.2, but not
+Sun f77. I hope this isn't my problem!
+
+Assumes gzip is on the PATH.
+
+Can't auto-swap compressed files, because it can't seek on them.
+
+The header format may not agree with that used elsewhere.
+
+Should it handle handles?
+
+Mapflex should warn and fallback to reading on SEGV? Would have to
+make sure that the data was written back after it was `destroyed'.
+
+=head1 FUNCTIONS
+
+=head2 readflex
+
+=for ref
+
+Read a binary file with flexible format specification
+
+=for usage
+
+ Usage:
+
+ ($x,$y,...) = readflex("filename" [, $hdr])
+ ($x,$y,...) = readflex(FILEHANDLE [, $hdr])
+
+
+=head2 writeflex
+
+=for ref
+
+Write a binary file with flexible format specification
+
+=for usage
+
+ Usage:
+
+ $hdr = writeflex($file, $pdl1, $pdl2,...) # or
+ $hdr = writeflex(FILEHANDLE, $pdl1, $pdl2,...)
+ # now you must call writeflexhdr()
+ writeflexhdr($file, $hdr)
+
+or
+
+ $PDL::IO::FlexRaw::writeflexhdr = 1; # set so we don't have to call writeflexhdr
+
+ $hdr = writeflex($file, $pdl1, $pdl2,...) # remember, $file must be filename
+ writeflex($file, $pdl1, $pdl2,...) # remember, $file must be filename
+
+=head2 writeflexhdr
+
+=for ref
+
+Write the header file corresponding to a previous writeflex call
+
+=for usage
+
+ Usage:
+
+ writeflexhdr($file, $hdr)
+
+ $file or "filename" is the filename used in a previous writeflex
+ If $file is actually a "filename" then writeflexhdr() will be
+ called automatically if $PDL::IO::FlexRaw::writeflexhdr is true.
+ If writeflex() was to a FILEHANDLE, you will need to call
+ writeflexhdr() yourself since the filename cannot be determined
+ (at least easily).
+
+=head2 mapflex
+
+=for ref
+
+Memory map a binary file with flexible format specification
+
+=for usage
+
+ Usage:
+
+ ($x,$y,...) = mapflex("filename" [, $hdr] [, $opts])
+
+=for options
+
+ All of these options default to false unless set true:
+
+ ReadOnly - Data should be readonly
+ Creat - Create file if it doesn't exist
+ Trunc - File should be truncated to a length that conforms
+ with the header
+
+=head2 _read_flexhdr
+
+Read a FlexRaw header file and return a header structure.
+
+=for usage
+
+ Usage:
+
+ $hdr = PDL::IO::FlexRaw::_read_flexhdr($file)
+
+Note that C<_read_flexhdr> is supposed to be an internal function. It
+was not originally documented and it is not tested. However, there
+appeared to be no other method for obtaining a header structure from
+a file, so I figured I would write a small bit of documentation on it.
+
+=head1 Bad Value Support
+
+As of PDL-2.4.8, L<PDL::IO::FlexRaw|PDL::IO::FlexRaw> has support for reading and writing
+pdls with L<bad|PDL::Bad> values in them.
+
+On C<writeflex>, a piddle
+argument with C<< $pdl->badflag == 1 >> will have the keyword/token "badvalue"
+added to the header file after the dimension list and an additional token
+with the bad value for that pdl if C<< $pdl->badvalue != $pdl->orig_badvalue >>.
+
+On C<readflex>, a pdl with the "badvalue" token in the header will
+automatically have its L<badflag|PDL::Bad/#badflag> set and its
+L<badvalue|PDL::Bad/#badvalue> as well if it is not the standard default for that type.
+
+=for example
+
+The new badvalue support required some additions to the header
+structure. However, the interface is still being finalized. For
+reference the current C<$hdr> looks like this:
+
+ $hdr = {
+ Type => 'byte', # data type
+ NDims => 2, # number of dimensions
+ Dims => [640,480], # dims
+ BadFlag => 1, # is set/set badflag
+ BadValue => undef, # undef==default
+ };
+
+ $badpdl = readflex('badpdl', [$hdr]);
+
+If you use bad values and try the new L<PDL::IO::FlexRaw|PDL::IO::FlexRaw> bad value
+support, please let us know via the perldl mailing list.
+Suggestions and feedback are also welcome.
+
+
+=head1 AUTHOR
+
+Copyright (C) Robin Williams <rjrw at ast.leeds.ac.uk> 1997.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+Documentation contributions copyright (C) David Mertens, 2010.
+
+=cut
+
+package PDL::IO::FlexRaw;
+
+BEGIN {
+ our $have_file_map = 0;
+
+ eval "use File::Map 0.57 qw(map_file)";
+ $have_file_map = 1 unless $@;
+}
+
+use PDL;
+use Exporter;
+use FileHandle;
+use PDL::Types ':All';
+use PDL::IO::Misc qw(bswap2 bswap4 bswap8);
+
+ at PDL::IO::FlexRaw::ISA = qw/Exporter/;
+
+ at EXPORT = qw/writeflex writeflexhdr readflex mapflex/;
+
+# Cast type numbers in concrete, for external file's sake...
+%flexnames = ( map {(typefld($_,'numval') => typefld($_,'ioname'))}
+ typesrtkeys());
+%flextypes = ( map {(typefld($_,'ioname') => typefld($_,'numval'),
+ typefld($_,'numval') => typefld($_,'numval'),
+ lc typefld($_,'ppsym') => typefld($_,'numval'),
+ )}
+ typesrtkeys());
+%flexswap = ( map {my $val = typefld($_,'numval');
+ my $nb = PDL::Core::howbig($val);
+ ($val => $nb > 1 ? "bswap$nb" : undef)}
+ typesrtkeys());
+
+# use Data::Dumper;
+# print Dumper \%flexnames;
+# print Dumper \%flextypes;
+# print Dumper \%flexswap;
+
+# %flexnames = (
+# $PDL_B => 'byte', $PDL_S => 'short',
+# $PDL_US => 'ushort', $PDL_L => 'long',
+# $PDL_F => 'float', $PDL_D => 'double');
+
+# %flextypes = (
+# 'byte' => $PDL_B, '0' => $PDL_B, 'b' => $PDL_B, 'c' => $PDL_B,
+# 'short' => $PDL_S, '1' => $PDL_S, 's' => $PDL_S,
+# 'ushort' => $PDL_US,'2' => $PDL_US,'u' => $PDL_US,
+# 'long' => $PDL_L, '3' => $PDL_L, 'l' => $PDL_L,
+# 'float' => $PDL_F, '4' => $PDL_F, 'f' => $PDL_F,
+# 'double' => $PDL_D, '5' => $PDL_D, 'd' => $PDL_D
+# );
+
+$PDL::IO::FlexRaw::verbose = 0;
+$PDL::IO::FlexRaw::writeflexhdr = defined($PDL::FlexRaw::IO::writeflexhdr) ? $PDL::FlexRaw::IO::writeflexhdr : 0;
+
+sub _read_flexhdr {
+ my ($hname) = @_;
+ my $hfile = new FileHandle "$hname"
+ or barf "Couldn't open '$hname' for reading";
+ binmode $hfile;
+ my ($newfile) = 1;
+ my ($tid, @str);
+ my (@ret);
+ # check for ENVI files and bail (for now)
+ my $line1 = scalar <$hfile>;
+ barf "This is an ENVI format file, please use readenvi()\n" if $line1 =~ /^ENVI\r?$/;
+ seek $hfile, 0, 0; # reset file pointer to beginning
+ ITEM:
+ while (!eof($hfile)) {
+ my (@dims) = (); my ($ndims) = -1, ($mode) = -2;
+ my ($have_badvalue) = undef;
+ my ($badvalue) = undef;
+ LINE:
+ while (<$hfile>) {
+ ### print STDERR "processing line '$_'\n";
+ next LINE if /^#/ or /^\s*$/;
+ chop;
+ tr/A-Z/a-z/;
+ @str = split;
+ TOKEN:
+ ### print STDERR "Got tokens: " . join(',', at str) . "\n";
+ my $numtokens = scalar @str;
+ foreach my $token (@str) {
+ next LINE if $token =~ /^#/;
+ if ($mode == -2) { # type
+ ### print STDERR " \$mode == -2: #tokens=$numtokens, '$token'\n";
+ if ($newfile) {
+ if ($token eq 'f77' || $token eq 'swap') {
+ push @ret, {
+ Type => $token
+ };
+ $numtokens--;
+ next ITEM;
+ }
+ }
+ barf("Bad typename '$token' in readflex") if (!exists($flextypes{$token}));
+ $tid = $flextypes{$token};
+ $numtokens--;
+ $newfile = 0;
+ $mode++;
+ } elsif ($mode == -1) { #ndims
+ ### print STDERR " \$mode == -1: #tokens=$numtokens, '$token'\n";
+ barf("Not number for ndims in readflex") if $token !~ /^\d*$/;
+ $ndims = $token;
+ barf("Bad ndims in readflex") if ($ndims < 0);
+ $numtokens--;
+ $mode++;
+ if ($mode == $ndims and $numtokens == 0) {
+ last LINE;
+ }
+ } elsif ($mode < $ndims) { # get dims
+ ### print STDERR " # get dims: #tokens=$numtokens, '$token'\n";
+ barf("Not number for dimension in readflex")
+ if $token !~ /^\d*$/;
+ push(@dims,$token);
+ $numtokens--;
+ $mode++;
+ if ($mode == $ndims and $numtokens == 0) {
+ last LINE;
+ }
+ } elsif ($mode == $ndims and ! $have_badvalue) { # check for badvalue info
+ ### print STDERR " # ! \$have_badvalue: #tokens=$numtokens, '$token'\n";
+ if ($token =~ /^badvalue$/ ) {
+ $have_badvalue = 1;
+ $numtokens--;
+ last LINE if $numtokens==0; # using default bad value
+ } else {
+ last LINE;
+ }
+ } elsif ($mode == $ndims and $have_badvalue and $numtokens > 0) {
+ ### print STDERR " # \$have_badvalue: #tokens = $numtokens, '$token'\n";
+ $badvalue = $token;
+ last LINE;
+ }
+ }
+ }
+ last ITEM if $mode == -2;
+ barf("Bad format in readflex header file ($ndims, $mode)") if ($ndims < 0 || $mode != $ndims);
+ push @ret, {
+ Type => $tid,
+ Dims => \@dims,
+ NDims => $ndims,
+ BadFlag => (($have_badvalue) ? 1 : 0),
+ BadValue => $badvalue,
+ };
+ }
+ return \@ret;
+}
+
+sub readchunk {
+ my ($d, $pdl, $len, $name) = @_;
+ my ($nread);
+ print "Reading $len at $offset from $name\n"
+ if $PDL::IO::FlexRaw::verbose;
+ ($nread = read($d, ${$pdl->get_dataref}, $len)) == $len
+ or barf "Couldn't read $len bytes at offset $offset from '$name', got $nread";
+ $pdl->upd_data();
+ $offset += $len;
+ return 1;
+}
+
+sub myhandler {
+ $flexmapok = 0;
+ barf "Data out of alignment, can't map further\n";
+ die;
+}
+
+sub mapchunk {
+ my ($orig, $pdl, $len, $name) = @_;
+ # link $len at $offset from $orig to $pdl.
+ # print "linking $len bytes from $offset\n";
+ $pdl->set_data_by_offset($orig,$offset);
+ local ($flexmapok)=1;
+ local $SIG{BUS} = \&myhandler unless $^O =~ /MSWin32/i;
+ local $SIG{FPE} = \&myhandler;
+ eval {$pdl->clump(-1)->at(0)};
+ $offset += $len;
+ $flexmapok;
+}
+
+sub readflex {
+ barf 'Usage ($x,$y,...) = readflex("filename"|FILEHANDLE [, \@hdr])'
+ if $#_ > 1;
+ my ($name,$h) = @_;
+ my ($hdr, $pdl, $len, @out, $chunk, $chunkread, $data);
+ local ($offset) = 0;
+ my ($newfile, $swapbyte, $f77mode, $zipt) = (1,0,0,0);
+ my $d;
+
+ # Test if $name is a file handle
+ if (defined fileno($name)) {
+ $d = $name;
+ binmode($d);
+ }
+ else {
+ if ($name =~ s/\.gz$// || $name =~ s/\.Z$// ||
+ (! -e $name && (-e $name.'.gz' || -e $name.'.Z'))) {
+ $data = "gzip -dcq $name |";
+ $zipt = 1;
+ } else {
+ $data = $name;
+ }
+
+ my ($size) = (stat $name)[7];
+ $d = new FileHandle $data
+ or barf "Couldn't open '$data' for reading";
+ binmode $d;
+ $h = _read_flexhdr("$name.hdr")
+ unless $h;
+ }
+
+# Go through headers which reconfigure
+ foreach $hdr (@$h) {
+ my ($type) = $hdr->{Type};
+ if ($type eq 'swap') {
+ $swapbyte = 1;
+ } elsif ($type ne 'f77') {
+ last;
+ }
+ }
+
+READ:
+ foreach $hdr (@$h) {
+ my ($type) = $hdr->{Type};
+ # Case convert when we have user data
+ $type =~ tr/A-Z/a-z/ if $#_ == 1;
+ if ($newfile) {
+ if ($type eq 'f77') {
+ $hdr = {
+ Type => $PDL_L,
+ Dims => [ ],
+ NDims => 0
+ };
+ $type = $PDL_L;
+ $f77mode = 1;
+ } elsif ($type eq 'swap') {
+ next READ;
+ } else {
+ $newfile = 0;
+ }
+ }
+ if ($#_ == 1) {
+ barf("Bad typename '$type' in readflex")
+ if (!defined($flextypes{$type}));
+ $type = $flextypes{$type};
+ }
+ $pdl = PDL->zeroes ((new PDL::Type($type)),
+ ref $hdr->{Dims} ? @{$hdr->{Dims}} : $hdr->{Dims});
+ $len = length $ {$pdl->get_dataref};
+
+ &readchunk($d,$pdl,$len,$name) or last READ;
+ $chunkread += $len;
+ if ($swapbyte) {
+ my $method = $flexswap{$type};
+ $pdl->$method if $method;
+# bswap2($pdl) if $pdl->get_datatype == $PDL_S;
+# bswap4($pdl) if $pdl->get_datatype == $PDL_L
+# || $pdl->get_datatype == $PDL_F;
+# bswap8($pdl) if $pdl->get_datatype == $PDL_D;
+ }
+ if ($newfile && $f77mode) {
+ if ($zipt || $swapbyte) {
+ $chunk = $pdl->copy;
+ $chunkread = 0;
+ next READ;
+ } else {
+ SWAP:
+ foreach (0,1) {
+ seek($d,4,0);
+ $swapbyte = $_;
+ bswap4($pdl) if $swapbyte;
+ $chunk = $pdl->copy;
+ next SWAP if ! seek($d,$pdl->at,1);
+ next SWAP if
+ read($d,$ {$chunk->get_dataref},$len) != $len;
+ $chunk->upd_data;
+ bswap4($chunk) if $swapbyte;
+ next SWAP if ($pdl->at != $chunk->at);
+ $chunkread = 0;
+ barf "Error can't rewind" if !seek($d,4,0);
+ # print "OK".($swapbyte?", swapped":""),"\n";
+ next READ;
+ }
+ barf "Error: Doesn't look like f77 file (even swapped)";
+ }
+ }
+
+ if ($hdr->{BadFlag}) { # set badflag and badvalue if needed
+ $pdl->badflag($hdr->{BadFlag});
+ $pdl->badvalue($hdr->{BadValue}) if defined $hdr->{BadValue};
+ }
+ push (@out,$pdl);
+
+ if ($f77mode && $chunk->at == $chunkread) {
+ $chunkread = 0;
+ my ($check) = $chunk->copy;
+ &readchunk($d,$check,4,$name) or last READ;
+ bswap4($check) if $swapbyte;
+ if ($check->at ne $chunk->at) {
+ barf "F77 file format error for $check cf $chunk";
+ last READ;
+ }
+ if (!eof($d)) {
+ &readchunk($d,$chunk,4,$name) or last READ;
+ bswap4($chunk) if $swapbyte;
+ } else {
+ last READ;
+ }
+ }
+ }
+ wantarray ? @out : $out[0];
+}
+
+sub mapflex {
+ my ($usage)
+ = 'Usage ($x,$y,...) = mapflex("filename" [, \@hdr] [,\%opts])';
+ my $name = shift;
+ # reference to header array
+ my ($h, $size);
+ # reference to options array, with defaults
+ my (%opts) = ( 'ReadOnly' => 0, 'Creat' => 0, 'Trunc' => 0 );
+
+ my ($hdr, $d, $pdl, $len, @out, $chunk, $chunkread);
+ local ($offset) = 0;
+ my ($newfile, $swapbyte, $f77mode, $zipt) = (1,0,0,0);
+
+ foreach (@_) {
+ if (ref($_) eq "ARRAY") {
+ $h = $_;
+ } elsif (ref($_) eq "HASH") {
+ %opts = (%opts,%$_);
+ } else {
+ warn $usage;
+ }
+ }
+
+ if ($name =~ s/\.gz$// || $name =~ s/\.Z$// ||
+ (! -e $name && (-e $name.'.gz' || -e $name.'.Z'))) {
+ barf "Can't map compressed file";
+ }
+
+ if (!defined $h) {
+ $h = _read_flexhdr("$name.hdr");
+ }
+
+# Go through headers which reconfigure
+ foreach $hdr (@$h) {
+ my ($type) = $hdr->{Type};
+ if ($type eq 'swap') {
+ barf "Can't map byte swapped file";
+ } elsif ($type eq 'f77') {
+ $f77mode = 1;
+ } else {
+ my($si) = 1;
+ foreach (ref $hdr->{Dims} ? @{$hdr->{Dims}} : $hdr->{Dims}) {
+ $si *= $_;
+ }
+ barf("Bad typename '$type' in mapflex")
+ unless defined $flextypes{$type};
+ $type = $flextypes{$type};
+ $size += $si * PDL::Core::howbig ($type);
+ }
+ }
+# $s now contains estimated size of data in header --
+# setting $f77mode means that it will be 8 x n bigger in reality
+ $size += 8 if ($f77mode);
+ if (!($opts{Creat})) {
+ my ($s) = $size;
+ $size = (stat $name)[7];
+ barf "File looks too small ($size cf header $s)" if $size < $s;
+ }
+ # print "Size $size f77mode $f77mode\n";
+
+ $d = PDL->zeroes(byte());
+
+ # print "Mapping total size $size\n";
+ # use Data::Dumper;
+ # print "Options: ", Dumper(\%opts), "\n";
+ if ($have_file_map and not defined($PDL::force_use_mmap_code) ) {
+ $d->set_data_by_file_map($name,
+ $size,
+ 1,
+ ($opts{ReadOnly}?0:1),
+ ($opts{Creat}?1:0),
+ (0644),
+ ($opts{Creat} || $opts{Trunc} ? 1:0)
+ );
+ } else {
+ warn "mapflex: direct mmap support being deprecated, please install File::Map\n";
+ $d->set_data_by_mmap($name,
+ $size,
+ 1,
+ ($opts{ReadOnly}?0:1),
+ ($opts{Creat}?1:0),
+ (0644),
+ ($opts{Creat} || $opts{Trunc} ? 1:0)
+ );
+ }
+READ:
+ foreach $hdr (@$h) {
+ my ($type) = $hdr->{Type};
+ # Case convert when we have user data
+ $type =~ tr/A-Z/a-z/ if $#_ == 1;
+ if ($newfile) {
+ if ($type eq 'f77') {
+ $hdr = {
+ Type => $PDL_L,
+ Dims => [ ],
+ NDims => 0
+ };
+ $type = $PDL_L;
+ } else {
+ $newfile = 0;
+ }
+ }
+ if ($#_ == 1) {
+ barf("Bad typename '$type' in mapflex")
+ unless defined $flextypes{$type};
+ $type = $flextypes{$type};
+ }
+ my $pdl = PDL->zeroes ((new PDL::Type($type)),
+ ref $hdr->{Dims} ? @{$hdr->{Dims}} : $hdr->{Dims});
+ $len = length $ {$pdl->get_dataref};
+
+ &mapchunk($d,$pdl,$len,$name) or last READ;
+ $chunkread += $len;
+ if ($newfile && $f77mode) {
+ if ($opts{Creat}) {
+ $pdl->set(0,$size - 8);
+ } else {
+ $chunk = $pdl->copy;
+ }
+ $chunkread = 0;
+ next READ;
+ }
+
+ if ($hdr->{BadFlag}) { # set badflag and badvalue if needed
+ $pdl->badflag($hdr->{BadFlag});
+ $pdl->badvalue($hdr->{BadValue}) if defined $hdr->{BadValue};
+ }
+ push (@out,$pdl);
+
+ if ($f77mode && $chunk->at == $chunkread) {
+ $chunkread = 0;
+ my ($check) = $chunk->copy;
+ &mapchunk($d,$check,4,$name) or last READ;
+ if ($opts{Creat}) {
+ $check->set(0,$size-8);
+ } else {
+ if ($check->at ne $chunk->at) {
+ barf "F77 file format error for $check cf $chunk";
+ last READ;
+ }
+ }
+ barf "Will only map first f77 data statement" if ($offset < $size);
+ last READ;
+ }
+ }
+ wantarray ? @out : $out[0];
+}
+
+sub writeflex {
+ my $usage = 'Usage $hdr = writeflex("filename"|FILEHANDLE,$pdl,...)';
+ barf $usage if $#_<0;
+ my($name) = shift;
+ my $isname = 0;
+ my $hdr;
+ my $d;
+
+ # Test if $name is a file handle
+ if (defined fileno($name)) {
+ $d = $name;
+ binmode $d;
+ }
+ else {
+ barf $usage if ref $name;
+ $isname = 1;
+ my $modename = ($name =~ /^[+]?[><|]/) ? $name : ">$name";
+ $d = new FileHandle $modename
+ or barf "Couldn't open '$name' for writing";
+ binmode $d;
+ }
+ foreach $pdl (@_) {
+ barf $usage if ! ref $pdl;
+ # print join(' ',$pdl->getndims,$pdl->dims),"\n";
+ push @{$hdr}, {
+ Type => $flexnames{$pdl->get_datatype},
+ Dims => [ $pdl->dims ],
+ NDims => $pdl->getndims,
+ BadFlag => $pdl->badflag,
+ BadValue => (($pdl->badvalue == $pdl->orig_badvalue) ? undef : $pdl->badvalue),
+ };
+ print $d $ {$pdl->get_dataref};
+ }
+ if (defined wantarray) {
+ # list or scalar context
+ writeflexhdr($name, $hdr) if $isname and $PDL::IO::FlexRaw::writeflexhdr;
+ return $hdr;
+ } else {
+ # void context so write header file
+ writeflexhdr($name, $hdr) if $isname;
+ return;
+ }
+}
+
+sub writeflexhdr {
+ barf 'Usage writeflex("filename", $hdr)' if $#_!=1 || !ref $_[1];
+ my($name) = shift; my ($hdr) = shift;
+ my $hname = "$name.hdr";
+ my $h = new FileHandle ">$hname"
+ or barf "Couldn't open '$hname' for writing";
+ binmode $h;
+ print $h
+ "# Output from PDL::IO::writeflex, data in $name\n";
+ foreach (@$hdr) {
+ my ($type) = $_->{Type};
+ if (! exists $flextypes{$type}) {
+ barf "Writeflexhdr: will only print data elements, not $type";
+ next;
+ }
+ print $h join("\n",$_->{Type},
+ $_->{NDims},
+ (join ' ',ref $_->{Dims} ? @{$_->{Dims}} : $_->{Dims}) . (($_->{BadFlag}) ? " badvalue $_->{BadValue}" : '')),
+ "\n\n";
+ }
+}
+
+1;
+
+
diff --git a/IO/FlexRaw/Makefile.PL b/IO/FlexRaw/Makefile.PL
new file mode 100644
index 0000000..d771fc4
--- /dev/null
+++ b/IO/FlexRaw/Makefile.PL
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => "PDL::IO::FlexRaw",
+ 'VERSION_FROM' => '../../Basic/Core/Version.pm',
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
diff --git a/IO/GD/Changes b/IO/GD/Changes
new file mode 100644
index 0000000..534604c
--- /dev/null
+++ b/IO/GD/Changes
@@ -0,0 +1,18 @@
+
+PDL::IO::GD Changes:
+
+1.3: 19 Feb 2004 (Judd Taylor)
+ - Added support to write only chunks of PNG images.
+ - Started changelog!
+
+1.6: 12 Oct 2005 (Judd Taylor)
+ - Added functions to set level of compression on PNG images
+ (write_png_ex, write_true_png_ex, write_png_best, write_true_png_best)
+ - Added function recompress_png_best, to open a PNG file, and write it out
+ using the best PNG compression available.
+
+2.0: 30 Mar 2006 (Judd Taylor)
+ - Transferred to new name PDL::IO::GD, and modified for inclusion to the
+ PDL CVS tree.
+
+
diff --git a/IO/GD/GD.pd b/IO/GD/GD.pd
new file mode 100644
index 0000000..b110d06
--- /dev/null
+++ b/IO/GD/GD.pd
@@ -0,0 +1,2291 @@
+#
+# GD.pd
+#
+# PDL interface to the GD c library
+# ('cos looping over a piddle in perl and using the perl GD lib is too slow...)
+#
+# Judd Taylor, USF IMaRS
+# 13 March 2003
+#
+
+use strict;
+#use PDL;
+use vars qw( $VERSION );
+
+$VERSION = "2.1";
+
+#####################################
+# Start the General Interface Docs: #
+#####################################
+
+pp_addpm({ At => 'Top' }, <<'ENDPM');
+=head1 NAME
+
+PDL::IO::GD - Interface to the GD image library.
+
+=head1 SYNOPSIS
+
+ my $pdl = sequence(byte, 30, 30);
+ write_png($pdl, load_lut($lutfile), "test.png");
+
+ write_true_png(sequence(100, 100, 3), "test_true.png");
+
+ my $image = read_png("test.png");
+
+ my $image = read_true_png("test_true_read.png");
+ write_true_png($image, "test_true_read.out.png");
+
+ my $lut = read_png_lut("test.png");
+
+ $pdl = sequence(byte, 30, 30);
+ write_png_ex($pdl, load_lut($lutfile), "test_nocomp.png", 0);
+ write_png_ex($pdl, load_lut($lutfile), "test_bestcomp1.png", 9);
+ write_png_best($pdl, load_lut($lutfile), "test_bestcomp2.png");
+
+ $pdl = sequence(100, 100, 3);
+ write_true_png_ex($pdl, "test_true_nocomp.png", 0);
+ write_true_png_ex($pdl, "test_true_bestcomp1.png", 9);
+ write_true_png_best($pdl, "test_true_bestcomp2.png");
+
+ recompress_png_best("test_recomp_best.png");
+
+=head1 DESCRIPTION
+
+This is the "General Interface" for the PDL::IO::GD library, and is actually several
+years old at this point (read: stable). If you're feeling frisky, try the new OO
+interface described below.
+
+The general version just provides several image IO utility functions you can use with
+piddle variables. It's deceptively useful, however.
+
+=cut
+
+
+ENDPM
+
+
+###########################
+# General Interface Code: #
+###########################
+
+
+# needed header files:
+pp_addhdr(<<'EOH');
+
+#include "gd.h"
+
+#include "gdfontl.h"
+#include "gdfonts.h"
+#include "gdfontmb.h"
+#include "gdfontg.h"
+#include "gdfontt.h"
+
+#include <stdio.h>
+
+#define PKG "PDL::IO::GD"
+
+EOH
+
+# Function to write a PNG image from a piddle variable:
+pp_def( 'write_png',
+ Pars => 'byte img(x,y); byte lut(i,j);',
+ OtherPars => 'char* filename',
+ Doc => <<'ENDDOC',
+Writes a 2-d PDL varable out to a PNG file, using the supplied color look-up-table piddle
+(hereafter referred to as a LUT).
+
+The LUT contains a line for each value 0-255 with a corresponding R, G, and B value.
+ENDDOC
+ Code => <<'EOC' );
+
+gdImagePtr im;
+int xsize, ysize, tmp, ind, x2, y2;
+char str[255];
+FILE *out;
+
+if ($SIZE(i) != 3 || $SIZE(j) > 256)
+{
+ croak("Wrong LUT dimensions (%d, %d)! (should be (3, X), where X <= 256)\n",
+ $SIZE(i), $SIZE(j) );
+}
+
+xsize = $SIZE(x);
+ysize = $SIZE(y);
+
+im = gdImageCreate(xsize, ysize);
+
+/* Set up the color palette */
+for(ind = 0; ind < $SIZE(j); ind++)
+{
+ tmp = gdImageColorAllocate(im, $lut(i=>0,j=>ind), $lut(i=>1,j=>ind), $lut(i=>2,j=>ind));
+ if (tmp != ind)
+ {
+ croak("palette mismatch on index %d (mapped to %d)!\n", ind, tmp);
+ }
+}
+
+/* render the data */
+for( y2 = 0; y2 < $SIZE(y); y2++ )
+{
+ for( x2 = 0; x2 < $SIZE(x); x2++ )
+ {
+ gdImageSetPixel(im, x2, y2, $img(x=>x2,y=>y2));
+ }
+}
+
+/* write the image to the file */
+out = fopen($COMP(filename), "wb");
+
+gdImagePng(im, out);
+
+fclose(out);
+
+gdImageDestroy(im);
+
+EOC
+
+# Function to write a PNG image from a piddle variable, accepting a compression
+# level argument:
+pp_def( 'write_png_ex',
+ Pars => 'img(x,y); lut(i,j);',
+ OtherPars => 'char* filename; int level',
+ Doc => <<'ENDDOC',
+Same as write_png(), except you can specify the compression level (0-9) as the last arguement.
+ENDDOC
+ Code => <<'EOC' );
+
+gdImagePtr im;
+int xsize, ysize, tmp, ind, x2, y2;
+char str[255];
+FILE *out;
+
+if( $COMP(level) < -1 || $COMP(level) > 9 )
+{
+ croak("Invalid compression level %d, should be [-1,9]!\n",
+ $COMP(level) );
+}
+
+if ($SIZE(i) != 3 || $SIZE(j) > 256)
+{
+ croak("Wrong LUT dimensions (%d, %d)! (should be (3, X), where X <= 256)\n",
+ $SIZE(i), $SIZE(j) );
+}
+
+xsize = $SIZE(x);
+ysize = $SIZE(y);
+
+im = gdImageCreate(xsize, ysize);
+
+/* Set up the color palette */
+for(ind = 0; ind < $SIZE(j); ind++)
+{
+ tmp = gdImageColorAllocate(im, $lut(i=>0,j=>ind), $lut(i=>1,j=>ind), $lut(i=>2,j=>ind));
+ if (tmp != ind)
+ {
+ croak("palette mismatch on index %d (mapped to %d)!\n", ind, tmp);
+ }
+}
+
+/* render the data */
+for( y2 = 0; y2 < $SIZE(y); y2++ )
+{
+ for( x2 = 0; x2 < $SIZE(x); x2++ )
+ {
+ gdImageSetPixel(im, x2, y2, $img(x=>x2,y=>y2));
+ }
+}
+
+/* write the image to the file */
+out = fopen($COMP(filename), "wb");
+
+gdImagePngEx(im, out, $COMP(level));
+
+fclose(out);
+
+gdImageDestroy(im);
+
+EOC
+
+# Function to write a TRUE COLOR PNG image from a piddle variable:
+pp_def( 'write_true_png',
+ Pars => 'img(x,y,z);',
+ OtherPars => 'char* filename',
+ Doc => <<'ENDDOC',
+Writes an (x, y, z(3)) PDL varable out to a PNG file, using a true color format.
+
+This means a larger file on disk, but can contain more than 256 colors.
+ENDDOC
+ Code => <<'EOC' );
+
+gdImagePtr im;
+int xsize, ysize, x2, y2;
+char str[255];
+FILE *out;
+
+if ($SIZE(z) != 3)
+{
+ croak("Wrong dimensions (%d, %d, %d)! (should be (X,Y,3))\n",
+ $SIZE(x), $SIZE(y), $SIZE(z) );
+}
+
+xsize = $SIZE(x);
+ysize = $SIZE(y);
+im = gdImageCreateTrueColor(xsize, ysize);
+
+/* render the data */
+for( y2 = 0; y2 < ysize; y2++ )
+{
+ for( x2 = 0; x2 < xsize; x2++ )
+ {
+ gdImageSetPixel(im, x2, y2,
+ gdImageColorResolve(im,
+ $img(x=>x2,y=>y2,z=>0),
+ $img(x=>x2,y=>y2,z=>1),
+ $img(x=>x2,y=>y2,z=>2)
+ )
+ );
+ }
+}
+/* write the image to the file */
+out = fopen($COMP(filename), "wb");
+gdImagePng(im, out);
+fclose(out);
+gdImageDestroy(im);
+EOC
+
+# Function to write a TRUE COLOR PNG image from a piddle variable,
+# with the specified compression level:
+pp_def( 'write_true_png_ex',
+ Pars => 'img(x,y,z);',
+ OtherPars => 'char* filename; int level',
+ Doc => <<'ENDDOC',
+Same as write_true_png(), except you can specify the compression level (0-9) as the last arguement.
+ENDDOC
+ Code => <<'EOC' );
+
+gdImagePtr im;
+int xsize, ysize, x2, y2;
+char str[255];
+FILE *out;
+
+if( $COMP(level) < -1 || $COMP(level) > 9 )
+{
+ croak("Invalid compression level %d, should be [-1,9]!\n",
+ $COMP(level) );
+}
+
+if ($SIZE(z) != 3)
+{
+ croak("Wrong dimensions (%d, %d, %d)! (should be (X,Y,3))\n",
+ $SIZE(x), $SIZE(y), $SIZE(z) );
+}
+
+xsize = $SIZE(x);
+ysize = $SIZE(y);
+im = gdImageCreateTrueColor(xsize, ysize);
+
+/* render the data */
+for( y2 = 0; y2 < ysize; y2++ )
+{
+ for( x2 = 0; x2 < xsize; x2++ )
+ {
+ gdImageSetPixel(im, x2, y2,
+ gdImageColorResolve(im,
+ $img(x=>x2,y=>y2,z=>0),
+ $img(x=>x2,y=>y2,z=>1),
+ $img(x=>x2,y=>y2,z=>2)
+ )
+ );
+ }
+}
+/* write the image to the file */
+out = fopen($COMP(filename), "wb");
+gdImagePngEx( im, out, $COMP(level) );
+fclose(out);
+gdImageDestroy(im);
+EOC
+
+#
+# Add some perl level alias functions to automatically use the best compression
+#
+pp_addpm(<<'ENDPM');
+
+=head2 write_png_best( $img(piddle), $lut(piddle), $filename )
+
+Like write_png(), but it assumes the best PNG compression (9).
+
+=cut
+
+
+sub write_png_best
+{
+ my $img = shift;
+ my $lut = shift;
+ my $filename = shift;
+ return write_png_ex( $img, $lut, $filename, 9 );
+} # End of write_png_best()...
+
+=head2 write_true_png_best( $img(piddle), $filename )
+
+Like write_true_png(), but it assumes the best PNG compression (9).
+
+=cut
+
+
+sub write_true_png_best
+{
+ my $img = shift;
+ my $filename = shift;
+ return write_true_png_ex( $img, $filename, 9 );
+} # End of write_true_png_best()...
+
+ENDPM
+# End of best copression aliases
+pp_add_exported( '', 'write_png_best write_true_png_best' );
+
+#
+# Function to recompress PNG files with the best compression available:
+# NOTE: libgd doesn't return anything, so there's nothing to check!
+pp_addpm( '', <<'ENDPM' );
+=head2 recompress_png_best( $filename )
+
+Recompresses the given PNG file using the best compression (9).
+
+=cut
+
+
+ENDPM
+pp_addxs( '', <<'ENDXS' );
+
+void
+recompress_png_best(char* filename)
+ CODE:
+ gdImagePtr im;
+ FILE* file;
+ file = fopen(filename, "rb");
+ im = gdImageCreateFromPng(file);
+ fclose(file);
+ file = fopen(filename, "wb");
+ gdImagePngEx( im, file, 9 );
+ fclose(file);
+ gdImageDestroy(im);
+
+ENDXS
+pp_add_exported( '', 'recompress_png_best' );
+# End of recompress_png_best() XS code...
+
+pp_addpm(<<'EOPM');
+
+=head2 load_lut( $filename )
+
+Loads a color look up table from an ASCII file. returns a piddle
+
+=cut
+
+
+sub load_lut
+{
+ return xchg(byte(cat(rcols(shift))), 0, 1);
+} # end of load_lut()...
+
+=head2 read_png( $filename )
+
+Reads a (palette) PNG image into a (new) PDL variable.
+
+=cut
+
+
+sub read_png
+{
+ my $filename = shift;
+
+ # Get the image dims...
+ my $x = _get_png_xs($filename);
+ my $y = _get_png_ys($filename);
+ #print "\$x=$x\t\$y=$y\n";
+
+ my $temp = zeroes(long, $x, $y);
+ _read_png($temp, $filename);
+ return byte($temp);
+} # End of read_png()...
+
+=head2 read_png_true( $filename )
+
+Reads a true color PNG image into a (new) PDL variable.
+
+=cut
+
+
+sub read_true_png
+{
+ my $filename = shift;
+
+ # Get the image dims...
+ my $x = _get_png_xs($filename);
+ my $y = _get_png_ys($filename);
+ #print "\$x=$x\t\$y=$y\n";
+
+
+ my $temp = zeroes(long, $x, $y, 3);
+ _read_true_png($temp, $filename);
+ return byte($temp);
+} # End of read_png()...
+
+
+EOPM
+
+pp_add_exported('', 'load_lut read_png read_true_png');
+
+pp_addxs('', <<'EOXS');
+int
+_get_png_xs(char* filename)
+ CODE:
+ gdImagePtr im;
+ FILE* in;
+
+ in = fopen(filename, "rb");
+ im = gdImageCreateFromPng(in);
+ fclose(in);
+ RETVAL = gdImageSX(im);
+ gdImageDestroy(im);
+ OUTPUT:
+ RETVAL
+
+int
+_get_png_ys(char* filename)
+ CODE:
+ gdImagePtr im;
+ FILE* in;
+
+ in = fopen(filename, "rb");
+ im = gdImageCreateFromPng(in);
+ fclose(in);
+ RETVAL = gdImageSY(im);
+ gdImageDestroy(im);
+ OUTPUT:
+ RETVAL
+EOXS
+
+# Function to read a TRUE COLOR PNG image into a piddle variable:
+pp_def( '_read_true_png',
+ Pars => 'int [o] img(x,y,z);',
+ OtherPars => 'char* filename',
+ Doc => undef,
+ Code => <<'EOC' );
+gdImagePtr im;
+int xsize, ysize, x2, y2, z2;
+char* func = "PDL::IO::GD::_read_png(): ";
+char str[255];
+FILE *in = NULL;
+
+in = fopen($COMP(filename), "rb");
+if ( in == NULL )
+{
+ croak("%sError opening %s!\n", func, $COMP(filename));
+}
+
+im = gdImageCreateFromPng(in);
+if ( im == NULL )
+{
+ croak("%sError reading PNG data!\n", func);
+}
+fclose(in);
+
+xsize = gdImageSX(im);
+ysize = gdImageSY(im);
+
+/* Check the dims... */
+if ( !( ($SIZE(x)==xsize) && ($SIZE(y)==ysize) ) )
+{
+ croak("%sDims of %s (%dx%d) and piddle (%dx%d) do not match!\n",
+ func, $COMP(filename), xsize, ysize, $SIZE(x), $SIZE(y));
+}
+
+/* read the data */
+for( y2 = 0; y2 < ysize; y2++ )
+{
+ for( x2 = 0; x2 < xsize; x2++ )
+ {
+ int tpixel = gdImageTrueColorPixel(im, x2, y2);
+ $img(x=>x2,y=>y2,z=>0) = gdTrueColorGetRed(tpixel);
+ $img(x=>x2,y=>y2,z=>1) = gdTrueColorGetGreen(tpixel);
+ $img(x=>x2,y=>y2,z=>2) = gdTrueColorGetBlue(tpixel);
+ }
+}
+gdImageDestroy(im);
+EOC
+
+# Function to read PNG image into a piddle variable:
+pp_def( '_read_png',
+ Pars => 'int [o] img(x,y);',
+ OtherPars => 'char* filename',
+ Doc => undef,
+ Code => <<'EOC' );
+gdImagePtr im;
+int xsize, ysize, x2, y2;
+char* func = "PDL::IO::GD::_read_png(): ";
+char str[255];
+FILE *in = NULL;
+
+in = fopen($COMP(filename), "rb");
+if ( in == NULL )
+{
+ croak("%sError opening %s!\n", func, $COMP(filename));
+}
+
+im = gdImageCreateFromPng(in);
+if ( im == NULL )
+{
+ croak("%sError reading PNG data!\n", func);
+}
+fclose(in);
+
+xsize = gdImageSX(im);
+ysize = gdImageSY(im);
+
+/* Check the dims... */
+if ( !( ($SIZE(x)==xsize) && ($SIZE(y)==ysize) ) )
+{
+ croak("%sDims of %s (%dx%d) and piddle (%dx%d) do not match!\n",
+ func, $COMP(filename), xsize, ysize, $SIZE(x), $SIZE(y));
+}
+
+/* read the data */
+for( y2 = 0; y2 < ysize; y2++ )
+{
+ for( x2 = 0; x2 < xsize; x2++ )
+ {
+ $img(x=>x2,y=>y2) = gdImageGetPixel(im, x2, y2);
+ }
+}
+/* write the image to the file */
+gdImageDestroy(im);
+EOC
+
+pp_def( '_gd_image_to_pdl_true',
+ Pars => 'byte [o] img(x,y,z);',
+ OtherPars => 'IV img_ptr',
+ Doc => undef,
+ Code => <<'ENDCODE' );
+int xsize, ysize, x2, y2, z2;
+gdImagePtr im = INT2PTR(gdImagePtr, $COMP(img_ptr));
+char* func = "PDL::IO::GD::_gd_image_to_pdl_true(): ";
+char str[255];
+
+xsize = gdImageSX(im);
+ysize = gdImageSY(im);
+
+/* Check the dims... */
+if ( !( ($SIZE(x)==xsize) && ($SIZE(y)==ysize) ) )
+{
+ croak("%sDims of gdImage (%dx%d) and piddle (%dx%d) do not match!\n",
+ func, xsize, ysize, $SIZE(x), $SIZE(y));
+}
+
+/* read the data */
+for( y2 = 0; y2 < ysize; y2++ )
+{
+ for( x2 = 0; x2 < xsize; x2++ )
+ {
+ int tpixel = gdImageTrueColorPixel(im, x2, y2);
+ $img(x=>x2,y=>y2,z=>0) = gdTrueColorGetRed(tpixel);
+ $img(x=>x2,y=>y2,z=>1) = gdTrueColorGetGreen(tpixel);
+ $img(x=>x2,y=>y2,z=>2) = gdTrueColorGetBlue(tpixel);
+ }
+}
+ENDCODE
+
+pp_def( '_gd_image_to_pdl',
+ Pars => 'byte [o] img(x,y);',
+ OtherPars => 'IV img_ptr',
+ Doc => undef,
+ Code => <<'ENDCODE' );
+int xsize, ysize, x2, y2;
+char* func = "PDL::IO::GD::_gd_image_to_pdl(): ";
+gdImagePtr im = INT2PTR(gdImagePtr, $COMP(img_ptr));
+char str[255];
+
+xsize = gdImageSX(im);
+ysize = gdImageSY(im);
+
+/* Check the dims... */
+if ( !( ($SIZE(x)==xsize) && ($SIZE(y)==ysize) ) )
+{
+ croak("%sDims of gdImage (%dx%d) and piddle (%dx%d) do not match!\n",
+ func, xsize, ysize, $SIZE(x), $SIZE(y));
+}
+
+/* read the data */
+for( y2 = 0; y2 < ysize; y2++ )
+{
+ for( x2 = 0; x2 < xsize; x2++ )
+ {
+ $img(x=>x2,y=>y2) = gdImageGetPixel(im, x2, y2);
+ }
+}
+ENDCODE
+
+pp_def( '_pdl_to_gd_image_true',
+ Pars => 'byte img(x,y,z); longlong [o] img_ptr(i)',
+ Doc => undef,
+ Code => <<'ENDCODE' );
+gdImagePtr im;
+int xsize, ysize, x2, y2;
+char str[255];
+
+if ($SIZE(z) != 3)
+{
+ croak("Wrong dimensions (%d, %d, %d)! (should be (X,Y,3))\n",
+ $SIZE(x), $SIZE(y), $SIZE(z) );
+}
+
+xsize = $SIZE(x);
+ysize = $SIZE(y);
+im = gdImageCreateTrueColor(xsize, ysize);
+
+/* render the data */
+for( y2 = 0; y2 < ysize; y2++ )
+{
+ for( x2 = 0; x2 < xsize; x2++ )
+ {
+ gdImageSetPixel(im, x2, y2,
+ gdImageColorResolve(im,
+ $img(x=>x2,y=>y2,z=>0),
+ $img(x=>x2,y=>y2,z=>1),
+ $img(x=>x2,y=>y2,z=>2)
+ )
+ );
+ }
+}
+$img_ptr(i=>0) = (PDL_LongLong) PTR2IV(im);
+ENDCODE
+
+pp_def( '_pdl_to_gd_image_lut',
+ Pars => 'byte img(x,y); byte lut(i,j); longlong [o] img_ptr(q)',
+ Doc => undef,
+ Code => <<'ENDCODE' );
+
+gdImagePtr im;
+int xsize, ysize, tmp, ind, x2, y2;
+char str[255];
+
+if ($SIZE(i) != 3 || $SIZE(j) > 256)
+{
+ croak("Wrong LUT dimensions (%d, %d)! (should be (3, X), where X <= 256)\n",
+ $SIZE(i), $SIZE(j) );
+}
+
+xsize = $SIZE(x);
+ysize = $SIZE(y);
+
+im = gdImageCreate(xsize, ysize);
+
+/* Set up the color palette */
+for(ind = 0; ind < $SIZE(j); ind++)
+{
+ tmp = gdImageColorAllocate(im, $lut(i=>0,j=>ind), $lut(i=>1,j=>ind), $lut(i=>2,j=>ind));
+ if (tmp != ind)
+ {
+ croak("palette mismatch on index %d (mapped to %d)!\n", ind, tmp);
+ }
+}
+
+/* render the data */
+for( y2 = 0; y2 < $SIZE(y); y2++ )
+{
+ for( x2 = 0; x2 < $SIZE(x); x2++ )
+ {
+ gdImageSetPixel(im, x2, y2, $img(x=>x2,y=>y2));
+ }
+}
+$img_ptr(q=>0) = (PDL_LongLong) PTR2IV(im);
+ENDCODE
+
+# Function to write Read PNG LUT Table into a piddle variable:
+pp_addpm(<<'EOPM');
+
+=head2 my $lut = read_png_lut( $filename )
+
+Reads a color LUT from an already-existing palette PNG file.
+
+=cut
+
+
+sub read_png_lut
+{
+ my $filename = shift;
+ my $lut = zeroes(byte, 3, 256);
+ _read_png_lut($lut, $filename);
+ return $lut;
+} # End of read_png_lut()...
+EOPM
+
+pp_add_exported('', 'read_png_lut');
+
+pp_def( '_read_png_lut',
+ Pars => 'byte [o] lut(c,i);',
+ OtherPars => 'char* filename',
+ Doc => undef,
+ Code => <<'EOC' );
+gdImagePtr im;
+int ind;
+char* func = "PDL::IO::GD::_read_png_lut(): ";
+char str[255];
+FILE *in = NULL;
+
+/* Check dims: */
+if ( $SIZE(c) != 3 )
+{
+ croak("%sLUT dims should be 3,256!\n", func);
+}
+
+in = fopen($COMP(filename), "rb");
+if ( in == NULL )
+{
+ croak("%sError opening %s!\n", func, $COMP(filename));
+}
+
+im = gdImageCreateFromPng(in);
+if ( im == NULL )
+{
+ croak("%sError reading PNG data!\n", func);
+}
+fclose(in);
+
+/* read the data */
+for( ind = 0; ind < 256; ind++ )
+{
+ $lut(c=>0,i=>ind) = gdImageRed(im, ind);
+ $lut(c=>1,i=>ind) = gdImageGreen(im, ind);
+ $lut(c=>2,i=>ind) = gdImageBlue(im, ind);
+}
+gdImageDestroy(im);
+EOC
+
+
+pp_addxs( <<'ENDXS' );
+void
+_gdImageDestroy( im )
+ gdImagePtr im
+ CODE:
+ /* fprintf( stderr, "_gdImageDestroy(): gdImagePtr = %p (d=%d x=%x l=%ld ll=%lld)\n", im, im, im, im, im);*/
+ gdImageDestroy ( im );
+ OUTPUT:
+ENDXS
+
+
+####################
+# NEW OO Interface #
+####################
+
+##############################################
+# Autogeneration of the low level interface: #
+##############################################
+
+##################################################
+# Process functions to create images from files: #
+##################################################
+
+#########################################
+# Start the PDL::IO::GD OO module code: #
+#########################################
+pp_addpm( { At => 'Bot' }, <<'ENDPM' );
+
+=head1 OO INTERFACE
+
+Object Oriented interface to the GD image library.
+
+=head1 SYNOPSIS
+
+ # Open an existing file:
+ #
+ my $gd = PDL::IO::GD->new( { filename => "test.png" } );
+
+ # Query the x and y sizes:
+ my $x = $gd->SX();
+ my $y = $gd->SY();
+
+ # Grab the PDL of the data:
+ my $pdl = $gd->to_pdl();
+
+ # Kill this thing:
+ $gd->DESTROY();
+
+ # Create a new object:
+ #
+ my $im = PDL::IO::GD->new( { x => 300, y => 300 } );
+
+ # Allocate some colors:
+ #
+ my $black = $im->ColorAllocate( 0, 0, 0 );
+ my $red = $im->ColorAllocate( 255, 0, 0 );
+ my $green = $im->ColorAllocate( 0, 255, 0 );
+ my $blue = $im->ColorAllocate( 0, 0, 255 );
+
+ # Draw a rectangle:
+ $im->Rectangle( 10, 10, 290, 290, $red );
+
+ # Add some text:
+ $im->String( gdFontGetLarge(), 20, 20, "Test Large Font!", $green );
+
+ # Write the output file:
+ $im->write_Png( "test2.png" );
+
+=head1 DESCRIPTION
+
+This is the Object-Oriented interface from PDL to the GD image library.
+
+See L<http://www.boutell.com/gd/> for more information on the GD library and how it works.
+
+=head2 IMPLEMENTATION NOTES
+
+Surprisingly enough, this interface has nothing to do with the other Perl->GD interface module,
+aka 'GD' (as in 'use GD;'). This is done from scratch over the years.
+
+Requires at least version 2.0.22 of the GD library, but it's only been thoroughly tested with
+gd-2.0.33, so it would be best to use that. The 2.0.22 requirement has to do with a change in
+GD's font handling functions, so if you don't use those, then don't worry about it.
+
+I should also add, the statement about "thoroughly tested" above is mostly a joke. This OO
+interface is very young, and it has I<barely> been tested at all, so if something
+breaks, email me and I'll get it fixed ASAP (for me).
+
+Functions that manipulate and query the image objects generally have a 'gdImage' prefix on the
+function names (ex: gdImageString()). I've created aliases here for all of those member
+functions so you don't have to keep typing 'gdImage' in your code, but the long version are in
+there as well.
+
+=head1 FUNCTIONS
+
+=cut
+
+use PDL;
+use PDL::Slices;
+use PDL::IO::Misc;
+
+#
+# Some helper functions:
+#
+sub _pkg_name
+ { return "PDL::IO::GD::" . (shift) . "()"; }
+
+# ID a file type from it's filename:
+sub _id_image_file
+{
+ my $filename = shift;
+
+ return 'png'
+ if( $filename =~ /\.png$/ );
+
+ return 'jpg'
+ if( $filename =~ /\.jpe?g$/ );
+
+ return 'wbmp'
+ if( $filename =~ /\.w?bmp$/ );
+
+ return 'gd'
+ if( $filename =~ /\.gd$/ );
+
+ return 'gd2'
+ if( $filename =~ /\.gd2$/ );
+
+ return 'gif'
+ if( $filename =~ /\.gif$/ );
+
+ return 'xbm'
+ if( $filename =~ /\.xbm$/ );
+
+ return undef;
+} # End of _id_image_file()...
+
+# Load a new file up (don't read it yet):
+sub _img_ptr_from_file
+{
+ my $filename = shift;
+ my $type = shift;
+
+ return _gdImageCreateFromPng( $filename )
+ if( $type eq 'png' );
+
+ return _gdImageCreateFromJpeg( $filename )
+ if( $type eq 'jpg' );
+
+ return _gdImageCreateFromWBMP( $filename )
+ if( $type eq 'wbmp' );
+
+ return _gdImageCreateFromGd( $filename )
+ if( $type eq 'gd' );
+
+ return _gdImageCreateFromGd2( $filename )
+ if( $type eq 'gd2' );
+
+ return _gdImageCreateFromGif( $filename )
+ if( $type eq 'gif' );
+
+ return _gdImageCreateFromXbm( $filename )
+ if( $type eq 'xbm' );
+
+ return undef;
+} # End of _img_ptr_from_file()...
+
+# ID a file type from it's "magic" header in the image data:
+sub _id_image_data
+{
+ my $data = shift;
+ my $magic = substr($data,0,4);
+
+ return 'png'
+ if( $magic eq "\x89PNG" );
+
+ return 'jpg'
+ if( $magic eq "\377\330\377\340" );
+ return 'jpg'
+ if( $magic eq "\377\330\377\341" );
+ return 'jpg'
+ if( $magic eq "\377\330\377\356" );
+
+ return 'gif'
+ if( $magic eq "GIF8" );
+
+ return 'gd2'
+ if( $magic eq "gd2\000" );
+
+ # Still need filters for WBMP and .gd!
+
+ return undef;
+} # End of _id_image_data()...
+
+
+# Load a new data scalar up:
+sub _img_ptr_from_data
+{
+ my $data = shift;
+ my $type = shift;
+
+ return _gdImageCreateFromPngPtr( $data )
+ if( $type eq 'png' );
+
+ return _gdImageCreateFromJpegPtr( $data )
+ if( $type eq 'jpg' );
+
+ return _gdImageCreateFromWBMPPtr( $data )
+ if( $type eq 'wbmp' );
+
+ return _gdImageCreateFromGdPtr( $data )
+ if( $type eq 'gd' );
+
+ return _gdImageCreateFromGd2Ptr( $data )
+ if( $type eq 'gd2' );
+
+ return _gdImageCreateFromGifPtr( $data )
+ if( $type eq 'gif' );
+
+ return undef;
+} # End of _img_ptr_from_data()...
+
+
+=head2 new
+
+Creates a new PDL::IO::GD object.
+
+Accepts a hash describing how to create the object. Accepts a single hash ( with
+curly braces ), an inline hash (the same, but without the braces) or a single
+string interpreted as a filename. Thus the following are all equivalent:
+
+ PDL::IO::GD->new( {filename => 'image.png'} );
+ PDL::IO::GD->new( filename => 'image.png' );
+ PDL::IO::GD->new( 'image.png' );
+
+If the hash has:
+
+ pdl => $pdl_var (lut => $lut_piddle)
+ Then a new GD is created from that PDL variable.
+
+ filename => $file
+ Then a new GD is created from the image file.
+
+ x => $num, y => $num
+ Then a new GD is created as a palette image, with size x, y
+
+ x => $num, y => $num, true_color => 1
+ Then a new GD is created as a true color image, with size x, y
+
+ data => $scalar (type => $typename)
+ Then a new GD is created from the file data stored in $scalar.
+ If no type is given, then it will try to guess the type of the data, but
+ this will not work for WBMP and gd image types. For those types, you
+ _must_ specify the type of the data, or the operation will fail.
+ Valid types are: 'jpg', 'png', 'gif', 'gd', 'gd2', 'wbmp'.
+
+Example:
+
+ my $gd = PDL::IO::GD->new({ pdl => $pdl_var });
+
+ my $gd = PDL::IO::GD->new({ pdl => $pdl_var, lut => $lut_piddle });
+
+ my $gd = PDL::IO::GD->new({ filename => "image.png" });
+
+ my $gd = PDL::IO::GD->new({ x => 100, y => 100 });
+
+ my $gd = PDL::IO::GD->new({ x => 100, y => 100, true_color => 1 });
+
+ my $gd = PDL::IO::GD->new({ data => $imageData });
+
+ my $gd = PDL::IO::GD->new({ data => $imageData, type => 'wbmp' });
+
+=cut
+
+sub new
+{
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ #my $self = $class->SUPER::new( @_ );
+ my $self = {};
+
+ my $sub = _pkg_name( "new" );
+
+ # Figure out our options:
+
+ # I want a single hash. I handle several cases here
+ my $options;
+ if( @_ == 1 && ref $_[0] eq 'HASH' ) {
+ # single hash argument. Just take it
+ $options = shift;
+ }
+ elsif( @_ == 1 && ! ref $_[0] ) {
+ # single scalar argument. Treat it as a filename by default
+ my $filename = shift;
+ $options = { filename => $filename };
+ }
+ else {
+ # the only other acceptable option is an inline hash. This is valid if I
+ # have an even number of arguments, and the even-indexed ones (the keys)
+ # are scalars
+ if( @_ % 2 == 0 ) {
+ my $Npairs = scalar(@_)/2;
+
+ use List::MoreUtils 'none';
+ if( List::MoreUtils::none { ref $_[2*$_] } 0..$Npairs-1 ) {
+ # treat the arguments as a hash
+ $options = { @_ }
+ }
+ }
+ }
+
+ if( !defined $options ) {
+ die <<EOF;
+PDL::IO::GD::new couldn't parse its arguments.
+Expected a hash-ref or an inline hash or just a filename
+EOF
+ }
+
+
+
+ if( defined( $options->{pdl} ) )
+ { # Create it from a PDL variable:
+ my $pdl = $options->{pdl};
+ $pdl->make_physical();
+ my $num_dims = scalar( $pdl->dims() );
+ if( $num_dims == 2 )
+ {
+ if( defined( $options->{lut} ) )
+ {
+ my $ptr = zeroes( longlong, 1 );
+ my $lut = $options->{lut};
+ _pdl_to_gd_image_lut( $pdl, $lut, $ptr );
+# print STDERR "in new (with lut), setting IMG_PTR to " . $ptr->at(0) . "\n";
+ $self->{IMG_PTR} = $ptr->at(0);
+ $ptr = null;
+ die "$sub: _pdl_to_gd_image_lut() failed!\n"
+ if( $self->{IMG_PTR} == 0 );
+ }
+ else
+ {
+ my $ptr = zeroes( longlong, 1 );
+ my $lut = sequence(byte, 255)->slice("*3,:");
+ _pdl_to_gd_image_lut( $pdl, $lut, $ptr );
+# print STDERR "in new (no lut), setting IMG_PTR to " . $ptr->at(0) . "\n";
+ $self->{IMG_PTR} = $ptr->at(0);
+ $ptr = null;
+ die "$sub: _pdl_to_gd_image_lut() failed!\n"
+ if( $self->{IMG_PTR} == 0 );
+ }
+ }
+ elsif( $num_dims == 3 )
+ {
+ my $ptr = zeroes( longlong, 1 );
+ _pdl_to_gd_image_true( $pdl, $ptr );
+# print STDERR "in new (ndims=3), setting IMG_PTR to " . $ptr->at(0) . "\n";
+ $self->{IMG_PTR} = $ptr->at(0);
+ $ptr = null;
+ die "$sub: _pdl_to_gd_image_true() failed!\n"
+ if( $self->{IMG_PTR} == 0 );
+ }
+ else
+ {
+ die "Can't create a PDL::IO::GD from a PDL with bad dims!\n";
+ }
+ }
+ elsif( defined( $options->{filename} ) )
+ { # Create it from a file:
+
+ # Figure out what type of file it is:
+ $self->{input_type} = _id_image_file( $options->{filename} )
+ or die "$sub: Can't determine image type of filename => \'$options->{filename}\'!\n";
+
+ # Read in the file:
+ $self->{IMG_PTR} = _img_ptr_from_file( $options->{filename}, $self->{input_type} )
+ or die "$sub: Can't read in the input file!\n";
+ }
+ elsif( defined( $options->{x} ) && defined( $options->{y} ) )
+ { # Create an empty image:
+ my $done = 0;
+ if( defined( $options->{true_color} ) )
+ {
+ if( $options->{true_color} )
+ { # Create an empty true color image:
+ $self->{IMG_PTR} = _gdImageCreateTrueColor( $options->{x}, $options->{y} );
+ die "$sub: _gdImageCreateTrueColor() failed!\n"
+ if( $self->{IMG_PTR} == 0 );
+ $done = 1;
+ }
+ }
+ unless( $done )
+ { # Create an empty palette image:
+ $self->{IMG_PTR} = _gdImageCreatePalette( $options->{x}, $options->{y} );
+ die "$sub: _gdImageCreatePalette() failed!\n"
+ if( $self->{IMG_PTR} == 0 );
+ }
+ }
+ elsif( defined( $options->{data} ) )
+ { # Create an image from the given image data:
+
+ # Figure out what type of file it is:
+ if( defined( $options->{type} ) &&
+ ( $options->{type} eq 'jpg'
+ || $options->{type} eq 'png'
+ || $options->{type} eq 'gif'
+ || $options->{type} eq 'wbmp'
+ || $options->{type} eq 'gd'
+ || $options->{type} eq 'gd2' ) )
+ {
+ $self->{input_type} = $options->{type};
+ }
+ else
+ {
+ $self->{input_type} = _id_image_data( $options->{data} )
+ or die "$sub: Can't determine image type given data!\n";
+ }
+
+ # Load the data:
+ $self->{IMG_PTR} = _img_ptr_from_data( $options->{data}, $self->{input_type} )
+ or die "$sub: Can't load the input image data!\n";
+ }
+
+ # Bless and return:
+ #
+ bless ($self, $class);
+ return $self;
+} # End of new()...
+
+=head2 to_pdl
+
+When you're done playing with your GDImage and want a piddle back, use this function to return one.
+
+=cut
+
+
+sub to_pdl
+{
+ my $self = shift;
+
+ my $sub = _pkg_name( "to_pdl" );
+
+ my $x = $self->gdImageSX();
+ my $y = $self->gdImageSY();
+
+ if( $self->gdImageTrueColor() )
+ {
+ my $pdl = zeroes(byte, $x, $y, 3);
+ _gd_image_to_pdl_true( $pdl, $self->{IMG_PTR} );
+ return $pdl;
+ }
+
+ my $pdl = zeroes(byte, $x, $y);
+ _gd_image_to_pdl( $pdl, $self->{IMG_PTR} );
+ return $pdl;
+} # End of to_pdl()...
+
+=head2 apply_lut( $lut(piddle) )
+
+Does a $im->ColorAllocate() for and entire LUT piddle at once.
+
+The LUT piddle format is the same as for the general interface above.
+
+=cut
+
+
+sub apply_lut
+{
+ my $self = shift;
+ my $lut = shift;
+
+ # Let the PDL threading engine sort this out:
+ $self->ColorAllocates( $lut->slice("(0),:"), $lut->slice("(1),:"), $lut->slice("(2),:") );
+} # End of apply_lut()...
+
+sub DESTROY
+{
+ my $self = shift;
+ my $sub = _pkg_name( "DESTROY" );
+
+ #print STDERR sprintf("$sub: destroying gdImagePtr: 0x%p (%d) (%ld) (%lld)!\n", $self->{IMG_PTR}, $self->{IMG_PTR},$self->{IMG_PTR},$self->{IMG_PTR});
+
+ if( defined( $self->{IMG_PTR} ) )
+ {
+ _gdImageDestroy( $self->{IMG_PTR} );
+ delete( $self->{IMG_PTR} );
+ }
+} # End of DESTROY()...
+
+=head2 WARNING:
+
+All of the docs below this point are auto-generated (not to mention the actual code),
+so read with a grain of salt, and B<always> check the main GD documentation about how
+that function works and what it does.
+
+=cut
+
+ENDPM
+
+generate_create_functions( <<'ENDCREATE' );
+gdImagePtr gdImageCreateFromPng (FILE * fd);
+gdImagePtr gdImageCreateFromWBMP (FILE * inFile);
+gdImagePtr gdImageCreateFromJpeg (FILE * infile);
+gdImagePtr gdImageCreateFromGd (FILE * in);
+gdImagePtr gdImageCreateFromGd2 (FILE * in);
+gdImagePtr gdImageCreateFromXbm (FILE * in);
+gdImagePtr gdImageCreateFromGif (FILE * fd);
+gdImagePtr gdImageCreate (int sx, int sy);
+gdImagePtr gdImageCreatePalette (int sx, int sy);
+gdImagePtr gdImageCreateTrueColor (int sx, int sy);
+ENDCREATE
+
+generate_create_from_data_functions( <<'ENDCDATA' );
+gdImagePtr gdImageCreateFromPngPtr (int size, void * data);
+gdImagePtr gdImageCreateFromWBMPPtr (int size, void * data);
+gdImagePtr gdImageCreateFromJpegPtr (int size, void * data);
+gdImagePtr gdImageCreateFromGdPtr (int size, void * data);
+gdImagePtr gdImageCreateFromGd2Ptr (int size, void * data);
+gdImagePtr gdImageCreateFromGifPtr (int size, void * data);
+ENDCDATA
+
+
+generate_write_functions( <<'ENDWRITE' );
+void gdImagePng (gdImagePtr im, FILE * out);
+void gdImagePngEx (gdImagePtr im, FILE * out, int level);
+void gdImageWBMP (gdImagePtr image, int fg, FILE * out);
+void gdImageJpeg (gdImagePtr im, FILE * out, int quality);
+void gdImageGd (gdImagePtr im, FILE * out);
+void gdImageGd2 (gdImagePtr im, FILE * out, int cs, int fmt);
+void gdImageGif (gdImagePtr im, FILE * out);
+ENDWRITE
+
+
+generate_data_ptr_functions( <<'ENDDATAPTR' );
+void *gdImagePngPtr (gdImagePtr im, int *size);
+void *gdImagePngPtrEx (gdImagePtr im, int *size, int level);
+void *gdImageWBMPPtr (gdImagePtr im, int *size, int fg);
+void *gdImageJpegPtr (gdImagePtr im, int *size, int quality);
+void *gdImageGdPtr (gdImagePtr im, int *size);
+void *gdImageGd2Ptr (gdImagePtr im, int cs, int fmt, int *size);
+ENDDATAPTR
+
+
+#void gdImageDestroy (gdImagePtr im);
+generate_member_functions( <<'ENDMEMBERS' );
+void gdImageSetPixel (gdImagePtr im, int x, int y, int color);
+int gdImageGetPixel (gdImagePtr im, int x, int y);
+void gdImageAABlend (gdImagePtr im);
+void gdImageLine (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
+void gdImageDashedLine (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
+void gdImageRectangle (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
+void gdImageFilledRectangle (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
+void gdImageSetClip(gdImagePtr im, int x1, int y1, int x2, int y2);
+void gdImageGetClip(gdImagePtr im, int *x1P, int *y1P, int *x2P, int *y2P);
+int gdImageBoundsSafe (gdImagePtr im, int x, int y);
+void gdImageChar (gdImagePtr im, gdFontPtr f, int x, int y, int c, int color);
+void gdImageCharUp (gdImagePtr im, gdFontPtr f, int x, int y, int c, int color);
+void gdImageString (gdImagePtr im, gdFontPtr f, int x, int y, unsigned char *s, int color);
+void gdImageStringUp (gdImagePtr im, gdFontPtr f, int x, int y, unsigned char *s, int color);
+void gdImageString16 (gdImagePtr im, gdFontPtr f, int x, int y, unsigned short *s, int color);
+void gdImageStringUp16 (gdImagePtr im, gdFontPtr f, int x, int y, unsigned short *s, int color);
+void gdImagePolygon (gdImagePtr im, gdPointPtr p, int n, int c);
+void gdImageFilledPolygon (gdImagePtr im, gdPointPtr p, int n, int c);
+int gdImageColorAllocate (gdImagePtr im, int r, int g, int b);
+int gdImageColorAllocateAlpha (gdImagePtr im, int r, int g, int b, int a);
+int gdImageColorClosest (gdImagePtr im, int r, int g, int b);
+int gdImageColorClosestAlpha (gdImagePtr im, int r, int g, int b, int a);
+int gdImageColorClosestHWB (gdImagePtr im, int r, int g, int b);
+int gdImageColorExact (gdImagePtr im, int r, int g, int b);
+int gdImageColorExactAlpha (gdImagePtr im, int r, int g, int b, int a);
+int gdImageColorResolve (gdImagePtr im, int r, int g, int b);
+int gdImageColorResolveAlpha (gdImagePtr im, int r, int g, int b, int a);
+void gdImageColorDeallocate (gdImagePtr im, int color);
+void gdImageTrueColorToPalette (gdImagePtr im, int ditherFlag, int colorsWanted);
+void gdImageColorTransparent (gdImagePtr im, int color);
+void gdImageFilledArc (gdImagePtr im, int cx, int cy, int w, int h, int s, int e, int color, int style);
+void gdImageArc (gdImagePtr im, int cx, int cy, int w, int h, int s, int e, int color);
+void gdImageFilledEllipse (gdImagePtr im, int cx, int cy, int w, int h, int color);
+void gdImageFillToBorder (gdImagePtr im, int x, int y, int border, int color);
+void gdImageFill (gdImagePtr im, int x, int y, int color);
+void gdImageCopyRotated (gdImagePtr dst, gdImagePtr src, double dstX, double dstY, int srcX, int srcY, int srcWidth, int srcHeight, int angle);
+void gdImageSetBrush (gdImagePtr im, gdImagePtr brush);
+void gdImageSetTile (gdImagePtr im, gdImagePtr tile);
+void gdImageSetAntiAliased (gdImagePtr im, int c);
+void gdImageSetAntiAliasedDontBlend (gdImagePtr im, int c, int dont_blend);
+void gdImageSetStyle (gdImagePtr im, int *style, int noOfPixels);
+void gdImageSetThickness (gdImagePtr im, int thickness);
+void gdImageInterlace (gdImagePtr im, int interlaceArg);
+void gdImageAlphaBlending (gdImagePtr im, int alphaBlendingArg);
+void gdImageSaveAlpha (gdImagePtr im, int saveAlphaArg);
+int gdImageTrueColor (gdImagePtr im);
+int gdImageColorsTotal (gdImagePtr im);
+int gdImageRed (gdImagePtr im, int c);
+int gdImageGreen (gdImagePtr im, int c);
+int gdImageBlue (gdImagePtr im, int c);
+int gdImageAlpha (gdImagePtr im, int c);
+int gdImageGetTransparent (gdImagePtr im);
+int gdImageGetInterlaced (gdImagePtr im);
+int gdImageSX (gdImagePtr im);
+int gdImageSY (gdImagePtr im);
+ENDMEMBERS
+#char* gdImageStringTTF (gdImagePtr im, int *brect, int fg, char *fontlist, double ptsize, double angle, int x, int y, char *string);
+#char* gdImageStringFT (gdImagePtr im, int *brect, int fg, char *fontlist, double ptsize, double angle, int x, int y, char *string);
+#ENDMEMBERS
+
+# Allow operation on these member function on piddles as well:
+#int gdImageGetPixel (gdImagePtr im, int x, int y);
+generate_pp_def_members( <<'ENDMEMBERS' );
+int gdImageColorAllocate (gdImagePtr im, int r, int g, int b);
+int gdImageColorAllocateAlpha (gdImagePtr im, int r, int g, int b, int a);
+void gdImageSetPixel (gdImagePtr im, int x, int y, int color);
+void gdImageLine (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
+void gdImageDashedLine (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
+void gdImageRectangle (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
+void gdImageFilledRectangle (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
+void gdImageFilledArc (gdImagePtr im, int cx, int cy, int w, int h, int s, int e, int color, int style);
+void gdImageArc (gdImagePtr im, int cx, int cy, int w, int h, int s, int e, int color);
+void gdImageFilledEllipse (gdImagePtr im, int cx, int cy, int w, int h, int color);
+ENDMEMBERS
+
+generate_class_functions( <<'ENDCLASS' );
+void gdImageCopy (gdImagePtr dst, gdImagePtr src, int dstX, int dstY, int srcX, int srcY, int w, int h);
+void gdImageCopyMerge (gdImagePtr dst, gdImagePtr src, int dstX, int dstY, int srcX, int srcY, int w, int h, int pct);
+void gdImageCopyMergeGray (gdImagePtr dst, gdImagePtr src, int dstX, int dstY, int srcX, int srcY, int w, int h, int pct);
+void gdImageCopyResized (gdImagePtr dst, gdImagePtr src, int dstX, int dstY, int srcX, int srcY, int dstW, int dstH, int srcW, int srcH);
+void gdImageCopyResampled (gdImagePtr dst, gdImagePtr src, int dstX, int dstY, int srcX, int srcY, int dstW, int dstH, int srcW, int srcH);
+int gdImageCompare (gdImagePtr im1, gdImagePtr im2);
+void gdImagePaletteCopy (gdImagePtr dst, gdImagePtr src);
+ENDCLASS
+
+generate_general_functions( <<'ENDGENERAL' );
+int gdAlphaBlend (int dest, int src);
+int gdTrueColor (int r, int g, int b);
+int gdTrueColorAlpha (int r, int g, int b, int a);
+void gdFree (void *m);
+gdFontPtr gdFontGetLarge ( );
+gdFontPtr gdFontGetSmall ( );
+gdFontPtr gdFontGetMediumBold ( );
+gdFontPtr gdFontGetGiant ( );
+gdFontPtr gdFontGetTiny ( );
+ENDGENERAL
+
+#
+# Keep these in here for later:
+#
+my $unused_funcs = <<'ENDUNUSED';
+# These have disappeared in later versions of GD:
+void gdFreeFontCache ();
+void gdImageEllipse (gdImagePtr im, int cx, int cy, int w, int h, int color);
+BGD_DECLARE(gdImagePtr) gdImageCreateFromGifPtr (int size, void *data);
+BGD_DECLARE(gdImagePtr) gdImageCreateFromGifCtx (gdIOCtxPtr in);
+void gdImagePngCtx (gdImagePtr im, gdIOCtx * out);
+void gdImagePngCtxEx (gdImagePtr im, gdIOCtx * out, int level);
+void gdImageWBMPCtx (gdImagePtr image, int fg, gdIOCtx * out);
+void gdImageJpegCtx (gdImagePtr im, gdIOCtx * out, int quality);
+void gdImagePngToSink (gdImagePtr im, gdSinkPtr out);
+gdIOCtx *gdNewFileCtx (FILE *);
+gdIOCtx *gdNewDynamicCtx (int, void *);
+gdIOCtx *gdNewSSCtx (gdSourcePtr in, gdSinkPtr out);
+void *gdDPExtractData (struct gdIOCtx *ctx, int *size);
+gdImagePtr gdImageCreateFromPngSource (gdSourcePtr in);
+gdImagePtr gdImageCreateFromGd2Part (FILE * in, int srcx, int srcy, int w, int h);
+char* gdImageStringFTEx (gdImage * im, int *brect, int fg, char *fontlist, double ptsize, double angle, int x, int y, char *string, gdFTStringExtraPtr strex);
+ENDUNUSED
+
+# Add functions that the code gen doesn't handle properly:
+#
+#char* gdImageStringTTF (gdImagePtr im, int *brect, int fg, char *fontlist, double ptsize, double angle, int x, int y, char *string);
+pp_addxs( <<"ENDXS" );
+char*
+_gdImageStringTTF( im, brect, fg, fontlist, ptsize, angle, x, y, string )
+ gdImagePtr im
+ int * brect
+ int fg
+ char * fontlist
+ double ptsize
+ double angle
+ int x
+ int y
+ char * string
+ CODE:
+ int c_brect[8];
+ RETVAL = gdImageStringTTF ( im, c_brect, fg, fontlist, ptsize, angle, x, y, string );
+ brect = c_brect;
+ OUTPUT:
+ RETVAL
+ brect
+ENDXS
+
+pp_addpm( { At => 'Bot' }, <<'ENDPM' );
+=head2 StringTTF
+
+$image->StringTTF( $brect, $fg, $fontlist, $ptsize, $angle, $x, $y, $string )
+
+Alias for gdImageStringTTF.
+
+=cut
+
+
+sub StringTTF
+{
+ return gdImageStringTTF ( @_ );
+} # End of StringTTF()...
+
+
+=head2 gdImageStringTTF
+
+$image->gdImageStringTTF( $brect, $fg, $fontlist, $ptsize, $angle, $x, $y, $string )
+
+=cut
+
+
+sub gdImageStringTTF
+{
+ my $self = shift;
+ return _gdImageStringTTF ( $self->{IMG_PTR}, @_ );
+} # End of gdImageStringTTF()...
+ENDPM
+
+
+#char* gdImageStringFT (gdImagePtr im, int *brect, int fg, char *fontlist, double ptsize, double angle, int x, int y, char *string);=
+pp_addxs(<<"ENDXS");
+char*
+_gdImageStringFT( im, brect, fg, fontlist, ptsize, angle, x, y, string )
+ gdImagePtr im
+ int * brect
+ int fg
+ char * fontlist
+ double ptsize
+ double angle
+ int x
+ int y
+ char * string
+ CODE:
+ int c_brect[8];
+ RETVAL = gdImageStringFT ( im, c_brect, fg, fontlist, ptsize, angle, x, y, string );
+ brect = c_brect;
+ OUTPUT:
+ RETVAL
+ brect
+ENDXS
+
+pp_addpm({At => 'Bot'}, <<'ENDPM' );
+=head2 StringFT
+
+$image->StringFT( $brect, $fg, $fontlist, $ptsize, $angle, $x, $y, $string )
+
+Alias for gdImageStringFT.
+
+=cut
+
+
+sub StringFT
+{
+ return gdImageStringFT ( @_ );
+} # End of StringFT()...
+
+
+=head2 gdImageStringFT
+
+$image->gdImageStringFT( $brect, $fg, $fontlist, $ptsize, $angle, $x, $y, $string )
+
+=cut
+
+
+sub gdImageStringFT
+{
+ my $self = shift;
+ return _gdImageStringFT ( $self->{IMG_PTR}, @_ );
+} # End of gdImageStringFT()...
+ENDPM
+
+# Add the final docs:
+#
+pp_addpm({At => 'Bot'}, <<'ENDPM');
+
+=head1 AUTHOR
+
+Judd Taylor, Orbital Systems, Ltd.
+judd dot t at orbitalsystems dot com
+
+=cut
+
+ENDPM
+
+pp_done();
+
+exit(0);
+#########
+# SUBS: #
+#########
+
+use Data::Dumper;
+
+#
+# Member functions to create a new object (or populate it from data):
+#
+sub generate_create_functions
+{
+ my @funcs = split( /\n/, shift );
+ my $sub = "generate_create_functions()";
+
+ foreach my $func ( @funcs )
+ {
+ #print "$sub: Generating read function for $func...\n";
+
+ my $info = parse_prototype( $func )
+ or die "$sub: Couldn't parse prototype!\n";
+
+ # If it wants a FILE*, we need to do something different in the XS code:
+ if( $info->{ARGS}->{1}->{TYPE} =~ /FILE\s*\*/ )
+ {
+ my $function_name = $info->{NAME};
+ my $return_type = $info->{RETURN_TYPE};
+
+ pp_addxs(<<"ENDXS");
+$return_type
+_$function_name( char* filename )
+ CODE:
+ FILE* file;
+ file = fopen( filename, "rb");
+ RETVAL = $function_name( file );
+ fclose(file);
+ OUTPUT:
+ RETVAL
+ENDXS
+ }
+ # Otherwise, it should be pretty easy:
+ else
+ {
+ add_basic_xs( $info, '_' );
+ }
+ }
+} # End of generate_create_functions()...
+
+
+#
+# Member functions to create a new object from a data scalar:
+#
+# gdImagePtr gdImageCreateFromPngPtr (int size, void * data);
+#
+sub generate_create_from_data_functions
+{
+ my @funcs = split( /\n/, shift );
+ my $sub = "generate_create_from_data_functions()";
+
+ foreach my $func ( @funcs )
+ {
+ #print "$sub: Generating read function for $func...\n";
+
+ my $info = parse_prototype( $func )
+ or die "$sub: Couldn't parse prototype!\n";
+
+ my $function_name = $info->{NAME};
+ my $return_type = $info->{RETURN_TYPE};
+
+ pp_addxs(<<"ENDXS");
+$return_type
+_$function_name( imageData )
+ SV * imageData
+ PREINIT:
+ char* data;
+ STRLEN len;
+ CODE:
+ data = SvPV( imageData, len );
+ RETVAL = $function_name( len, (void*)data );
+ OUTPUT:
+ RETVAL
+
+ENDXS
+ }
+} # End of generate_create_from_data_functions()...
+
+
+
+#void gdImagePng (gdImagePtr im, FILE * out);
+#void gdImageWBMP (gdImagePtr image, int fg, FILE * out);
+sub generate_write_functions
+{
+ my @funcs = split( /\n/, shift );
+ my $sub = "generate_write_functions()";
+
+ foreach my $func ( @funcs )
+ {
+ #print "$sub: Generating write function for $func...\n";
+
+ my $info = parse_prototype( $func )
+ or die "$sub: Couldn't parse prototype!\n";
+
+ my $function_name = $info->{NAME};
+ my $return_type = $info->{RETURN_TYPE};
+
+ my @arg_names = ();
+ my @call_args = ();
+ my $arg_decl_string = "";
+ foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } )
+ {
+ my $type = $info->{ARGS}->{$num}->{TYPE};
+ my $name = $info->{ARGS}->{$num}->{NAME};
+ if( $type =~ /FILE/ )
+ {
+ push( @arg_names, "filename" );
+ push( @call_args, "file" );
+ $arg_decl_string.= "\t\tchar *\t\tfilename\n";
+ next;
+ }
+ push(@arg_names, $name );
+ push(@call_args, $name );
+ $arg_decl_string .= "\t\t$type\t\t$name\n";
+ }
+ my $arg_list = join(", ", @arg_names);
+ my $call_arg_list = join(", ", @call_args);
+
+ pp_addxs(<<"ENDXS");
+$return_type
+_$function_name ( $arg_list )
+$arg_decl_string
+ CODE:
+ FILE* file;
+ file = fopen( filename, "wb");
+ $function_name ( $call_arg_list );
+ fclose( file );
+ENDXS
+
+ # Add the OO code:
+ #
+
+ # Use template method here to avoid escaping everything:
+ my $pmcode = <<'ENDPM';
+=head2 INSERT_NAME_HERE
+
+$image->INSERT_NAME_HERE( INSERT_DOC_ARG_LIST_HERE )
+
+=cut
+
+
+sub INSERT_NAME_HERE
+{
+ my $self = shift;
+ return INSERT_XS_FUNC_HERE ( $self->{IMG_PTR}, @_ );
+} # End of INSERT_NAME_HERE()...
+ENDPM
+ my $name = "write_" . $function_name;
+ $name =~ s/gdimage//;
+ $name =~ s/gdImage//;
+ $pmcode =~ s/INSERT_NAME_HERE/$name/sg;
+ $pmcode =~ s/INSERT_XS_FUNC_HERE/_$function_name/sg;
+
+ my @arg_names2;
+ my @doc_args;
+ foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } )
+ {
+ next if ( $info->{ARGS}->{$num}->{TYPE} eq 'gdImagePtr' );
+
+ if( $info->{ARGS}->{$num}->{TYPE} =~ /FILE/ )
+ {
+ push( @arg_names2, "filename" );
+ push(@doc_args, "\$filename" );
+ next;
+ }
+ push(@arg_names2, $info->{ARGS}->{$num}->{NAME});
+ push(@doc_args, "\$" . $info->{ARGS}->{$num}->{NAME} );
+ }
+ my $arg_list2 = join( ", ", @arg_names2 );
+ $pmcode =~ s/INSERT_ARG_LIST_HERE/$arg_list2/sg;
+
+ my $doc_arg_list = join( ", ", @doc_args );
+ $pmcode =~ s/INSERT_DOC_ARG_LIST_HERE/$doc_arg_list/sg;
+
+ pp_addpm( { At => 'Bot' }, $pmcode );
+ }
+} # End of generate_write_functions()...
+
+#
+# The functions allow you to get a pointer to a formatted region of memory
+# that contains image data in the specified format. This is useful, among
+# other things, because PerlQt has almost no other way to import any image
+# data from PDL!
+#
+#void *gdImageWBMPPtr (gdImagePtr im, int *size, int fg);
+#void *gdImageJpegPtr (gdImagePtr im, int *size, int quality);
+#void *gdImagePngPtr (gdImagePtr im, int *size);
+#void *gdImageGdPtr (gdImagePtr im, int *size);
+#void *gdImageGd2Ptr (gdImagePtr im, int cs, int fmt, int *size);
+#void *gdImagePngPtrEx (gdImagePtr im, int *size, int level);
+#
+sub generate_data_ptr_functions
+{
+ my @funcs = split( /\n/, shift );
+ my $sub = "generate_data_ptr_functions()";
+
+ foreach my $func ( @funcs )
+ {
+ #print "$sub: Generating data_ptr function for $func...\n";
+ my $info = parse_prototype( $func )
+ or die "$sub: Couldn't parse prototype!\n";
+
+ #use Data::Dumper;
+ #print Data::Dumper->Dump([$info], ['info']);
+
+ my $function_name = $info->{NAME};
+ my $return_type = $info->{RETURN_TYPE};
+
+ my @arg_names = ();
+ my @call_args = ();
+ my $arg_decl_string = "";
+ foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } )
+ {
+ my $type = $info->{ARGS}->{$num}->{TYPE};
+ my $name = $info->{ARGS}->{$num}->{NAME};
+
+ if( $name =~ /size/ )
+ {
+ push( @call_args, "\&$name" );
+ next;
+ }
+
+ push(@arg_names, $name );
+ push(@call_args, $name );
+ $arg_decl_string .= "\t\t$type\t\t$name\n";
+ }
+ my $arg_list = join(", ", @arg_names);
+ my $call_arg_list = join(", ", @call_args);
+
+ # Add the low level functions we'll need:
+ #
+ pp_addxs(<<"ENDXS");
+SV *
+_$function_name( $arg_list )
+$arg_decl_string
+ CODE:
+ char* imdata;
+ int size;
+ imdata = (char *)$function_name( $call_arg_list );
+ RETVAL = newSVpv( imdata, size );
+ gdFree( imdata );
+ OUTPUT:
+ RETVAL
+ENDXS
+
+ # Add the object code for this function:
+ #
+ # Use template method here to avoid escaping everything:
+ my $pmcode = <<'ENDPM';
+=head2 INSERT_NAME_HERE
+
+$image->INSERT_NAME_HERE( INSERT_DOC_ARG_LIST_HERE )
+
+=cut
+
+
+sub INSERT_NAME_HERE
+{
+ my $self = shift;
+ return INSERT_XS_FUNC_HERE ( $self->{IMG_PTR}, @_ );
+} # End of INSERT_NAME_HERE()...
+ENDPM
+
+ my $format = $function_name;
+ $format =~ s/gdImage//;
+ $format =~ s/Ptr//;
+ my $name = "get_$format" . "_data";
+
+ $pmcode =~ s/INSERT_NAME_HERE/$name/sg;
+ $pmcode =~ s/INSERT_XS_FUNC_HERE/_$function_name/sg;
+
+ my @arg_names2;
+ my @doc_args;
+ foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } )
+ {
+ next if ( $info->{ARGS}->{$num}->{TYPE} eq 'gdImagePtr' );
+ next if ( $info->{ARGS}->{$num}->{NAME} eq 'size' );
+ push(@arg_names2, $info->{ARGS}->{$num}->{NAME});
+ push(@doc_args, "\$" . $info->{ARGS}->{$num}->{NAME} );
+ }
+ my $arg_list2 = join( ", ", @arg_names2 );
+ $pmcode =~ s/INSERT_ARG_LIST_HERE/$arg_list2/sg;
+
+ my $doc_arg_list = join( ", ", @doc_args );
+ $pmcode =~ s/INSERT_DOC_ARG_LIST_HERE/$doc_arg_list/sg;
+
+ pp_addpm( { At => 'Bot' }, $pmcode );
+ } # foreach func...
+
+} # End of generate_data_ptr_functions()...
+
+
+
+#
+# Here, we also need to add PM code for the OO side:
+#
+sub generate_member_functions
+{
+ my @funcs = split( /\n/, shift );
+ my $sub = "generate_member_functions()";
+
+ foreach my $func ( @funcs )
+ {
+ #print "$sub: Generating member function for $func...\n";
+
+ my $info = parse_prototype( $func )
+ or die "$sub: Couldn't parse prototype!\n";
+
+ # Add the XS portion of the code:
+ my @macro_list = qw(
+ gdImageSX
+ gdImageSY
+ gdImageTrueColor
+ );
+ if( scalar( grep( /$info->{NAME}/, @macro_list ) ) )
+ { # Special functions that are actually definitions:
+ add_basic_def_xs( $info, '_' );
+ }
+ else
+ { # Normal function
+ add_basic_xs( $info, '_' );
+ }
+
+ # Add the OO code:
+
+ # Use template method here to avoid escaping everything:
+ my $pmcode = <<'ENDPM';
+INSERT_SHORT_CODE_HERE
+
+=head2 INSERT_NAME_HERE
+
+$image->INSERT_NAME_HERE( INSERT_DOC_ARG_LIST_HERE )
+
+=cut
+
+
+sub INSERT_NAME_HERE
+{
+ my $self = shift;
+ return INSERT_XS_FUNC_HERE ( $self->{IMG_PTR}, @_ );
+} # End of INSERT_NAME_HERE()...
+ENDPM
+
+ my $short_code_template = <<'ENDSHORTCODE';
+=head2 INSERT_SHORT_NAME_HERE
+
+$image->INSERT_SHORT_NAME_HERE( INSERT_DOC_ARG_LIST_HERE )
+
+Alias for INSERT_NAME_HERE.
+
+=cut
+
+
+sub INSERT_SHORT_NAME_HERE
+{
+ return INSERT_NAME_HERE ( @_ );
+} # End of INSERT_SHORT_NAME_HERE()...
+ENDSHORTCODE
+
+ my $name = $info->{NAME};
+ my $short_name = $name;
+ $short_name =~ s/gdImage//;
+ my $short_code = '';
+ if( $short_name ne $name )
+ {
+ $short_code = $short_code_template;
+ $short_code =~ s/INSERT_SHORT_NAME_HERE/$short_name/sg;
+ }
+ $pmcode =~ s/INSERT_SHORT_CODE_HERE/$short_code/sg;
+
+ $pmcode =~ s/INSERT_NAME_HERE/$name/sg;
+ $pmcode =~ s/INSERT_XS_FUNC_HERE/_$name/sg;
+
+ my @arg_names;
+ my @doc_args;
+ foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } )
+ {
+ next if ( $info->{ARGS}->{$num}->{TYPE} eq 'gdImagePtr' );
+ push(@arg_names, $info->{ARGS}->{$num}->{NAME});
+ push( @doc_args, "\$" . $info->{ARGS}->{$num}->{NAME} );
+ }
+ my $arg_list = join( ", ", @arg_names );
+ $pmcode =~ s/INSERT_ARG_LIST_HERE/$arg_list/sg;
+ my $doc_arg_list = join( ", ", @doc_args );
+ $pmcode =~ s/INSERT_DOC_ARG_LIST_HERE/$doc_arg_list/sg;
+
+ pp_addpm( { At => 'Bot' }, $pmcode );
+ }
+} # End of generate_member_functions()...
+
+#
+# Add some member functions that can function on piddles:
+#
+sub generate_pp_def_members
+{
+ my @funcs = split( /\n/, shift );
+ my $sub = "generate_pp_def_members()";
+
+ foreach my $func ( @funcs )
+ {
+ #print "$sub: Generating member function for $func...\n";
+
+ my $info = parse_prototype( $func )
+ or die "$sub: Couldn't parse prototype!\n";
+
+ my $orig_name = $info->{NAME};
+ my $name = $orig_name . "s";
+ my $short_name = $name;
+ $short_name =~ s/gdImage//;
+ my $pdlpp_name = "_$name";
+
+ my @arg_names;
+ my @doc_args;
+ my $pdlpp_arg_list = "";
+ foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } )
+ {
+ my $type = $info->{ARGS}->{$num}->{TYPE};
+ my $arg_name = $info->{ARGS}->{$num}->{NAME};
+ next if ( $type eq 'gdImagePtr' );
+ push(@arg_names, $arg_name );
+ push( @doc_args, "\$" . $arg_name . "(pdl)" );
+ $pdlpp_arg_list .= "$type $arg_name(); ";
+ }
+ my $arg_list = join( ", ", @arg_names );
+ my $doc_arg_list = join( ", ", @doc_args );
+ my $pdlpp_call_arg_list = "\$" . join( "(), \$", @arg_names ) . "()";
+
+ # Add the PDL::PP code:
+ #
+ pp_def( $pdlpp_name,
+ Pars => $pdlpp_arg_list,
+ OtherPars => 'IV img_ptr;',
+ Doc => undef,
+ Code => "$orig_name( INT2PTR(gdImagePtr, \$COMP(img_ptr)), $pdlpp_call_arg_list );" );
+
+ # Add the OO code:
+
+ # Use template method here to avoid escaping everything:
+ my $pmcode = <<'ENDPM';
+INSERT_SHORT_CODE_HERE
+
+=head2 INSERT_NAME_HERE
+
+$image->INSERT_NAME_HERE( INSERT_DOC_ARG_LIST_HERE )
+
+=cut
+
+
+sub INSERT_NAME_HERE
+{
+ my $self = shift;
+ return INSERT_PP_FUNC_HERE ( @_, $self->{IMG_PTR} );
+} # End of INSERT_NAME_HERE()...
+ENDPM
+
+ my $short_code_template = <<'ENDSHORTCODE';
+=head2 INSERT_SHORT_NAME_HERE
+
+$image->INSERT_SHORT_NAME_HERE( INSERT_DOC_ARG_LIST_HERE )
+
+Alias for INSERT_NAME_HERE.
+
+=cut
+
+
+sub INSERT_SHORT_NAME_HERE
+{
+ return INSERT_NAME_HERE ( @_ );
+} # End of INSERT_SHORT_NAME_HERE()...
+ENDSHORTCODE
+
+ my $short_code = '';
+ if( $short_name ne $name )
+ {
+ $short_code = $short_code_template;
+ $short_code =~ s/INSERT_SHORT_NAME_HERE/$short_name/sg;
+ }
+ $pmcode =~ s/INSERT_SHORT_CODE_HERE/$short_code/sg;
+
+ $pmcode =~ s/INSERT_NAME_HERE/$name/sg;
+ $pmcode =~ s/INSERT_PP_FUNC_HERE/$pdlpp_name/sg;
+
+
+ $pmcode =~ s/INSERT_ARG_LIST_HERE/$arg_list/sg;
+
+ $pmcode =~ s/INSERT_DOC_ARG_LIST_HERE/$doc_arg_list/sg;
+
+ pp_addpm( { At => 'Bot' }, $pmcode );
+ }
+} # End of generate_pp_def_members...
+
+#
+# Functions not specific to one object, but that need to take objects as arguements:
+#
+sub generate_class_functions
+{
+ my @funcs = split( /\n/, shift );
+ my $sub = "generate_class_functions()";
+
+ pp_addpm( {At => 'Bot'}, <<'ENDPM' );
+=head1 CLASS FUNCTIONS
+
+=cut
+
+
+ENDPM
+
+ foreach my $func ( @funcs )
+ {
+ #print "$sub: Generating class function for $func...\n";
+
+ my $info = parse_prototype( $func )
+ or die "$sub: Couldn't parse prototype!\n";
+
+ # Add the XS portion of the code:
+ add_basic_xs( $info, '_' );
+
+ # Add the Class functions code:
+
+ # Figure out the perl arg list where it needs PDL::IO::GDImage objects:
+ #
+ my @perl_arg_names;
+ my @arg_names;
+ my @doc_args;
+ my $arg_shift_string = "";
+ foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } )
+ {
+ my $type = $info->{ARGS}->{$num}->{TYPE};
+ my $name = $info->{ARGS}->{$num}->{NAME};
+
+ push(@arg_names, $name);
+ $arg_shift_string .= " my \$$name = shift;\n";
+
+ if ( $type eq 'gdImagePtr' )
+ {
+ push(@perl_arg_names, "\$" . $name . "->{IMG_PTR}" );
+ push(@doc_args, "\$" . $name . "(PDL::IO::GD)" );
+ next;
+ }
+ push(@doc_args, "\$" . $name);
+ push(@perl_arg_names, "\$" . $name);
+ }
+
+ # Use template method here to avoid escaping everything:
+ my $pmcode = <<'ENDPM';
+=head2 INSERT_NAME_HERE
+
+INSERT_NAME_HERE ( INSERT_DOC_ARG_LIST_HERE )
+
+=cut
+
+
+sub INSERT_NAME_HERE
+{
+INSERT_ARG_SHIFT_HERE
+ return INSERT_XS_FUNC_HERE ( INSERT_PERL_ARG_LIST_HERE );
+} # End of INSERT_NAME_HERE()...
+ENDPM
+ my $function_name = $info->{NAME};
+ $pmcode =~ s/INSERT_NAME_HERE/$function_name/sg;
+ $pmcode =~ s/INSERT_XS_FUNC_HERE/_$function_name/sg;
+ $pmcode =~ s/INSERT_ARG_SHIFT_HERE/$arg_shift_string/sg;
+
+ my $perl_arg_list = join(", ", @perl_arg_names);
+ $pmcode =~ s/INSERT_PERL_ARG_LIST_HERE/$perl_arg_list/sg;
+
+ my $doc_arg_list = join( ", ", @doc_args );
+ $pmcode =~ s/INSERT_DOC_ARG_LIST_HERE/$doc_arg_list/sg;
+
+ pp_addpm( { At => 'Bot' }, $pmcode );
+ }
+
+} # End of generate_class_functions()...
+
+#
+# These functions are not specific to and object instance:
+#
+sub generate_general_functions
+{
+ my @funcs = split( /\n/, shift );
+ my $sub = "generate_general_functions()";
+
+ foreach my $func ( @funcs )
+ {
+ #print "$sub: Generating general function for $func...\n";
+
+ my $info = parse_prototype( $func )
+ or die "$sub: Couldn't parse prototype!\n";
+
+ # Add the XS portion of the code:
+ my @macro_list = qw(
+ gdTrueColor
+ gdTrueColorAlpha
+ );
+
+ if( scalar( grep( /$info->{NAME}/, @macro_list ) ) )
+ { # Special functions that are actually definitions:
+ add_basic_def_xs( $info );
+ }
+ else
+ { # Normal function
+ add_basic_xs( $info );
+ }
+
+ pp_add_exported(" $info->{NAME} ");
+ }
+} # End of generate_general_functions()...
+
+sub add_basic_xs
+{
+ my $info = shift;
+ my $prefix = shift || '';
+
+ my $return_type = $info->{RETURN_TYPE};
+
+ my $orig_name = $info->{NAME};
+ my $name = $prefix . $orig_name;
+ my @arg_names;
+ my @arg_call_names;
+ my @out_arg_names;
+ my $arg_decl_string = "";
+ foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } )
+ {
+ my $name = $info->{ARGS}->{$num}->{NAME};
+ my $type = $info->{ARGS}->{$num}->{TYPE};
+
+ # Handle perl's handling of pointers:
+ my $call_name = $name;
+ if( $type =~ /(\S+)\s*\*/
+ && $type !~ /void/
+ && $type !~ /char/ )
+ {
+ $type = $1;
+ $call_name = "&$name";
+ push( @out_arg_names, $name );
+ }
+
+ push(@arg_names, $name );
+ push(@arg_call_names, $call_name );
+ $arg_decl_string .= "\t\t$type\t\t$name\n";
+ }
+ chomp( $arg_decl_string );
+ my $arg_string = join(", ", @arg_names );
+
+ my $arg_call_string = join(", ", @arg_call_names);
+
+ my $retval_output = "\t\tRETVAL\n";
+ my $retval_input = "RETVAL =";
+ if( $return_type =~ /void/ )
+ {
+ $retval_output = '';
+ $retval_input = '';
+ }
+
+ my $arg_output_string = $retval_output . "\t\t" . join("\n\t\t", @out_arg_names);
+
+ pp_addxs( <<"ENDXS" );
+$return_type
+$name( $arg_string )
+$arg_decl_string
+\tCODE:
+\t\t$retval_input $orig_name ( $arg_call_string );
+\tOUTPUT:
+$arg_output_string
+ENDXS
+} # End of add_basic_xs()...
+
+sub add_basic_def_xs
+{
+ my $info = shift;
+ my $prefix = shift || '';
+
+ my $return_type = $info->{RETURN_TYPE};
+ my $orig_name = $info->{NAME};
+ my $name = $prefix . $orig_name;
+ my @arg_names;
+ my $arg_decl_string = "";
+ foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } )
+ {
+ my $name = $info->{ARGS}->{$num}->{NAME};
+ my $type = $info->{ARGS}->{$num}->{TYPE};
+ push(@arg_names, $name );
+ $arg_decl_string .= "\t\t$type\t\t$name\n";
+ }
+ chomp( $arg_decl_string );
+ my $arg_string = join(", ", @arg_names );
+
+ pp_addxs( <<"ENDXS" );
+$return_type
+$name( $arg_string )
+$arg_decl_string
+\tCODE:
+\t\tRETVAL = $orig_name ( $arg_string );
+\tOUTPUT:
+\t\tRETVAL
+ENDXS
+} # End of add_basic_def_xs()...
+
+sub parse_prototype
+{
+ my $proto = shift;
+
+ return undef
+ unless( $proto =~ /(\w+\s*\*?)\s*(\w+)\s*\((.*)\)/ );
+
+ my $args = $3;
+
+ my $hash = {
+ RETURN_TYPE => $1,
+ NAME => $2,
+ };
+
+ # Figure out the args:
+ my $arg_count = 1;
+ foreach my $arg ( split (/,/, $args) )
+ {
+ my ($name) = ($arg =~ /(\w+)$/);
+ $arg =~ s/$name$//; # arg now contains the full C type
+ $arg =~ s/const //; # get rid of 'const' in C type
+ $arg =~ s/^\s+//;
+ $arg =~ s/\s+$//; # pare off the variable type from 'arg'
+ $hash->{ARGS}->{$arg_count} = {
+ NAME => $name,
+ TYPE => $arg,
+ };
+ $arg_count++;
+ }
+
+ #use Data::Dumper;
+ #my $dd = Data::Dumper->new( [$hash], [ 'hash' ] );
+ #$dd->Indent(1);
+ #print STDERR $dd->Dump();
+
+ return $hash;
+} # End of parse_prototype()...
diff --git a/IO/GD/Makefile.PL b/IO/GD/Makefile.PL
new file mode 100644
index 0000000..516a933
--- /dev/null
+++ b/IO/GD/Makefile.PL
@@ -0,0 +1,159 @@
+#
+# Makefile.PL for PDL::IO::GD
+#
+# Judd Taylor, USF IMaRS
+# 12 April 2006
+#
+
+use ExtUtils::MakeMaker;
+use Config;
+PDL::Core::Dev->import();
+
+BEGIN
+{
+ # Generic descripton of how to optionally add this package to the PDL Tree:
+ $ppfile = "GD.pd";
+ $package_name = "PDL::IO::GD";
+ $lib_name = "GD";
+ $find_libs = [ 'libgd.so', 'libgd.a', 'libgd.dll.a', 'bgd.dll' ];
+ $find_incs = [ 'gd.h' ];
+ $config_flag = 'WITH_GD';
+ $config_libs = 'GD_LIBS';
+ $config_incs = 'GD_INC';
+ @lib_locations = (
+ '/usr/lib64',
+ '/usr/local/lib64',
+ '/lib64',
+ '/usr/lib',
+ '/usr/local/lib',
+ '/lib',
+ split(/ /, $Config{libpth}),
+ );
+ @inc_locations = (
+ '/usr/include',
+ '/usr/local/include',
+ $Config{usrinc},
+ );
+
+ #
+ # You probably won't need to edit anything below here (until the very end):
+ #
+
+ $msg = "";
+ $forcebuild=0;
+
+ if (defined $PDL::Config{$config_flag} && $PDL::Config{$config_flag}==0)
+ {
+ $msg = "\n Will skip build of $package_name on this system \n";
+ goto skip;
+ }
+
+ if (defined $PDL::Config{$config_flag} && $PDL::Config{$config_flag}==1)
+ {
+ print "\n Will forcibly try and build $package_name on this system \n\n";
+ $forcebuild=1;
+ }
+
+ # Look for GD includes/libs
+
+ # get locations from perldl.conf, if specified there:
+ @lib_locations = @{$PDL::Config{$config_libs}}
+ if( defined $PDL::Config{$config_libs} );
+ @inc_locations = @{$PDL::Config{$config_incs}}
+ if( defined $PDL::Config{$config_incs} );
+
+ #
+ # Do the search:
+ #
+ # Look for the libs:
+ foreach my $libdir ( @lib_locations )
+ {
+ my $found = 0;
+ foreach my $find_lib ( @$find_libs )
+ {
+ if ( -e "$libdir/$find_lib" )
+ {
+ $lib_path = $libdir;
+ $found = 1;
+ # The lib name is different on windows, so we need to adjust the LIBS, below:
+ $linkname = ( $find_lib =~ /bgd.dll$/ ) ? 'bgd' : 'gd';
+ }
+ last if $found;
+ }
+ last if $found;
+ } # foreach $libdir...
+
+ unless( defined( $lib_path ) )
+ {
+ $msg .= "Cannot find $lib_name library, $find_lib.\n"
+ . "Please add the correct library path to Makefile.PL or install $lib_name\n.";
+ }
+
+ # Look for the include files:
+ foreach my $incdir ( @inc_locations )
+ {
+ foreach my $find_inc ( @$find_incs )
+ {
+ if ( -e "$incdir/$find_inc" )
+ {
+ $include_path = $incdir;
+ last;
+ }
+ }
+ }
+
+ unless( defined( $include_path ) )
+ {
+ $msg .= "Cannot find $lib_name header file, $find_inc.\n"
+ . "Please add the correct library path to Makefile.PL or install $lib_name.\n";
+ }
+
+ #
+ # Make sure everything we wanted is found:
+ #
+ $donot = 1;
+ if( defined( $include_path ) && defined( $lib_path ) )
+ {
+ $donot = 0;
+ }
+
+ $donot = 0 if( $forcebuild );
+
+ if ( $donot )
+ {
+ $msg .= "\n Skipping build of $package_name.\n";
+ }
+
+skip:
+
+ if ($msg ne "" && $forcebuild==0)
+ {
+ warn $msg . "\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ $donot = 1;
+ $PDL::Config{$config_flag}=0;
+ }
+ else
+ {
+ $PDL::Config{$config_flag}=1;
+ print "\n Building $package_name. Turn off $config_flag if there are any problems\n\n";
+ }
+
+} # BEGIN...
+
+return if $donot;
+
+$package = [$ppfile, $lib_name, $package_name];
+%hash = pdlpp_stdargs($package);
+$hash{VERSION_FROM} = $ppfile;
+$hash{LIBS} = ["-L$lib_path -l$linkname"];
+$hash{INC} = PDL_INCLUDE() . " -I$include_path";
+push( @{ $hash{TYPEMAPS} }, 'typemap' );
+
+WriteMakefile(%hash);
+
+sub MY::postamble { pdlpp_postamble_int( $package ); }
+
+#@pack = ( $package );
+#sub MY::postamble { pdlpp_postamble_int(@::pack); }
diff --git a/IO/GD/TODO b/IO/GD/TODO
new file mode 100644
index 0000000..0b28de5
--- /dev/null
+++ b/IO/GD/TODO
@@ -0,0 +1,10 @@
+
+PDL::IO::GD TODO:
+
+Documentation
+
+Jpeg/etc.. input/output functions (autogenerate?)
+
+Read true color images...
+
+Decide whether that OO interface I was going to mess with is worth leaving in there
\ No newline at end of file
diff --git a/IO/GD/typemap b/IO/GD/typemap
new file mode 100644
index 0000000..ea98f29
--- /dev/null
+++ b/IO/GD/typemap
@@ -0,0 +1,11 @@
+#
+# Extra type mappings for Judd::PDL::IO::GD
+#
+gdImagePtr T_PTR
+gdImage * T_PTR
+gdFontPtr T_PTR
+gdFont * T_PTR
+gdPointPtr T_PTR
+
+int * T_PTR
+unsigned short * T_PTR
diff --git a/IO/HDF/Changes b/IO/HDF/Changes
new file mode 100644
index 0000000..2ac151f
--- /dev/null
+++ b/IO/HDF/Changes
@@ -0,0 +1,76 @@
+Revision history for Perl extension PDL::HDF
+0.01 13/02/01
+ - original version
+
+2.0 27 March 2006 (Judd Taylor, judd at marine.usf.edu)
+
+ - New version I've taken over from the previous authors.
+
+ - There has been several minor fixes to the old version that I have fixed over the years,
+ and I can't remember them all to document here. Any new functionality has been documented,
+ however.
+
+ - "Chunking" functionality added. This is an internal tiling and compression on the SD
+ datasets done by the HDF library. This is on by default, and can be
+ inquired/changed through ->Chunking() member function (pass it 0 for off, true for on).
+ The actual chunking section automatically determines a tile size for the dataset, but
+ this may not be optimal for some datasets. Down the road I'll provide better control of
+ this feature.
+
+ - I've defuncted several functions that had strange (perhaps French) spellings. The originals
+ are still there for the time being, but a future version will come with warnings, and
+ finally be removed from the library even further out.
+
+ SDgetvariablename -> SDgetvariablenames
+ SDgetattribut -> SDgetattribute
+ SDgetattributname -> SDgetattributenames
+ SDgetdimsizeunlimit -> SDgetunlimiteddimsize
+ SDgetdimname -> SDgetdimnames
+ Vgetchilds -> Vgetchildren
+ VSgetfieldsnames -> VSgetfieldnames
+
+ - Umm... I don't like fortran array dim order, so I use C order. This may be a concern for
+ you, but I can't verify the problem for everyone since all of my code works fine.
+ I generally save things as X, Y, Z in my code (think an image, for instance), and then
+ when I open the HDF with image viewers, everything is fine. That's not how HDF saves
+ the data, however, so there's a dim reverse in the code for SDget and SDput, but that
+ should (theoretically) be transparent to you. NOTE: there is no reformatting of memory
+ necessary (it's time consuming, and has been avoided), since the C style dim order
+ is how a linear array maps into memory anyways (that's the main reason I like C style
+ over fortran).
+ If this causes _huge_ problems for you, then maybe I can make the ordering optional and
+ you can have it your backwards way if you want :)
+
+ - I migrated all of the failure codes to return 'undef' instead of the mix they were returning
+ before. This should allow old code to be left alone.
+
+ - I migrated all of the perl hashes to anonymous hashes.
+
+ - I removed and internally doc'd several places where buffer overflows are possible, and did
+ my best shot at making the buffer overflows impossible, using the new constants below.
+ NOTE: this is not total elimination of the problem! Look for that in a later version with
+ updates perlXS code on those function to use the C constants.
+ The constants used in the code are cool with the HDF4.2r1 version, assuming you didn't
+ change anything before you compiled the HDF library. The HDF people could theoretically
+ change those values at a later point, so they should be read directly from the HDF system
+ headers, rather than hard coded in this module.
+
+ - I moved the constants over to 'use constant', so instead of using '$PDL::IO::HDF:DFACC_CREATE',
+ you now would use : 'PDL::IO::HDF->DFACC_CREATE'. This is how constants work in Perl, so get
+ over it and fix your old code that uses things the old way.
+
+ - I added a couple of constants (all only usefull for allocating memory internally):
+ MAX_NC_NAME => HDF's constant to hold the max name length for an attr/sds/dim
+ MAX_VAR_DIMS => HDF's constant to hold the max number of dims for a HDF variable
+ VNAMELENMAX => HDF's constant for the max length of VS interface names
+ FAIL => HDF's constant failure return code
+
+ - I moved all of the tests over to 'use Test', for easier clarity and to get them working again. I
+ also modified the tests to clean up their test files when they are no longer needed (some tests
+ use outputs from earlier tests).
+
+ - I added tests for the SDS chunking features.
+
+
+
+
\ No newline at end of file
diff --git a/IO/HDF/HDF.pm b/IO/HDF/HDF.pm
new file mode 100644
index 0000000..ada5439
--- /dev/null
+++ b/IO/HDF/HDF.pm
@@ -0,0 +1,300 @@
+package PDL::IO::HDF;
+
+
+=head1 NAME
+
+PDL::IO::HDF - A PDL interface to the HDF4 library.
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::IO::HDF;
+
+ # Open file 'foo.hdf' with all hdf interface:
+ my $HDF = PDL::IO::HDF->new("foo.hdf");
+
+ # You can call functions from either the SD or VS interfaces:
+ $HDF->{SD}->SDget("Foo_data");
+ $HDF->{VS}->VSgetnames();
+
+ # To close the file:
+ $HDF->close();
+
+=head1 DESCRIPTION
+
+This library provides functions to manipulate HDF files with the
+SD, VS, and V HDF interfaces.
+
+For more infomation on HDF, see http://hdf.ncsa.uiuc.edu/
+
+The 'new' function of this package uses the 'new' functions for the
+individual HDF interfaces. This allows you to use all of the interfaces
+at one time (if you don't mind the extended syntax).
+
+Actually using the HDF files comes down to using one of the particular
+interfaces, for that see the docs on those modules.
+
+=cut
+
+our $VERSION = '2.0';
+$VERSION = eval $VERSION;
+
+use PDL::Primitive;
+use PDL::Basic;
+
+use PDL::IO::HDF::SD;
+use PDL::IO::HDF::VS;
+
+#
+# Constants:
+#
+
+=head1 CONSTANTS
+
+These constants are now implented using the perl 'use constant' pragma.
+
+Previously, they were just scalars that were changable (which is a no-no).
+
+See constant(1) for more info on how to use these in your code.
+
+=head2 Access Modes
+
+=over 8
+
+=item DFACC_READ
+
+Open the file in read-only mode.
+
+=item DFACC_WRITE
+
+Open the file in write-only mode.
+
+=item DFACC_CREATE
+
+Clobber the file (create it if it doesn't exist, and then open with RW mode).
+
+=item DFACC_ALL
+
+Open the file in read-write mode.
+
+=item DFACC_RDONLY
+
+Same as DFACC_READ
+
+=item DFACC_RDWR
+
+Open the file in read-write mode.
+
+=back
+
+=cut
+
+# Access modes:
+use constant {
+ DFACC_READ => 1,
+ DFACC_WRITE => 2,
+ DFACC_CREATE => 4,
+ DFACC_ALL => 7,
+ DFACC_RDONLY => 1,
+ DFACC_RDWR => 3,
+};
+
+=head2 VS Interface Interlacing Modes
+
+=over 8
+
+=item FULL_INTERLACE
+
+=item NO_INTERLACE
+
+=back
+
+=cut
+# VS interlace modes:
+use constant {
+ FULL_INTERLACE => 0,
+ NO_INTERLACE => 1,
+};
+
+=head2 HDF4 Data Type Codes:
+
+=over 8
+
+=item DFNT_UCHAR
+
+HDF's unsigned char ~= PDL's byte
+
+=item DFNT_CHAR
+
+HDF's char ~= PDL's byte
+
+=item DFNT_FLOAT32
+
+HDF's 32-bit float ~= PDL's float
+
+=item DFNT_FLOAT64
+
+HDF's 64-bit float ~= PDL's double
+
+=item DFNT_INT8
+
+HDF's 8-bit integer ~= PDL's byte
+
+=item DFNT_UINT8
+
+HDF's 8-bit unsigned integer ~= PDL's byte
+
+=item DFNT_INT16
+
+HDF's 16-bit integer ~= PDL's short
+
+=item DFNT_UINT16
+
+HDF's 16-bit unsigned integer ~= PDL's ushort
+
+=item DFNT_INT32
+
+HDF's 32-bit integer ~= PDL's long
+
+=item DFNT_INT64
+
+HDF's 32-bit integer ~= PDL's long
+
+=back
+
+=cut
+# HDF Data type numbers:
+use constant {
+ DFNT_UCHAR => 3,
+ DFNT_CHAR => 4,
+ DFNT_FLOAT32 => 5,
+ DFNT_FLOAT64 => 6,
+ DFNT_INT8 => 20,
+ DFNT_UINT8 => 21,
+ DFNT_INT16 => 22,
+ DFNT_UINT16 => 23,
+ DFNT_INT32 => 24,
+ DFNT_INT64 => 25,
+};
+
+=head2 Misc. HDF Library Constants:
+
+=over 8
+
+=item MAX_NC_NAME
+
+This is the max name length for SDS variables, attribtues, and just about anything else.
+
+=item MAX_VAR_DIMS
+
+This is the max number of dims a HDF variable can have.
+
+=item VNAMELENMAX
+
+Max length of V interface names.
+
+=back
+
+=cut
+
+# These are current with HDF4.2r1:
+#
+
+# Maximum Attr/SDS/VS name length:
+use constant MAX_NC_NAME => 256;
+
+# Maximum variable dims (use for alloc'ing mem for the low level calls that return dims:
+use constant MAX_VAR_DIMS => 32;
+
+# Max name len for VS interface:
+use constant VNAMELENMAX => 64;
+
+use constant FAIL => -1;
+
+# Declaration of the different 'typemap' globals
+
+# NOTE: Since the keys & values below are constants, we need the () around them:
+
+#typemap pour convertir typePDL->typeHDF
+$SDtypeTMAP = {
+ PDL::byte->[0] => (DFNT_UINT8),
+ PDL::short->[0] => (DFNT_INT16),
+ PDL::ushort->[0] => (DFNT_UINT16),
+ PDL::long->[0] => (DFNT_INT32),
+ PDL::float->[0] => (DFNT_FLOAT32),
+ PDL::double->[0] => (DFNT_FLOAT64),
+ #PDL::byte->[0] => $DFNT_UCHAR ###attention PDL::byte 2x
+};
+
+#typemap pour convertir typeHDF->typePDL
+$SDinvtypeTMAP = {
+ (DFNT_INT8) => sub { PDL::byte(@_); }, #badtype
+ (DFNT_UINT8) => sub { PDL::byte(@_); },
+ (DFNT_INT16) => sub { PDL::short(@_); },
+ (DFNT_UINT16) => sub { PDL::ushort(@_); },
+ (DFNT_INT32) => sub { PDL::long(@_); },
+ (DFNT_INT64) => sub { PDL::long(@_); }, #badtype
+ (DFNT_FLOAT32) => sub { PDL::float(@_); },
+ (DFNT_FLOAT64) => sub { PDL::double(@_); },
+ (DFNT_UCHAR) => sub { PDL::byte(@_); },
+ (DFNT_CHAR) => sub { PDL::byte(@_); } #badtype
+};
+
+$SDinvtypeTMAP2 = {
+ (DFNT_INT8) => PDL::byte,
+ (DFNT_UINT8) => PDL::byte,
+ (DFNT_INT16) => PDL::short,
+ (DFNT_UINT16) => PDL::ushort,
+ (DFNT_INT32) => PDL::long,
+ (DFNT_INT64) => PDL::long,
+ (DFNT_FLOAT32) => PDL::float,
+ (DFNT_FLOAT64) => PDL::double,
+ (DFNT_UCHAR) => PDL::byte,
+ (DFNT_CHAR) => PDL::byte,
+};
+
+sub new
+{
+ my $type = shift;
+ my $file = shift;
+
+ my $obj = {};
+
+ $obj->{SD} = PDL::IO::HDF::SD->new( $file );
+ $obj->{VS} = PDL::IO::HDF::VS->new( $file );
+
+ bless $obj, $type;
+} # End of new()...
+
+sub close
+{
+ my $self = shift;
+ $self->{SD}->close;
+ $self->{VS}->close;
+} # End of close()...
+
+
+sub DESTROY
+{
+ my $self = shift;
+ $self->close;
+} # End of DESTROY()...
+
+
+=head1 CURRENT AUTHOR & MAINTAINER
+
+Judd Taylor, Orbital Systems, Ltd.
+judd dot t at orbitalsystems dot com
+
+=head1 PREVIOUS AUTHORS
+
+Patrick Leilde patrick.leilde at ifremer.fr
+contribs of Olivier Archer olivier.archer at ifremer.fr
+
+=head1 SEE ALSO
+
+perl(1), PDL(1), PDL::IO::HDF::SD(1), PDL::IO::HDF::VS(1), constant(1).
+
+=cut
+
+
diff --git a/IO/HDF/Makefile.PL b/IO/HDF/Makefile.PL
new file mode 100644
index 0000000..bb4042b
--- /dev/null
+++ b/IO/HDF/Makefile.PL
@@ -0,0 +1,191 @@
+#
+# Makefile.PL for PDL::IO::HDF module
+#
+
+use ExtUtils::MakeMaker;
+use Config;
+
+PDL::Core::Dev->import();
+
+BEGIN
+{
+ $msg = "";
+ $forcebuild=0; # Note: forcebuild not used
+
+ if (defined $PDL::Config{WITH_HDF} && $PDL::Config{WITH_HDF}==0)
+ {
+ $msg = "\n Will skip build of PDL::IO::HDF on this system \n";
+ goto skip;
+ }
+
+ if (defined $PDL::Config{WITH_HDF} && $PDL::Config{WITH_HDF}==1)
+ {
+ print "\n Will forcibly try and build PDL::IO::HDF on this system \n\n";
+ $forcebuild=1;
+ }
+
+ # Look for HDF4 includes/libs
+ # default locations:
+ @HDF_lib_locations = (
+ '/usr/lib64',
+ '/usr/local/netcdf/lib',
+ '/usr/local/lib',
+ '/usr/local/lib64',
+ '/usr/lib64/hdf',
+ '/opt/local/lib',
+ '/usr/lib',
+ '/usr/lib/hdf',
+ '/opt/lib',
+ split(/ /, $Config{libpth}),
+ );
+ @HDF_inc_locations = (
+ '/usr/local/include',
+ '/usr/local/netcdf/include',
+ '/opt/local/include',
+ '/usr/include',
+ '/usr/include/hdf',
+ '/opt/include',
+ $Config{usrinc},
+ );
+
+ # get locations from perldl.conf, if specified there:
+ @HDF_lib_locations = @{$PDL::Config{HDF_LIBS}}
+ if( defined $PDL::Config{HDF_LIBS} );
+ @HDF_inc_locations = @{$PDL::Config{HDF_INC}}
+ if( defined $PDL::Config{HDF_INC} );
+
+ #
+ # Do the search:
+ #
+ my $found_df = 0;
+ my $found_sz = 0;
+
+ # Look for the libs:
+ foreach my $libdir ( @HDF_lib_locations )
+ {
+ if (-e "$libdir/libdfalt.a" && !$found_df)
+ {
+ $found_df = 1;
+ $hdf_lib_path = $libdir;
+ $hdf_libs = '-lmfhdfalt -ldfalt';
+ print "Found libdfalt.a at $libdir/libdfalt.a\n";
+ }
+
+ if (-e "$libdir/libdf.a" && !$found_df)
+ {
+ $found_df = 1;
+ $hdf_lib_path = $libdir;
+ $hdf_libs = '-lmfhdf -ldf';
+ print "Found libdf.a at $libdir/libdf.a\n";
+ }
+
+ # Look for the szip library, which HDF >= 4.2r0 needs, but older versions don't!
+
+ if (-e "$libdir/libsz.$Config{so}" && !$found_sz)
+ {
+ $found_sz = 1;
+ print "Found libsz.$Config{so} at $libdir/libsz.$Config{so}\n";
+ }
+ } # foreach $libdir...
+
+ unless( defined( $hdf_lib_path ) )
+ {
+ $msg .= "Cannot find hdf library, libdf.a.\n"
+ . "Please add the correct library path to Makefile.PL or install HDF\n";
+
+ }
+
+ warn "Warning: Did not find libsz, necessary for HDF >= 4.2r0\n" unless $found_sz;
+ $szip = $found_sz ? "-lsz" : "";
+
+ # Look for the include files:
+ foreach my $incdir ( @HDF_inc_locations )
+ {
+ if (-e "$incdir/hdf.h")
+ {
+ $hdf_include_path = ($incdir eq '/usr/local/include' ) ? "" : $incdir;
+ print "Found hdf.h at $incdir/hdf.h\n";
+ last;
+ }
+ }
+
+ unless( defined( $hdf_include_path ) )
+ {
+ $msg .= "Cannot find hdf header file, hdf.h.\n"
+ . "Please add the correct library path to Makefile.PL or install HDF\n";
+ }
+
+ #
+ # Set up architecture dependant stuff:
+ # NOTE TO SELF: The main PDL developers may not like this...
+ #
+ my $cpu = `uname -m`;
+ chomp $cpu;
+ my $hdf_defs;
+ if ($cpu eq 'x86_64') {
+ $hdf_defs = "-DSWAP -DNDEBUG -DHDF -DBIG_LONGS -DIA64 " .
+ "-D_BSD_SOURCE -DLINUX -DGCC32";
+ }
+ elsif ($cpu eq 'i686') {
+ $hdf_defs = "-DNDEBUG -D_BSD_SOURCE -DLINUX -DGCC32";
+ }
+ else {
+ print "WARNING: Unknown cpu type $cpu! Not setting \$hdf_defs. (This may not be a bad thing)\n";
+ }
+ print "Final \$hdf_defs flags: \'$hdf_defs\'\n\n";
+
+
+ #
+ # Make sure everything we wanted is found:
+ #
+ $donot = 1;
+ if( defined( $hdf_include_path ) && defined( $hdf_lib_path ) )
+ {
+ $donot = 0;
+ }
+
+ if ( $donot )
+ {
+ $msg .= "\n Skipping build of PDL::IO::HDF.\n";
+ }
+
+skip:
+
+ if ($msg ne "" && $forcebuild==0)
+ {
+ warn $msg . "\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ $donot = 1;
+ $PDL::Config{WITH_HDF}=0;
+ }
+ else
+ {
+ $PDL::Config{WITH_HDF}=1;
+ print "\n Building PDL::IO::HDF. Turn off WITH_HDF if there are any problems\n\n";
+ }
+} # End of BEGIN...
+
+return if $donot;
+
+WriteMakefile( NAME => 'PDL::IO::HDF',
+ CCFLAGS => $define_bool,
+ DEFINE => $hdf_defs,
+ #OPTIMIZE => "$hdf_defs",
+ VERSION_FROM => 'HDF.pm',
+ TYPEMAPS => [ &PDL_TYPEMAP() ],
+ PM => {
+ 'HDF.pm' => '$(INST_LIBDIR)/HDF.pm',
+ },
+ INC => &PDL_INCLUDE() . " -I$hdf_include_path",
+ LIBS => [ "-L$hdf_lib_path $hdf_libs -ljpeg -lz $szip" ],
+ dist => {
+ COMPRESS => 'gzip',
+ SUFFIX => 'gz',
+ },
+ DIR => [ 'SD', 'VS' ],
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
+sub MY::postamble { pdlpp_postamble_int($package); }
+
diff --git a/IO/HDF/SD/Changes b/IO/HDF/SD/Changes
new file mode 100644
index 0000000..4e8b2e0
--- /dev/null
+++ b/IO/HDF/SD/Changes
@@ -0,0 +1,3 @@
+Revision history for Perl extension PDL::HDF
+0.01 13/02/01
+ - original version
diff --git a/IO/HDF/SD/MANIFEST b/IO/HDF/SD/MANIFEST
new file mode 100644
index 0000000..803f8eb
--- /dev/null
+++ b/IO/HDF/SD/MANIFEST
@@ -0,0 +1,3 @@
+SD.pd
+Changes
+Makefile.PL
diff --git a/IO/HDF/SD/Makefile.PL b/IO/HDF/SD/Makefile.PL
new file mode 100644
index 0000000..348403a
--- /dev/null
+++ b/IO/HDF/SD/Makefile.PL
@@ -0,0 +1,29 @@
+#
+# Makefile.PL for PDL::IO::HDF::SD module.
+#
+use ExtUtils::MakeMaker;
+use Config;
+
+PDL::Core::Dev->import();
+
+$package = [ "SD.pd", SD , PDL::IO::HDF::SD ];
+WriteMakefile(
+ NAME => 'PDL::IO::HDF::SD',
+ TYPEMAPS => [ &PDL_TYPEMAP() ],
+ OBJECT => 'SD.o ',
+ PM => {
+ 'SD.pm' => '$(INST_LIBDIR)/SD.pm',
+ },
+ INC => &PDL_INCLUDE() . " -I$hdf_include_path",
+ LIBS => [ "-L$hdf_lib_path $hdf_libs -ljpeg -lz $szip" ],
+ clean => {
+ FILES => 'SD.pm SD.xs SD.o SD.c',
+ },
+ dist => {
+ COMPRESS => 'gzip',
+ SUFFIX => 'gz'
+ },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
+sub MY::postamble { pdlpp_postamble_int($package); }
diff --git a/IO/HDF/SD/SD.pd b/IO/HDF/SD/SD.pd
new file mode 100644
index 0000000..9e597a7
--- /dev/null
+++ b/IO/HDF/SD/SD.pd
@@ -0,0 +1,1618 @@
+pp_addpm({At => Top}, <<'EOD');
+
+=head1 NAME
+
+PDL::IO::HDF::SD - PDL interface to the HDF4 SD library.
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::IO::HDF::SD;
+
+ #
+ # Creating and writing an HDF file
+ #
+
+ # Create an HDF file:
+ my $hdf = PDL::IO::HDF::SD->new("-test.hdf");
+
+ # Define some data
+ my $data = sequence(short, 500, 5);
+
+ # Put data in file as 'myData' dataset with the names
+ # of dimensions ('dim1' and 'dim2')
+ $hdf->SDput("myData", $data , ['dim1','dim2']);
+
+ # Put some local attributes in 'myData'
+ #
+ # Set the fill value to 0
+ my $res = $hdf->SDsetfillvalue("myData", 0);
+ # Set the valid range from 0 to 2000
+ $res = $hdf->SDsetrange("myData", [0, 2000]);
+ # Set the default calibration for 'myData' (scale factor = 1, other = 0)
+ $res = $hdf->SDsetcal("myData");
+
+ # Set a global text attribute
+ $res = $hdf->SDsettextattr('This is a global text test!!', "myGText" );
+ # Set a local text attribute for 'myData'
+ $res = $hdf->SDsettextattr('This is a local text testl!!', "myLText", "myData" );
+
+ # Set a global value attribute (you can put all values you want)
+ $res = $hdf->SDsetvalueattr( PDL::short( 20 ), "myGValue");
+
+ # Set a local value attribute (you can put all values you want)
+ $res = $hdf->SDsetvalueattr( PDL::long( [20, 15, 36] ), "myLValues", "myData" );
+
+ # Close the file
+ $hdf->close();
+
+ #
+ # Reading from an HDF file:
+ #
+
+ # Open an HDF file in read only mode:
+ my $hdf = PDL::IO::HDF::SD->new("test.hdf");
+
+ # Get a list of all datasets:
+ my @dataset_list = $hdf->SDgetvariablename();
+
+ # Get a list of the names of all global attributes:
+ my @globattr_list = $hdf->SDgetattributenames();
+
+ # Get a list of the names of all local attributes for a dataset:
+ my @locattr_list = $hdf->SDgetattributenames("myData");
+
+ # Get the value of local attribute for a dataset:
+ my $value = $hdf->SDgetattribut("myLText","myData");
+
+ # Get a PDL var of the entire dataset 'myData':
+ my $data = $hdf->SDget("myData");
+
+ # Apply the scale factor of 'myData'
+ $data *= $hdf->SDgetscalefactor("myData");
+
+ # Get the fill value and fill the PDL var in with BAD:
+ $data->inplace->setvaltobad( $hdf->SDgetfillvalue("myData") );
+
+ # Get the valid range of a dataset:
+ my @range = $hdf->SDgetrange("myData");
+
+ #Now you can do what you want with your data
+ $hdf->close();
+
+
+=head1 DESCRIPTION
+
+This library provides functions to read, write, and manipulate
+HDF4 files with HDF's SD interface.
+
+For more infomation on HDF4, see http://hdf.ncsa.uiuc.edu/
+
+There have been a lot of changes starting with version 2.0, and these may affect
+your code. PLEASE see the 'Changes' file for a detailed description of what
+has been changed. If your code used to work with the circa 2002 version of this
+module, and does not work anymore, reading the 'Changes' is your best bet.
+
+In the documentation, the terms dataset and SDS (Scientific Data Set) are used
+interchangably.
+
+=cut
+
+
+EOD
+
+
+pp_addhdr(<<'EOH');
+
+#include <hdf.h>
+#include <mfhdf.h>
+#include <string.h>
+
+#define PDLchar pdl
+#define PDLuchar pdl
+#define PDLshort pdl
+#define PDLint pdl
+#define PDLlong pdl
+#define PDLfloat pdl
+#define PDLdouble pdl
+#define PDLvoid pdl
+#define uchar unsigned char
+
+
+#define COMP_CODE_NONE 0
+#define COMP_CODE_RLE 1
+#define COMP_CODE_SKPHUFF 3
+#define COMP_CODE_DEFLATE 4
+
+EOH
+
+use lib "../";
+use buildfunc;
+
+#-------------------------------------------------------------------------
+# Create low level interface from HDF SD header file.
+#-------------------------------------------------------------------------
+
+create_low_level (<<'EODEF');
+#
+# SDS Interface
+#
+int SDstart(const char *filename, int access_mode);
+int SDfileinfo(int sd_id, int *ndatasets, int *global_attr);
+int SDattrinfo(int s_id, int attr_index, char *attr_name, int *number_type, int *count);
+#int SDreadattr(int s_id, int attr_index, void *data);
+int SDreadattr(int s_id, int attr_index, PDLvoid *data);
+int SDgetinfo(int sds_id, char *sds_name, int *rank, int *dimsizes, int *number_type, int *nattrs);
+int SDselect(int sd_id, int index);
+int SDgetdimid(int sds_id, int dim_number);
+int SDdiminfo(int dim_id, char *name, int *count, int *number_type, int *nattrs);
+int SDnametoindex(int sd_id, const char *sds_name);
+#int SDreaddata(int sds_id, int *start, int *stride, int *edge, void *buffer);
+int SDreaddata(int sds_id, int *start, int *stride, int *edge, PDLvoid *buffer);
+#int SDsetfillvalue(int sds_id, const void *fill_val);
+int SDsetfillvalue(int sds_id, const PDLvoid *fill_val);
+#int SDsetrange(int sds_id, const void *max, const void *min);
+int SDsetrange(int sds_id, const PDLvoid *max, const PDLvoid *min);
+#int SDwritedata(int sds_id, const int *start, const int *stride, const int *edge, const void *data);
+int SDwritedata(int sds_id, const int *start, const int *stride, const int *edge, const PDLvoid *data);
+int SDsetexternalfile(int sds_id, const char *filename, int offset);
+int SDsetdimstrs(int dim_id, const char *label, const char *unit, const char *format);
+int SDsetdimscale(int dim_id, int count, int number_type, const void *data);
+int SDsetdimname(int dim_id, const char *dim_name);
+int SDsetdatastrs(int sds_id, const char *label, const char *unit, const char *format, const char *coordsys);
+int SDsetcal(int sds_id, double cal, double cal_err, double offset, double offset_err, int number_type);
+#int SDsetcal(int sds_id, float cal, float cal_err, float offset, float offset_err, int number_type);
+int SDsetattr(int s_id, const char *attr_name, int num_type, int count, const void *values);
+int SDreftoindex(int sd_id, int sds_ref);
+int SDiscoordvar(int sds_id);
+int SDidtoref(int sds_id);
+int SDgetdimstrs(int dim_id, char *label, char *unit, char *format, int len);
+int SDgetdimscale(int dim_id, void *data);
+int SDgetdatastrs(int sds_id, char *label, char *unit, char *format, char *coordsys, int len);
+
+
+#ORIG:
+#int SDgetcal(int sds_id, double cal, double cal_err, double offset, double offset_err, double number_type);
+#int SDgetcal(int sds_id, float cal, float cal_err, float offset, float offset_err, int number_type);
+#int SDgetcal(int sds_id, double *cal, double *cal_err, float64 *offset, float64 *offset_err, int *number_type);
+
+int SDendaccess(int sds_id);
+int SDend(int sd_id);
+int SDcreate(int sd_id, const char *name, int number_type, int rank, const int *dimsizes);
+
+int SDwritechunk(int sds_id, const int* origin, const PDLvoid *data);
+int SDsetchunkcache(int sds_id, int maxcache, int flag);
+
+EODEF
+
+pp_addxs('',<<'ENDXS');
+
+void
+_HEprint(int level)
+ CODE:
+ HEprint(stderr, level);
+
+int
+_SDgetcal(sds_id, cal, cal_err, offset, offset_err, number_type)
+ int sds_id
+ double cal
+ double cal_err
+ double offset
+ double offset_err
+ int* number_type
+ CODE:
+ RETVAL = SDgetcal(sds_id, &cal, &cal_err, &offset, &offset_err, number_type);
+ OUTPUT:
+ RETVAL
+
+void
+UnpackSBigEndianPDL(size, buff, p)
+ int size
+ unsigned char * buff
+ PDLint * p
+ CODE:
+ int i, INTtmp;
+ unsigned char bch1, bch2;
+ int * data;
+
+ data = p->data;
+
+ for(i=0; i<size; i++)
+ {
+ bch1 = buff[i*2];
+ bch2 = buff[i*2+1];
+
+ INTtmp = (bch1 << 8) + bch2;
+
+ if( INTtmp >= 32768 )
+ { INTtmp -= 65536; }
+
+ data[i] = INTtmp;
+ }
+ OUTPUT:
+ p
+
+int
+_SDsetcompress(sd_id, ldef);
+ int sd_id
+ int ldef
+ CODE:
+ comp_info c_info;
+ c_info.deflate.level = ldef;
+ RETVAL = SDsetcompress(sd_id, COMP_CODE_DEFLATE, &c_info) + 1;
+ OUTPUT:
+ RETVAL
+
+int
+_SDsetchunk(sds_id, rank, chunk_lengths);
+ int sds_id
+ int rank
+ int* chunk_lengths
+ CODE:
+ HDF_CHUNK_DEF c_def;
+ int i;
+ int32 status = FAIL;
+ for(i = 0; i < rank; i++)
+ {
+ /* fprintf(stderr, "_SDsetchunk(): chunk_lengths[%d] = %d\n", i , chunk_lengths[i]); */
+ c_def.chunk_lengths[i] = chunk_lengths[i];
+ c_def.comp.chunk_lengths[i] = chunk_lengths[i];
+ }
+ c_def.comp.comp_type = COMP_CODE_DEFLATE;
+ c_def.comp.cinfo.deflate.level = 6;
+ status = SDsetchunk(sds_id, c_def, (HDF_CHUNK | HDF_COMP) );
+ if( status == FAIL )
+ {
+ fprintf(stderr, "_SDsetchunk(): return status = %d\n", status);
+ HEprint(stderr, 0);
+ }
+ RETVAL = status;
+ OUTPUT:
+ RETVAL
+
+int
+_SDinitchunk(sds_id, type, rank, chunk_lengths);
+ int sds_id
+ int type
+ int rank
+ int* chunk_lengths
+ CODE:
+ void* data = NULL;
+ int* origin = NULL;
+ int i;
+ size_t size;
+ int status;
+ origin = HDgetspace( sizeof( int ) * rank );
+ for( i = 0; i < rank; i++ )
+ origin[i] = 0;
+ /* Just use the largest datatype here: */
+ size = DFKNTsize(type) * chunk_lengths[0];
+ if( rank > 1 )
+ {
+ for( i = 1; i < rank; i++ )
+ size *= chunk_lengths[i];
+ }
+ data = HDgetspace( size );
+ status = SDwritechunk(sds_id, origin, data);
+ if( status == FAIL )
+ {
+ fprintf(stderr, "_SDinitchunk(): return status = %d\n", status);
+ HEprint(stderr, 0);
+ }
+ HDfreespace( data );
+ HDfreespace( origin );
+ RETVAL = status;
+ OUTPUT:
+ RETVAL
+
+int
+Hishdf(filename);
+ char* filename
+ CODE:
+ RETVAL = Hishdf(filename);
+ OUTPUT:
+ RETVAL
+
+int
+_SDgetunlimiteddim(sds_id, dim);
+ int sds_id
+ int dim
+ CODE:
+ char sds_name[250];
+ int rank;
+ int dimsizes[32];
+ int num_type;
+ int nattrs;
+ RETVAL = SDgetinfo(sds_id, sds_name, &rank, dimsizes, &num_type, &nattrs) + 1;
+ if(RETVAL==1){RETVAL = dimsizes[dim];}
+ OUTPUT:
+ RETVAL
+
+int
+_SDsetattr_text(s_id, name, text, size);
+ int s_id
+ char * name
+ char * text
+ int size
+ CODE:
+ RETVAL = SDsetattr(s_id, name, 4, size, text);
+ OUTPUT:
+ RETVAL
+
+int
+_SDsetattr_values(s_id, name, values, size, type);
+ int s_id
+ char * name
+ pdl * values
+ int size
+ int type
+ CODE:
+ RETVAL = SDsetattr(s_id, name, type, size, values->data);
+ OUTPUT:
+ RETVAL
+
+ENDXS
+
+pp_addpm(<<'EOPM');
+
+use PDL::Primitive;
+use PDL::Basic;
+
+use PDL::IO::HDF;
+
+require POSIX;
+
+sub _pkg_name
+ { return "PDL::IO::HDF::SD::" . shift() . "()"; }
+
+# Convert a byte to a char:
+sub Byte2Char
+{
+ my ($strB) = @_;
+ my $strC;
+ for(my $i=0; $i<$strB->nelem; $i++)
+ {
+ $strC .= chr( $strB->at($i) );
+ }
+ return($strC);
+} # End of Byte2Char()...
+
+=head1 CLASS METHODS
+
+=head2 new
+
+=for ref
+
+ Open or create a new HDF object.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the file.
+ if you want to write to it, prepend the name with the '+' character : "+name.hdf"
+ if you want to create it, prepend the name with the '-' character : "-name.hdf"
+ otherwise the file will be open in read only mode
+
+ Returns the hdf object (die on error)
+
+=for example
+
+ my $hdf = PDL::IO::HDF::SD->new("file.hdf");
+
+=cut
+
+
+sub new
+{
+ # General:
+ my $type = shift;
+ my $filename = shift;
+
+ my $sub = _pkg_name( 'new' );
+
+ my $debug = 0;
+
+ my $self = {};
+
+ if (substr($filename, 0, 1) eq '+')
+ { # open for writing
+ $filename = substr ($filename, 1); # chop off +
+ $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_WRITE + PDL::IO::HDF->DFACC_READ;
+ }
+ if (substr($filename, 0, 1) eq '-')
+ { # Create new file
+ $filename = substr ($filename, 1); # chop off -
+ print "$sub: Creating HDF File $filename\n"
+ if $debug;
+ $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_CREATE;
+ $self->{SDID} = PDL::IO::HDF::SD::_SDstart( $filename, $self->{ACCESS_MODE} );
+ my $res = PDL::IO::HDF::SD::_SDend( $self->{SDID} );
+ die "$sub: _ERR::Create\n"
+ if( ($self->{SDID} == PDL::IO::HDF->FAIL ) || ( $res == PDL::IO::HDF->FAIL ));
+ $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_WRITE + PDL::IO::HDF->DFACC_READ;
+ }
+ unless( defined( $self->{ACCESS_MODE} ) )
+ { # Default to Read-only access:
+ $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_READ;
+ }
+ $self->{FILE_NAME} = $filename;
+
+ # SD interface:
+ print "$sub: Loading HDF File $self->{FILE_NAME}\n"
+ if $debug;
+
+ $self->{SDID} = PDL::IO::HDF::SD::_SDstart( $self->{FILE_NAME}, $self->{ACCESS_MODE} );
+ die "$sub: _ERR::SDstart\n"
+ if( $self->{SDID} == PDL::IO::HDF->FAIL );
+
+ my $num_datasets = -999;
+ my $num_global_attrs = -999;
+ my $res = _SDfileinfo( $self->{SDID}, $num_datasets, $num_global_attrs );
+ die "$sub: ** sdFileInfo **\n"
+ if($res == PDL::IO::HDF->FAIL);
+
+ foreach my $i ( 0 .. $num_global_attrs-1 )
+ {
+ print "$sub: Loading Global Attribute #$i\n"
+ if $debug;
+
+ my $attrname = " "x(PDL::IO::HDF->MAX_NC_NAME+1);
+ my $type = 0;
+ my $count = 0;
+
+ $res = _SDattrinfo( $self->{SDID}, $i, $attrname, $type, $count );
+ die "$sub: ** sdAttrInfo **\n"
+ if($res == PDL::IO::HDF->FAIL);
+
+ print "$sub: \$attrname = \'$attrname\'\n"
+ if $debug;
+
+ $self->{GLOBATTR}->{$attrname} = zeroes( $PDL::IO::HDF::SDinvtypeTMAP2->{$type}, $count );
+ $res = _SDreadattr( $self->{SDID}, $i, $self->{GLOBATTR}->{$attrname} );
+ die "$sub: ** sdReadAttr **\n"
+ if($res == PDL::IO::HDF->FAIL);
+
+ if( $type == PDL::IO::HDF->DFNT_CHAR )
+ {
+ $self->{GLOBATTR}->{$attrname} = Byte2Char( $self->{GLOBATTR}->{$attrname} );
+ }
+ }
+
+ my @dataname;
+ foreach my $i ( 0 .. $num_datasets-1 )
+ {
+ print "$sub: Loading SDS #$i\n"
+ if $debug;
+
+ my $sds_id = _SDselect( $self->{SDID}, $i );
+ die "$sub: ** sdSelect **\n"
+ if($sds_id == PDL::IO::HDF->FAIL);
+
+ my $name = " "x(PDL::IO::HDF->MAX_NC_NAME+1);
+ my $rank = 0;
+ my $dimsize = " "x( (4 * PDL::IO::HDF->MAX_VAR_DIMS) + 1 );
+ my $numtype = 0;
+ my $num_attrs = 0;
+
+ $res = _SDgetinfo($sds_id, $name, $rank, $dimsize, $numtype, $num_attrs);
+ die "$sub: ** sdGetInfo **\n"
+ if($res == PDL::IO::HDF->FAIL);
+
+ print "$sub: \$name = \'$name\'\n"
+ if $debug;
+ print "$sub: \$dimsize = \'$dimsize\'\n"
+ if $debug;
+
+ $self->{DATASET}->{$name}->{TYPE} = $numtype;
+ $self->{DATASET}->{$name}->{RANK} = $rank;
+ $self->{DATASET}->{$name}->{SDSID} = $sds_id;
+
+ # Load up information on the dimensions (named, unlimited, etc...):
+ #
+ foreach my $j ( 0 .. $self->{DATASET}->{$name}->{RANK}-1 )
+ {
+ print "$sub: Loading SDS($i) Dimension #$j\n"
+ if $debug;
+
+ my $dim_id = _SDgetdimid( $sds_id, $j );
+ die "$sub: ** sdGetDimId **\n"
+ if($dim_id == PDL::IO::HDF->FAIL);
+
+ my $dimname = " "x(PDL::IO::HDF->MAX_NC_NAME+1);
+ my $size = 0;
+ my $num_type = 0;
+ my $num_dim_attrs = 0;
+
+ $res = _SDdiminfo( $dim_id, $dimname, $size, $num_type, $num_dim_attrs );
+ die "$sub: ** sdDimInfo **\n"
+ if($res == PDL::IO::HDF->FAIL);
+
+ print "$sub: \$dimname = \'$dimname\'\n"
+ if $debug;
+
+ $self->{DATASET}->{$name}->{DIMS}->{$j}->{DIMID} = $dim_id;
+ $self->{DATASET}->{$name}->{DIMS}->{$j}->{SIZE} = $size;
+ $self->{DATASET}->{$name}->{DIMS}->{$j}->{NAME} = $dimname;
+
+ # The size comes back as 0 if it has the HDF unlimited dimension thing going on:
+ # So, lets figure out what the size is currently at:
+ unless ( $size )
+ {
+ $self->{DATASET}->{$name}->{DIMS}->{$j}->{REAL_SIZE} = _SDgetunlimiteddim( $sds_id, $j);
+ }
+ }
+
+ # Load up info on the SDS's attributes:
+ #
+ foreach my $j ( 0 .. $num_attrs-1 )
+ {
+ print "$sub: Loading SDS($i) Attribute #$j\n"
+ if $debug;
+
+ my $attrname = " "x(PDL::IO::HDF->MAX_NC_NAME+1);
+ my $type = 0;
+ my $count = 0;
+
+ $res = _SDattrinfo( $sds_id, $j, $attrname, $type, $count);
+ die "$sub: ** sdAttrInfo **\n"
+ if($res == PDL::IO::HDF->FAIL);
+
+ print "$sub: \$attrname = \'$attrname\'\n"
+ if $debug;
+
+ $self->{DATASET}->{$name}->{ATTRS}->{$attrname} =
+ zeroes( $PDL::IO::HDF::SDinvtypeTMAP2->{$type}, $count );
+
+ $res = _SDreadattr( $sds_id, $j, $self->{DATASET}->{$name}->{ATTRS}->{$attrname} );
+ die "$sub: ** sdReadAttr **\n"
+ if($res == PDL::IO::HDF->FAIL);
+
+ # FIXME: This should be a constant
+ if( $type == PDL::IO::HDF->DFNT_CHAR )
+ {
+ $self->{DATASET}->{$name}->{ATTRS}->{$attrname} =
+ Byte2Char( $self->{DATASET}->{$name}->{ATTRS}->{$attrname} );
+ }
+ }
+ }
+
+ bless $self, $type;
+
+ # Now that we're blessed, run our own accessors:
+
+ # Default to using this (it's a good thing :)
+ $self->Chunking( 1 );
+
+ return $self;
+} # End of new()...
+
+=head2 Chunking
+
+=for ref
+
+ Accessor for the chunking mode on this HDF file.
+
+ 'Chunking' is an internal compression and tiling the HDF library can
+ perform on an SDS.
+
+ This variable only affects they way SDput() works, and is ON by default.
+
+ The code modifications enabled by this flag automatically partition the
+ dataset to chunks of at least 100x100 values in size. The logic on this
+ is pretty fancy, and would take a while to doc out here. If you
+ _really_ have to know how it auto-partitions the data, then look at
+ the code.
+
+ Someday over the rainbow, I'll add some features for better control of the
+ chunking parameters, if the need arises. For now, it's just stupid easy
+ to use.
+
+=for usage
+
+ Arguments:
+ 1 (optional): new value for the chunking flag.
+
+=for example
+
+ # See if chunking is currently on for this file:
+ my $chunkvar = $hdf->Chunking();
+
+ # Turn the chunking off:
+ my $newvar = $hdf->Chunking( 0 );
+
+ # Turn the chunking back on:
+ my $newvar = $hdf->Chunking( 1 );
+
+=cut
+
+
+# See the changelog for more docs on this feature:
+sub Chunking
+{
+ my $self = shift;
+ my $var = shift;
+ if( defined( $var ) )
+ {
+ $self->{CHUNKING} = $var ? 1 : 0;
+ }
+ return $self->{CHUNKING};
+} # End of Chunking()...
+
+=head2 SDgetvariablenames
+
+=for ref
+
+ get the list of datasets.
+
+=for usage
+
+ No arguments
+ Returns the list of dataset or undef on error.
+
+=for example
+
+ my @DataList = $hdfobj->SDgetvariablenames();
+
+=cut
+
+
+sub SDgetvariablenames
+{
+ my($self) = @_;
+ return keys %{$self->{DATASET}};
+} # End of SDgetvariablenames()...
+sub SDgetvariablename
+{
+ my $self = shift;
+ return $self->SDgetvariablenames( @_ );
+} # End of SDgetvariablename()...
+
+
+=head2 SDgetattributenames
+
+=for ref
+
+ Get a list of the names of the global or SDS attributes.
+
+=for usage
+
+ Arguments:
+ 1 (optional) : The name of the SD dataset from which you want to get
+ the attributes. This arg is optional, and without it, it will
+ return the list of global attribute names.
+
+ Returns a list of names or undef on error.
+
+=for example
+
+ # For global attributes :
+ my @attrList = $hdf->SDgetattributenames();
+
+ # For SDS attributes :
+ my @attrList = $hdf->SDgetattributenames("dataset_name");
+
+=cut
+
+
+sub SDgetattributenames
+{
+ my($self, $name) = @_;
+ if( defined( $name ) )
+ {
+ return( undef )
+ unless defined( $self->{DATASET}->{$name} );
+ return keys %{ $self->{DATASET}->{$name}->{ATTRS} };
+ }
+ else
+ {
+ return keys %{ $self->{GLOBATTR} };
+ }
+} # End of SDgetattributenames()...
+# Wrapper (this is now defunct):
+sub SDgetattributname
+{
+ my $self = shift;
+ return $self->SDgetattributenames( @_ );
+} # End of SDgetattributname()...
+
+=head2 SDgetattribute
+
+=for ref
+
+ Get a global or SDS attribute value.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the attribute.
+ 2 (optional): The name of the SDS from which you want to get the attribute
+ value. Without this arg, it returns the global attribute value of that name.
+
+ Returns an attribute value or undef on error.
+
+=for example
+
+ # for global attributs :
+ my $attr = $hdf->SDgetattribute("attr_name");
+
+ # for local attributs :
+ my $attr = $hdf->SDgetattribute("attr_name", "dataset_name");
+
+=cut
+
+
+sub SDgetattribute
+{
+ my($self, $name, $dataset) = @_;
+ if( defined($dataset) )
+ { # It's an SDS attribute:
+ return( undef )
+ unless defined( $self->{DATASET}->{$dataset} );
+ return $self->{DATASET}->{$dataset}->{ATTRS}->{$name};
+ }
+ else
+ { # Global attribute:
+ return( undef )
+ unless defined( $self->{GLOBATTR}->{$name} );
+ return $self->{GLOBATTR}->{$name};
+ }
+} # End of SDgetattribute()...
+# Wrapper (this is now defunct):
+sub SDgetattribut
+{
+ my $self = shift;
+ return $self->SDgetattribute( @_ );
+} # End of SDgetattribut()...
+
+=head2 SDgetfillvalue
+
+=for ref
+
+ Get the fill value of an SDS.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the SDS from which you want to get the fill value.
+
+ Returns the fill value or undef on error.
+
+=for example
+
+ my $fillvalue = $hdf->SDgetfillvalue("dataset_name");
+
+=cut
+
+
+sub SDgetfillvalue
+{
+ my($self, $name) = @_;
+ return( undef )
+ unless defined( $self->{DATASET}->{$name} );
+ return ($self->{DATASET}->{$name}->{ATTRS}->{_FillValue})->at(0);
+} # End of SDgetfillvalue()...
+
+=head2 SDgetrange
+
+=for ref
+
+ Get the valid range of an SDS.
+
+=for usage
+
+ Arguments:
+ 1 : the name of the SDS from which you want to get the valid range.
+
+ Returns a list of two elements [min, max] or undef on error.
+
+=for example
+
+ my @range = $hdf->SDgetrange("dataset_name");
+
+=cut
+
+
+sub SDgetrange
+{
+ my($self, $name) = @_;
+ return( undef )
+ unless defined( $self->{DATASET}->{$name} );
+ return $self->{DATASET}->{$name}->{ATTRS}->{valid_range};
+} # End of SDgetrange()...
+
+=head2 SDgetscalefactor
+
+=for ref
+
+ Get the scale factor of an SDS.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the SDS from which you want to get the scale factor.
+
+ Returns the scale factor or undef on error.
+
+=for example
+
+ my $scale = $hdf->SDgetscalefactor("dataset_name");
+
+=cut
+
+
+sub SDgetscalefactor
+{
+ my($self, $name) = @_;
+ return( undef )
+ unless defined( $self->{DATASET}->{$name} );
+
+ return ($self->{DATASET}->{$name}->{ATTRS}->{scale_factor})->at(0);
+} # End of SDgetscalefactor()...
+
+=head2 SDgetdimsize
+
+=for ref
+
+ Get the dimensions of a dataset.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the SDS from which you want to get the dimensions.
+
+ Returns an array of n dimensions with their sizes or undef on error.
+
+=for example
+
+ my @dim = $hdf->SDgetdimsize("dataset_name");
+
+=cut
+
+
+sub SDgetdimsize
+{
+ my ($self, $name) = @_;
+ return( undef )
+ unless defined( $self->{DATASET}->{$name} );
+ my @dims;
+ foreach( sort keys %{ $self->{DATASET}->{$name}->{DIMS} } )
+ {
+ push @dims, $self->{DATASET}->{$name}->{DIMS}->{$_}->{SIZE};
+ }
+
+ return( @dims );
+} # End of SDgetdimsize()...
+
+=head2 SDgetunlimiteddimsize
+
+=for ref
+
+ Get the actual dimensions of an SDS with 'unlimited' dimensions.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the SDS from which you want to the dimensions.
+
+ Returns an array of n dimensions with the dim sizes or undef on error.
+
+=for example
+
+ my @dims = $hdf->SDgetunlimiteddimsize("dataset_name");
+
+=cut
+
+
+sub SDgetunlimiteddimsize
+{
+ my ($self, $name) = @_;
+
+ return( undef )
+ unless defined( $self->{DATASET}->{$name} );
+
+ my @dim;
+ foreach( sort keys %{$self->{DATASET}{$name}{DIMS}} )
+ {
+ if( $self->{DATASET}->{$name}->{DIMS}->{$_}->{SIZE} == 0 )
+ {
+ $dim[ $_ ] =
+ $self->{DATASET}->{$name}->{DIMS}->{$_}->{REAL_SIZE};
+ }
+ else
+ {
+ $dim[ $_ ] =
+ $self->{DATASET}->{$name}->{DIMS}->{$_}->{SIZE};
+ }
+ }
+ return(@dim);
+} # End of SDgetunlimiteddimsize()...
+# Wrapper (this is now defunct):
+sub SDgetdimsizeunlimit
+{
+ my $self = shift;
+ return $self->SDgetunlimiteddimsize( @_ );
+} # End of SDgetdimsizeunlimit()...
+
+=head2 SDgetdimnames
+
+=for ref
+
+ Get the names of the dimensions of a dataset.
+
+=for usage
+
+ Arguments:
+ 1 : the name of a dataset you want to get the dimensions'names .
+
+ Returns an array of n dimensions with their names or an empty list if error.
+
+=for example
+
+ my @dim_names = $hdf->SDgetdimnames("dataset_name");
+
+=cut
+
+
+sub SDgetdimnames
+{
+ my ($self, $name) = @_;
+
+ return( undef )
+ unless defined( $self->{DATASET}->{$name} );
+
+ my @dims=();
+ foreach( sort keys %{ $self->{DATASET}->{$name}->{DIMS} } )
+ {
+ push @dims,$self->{DATASET}->{$name}->{DIMS}->{$_}->{NAME};
+ }
+ return(@dims);
+} # End of SDgetdimnames()...
+sub SDgetdimname
+{
+ my $self = shift;
+ return $self->SDgetdimnames( @_ );
+} # End of SDgetdimname();
+
+=head2 SDgetcal
+
+=for ref
+
+ Get the calibration factor from an SDS.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the SDS
+
+ Returns (scale factor, scale factor error, offset, offset error, data type), or undef on error.
+
+=for example
+
+ my ($cal, $cal_err, $off, $off_err, $d_type) = $hdf->SDgetcal("dataset_name");
+
+=cut
+
+
+sub SDgetcal
+{
+ my ($self, $name ) = @_;
+
+ my ($cal, $cal_err, $off, $off_err, $type);
+
+ return( undef )
+ unless defined( $self->{DATASET}->{$name} );
+ return( undef )
+ unless defined( $self->{DATASET}->{$name}->{ATTRS}->{scale_factor} );
+
+ $cal = $self->{DATASET}->{$name}->{ATTRS}->{scale_factor};
+ $cal_err = $self->{DATASET}->{$name}->{ATTRS}->{scale_factor_err};
+ $off = $self->{DATASET}->{$name}->{ATTRS}->{add_offset};
+ $off_err = $self->{DATASET}->{$name}->{ATTRS}->{add_offset_err};
+ $type = $self->{DATASET}->{$name}->{ATTRS}->{calibrated_nt};
+
+ return( $cal, $cal_err, $off, $off_err, $type );
+} # End of SDgetcal()...
+
+=head2 SDget
+
+=for ref
+
+ Get a the data from and SDS, or just a slice of that SDS.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the SDS you want to get.
+ 2 (optional): The start array ref of the slice.
+ 3 (optional): The size array ref of the slice (HDF calls this the 'edge').
+ 4 (optional): The stride array ref of the slice.
+
+ Returns a PDL of data if ok, PDL::null on error.
+
+ If the slice arguements are not given, this function will read the entire
+ SDS from the file.
+
+ The type of the returned PDL variable is the PDL equivalent of what was
+ stored in the HDF file.
+
+=for example
+
+ # Get the entire SDS:
+ my $pdldata = $hdf->SDget("dataset_name");
+
+ # get a slice of the dataset
+ my $start = [10,50,10]; # the start position of the slice is [10, 50, 10]
+ my $edge = [20,20,20]; # read 20 values on each dimension from @start
+ my $stride = [1, 1, 1]; # Don't skip values
+ my $pdldata = $hdf->SDget( "dataset_name", $start, $edge, $stride );
+
+=cut
+
+
+sub SDget
+{
+ my($self, $name, $start, $end, $stride) = @_;
+ my $sub = _pkg_name( 'SDget' );
+
+ return null
+ unless defined( $self->{DATASET}->{$name} );
+
+ unless( defined( $end ) )
+ { # \@end was not passed in, so we need to set everything else to defaults:
+ ($start, $end) = [];
+ my @dimnames=$self->SDgetdimnames($name);
+ for my $dim (0 .. $#dimnames)
+ {
+ my $use_size = $self->{DATASET}->{$name}->{DIMS}->{$dim}->{SIZE}
+ || $self->{DATASET}->{$name}->{DIMS}->{$dim}->{REAL_SIZE};
+
+ $$end[ $dim ] = $use_size;
+ $$start[ $dim ] = 0;
+ $$stride[ $dim ] = 1;
+ }
+ }
+
+ my $c_start = pack ("L*", @$start);
+ my $c_end = pack ("L*", @$end);
+ my $c_stride = pack ("L*", @$stride);
+ #print STDERR "$sub: start:[".join(',',@$start)
+ # ."]=>$c_start end:[".join(',',@$end)
+ # ."]=>$c_end stride:[".join(',',@$stride)."]=>$c_stride\n";
+
+ my $buff = zeroes( $PDL::IO::HDF::SDinvtypeTMAP2->{$self->{DATASET}->{$name}->{TYPE}}, reverse @$end );
+
+ my $res = _SDreaddata( $self->{DATASET}->{$name}->{SDSID}, $c_start, $c_stride, $c_end, $buff );
+ if($res == PDL::IO::HDF->FAIL)
+ {
+ $buff = null;
+ print "$sub: Error returned from _SDreaddata()!\n";
+ }
+
+ return $buff;
+} # End of SDget()...
+
+=head2 SDsetfillvalue
+
+=for ref
+
+ Set the fill value for an SDS.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the SDS.
+ 2 : The fill value.
+
+ Returns true on success, undef on error.
+
+=for example
+
+ my $res = $hdf->SDsetfillvalue("dataset_name",$fillvalue);
+
+=cut
+
+
+sub SDsetfillvalue
+{
+ my ($self, $name, $value) = @_;
+
+ return( undef )
+ unless defined( $self->{DATASET}->{$name} );
+
+ $value = &{$PDL::IO::HDF::SDinvtypeTMAP->{$self->{DATASET}->{$name}->{TYPE}}}($value);
+ $self->{DATASET}->{$name}->{ATTRS}->{_FillValue} = $value;
+
+ return( _SDsetfillvalue($self->{DATASET}->{$name}->{SDSID}, $value) + 1 );
+} # End of SDsetfillvalue()...
+
+=head2 SDsetrange
+
+=for ref
+
+ Set the valid range of an SDS.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the SDS
+ 2 : an anonymous array of two elements : [min, max].
+
+ Returns true on success, undef on error.
+
+=for example
+
+ my $res = $hdf->SDsetrange("dataset_name", [$min, $max]);
+
+=cut
+
+
+sub SDsetrange
+{
+ my ($self, $name, $range) = @_;
+
+ return undef
+ unless defined( $self->{DATASET}->{$name} );
+
+ my $min = &{$PDL::IO::HDF::SDinvtypeTMAP->{$self->{DATASET}->{$name}->{TYPE}}}($$range[0]);
+ my $max = &{$PDL::IO::HDF::SDinvtypeTMAP->{$self->{DATASET}->{$name}->{TYPE}}}($$range[1]);
+ $range = &{$PDL::IO::HDF::SDinvtypeTMAP->{$self->{DATASET}->{$name}->{TYPE}}}($range);
+ $self->{DATASET}->{$name}->{ATTRS}->{valid_range} = $range;
+
+ return( _SDsetrange($self->{DATASET}->{$name}->{SDSID}, $max, $min) + 1 );
+} # End of SDsetrange()...
+
+=head2 SDsetcal
+
+=for ref
+
+ Set the HDF calibration for an SDS.
+
+ In HDF lingo, this means to define:
+ scale factor
+ scale factor error
+ offset
+ offset error
+
+=for usage
+
+ Arguments:
+ 1 : The name of the SDS.
+ 2 (optional): the scale factor (default is 1)
+ 3 (optional): the scale factor error (default is 0)
+ 4 (optional): the offset (default is 0)
+ 5 (optional): the offset error (default is 0)
+
+ Returns true on success, undef on error.
+
+ NOTE: This is not required to make a valid HDF SDS, but is there if you want to use it.
+
+=for example
+
+ # Create the dataset:
+ my $res = $hdf->SDsetcal("dataset_name");
+
+ # To just set the scale factor:
+ $res = $hdf->SDsetcal("dataset_name", $scalefactor);
+
+ # To set all calibration parameters:
+ $res = $hdf->SDsetcal("dataset_name", $scalefactor, $scale_err, $offset, $off_err);
+
+=cut
+
+
+sub SDsetcal
+{
+ my $self = shift;
+ my $name = shift;
+
+ return( undef )
+ unless defined( $self->{DATASET}->{$name} );
+
+ $self->{DATASET}->{$name}->{ATTRS}->{scale_factor} = shift || 1;
+ $self->{DATASET}->{$name}->{ATTRS}->{scale_factor_err} = shift || 0;
+ $self->{DATASET}->{$name}->{ATTRS}->{add_offset} = shift || 0;
+ $self->{DATASET}->{$name}->{ATTRS}->{add_offset_err} = shift || 0;
+ # PDL_Double is the default type:
+ $self->{DATASET}->{$name}->{ATTRS}->{calibrated_nt} = shift || 6;
+
+ return(
+ _SDsetcal(
+ $self->{DATASET}->{$name}->{SDSID},
+ $self->{DATASET}->{$name}->{ATTRS}->{scale_factor},
+ $self->{DATASET}->{$name}->{ATTRS}->{scale_factor_err},
+ $self->{DATASET}->{$name}->{ATTRS}->{add_offset},
+ $self->{DATASET}->{$name}->{ATTRS}->{add_offset_err},
+ $self->{DATASET}->{$name}->{ATTRS}->{calibrated_nt}
+ ) + 1);
+} # End of SDsetcal()...
+
+=head2 SDsetcompress
+
+=for ref
+
+ Set the internal compression on an SDS.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the SDS.
+ 2 (optional): The gzip compression level ( 1 - 9 ). If not
+ specified, then 6 is used.
+
+ Returns true on success, undef on failure.
+
+ WARNING: This is a fairly buggy feature with many version of the HDF library.
+ Please just use the 'Chunking' features instead, as they work far better, and
+ are more reliable.
+
+=for example
+
+ my $res = $hdf->SDsetfillvalue("dataset_name",$deflate_value);
+
+=cut
+
+
+sub SDsetcompress
+{
+ my ($self, $name) = @_;
+
+ return( undef )
+ unless defined( $self->{DATASET}->{$name} );
+
+ # NOTE: Behavior change from the old version:
+ # it used to set to 6 if the passed value was greater than 8
+ # it now sets it to 9 if it's greater than 9.
+ my $deflate = shift || 6;
+ $deflate = 9
+ if( $deflate > 9 );
+
+ return( 1 + _SDsetcompress( $self->{DATASET}->{$name}->{SDSID}, $deflate ) );
+} # End of SDsetcompress()...
+
+=head2 SDsettextattr
+
+=for ref
+
+ Add a text HDF attribute, either globally, or to an SDS.
+
+=for usage
+
+ Arguments:
+ 1 : The text you want to add.
+ 2 : The name of the attribute
+ 3 (optional): The name of the SDS.
+
+ Returns true on success, undef on failure.
+
+=for example
+
+ # Set a global text attribute:
+ my $res = $hdf->SDsettextattr("my_text", "attribut_name");
+
+ # Set a local text attribute for 'dataset_name':
+ $res = $hdf->SDsettextattr("my_text", "attribut_name", "dataset_name");
+
+=cut
+
+
+sub SDsettextattr
+{
+ my ($self, $text, $name, $dataset) = @_;
+
+ if( defined($dataset) )
+ {
+ return( undef )
+ unless defined( $self->{DATASET}->{$dataset} );
+
+ $self->{DATASET}->{$dataset}->{ATTRS}->{$name} = $text;
+ return( _SDsetattr_text( $self->{DATASET}->{$dataset}->{SDSID}, $name, $text, length($text) ) + 1 );
+ }
+
+ # Implied else it's a global attribute:
+ $self->{GLOBATTR}->{$name} = $text;
+ return( _SDsetattr_text( $self->{SDID}, $name, $text, length($text) ) + 1);
+} # End of SDsettextattr()...
+
+=head2 SDsetvalueattr
+
+=for ref
+
+ Add a non-text HDF attribute, either globally, or to an SDS.
+
+=for usage
+
+ Arguments:
+ 1 : A pdl of value(s) you want to store.
+ 2 : The name of the attribute.
+ 3 (optional): the name of the SDS.
+
+ Returns true on success, undef on failure.
+
+=for example
+
+ my $attr = sequence( long, 4 );
+
+ # Set a global attribute:
+ my $res = $hdf->SDsetvalueattr($attribute, "attribute_name");
+
+ # Set a local attribute for 'dataset_name':
+ $res = $hdf->SDsetvalueattr($attribute, "attribute_name", "dataset_name");
+
+=cut
+
+
+sub SDsetvalueattr
+{
+ my ($self, $values, $name, $dataset) = @_;
+
+ if( defined($dataset) )
+ {
+ return( undef )
+ unless defined( $self->{DATASET}->{$dataset} );
+
+ $self->{DATASET}->{$dataset}->{ATTRS}->{$name} = $values;
+ return( _SDsetattr_values(
+ $self->{DATASET}->{$dataset}->{SDSID}, $name, $values,
+ $values->nelem(), $PDL::IO::HDF::SDtypeTMAP->{$values->get_datatype()} ) + 1);
+ }
+ # Implied else it's a global attribute:
+ $self->{GLOBATTR}->{$name} = $values;
+ return( _SDsetattr_values(
+ $self->{SDID}, $name, $values,
+ $values->nelem(), $PDL::IO::HDF::SDtypeTMAP->{$values->get_datatype()} ) + 1);
+} # End of SDsetvalueattr()...
+
+=head2 SDsetdimname
+
+=for ref
+
+ Set or rename the dimensions of an SDS.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the SDS.
+ 2 : An anonymous array with the dimensions names. For dimensions you want
+ to leave alone, leave 'undef' placeholders.
+
+ Returns true on success, undef on failure.
+
+=for example
+
+ # Rename all dimensions
+ my $res = $hdf->SDsetdimname("dataset_name", ['dim1','dim2','dim3']);
+
+ # Rename some dimensions
+ $res = $hdf->SDsetdimname("dataset_name", ['dim1', undef ,'dim3']);
+
+=cut
+
+
+# FIXME: There are several problems with this:
+# - The return code is an aggregate, and not necessarily accurate
+# - It bails on the first error without trying the rest. If that is still
+# desired, then it should run the check first, and if it's ok, then actually
+# make the HDF library call.
+sub SDsetdimname
+{
+ my ($self, $name, $dimname) = @_;
+
+ return undef
+ unless defined( $self->{DATASET}->{$name} );
+
+ my $res = 0;
+ foreach( sort keys %{$self->{DATASET}->{$name}->{DIMS}} )
+ {
+ return( undef )
+ unless defined( $$dimname[ $_ ] );
+
+ $res = _SDsetdimname(
+ $self->{DATASET}->{$name}->{DIMS}->{$_}->{DIMID},
+ $$dimname[ $_ ] ) + 1;
+ }
+ return( $res );
+} # End of SDsetdimname()...
+
+=head2 SDput
+
+=for ref
+
+ Write to a SDS in an HDF file or create and write to it if it doesn't exist.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the SDS.
+ 2 : A pdl of data.
+ 3 (optional): An anonymous array of the dim names (only for creation)
+ 4 (optional): An anonymous array of the start of the slice to store
+ (only for putting a slice)
+
+ Returns true on success, undef on failure.
+
+ The datatype of the SDS in the HDF file will match the PDL equivalent as
+ much as possible.
+
+=for example
+
+ my $data = sequence( float, 10, 20, 30 ); #any value you want
+
+ # Simple case: create a new dataset with a $data pdl
+ my $result = $hdf->SDput("dataset_name", $data);
+
+ # Above, but also naming the dims:
+ $res = $hdf->SDput("dataset_name", $data, ['dim1','dim2','dim3']);
+
+ # Just putting a slice in there:
+ my $start = [x,y,z];
+ $res = $hdf->SDput("dataset_name", $data->slice("..."), undef, $start);
+
+=cut
+
+
+sub SDput
+{
+ my($self, $name, $data, $dimname_p, $from) = @_;
+
+ my $sub = _pkg_name( 'SDput' );
+
+ my $rank = $data->getndims();
+ my $dimsize = pack ("L*", reverse $data->dims);
+
+ # If this dataset doesn't already exist, then create it:
+ #
+ unless ( defined( $self->{DATASET}->{$name} ) )
+ {
+ my $hdf_type = $PDL::IO::HDF::SDtypeTMAP->{$data->get_datatype()};
+
+ my $res = _SDcreate( $self->{SDID}, $name, $hdf_type, $rank, $dimsize );
+ return( undef )
+ if ($res == PDL::IO::HDF->FAIL);
+
+ $self->{DATASET}->{$name}->{SDSID} = $res;
+ $self->{DATASET}->{$name}->{TYPE} = $hdf_type;
+ $self->{DATASET}->{$name}->{RANK} = $rank;
+
+ if( $self->Chunking() )
+ {
+ # Setup chunking on this dataset:
+ my @chunk_lens;
+ my $min_chunk_size = 100;
+ my $num_chunks = 10;
+ my $total_chunks = 1;
+ foreach my $dimsize ( $data->dims() )
+ {
+ my $chunk_size = ($dimsize + 9) / $num_chunks;
+ my $num_chunks_this_dim = $num_chunks;
+ if( $chunk_size < $min_chunk_size )
+ {
+ $chunk_size = $min_chunk_size;
+ # Re-calc the num_chunks_per_dim:
+ $num_chunks_this_dim = POSIX::ceil( $dimsize / $chunk_size );
+ }
+ push(@chunk_lens, $chunk_size);
+ $total_chunks *= $num_chunks_this_dim;
+ }
+ my $chunk_lengths = pack("L*", reverse @chunk_lens);
+
+ $res = _SDsetchunk( $self->{DATASET}->{$name}->{SDSID}, $rank, $chunk_lengths );
+ return( undef )
+ if ($res == PDL::IO::HDF->FAIL);
+
+ $res = _SDsetchunkcache( $self->{DATASET}->{$name}->{SDSID}, $total_chunks, 0);
+ return( undef )
+ if ($res == PDL::IO::HDF->FAIL);
+ } # End of chunking section...
+ } # End of dataset creation...
+
+ my $start = [];
+ my $stride = [];
+ if( defined( $from ) )
+ {
+ $start = $from;
+ foreach($data->dims)
+ { push(@$stride, 1); }
+ }
+ else
+ { # $from was not defined, so assume we're doing all of it:
+ foreach($data->dims)
+ {
+ push(@$start, 0);
+ push(@$stride, 1);
+ }
+ }
+ $start = pack ("L*", @$start);
+ $stride = pack ("L*", @$stride);
+ $data->make_physical();
+
+ $res = _SDwritedata( $self->{DATASET}->{$name}->{SDSID}, $start, $stride, $dimsize, $data );
+ return( undef )
+ if ($res == PDL::IO::HDF->FAIL);
+
+ foreach my $j ( 0 .. $rank-1 )
+ {
+ # Probably not a good way to bail:
+ my $dim_id = _SDgetdimid( $self->{DATASET}->{$name}->{SDSID}, $j );
+ return( undef )
+ if( $dim_id == PDL::IO::HDF->FAIL);
+
+ if( defined( @$dimname_p[$j] ) )
+ {
+ $res = _SDsetdimname( $dim_id, @$dimname_p[$j] );
+ return( undef )
+ if( $res == PDL::IO::HDF->FAIL );
+ }
+
+ my $dimname = " "x(PDL::IO::HDF->MAX_NC_NAME);
+ my $size = 0;
+ my $num_dim_attrs = 0;
+ $res = _SDdiminfo( $dim_id, $dimname, $size, $numtype=0, $num_dim_attrs);
+
+ return( undef )
+ if ($res == PDL::IO::HDF->FAIL);
+ $self->{DATASET}->{$name}->{DIMS}->{$j}->{NAME} = $dimname;
+ $self->{DATASET}->{$name}->{DIMS}->{$j}->{SIZE} = $size;
+ $self->{DATASET}->{$name}->{DIMS}->{$j}->{DIMID} = $dim_id;
+ }
+ return( 1 );
+} # End of SDput()...
+
+=head2 close
+
+=for ref
+
+ Close an HDF file.
+
+=for usage
+
+ No arguments.
+
+=for example
+
+ my $result = $hdf->close();
+
+=cut
+
+
+# NOTE: This may not be enough, since there may be opened datasets as well! SDendaccess()!
+sub close
+{
+ my $self = shift;
+ my $sdid = $self->{SDID};
+ $self = undef;
+ return( _SDend( $sdid ) + 1);
+} # End of close()...
+
+sub DESTROY
+{
+ my $self = shift;
+ $self->close;
+} # End of DESTROY()...
+
+EOPM
+
+#
+# Add the tail of the documentation to the module:
+#
+pp_addpm(<<'EOD');
+
+=head1 CURRENT AUTHOR & MAINTAINER
+
+Judd Taylor, Orbital Systems, Ltd.
+judd dot t at orbitalsystems dot com
+
+=head1 PREVIOUS AUTHORS
+
+Patrick Leilde patrick.leilde at ifremer.fr
+contribs of Olivier Archer olivier.archer at ifremer.fr
+
+=head1 SEE ALSO
+
+perl(1), PDL(1), PDL::IO::HDF(1).
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/IO/HDF/TODO b/IO/HDF/TODO
new file mode 100644
index 0000000..18f49f8
--- /dev/null
+++ b/IO/HDF/TODO
@@ -0,0 +1,39 @@
+#
+# PDL::IO::HDF
+#
+# Version 2.0 TODO:
+# We get there and it'll be included in the main PDL distribution!
+#
+# Judd Taylor, USF IMaRS
+# 17 March 2006
+#
+
+############
+# General: #
+############
+
+ Internally, everything should be using Class::Accessor methods, to seperate the naming semantics...
+
+ I've always wanted better error handling, but that's a little ambitious for this version.
+ The current error handling is to just die, but that's a major pain, since you may just want
+ to open HDF files as a test and do something else if it fails.
+ If the sub doesn't just die(), then it returns alls sorts of things currently (0, [], undef)
+
+ I prefer lazy population of information, as it speeds up doing simple things on the files
+ greatly. [NOTE: I've also written my own HDF4 C++ lib, and it works great there].
+
+ Real OO re-design and re-implementation (not for this version, though).
+
+
+##########
+# Tests: #
+##########
+
+
+##################
+# Documentation: #
+##################
+
+ The VS.pd file needs a lot more documentation.
+
+
diff --git a/IO/HDF/VS/Changes b/IO/HDF/VS/Changes
new file mode 100644
index 0000000..4e8b2e0
--- /dev/null
+++ b/IO/HDF/VS/Changes
@@ -0,0 +1,3 @@
+Revision history for Perl extension PDL::HDF
+0.01 13/02/01
+ - original version
diff --git a/IO/HDF/VS/MANIFEST b/IO/HDF/VS/MANIFEST
new file mode 100644
index 0000000..1901da4
--- /dev/null
+++ b/IO/HDF/VS/MANIFEST
@@ -0,0 +1,3 @@
+VS.pd
+Changes
+Makefile.PL
diff --git a/IO/HDF/VS/Makefile.PL b/IO/HDF/VS/Makefile.PL
new file mode 100644
index 0000000..a8fa53f
--- /dev/null
+++ b/IO/HDF/VS/Makefile.PL
@@ -0,0 +1,30 @@
+#
+# Makefile.PL for PDL::IO::HDF::VS module.
+#
+
+use ExtUtils::MakeMaker;
+use Config;
+
+PDL::Core::Dev->import();
+
+$package = [ "VS.pd" , VS , PDL::IO::HDF::VS ];
+WriteMakefile(
+ NAME => 'PDL::IO::HDF::VS',
+ TYPEMAPS => [ &PDL_TYPEMAP() ],
+ OBJECT => 'VS.o',
+ PM => {
+ 'VS.pm' => '$(INST_LIBDIR)/VS.pm',
+ },
+ INC => &PDL_INCLUDE() . " -I$hdf_include_path",
+ LIBS => [ "-L$hdf_lib_path $hdf_libs -ljpeg -lz $szip" ],
+ clean => {
+ FILES => 'VS.pm VS.xs VS.o VS.c',
+ },
+ dist => {
+ COMPRESS => 'gzip',
+ SUFFIX => 'gz',
+ },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
+sub MY::postamble { pdlpp_postamble_int($package); }
diff --git a/IO/HDF/VS/VS.pd b/IO/HDF/VS/VS.pd
new file mode 100644
index 0000000..8f2a1d6
--- /dev/null
+++ b/IO/HDF/VS/VS.pd
@@ -0,0 +1,793 @@
+pp_addpm({At => Top}, <<'EOD');
+
+=head1 NAME
+
+PDL::IO::HDF - An interface library for HDF4 files.
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::IO::HDF::VS;
+
+ #### no doc for now ####
+
+=head1 DESCRIPTION
+
+This librairy provide functions to manipulate
+HDF4 files with VS and V interface (reading, writting, ...)
+
+For more infomation on HDF4, see http://www.hdfgroup.org/products/hdf4/
+
+=head1 FUNCTIONS
+
+=cut
+
+EOD
+
+
+pp_addhdr(<<'EOH');
+
+#include <hdf.h>
+#include <string.h>
+#include <stdio.h>
+
+#include <perl.h>
+#include <EXTERN.h>
+#include <XSUB.h>
+
+#define PDLchar pdl
+#define PDLuchar pdl
+#define PDLshort pdl
+#define PDLint pdl
+#define PDLlong pdl
+#define PDLfloat pdl
+#define PDLdouble pdl
+#define PDLvoid pdl
+#define uchar unsigned char
+
+#define PDLlist pdl
+
+EOH
+
+#define AVRef AV
+#pp_bless ("PDL::IO::HDF::VS");
+
+use lib "../";
+use buildfunc;
+
+
+#-------------------------------------------------------------------------
+# Create low level interface from HDF VS and V header file.
+#-------------------------------------------------------------------------
+
+create_low_level (<<'EODEF');
+#
+# HDF (H) Interface
+#
+int Hishdf(const char *filename);
+int Hopen(const char *filename, int access, int n_dds);
+int Hclose(int file_id)+1;
+#
+# VGROUP/VDATA Interface
+#
+int Vstart(int hdfid);
+int Vend(int hdfid);
+int Vgetid(int hdfid, int vgroup_ref);
+int Vattach(int hdfid, int vgroup_ref, const char *access);
+int Vdetach(int vgroup_id);
+int Vntagrefs(int vgroup_id);
+
+int Vgettagref(int vgroup_id, int index, int *tag, int *ref);
+int Vinquire(int vgroup_id, int *n_entries, char *vgroup_name);
+
+int Vsetname(int vgroup_id, const char *vgroup_name);
+int Vsetclass(int vgroup_id, const char *vgroup_class);
+int Visvg(int vgroup_id, int obj_ref);
+int Visvs(int vgroup_id, int obj_ref);
+int Vaddtagref(int vgroup_id, int tag, int ref);
+int Vinsert(int vgroup_id, int v_id);
+
+int VSsetname(int vdata_id, const char *vdata_name);
+int VSsetclass(int vdata_id, const char *vdata_class);
+int VSgetid(int hdfid, int vdata_ref);
+int VSattach(int hdfid, int vdata_ref, const char *access);
+int VSdetach(int vdata_id);
+int VSelts(int vdata_id);
+int VSsizeof(int vdata_id, const char *fields);
+int VSfind(int hdfid, const char *vdata_name);
+int VFfieldtype(int vdata_id, int field_index);
+int VFnfields(int vdata_ref);
+int VFfieldorder(int vdata_ref, int field_index);
+
+int VSfdefine(int vata_id, const char *fieldname, int data_type, int order)+1;
+int VSsetfields(int vata_id, const char *fieldname_list)+1;
+int VSwrite(int vdata_id, const PDLvoid *databuf, int n_records, int interlace_mode);
+int VSread(int vdata_id, PDLvoid *databuf, int n_records, int interlace_mode);
+#int VSlone(int file_id, int *ref_array, int max_ref);
+
+int VSfnattrs(int vdata_id, int field_index);
+int VSgetattr(int vdata_id, int field_index, int attr_index, PDLlong *values);
+int VSisattr(int vdata_id);
+
+int SDstart(const char *filename, int access_mode);
+int SDreftoindex(int sd_id, int sds_ref);
+int SDselect(int sd_id, int index);
+int SDgetinfo(int sds_id, char *sds_name, int *rank, int *dimsizes, int *number_type, int *nattrs);
+int SDendaccess(int sds_id);
+int SDend(int sd_id);
+
+EODEF
+
+pp_addxs('',<<'ENDOFXS');
+
+int
+_WriteMultPDL(VID, nb_records, nb_fields, interlace_mode, ...);
+ int VID
+ int nb_records
+ int nb_fields
+ int interlace_mode
+ PROTOTYPE: @
+ CODE:
+ unsigned char *databuff, *ptrbuff;
+ unsigned long int total_size;
+ int i, j, k, curvalue, cursdim;
+ SV * sizeofPDL;
+ SV * listofPDL;
+ SV * sdimofPDL;
+ SV * * SvTmp1, * * SvTmp2, * * SvTmp3;
+ pdl *curPDL;
+
+ sizeofPDL = SvRV( ST(4) );
+ sdimofPDL = SvRV( ST(5) );
+ listofPDL = SvRV( ST(6) );
+
+ total_size = 0;
+ for(i=0; i<nb_fields; i++)
+ {
+ SvTmp1 = av_fetch((AV*)sizeofPDL, i, 0);
+ curvalue = SvIV( *SvTmp1 );
+
+ SvTmp3 = av_fetch((AV*)sdimofPDL, i, 0);
+ cursdim = SvIV( *SvTmp3 );
+
+ total_size += curvalue * cursdim;
+ }
+
+ total_size *= nb_records;
+ databuff = (unsigned char *)malloc( total_size );
+ if(databuff==NULL)
+ croak("memory allocation error");
+ ptrbuff = databuff;
+
+ if(interlace_mode == 0)
+ {
+ for(i=0; i<nb_records; i++)
+ {
+ for(j=0; j<nb_fields; j++)
+ {
+ SvTmp2 = av_fetch((AV*)listofPDL, j, 0);
+ curPDL = PDL->SvPDLV( *SvTmp2 );
+
+ SvTmp3 = av_fetch((AV*)sdimofPDL, j, 0);
+ cursdim = SvIV( *SvTmp3 );
+
+ SvTmp1 = av_fetch((AV*)sizeofPDL, j, 0);
+ curvalue = SvIV( *SvTmp1 );
+
+ for(k=0; k<cursdim; k++)
+ {
+ #printf("Value %d= %d\n", k, *(int *)(curPDL->data + curvalue*i + curvalue*k*nb_records));
+ memcpy( ptrbuff, (unsigned char *)(curPDL->data + curvalue*i + curvalue*k*nb_records), curvalue );
+
+ #printf("Value %d=%d\n", k, *(int *)(curPDL->data + curvalue*i*cursdim + curvalue*k));
+ #memcpy( ptrbuff, (unsigned char *)(curPDL->data + curvalue*i*cursdim + curvalue*k), curvalue );
+
+ #printf("buffer %d= %d\n", k, *(int *)ptrbuff);
+ ptrbuff += curvalue;
+ }
+ }
+ }
+ }
+ else
+ {
+ for(j=0; j<nb_fields; j++)
+ {
+ SvTmp2 = av_fetch((AV*)listofPDL, j, 0);
+ curPDL = PDL->SvPDLV( *SvTmp2 );
+
+ SvTmp1 = av_fetch((AV*)sizeofPDL, j, 0);
+ curvalue = SvIV( *SvTmp1 );
+
+ SvTmp3 = av_fetch((AV*)sdimofPDL, j, 0);
+ cursdim = SvIV( *SvTmp3 );
+
+ memcpy( ptrbuff, (unsigned char *)(curPDL->data), curvalue*nb_records*cursdim );
+ ptrbuff += curvalue*nb_records*cursdim;
+ #printf("buffer %d= %d\n", k, curvalue*nb_records*cursdim);
+ }
+ interlace_mode = 1;
+ }
+ fprintf(stderr, "Calling VSwrite(VID=%d, databuff=%p, nb_records=%d, interlace_mode=%d)...\n",
+ VID, databuff, nb_records, interlace_mode);
+ RETVAL = VSwrite(VID, databuff, nb_records, interlace_mode);
+ OUTPUT:
+ RETVAL
+
+void
+_Vgetname(vgroup_id, vgroup_name);
+ int vgroup_id
+ char *vgroup_name
+ CODE:
+ vgroup_name=(char *)malloc(VGNAMELENMAX);
+ Vgetname(vgroup_id,vgroup_name);
+ OUTPUT:
+ vgroup_name
+
+void
+_VSgetname(vdata_id, vdata_name);
+ int vdata_id
+ char *vdata_name
+ CODE:
+ vdata_name=(char *)malloc(VGNAMELENMAX*sizeof(char));
+ VSgetname(vdata_id,vdata_name);
+ OUTPUT:
+ vdata_name
+
+void
+_Vgetclass(vgroup_id, vgroup_class);
+ int vgroup_id
+ char *vgroup_class
+ CODE:
+ vgroup_class=(char *)malloc(VGNAMELENMAX*sizeof(char));
+ Vgetclass(vgroup_id,vgroup_class);
+ OUTPUT:
+ vgroup_class
+
+void
+_VSgetclass(vdata_id, vdata_class);
+ int vdata_id
+ char *vdata_class
+ CODE:
+ vdata_class=(char *)malloc(VGNAMELENMAX*sizeof(char));
+ VSgetclass(vdata_id,vdata_class);
+ OUTPUT:
+ vdata_class
+
+int
+_VSgetfields(vdata_id, fields);
+ int vdata_id
+ char *fields
+ CODE:
+ char *tmpfields;
+ int len;
+ tmpfields=(char *)malloc(10000*sizeof(char));
+ RETVAL=VSgetfields(vdata_id, tmpfields);
+ len=strlen(tmpfields);
+ fields=(char *)malloc(len*sizeof(char)+1);
+ strcpy(fields,tmpfields);
+ OUTPUT:
+ RETVAL
+ fields
+
+AV *
+_VSlone(file_id);
+ int file_id;
+ CODE:
+ AV *ref_vdata_list;
+ int *ref_array;
+ SV *ref_vdata;
+ int32 nlone;
+ ref_vdata_list=newAV();
+ ref_array=(int *)malloc(MAX_FIELD_SIZE*sizeof(int));
+ nlone = VSlone(file_id, ref_array, MAX_FIELD_SIZE);
+ int32 i;
+ for(i=0;i<nlone;i++){
+ ref_vdata=newSViv((IV)ref_array[i]);
+ av_push(ref_vdata_list, ref_vdata);
+ }
+ RETVAL=ref_vdata_list;
+ OUTPUT:
+ RETVAL
+
+
+int
+_VSinquire(vdata_id, n_records, interlace, fields, vdata_size, vdata_name);
+ int vdata_id
+ int *n_records
+ int *interlace
+ char *fields
+ int *vdata_size
+ char *vdata_name
+CODE:
+ char *tmpfields;
+ int len;
+ vdata_name=(char *)malloc(VGNAMELENMAX*sizeof(char));
+ tmpfields=(char *)malloc(10000*sizeof(char));
+ RETVAL=VSinquire(vdata_id, n_records, interlace, tmpfields, vdata_size, vdata_name)+1;
+ len=strlen(tmpfields);
+ fields=(char *)malloc(len*sizeof(char)+1);
+ strcpy(fields,tmpfields);
+OUTPUT:
+ RETVAL
+ n_records
+ interlace
+ fields
+ vdata_size
+ vdata_name
+
+ENDOFXS
+
+pp_addpm(<<'EOPM');
+
+use PDL::Primitive;
+use PDL::Basic;
+use strict;
+
+use PDL::IO::HDF;
+
+my $TMAP = {
+ PDL::byte->[0] => 1,
+ PDL::short->[0] => 2,
+ PDL::ushort->[0] => 2,
+ PDL::long->[0] => 4,
+ PDL::float->[0] => 4,
+ PDL::double->[0] => 8
+};
+
+sub _pkg_name
+ { return "PDL::IO::HDF::VS::" . shift() . "()"; }
+
+=head2 new
+
+=for ref
+
+ Open or create a new HDF object with VS and V interface.
+
+=for usage
+
+ Arguments:
+ 1 : The name of the HDF file.
+ If you want to write to it, prepend the name with the '+' character : "+name.hdf"
+ If you want to create it, prepend the name with the '-' character : "-name.hdf"
+ Otherwise the file will be opened in read only mode.
+
+ Returns the hdf object (die on error)
+
+=for example
+
+ my $hdf = PDL::IO::HDF::VS->new("file.hdf");
+
+=cut
+
+sub new
+{
+ # general
+ my $type = shift;
+ my $filename = shift;
+
+ my $self = {};
+
+ if (substr($filename, 0, 1) eq '+')
+ { # open for writing
+ $filename = substr ($filename, 1); # chop off +
+ $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_WRITE + PDL::IO::HDF->DFACC_READ;
+ }
+ if (substr($filename, 0, 1) eq '-')
+ { # Creating
+ $filename = substr ($filename, 1); # chop off -
+ $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_CREATE;
+ }
+
+ unless( defined($self->{ACCESS_MODE}) )
+ {
+ $self->{ACCESS_MODE} = PDL::IO::HDF->DFACC_READ;
+ }
+
+ $self->{FILE_NAME} = $filename;
+
+ $self->{HID} = PDL::IO::HDF::VS::_Hopen( $self->{FILE_NAME}, $self->{ACCESS_MODE}, 20 );
+ if ($self->{HID})
+ {
+ PDL::IO::HDF::VS::_Vstart( $self->{HID} );
+
+ my $SDID = PDL::IO::HDF::VS::_SDstart( $self->{FILE_NAME}, $self->{ACCESS_MODE} );
+
+ #### search for vgroup
+ my $vgroup = {};
+
+ my $vg_ref = -1;
+ while( ($vg_ref = PDL::IO::HDF::VS::_Vgetid( $self->{HID}, $vg_ref )) != PDL::IO::HDF->FAIL)
+ {
+ my $vg_id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $vg_ref, 'r' );
+
+ my $n_entries = 0;
+
+ my $vg_name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
+ my $res = PDL::IO::HDF::VS::_Vinquire( $vg_id, $n_entries, $vg_name );
+
+ my $vg_class = "";
+ PDL::IO::HDF::VS::_Vgetclass( $vg_id, $vg_class );
+
+ $vgroup->{$vg_name}->{ref} = $vg_ref;
+ $vgroup->{$vg_name}->{class} = $vg_class;
+
+ my $n_pairs = PDL::IO::HDF::VS::_Vntagrefs( $vg_id );
+
+ for ( 0 .. $n_pairs-1 )
+ {
+ my ($tag, $ref);
+ $res = PDL::IO::HDF::VS::_Vgettagref( $vg_id, $_, $tag = 0, $ref = 0 );
+ if($tag == 1965)
+ { # Vgroup
+ my $id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $ref, 'r' );
+ my $name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
+ my $res = PDL::IO::HDF::VS::_Vgetname( $id, $name );
+ PDL::IO::HDF::VS::_Vdetach( $id );
+ $vgroup->{$vg_name}->{children}->{$name} = $ref;
+ $vgroup->{$name}->{parents}->{$vg_name} = $vg_ref;
+ }
+ elsif($tag == 1962)
+ { # Vdata
+ my $id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $ref, 'r' );
+ my $name = " "x(PDL::IO::HDF->VNAMELENMAX+1);
+ my $res = PDL::IO::HDF::VS::_VSgetname( $id, $name );
+ my $class = "";
+ PDL::IO::HDF::VS::_VSgetclass( $id, $class );
+ PDL::IO::HDF::VS::_VSdetach( $id );
+ $vgroup->{$vg_name}->{attach}->{$name}->{type} = 'VData';
+ $vgroup->{$vg_name}->{attach}->{$name}->{ref} = $ref;
+ $vgroup->{$vg_name}->{attach}->{$name}->{class} = $class
+ if( $class ne '' );
+ }
+ if( ($SDID != PDL::IO::HDF->FAIL) && ($tag == 720)) #tag for SDS tag/ref (see 702)
+ {
+ my $i = _SDreftoindex( $SDID, $ref );
+ my $sds_ID = _SDselect( $SDID, $i );
+
+ my $name = " "x(PDL::IO::HDF->MAX_NC_NAME+1);
+ my $rank = 0;
+ my $dimsize = " "x( (4 * PDL::IO::HDF->MAX_VAR_DIMS) + 1 );
+ my $numtype = 0;
+ my $nattrs = 0;
+
+ $res = _SDgetinfo( $sds_ID, $name, $rank, $dimsize , $numtype, $nattrs );
+
+ $vgroup->{$vg_name}->{attach}->{$name}->{type} = 'SDS_Data';
+ $vgroup->{$vg_name}->{attach}->{$name}->{ref} = $ref;
+ }
+ } # for each pair...
+
+ PDL::IO::HDF::VS::_Vdetach( $vg_id );
+ } # while vg_ref...
+
+ PDL::IO::HDF::VS::_SDend( $SDID );
+ $self->{VGROUP} = $vgroup;
+
+ #### search for vdata
+ my $vdata_ref=-1;
+ my $vdata_id=-1;
+ my $vdata = {};
+
+ # get lone vdata (not member of a vgroup)
+ my $lone=PDL::IO::HDF::VS::_VSlone($self->{HID});
+
+ my $MAX_REF = 0;
+ while ( $vdata_ref = shift @$lone )
+ {
+ my $mode="r";
+ if ( $self->{ACCESS_MODE} != PDL::IO::HDF->DFACC_READ )
+ {
+ $mode="w";
+ }
+ $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, $mode );
+ my $vdata_size = 0;
+ my $n_records = 0;
+ my $interlace = 0;
+ my $fields = "";
+ my $vdata_name = "";
+
+ my $status = PDL::IO::HDF::VS::_VSinquire(
+ $vdata_id, $n_records, $interlace, $fields, $vdata_size, $vdata_name );
+ die "PDL::IO::HDF::VS::_VSinquire (vdata_id=$vdata_id)"
+ unless $status;
+ $vdata->{$vdata_name}->{REF} = $vdata_ref;
+ $vdata->{$vdata_name}->{NREC} = $n_records;
+ $vdata->{$vdata_name}->{INTERLACE} = $interlace;
+
+ $vdata->{$vdata_name}->{ISATTR} = PDL::IO::HDF::VS::_VSisattr( $vdata_id );
+
+ my $field_index = 0;
+ foreach my $onefield ( split( ",", $fields ) )
+ {
+ $vdata->{$vdata_name}->{FIELDS}->{$onefield}->{TYPE} =
+ PDL::IO::HDF::VS::_VFfieldtype( $vdata_id, $field_index );
+ $vdata->{$vdata_name}->{FIELDS}->{$onefield}->{INDEX} = $field_index;
+ $field_index++;
+ }
+
+ PDL::IO::HDF::VS::_VSdetach( $vdata_id );
+ } # while vdata_ref...
+
+ $self->{VDATA} = $vdata;
+ } # if $self->{HDID}...
+
+ bless($self, $type);
+} # End of new()...
+
+sub Vgetchildren
+{
+ my ($self, $name) = @_;
+ return( undef )
+ unless defined( $self->{VGROUP}->{$name}->{children} );
+
+ return keys %{$self->{VGROUP}->{$name}->{children}};
+} # End of Vgetchildren()...
+# Now defunct:
+sub Vgetchilds
+{
+ my $self = shift;
+ return $self->Vgetchildren( @_ );
+} # End of Vgetchilds()...
+
+sub Vgetattach
+{
+ my ($self, $name) = @_;
+ return( undef )
+ unless defined( $self->{VGROUP}->{$name}->{attach} );
+
+ return keys %{$self->{VGROUP}->{$name}->{children}};
+} # End of Vgetattach()...
+
+sub Vgetparents
+{
+ my ($self, $name) = @_;
+ return( undef )
+ unless defined( $self->{VGROUP}->{$name}->{parents} );
+
+ return keys %{$self->{VGROUP}->{$name}->{parents}};
+} # End of Vgetparents()...
+
+sub Vgetmains
+{
+ my ($self) = @_;
+ my @rlist;
+ foreach( keys %{$self->{VGROUP}} )
+ {
+ push(@rlist, $_)
+ unless defined( $self->{VGROUP}->{$_}->{parents} );
+ }
+ return @rlist;
+} # End of Vgetmains()...
+
+sub Vcreate
+{
+ my($self, $name, $class, $where) = @_;
+
+ my $id = PDL::IO::HDF::VS::_Vattach( $self->{HID}, -1, 'w' );
+ return( undef )
+ if( $id == PDL::IO::HDF->FAIL );
+
+ my $res = _Vsetname($id, $name);
+ $res = _Vsetclass($id, $class)
+ if defined( $class );
+
+ $self->{VGROUP}->{$name}->{ref} = '???';
+ $self->{VGROUP}->{$name}->{class} = $class
+ if defined( $class );
+
+ if( defined( $where ) )
+ {
+ return( undef )
+ unless defined( $self->{VGROUP}->{$where} );
+
+ my $ref = $self->{VGROUP}->{$where}->{ref};
+
+ my $Pid = PDL::IO::HDF::VS::_Vattach( $self->{HID}, $ref, 'w' );
+ my $index = PDL::IO::HDF::VS::_Vinsert( $Pid, $id );
+ my ($t, $r) = (0, 0);
+ $res = PDL::IO::HDF::VS::_Vgettagref( $Pid, $index, $t, $r );
+ PDL::IO::HDF::VS::_Vdetach( $Pid );
+
+ $self->{VGROUP}->{$name}->{parents}->{$where} = $ref;
+ $self->{VGROUP}->{$where}->{children}->{$name} = $r;
+ $self->{VGROUP}->{$name}->{ref} = $r;
+ }
+ return( _Vdetach( $id ) + 1 );
+} # End of Vcreate()...
+
+=head2 close
+
+=for ref
+
+ Close the VS interface.
+
+=for usage
+
+ no arguments
+
+=for example
+
+ my $result = $hdf->close();
+
+=cut
+
+sub close
+{
+ my $self = shift;
+ _Vend( $self->{HID} );
+ my $Hid = $self->{HID};
+ $self = undef;
+ return( _Hclose($Hid) + 1 );
+} # End of close()...
+
+sub VSisattr
+{
+ my($self, $name) = @_;
+
+ return undef
+ unless defined( $self->{VDATA}->{$name} );
+
+ return $self->{VDATA}->{$name}->{ISATTR};
+} # End of VSisattr()...
+
+sub VSgetnames
+{
+ my $self = shift;
+ return keys %{$self->{VDATA}};
+} # End of VSgetnames()...
+
+sub VSgetfieldnames
+{
+ my ( $self, $name ) = @_;
+
+ my $sub = _pkg_name( 'VSgetfieldnames' );
+
+ die "$sub: vdata name $name doesn't exist!\n"
+ unless defined( $self->{VDATA}->{$name} );
+
+ return keys %{$self->{VDATA}->{$name}->{FIELDS}};
+} # End of VSgetfieldnames()...
+# Now defunct:
+sub VSgetfieldsnames
+{
+ my $self = shift;
+ return $self->VSgetfieldnames( @_ );
+} # End of VSgetfieldsnames()...
+
+
+sub VSread
+{
+ my ( $self, $name, $field ) = @_;
+ my $sub = _pkg_name( 'VSread' );
+
+ my $data = null;
+ my $vdata_ref = PDL::IO::HDF::VS::_VSfind( $self->{HID}, $name );
+
+ die "$sub: vdata name $name doesn't exist!\n"
+ unless $vdata_ref;
+
+ my $vdata_id = PDL::IO::HDF::VS::_VSattach( $self->{HID}, $vdata_ref, 'r' );
+ my $vdata_size = 0;
+ my $n_records = 0;
+ my $interlace = 0;
+ my $fields = "";
+ my $vdata_name = "";
+ my $status = PDL::IO::HDF::VS::_VSinquire(
+ $vdata_id, $n_records, $interlace, $fields, $vdata_size, $vdata_name );
+ my $data_type = PDL::IO::HDF::VS::_VFfieldtype(
+ $vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{INDEX} );
+
+ die "$sub: data_type $data_type not implemented!\n"
+ unless defined( $PDL::IO::HDF::SDinvtypeTMAP->{$data_type} );
+
+ my $order = PDL::IO::HDF::VS::_VFfieldorder(
+ $vdata_id, $self->{VDATA}->{$name}->{FIELDS}->{$field}->{INDEX} );
+
+ if($order == 1)
+ {
+ $data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records );
+ }
+ else
+ {
+ $data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, $n_records, $order );
+ }
+ $status = PDL::IO::HDF::VS::_VSsetfields( $vdata_id, $field );
+
+ die "$sub: _VSsetfields\n"
+ unless $status;
+
+ $status = PDL::IO::HDF::VS::_VSread( $vdata_id, $data, $n_records, $interlace);
+
+ PDL::IO::HDF::VS::_VSdetach( $vdata_id );
+ return $data;
+} # End of VSread()...
+
+sub VSwrite
+{
+ my($self, $name, $mode, $field, $value) = @_;
+
+ return( undef )
+ if( $$value[0]->getndims > 2); #too many dims
+
+ my $VD_id;
+ my $res;
+ my @foo = split( /:/, $name );
+
+ return( undef )
+ if defined( $self->{VDATA}->{$foo[0]} );
+
+ $VD_id = _VSattach( $self->{HID}, -1, 'w' );
+
+ return( undef )
+ if( $VD_id == PDL::IO::HDF->FAIL );
+
+ $res = _VSsetname( $VD_id, $foo[0] );
+ return( undef )
+ if( $res == PDL::IO::HDF->FAIL );
+
+ $res = _VSsetclass( $VD_id, $foo[1] )
+ if defined( $foo[1] );
+ return( undef )
+ if( $res == PDL::IO::HDF->FAIL );
+
+ my @listfield = split( /,/, $field );
+ for( my $i = 0; $i <= $#$value; $i++ )
+ {
+ my $HDFtype = $PDL::IO::HDF::SDtypeTMAP->{$$value[$i]->get_datatype()};
+ $res = _VSfdefine( $VD_id, $listfield[$i], $HDFtype, $$value[$i]->getdim(1) );
+ return( undef )
+ unless $res;
+ }
+
+ $res = _VSsetfields( $VD_id, $field );
+ return( undef )
+ unless $res;
+
+ my @sizeofPDL;
+ my @sdimofPDL;
+ foreach ( @$value )
+ {
+ push(@sdimofPDL, $_->getdim(1));
+ push(@sizeofPDL, $TMAP->{$_->get_datatype()});
+ }
+ $res = _WriteMultPDL( $VD_id, $$value[0]->getdim(0), $#$value+1, $mode, \@sizeofPDL, \@sdimofPDL, $value);
+
+ return( undef )
+ if( _VSdetach($VD_id) == PDL::IO::HDF->FAIL );
+ return $res;
+} # End of VSwrite()...
+
+
+sub DESTROY
+{
+ my $self = shift;
+ $self->close;
+} # End of DESTROY()...
+
+EOPM
+
+#
+# Add the tail of the docs:
+#
+pp_addpm(<<'EOD');
+
+=head1 CURRENT AUTHOR & MAINTAINER
+
+Judd Taylor, Orbital Systems, Ltd.
+judd dot t at orbitalsystems dot com
+
+=head1 PREVIOUS AUTHORS
+
+Olivier Archer olivier.archer at ifremer.fr
+contribs of Patrick Leilde patrick.leilde at ifremer.fr
+
+=head1 SEE ALSO
+
+perl(1), PDL(1), PDL::IO::HDF(1).
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/IO/HDF/buildfunc.pm b/IO/HDF/buildfunc.pm
new file mode 100644
index 0000000..cbc97f4
--- /dev/null
+++ b/IO/HDF/buildfunc.pm
@@ -0,0 +1,114 @@
+#package;
+
+use strict;
+
+# This file contains functions to build .pd from the HDF prototypes
+
+# Define a low-level perl interface to HDF from these definitions.
+sub create_low_level
+{
+ # This file must be modified to only include
+ # netCDF 3 function definitions.
+ # Also, all C function declarations must be on one line.
+ my $defn = shift;
+ my $sub = "create_low_level()";
+
+ my @lines = split (/\n/, $defn);
+
+ foreach my $line (@lines)
+ {
+
+ next if ( $line =~ /^\#/ ); # Skip commented out lines
+ next if ( $line =~ /^\s*$/ ); # Skip blank lines
+
+ unless ($line =~ /^(\w+\**)\s+(\w+)\((.+)\)(\+*\d*)\;/)
+ {
+ die "$sub: Can't parse this line!\n";
+ }
+ my ($return_type, $func_name, $params, $add) = ($1, $2, $3, $4);
+
+ my @vars;
+ my @types;
+ my $output = {};
+ foreach my $param ( split (/,/, $params) )
+ {
+ my ($varname) = ($param =~ /(\w+)$/);
+ $param =~ s/$varname//; # parm now contains the full C type
+ $output->{$varname} = 1
+ if (($param =~ /\*/) && ($param !~ /const/));
+ $param =~ s/const //; # get rid of 'const' in C type
+ $param =~ s/^\s+//;
+ $param =~ s/\s+$//; # pare off the variable type from 'parm'
+
+ push (@vars, $varname);
+ push (@types, $param);
+ }
+
+ # Create the XS header:
+ my $xsout = '';
+ $xsout .= "$return_type\n";
+ $xsout .= "_$func_name (" . join (", ", @vars) . ")\n";
+
+ # Add in the variable declarations:
+ foreach my $i ( 0 .. $#vars )
+ {
+ $xsout .= "\t$types[$i]\t$vars[$i]\n";
+ }
+
+ # Add the CODE section:
+ $xsout .= "CODE:\n";
+ $xsout .= "\tRETVAL = ";
+ $xsout .= "$add + "
+ if defined($add);
+ $xsout .= "$func_name (";
+
+ # Add more variable stuff:
+ foreach my $i ( 0 .. $#vars )
+ {
+ my $type = $types[$i];
+ if ($type =~ /PDL/)
+ {
+ $type =~ s/PDL//; # Get rid of PDL type when writing xs CODE section
+ $xsout .= "($type)$vars[$i]"."->data,";
+ }
+ else
+ {
+ $xsout .= "$vars[$i],";
+ }
+ }
+ chop ($xsout); # remove last comma
+ $xsout .= ");\n";
+
+ # Add the OUTPUT section:
+ $xsout .= "OUTPUT:\n";
+ $xsout .= "\tRETVAL\n";
+ foreach my $var ( keys %$output )
+ {
+ $xsout .= "\t$var\n";
+ }
+ $xsout .= "\n\n";
+
+ # Add it to the PDL::PP file:
+ pp_addxs ('', $xsout);
+ }
+} # End of create_low_level()...
+
+sub create_generic
+{
+ my $defn = shift;
+ my @alltype = ('char', 'unsigned char', 'short int', 'unsigned short int',
+ 'long int', 'unsigned long int', 'float', 'double');
+ my @nametype = ('char', 'uchar', 'short', 'ushort',
+ 'long', 'ulong', 'float', 'double');
+
+ foreach my $i ( 0 .. $#alltype )
+ {
+ my $xsout = $defn;
+ $xsout =~ s/GENERIC/$alltype[$i]/eg;
+ $xsout =~ s/NAME/$nametype[$i]/eg;
+ pp_addxs ('', $xsout);
+ }
+} # End of create_generic()...
+
+
+1;
diff --git a/IO/HDF/typemap b/IO/HDF/typemap
new file mode 100644
index 0000000..1f85db0
--- /dev/null
+++ b/IO/HDF/typemap
@@ -0,0 +1,55 @@
+# Extra type mappings for PDL::IO::HDF
+# basic C types
+int * T_PVI
+long int * T_PVI
+size_t * T_PVI
+nc_type * T_PVI
+nc_type T_IV
+PDLchar * T_PDL
+PDLuchar * T_PDL
+PDLshort * T_PDL
+PDLint * T_PDL
+PDLlong * T_PDL
+PDLfloat * T_PDL
+PDLdouble * T_PDL
+PDLvoid * T_PDL
+
+PDLlist * T_PVI
+
+#############################################################################
+INPUT
+
+T_PVI
+ $var = ($type)SvPV($arg,PL_na)
+T_PDLB
+ $var = (unsigned char *)(PDL->SvPDLV($arg)->data)
+T_PDLS
+ $var = (short *)(PDL->SvPDLV($arg)->data)
+T_PDLUS
+ $var = (unsigned short *)(PDL->SvPDLV($arg)->data)
+T_PDLL
+ $var = (long *)(PDL->SvPDLV($arg)->data)
+T_PDLF
+ $var = (float *)(PDL->SvPDLV($arg)->data)
+T_PDLD
+ $var = (double *)(PDL->SvPDLV($arg)->data)
+
+#############################################################################
+OUTPUT
+
+T_PVI
+ sv_setiv((SV*)$arg, (IV)*$var);
+T_PDLB
+ PDL->SetSV_PDL($arg,$var);
+T_PDLS
+ PDL->SetSV_PDL($arg,$var);
+T_PDLUS
+ PDL->SetSV_PDL($arg,$var);
+T_PDLL
+ PDL->SetSV_PDL($arg,$var);
+T_PDLF
+ PDL->SetSV_PDL($arg,$var);
+T_PDLD
+ PDL->SetSV_PDL($arg,$var);
+
+
diff --git a/IO/IDL/IDL.pm b/IO/IDL/IDL.pm
new file mode 100644
index 0000000..3b9f3f2
--- /dev/null
+++ b/IO/IDL/IDL.pm
@@ -0,0 +1,870 @@
+=head1 NAME
+
+PDL::IO::IDL -- I/O of IDL Save Files
+
+=head1 DESCRIPTION
+
+PDL::IO::IDL allows you to read and write IDL(tm) data files.
+
+Currently, only reading is implemented. Scalars, arrays,
+and structures are all supported. Heap pointers, compiled code, and
+objects are not supported. Of those three, only heap pointers are
+likely to be supported in the future.
+
+This code was not developed by RSI, makers of IDL.
+
+=head1 NOTES
+
+These things seem to work:
+
+=over 3
+
+=item BYTE, SHORT, LONG, FLOAT, and DOUBLE numeric types and arrays
+
+All of these types seem to work fine. The corresponding variable is
+stored as a PDL in the hash element with the same name as the original
+variable in the file. Arrays are byteswapped as needed and are read in so
+that the dim list has the same indexing order within PDL as it did within IDL.
+
+=item STRINGs and arrays of STRINGs
+
+String types are stored as Perl list refs, in the hash element with
+the same name as the original variable in the file.
+
+=item Structures
+
+Structures are stored as hash refs. The elements of the hash may be
+accessed as values within the hash.
+
+=item Common blocks
+
+Variables that are notated as being in a common block are read as
+normal. Common-block names are collected in the special hash value
+'+common', which contains a hash each keyword of which is the name of
+a common block and each value of which is an array of variable names.
+
+=back
+
+These things are known to be not working and may one day be fixed:
+
+=over 3
+
+=item COMPLEX numbers
+
+These could be implemented as 2-arrays or as PDL::Complex values, but aren't yet.
+
+=item PTR types
+
+These could be implemented as perl refs but currently aren't.
+
+=item writing
+
+Maybe one day -- but why bother writing a broken file format? NetCDF is better.
+
+=back
+
+These things are known to be not working and will probably never be fixed
+
+=over 3
+
+=item Compiled code
+
+Decompiling IDL code is a violation of the IDL end-user license. To
+implement this, someone who does not hold an IDL license would have to
+reverse-engineer a set of .SAV files sent to that person by someone
+else with an IDL license.
+
+=item Objects
+
+IDL objects contain compiled code.
+
+=back
+
+=head1 FUNCTIONS
+
+=cut
+
+ package PDL::IO::IDL;
+
+ BEGIN {
+
+ use Exporter ();
+ package PDL::IO::IDL;
+ @ISA = ( Exporter );
+ @EXPORT_OK = qw( ridl );
+ @EXPORT = @EXPORT_OK;
+ @EXPORT_TAGS = ( Func=>[@EXPORT_OK] );
+
+ our $VERSION = "0.5";
+ $VERSION = eval $VERSION;
+
+ use PDL;
+ use PDL::Exporter;
+ use Carp;
+
+ }
+use strict;
+
+=head2 ridl
+
+=for usage
+
+$a = ridl("foo.sav");
+
+=for ref
+
+Read an IDL save file from a file.
+
+Upon successful completion, $a is a hash ref containing all of the
+variables that are present in the save file, indexed by original
+variable name.
+
+IDL identifiers are case insensitive; they're all converted to
+upper-case in the hash that gets returned. This may be adjustable at
+a future date. Furthermore, because IDL identifiers can't contain
+special characters, some fields that start with '+' are used to store
+metadata about the file itself.
+
+Numeric arrays are stored as PDLs, structures are stored as hashes,
+and string and structure arrays are stored as perl lists. Named
+structure types don't exist in perl in the same way that they do in
+IDL, so named structures are described in the 'structs' field of the
+global metadata. Anonymous structures are treated as simple hashes.
+Named structures are also simple hashes, but they also contain a field
+'+name' that refers to the name of the structure type.
+
+=cut
+
+
+sub ridl {
+ my( $name ) = shift;
+
+ STDERR->autoflush(1);
+
+ open(IDLSAV,"<$name") || barf("ridl: Can't open `$name' for reading\n");
+
+ my $hash = read_preamble();
+
+ read_records($hash);
+
+ my @snames = sort keys %{$PDL::IO::IDL::struct_table};
+ @snames = grep(!m/^\+/, at snames);
+ if(@snames) {
+ $hash->{'+structs'}={};
+ local $_;
+ for(@snames) {
+ $hash->{'+structs'}->{$_} =
+ $PDL::IO::IDL::struct_table->{$_}->{'names'};
+ }
+ }
+
+ return $hash;
+}
+
+
+############################################################
+##
+## Data structure definitions...
+##
+## This is a list, each element of which contains a description and
+## subroutine to read that particular record type.
+##
+
+our $types = [ ['START_MARKER',undef] # 0 (start of SAVE file)
+ ,['COMMON_BLOCK',\&r_com] # 1 (COMMON block definition)
+ ,['VARIABLE',\&r_var] # 2 (Variable data)
+ ,['SYSTEM_VARIABLE',undef] # 3 (System variable data)
+ ,undef # 4 (??)
+ ,undef # 5 (??)
+ ,['END_MARKER',\&r_end] # 6 (End of SAVE file)
+ ,undef # 7 (??)
+ ,undef # 8 (??)
+ ,undef # 9 (??)
+ ,['TIMESTAMP',\&r_ts] # 10 (Timestamp of the save file)
+ ,undef # 11 (??)
+ ,['COMPILED',undef] # 12 (Compiled procedure or func)
+ ,['IDENTIFICATION',undef] # 13 (Author identification)
+ ,['VERSION',\&r_v] # 14 (IDL Version information)
+ ,['HEAP_HEADER',undef] # 15 (Heap index information)
+ ,['HEAP_DATA',undef] # 16 (Heap data)
+ ,['PROMOTE64',\&r_p64] # 17 (Starts 64-bit file offsets)
+ ];
+
+
+############################################################
+##
+## Vtypes -- Representations of IDL scalar variable types.
+## The first element is the name, the second element is either a
+## perl string (that should be fed to unpack) or a code ref to a
+## sub that decodes the type.
+##
+
+our $vtypes = [
+ undef # 0
+ ,["Byte", \&r_byte_pdl, [] ] # 1
+ ,["Short", \&r_n_cast, [long,short] ] # 2
+ ,["Long", \&r_n_pdl, [long] ] # 3
+ ,["Float", \&r_n_pdl, [float] ] # 4
+ ,["Double", \&r_n_pdl, [double] ] # 5
+ ,["Complex", undef ] # 6
+ ,["String", \&r_strvar, [] ] # 7
+ ,["Structure", sub {}, [] ] # 8
+ ,["ComplexDbl",undef ] # 9
+ ,["HeapPtr", undef ] # 10
+ ,["Object", undef ] # 11
+ ,["UShort", \&r_n_cast, [long,ushort] ] # 12
+ ,["ULong", \&r_n_pdl, [long] ] # 13
+ ,["LongLong", undef ] # 14
+ ,["ULongLong", undef ] # 15
+];
+
+
+###
+# Cheesy way to check if 64-bit is OK
+our $quad_ok = eval { my @a = unpack "q","00000001"; $a[0]; };
+
+### Initialized in read_preamble.
+our $little_endian;
+our $swab;
+our $p64;
+
+
+##############################
+#
+# read_preamble
+#
+# Reads the preamble of a file and returns the preamble as a hash
+# ref. In case of failure, it barfs. Also initializes the structure table.
+#
+
+sub read_preamble {
+ my $buf;
+ my $out;
+
+ sysread(IDLSAV,$buf,4) || barf ("PDL::IO::IDL: Couldn't read preamble\n");
+ my @sig = unpack("a2S",$buf);
+
+ barf("PDL::IO::IDL: This isn't an IDL save file (wrong magic)\n")
+ if($sig[0] ne 'SR');
+
+ if($sig[1] == 1024 || $sig[1] == 4) {
+ $little_endian = ($sig[1] == 1024);
+ } else {
+ barf "Unrecognized IDL save file type\n";
+ }
+
+ $swab = $little_endian;
+
+ $p64 = 0;
+
+ $PDL::IO::IDL::struct_table = {};
+
+ return {"+meta"=>{}};
+}
+
+##############################
+#
+# read_records
+#
+# Reads all the records of the file. Splits out into several other
+# types of record reader...
+#
+#
+
+sub read_records {
+ my $hash = shift;
+ my ($buf, $tbuf);
+
+ my $retval;
+
+ my %nexts;
+ my $tag_count = 0;
+ do {
+
+ ### Read header of the record
+
+ sysread(IDLSAV, $tbuf, 4) || barf("PDL::IO::IDL: unexpected EOF\n");
+ my $type = unpack "N",$tbuf;
+
+ ### Record the next seek location
+ ### (and discard 8 more bytes)
+
+ my $next;
+ if($p64) {
+ print "Reading 64-bit location..." if($PDL::debug);
+ sysread(IDLSAV,$buf,8 + 8);
+ my @next = unpack "NN",$buf;
+ $next = $next[1] + 2**32 * $next[0];
+ } else {
+ print "Reading 32-bit location..." if($PDL::debug);
+ sysread(IDLSAV,$buf,4 + 8);
+ $next = unpack "N",$buf;
+ }
+ print "$next\n" if($PDL::debug);
+
+ ###
+ ### Infinite-loop detector
+ ###
+
+ barf("Repeat index finder was activated! This is a bug or a problem with your file.\n")
+ if($nexts{$next}) ;
+ $nexts{$next} = 1;
+
+ ###
+ ### Call the appropriate handling routine
+ ###
+
+ $retval = 1;
+
+ if(defined $types->[$type]) {
+ if(defined ($types->[$type]->[1])) {
+ print "Found record of type $types->[$type]->[0]...\n" if($PDL::debug || $PDL::IO::IDL::test);
+ $retval = &{$types->[$type]->[1]}($hash);
+ print "OK.\n" if($PDL::debug);
+ } else {
+ print STDERR "Ignoring record of type ".$types->[$type]->[0]." - not implemented.\n";
+ }
+ } else {
+ print STDERR "\nIgnoring record of unknown type $type - not implemented.\n";
+ }
+ print "Seeking $next ($tag_count tags read so far...)\n" if($PDL::debug || $PDL::IO::IDL::test);
+ $tag_count++;
+ sysseek(IDLSAV, $next, 0);
+ $FOO::hash = $hash;
+ } while($retval);
+
+}
+
+
+
+
+##############################
+# r_com
+#
+# Jumptable entry for the COMMONBLOCK keyword -- this loads
+# the variable names that belong in the COMMON block into a
+# metavariable.
+
+sub r_com {
+ my $hash = shift;
+ my $buf;
+
+ sysread(IDLSAV,$buf,4);
+ my $nvars = unpack "N",$buf;
+
+ my $name = r_string();
+ $hash->{"+common"}->{$name} = [];
+
+ for my $i(1..$nvars) {
+ push(@{$hash->{"+common"}->{$name}},r_string());
+ }
+
+ return 1;
+}
+
+
+
+
+##############################
+# r_end
+#
+# Jumptable entry for the END TABLE keyword -- just return 0.
+
+sub r_end { 0; }
+
+
+##############################
+# r_ts
+#
+# TIMESTAMP record handler
+#
+sub r_ts {
+ my $hash = shift;
+ my $buf;
+
+ ### Read and discard a LONARR(258) -- why? I don't know.
+ sysread(IDLSAV,$buf,1024);
+ $hash->{"+meta"}->{t_date} = r_string();
+ $hash->{"+meta"}->{t_user} = r_string();
+ $hash->{"+meta"}->{t_host} = r_string();
+
+ return 1;
+}
+
+
+
+##############################
+# r_version
+#
+# VERSION record handler
+#
+sub r_v {
+ my $hash = shift;
+ my $buf;
+ my $version;
+
+ sysread(IDLSAV,$buf,4);
+ $version = $hash->{"+meta"}->{v_fmt} = unpack "N",$buf;
+
+# barf("Unknown IDL save file version ".$version)
+ print STDERR "Warning: IDL file is v$version (neither 5 nor 6); winging it. Check results!\n"
+ if($version != 5 && $version != 6);
+
+ $hash->{"+meta"}->{v_arch} = r_string();
+ $hash->{"+meta"}->{v_os} = r_string();
+ $hash->{"+meta"}->{v_release} = r_string();
+ return 1;
+}
+
+##############################
+# r_p64
+sub r_p64 {
+ my $hash = shift;
+ $p64 = 1;
+}
+
+##############################
+# r_var
+#
+# VARIABLE reader - parse a single variable out of a VARIABLE record.
+#
+
+sub r_var {
+ my $hash = shift;
+
+ ### Read in the variable name
+ my $name = r_string();
+
+
+ ### Read in and parse the type
+
+ my $buf;
+ sysread(IDLSAV,$buf,8);
+ my ($type,$flags) = unpack "NN",$buf;
+
+ unless(defined $vtypes->[$type]) {
+ barf("PDL::IO::IDL: Unknown variable type $type");
+ }
+
+ unless(defined $vtypes->[$type]->[1]) {
+ print STDERR "Ignoring variable $name: unsupported type ".$vtypes->[$type]->[0]."\n";
+ return 1;
+ }
+
+ print "Variable $name found (flags is $flags)...\n" if($PDL::debug);
+
+ if((($flags & 4) == 0) and (($flags & 32) == 0)) {
+ print "it's a scalar\n" if($PDL::debug);
+
+
+ sysread(IDLSAV,$buf,4);
+ my($seven) = unpack "N",$buf;
+ if($seven != 7) {
+ print STDERR "Warning: expected data-start key (7) but got $seven, for variable $name\n";
+ }
+
+ ## Scalar case
+ $hash->{$name} =
+ &{$vtypes->[$type]->[1]}
+ ($flags, [], @{$vtypes->[$type]->[2]})
+ } else {
+ ## Array case
+
+ my($arrdesc) = r_arraydesc();
+
+ if(($flags & 32) == 0) {
+
+ ## Simple array case
+ sysread(IDLSAV,$buf,4);
+ my($indicator) = unpack "N",$buf;
+
+ print STDERR "Warning: Reading data from an array but got code $indicator (expected 7)\n"
+ if($indicator != 7);
+
+ print "simple array...type=$type\n" if($PDL::debug);
+
+ my @args= ($flags,[ @{$arrdesc->{dims}}[0..$arrdesc->{ndims}-1]],
+ @{$vtypes->[$type]->[2]});
+ my $pdl = &{$vtypes->[$type]->[1]}(@args);
+ $hash->{$name} = $pdl;
+
+ } else {
+
+ ## Structure case
+ print "structure...\n" if($PDL::debug);
+ my($sname) = r_structdesc();
+
+ my @structs;
+ print "Reading $arrdesc->{nelem} structures....\n" if($PDL::debug || $PDL::IO::IDL::test);
+ my $i;
+
+ {my $buf; sysread(IDLSAV,$buf,4);}
+
+ for ($i=0;$i<$arrdesc->{nelem};$i++) {
+ if($PDL::IO::IDL::test && !($i%100)){
+ print "$i of $arrdesc->{nelem}...\n";
+ }
+
+ push(@structs,r_struct($sname));
+ }
+
+ # Make a multi-dimensional list that contains the structs
+ $hash->{$name} = multi_dimify($arrdesc,\@structs);
+
+ }
+ }
+
+
+ return 1;
+}
+
+
+##############################
+# multi_dimify
+#
+# Take a linear list of items and an array descriptor, and
+# hand back a multi-dimensional perl list with the correct dimension
+# according to the descriptor. (This isn't necessary for PDL types,
+# only for structures and strings).
+#
+
+sub multi_dimify {
+
+ my($arrdesc,$structs,$n) = @_;
+
+ return shift @{$structs}
+ if($arrdesc->{ndims} <= $n or
+ $arrdesc->{ndims} == 0 or
+ $arrdesc->{ndims}-$n == 1 && $arrdesc->{dims}->[$n]==1);
+
+
+ if($arrdesc->{ndims} - $n == 1){
+ my @ret = splice @{$structs},0,$arrdesc->{dims}->[$n];
+ return \@ret;
+ }
+
+
+ my $out = [];
+ my $i;
+ for ($i=0;$i<$arrdesc->{dims}->[$n];$i++) {
+ push(@{$out},multi_dimify($arrdesc,$structs,$n+1));
+ }
+
+ return $out;
+}
+
+
+
+######################################################################
+######################################################################
+
+
+#
+# r_arraydesc - read an array descriptor from the file
+#
+
+our $r_arraydesc_table = ['a','b','nbytes','nelem','ndims','c','d','nmax'];
+
+sub r_arraydesc {
+ my $out = {};
+ my $buf;
+
+ sysread(IDLSAV,$buf,4*8);
+
+ my(@vals) = unpack("N"x8,$buf);
+ print STDERR "r_arraydesc_table: vals[0]=".$vals[0]." (should be 8)\n"
+ if($vals[0] != 8);
+ for my $i(0..7) {
+ $out->{$r_arraydesc_table->[$i]} = $vals[$i];
+ }
+ my $nmax = $vals[7];
+ my $nelem = $vals[3];
+
+ sysread(IDLSAV,$buf,$nmax*4);
+ $out->{dims} = [unpack("N"x$nmax,$buf)];
+ my $dims = pdl(@{$out->{dims}});
+
+ $out->{pdldims} = $dims;
+
+ print STDERR "PDL::IO::IDL: Inconsistent array dimensions in variable (nelem=$nelem, dims=".join("x",@{$out->{dims}}).")"
+ if($nelem != $dims->prod);
+
+ $out;
+}
+
+
+##############################
+#
+# r_structdesc reads a structure description and stores it in the struct_table.
+# You get back the name of the structure.
+#
+
+sub r_structdesc {
+ my $buf;
+
+ print "Reading a structure description...\n" if($PDL::IO::IDL::test);
+
+ sysread(IDLSAV,$buf,4); # Discard initial long (value=9) from descriptor
+ my($name) = r_string(); # Have to store structures in the structure table.
+ $name =~ s/\s//g;
+
+ $name = "+anon".scalar(keys %{$PDL::IO::IDL::struct_table})
+ if($name eq '');
+
+ sysread(IDLSAV,$buf,4*3);
+ my($predef,$ntags,$nbytes) = unpack("N"x3,$buf);
+ print "predef=$predef,ntags=$ntags,nbytes=$nbytes\n" if($PDL::debug);
+ if(!($predef & 1)) {
+ my $i;
+ print "not predefined. ntags=$ntags..\n" if($PDL::debug || $PDL::IO::IDL::test);
+
+ my $st = $PDL::IO::IDL::struct_table->{$name} = {
+ "ntags" => $ntags
+ ,"nbytes"=> $nbytes
+ ,"names" => []
+ ,"arrays" => []
+ ,"structs" => []
+ };
+
+ ### Read tag descriptors.
+ sysread(IDLSAV,$buf,3*4*$ntags);
+ $st->{descrip} = [(unpack "N"x(3*$ntags), $buf)];
+
+
+ print "ntags is $ntags\n" if($PDL::debug || $PDL::IO::IDL::test);
+ ### Read tag names.
+ for $i(0..$ntags-1) {
+ push(@{$st->{names}},r_string());
+ }
+
+ ### Search for nested arrays & structures
+ my ($nstructs,$narrays);
+
+ for $i(0..$ntags-1) {
+ my $a = $st->{descrip}->[$i*3+2];
+
+ $nstructs++ if($a & 32);
+ $narrays++ if($a & 38);
+ }
+
+ print "narrays=$narrays\n" if($PDL::debug || $PDL::IO::IDL::test);
+ for $i(0..($narrays-1)) {
+ push( @{$st->{arrays}}, r_arraydesc() );
+ }
+
+ print "nstructs=$nstructs\n" if($PDL::debug || $PDL::IO::IDL::test);
+ for $i(0..($nstructs-1)) {
+ push( @{$st->{structs}}, r_structdesc() );
+ }
+
+ }
+ print "finished with structure desc...\n" if($PDL::IO::IDL::test);
+ return $name;
+}
+
+##############################
+#
+# r_struct
+#
+# Given the name of a structure type, read in exactly one of them.
+# If I were smarter, this would be the same code as the variable
+# reader, but I'm not so it's only similar.
+#
+our $r_struct_recursion = 0;
+
+sub r_struct {
+ my($sname) = shift;
+
+
+ print ("_ "x$r_struct_recursion) . "Reading a structure...\n" if($PDL::IO::IDL::test);
+ my $zz=$r_struct_recursion;
+ local($r_struct_recursion) = $zz++;
+
+ # Get the structure descriptor from the table.
+ my($sd) = $PDL::IO::IDL::struct_table->{$sname};
+ barf "Unknown structure type $sname" unless defined($sd);
+
+ # Initialize the structure itself and the array and structure indices.
+ my($struct) = {};
+ $struct->{'+name'} = $sname unless($sname =~ m/^\+/);
+
+ my($array_no, $struct_no);
+
+ # Loop over tags and snarf each one
+ my($i);
+ for($i=0;$i<$sd->{ntags};$i++) {
+ my($name) = $sd->{names}->[$i];
+
+ my($type) = $sd->{descrip}->[$i*3+1];
+ my($flags) = $sd->{descrip}->[$i*3+2];
+
+ print "reading tag #$i ($sd->{names}->[$i])\n" if($PDL::debug);
+
+ barf("PDL::IO::IDL: Unknown variable type $type in structure")
+ unless defined($vtypes->[$type]);
+
+ unless(defined($vtypes->[$type]->[1])) {
+ print "Skipping tag $name in structure - unsupported type ".$vtypes->[$type]->[0]."\n";
+ $array_no++ if($flags & 38);
+ $struct_no++ if($flags & 32);
+
+ } else {
+
+ if( (($flags & 4)==0) and (($flags & 32)==0) ) {
+ ## Scalar tag case
+ $struct->{$name} = &{$vtypes->[$type]->[1]}
+ ($flags, [], @{$vtypes->[$type]->[2]});
+ } else {
+
+ ### Array and/or structure case ###
+
+ my($arrdesc) = $sd->{arrays}->[$array_no++];
+# sysread(IDLSAV,my $buf,4); # skip indicator
+
+ if(($flags & 32) == 0) {
+
+ ### Tag is a simple array ###
+
+ my @args = ($flags,[ @{$arrdesc->{dims}}[0..$arrdesc->{ndims}-1]],
+ @{$vtypes->[$type]->[2]});
+ my $pdl = &{$vtypes->[$type]->[1]}(@args);
+ print " pdl is $pdl\n" if($PDL::debug);
+ $struct->{$name} = $pdl;
+
+ } else {
+
+ ### Tag is a structure ###
+
+ my $tsname = $sd->{structs}->[$struct_no++];
+ my @structs = ();
+ for $i(1..$arrdesc->{nelem}) {
+ push(@structs,r_struct($tsname));
+ }
+
+ $struct->{$name} = multi_dimify($arrdesc,\@structs);
+
+ }
+ }
+ }
+ } # end of ntags loop
+
+ return $struct;
+}
+
+
+
+
+##############################
+#
+# r_string
+#
+# Reads a string value, leaving the file pointer correctly aligned
+# on a 32-bit boundary (if it started that way). Returns the string as
+# a perl scalar.
+#
+sub r_string{
+ my ($buf,$foo);
+ sysread(IDLSAV, $buf, 4); # Read the length...
+
+ my ($len) = unpack "N",$buf;
+ # Pad the length out to the next 32-bit boundary
+
+ my $plen = $len - ($len % -4) ;
+
+ sysread(IDLSAV,$buf,$plen);
+ return unpack "A$len",$buf;
+}
+
+
+##############################
+#
+# r_strvar
+#
+# Reads a string variable (different than r_string because
+# of the extra length duplication in the IDL file...)
+#
+sub r_strvar {
+ my $buf;
+ my $flags = shift;
+ sysread(IDLSAV,$buf,4);
+ return r_string();
+}
+
+##############################
+#
+# r_byte_pdl
+#
+# Reads a byte PDL (stored as a strvar)
+#
+sub r_byte_pdl {
+ my($flags,$dims) = @_;
+
+ sysread(IDLSAV,my $buf,4)
+ if($#$dims > 1);
+
+ $a = r_string();
+
+ my $pdl = new PDL;
+ $pdl->set_datatype(byte->enum);
+ $pdl->setdims($dims);
+ ${ $pdl->get_dataref() } = $a;
+ $pdl->upd_data;
+
+ $pdl;
+}
+
+##############################
+#
+# r_n_pdl
+#
+# Reads <n> normal integer-type numerical values as a pdl.
+# You feed in the dimlist and type, you get back the
+# final pdl. The read is padded to the nearest word boundary.
+#
+
+sub r_n_pdl {
+ my($flags,$dims,$type) = @_;
+
+ my $nelem = pdl($dims)->prod;
+ my $dsize = PDL::Core::howbig($type);
+ my $hunksize = $dsize * $nelem;
+
+ my $pdl = PDL->new_from_specification($type,@$dims);
+ my $dref = $pdl->get_dataref();
+
+ my $len = sysread(IDLSAV, $$dref, $hunksize - ($hunksize % -4) );
+ $pdl->upd_data;
+
+ print "bytes were ",join(",",unpack "C"x($hunksize-($hunksize%-4)),$$dref),"\n" if($PDL::debug);
+
+
+ if($swab) {
+ bswap2($pdl) if($dsize==2);
+ bswap4($pdl) if($dsize==4);
+ bswap8($pdl) if($dsize==8);
+ }
+
+ $pdl;
+}
+
+sub r_n_cast {
+ my($flags,$dims,$type1,$type2) = @_;
+
+ (r_n_pdl($flags,$dims,$type1))->convert($type2);
+}
+
+
+=head1 AUTHOR, LICENSE, NO WARRANTY
+
+THIS CODE IS PROVIDED WITH NO WARRANTY and may be distributed and/or
+modified under the same terms as PDL itself.
+
+This code is based on the analysis of the IDL save file format
+published by Craig Markwardt in 2002.
+
+IDL is a trademark of Research Systems Incorporated (RSI). The PDL
+development team, and authors of this code, are not affiliated with RSI.
+
+=cut
+
+1;
diff --git a/IO/IDL/Makefile.PL b/IO/IDL/Makefile.PL
new file mode 100644
index 0000000..34b6521
--- /dev/null
+++ b/IO/IDL/Makefile.PL
@@ -0,0 +1,14 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => "PDL::IO::IDL",
+ 'VERSION_FROM' => '../../Basic/Core/Version.pm',
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
+# With dmake a postamble is sometimes (incorrectly) written
+# in the Makefile. The following prevents that:
+
+sub MY::postamble {
+ return "";
+}
diff --git a/IO/IDL/README b/IO/IDL/README
new file mode 100755
index 0000000..6917736
--- /dev/null
+++ b/IO/IDL/README
@@ -0,0 +1,56 @@
+IDL has updated their status to allow reading of IDL SAV data
+files from other languages. This implementation is based on
+a 3rd party spec by Craig Markwardt based on the IDL 4.x and 5.x
+save files. It cannot read save files created by IDL 8.x.
+
++------------------------------------------------------------------+
+
+From Joe Hourcle, who worked to get permission to distribute
+this code:
+
+
+In January of 2011, our group had a meeting with our NASA account
+rep, Amanda O'Connor. I brought up that they had announced at
+the IDL User Meeting at either the 2009 or 2010 Fall AGU Meeting
+that there was now a python library to read IDL save files, and I
+asked what was the process to be allowed to read them from Perl.
+
+This was the response that I received. ...
+
+-Joe
+
+
+Begin forwarded message:
+
+> From: "Thomas Harris" <tharris at ittvis.com>
+> Date: February 3, 2011 12:29:18 PM EST
+> To: <oneiros at grace.nascom.nasa.gov>, ...
+> Cc: "Amanda O'Connor" <amandao at ittvis.com>
+> Subject: FW: ITT-VIS meeting Follow-up
+>
+> Hi all:
+> My name is Thomas Harris and I'm working with Amanda this year on NASA.
+> Amanda and I checked in to your questions regarding IDL SAV files with
+> our Product Management. Here is their response:
+>
+> "...We are perfectly fine with people wanting to read IDL save files
+> with Data in them, in whatever language they want - IDL, Matlab, Perl,
+> Python.
+>
+> Finally, we are going to remove the Copyright restriction from data Save
+> files (probably in IDL 8.1), but keep it in for code Save files. That
+> way there should be no confusion."
+>
+> Let me know if you have any additional questions.
+> Best regards,
+>
+> Thomas Harris
+> Technical Account Manager - Federal Sales
+> ITT Visual Information Solutions
+>
+> tharris at ittvis.com
+> direct: 303.402.4666
+> tel: 303.786.9900
+> mobile: 720.256.1098
+> fax: 303.786.9909
+> www.ittvis.com
diff --git a/IO/IO.pod b/IO/IO.pod
new file mode 100644
index 0000000..25d86d3
--- /dev/null
+++ b/IO/IO.pod
@@ -0,0 +1,290 @@
+=head1 NAME
+
+PDL::IO - An overview of the modules in the PDL::IO namespace.
+
+=head1 SYNOPSIS
+
+ # At your system shell, type:
+ perldoc PDL::IO
+
+=head1 DESCRIPTION
+
+PDL contains many modules for displaying, loading, and saving data.
+
+=over
+
+=item * Perlish or Text-Based
+
+A few IO modules provide Perl-inspired capabilities. These are
+PDL::IO::Dumper and PDL::IO::Storable. PDL::IO::Misc provides
+simpler routines for dealing with delimited files, though its
+capabilities are limited to tabular or at most 3-d data sets.
+
+=item * Raw Format
+
+PDL has two modules that store their data in a raw binary format; they
+are PDL::IO::FastRaw and PDL::IO::FlexRaw. They are fast but the files
+they produce will not be readable across different architectures.
+These two modules are so similar that they could probably be combined.
+
+=item * Data Browsing
+
+At the moment, only PDL::IO::Browser provides data browsing functionality.
+
+=item * Image Handling
+
+PDL has a handful of modules that will load images into piddles for you.
+They include PDL::IO::Dicom, PDL::IO::FITS, PDL::IO::GD, PDL::IO::Pic,
+and PDL::IO::Pnm. However, PDL::IO::FITS should also be considered something
+of a general data format.
+
+=item * Disk Caching
+
+Both PDL::IO::FastRaw and PDL::IO::FlexRaw provide for direct piddle-to-disk
+mapping, but they use PDL's underlying mmap functionality to do it, and that
+doesn't work for Windows. However, users of all operating systems can still
+use PDL::DiskCache, which can use any desired IO read/write functionality
+(though you may have to write a small wrapper function).
+
+=item * General Data Storage Formats
+
+PDL has a number of modules that interface general data storage libraries.
+They include PDL::IO::HDF and PDL::IO::NDF (the latter is now a separate
+CPAN module). There is a PDL::IO::IDL,
+though at the moment it is not distributed with PDL. PDL::IO::FITS is
+something of a general data format, since piddle data can be stored to a
+FITS file without loss. PDL::IO::FlexRaw and PDL::IO::FastRaw read and
+write data identical C's low-level C<write> function and PDL::IO::FlexRaw
+can work with FORTRAN 77 UNFORMATTED files. FlexRaw and Storable provide
+general data storage capabilities. Finally, PDL can read Grib (weather-data)
+files using the CPAN module PDL::IO::Grib.
+
+=item * Making Movies
+
+You can make an MPEG animation using PDL::IO::Pic's wmpeg function.
+
+=back
+
+Here's a brief summary of all of the modules, in alphabetical order.
+
+=head2 PDL::DiskCache
+
+The DiskCache module allows you to tie a Perl array to a collection
+of files on your disk, which will be loaded into and out of memory
+as piddles. Although the module defaults to working with FITS files,
+it allows you to specify your own reading and writing functions.
+This allows you to vastly streamline your code by hiding the unnecessary
+details of loading and saving files.
+
+If you find yourself writing scripts to procss many data files,
+especially if that data processing is not necessarily in sequential
+order, you should consider using PDL::DiskCache. To read more,
+check the L<PDL::DiskCache documentation|PDL::DiskCache>.
+
+=head2 PDL::IO::Browser
+
+The Browser module provides a text-based data browser for 2D data sets.
+
+It uses the CURSES library to do the scrolling, so if your operating
+system does not have the cureses library, you won't be able to install
+this on your machine. (Note that the package containing the header
+files for the CURSES library may be called C<libcurses> or possibly
+C<libncurses>.)
+
+PDL::IO::Browser is not installed by default because it gives
+trouble on Mac OS X, and not enough is known to fix the problem.
+If you want to enable it, edit the perldl configuration file
+and rebuild PDL. To learn more about editing the configuration
+file, see the INSTALLATION section in L<the FAQ|PDL::FAQ>. (Also,
+if you are familiar with CURSES on Mac, your help would be much
+appreciated!)
+
+To see if the module is installed on your machine (and to get more
+information about PDL::IO::Browser), follow L<this link|PDL::IO::Browser>
+or type at the system prompt:
+
+ perldoc PDL::IO::Browser
+
+If you want to get more information about PDL::IO::Browser and it's
+not installed on your system, I'm afraid you'll have to pick out the
+pod from the source file, which can be found online at
+L<http://pdl.git.sourceforge.net/git/gitweb.cgi?p=pdl/pdl;a=blob_plain;f=IO/Browser/browser.pd;hb=HEAD>.
+
+=head2 PDL::IO::Dicom
+
+DICOM is an image format, and this module allows you to read image
+files with the DICOM file format. To read more, check the
+L<PDL::IO::Dicom documentation|PDL::IO::Dicom>.
+
+=head2 PDL::IO::Dumper
+
+Provides functionality similar to L<Data::Dumper|Data::Dumper> for
+piddles. L<Data::Dumper|Data::Dumper> stringifies a data structure,
+creating a string that can be C<eval>ed to reproduce the original data
+structure. It's also usually suitable for printing, to visualize the
+structure.
+
+To read more, check the L<PDL::IO::Dumper documentation|PDL::IO::Dumper>.
+See also PDL::IO::Storable for a more comprehensive structured
+data solution.
+
+=head2 PDL::IO::FastRaw
+
+Very simple module for quickly writing, reading, and memory-mapping
+piddles to/from disk. It is fast to learn and fast to use, though
+you may be frustrated by its lack of options. To quote from
+the original POD:
+
+"The binary files are in general NOT interchangeable between different
+architectures since the binary file is simply dumped from the memory
+region of the piddle. This is what makes the approach efficient."
+
+This creates two files for every piddle saved - one that stores the
+raw data and another that stores the header file, which indicates
+the dimensions of the data stored in the raw file. Even
+if you save 1000 different piddles with the exact same dimensions,
+you will still need to write out a header file for each one. You
+cannot store multiple piddles in one file.
+
+Note that at the time of writing, memory-mapping is not possible
+on Windows.
+
+For more details, see L<PDL::IO::FastRaw>. For a more flexible
+raw IO module, see PDL::IO::FlexRaw.
+
+=head2 PDL::IO::FITS
+
+Allows basic reading and writing of FITS files. You can read more
+about FITS formatted files at L<http://fits.gsfc.nasa.gov/fits_intro.html>
+and L<http://en.wikipedia.org/wiki/FITS>. It is an image format
+commonly used in Astronomy.
+
+This module may or may not be installed on your machine. To get more
+information, check online at
+L<http://pdl.sourceforge.net/PDLdocs/IO/FITS.html>. To see if the
+module is installed on your machine, follow L<this link|PDL::IO::FITS>
+or type at the system prompt:
+
+ perldoc PDL::IO::FITS
+
+=head2 PDL::IO::FlexRaw
+
+Somewhat smarter module (compared to FastRaw) for reading, writing,
+and memory mapping piddles to disk. In addition to everything that
+FastRaw can do, FlexRaw can also store multiple piddles in a single
+file, take user-specified headers (so you can use one header file
+for multiple files that have identical structure), and read
+compressed data. However, FlexRaw cannot memory-map compressed data,
+and just as with FastRaw, the format will not work across multiple
+architectures.
+
+FlexRaw and FastRaw produce identical raw files and have essentially
+identical performance. Use whichever module seems to be more
+comfortable. I would generally recommend using FlexRaw over
+FastRaw, but the differences are minor for most uses.
+
+Note that at the time of writing, memory-mapping is not possible
+on Windows.
+
+For more details on FlexRaw, see L<PDL::IO::FlexRaw>.
+
+=head2 PDL::IO::GD
+
+GD is a library for reading, creating, and writing bitmapped images,
+written in C. You can read more about the C-library here:
+L<http://www.libgd.org/>.
+
+In addition to reading and writing .png and .jpeg files, GD allows
+you to modify the bitmap by drawing rectangles, adding text, and
+probably much more. The documentation can be
+L<found here|PDL::IO::GD>. As such, it should probably be not
+only considered an IO module, but a Graphics module as well.
+
+This module provides PDL bindings for the GD library, which ought
+not be confused with the Perl bindings. The perl bindings were
+developed independently and can be found at L<GD>, if you have
+Perl's GD bindings installed.
+
+=head2 PDL::IO::Grib
+
+A CPAN module last updated in 2000 that allows you to read Grib files.
+GRIB is a data format commonly used in meteorology. In the off-chance
+that you have it installed, you should L<read PDL::IO::Grib's
+documenation|PDL::IO::Grib>.
+
+=head2 PDL::IO::HDF, PDL::IO::HDF5
+
+Provides an interface to HDF4 and HDF5 file formats, which are kinda like
+cross-platform binary XML files. HDF stands for B<H>eierarchicl B<D>ata
+B<F>ormat. HDF was originally developed at the NCSA. To read more about
+HDF, see L<http://www.hdfgroup.org/>. Note that HDF5 is not presently
+distributed with PDL, and neither HDF4 nor HDF5 will be installed unless
+you have the associated C libraries that these modules interface. Also
+note that the HDF5 library on CPAN is rather old and somebody from HDF
+contacted the mailing list in the Fall of 2009 to develop new and better
+HDF5 bindings for Perl.
+
+You should look into the L<PDL::IO::HDF (4) documentation|PDL::IO::HDF> or
+L<PDL::IO::HDF5 documentation|PDL::IO::HDF5>, depending upon which module
+you have installed.
+
+=head2 PDL::IO::IDL
+
+Once upon a time, PDL had a module for reading IDL data files. Unfortunately, it
+cannot be distributed because the original author, Craig DeForest,
+signed the IDL license agreement and was unable to negotiate the administrative
+hurdles to get it published. However, it can be found in Sourceforge's CVS attic, and
+any PDL user who has not signed IDL's license agreement can fix it up and resubmit it.
+
+=head2 PDL::IO::Misc
+
+Provides mostly text-based IO routines. Data input and output is
+restricted mostly to tabular (i.e. two-dimensional) data sets,
+though limited support is provided for 3d data sets.
+
+Alternative text-based modules support higher dimensions, such
+as PDL::IO::Dumper and PDL::IO::Storable. Check the
+L<PDL::IO::Misc documentation|PDL::IO::Misc> for more details.
+
+=head2 PDL::IO::NDF
+
+Starlink developed a file format for N-Dimensional data Files,
+which it cleverly dubbed NDF. If you work with these files,
+you're in luck! Check the L<PDL::IO::NDF documentation|PDL::IO::NDF>
+for more details.
+
+=head2 PDL::IO::Pic
+
+Provides reading/writing of images to/from piddles, as well as creating
+MPEG animations! The module uses the netpbm library, so you will
+need that on your machine in order for this to work. To read more,
+see the L<PDL::IO::Pic documentation|PDL::IO::Pic>. Also look into
+the next module, as well as PDL::IO::GD.
+
+=head2 PDL::IO::Pnm
+
+Provides methods for reading and writing pnm files (of which pbm is
+but one). Check the L<PDL::IO::Pnm documentation|PDL::IO::Pnm> for
+more details. Also check out the previous module and PDL::IO::GD.
+
+=head2 PDL::IO::Storable
+
+Implements the relevant methods to be able to store and retrieve piddles
+via Storable. True, you can use many methods to save a single piddle.
+In contrast, this module is particularly useful if you need to save a complex Perl structure
+that contain piddles, such as an array of hashes, each of which contains
+piddles.
+
+Check the L<PDL::IO::Storable documentation|PDL::IO::Storable> for more
+details. See also PDL::IO::Dumper for an alternative stringifier.
+
+
+=head1 COPYRIGHT
+
+Copyright 2010 David Mertens (dcmertens.perl at gmail.com). You can
+distribute and/or modify this document under the same terms as the
+current Perl license.
+
+See: http://dev.perl.org/licenses/
+
+
diff --git a/IO/Makefile.PL b/IO/Makefile.PL
new file mode 100644
index 0000000..d29cb49
--- /dev/null
+++ b/IO/Makefile.PL
@@ -0,0 +1,28 @@
+
+PDL::Core::Dev->import();
+
+# do we build PDL::IO::Browser ?
+#
+my @dirs = qw( FastRaw Misc FlexRaw Pnm Storable FITS HDF GD Dicom IDL );
+my $build_browser = $PDL::Config{WITH_IO_BROWSER} || 0;
+if ( $build_browser and ($^O !~ /win32/i) ) {
+ push @dirs, 'Browser';
+ print "\n Building PDL::IO::Browser. Turn off WITH_IO_BROWSER if this is incorrect.\n\n";
+} else {
+ print "\n Not building PDL::IO::Browser. Turn on WITH_IO_BROWSER if this is incorrect.\n\n";
+}
+
+use ExtUtils::MakeMaker;
+# # See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# # the contents of the Makefile that is written.
+
+WriteMakefile(
+ 'NAME' => 'PDL::IO',
+ 'VERSION_FROM' => '../Basic/Core/Version.pm',
+ 'PM' => {
+ 'Dumper.pm' => '$(INST_LIB)/PDL/IO/Dumper.pm',
+ 'IO.pod' => '$(INST_LIB)/PDL/IO.pod',
+ },
+ 'DIR' => [ @dirs ],
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
diff --git a/IO/Misc/Makefile.PL b/IO/Misc/Makefile.PL
new file mode 100644
index 0000000..64bfa41
--- /dev/null
+++ b/IO/Misc/Makefile.PL
@@ -0,0 +1,20 @@
+
+# Makefile.PL for PDL::IO module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+# Replace this wit:e
+PDL::Core::Dev->import();
+
+ at pack = (["misc.pd",Misc,PDL::IO::Misc]);
+
+WriteMakefile(
+ pdlpp_stdargs_int(@::pack)
+);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/IO/Misc/misc.pd b/IO/Misc/misc.pd
new file mode 100644
index 0000000..fd3f5e8
--- /dev/null
+++ b/IO/Misc/misc.pd
@@ -0,0 +1,1589 @@
+
+# check for bad value support
+use PDL::Config;
+my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
+
+# and endian-ness of machine
+require PDL::Core::Dev;
+my $isbigendian = PDL::Core::Dev::isbigendian();
+
+pp_addpm({At=>'Top'},<<'EOD');
+
+=head1 NAME
+
+PDL::IO::Misc - misc IO routines for PDL
+
+=head1 DESCRIPTION
+
+Some basic I/O functionality: FITS, tables, byte-swapping
+
+=head1 SYNOPSIS
+
+ use PDL::IO::Misc;
+
+=cut
+
+EOD
+
+pp_addpm({At=>'Bot'},<<'EOD');
+
+=head1 AUTHOR
+
+Copyright (C) Karl Glazebrook 1997, Craig DeForest 2001,
+2003, and Chris Marshall 2010. All rights reserved. There is
+no warranty. You are allowed to redistribute this software
+/ documentation under certain conditions. For details, see
+the file COPYING in the PDL distribution. If this file is
+separated from the PDL distribution, the copyright notice
+should be included in the file.
+
+=cut
+
+EOD
+
+pp_add_exported('',"rcols wcols swcols rgrep rdsa");
+
+############################## PM CODE ########################################
+
+pp_addpm(<<'!NO!SUBS!');
+
+use PDL::Primitive;
+use PDL::Types;
+use PDL::Options;
+use PDL::Bad;
+use Carp;
+use Symbol qw/ gensym /;
+use List::Util;
+use strict;
+
+!NO!SUBS!
+
+defpdl(
+ 'bswap2',
+ 'x(); ',
+ '',
+ '
+ int i;
+ PDL_Short *aa; PDL_Short bb;
+ PDL_Byte *a,*b;
+
+ int n = sizeof($x()) / sizeof(PDL_Short);
+ aa = (PDL_Short*) &$x();
+
+ for(i=0;i<n; i++) {
+ bb = aa[i]; a = (PDL_Byte*) (void*) (aa+i);
+ b = (PDL_Byte*) &bb;
+ *a = *(b+1); *(a+1) = *b;
+ }',
+ "Swaps pairs of bytes in argument x()"
+);
+
+
+defpdl(
+ 'bswap4',
+ 'x(); ',
+ '',
+ '
+ int i;
+ PDL_Long *aa; PDL_Long bb;
+ PDL_Byte *a,*b;
+
+ int n = sizeof($x()) / sizeof(PDL_Long);
+ aa = (PDL_Long*) &$x();
+
+ for(i=0;i<n; i++) {
+ bb = aa[i]; a = (PDL_Byte*) (void*) (aa+i);
+ b = (PDL_Byte*) &bb;
+ *a = *(b+3); *(a+1) = *(b+2); *(a+2) = *(b+1); *(a+3) = *b;
+ }',
+ "Swaps quads of bytes in argument x()"
+);
+
+
+defpdl(
+ 'bswap8',
+ 'x(); ',
+ '',
+ '
+ int i;
+ PDL_Double *aa; PDL_Double bb;
+ PDL_Byte *a,*b;
+
+ int n = sizeof($x()) / sizeof(PDL_Double);
+ aa = (PDL_Double*) &$x();
+
+ for(i=0;i<n; i++) {
+ bb = aa[i]; a = (PDL_Byte*) (void*) (aa+i);
+ b = (PDL_Byte*) &bb;
+ *a = *(b+7); *(a+1) = *(b+6); *(a+2) = *(b+5); *(a+3) = *(b+4);
+ *(a+4) = *(b+3); *(a+5) = *(b+2); *(a+6) = *(b+1); *(a+7) = *b;
+ }',
+ "Swaps octets of bytes in argument x()"
+);
+
+
+pp_addpm(<<'!NO!SUBS!');
+
+
+
+# Internal routine to extend PDL array by size $n along last dimension
+# - Would be nice to have a proper extend function rather than hack
+# - Is a NO-OP when handed a perl ARRAY ref rather than a piddle arg
+sub _ext_lastD { # Called by rcols and rgrep
+ my ($a,$n) = @_;
+ if (ref($_[0]) ne 'ARRAY') {
+ my @nold = $a->dims;
+ my @nnew = @nold;
+ $nnew[-1] += $n; # add $n to the last dimension
+ my $b = zeroes($a->type, at nnew); # New pdl
+ my $bb = $b->mv(-1,0)->slice("0:".($nold[-1]-1))->mv(0,-1);
+ $bb .= $a;
+ $_[0] = $b;
+ }
+ 1;
+}
+
+# Implements PDL->at() for either 1D PDL or ARRAY arguments
+# TODO: Need to add support for multidim piddles parallel to rcols
+sub _at_1D ($$) { # Called by wcols and swcols
+ my $data = $_[0];
+ my $index = $_[1];
+
+ if (ref $data eq 'ARRAY') {
+ return $data->[$index];
+ } else {
+ return $data->at($index);
+ }
+}
+
+# squeezes "fluffy" perl list values into column data type
+sub _burp_1D {
+ my $data = $_[0]->[0];
+ my $databox = $_[0]->[1];
+ my $index = $_[1];
+
+ my $start = $index - @{$databox} + 1;
+
+ my $tmp; # work around for perl -d "feature"
+ if (ref $data eq 'ARRAY') {
+ push @{$data}, @{$databox};
+ } elsif ( ref($databox->[0]) eq "ARRAY" ) {
+ # could add POSIX::strtol for hex and octal support but
+ # can't break float conversions (how?)
+ ($tmp = $data->slice(":,$start:$index")) .= pdl($databox);
+ } else {
+ # could add POSIX::strtol for hex and octal support but
+ # can't break float conversions (how?)
+ ($tmp = $data->slice("$start:$index")) .= pdl($databox);
+ }
+ $_[0] = [ $data, [] ];
+}
+
+# taken outside of rcols() to avoid clutter
+sub _handle_types ($$$) {
+ my $ncols = shift;
+ my $deftype = shift;
+ my $types = shift;
+
+ barf "Unknown PDL type given for DEFTYPE.\n"
+ unless ref($deftype) eq "PDL::Type";
+
+ my @cols = ref($types) eq "ARRAY" ? @$types : ();
+
+ if ( $#cols > -1 ) {
+ # truncate if required
+ $#cols = $ncols if $#cols > $ncols;
+
+ # check input values are sensible
+ for ( 0 .. $#cols ) {
+ barf "Unknown value '$cols[$_]' in TYPES array.\n"
+ unless ref($cols[$_]) eq "PDL::Type";
+ }
+ }
+
+ # fill in any missing columns
+ for ( ($#cols+1) .. $ncols ) { push @cols, $deftype; }
+
+ return @cols;
+} # sub: _handle_types
+
+
+# Whether an object is an IO handle
+use Scalar::Util;
+sub _is_io_handle {
+ my $h = shift;
+ # reftype catches almost every handle, except: *MYHANDLE
+ # fileno catches *MYHANDLE, but doesn't catch handles that aren't files
+ my $reftype = Scalar::Util::reftype($h);
+ return defined(fileno($h)) || (defined($reftype) && $reftype eq 'GLOB');
+}
+
+
+=head2 rcols
+
+=for ref
+
+Read specified ASCII cols from a file into piddles and perl
+arrays (also see L</rgrep()>).
+
+=for usage
+
+ Usage:
+ ($x,$y,...) = rcols( *HANDLE|"filename", { EXCLUDE => '/^!/' }, $col1, $col2, ... )
+ $x = rcols( *HANDLE|"filename", { EXCLUDE => '/^!/' }, [] )
+ ($x,$y,...) = rcols( *HANDLE|"filename", $col1, $col2, ..., { EXCLUDE => '/^!/' } )
+ ($x,$y,...) = rcols( *HANDLE|"filename", "/foo/", $col1, $col2, ... )
+
+For each column number specified, a 1D output PDL will be
+generated. Anonymous arrays of column numbers generate
+2D output piddles with dim0 for the column data and dim1
+equal to the number of colums in the anonymous array(s).
+
+An empty anonymous array as column specification will
+produce a single output data piddle with dim(1) equal
+to the number of columns available.
+
+There are two calling conventions - the old version, where a
+pattern can be specified after the filename/handle, and the
+new version where options are given as as hash reference.
+This reference can be given as either the second or last
+argument.
+
+The default behaviour is to ignore lines beginning with
+a # character and lines that only consist of whitespace.
+Options exist to only read from lines that match, or do
+not match, supplied patterns, and to set the types of the
+created piddles.
+
+Can take file name or *HANDLE, and if no explicit column
+numbers are specified, all are assumed. For the allowed types,
+see L<PDL::Core/Datatype_conversions>.
+
+Options (case insensitive):
+
+ EXCLUDE or IGNORE
+ - ignore lines matching this pattern (default B<'/^#/'>).
+
+ INCLUDE or KEEP
+ - only use lines which match this pattern (default B<''>).
+
+ LINES
+ - a string pattern specifying which line numbers to use.
+ Line numbers start at 0 and the syntax is 'a:b:c' to use
+ every c'th matching line between a and b (default B<''>).
+
+ DEFTYPE
+ - default data type for stored data (if not specified, use the type
+ stored in C<$PDL::IO::Misc::deftype>, which starts off as B<double>).
+
+ TYPES
+ - reference to an array of data types, one element for each column
+ to be read in. Any missing columns use the DEFTYPE value (default B<[]>).
+
+ COLSEP
+ - splits on this string/pattern/qr{} between colums of data. Defaults to
+ $PDL::IO::Misc::defcolsep.
+
+ PERLCOLS
+ - an array of column numbers which are to be read into perl arrays
+ rather than piddles. Any columns not specified in the explicit list
+ of columns to read will be returned after the explicit columns.
+ (default B<undef>).
+
+ COLIDS
+ - if defined to an array reference, it will be assigned the column
+ ID values obtained by splitting the first line of the file in the
+ identical fashion to the column data.
+
+ CHUNKSIZE
+ - the number of input data elements to batch together before appending
+ to each output data piddle (Default value is 100). If CHUNKSIZE is
+ greater than the number of lines of data to read, the entire file is
+ slurped in, lines split, and perl lists of column data are generated.
+ At the end, effectively pdl(@column_data) produces any result piddles.
+
+ VERBOSE
+ - be verbose about IO processing (default C<$PDL::vebose>)
+
+=for example
+
+For example:
+
+ $x = PDL->rcols 'file1'; # file1 has only one column of data
+ $x = PDL->rcols 'file2', []; # file2 can have multiple columns, still 1 piddle output
+ # (empty array ref spec means all possible data fields)
+
+ ($x,$y) = rcols 'table.csv', { COLSEP => ',' }; # read CSV data file
+ ($x,$y) = rcols *STDOUT; # default separator for lines like '32 24'
+
+ # read in lines containing the string foo, where the first
+ # example also ignores lines that begin with a # character.
+ ($x,$y,$z) = rcols 'file2', 0,4,5, { INCLUDE => '/foo/' };
+ ($x,$y,$z) = rcols 'file2', 0,4,5, { INCLUDE => '/foo/', EXCLUDE => '' };
+
+ # ignore the first 27 lines of the file, reading in as ushort's
+ ($x,$y) = rcols 'file3', { LINES => '27:-1', DEFTYPE => ushort };
+ ($x,$y) = rcols 'file3', { LINES => '27:', TYPES => [ ushort, ushort ] };
+
+ # read in the first column as a perl array and the next two as piddles
+ # with the perl column returned after the piddle outputs
+ ($x,$y,$name) = rcols 'file4', 1, 2 , { PERLCOLS => [ 0 ] };
+ printf "Number of names read in = %d\n", 1 + $#$name;
+
+ # read in the first column as a perl array and the next two as piddles
+ # with PERLCOLS changing the type of the first returned value to perl list ref
+ ($name,$x,$y) = rcols 'file4', 0, 1, 2, { PERLCOLS => [ 0 ] };
+
+ # read in the first column as a perl array returned first followed by the
+ # the next two data columns in the file as a single Nx2 piddle
+ ($name,$xy) = rcols 'file4', 0, [1, 2], { PERLCOLS => [ 0 ] };
+
+
+ NOTES:
+
+ 1. Quotes are required on patterns or use the qr{} quote regexp syntax.
+
+ 2. Columns are separated by whitespace by default, use the COLSEP option
+ separator to specify an alternate split pattern or string or specify an
+ alternate default separator by setting C<$PDL::IO::Misc::defcolsep> .
+
+ 3. Legacy support is present to use C<$PDL::IO::Misc::colsep> to set the
+ column separator but C<$PDL::IO::Misc::colsep> is not defined by default.
+ If you set the variable to a defined value it will get picked up.
+
+ 4. LINES => '-1:0:3' may not work as you expect, since lines are skipped
+ when read in, then the whole array reversed.
+
+ 5. For consistancy with wcols and rcols 1D usage, column data is loaded
+ into the rows of the pdls (i.e., dim(0) is the elements read per column
+ in the file and dim(1) is the number of columns of data read.
+
+=cut
+
+use vars qw/ $colsep $defcolsep $deftype /;
+
+$defcolsep = ' '; # Default column separator
+$deftype = double; # Default type for piddles
+
+my $defchunksize = 100; # Number of perl list items to append to piddle
+my $usecolsep; # This is the colsep value that is actually used
+
+# NOTE: XXX
+# need to look at the line-selection code. For instance, if want
+# lines => '-1:0:3',
+# read in all lines, reverse, then apply the step
+# -> fix point 4 above
+#
+# perhaps should just simplify the LINES option - ie remove
+# support for reversed arrays?
+
+sub rcols{ PDL->rcols(@_) }
+
+sub PDL::rcols {
+ my $class = shift;
+ barf 'Usage ($x,$y,...) = rcols( *HANDLE|"filename", ["/pattern/" or \%options], $col1, $col2, ..., [ \%options] )'
+ if $#_<0;
+
+ my $is_handle = _is_io_handle $_[0];
+ my $fh = $is_handle ? $_[0] : gensym;
+ open $fh, $_[0] or die "File $_[0] not found\n" unless $is_handle;
+ shift;
+
+ # set up default options
+ my $opt = new PDL::Options( {
+ CHUNKSIZE => undef,
+ COLIDS => undef,
+ COLSEP => undef,
+ DEFTYPE => $deftype,
+ EXCLUDE => '/^#/',
+ INCLUDE => undef,
+ LINES => '',
+ PERLCOLS => undef,
+ TYPES => [],
+ VERBOSE=> $PDL::verbose,
+ } );
+ $opt->synonyms( { IGNORE => 'EXCLUDE', KEEP => 'INCLUDE' } );
+
+ # has the user supplied any options
+ if ( defined($_[0]) ) {
+ # ensure the old-style behaviour by setting the exclude pattern to undef
+ if ( $_[0] =~ m|^/.*/$| ) { $opt->options( { EXCLUDE => undef, INCLUDE => shift } ); }
+ elsif ( ref($_[0]) eq "Regexp" ) { $opt->options( { EXCLUDE => undef, INCLUDE => shift } ); }
+ elsif ( ref($_[0]) eq "HASH" ) { $opt->options( shift ); }
+ }
+
+ # maybe the last element is a hash array as well
+ $opt->options( pop ) if defined($_[-1]) and ref($_[-1]) eq "HASH";
+
+ # a reference to a hash array
+ my $options = $opt->current();
+
+ # handle legacy colsep variable
+ $usecolsep = (defined $colsep) ? qr{$colsep} : undef;
+ $usecolsep = qr{$options->{COLSEP}} if $options->{COLSEP};
+
+ # what are the patterns?
+ foreach my $pattern ( qw( INCLUDE EXCLUDE ) ) {
+ if ( $options->{$pattern} and ref($options->{$pattern}) ne "Regexp" ) {
+ if ( $options->{$pattern} =~ m|^/.*/$| ) {
+ $options->{$pattern} =~ s|^/(.*)/$|$1|;
+ $options->{$pattern} = qr($options->{$pattern});
+ } else {
+ barf "rcols() - unable to process $pattern value.\n";
+ }
+ }
+ }
+
+ # CHUNKSIZE controls memory/time tradeoff of piddle IO
+ my $chunksize = $options->{CHUNKSIZE} || $defchunksize;
+ my $nextburpindex = -1;
+
+# which columns are to be read into piddles and which into perl arrays?
+my @end_perl_cols = (); # unique perl cols to return at end
+
+my @perl_cols = (); # perl cols index list from PERLCOLS option
+ at perl_cols = @{ $$options{PERLCOLS} } if $$options{PERLCOLS};
+
+my @is_perl_col; # true if index corresponds to a perl column
+for (@perl_cols) { $is_perl_col[$_] = 1; };
+# print STDERR "rcols: \@is_perl_col is @is_perl_col\n";
+
+my ( @explicit_cols ) = @_; # call specified columns to read
+# print STDERR "rcols: \@explicit_cols is @explicit_cols\n";
+
+# work out which line numbers are required
+# - the regexp's are a bit over the top
+my ( $a, $b, $c );
+if ( $$options{LINES} ne '' ) {
+ if ( $$options{LINES} =~ /^\s*([+-]?\d*)\s*:\s*([+-]?\d*)\s*$/ ) {
+ $a = $1; $b = $2;
+ } elsif ( $$options{LINES} =~ /^\s*([+-]?\d*)\s*:\s*([+-]?\d*)\s*:\s*([+]?\d*)\s*$/ ) {
+ $a = $1; $b = $2; $c = $3;
+ } else {
+ barf "rcols() - unable to parse LINES option.\n";
+ }
+}
+
+# Since we do not know how many lines there are in advance, things get a bit messy
+my ( $index_start, $index_end ) = ( 0, -1 );
+$index_start = $a if defined($a) and $a ne '';
+$index_end = $b if defined($b) and $b ne '';
+my $line_step = $c || 1;
+
+# $line_rev = 0/1 for normal order/reversed
+# $line_start/_end refer to the first and last line numbers that we want
+# (the values of which we may not know until we've read in all the file)
+my ( $line_start, $line_end, $line_rev );
+if ( ($index_start >= 0 and $index_end < 0) ) {
+ # eg 0:-1
+ $line_rev = 0; $line_start = $index_start;
+} elsif ( $index_end >= 0 and $index_start < 0 ) {
+ # eg -1:0
+ $line_rev = 1; $line_start = $index_end;
+} elsif ( $index_end >= $index_start and $index_start >= 0 ) {
+ # eg 0:10
+ $line_rev = 0; $line_start = $index_start; $line_end = $index_end;
+} elsif ( $index_start > $index_end and $index_end >= 0 ) {
+ # eg 10:0
+ $line_rev = 1; $line_start = $index_end; $line_end = $index_start;
+} elsif ( $index_start <= $index_end ) {
+ # eg -5:-1
+ $line_rev = 0;
+} else {
+ # eg -1:-5
+ $line_rev = 1;
+}
+
+my @ret;
+
+my ($k,$fhline);
+
+my $line_num = -1;
+my $line_ctr = $line_step - 1; # ensure first line is always included
+my $index = -1;
+my $pdlsize = 0;
+my $extend = 10000;
+
+my $line_store; # line numbers of saved data
+
+RCOLS_IO: {
+
+ if ($options->{COLIDS}) {
+ print STDERR "rcols: processing COLIDS option\n" if $options->{VERBOSE};
+ undef $!;
+ if (defined($fhline = <$fh>) ) { # grab first line's fields for column IDs
+ my @v = defined($usecolsep) ? split($usecolsep,$fhline) : split(' ',$fhline);
+ @{$options->{COLIDS}} = @v;
+ } else {
+ die "rcols: reading COLIDS info, $!" if $!;
+ last RCOLS_IO;
+ }
+ }
+
+ while( defined($fhline = <$fh>) ) {
+
+ # chomp $fhline;
+ $fhline =~ s/\r?\n$//; # handle DOS on unix files better
+
+ $line_num++;
+
+ # the order of these checks is important, particularly whether we
+ # check for line_ctr before or after the pattern matching
+ # Prior to PDL 2.003 the line checks were done BEFORE the
+ # pattern matching
+ #
+ # need this first check, even with it almost repeated at end of loop,
+ # incase the pattern matching excludes $line_num == $line_end, say
+ last if defined($line_end) and $line_num > $line_end;
+ next if defined($line_start) and $line_num < $line_start;
+ next if $options->{EXCLUDE} and $fhline =~ /$options->{EXCLUDE}/;
+ next if $options->{INCLUDE} and not $fhline =~ /$options->{INCLUDE}/;
+ next unless ++$line_ctr == $line_step;
+ $line_ctr = 0;
+
+ $index++;
+ my @v = defined($usecolsep) ? split($usecolsep,$fhline) : split(' ',$fhline);
+
+ # map empty fields '' to undef value
+ @v = map { $_ eq '' ? undef : $_ } @v;
+
+ # if the first line, set up the output piddles using all the columns
+ # if the user doesn't specify anything
+ if ( $index == 0 ) {
+
+ # Handle implicit multicolumns in command line
+ if ($#explicit_cols < 0) { # implicit single col data
+ @explicit_cols = ( 0 .. $#v );
+ }
+ if (scalar(@explicit_cols)==1 and ref($explicit_cols[0]) eq "ARRAY") {
+ if ( !scalar(@{$explicit_cols[0]}) ) { # implicit multi-col data
+ @explicit_cols = ( [ 0 .. $#v ] );
+ }
+ }
+ my $implicit_pdls = 0;
+ my $is_explicit = {};
+ foreach my $col (@explicit_cols) {
+ if (ref($col) eq "ARRAY") {
+ $implicit_pdls++ if !scalar(@$col);
+ } else {
+ $is_explicit->{$col} = 1;
+ }
+ }
+ if ($implicit_pdls > 1) {
+ die "rcols: only one implicit multicolumn piddle spec allowed, found $implicit_pdls!\n";
+ }
+ foreach my $col (@explicit_cols) {
+ if (ref($col) eq "ARRAY" and !scalar(@$col)) {
+ @$col = grep { !$is_explicit->{$_} } ( 0 .. $#v );
+ }
+ }
+
+ # remove declared perl columns from pdl data list
+ $k = 0;
+ my @pdl_cols = ();
+ foreach my $col (@explicit_cols) {
+ # strip out declared perl cols so they won't be read into piddles
+ if ( ref($col) eq "ARRAY" ) {
+ @$col = grep { !$is_perl_col[$_] } @{$col};
+ push @pdl_cols, [ @{$col} ];
+ } elsif (!$is_perl_col[$col]) {
+ push @pdl_cols, $col;
+ }
+ }
+ # strip out perl cols in explicit col list for return at end
+ @end_perl_cols = @perl_cols;
+ foreach my $col (@explicit_cols) {
+ if ( ref($col) ne "ARRAY" and defined($is_perl_col[$col]) ) {
+ @end_perl_cols = grep { $_ != $col } @end_perl_cols;
+ }
+ };
+
+ # sort out the types of the piddles
+ my @types = _handle_types( $#pdl_cols, $$options{DEFTYPE}, $$options{TYPES} );
+ if ( $options->{VERBOSE} ) { # dbg aid
+ print "Reading data into piddles of type: [ ";
+ foreach my $t ( @types ) {
+ print $t->shortctype() . " ";
+ }
+ print "]\n";
+ }
+
+ $k = 0;
+ for (@explicit_cols) {
+ # Using mixed list+piddle data structure for performance tradeoff
+ # between memory usage (perl list) and speed of IO (PDL operations)
+ if (ref($_) eq "ARRAY") {
+ # use multicolumn piddle here
+ push @ret, [ $class->zeroes($types[$k++],scalar(@{$_}),1), [] ];
+ } else {
+ push @ret, ($is_perl_col[$_] ? [ [], [] ] : [ $class->zeroes($types[$k],1), [] ]);
+ $k++ unless $is_perl_col[$_];
+ }
+ }
+ for (@end_perl_cols) { push @ret, [ [], [] ]; }
+
+ $line_store = [ $class->zeroes(long,1), [] ]; # only need to store integers
+ }
+
+ # if necessary, extend PDL in buffered manner
+ $k = 0;
+ if ( $pdlsize < $index ) {
+ for (@ret, $line_store) { _ext_lastD( $_->[0], $extend ); }
+ $pdlsize += $extend;
+ }
+
+ # - stick perl arrays onto end of $ret
+ $k = 0;
+ for (@explicit_cols, @end_perl_cols) {
+ if (ref($_) eq "ARRAY") {
+ push @{ $ret[$k++]->[1] }, [ @v[ @$_ ] ];
+ } else {
+ push @{ $ret[$k++]->[1] }, $v[$_];
+ }
+ }
+
+ # store the line number
+ push @{$line_store->[1]}, $line_num;
+
+ # need to burp out list if needed
+ if ( $index >= $nextburpindex ) {
+ for (@ret, $line_store) { _burp_1D($_,$index); }
+ $nextburpindex = $index + $chunksize;
+ }
+
+ # Thanks to Frank Samuelson for this
+ last if defined($line_end) and $line_num == $line_end;
+ }
+
+}
+
+close($fh) unless $is_handle;
+
+# burp one final time if needed and
+# clean out additional ARRAY ref level for @ret
+for (@ret, $line_store) {
+ _burp_1D($_,$index) if defined $_ and scalar @{$_->[1]};
+ $_ = $_->[0];
+}
+
+# have we read anything in? if not, return empty piddles
+if ( $index == -1 ) {
+ print "Warning: rcols() did not read in any data.\n" if $options->{VERBOSE};
+ if ( wantarray ) {
+ foreach ( 0 .. $#explicit_cols ) {
+ if ( $is_perl_col[$_] ) {
+ $ret[$_] = PDL->null;
+ } else {
+ $ret[$_] = [];
+ }
+ }
+ for ( @end_perl_cols ) { push @ret, []; }
+ return ( @ret );
+ } else {
+ return PDL->null;
+ }
+}
+
+# if the user has asked for lines => 0:-1 or 0:10 or 1:10 or 1:-1,
+# - ie not reversed and the last line number is known -
+# then we can skip the following nastiness
+if ( $line_rev == 0 and $index_start >= 0 and $index_end >= -1 ) {
+ for (@ret) {
+ ## $_ = $_->mv(-1,0)->slice("0:${index}")->mv(0,-1) unless ref($_) eq 'ARRAY';
+ $_ = $_->mv(-1,0)->slice("0:${index}") unless ref($_) eq 'ARRAY'; # cols are dim(0)
+ };
+ if ( $options->{VERBOSE} ) {
+ if ( ref($ret[0]) eq 'ARRAY' ) {
+ print "Read in ", scalar( @{ $ret[0] } ), " elements.\n";
+ } else {
+ print "Read in ", $ret[0]->nelem, " elements.\n";
+ }
+ }
+ wantarray ? return(@ret) : return $ret[0];
+}
+
+# Work out which line numbers we want. First we clean up the piddle
+# containing the line numbers that have been read in
+$line_store = $line_store->slice("0:${index}");
+
+# work out the min/max line numbers required
+if ( $line_rev ) {
+ if ( defined($line_start) and defined($line_end) ) {
+ my $dummy = $line_start;
+ $line_start = $line_end;
+ $line_end = $dummy;
+ } elsif ( defined($line_start) ) {
+ $line_end = $line_start;
+ } else {
+ $line_start = $line_end;
+ }
+}
+$line_start = $line_num + 1 + $index_start if $index_start < 0;
+$line_end = $line_num + 1 + $index_end if $index_end < 0;
+
+my $indices;
+
+{ no warnings 'precedence';
+ if ( $line_rev ) {
+ $indices = which( $line_store >= $line_end & $line_store <= $line_start )->slice('-1:0');
+ } else {
+ $indices = which( $line_store >= $line_start & $line_store <= $line_end );
+ }
+}
+
+# truncate the piddles
+for my $col ( @explicit_cols ) {
+ if ( ref($col) eq "ARRAY" ) {
+ for ( @$col ) {
+ $ret[$_] = $ret[$_]->index($indices);
+ }
+ } else {
+ $ret[$col] = $ret[$col]->index($indices) unless $is_perl_col[$col] };
+}
+
+# truncate/reverse/etc the perl arrays
+my @indices_array = list $indices;
+foreach ( @explicit_cols, @end_perl_cols ) {
+ if ( $is_perl_col[$_] ) {
+ my @temp = @{ $ret[$_] };
+ $ret[$_] = [];
+ foreach my $i ( @indices_array ) { push @{ $ret[$_] }, $temp[$i] };
+ }
+}
+
+# print some diagnostics
+if ( $options->{VERBOSE} ) {
+ my $done = 0;
+ foreach my $col (@explicit_cols) {
+ last if $done;
+ next if $is_perl_col[$col];
+ print "Read in ", $ret[$col]->nelem, " elements.\n";
+ $done = 1;
+ }
+ foreach my $col (@explicit_cols, @end_perl_cols) {
+ last if $done;
+ print "Read in ", $ret[$col]->nelem, " elements.\n";
+ $done = 1;
+ }
+}
+
+# fix 2D pdls to match what wcols generates
+foreach my $col (@ret) {
+ next if ref($col) eq "ARRAY";
+ $col = $col->mv(0,1) if $col->ndims == 2;
+}
+
+wantarray ? return(@ret) : return $ret[0];
+}
+
+
+=head2 wcols
+
+=for ref
+
+ Write ASCII columns into file from 1D or 2D piddles and/or 1D listrefs efficiently.
+
+Can take file name or *HANDLE, and if no file/filehandle is given defaults to STDOUT.
+
+ Options (case insensitive):
+
+ HEADER - prints this string before the data. If the string
+ is not terminated by a newline, one is added. (default B<''>).
+
+ COLSEP - prints this string between colums of data. Defaults to
+ $PDL::IO::Misc::defcolsep.
+
+ FORMAT - A printf-style format string that is cycled through
+ column output for user controlled formatting.
+
+=for usage
+
+ Usage: wcols $data1, $data2, $data3,..., *HANDLE|"outfile", [\%options]; # or
+ wcols $format_string, $data1, $data2, $data3,..., *HANDLE|"outfile", [\%options];
+
+ where the $dataN args are either 1D piddles, 1D perl array refs,
+ or 2D piddles (as might be returned from rcols() with the [] column
+ syntax and/or using the PERLCOLS option). dim(0) of all piddles
+ written must be the same size. The printf-style $format_string,
+ if given, overrides a any FORMAT key settings in the option hash
+
+e.g.,
+
+=for example
+
+ $x = random(4); $y = ones(4);
+ wcols $x, $y+2, 'foo.dat';
+ wcols $x, $y+2, *STDERR;
+ wcols $x, $y+2, '|wc';
+
+ $a = sequence(3); $b = zeros(3); $c = random(3);
+ wcols $a,$b,$c; # Orthogonal version of 'print $a,$b,$c' :-)
+
+ wcols "%10.3f", $a,$b; # Formatted
+ wcols "%10.3f %10.5g", $a,$b; # Individual column formatting
+
+ $a = sequence(3); $b = zeros(3); $units = [ 'm/sec', 'kg', 'MPH' ];
+ wcols $a,$b, { HEADER => "# a b" };
+ wcols $a,$b, { Header => "# a b", Colsep => ', ' }; # case insensitive option names!
+ wcols " %4.1f %4.1f %s",$a,$b,$units, { header => "# Day Time Units" };
+
+ $a52 = sequence(5,2); $b = ones(5); $c = [ 1, 2, 4 ];
+ wcols $a52; # now can write out 2D pdls (2 columns data in output)
+ wcols $b, $a52, $c # ...and mix and match with 1D listrefs as well
+
+ NOTES:
+
+ 1. Columns are separated by whitespace by default, use
+ C<$PDL::IO::Misc::defcolsep> to modify the default value or
+ the COLSEP option
+
+ 2. Support for the C<$PDL::IO::Misc::colsep> global value
+ of PDL-2.4.6 and earlier is maintained but the initial value
+ of the global is undef until you set it. The value will be
+ then be picked up and used as if defcolsep were specified.
+
+ 3. Dim 0 corresponds to the column data dimension for both
+ rcols and wcols. This makes wcols the reverse operation
+ of rcols.
+
+=cut
+
+*wcols = \&PDL::wcols;
+
+sub PDL::wcols {
+ barf 'Usage: wcols($optional_format_string, 1_or_2D_pdls, *HANDLE|"filename", [\%options])' if @_<1;
+
+ # handle legacy colsep variable
+ $usecolsep = (defined $colsep) ? $colsep : $defcolsep;
+
+ # if last argument is a reference to a hash, parse the options
+ my ($format_string, $step, $fh);
+ my $header;
+ if ( ref( $_[-1] ) eq "HASH" ) {
+ my $opt = pop;
+ foreach my $key ( keys %$opt ) {
+ if ( $key =~ /^H/i ) { $header = $opt->{$key}; } # option: HEADER
+ elsif ( $key =~ /^COLSEP/i ) { $usecolsep = $opt->{$key}; } # option: COLSEP
+ elsif ( $key =~ /^FORMAT/i ) { $format_string = $opt->{$key}; } # option: FORMAT
+ else {
+ print "Warning: wcols does not understand option <$key>.\n";
+ }
+ }
+ }
+ if (ref(\$_[0]) eq "SCALAR") {
+ $step = $format_string = shift; # 1st arg not piddle, explicit overrides option hash
+ $step =~ s/(%%|[^%])//g; # use step to count number of format items
+ $step = length ($step);
+ }
+ my $file = $_[-1];
+ my $file_opened;
+ my $is_handle = !UNIVERSAL::isa($file,'PDL') &&
+ !UNIVERSAL::isa($file,'ARRAY') &&
+ _is_io_handle $file;
+ if ($is_handle) { # file handle passed directly
+ $fh = $file; pop;
+ }
+ else{
+ if (ref(\$file) eq "SCALAR") { # Must be a file name
+ $fh = gensym;
+ if (!$is_handle) {
+ $file = ">$file" unless $file =~ /^\|/ or $file =~ /^\>/;
+ open $fh, $file or barf "File $file can not be opened for writing\n";
+ }
+ pop;
+ $file_opened = 1;
+ }
+ else{ # Not a filehandle or filename, assume something else
+ # (probably piddle) and send to STDOUT
+ $fh = *STDOUT;
+ }
+ }
+
+ my @p = @_;
+ my $n = (ref $p[0] eq 'ARRAY') ? $#{$p[0]}+1 : $p[0]->dim(0);
+ my @dogp = (); # need to break 2D pdls into a their 1D pdl components
+ for (@p) {
+ if ( ref $_ eq 'ARRAY' ) {
+ barf "wcols: 1D args must have same number of elements\n" if scalar(@{$_}) != $n;
+ push @dogp, $_;
+ } else {
+ barf "wcols: 1D args must have same number of elements\n" if $_->dim(0) != $n or $_->getndims > 2;
+ if ( $_->getndims == 2 ) {
+ push @dogp, $_->dog;
+ } else {
+ push @dogp, $_;
+ }
+ }
+ }
+ if ( defined $header ) {
+ $header .= "\n" unless $header =~ m/\n$/;
+ print $fh $header;
+ }
+ my $i;
+ my $pcnt = scalar @dogp;
+ for ($i=0; $i<$n; $i++) {
+ if ($format_string) {
+ my @d;
+ my $pdone = 0;
+ for (@dogp) {
+ push @d,_at_1D($_,$i); $pdone++;
+ if (@d == $step) {
+ printf $fh $format_string, at d;
+ printf $fh $usecolsep unless $pdone==$pcnt;
+ $#d = -1;
+ }
+ }
+ if (@d && !$i) {
+ my $str;
+ if ($#dogp>0) {
+ $str = ($#dogp+1).' columns don\'t';
+ } else {
+ $str = '1 column doesn\'t';
+ }
+ $str .= " fit in $step column format ".
+ '(even repeated) -- discarding surplus';
+ carp $str;
+ # printf $fh $format_string, at d;
+ # printf $fh $usecolsep;
+ }
+ } else {
+ my $pdone = 0;
+ for (@dogp) {
+ $pdone++;
+ print $fh _at_1D($_,$i) . ( ($pdone==$pcnt) ? '' : $usecolsep );
+ }
+ }
+ print $fh "\n";
+ }
+ close($fh) if $file_opened;
+ return 1;
+}
+
+=head2 swcols
+
+=for ref
+
+generate string list from C<sprintf> format specifier and a list of piddles
+
+C<swcols> takes an (optional) format specifier of the printf
+sort and a list of 1D piddles as input. It returns a perl
+array (or array reference if called in scalar context)
+where each element of the array is the string generated by
+printing the corresponding element of the piddle(s) using
+the format specified. If no format is specified it uses the
+default print format.
+
+=for usage
+
+ Usage: @str = swcols format, pdl1,pdl2,pdl3,...;
+ or $str = swcols format, pdl1,pdl2,pdl3,...;
+
+=cut
+
+*swcols = \&PDL::swcols;
+
+sub PDL::swcols{
+ my ($format_string,$step);
+
+ my @outlist;
+
+ if (ref(\$_[0]) eq "SCALAR") {
+ $step = $format_string = shift; # 1st arg not piddle
+ $step =~ s/(%%|[^%])//g; # use step to count number of format items
+ $step = length ($step);
+ }
+
+ my @p = @_;
+ my $n = (ref $p[0] eq 'ARRAY') ? $#{$p[0]}+1 : $p[0]->nelem;
+ for (@p) {
+ if ( ref $_ eq 'ARRAY' ) {
+ barf "swcols: 1D args must have same number of elements\n" if scalar(@{$_}) != $n;
+ } else {
+ barf "swcols: 1D args must have same number of elements\n" if $_->nelem != $n or $_->getndims!=1;
+ }
+ }
+
+ my $i;
+ for ($i=0; $i<$n; $i++) {
+ if ($format_string) {
+ my @d;
+ for (@p) {
+ push @d,_at_1D($_,$i);
+ if (@d == $step) {
+ push @outlist,sprintf $format_string, at d;
+ $#d = -1;
+ }
+ }
+ if (@d && !$i) {
+ my $str;
+ if ($#p>0) {
+ $str = ($#p+1).' columns don\'t';
+ } else {
+ $str = '1 column doesn\'t';
+ }
+ $str .= " fit in $step column format ".
+ '(even repeated) -- discarding surplus';
+ carp $str;
+ # printf $fh $format_string, at d;
+ # printf $fh $usecolsep;
+ }
+ } else {
+ for (@p) {
+ push @outlist,sprintf _at_1D($_,$i),$usecolsep;
+ }
+ }
+ }
+ wantarray ? return @outlist: return \@outlist;
+}
+
+
+=head2 rgrep
+
+=for ref
+
+ Read columns into piddles using full regexp pattern matching.
+
+
+ Options:
+
+ UNDEFINED: This option determines what will be done for undefined
+ values. For instance when reading a comma-separated file of the type
+ C<1,2,,4> where the C<,,> indicates a missing value.
+
+ The default value is to assign C<$PDL::undefval> to undefined values,
+ but if C<UNDEFINED> is set this is used instead. This would normally
+ be set to a number, but if it is set to C<Bad> and PDL is compiled
+ with Badvalue support (see L<PDL::Bad/>) then undefined values are set to
+ the appropriate badvalue and the column is marked as bad.
+
+ DEFTYPE: Sets the default type of the columns - see the documentation for
+ L</rcols()>
+
+ TYPES: A reference to a Perl array with types for each column - see
+ the documentation for L</rcols()>
+
+ BUFFERSIZE: The number of lines to extend the piddle by. It might speed
+ up the reading a little bit by setting this to the number of lines in the
+ file, but in general L</rasc()> is a better choice
+
+Usage
+
+=for usage
+
+ ($x,$y,...) = rgrep(sub, *HANDLE|"filename")
+
+e.g.
+
+=for example
+
+ ($a,$b) = rgrep {/Foo (.*) Bar (.*) Mumble/} $file;
+
+i.e. the vectors C<$a> and C<$b> get the progressive values
+of C<$1>, C<$2> etc.
+
+=cut
+
+ sub rgrep (&@) {
+ barf 'Usage ($x,$y,...) = rgrep(sub, *HANDLE|"filename", [{OPTIONS}])'
+ if $#_ > 2;
+
+ my (@ret, at v,$nret); my ($m,$n)=(-1,0); # Count/PDL size
+ my $pattern = shift;
+
+ my $is_handle = _is_io_handle $_[0];
+ my $fh = $is_handle ? $_[0] : gensym;
+ open $fh, $_[0] or die "File $_[0] not found\n" unless $is_handle;
+
+ if (ref($pattern) ne "CODE") {
+ die "Got a ".ref($pattern)." for rgrep?!";
+ }
+
+
+ # set up default options
+ my $opt = new PDL::Options( {
+ DEFTYPE => $deftype,
+ TYPES => [],
+ UNDEFINED => $PDL::undefval,
+ BUFFERSIZE => 10000
+ } );
+ # Check if the user specified options
+ my $u_opt = $_[1] || {};
+ $opt->options( $u_opt);
+
+ my $options = $opt->current();
+
+ # If UNDEFINED is set to .*bad.* then undefined are set to
+ # bad - unless we have a Perl that is not compiled with Bad support
+ my $undef_is_bad = ($$options{UNDEFINED} =~ /bad/i);
+ if ($undef_is_bad && !$PDL::Bad::Status) {
+ carp "UNDEFINED cannot be set to Badvalue when PDL hasn't been compiled with Bad value support - \$PDL::undefval used instead\n";
+ $undef_is_bad = 0;
+ }
+ barf "Unknown PDL type given for DEFTYPE.\n"
+ unless ref($$options{DEFTYPE}) eq "PDL::Type";
+
+
+ while(<$fh>) {
+ next unless @v = &$pattern;
+
+ $m++; # Count got
+ if ($m==0) {
+ $nret = $#v; # Last index of values to return
+
+ # Handle various columns as in rcols - added 18/04/05
+ my @types = _handle_types( $nret, $$options{DEFTYPE}, $$options{TYPES} );
+ for (0..$nret) {
+ # Modified 18/04/05 to use specified precision.
+ $ret[$_] = [ PDL->zeroes($types[$_], 1), [] ];
+ }
+ } else { # perhaps should only carp once...
+ carp "Non-rectangular rgrep" if $nret != $#v;
+ }
+ if ($n<$m) {
+ for (0..$nret) {
+ _ext_lastD( $ret[$_]->[0], $$options{BUFFERSIZE} ); # Extend PDL in buffered manner
+ }
+ $n += $$options{BUFFERSIZE};
+ }
+ for(0..$nret) {
+ # Set values - '1*' is to ensure numeric
+ # We now (JB - 18/04/05) also check for defined values or not
+ # Ideally this should include Badvalue support..
+ if ($v[$_] eq '') {
+ # Missing value - let us treat this specially
+ if ($undef_is_bad) {
+ set $ret[$_]->[0], $m, $$options{DEFTYPE}->badvalue();
+ # And set bad flag on $ref[$_]!
+ $ret[$_]->[0]->badflag(1);
+ } else {
+ set $ret[$_]->[0], $m, $$options{UNDEFINED};
+ }
+ } else {
+ set $ret[$_]->[0], $m, 1*$v[$_];
+ }
+ }
+ }
+
+ close($fh) unless $is_handle;
+ for (@ret) { $_ = $_->[0]->slice("0:$m")->copy; }; # Truncate
+ wantarray ? return(@ret) : return $ret[0];
+}
+
+
+=head2 rdsa
+
+=for ref
+
+ Read a FIGARO/NDF format file.
+
+ Requires non-PDL DSA module. Contact Frossie (frossie at jach.hawaii.edu)
+
+Usage:
+
+=for usage
+
+ ([$xaxis],$data) = rdsa($file)
+
+=for example
+
+ $a = rdsa 'file.sdf'
+
+Not yet tested with PDL-1.9X versions
+
+=cut
+
+sub rdsa{PDL->rdsa(@_)}
+
+use vars qw/ $dsa_loaded /;
+sub PDL::rdsa {
+ my $class = shift;
+ barf 'Usage: ([$xaxis],$data) = rdsa($file)' if $#_!=0;
+ my $file = shift; my $pdl = $class->new; my $xpdl;
+ eval 'use DSA' unless $dsa_loaded++;
+ barf 'Cannot use DSA library' if $@ ne "";
+
+ my $status = 0;
+
+ # Most of this stuff stolen from Frossie:
+
+ dsa_open($status);
+ dsa_named_input('IMAGE',$file,$status);
+ goto skip if $status != 0;
+
+ dsa_get_range('IMAGE',my $vmin,my $vmax,$status);
+ my @data_dims;
+ dsa_data_size('IMAGE',5, my $data_ndims, \@data_dims, my $data_elements,
+ $status);
+ dsa_map_data('IMAGE','READ','FLOAT',my $data_address,my $data_slot,
+ $status);
+
+ @data_dims = @data_dims[0..$data_ndims-1];
+ print "Dims of $file = @data_dims\n" if $PDL::verbose;
+ $pdl->set_datatype($PDL_F);
+ $pdl->setdims([@data_dims]);
+ my $dref = $pdl->get_dataref;
+ mem2string($data_address,4*$data_elements,$$dref);
+ $pdl->upd_data();
+
+ if (wantarray) { # Map X axis values
+ my @axis_dims;
+ dsa_axis_size('IMAGE',1,5, my $axis_ndims, \@axis_dims,
+ my $axis_elements, $status);
+ dsa_map_axis_data('IMAGE',1,'READ','FLOAT',my $axis_address,
+ my $axis_slot,$status);
+ @axis_dims = @axis_dims[0..$axis_ndims-1];
+ $xpdl = $class->new;
+ $xpdl->set_datatype($PDL_F);
+ $xpdl->setdims([@axis_dims]);
+ my $xref = $xpdl->get_dataref;
+ mem2string($axis_address,4*$axis_elements,$$xref);
+ $xpdl->upd_data();
+ }
+
+ skip: dsa_close($status);
+
+ barf("rdsa: obtained DSA error") if $status != 0;
+
+ return ($xpdl,$pdl);
+}
+
+=head2 isbigendian
+
+=for ref
+
+ Determine endianness of machine - returns 0 or 1 accordingly
+
+=cut
+
+!NO!SUBS!
+
+# $isbigendian is set up at top of file
+pp_addpm( "sub PDL::isbigendian { return $isbigendian; };\n*isbigendian = \\&PDL::isbigendian;\n");
+pp_add_exported("", "isbigendian");
+
+################################ XS CODE ######################################
+
+sub defpdl {
+ pp_def(
+ $_[0],
+ Pars => $_[1],
+ OtherPars => $_[2],
+ Code => $_[3],
+ Doc => $_[4],
+ );
+}
+
+###### Read ASCII Function ##########
+pp_addhdr(<<'EOH');
+
+#define SWALLOWLINE(fp) while ((s = PerlIO_getc(fp)) != '\n' && s != EOF)
+#define TRAILING_WHITESPACE_CHECK(s) \
+ if (s!=' ' && s!='\t' && s!='\r' && s!='\n' && s!=',') return -1
+
+int getfloat(PerlIO *fp, PDL_Float *fz)
+{
+ PDL_Float f = 0;
+ int nread = 0;
+ int i, s = PerlIO_getc(fp);
+ int afterp = 0, aftere=0;
+ int expo = 0;
+ PDL_Float sig = 1.0, esig = 1.0;
+ PDL_Float div = 1.0;
+
+ if (s == EOF) return 0;
+ while (1) {
+ if (s == EOF)
+ return 0; /* signal end of line */
+ if (s == '#')
+ SWALLOWLINE(fp);
+ if ((s >='0' && s <='9') || s =='.' || s == 'e' || s == 'E'
+ || s == '+' || s == '-') break;
+ if (s!=' ' && s!='\t' && s!='\r' && s!='\n' && s!=',')
+ return -1; /* garbage */
+ s = PerlIO_getc(fp); /* else skip whitespace */
+ }
+ /* parse number */
+ while (1) {
+ switch (s) {
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ if (aftere)
+ expo = (expo*10) + (s - '0');
+ else if (afterp) {
+ div /= 10.0;
+ f += div*(s - '0');
+ } else
+ f = (f*10) + (s - '0');
+ break;
+ case '+':
+ /* ignore */
+ break;
+ case '-':
+ if (aftere)
+ esig = -1;
+ else
+ sig = -1;
+ break;
+ case 'e':
+ case 'E':
+ if (aftere)
+ return -1;
+ aftere = 1;
+ break;
+ case '.':
+ if (afterp || aftere)
+ return -1;
+ afterp = 1;
+ break;
+ default:
+ goto endread;
+ break;
+ }
+ nread++;
+ s = PerlIO_getc(fp);
+ }
+endread:
+ f *= sig;
+ for (i=0;i<expo; i++)
+ f *= (esig > 0 ? 10.0 : 0.1);
+
+ *fz = f;
+ TRAILING_WHITESPACE_CHECK(s);
+ return nread;
+}
+
+int getdouble(PerlIO *fp, PDL_Double *fz)
+{
+ PDL_Double f = 0;
+ int nread = 0;
+ int i, s = PerlIO_getc(fp);
+ int afterp = 0, aftere=0;
+ int expo = 0;
+ PDL_Double sig = 1.0, esig = 1.0;
+ PDL_Double div = 1.0;
+
+ if (s == EOF) return 0;
+ while (1) {
+ if (s == EOF)
+ return 0; /* signal end of line */
+ if (s == '#')
+ SWALLOWLINE(fp);
+ if ((s >='0' && s <='9') || s =='.' || s == 'e' || s == 'E'
+ || s == '+' || s == '-') break;
+ if (s!=' ' && s!='\t' && s!='\r' && s!='\n' && s!=',')
+ return -1; /* garbage */
+ s = PerlIO_getc(fp); /* else skip whitespace */
+ }
+ /* parse number */
+ while (1) {
+ switch (s) {
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
+ if (aftere)
+ expo = (expo*10) + (s - '0');
+ else if (afterp) {
+ div /= 10.0;
+ f += div*(s - '0');
+ } else
+ f = (f*10) + (s - '0');
+ break;
+ case '+':
+ /* ignore */
+ break;
+ case '-':
+ if (aftere)
+ esig = -1;
+ else
+ sig = -1;
+ break;
+ case 'e':
+ case 'E':
+ if (aftere)
+ return -1;
+ aftere = 1;
+ break;
+ case '.':
+ if (afterp || aftere)
+ return -1;
+ afterp = 1;
+ break;
+ default:
+ goto endread;
+ break;
+ }
+ nread++;
+ s = PerlIO_getc(fp);
+ }
+endread:
+ f *= sig;
+ for (i=0;i<expo; i++)
+ f *= (esig > 0 ? 10.0 : 0.1);
+
+ *fz = f;
+ TRAILING_WHITESPACE_CHECK(s);
+ return nread;
+}
+
+EOH
+
+pp_add_exported('', 'rasc rcube');
+pp_addpm(<<'EOPM');
+
+
+=head2 rasc
+
+=for ref
+
+ Simple function to slurp in ASCII numbers quite quickly,
+ although error handling is marginal (to nonexistent).
+
+=for usage
+
+ $pdl->rasc("filename"|FILEHANDLE [,$noElements]);
+
+ Where:
+ filename is the name of the ASCII file to read or open file handle
+ $noElements is the optional number of elements in the file to read.
+ (If not present, all of the file will be read to fill up $pdl).
+ $pdl can be of type float or double (for more precision).
+
+=for example
+
+ # (test.num is an ascii file with 20 numbers. One number per line.)
+ $in = PDL->null;
+ $num = 20;
+ $in->rasc('test.num',20);
+ $imm = zeroes(float,20,2);
+ $imm->rasc('test.num');
+
+=cut
+
+sub rasc {PDL->rasc(@_)}
+sub PDL::rasc {
+ use IO::File;
+ my ($pdl, $file, $num) = @_;
+ $num = -1 unless defined $num;
+ my $fi = $file;
+ my $is_openhandle = defined fileno $fi ? 1 : 0;
+ unless ($is_openhandle) {
+ barf 'usage: rasc $pdl, "filename"|FILEHANDLE, [$num_to_read]'
+ if !defined $file || ref $file;
+ $fi = new IO::File "<$file" or barf "Can't open $file";
+ }
+ $pdl->_rasc(my $ierr=null,$num,$fi);
+ close $fi unless $is_openhandle;
+ return all $ierr > 0;
+}
+
+# ----------------------------------------------------------
+
+=head2 rcube
+
+=for ref
+
+ Read list of files directly into a large data cube (for efficiency)
+
+=for usage
+
+ $cube = rcube \&reader_function, @files;
+
+=for example
+
+ $cube = rcube \&rfits, glob("*.fits");
+
+This IO function allows direct reading of files into a large data cube,
+Obviously one could use cat() but this is more memory efficient.
+
+The reading function (e.g. rfits, readfraw) (passed as a reference)
+and files are the arguments.
+
+The cube is created as the same X,Y dims and datatype as the first
+image specified. The Z dim is simply the number of images.
+
+=cut
+
+sub rcube {
+
+ my $reader = shift;
+
+ barf "Usage: blah" unless ref($reader) eq "CODE";
+
+ my $k=0;
+ my ($im,$cube,$tmp,$nx,$ny);
+ my $nz = scalar(@_);
+
+ for my $file (@_) {
+ print "Slice ($k) - reading file $file...\n" if $PDL::verbose;
+ $im = &$reader($file);
+ ($nx, $ny) = dims $im;
+ if ($k == 0) {
+ print "Creating $nx x $ny x $nz cube...\n" if $PDL::verbose;
+ $cube = $im->zeroes($im->type,$nx,$ny,$nz);
+ }
+ else {
+ barf "Dimensions do not match for file $file!\n" if
+ $im->getdim(0) != $nx or $im->getdim(1) != $ny ;
+
+ }
+ $tmp = $cube->slice(":,:,($k)");
+ $tmp .= $im;
+ $k++;
+ }
+
+ return $cube;
+}
+
+
+EOPM
+
+# in the future this function should return a state indicating an error
+# if appropriate
+pp_def('_rasc',
+ Pars => '[o] nums(n); int [o] ierr(n)',
+ OtherPars => 'int num => n; SV* fd',
+ GenericTypes => [F,D],
+ Code => q@
+ int ns, i, j;
+ PerlIO *fp;
+ IO *io;
+
+ /* io = GvIO(gv_fetchpv($COMP(fd),FALSE,SVt_PVIO)); */
+ io = sv_2io($COMP(fd));
+ if (!io || !(fp = IoIFP(io)))
+ croak("Can\'t figure out FP");
+ ns = $SIZE(n);
+ threadloop %{
+ for (i=0;i<ns; i++) {
+ if (($ierr(n=>i) =
+ $TFD(getfloat,getdouble)(fp, &($nums(n=>i)))) <= 0)
+ break;
+ }
+ for (j=i+1; j<ns; j++)
+ $ierr(n=>j) = $ierr(n=>i); /* inherit error flags */
+ %}
+ @,
+# Doc => 'Internal Function used by rasc. '
+ Doc => undef,
+);
+
+
+
+pp_done();
+
+
diff --git a/IO/Pnm/Makefile.PL b/IO/Pnm/Makefile.PL
new file mode 100644
index 0000000..29d538a
--- /dev/null
+++ b/IO/Pnm/Makefile.PL
@@ -0,0 +1,20 @@
+
+# Makefile.PL for PDL::IO module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+ at pack = (["pnm.pd",Pnm,PDL::IO::Pnm]);
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{'PM'}->{'Pic.pm'} = '$(INST_LIBDIR)/Pic.pm';
+WriteMakefile(%hash);
+
+# Add genpp rule
+sub MY::postamble { pdlpp_postamble_int(@::pack); }
+
+
diff --git a/IO/Pnm/Pic.pm b/IO/Pnm/Pic.pm
new file mode 100644
index 0000000..adbab7b
--- /dev/null
+++ b/IO/Pnm/Pic.pm
@@ -0,0 +1,1024 @@
+=head1 NAME
+
+PDL::IO::Pic -- image I/O for PDL
+
+=head1 DESCRIPTION
+
+=head2 Image I/O for PDL based on the netpbm package.
+
+This package implements I/O for a number of popular image formats
+by exploiting the xxxtopnm and pnmtoxxx converters from the netpbm package
+(which is based on the original pbmplus by Jef Poskanzer).
+
+Netpbm is available at
+ftp://wuarchive.wustl.edu/graphics/graphics/packages/NetPBM/
+Pbmplus (on which netpbm is based) might work as well, I haven't tried it.
+If you want to read/write JPEG images you additionally need the two
+converters cjpeg/djpeg which come with the libjpeg distribution (the
+"official" archive site for this software is L<ftp://ftp.uu.net/graphics/jpeg>).
+
+Image I/O for all formats is established by reading and writing only
+the PNM format directly while the netpbm standalone apps take care of
+the necessary conversions. In accordance with netpbm parlance PNM stands
+here for 'portable any map' meaning any of the PBM/PGM/PPM formats.
+
+As it appeared to be a reasonable place this package also contains the
+routine wmpeg to write mpeg movies from PDLs representing image
+stacks (the image stack is first written as a sequence of PPM images into some
+temporary directory). For this to work you need the program ffmpeg also.
+
+=cut
+
+package PDL::IO::Pic;
+
+
+ at EXPORT_OK = qw( wmpeg rim wim rpic wpic rpiccan wpiccan );
+
+%EXPORT_TAGS = (Func => [@EXPORT_OK]);
+use PDL::Core;
+use PDL::Exporter;
+use PDL::Types;
+use PDL::ImageRGB;
+use PDL::IO::Pnm;
+use PDL::Options;
+use PDL::Config;
+use File::Basename;
+use SelfLoader;
+use File::Spec;
+
+use strict;
+use vars qw( $Dflags @ISA %converter );
+
+ at ISA = qw( PDL::Exporter );
+
+
+=head2 Configuration
+
+The executables from the netpbm package are assumed to be in your path.
+Problems in finding the executables may show up as PNM format
+errors when calling wpic/rpic. If you run into this kind of problem run
+your program with perl C<-w> so that perl prints a message if it can't find
+the filter when trying to open the pipe. [']
+
+=cut
+
+
+# list of converters by type
+# might get more fields in the future to provide a generic representation
+# of common flags like COMPRESSION, LUT, etc which would hold the correct
+# flags for the particular converter or NA if not supported
+# conventions:
+# NONE we need no converter (directly supported format)
+# NA feature not available
+# 'whatevertopnm' name of the executable
+# The 'FLAGS' key must be used if the converter needs other flags than
+# the default flags ($Dflags)
+#
+#
+# The "referral" field, if present, contains a within-perl referral
+# to other methods for reading/writing the PDL as that type of file. The
+# methods must have the same syntax as wpic/rpic (e.g. wfits/rfits).
+#
+
+$PDL::IO::Pic::debug = $PDL::IO::Pic::debug || 0;
+&init_converter_table();
+
+# setup functions
+
+sub init_converter_table {
+ # default flag to be used with any converter unless overridden with FLAGS
+ $Dflags = '';
+ %converter = ();
+
+ # Pbmplus systems have cjpeg/djpeg; netpbm systems have pnmtojpeg and
+ # jpegtopnm.
+
+ my $jpeg_conv='';
+
+ {
+ my @path = File::Spec->path();
+ my $ext = $^O =~ /MSWin/i ? '.exe' : '';
+ local $_;
+ my $pbmplus;
+
+ for (@path) {
+ $jpeg_conv="cjpeg" if ( -x "$_/cjpeg" . $ext );
+ $jpeg_conv="pnmtojpeg" if ( -x "$_/pnmtojpeg" . $ext );
+ }
+ }
+
+ my @normal = qw/TIFF SGI RAST PCX PNG/;
+ push(@normal,"JPEG") if($jpeg_conv eq 'pnmtojpeg');
+
+ for (@normal)
+ { my $conv = lc; $converter{$_} = {put => "pnmto$conv",
+ get => "$conv".'topnm'} }
+
+ my @special = (['PNM','NONE','NONE'],
+ ['PS','pnmtops -dpi=100',
+ 'pstopnm -stdout -xborder=0 -yborder=0 -quiet -dpi=100'],
+ ['GIF','ppmtogif','giftopnm'],
+ ['IFF','ppmtoilbm','ilbmtoppm']
+ );
+ push(@special,['JPEG', 'cjpeg' ,'djpeg'])
+ if($jpeg_conv eq 'cjpeg');
+
+ for(@special) {
+ $converter{$_->[0]} = {put => $_->[1],
+ get => $_->[2]}
+ }
+
+ $converter{'FITS'}={ 'referral' => {'put' => \&PDL::wfits, 'get' => \&PDL::rfits} };
+
+ # these converters do not understand pbmplus flags:
+ $converter{'JPEG'}->{FLAGS} = '';
+ $converter{'GIF'}->{Prefilt} = 'ppmquant 256 |';
+
+
+ my $key;
+ for $key (keys %converter) {
+
+ $converter{$key}->{Rok} = inpath($converter{$key}->{'get'})
+ if defined($converter{$key}->{'get'});
+
+ $converter{$key}->{Wok} = inpath($converter{$key}->{'put'})
+ if defined($converter{$key}->{'put'});
+
+ if (defined $converter{$key}->{Prefilt}) {
+ my $filt = $1 if $converter{$key}->{Prefilt} =~ /^\s*(\S+)\s+/;
+ $converter{$key}->{Wok} = inpath($filt) if $converter{$key}->{Wok};
+ }
+ }
+
+ $PDL::IO::Pic::biggrays = &hasbiggrays();
+ print "using big grays\n" if $PDL::IO::Pic::debug &&
+ $PDL::IO::Pic::biggrays;
+
+ for (keys %converter) {
+ $converter{$_}->{ushortok} = $PDL::IO::Pic::biggrays ?
+ (m/GIF/ ? 0 : 1) : (m/GIF|RAST|IFF/ ? 0 : 1);
+ }
+}
+
+sub inpath {
+ my ($prog) = @_;
+ my $pathsep = $^O =~ /win32/i ? ';' : ':';
+ my $exe = $^O =~ /win32/i ? '.exe' : '';
+ for(split $pathsep,$ENV{PATH}){return 1 if -x "$_/$prog$exe" || $prog =~ /^NONE$/}
+ return 0;
+}
+
+
+sub hasbiggrays {
+ my ($checked,$form) = (0,'');
+ require IO::File;
+ for (&rpiccan()) { next if /^PNM$/; $form = $_; $checked=1; last }
+ unless ($checked) {
+ warn "PDL::IO::Pic - couldn't find any pbm converter"
+ if $PDL::IO::Pic::debug;
+ return 0;
+ }
+ *SAVEERR = *SAVEERR; # stupid fix to shut up -w (AKA pain-in-the-...-flag)
+ open(SAVEERR, ">&STDERR");
+ my $tmp = new_tmpfile IO::File or barf "couldn't open tmpfile";
+ my $pos = $tmp->getpos;
+ my $txt;
+ { local *IN;
+ *IN = *$tmp; # doesn't seem to work otherwise
+ open(STDERR,">&IN") or barf "couldn't redirect stdder";
+
+ system("$converter{$form}->{get} -version");
+ open(STDERR, ">&PDL::IO::Pic::SAVEERR");
+ $tmp->setpos($pos); # rewind
+ $txt = join '',<IN>;
+ close IN; undef $tmp;
+ }
+ return ($txt =~ /PGM_BIGGRAYS/);
+}
+
+=head1 FUNCTIONS
+
+=head2 rpiccan, wpiccan
+
+=for ref
+
+Test which image formats can be read/written
+
+=for example
+
+ $im = PDL->rpic('PDL.jpg') if PDL->rpiccan('JPEG');
+ @wformats = PDL->wpiccan();
+
+finds out if PDL::IO::Pic can read/write certain image formats.
+When called without arguments returns a list of supported
+formats. When called with an argument returns true if format
+is supported on your computer (requires appropriate filters in
+your path), false otherwise.
+
+=cut
+
+sub rpiccan {return PDL->rpiccan(@_)}
+sub wpiccan {return PDL->wpiccan(@_)}
+sub PDL::rpiccan {splice @_,1,0,'R';
+ return PDL::IO::Pic::piccan(@_)}
+sub PDL::wpiccan {splice @_,1,0,'W';
+ return PDL::IO::Pic::piccan(@_)}
+
+
+=head2 rpic
+
+=for ref
+
+Read images in many formats with automatic format detection.
+
+=for example
+
+ $im = rpic $file;
+ $im = PDL->rpic 'PDL.jpg' if PDL->rpiccan('JPEG');
+
+I<Options>
+
+=for opt
+
+ FORMAT => 'JPEG' # explicitly read this format
+ XTRAFLAGS => '-nolut' # additional flags for converter
+
+Reads image files in most of the formats supported by netpbm. You can
+explicitly specify a supported format by additionally passing a hash
+containing the FORMAT key as in
+
+ $im = rpic ($file, {FORMAT => 'GIF'});
+
+This is especially useful if the particular format isn't identified by
+a magic number and doesn't have the 'typical' extension or you want to
+avoid the check of the magic number if your data comes in from a pipe.
+The function returns a pdl of the appropriate type upon completion.
+Option parsing uses the L<PDL::Options|PDL::Options> module and
+therefore supports minimal options matching.
+
+You can also read directly into an existing pdl that has to have the
+right size(!). This can come in handy when you want to read a sequence
+of images into a datacube, e.g.
+
+ $stack = zeroes(byte,3,500,300,4);
+ rpic $stack->slice(':,:,:,(0)'),"PDL.jpg";
+
+reads an rgb image (that had better be of size (500,300)) into the
+first plane of a 3D RGB datacube (=4D pdl datacube). You can also do
+transpose/inversion upon read that way.
+
+=cut
+
+my $rpicopts = {
+ FORMAT => undef,
+ XTRAFLAGS => undef,
+ };
+
+sub rpic {PDL->rpic(@_)}
+
+sub PDL::rpic {
+ barf 'Usage: $im = rpic($file[,hints]) or $im = PDL->rpic($file[,hints])'
+ if $#_<0;
+ my ($class,$file,$hints,$maybe) = @_;
+ my ($type, $pdl);
+
+ if (ref($file)) { # $file is really a pdl in this case
+ $pdl = $file;
+ $file = $hints;
+ $hints = $maybe;
+ } else {
+ $pdl = $class->initialize;
+ }
+
+ $hints = { iparse $rpicopts, $hints } if ref $hints;
+ if (defined($$hints{'FORMAT'})) {
+ $type = $$hints{'FORMAT'};
+ barf "unsupported (input) image format"
+ unless (exists($converter{$type}) &&
+ $converter{$type}->{'get'} !~ /NA/);
+ }
+ else {
+ $type = chkform($file);
+ barf "can't figure out file type, specify explicitly"
+ if $type =~ /UNKNOWN/; }
+
+ my($converter) = $PDL::IO::Pic::converter;
+ if (defined($converter{$type}->{referral})) {
+ if(ref ($converter{$type}->{referral}->{'get'}) eq 'CODE') {
+ return &{$converter{$type}->{referral}->{'get'}}(@_);
+ } else {
+ barf "rpic: internal error with referral (format is $type)\n";
+ }
+ }
+
+ my $flags = $converter{$type}->{FLAGS};
+ $flags = "$Dflags" unless defined($flags);
+ $flags .= " $$hints{XTRAFLAGS}" if defined($$hints{XTRAFLAGS});
+ my $cmd = "$converter{$type}->{get} $flags $file |";
+ $cmd = $file if $converter{$type}->{'get'} =~ /^NONE/;
+
+ print("conversion by '$cmd'\n") if $PDL::IO::Pic::debug > 10;
+
+ return rpnm($pdl,$cmd);
+}
+
+=head2 wpic
+
+=for ref
+
+Write images in many formats with automatic format selection.
+
+=for usage
+
+ Usage: wpic($pdl,$filename[,{ options... }])
+
+=for example
+
+ wpic $pdl, $file;
+ $im->wpic('web.gif',{LUT => $lut});
+ for (@images) {
+ $_->wpic($name[0],{CONVERTER => 'ppmtogif'})
+ }
+
+
+Write out an image file. Function will try to guess correct image
+format from the filename extension, e.g.
+
+ $pdl->wpic("image.gif")
+
+will write a gif file. The data written out will be scaled to byte if
+input is of type float/double. Input data that is of a signed integer
+type and contains negative numbers will be rejected (assuming the user
+should have the desired conversion to an unsigned type already). A number
+of options can be specified (as a hash reference) to get more direct control of
+the image format that is being written. Valid options are (key
+=> example_value):
+
+=for options
+
+ CONVERTER => 'ppmtogif', # explicitly specify pbm converter
+ FLAGS => '-interlaced -transparent 0', # flags for converter
+ IFORM => 'PGM', # explicitly specify intermediate format
+ XTRAFLAGS => '-imagename iris', # additional flags to defaultflags
+ FORMAT => 'PCX', # explicitly specify output image format
+ COLOR => 'bw', # specify color conversion
+ LUT => $lut, # use color table information
+
+Option parsing uses the L<PDL::Options|PDL::Options> module and
+therefore supports minimal options matching. A detailed explanation of
+supported options follows.
+
+=over 7
+
+=item CONVERTER
+
+directly specify the converter,
+you had better know what you are doing, e.g.
+
+ CONVERTER => 'ppmtogif',
+
+=item FLAGS
+
+flags to use with the converter;
+ignored if !defined($$hints{CONVERTER}), e.g. with the gif format
+
+ FLAGS => '-interlaced -transparent 0',
+
+=item IFORM
+
+intermediate PNM/PPM/PGM/PBM format to use;
+you can append the strings 'RAW' or 'ASCII'
+to enforce those modes, eg IFORMAT=>'PGMRAW' or
+
+ IFORM => 'PGM',
+
+=item XTRAFLAGS
+
+additional flags to use with an automatically chosen
+converter, this example works when you write SGI
+files (but will give an error otherwise)
+
+ XTRAFLAGS => '-imagename iris',
+
+=item FORMAT
+
+explicitly select the format you want to use. Required if wpic cannot
+figure out the desired format from the file name extension. Supported
+types are currently TIFF,GIF,SGI,PNM,JPEG,PS,RAST(Sun Raster),IFF,PCX,
+e.g.
+
+ FORMAT => 'PCX',
+
+=item COLOR
+
+you want black and white (value B<bw>), other possible value is
+B<bwdither> which will write a dithered black&white
+image from the input data, data conversion will be done appropriately,
+e.g.
+
+ COLOR => 'bw',
+
+=item LUT
+
+This is a palette image and the value of this key should be a
+pdl containg an RGB lookup table (3,x), e.g.
+
+ LUT => $lut,
+
+=back
+
+Using the CONVERTER hint you can also build a pipe and perform
+several netpbm operations to get the special result you like. Using it
+this way the first converter/filecommand in the pipe should be
+specified with the CONVERTER hint and subsequent converters + flags in
+the FLAGS hint. This is because wpic tries to figure out the required
+format to be written by wpnm based on the first converter. Be careful when
+using the PBMBIN var as it will only be prepended to the converter. If more
+converters are in the FLAGS part specify the full path unless they are in
+your PATH anyway.
+
+Example:
+
+ $im->wpic('test.ps',{CONVERTER => 'pgmtopbm',
+ FLAGS => "-dither8 | pnmtops" })
+
+Some of the options may appear silly at the moment and probably
+are. The situation will hopefully improve as people use the code and
+the need for different/modified options becomes clear. The general
+idea is to make the function perl compliant: easy things should be
+easy, complicated tasks possible.
+
+=cut
+
+my %wpicopts = map {($_ => undef)}
+ qw/IFORM CONVERTER FLAGS FORMAT
+ XTRAFLAGS COLOR LUT/;
+my $wpicopts = \%wpicopts;
+
+*wpic = \&PDL::wpic;
+
+sub PDL::wpic {
+ barf 'Usage: wpic($pdl,$filename[,$hints]) ' .
+ 'or $pdl->wpic($filename,[,$hints])' if $#_<1;
+
+ my ($pdl,$file,$hints) = @_;
+ my ($type, $cmd, $form,$iform,$iraw);
+
+ $hints = {iparse($wpicopts, $hints)} if ref $hints;
+ # figure out the right converter
+ my ($conv, $flags, $format, $referral) = getconv($pdl,$file,$hints);
+
+ if(defined($referral)) {
+ if(ref ($referral->{'put'}) eq 'CODE') {
+ return &{$referral->{'put'}}(@_);
+ } else {
+ barf "wpic: internal error with referral (format is $format)\n";
+ }
+ }
+
+ print "Using the command $conv with the flags $flags\n"
+ if $PDL::IO::Pic::debug>10;
+
+ if (defined($$hints{IFORM})) {
+ $iform = $$hints{IFORM}; }
+ else { # check if converter requires a particular intermediate format
+ $iform = 'PPM' if $conv =~ /^\s*(ppm)|(cjpeg)/;
+ $iform = 'PGM' if $conv =~ /^\s*pgm/;
+ $iform = 'PBM' if $conv =~ /^\s*pbm/;
+ $iform = 'PNM' if $conv =~ /^\s*(pnm)|(NONE)/; }
+ # get final values for $iform and $pdl (check conversions, consistency,etc)
+ ($pdl,$iform) = chkpdl($pdl,$iform,$hints,$format);
+ print "using intermediate format $iform\n" if $PDL::IO::Pic::debug>10;
+
+ $cmd = "|" . "$conv $flags >$file";
+ $cmd = ">" . $file if $conv =~ /^NONE/;
+ print "built the command $cmd to write image\n" if $PDL::IO::Pic::debug>10;
+
+ $iraw = 1 if (defined($$hints{IFORM}) && $$hints{IFORM} =~ /RAW/);
+ $iraw = 0 if (defined($$hints{IFORM}) && $$hints{IFORM} =~ /ASCII/);
+
+ local $SIG{PIPE}= sub {}; # Prevent crashing if converter dies
+
+ wpnm($pdl, $cmd, $iform , $iraw);
+}
+
+=head2 rim
+
+=for usage
+
+ Usage: $a = rim($file);
+ or rim($a,$file);
+
+=for ref
+
+Read images in most formats, with improved RGB handling.
+
+You specify a filename and get back a PDL with the image data in it.
+Any PNM handled format or FITS will work. In the second form, $a is an
+existing PDL that gets loaded with the image data.
+
+If the image is in one of the standard RGB formats, then you get back
+data in (<X>,<Y>,<RGB-index>) format -- that is to say, the third dim
+contains the color information. That allows you to do simple indexing
+into the image without knowing whether it is color or not -- if present,
+the RGB information is silently threaded over. (Contrast L<rpic|rpic>, which
+munges the information by putting the RGB index in the 0th dim, screwing
+up subsequent threading operations).
+
+If the image is in FITS format, then you get the data back in exactly
+the same order as in the file itself.
+
+Images with a ".Z" or ".gz" extension are assumed to be compressed with
+UNIX L<"compress"|compress> or L<"gzip"|gzip>, respecetively, and are
+automatically uncompressed before reading.
+
+OPTIONS
+
+The same as L<rpic|rpic>, which is used as an engine:
+
+=over 3
+
+=item FORMAT
+
+If you don't specify this then formats are autodetected. If you do specify
+it then only the specified interpreter is tried. For example,
+
+ $a = rim("foo.gif",{FORMAT=>"JPEG"})
+
+forces JPEG interpretation.
+
+=item XTRAFLAGS
+
+Contains extra command line flags for the pnm interpreter. For example,
+
+ $a = rim("foo.jpg",{XTRAFLAGS=>"-nolut"})
+
+prevents use of a lookup table in JPEG images.
+
+=back
+
+=cut
+
+use PDL::IO::Pic;
+
+sub rim {
+ my(@args) = @_;
+
+ my $out;
+
+ ## Handle dest-PDL-first case
+ if(@args >= 2 and (UNIVERSAL::isa($args[0],'PDL'))) {
+ my $dest = shift @args;
+ my $rpa = PDL->null;
+ $out = rpic(@args);
+
+ if($out->ndims == 3 && $out->dim(0) == 3 &&
+ !( defined($out->gethdr) && $out->gethdr->{SIMPLE} )
+ ) {
+ $out = $out->reorder(1,2,0);
+ }
+
+ $dest .= $out;
+ return $out;
+ }
+
+ # Handle no-first-PDL case
+ $out = rpic(@args);
+
+ if($out->ndims == 3 && $out->dim(0) == 3 &&
+ !( defined($out->gethdr) && $out->gethdr->{SIMPLE} )
+ ) {
+ return $out->reorder(1,2,0);
+ }
+
+ $out;
+}
+
+
+
+=head2 wim
+
+=for ref
+
+Write a pdl to an image file with selected type (or using filename extensions)
+
+=for usage
+
+ wim $pdl,$file;
+ $pdl->wim("foo.gif",{LUT=>$lut});
+
+Write out an image file. You can specify the format explicitly as an
+option, or the function will try to guess the correct image
+format from the filename extension, e.g.
+
+ $pdl->wim("image.gif");
+ $pdl->wim("image.fits");
+
+will write a gif and a FITS file. The data written out will be scaled
+to byte if the input if of type float/double. Input data that is of a
+signed integer type and contains negative numbers will be rejected.
+
+If you append C<.gz> or C<.Z> to the end of the file name, the final
+file will be automatically compresed with L<"gzip"|gzip> |
+L<"compress"|compress>, respectively.
+
+OPTIONS
+
+You can pass in a hash ref whose keys are options. The code uses the
+PDL::Options module so unique abbreviations are accepted. Accepted
+keys are the same as for L<wpic|wpic>, which is used as an engine:
+
+=over 3
+
+=item CONVERTER
+
+Names the converter program to be used by pbmplus (e.g. "ppmtogif" to
+output a gif file)
+
+=item FLAGS
+
+Flags that should be passed to the converter (replacing any default flag list)
+e.g. "-interlaced" to make an interlaced GIF
+
+=item IFORM
+
+Explicitly specifies the intermediate format (e.g. PGM, PPM, or PNM).
+
+=item XTRAFLAGS
+
+Flags that should be passed to the converter (in addition to any default
+flag list).
+
+=item FORMAT
+
+Explicitly specifies the output image format (allowing pbmplus to pick an
+output converter)
+
+=item COLOR
+
+Specifies color conversion (e.g. 'bw' converts to black-and-white; see
+L<pbmplus> for details).
+
+=item LUT
+
+Use color-table information
+
+=back
+
+=cut
+
+*wim = \&PDL::wim;
+
+sub PDL::wim {
+ my(@args) = @_;
+
+ my($im) = $args[0];
+
+ $args[0] = $im->reorder(2,0,1)
+ if( $im->ndims == 3
+ and $im->dim(2)==3
+ and !(
+ ( $args[1] =~ m/\.fits$/i )
+ or
+ ( ref $args[2] eq 'HASH' and $args[2]->{FORMAT} =~ m/fits/i )
+ )
+ );
+
+ wpic(@args);
+}
+
+=head2 wmpeg
+
+=for ref
+
+Write an image sequence (a (3,x,y,n) byte pdl) as an animation.
+
+=for usage
+
+ $piddle->wmpeg('movie.mpg'); # $piddle is (3,x,y,nframes) byte
+
+Writes a stack of RGB images as a movie. While the
+format generated is nominally MPEG, the file extension
+is used to determine the video encoder type.
+
+ E.g.:
+ .mpg for MPEG-1 encoding
+ .mp4 for MPEG-4 encoding
+
+ And even:
+ .gif for GIF animation (uncompressed)
+
+C<wmpeg> requires a 4-D pdl of type B<byte> as
+input. The first dim B<has> to be of size 3 since
+it will be interpreted as RGB pixel data.
+C<wmpeg> returns 1 on success and undef on failure.
+
+=for example
+
+ $anim->wmpeg("GreatAnimation.mpg")
+ or die "can't create mpeg1 output";
+
+ $anim->wmpeg("GreatAnimation.mp4")
+ or die "can't create mpeg4 output";
+
+Some of the input data restrictions will have to
+be relaxed in the future but routine serves as
+a proof of principle at the moment. It uses the
+program ffmpeg to encode the frames into video.
+The arguments and parameters used for ffmpeg have
+not been tuned. This is a first implementation
+replacing mpeg_encode by ffmpeg. Currently, wmpeg
+doesn't allow modification of the parameters
+written through its calling interface. This will
+change in the future as needed.
+
+In the future it might be much nicer to implement
+a movie perl object that supplies methods for
+manipulating the image stack (insert, cut, append
+commands) and a final movie->make() call would
+invoke ffmpeg on the picture stack (which will
+only be held on disk). This should get around the
+problem of having to hold a huge amount of data
+in memory to be passed into wmpeg (when you are,
+e.g. writing a large animation from PDL3D rendered
+fly-throughs).
+
+Having said that, the actual storage requirements
+might not be so big in the future any more if
+you could pass 'virtual' transform pdls into
+wmpeg that will only be actually calculated when
+accessed by the wpic routines, you know what I
+mean...
+
+
+=cut
+
+*wmpeg = \&PDL::wmpeg;
+
+sub PDL::wmpeg {
+ barf 'Usage: wmpeg($pdl,$filename) ' .
+ 'or $pdl->wmpeg($filename)' if $#_ != 1;
+
+ my ($pdl,$file) = @_;
+
+ # return undef if no ffmpeg in path
+ if (! inpath('ffmpeg')) {
+ warn("wmpeg: ffmpeg not found in PATH");
+ return;
+ }
+
+ my @Dims = $pdl->dims;
+ # too strict in general but alright for the moment
+ # especially restriction to byte will have to be relaxed
+ barf "input must be byte (3,x,y,z)" if (@Dims != 4) || ($Dims[0] != 3)
+ || ($pdl->get_datatype != $PDL_B);
+ my $nims = $Dims[3];
+ my $tmp = gettmpdir();
+
+ # get tmpdir for parameter file
+ # see PDL-2.4.6 version for original code
+
+ # check the pdl for correct dimensionality
+
+ # write all the images as ppms and write the appropriate parameter file
+ my ($i,$fname);
+ # add blank cells to each image to fit with 16N x 16N mpeg standard
+ # $frame is full frame, insert each image in as $inset
+ my (@MDims) = (3,map(16*int(($_+15)/16), at Dims[1..2]));
+ my ($frame) = zeroes(byte, at MDims);
+ my ($inset) = $frame->slice(join(',',
+ map(int(($MDims[$_]-$Dims[$_])/2).':'.
+ int(($MDims[$_]+$Dims[$_])/2-1),0..2)));
+ my $range = sprintf "[%d-%d]",0,$nims-1;
+ local $SIG{PIPE} = 'IGNORE';
+ open MPEG, "| ffmpeg -f image2pipe -vcodec ppm -i - $file"
+ or barf "spawning ffmpeg failed: $?";
+ binmode MPEG;
+ # select ((select (MPEG), $| = 1)[0]); # may need for win32
+ my (@slices) = $pdl->dog;
+ for ($i=0; $i<$nims; $i++) {
+ local $PDL::debug = 1;
+ print STDERR "Writing frame $i, " . $frame->slice(':,:,-1:0')->clump(2)->info . "\n";
+ $inset .= $slices[$i];
+ print MPEG "P6\n$MDims[1] $MDims[2]\n255\n";
+ pnmout($frame->slice(':,:,-1:0')->clump(2), 1, 0, 'PDL::IO::Pic::MPEG');
+ }
+ # clean up
+ close MPEG;
+
+ # rm tmpdir and files if needed
+ return 1;
+}
+
+
+
+1; # Return OK status
+
+__DATA__
+
+# SelfLoaded code
+
+sub piccan {
+ my $class = shift;
+ my $rw = (shift =~ /r/i) ? 'Rok' : 'Wok';
+ if ($#_ > -1) {
+ my $format = shift;
+ barf 'unknown format' unless defined($converter{$format});
+ return $converter{$format}->{$rw};
+ } else {
+ my @formats = ();
+ for (keys %converter) {push @formats, $_ if $converter{$_}->{$rw}}
+ return @formats;
+ }
+}
+
+sub getext {
+# changed to a more os independent way
+ my $file = shift;
+ my ($base,$dir,$ext) = fileparse($file,'\.[^.]*');
+ $ext = $1 if $ext =~ /^.([^;]*)/; # chop off VMS version numbers
+ return $ext;
+}
+
+# try to figure out the format of a supposed image file from the extension
+# a couple of extensions are only checked when the optional parameter
+# $wmode is set (because those should have been identified by magic numbers
+# when reading)
+# todo: check completeness
+sub chkext {
+ my ($ext,$wmode) = @_;
+ $wmode = 0 unless defined $wmode;
+
+ # there are not yet file formats which wouldn't have been identified
+ # by magic no's if in reading mode
+
+ if ($wmode) {
+ return 'PNM' if $ext =~ /^(pbm)|(pgm)|(ppm)|(pnm)$/;
+ return 'JPEG' if $ext =~ /^(jpg)|(jpeg)$/;
+ return 'TIFF' if $ext =~ /^(tiff)|(tif)$/;
+ return 'PCX' if $ext =~ /^pcx$/;
+ return 'SGI' if $ext =~ /^rgb$/;
+ return 'GIF' if $ext =~ /^gif$/;
+ return 'RAST' if $ext =~ /^(r)|(rast)$/;
+ return 'IFF' if $ext =~ /^(iff)|(ilbm)$/;
+ return 'PS' if $ext =~ /^ps/;
+ return 'FITS' if $ext =~ /^f(i?ts|it)$/;
+ return 'PNG' if $ext =~ /^png$/i;
+ }
+
+
+ return 'UNKNOWN';
+}
+
+# try to figure out the format of a supposed image file
+# from the magic numbers (numbers taken from magic in netpbm and
+# the file format routines in xv)
+# if no magics match try extension for non-magic file types
+# todo: make more complete
+sub chkform {
+ my $file = shift;
+ my ($format, $magic, $len, $ext) = ("","",0,"");
+
+ open(IMG, $file) or barf "Can't open image file";
+ binmode IMG;
+ # should first check if file is long enough
+ $len = read(IMG, $magic,12);
+ if (!defined($len) ||$len != 12) {
+ barf "end of file when checking magic number";
+ close IMG;
+ return 'UNKNOWN';
+ }
+ close IMG;
+
+ return 'PNM' if $magic =~ /^P[1-6]/;
+ return 'GIF' if $magic =~ /(^GIF87a)|(^GIF89a)/;
+ return 'TIFF' if $magic =~ /(^MM)|(^II)/;
+ return 'JPEG' if $magic =~ /^(\377\330\377)/;
+ return 'SGI' if $magic =~ /^(\001\332)|(\332\001)/;
+ return 'RAST' if $magic =~ /^\131\246\152\225/;
+ return 'IFF' if $magic =~ /ILBM$/;
+ return 'PCX' if $magic =~ /^\012[\000-\005]/;
+ return 'PS' if $magic =~ /%!\s*PS/;
+ return 'FITS' if $magic =~ /^SIMPLE \=/;
+ return 'PNG' if $magic =~ /^.PNG\r/;
+
+
+ return chkext(getext($file)); # then try extensions
+}
+
+
+# helper proc for wpic
+# process hints for direct converter control and try to guess from extension
+# otherwise
+sub getconv {
+ my ($pdl,$file,$hints) = @_;
+
+ return ($$hints{CONVERTER},$$hints{FLAGS})
+ if defined($$hints{CONVERTER}); # somebody knows what he is doing
+
+ my $type = "";
+ if (defined($$hints{'FORMAT'})) {
+ $type = $$hints{'FORMAT'};
+ barf "unsupported (output) image format"
+ unless (exists($converter{$type})
+ && $converter{$type}->{'put'} !~ /NA/);
+ }
+ else {
+ $type = chkext(getext($file),1);
+ if ($type =~ /UNKNOWN/) {
+ barf "can't figure out desired file type, using PNM" ;
+ $type = 'PNM';
+ }
+ }
+
+ my $conv = $converter{$type}->{'put'};
+
+ # the datatype check is only a dirty fix for the ppmquant problem with
+ # types > byte
+ # a ppmquant is anyway only warranted when $isrgb!!!
+ $conv = $converter{$type}->{Prefilt}.$conv
+ if defined($converter{$type}->{Prefilt});
+
+ my $flags = $converter{$type}->{FLAGS};
+ $flags = "$Dflags" unless defined($flags);
+ $flags .= " $$hints{XTRAFLAGS}" if defined($$hints{XTRAFLAGS});
+ if (defined($$hints{'COLOR'}) && $$hints{'COLOR'} =~ /bwdither/) {
+ $flags = " | $conv $flags";
+ $conv = "pgmtopbm -floyd"; }
+
+ my($referral) = $converter{$type}->{referral};
+
+ return ($conv, $flags, $type, $referral);
+}
+
+# helper proc for wpic
+# if a certain type of pnm is required check data and make compliant if possible
+# else if intermediate format is pnm or ppm figure out the appropriate format
+# from the pdl
+sub chkpdl {
+ my ($pdl, $iform, $hints, $format) = @_;
+
+ if ($pdl->get_datatype >= $PDL_L ||
+ $pdl->get_datatype == $PDL_S ||
+ (!$converter{$format}->{ushortok} && $pdl->get_datatype == $PDL_US)) {
+ print "scaling data to type byte...\n" if $PDL::IO::Pic::debug;
+ $pdl = bytescl($pdl,-255);
+ }
+
+ my ($isrgb,$form) = (0,"");
+ my @Dims = $pdl->dims;
+ $isrgb = 1 if ($#Dims >= 2) && ($Dims[0] == 3);
+ barf "exspecting 2D or 3D-RGB-interlaced data as input"
+ unless ($isrgb || ($#Dims == 1));
+
+ $$hints{'COLOR'} = "" unless defined($$hints{'COLOR'});
+ if ($iform =~ /P[NP]M/) { # figure out the format from the data
+ $form = 'PPM' if $isrgb;
+ $form = 'PGM' if ($#Dims == 1) || ($$hints{'COLOR'} =~ /bwdither/i);
+ $form = 'PBM' if ($$hints{'COLOR'} =~ /bw/i);
+ $iform = $form; }
+ # this is the place for data conversions
+ if ($isrgb && ($iform =~ 'P[B,G]M')) {
+ print "wpic: converting to grayscale...\n";
+ $pdl = rgbtogr($pdl); # colour to grayscale
+ }
+ if (defined $$hints{LUT}) { # make LUT images into RGB
+ barf "luts only with non RGB data" if $isrgb;
+ print "starting palette->RGB conversion...\n" if $PDL::IO::Pic::debug;
+ $pdl = interlrgb($pdl,$$hints{LUT});
+ $iform = 'PPM'; # and tell everyone we are now RGB
+ print "finished conversion\n" if $PDL::IO::Pic::debug;
+ }
+ return ($pdl, $iform);
+}
+
+# delegate setting the temporary directory to the config file
+# (so that it can either be OS-independent or at least
+# easily controlled by the user).
+#
+sub gettmpdir {
+ my $tmpdir = $PDL::Config{TEMPDIR} ||
+ die "TEMPDIR not found in %PDL::Config";
+ barf "can't locate a temp dir called $tmpdir" unless -d $tmpdir;
+ return $tmpdir;
+}
+
+
+=head1 BUGS
+
+Currently only a random selection of converters/formats provided by
+pbmplus/netpbm is supported. It is hoped that the more important formats
+are covered. Other formats can be added as needed. Please send patches to
+the author.
+
+=head1 AUTHOR
+
+Copyright (C) 1996,1997 Christian Soeller <c.soeller at auckland.ac.nz>
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
diff --git a/IO/Pnm/pnm.pd b/IO/Pnm/pnm.pd
new file mode 100644
index 0000000..dff97a5
--- /dev/null
+++ b/IO/Pnm/pnm.pd
@@ -0,0 +1,620 @@
+# REPLACE FOLLOWING BY
+#
+# use PDL::PP qw/PDL::Experiment PDL::Experiment Experiment/;
+#
+# when using not in this package.
+
+pp_add_exported('',"rpnm wpnm");
+
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::IO::Pnm -- pnm format I/O for PDL
+
+=head1 SYNOPSIS
+
+ use PDL::IO::Pnm;
+ $im = wpnm $pdl, $file, $format[, $raw];
+ rpnm $stack->slice(':,:,:,(0)'),"PDL.ppm";
+
+=head1 DESCRIPTION
+
+pnm I/O for PDL.
+
+=cut
+
+use PDL::Core qw/howbig convert/;
+use PDL::Types;
+use PDL::Basic; # for max/min
+use PDL::IO::Misc;
+use Carp;
+use File::Temp qw( tempfile );
+
+# return the upper limit of data values an integer PDL data type
+# can hold
+sub dmax {
+ my $type = shift;
+ my $sz = 8*howbig($type);
+ $sz-- if ($type == $PDL_S || $type == $PDL_L); # signed types
+ return ((1 << $sz)-1);
+}
+
+# output any errors that have accumulated
+sub show_err {
+ my ($file,$showflag) = @_;
+ my $err;
+ $showflag = 1 unless defined $showflag;
+ if (-s "$file") {
+ open(INPUT,$file) or barf "Can't open error file";
+ if ($showerr) {
+ while (<INPUT>) {
+ print STDERR "converter: $_";
+ }} else {
+ $err = join('',<INPUT>);
+ }
+ }
+ close INPUT;
+ unlink $file;
+ return $err unless $showflag;
+}
+
+# barf after showing any accumulated errors
+sub rbarf {
+ my $err = show_err(shift, 0);
+ $err = '' unless defined $err;
+ barf @_,"converter error: $err";
+}
+
+# carp after showing any accumulated errors
+sub rcarp {
+ show_err(shift);
+ carp @_;
+}
+
+
+# public interface
+
+=head1 FUNCTIONS
+
+
+=head2 rpnm
+
+=for ref
+
+Read a pnm (portable bitmap/pixmap, pbm/ppm) file into a piddle.
+
+=for usage
+
+ Usage: $im = rpnm $file;
+
+Reads a file in pnm format (ascii or raw) into a pdl (magic numbers P1-P6).
+Based on the input format it returns pdls with arrays of size (width,height)
+if binary or grey value data (pbm and pgm) or (3,width,height) if rgb
+data (ppm). This also means for a palette image that the distinction between
+an image and its lookup table is lost which can be a problem in cases (but can
+hardly be avoided when using netpbm/pbmplus). Datatype is dependent
+on the maximum grey/color-component value (for raw and binary formats
+always PDL_B). rpnm tries to read chopped files by zero padding the
+missing data (well it currently doesn't, it barfs; I'll probably fix it
+when it becomes a problem for me ;). You can also read directly into an
+existing pdl that has to have the right size(!). This can come in handy
+when you want to read a sequence of images into a datacube.
+
+For details about the formats see appropriate manpages that come with the
+netpbm/pbmplus packages.
+
+=for example
+
+ $stack = zeroes(byte,3,500,300,4);
+ rpnm $stack->slice(':,:,:,(0)'),"PDL.ppm";
+
+reads an rgb image (that had better be of size (500,300)) into the
+first plane of a 3D RGB datacube (=4D pdl datacube). You can also do
+inplace transpose/inversion that way.
+
+=cut
+
+sub rpnm {PDL->rpnm(@_)}
+sub PDL::rpnm {
+ barf 'Usage: $im = rpnm($file) or $im = $pdl->rpnm($file)'
+ if $#_<0 || $#_>2;
+ my ($pdl,$file,$maybe) = @_;
+
+
+ if (ref($file)) { # $file is really a pdl in this case
+ $pdl = $file;
+ $file = $maybe;
+ } else {
+ $pdl = $pdl->initialize;
+ }
+
+ my ($errfh, $efile) = tempfile();
+ # catch STDERR
+ open(SAVEERR, ">&STDERR");
+ open(STDERR, ">$efile") || barf "Can't redirect stderr";
+ my $succeed = open(PNM, $file);
+ # redirection now in effect for child
+ # close(STDERR);
+ open(STDERR, ">&PDL::IO::Pnm::SAVEERR");
+ rbarf $efile,"Can't open pnm file '$file'" unless $succeed;
+ binmode PNM;
+
+ read(PNM,(my $magic),2);
+ rbarf $efile, "Oops, this is not a PNM file" unless $magic =~ /P[1-6]/;
+ print "reading pnm file with magic $magic\n" if $PDL::debug>1;
+
+ my ($isrgb,$israw,$params) = (0,0,3);
+ $israw = 1 if $magic =~ /P[4-6]/;
+ $isrgb = 1 if $magic =~ /P[3,6]/;
+ if ($magic =~ /P[1,4]/) { # PBM data
+ $params = 2;
+ $dims[2] = 1; }
+
+ # get the header information
+ my ($line, $pgot, @dims) = ("",0,0,0,0);
+ while (($pgot<$params) && ($line=<PNM>)) {
+ $line =~ s/#.*$//;
+ next if $line =~ /^\s*$/; # just white space
+ while ($line !~ /^\s*$/ && $pgot < $params) {
+ if ($line =~ /\s*(\S+)(.*)$/) {
+ $dims[$pgot++] = $1; $line = $2; }
+ else {
+ rbarf $efile, "no valid header info in pnm";}
+ }
+ }
+
+ my $type = $PDL_B;
+ do {
+TYPES: { my $pdlt;
+ foreach $pdlt ($PDL_B,$PDL_US,$PDL_L){
+ if ($dims[2] <= dmax($pdlt))
+ { $type = $pdlt;
+ last TYPES;
+ }
+ }
+ rbarf $efile, "rraw: data from ascii pnm file out of range";
+ }
+ };
+
+ # the file ended prematurely
+ rbarf $efile, "no valid header info in pnm" if $pgot < $params;
+ rbarf $efile,
+ "Dimensions must be > 0" if ($dims[0] <= 0) || ($dims[1] <= 0);
+
+ my @Dims = @dims[0,1];
+ $Dims[0] *= 3 if $isrgb;
+ if ($pdl->getndims==1 && $pdl->getdim(0)==0 && $isrgb) { #input pdl is null
+ local $PDL::debug = 0; # shut up
+ $pdl = $pdl->zeroes(PDL::Type->new($type),3, at dims[0,1]);
+ }
+ my $npdl = $isrgb ? $pdl->clump(2) : $pdl;
+ if ($israw) {
+ pnminraw (convert(pdl(0),$type), $npdl, $Dims[0], $Dims[1],
+ $magic eq "P4", 'PDL::IO::Pnm::PNM');
+ } else {
+ my $form = $1 if $magic =~ /P([1-3])/;
+ pnminascii (convert(pdl(0),$type), $npdl, $Dims[0], $Dims[1],
+ $form, 'PDL::IO::Pnm::PNM');
+ }
+ print("loaded pnm file, $dims[0]x$dims[1], gmax: $dims[2]",
+ $isrgb ? ", RGB data":"", $israw ? ", raw" : " ASCII"," data\n")
+ if $PDL::debug;
+ unlink($efile);
+
+ # need to byte swap for little endian platforms
+ unless ( isbigendian() ) {
+ if ($israw ) {
+ $pdl->bswap2 if $type==$PDL_US or $pdl->type == ushort;
+ $pdl->bswap4 if $type==$PDL_L; # not likely, but supported anyway
+ }
+ }
+ return $pdl;
+}
+
+
+=head2 wpnm
+
+=for ref
+
+Write a pnm (portable bitmap/pixmap, pbm/ppm) file into a file.
+
+=for usage
+
+ Usage: $im = wpnm $pdl, $file, $format[, $raw];
+
+Writes data in a pdl into pnm format (ascii or raw) (magic numbers P1-P6).
+The $format is required (normally produced by B<wpic>) and routine just
+checks if data is compatible with that format. All conversions should
+already have been done. If possible, usage of B<wpic> is preferred. Currently
+RAW format is chosen if compliant with range of input data. Explicit control
+of ASCII/RAW is possible through the optional $raw argument. If RAW is
+set to zero it will enforce ASCII mode. Enforcing RAW is
+somewhat meaningless as the routine will always try to write RAW
+format if the data range allows (but maybe it should reduce to a RAW
+supported type when RAW == 'RAW'?). For details about the formats
+consult appropriate manpages that come with the netpbm/pbmplus
+packages.
+
+=cut
+
+*wpnm = \&PDL::wpnm;
+sub PDL::wpnm {
+ barf ('Usage: wpnm($pdl,$filename,$format[,$raw]) ' .
+ 'or $pdl->wpnm($filename,$format[,$raw])') if $#_ < 2;
+ my ($pdl,$file,$type,$raw) = @_;
+ my ($israw,$max,$isrgb,$magic) = (0,255,0,"");
+
+ # need to copy input arg since bswap[24] work inplace
+ # might be better if the bswap calls detected if run in
+ # void context
+ my $swap_inplace = $pdl->is_inplace;
+
+ barf "wpnm: unknown format '$type'" if $type !~ /P[P,G,B]M/;
+
+ # check the data
+ my @Dims = $pdl->dims;
+ barf "wpnm: exspecting 3D (3,w,h) input"
+ if ($type =~ /PPM/) && (($#Dims != 2) || ($Dims[0] != 3));
+ barf "wpnm: exspecting 2D (w,h) input"
+ if ($type =~ /P[G,B]M/) && ($#Dims != 1);
+ barf "wpnm: user should convert float and double data to appropriate type"
+ if ($pdl->get_datatype == $PDL_F) || ($pdl->get_datatype == $PDL_D);
+ barf "wpnm: exspecting prescaled data"
+ if (($pdl->get_datatype != $PDL_B) || ($pdl->get_datatype != $PDL_US)) &&
+ ($pdl->min < 0);
+
+ # check for raw format
+ $israw = 1 if (($pdl->get_datatype == $PDL_B) || ($pdl->get_datatype == $PDL_US) || ($type =~ /PBM/));
+ $israw = 0 if (defined($raw) && !$raw);
+
+
+ $magic = $israw ? "P4" : "P1" if $type =~ /PBM/;
+ $magic = $israw ? "P5" : "P2" if $type =~ /PGM/;
+ $magic = $israw ? "P6" : "P3" if $type =~ /PPM/;
+ $isrgb = 1 if $magic =~ /P[3,6]/;
+
+ # catch STDERR and sigpipe
+ my ($errfh, $efile) = tempfile();
+ local $SIG{"PIPE"} = sub { show_err($efile);
+ die "Bad write to pipe $? $!"; };
+
+ my $pref = ($file !~ /^\s*[|>]/) ? ">" : ""; # test for plain file name
+ open(SAVEERR, ">&STDERR");
+ open(STDERR, ">$efile") || barf "Can't redirect stderr";
+ my $succeed = open(PNM, $pref . $file);
+ # close(STDERR);
+ open(STDERR, ">&PDL::IO::Pnm::SAVEERR");
+ rbarf $efile, "Can't open pnm file" unless $succeed;
+ binmode PNM;
+
+ $max =$pdl->max;
+ print "writing ". ($israw ? "raw" : "ascii") .
+ "format with magic $magic\n" if $PDL::debug;
+ # write header
+ print PNM "$magic\n";
+ print PNM "$Dims[-2] $Dims[-1]\n";
+ if ($type !~ /PBM/) { # fix maxval for raw output formats
+ my $outmax = 0;
+
+ if ($max < 256) {
+ $outmax = "255";
+ } elsif ($max < 65536) {
+ $outmax = "65535";
+ } else {
+ $outmax = $max;
+ };
+
+ print PNM "$outmax\n" unless $type =~ /PBM/;
+ };
+
+ # if rgb clump first two dims together
+ my $out = ($isrgb ? $pdl->slice(':,:,-1:0')->clump(2)
+ : $pdl->slice(':,-1:0'));
+
+ # handle byte swap issues for little endian platforms
+ unless ( isbigendian() ) {
+ if ($israw ) {
+ # make copy if needed
+ $out = $out->copy unless $swap_inplace;
+ if ( (255 < $max) and ($max < 65536)) {
+ $out->bswap2;
+ } elsif ($max >= 65536) {
+ $out->bswap4;
+ }
+ }
+ }
+ pnmout($out,$israw,$type eq "PBM",'PDL::IO::Pnm::PNM');
+
+ # check if our child returned an error (in case of a pipe)
+ if (!(close PNM)) {
+ my $err = show_err($efile,0);
+ barf "wpnm: pbmconverter error: $err";
+ }
+ unlink($efile);
+}
+
+
+
+;# Exit with OK status
+
+1;
+
+=head1 BUGS
+
+The stderr of the converters is redirected to a file. The filename is
+currently generated in a probably non-portable way. A method that avoids
+a file (and is portable) would be prefered.
+
+C<rpnm> currently relies on the fact that the header is separated
+from the image data by a newline. This is not required by the p[bgp]m
+formats (in fact any whitespace is allowed) but most of the pnm
+writers seem to comply with that. Truncated files are currently
+treated ungracefully (C<rpnm> just barfs).
+
+=head1 AUTHOR
+
+Copyright (C) 1996,1997 Christian Soeller <c.soeller at auckland.ac.nz>
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
+
+
+############################## END PM CODE ################################
+EOD
+
+
+pp_def('pnminraw',
+ Pars => 'type(); byte+ [o] im(m,n)',
+ OtherPars => 'int ms => m; int ns => n;
+ int isbin; char* fd',
+ GenericTypes => [B,U,L],
+ Code => 'int ms, ns, i,j,k,bit,llen;
+ PerlIO *fp;
+ IO *io;
+ PDL_Byte *buf, *bp;
+ $GENERIC() *gbp;
+
+ io = GvIO(gv_fetchpv($COMP(fd),FALSE,SVt_PVIO));
+ if (!io || !(fp = IoIFP(io)))
+ barf("Can\'t figure out FP");
+ ms = $SIZE(m); ns = $SIZE(n);
+ llen = ($COMP(isbin) ? ((ms+7) / 8) : (ms * sizeof($GENERIC())));
+ /* allocate a buffer of length llen */
+ if ((buf = (PDL_Byte*) malloc(llen*sizeof(PDL_Byte)))
+ == NULL)
+ barf("Error getting mem for line buffer");
+ threadloop %{ /* with top to bottom inversion */
+ for (i=ns-1; i>= 0; i--) {
+ if (PerlIO_read(fp,buf,llen) != llen)
+ barf("Error reading pnm file");
+ if ($COMP(isbin)) /* unpack buffer */
+ for (j=0,bp=buf,bit=0; j<ms; j++, bit++) {
+ bit &= 7;
+ if (!bit) k= *bp++;
+ /* here we do the inversion */
+ $im(n=>i,m=>j) = (k&0x80) ? 0 : 1;
+ k = k << 1;
+ }
+ else {
+ gbp = ($GENERIC()*)buf;
+ loop(m) %{
+ $im(n=>i,m=>m) = *(gbp++);
+ %}
+ }
+ }
+ %}', Doc => '
+
+=for ref
+
+Read in a raw pnm file.
+
+read a raw pnm file. The C<type> argument is only there to
+determine the type of the operation when creating C<im> or trigger
+the appropriate type conversion (maybe we want a byte+ here so that
+C<im> follows I<strictly> the type of C<type>).
+
+=cut
+
+
+'
+
+);
+
+pp_addhdr(<<'EOH');
+#define SWALLOWLINE(fp) while ((s = PerlIO_getc(fp)) != '\n' && s != EOF)
+#define PBM 1
+#define PGM 2
+#define PPM 3
+
+int getint(PerlIO *fp, PDL_Long *ip);
+
+/* process one input line from an ascii pnm file
+ * and store data into a pdl data component
+ * returns number of elements read
+ * returns -1 if garbage was encountered
+ */
+
+/* get the next number from the input string
+ * return values: len : number of characters read
+ * 0 : end of string or skip rest of string because comment
+ * -1 : found garbage
+ */
+#define TRAILING_WHITESPACE_CHECK(s) \
+ if (s!=' ' && s!='\t' && s!='\r' && s!='\n' && s!=',') return -1
+int getint(PerlIO *fp, PDL_Long *ip)
+{
+ PDL_Long i = 0;
+ int nread = 0;
+ int s = PerlIO_getc(fp);
+
+ if (s == EOF) return 0;
+ while (1) {
+ if (s == EOF)
+ return 0; /* signal end of line */
+ if (s == '#')
+ SWALLOWLINE(fp);
+ if (s >='0' && s <='9') break;
+ if (s!=' ' && s!='\t' && s!='\r' && s!='\n' && s!=',')
+ return -1; /* garbage */
+ s = PerlIO_getc(fp); /* else skip whitespace */
+ }
+ /* parse number */
+ while (1) {
+ i = (i*10) + (s - '0');
+ nread++;
+ if ((s = PerlIO_getc(fp)) == EOF) break; /* we could loose that */
+ if (s<'0' || s>'9') break;
+ }
+ *ip = i;
+ TRAILING_WHITESPACE_CHECK(s);
+ return nread;
+}
+
+EOH
+
+pp_def( 'pnminascii',
+ Pars => 'type(); byte+ [o] im(m,n)',
+ OtherPars => 'int ms => m; int ns => n;
+ int format; char* fd',
+ GenericTypes => [B,U,S,L],
+ Code => q?
+ int ms, ns, s, i;
+ PerlIO *fp;
+ IO *io;
+
+ io = GvIO(gv_fetchpv($COMP(fd),FALSE,SVt_PVIO));
+ if (!io || !(fp = IoIFP(io)))
+ barf("Can\'t figure out FP");
+ ms = $SIZE(m); ns = $SIZE(n);
+
+ switch ($COMP(format)) {
+ case PBM:
+ threadloop %{ /* with top to bottom inversion */
+ for (i=ns-1; i>= 0; i--) {
+ loop(m) %{
+ while ((s = PerlIO_getc(fp)) != EOF) {
+ switch (s) {
+ case '#': /* comment, skip rest of line */
+ SWALLOWLINE(fp);
+ break;
+ case '0':
+ case '1':
+ /* invert on the fly */
+ $im(n=>i,m=>m) = 1 - (s - '0');
+ goto $TBUSL(B,U,S,L)next;
+ break;
+ case ' ':
+ case '\t':
+ case '\r':
+ case '\n':
+ case ',':
+ /* skip whitespace */
+ break;
+ default: /* garbage */
+ barf("found garbage, aborting"); /* for now */
+ break;
+ }
+ }
+ $TBUSL(B,U,S,L)next: ;
+ %}
+ }
+ %}
+ break;
+ case PGM:
+ case PPM:
+ threadloop %{ /* with top to bottom inversion */
+ PDL_Long j;
+ for (i=ns-1; i>= 0; i--) {
+ loop(m) %{
+ if (getint(fp,&j) <= 0)
+ barf("found garbage, aborting"); /* for now */
+ $im(n=>i,m=>m) = j;
+ %}
+ }
+ %}
+ break;
+ default:
+ barf("unknown PNM format");
+ break;
+ } /* end switch */
+ ?, Doc => '
+=for ref
+
+Read in an ascii pnm file.
+
+=cut
+
+
+'
+);
+
+
+# write a line of data supporting threading !
+pp_def( 'pnmout',
+ Pars => 'a(m);',
+ 'NoPthread' => 1, # Pthreading doesn't make sense for an IO function
+ OtherPars => "int israw; int isbin; char *fd",
+ GenericTypes => [B,U,S,L],
+ Code => 'PerlIO *fp;
+ IO *io;
+
+ io = GvIO(gv_fetchpv($COMP(fd),FALSE,SVt_PVIO));
+ if (!io || !(fp = IoIFP(io)))
+ barf("Can\'t figure out FP");
+
+ if ($COMP(israw)) {
+ if ($COMP(isbin)) {
+ threadloop %{
+ int k=0, bit=0;
+ loop(m) %{
+ k = (k << 1) | ($a() < 1);
+ bit++;
+ if (bit==8) {
+ PerlIO_putc(fp,k);
+ bit = k = 0;
+ }
+ %}
+ if (bit) {
+ k = k << (8-bit);
+ PerlIO_putc(fp,k);
+ }
+ %}
+ } else {
+ int len = $SIZE(m) * sizeof($GENERIC());
+ threadloop %{
+ if (PerlIO_write(fp,$P(a),len) != len)
+ barf("Error writing pnm file");
+ %}
+ }
+ } else {
+ int len=0;
+ threadloop %{
+ loop(m) %{
+ PerlIO_printf(fp,"%3d ",$COMP(isbin) ?
+ ($a() < 1) :$a());
+ len +=4;
+ if (len>58) { PerlIO_printf(fp,"\n"); len=0; }
+ %}
+ if (len<=58)
+ PerlIO_printf(fp,"\n");
+ %}
+ }
+', Doc => '
+=for ref
+
+Write a line of pnm data.
+
+This function is implemented this way so that threading works
+naturally.
+
+=cut
+
+
+');
+
+pp_done();
diff --git a/IO/Storable/Makefile.PL b/IO/Storable/Makefile.PL
new file mode 100644
index 0000000..91bfa00
--- /dev/null
+++ b/IO/Storable/Makefile.PL
@@ -0,0 +1,22 @@
+
+# Makefile.PL for PDL::Examples module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+ at pack = (["storable.pd",Storable,PDL::IO::Storable]);
+
+%hash = pdlpp_stdargs_int(@::pack);
+# $hash{'OPTIMIZE'} = '-g'; # If you want to debug, uncomment this.
+$hash{'VERSION'} = '0.5';
+
+WriteMakefile(%hash);
+
+# Add genpp rule
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+}
+
diff --git a/IO/Storable/storable.pd b/IO/Storable/storable.pd
new file mode 100644
index 0000000..7749d74
--- /dev/null
+++ b/IO/Storable/storable.pd
@@ -0,0 +1,193 @@
+pp_addpm << 'EOPM';
+
+=head1 NAME
+
+PDL::IO::Storable - helper functions to make PDL usable with Storable
+
+=head1 SYNOPSIS
+
+ use Storable;
+ use PDL::IO::Storable;
+ $hash = {
+ 'foo' => 42,
+ 'bar' => zeroes(23,45),
+ };
+ store $hash, 'perlhash.dat';
+
+=head1 DESCRIPTION
+
+C<Storable> implements object persistence for Perl data structures
+that can (in principle) contain arbitrary Perl objects. Complicated
+objects must supply their own methods to be serialized and thawed.
+This module implements the relevant methods to be able to store
+and retrieve piddles via Storable.
+
+=head1 FUNCTIONS
+
+=cut
+
+EOPM
+
+# it *seems* to work now
+# better wait for some more extensive testing to be sure though
+
+pp_addhdr << 'EOH';
+
+EOH
+
+pp_addxs << 'EOXS';
+MODULE = PDL::Storable PACKAGE = PDL
+
+void
+make_null(sv)
+ SV *sv
+ CODE:
+ SV *newref, *dat;
+ PDL_Indx fake[1] = {0};
+ STRLEN n_a;
+
+ /* we basically mimick pdl_null but without letting
+ * it give us a it->sv ! We have our own to which we
+ * connect below
+ */
+ pdl *it = PDL->pdlnew();
+ it->datatype = PDL_B;
+ it->data = PDL->smalloc((STRLEN) (PDL->howbig(it->datatype)));
+ dat = newSVpv(it->data,PDL->howbig(it->datatype));
+ it->data = SvPV(dat,n_a);
+ it->datasv = dat;
+ PDL->setdims(it, fake, 0); /* However, there are 0 dims in scalar */
+ it->nvals = 1;
+ /* PDL->set(it->data, it->datatype, NULL, NULL, NULL, 0, 0, 0.0); */
+
+ /* a null piddle */
+ PDL->setdims(it,fake,1);
+ it->state |= PDL_NOMYDIMS;
+
+ /* connect pdl struct to this sv */
+ sv_setiv(SvRV(sv),PTR2IV(it));
+ it->sv = SvRV(sv);
+ /* printf("it->sv = %d\n",it->sv); */
+ PDL->SetSV_PDL(sv,it);
+
+EOXS
+
+pp_addpm << 'EOPM';
+
+use Carp;
+
+{ package PDL;
+# routines to make PDL work with Storable >= 1.03
+sub pdlpack {
+ my ($pdl) = @_;
+ my $hdr = pack 'i*', $pdl->get_datatype, $pdl->getndims, $pdl->dims;
+ my $dref = $pdl->get_dataref;
+ return $hdr.$$dref; # header followed by dataref
+ # note that this packing is not network transparent !!!!!
+ # likely to break when moving stored piddles across
+ # different architectures
+ # probably need to store endianness and type info with it
+ # type should be saved by name! the type codes could change depending
+ # on the PDL version
+}
+
+sub pdlunpack {
+ use Config ();
+ my ($pdl,$pack) = @_;
+ my $stride = $Config::Config{intsize};
+ my ($type,$ndims) = unpack 'i2', $pack;
+ my @dims = $ndims > 0 ? unpack 'i*', substr $pack, 2*$stride,
+ $ndims*$stride : ();
+ print "thawing PDL, Dims: [",join(',', at dims),"]\n" if $PDL::verbose;
+ $pdl->make_null; # make this a real piddle -- this is the tricky bit!
+ $pdl->set_datatype($type);
+ $pdl->setdims([@dims]);
+ my $dref = $pdl->get_dataref;
+ $$dref = substr $pack, (2+$ndims)*$stride;
+ $pdl->upd_data;
+ return $pdl;
+}
+
+sub STORABLE_freeze {
+ my ($self, $cloning) = @_;
+# return if $cloning; # Regular default serialization
+ return UNIVERSAL::isa($self, "HASH") ? ("",{%$self}) # hash ref -> Storable
+ : (pdlpack $self); # pack the piddle into a long string
+}
+
+sub STORABLE_thaw {
+ my ($pdl,$cloning,$serial,$hashref) = @_;
+ # print "in STORABLE_thaw\n";
+# return if $cloning;
+ my $class = ref $pdl;
+ if (defined $hashref) {
+ croak "serial data with hashref!" unless !defined $serial ||
+ $serial eq "";
+ for (keys %$hashref) { $pdl->{$_} = $hashref->{$_} }
+ } else {
+ # all the magic is happening in pdlunpack
+ $pdl->pdlunpack($serial); # unpack our serial into this sv
+ }
+}
+
+# have these as PDL methods
+
+=head2 store
+
+=for ref
+
+store a piddle using L<Storable|Storable>
+
+=for example
+
+ $a = random 12,10;
+ $a->store('myfile');
+
+=cut
+
+=head2 freeze
+
+=for ref
+
+freeze a piddle using L<Storable|Storable>
+
+=for example
+
+ $a = random 12,10;
+ $frozen = $a->freeze;
+
+=cut
+
+sub store { require Storable; Storable::store(@_) }
+sub freeze { require Storable; Storable::freeze(@_) }
+}
+
+=head1 BUGS
+
+The packed piddles are I<not> stored in a network transparent
+way. As a result expect problems when moving C<Storable> data
+containing piddles across computers.
+
+This could be fixed by amending the methods C<pdlpack> and
+C<pdlunpack> appropriately. If you want this functionality
+feel free to submit patches.
+
+If you want to move piddle data
+across platforms I recommend L<PDL::NetCDF|PDL::NetCDF> as
+an excellent (and IMHO superior) workaround.
+
+=head1 AUTHOR
+
+Copyright (C) 2002 Christian Soeller <c.soeller at auckland.ac.nz>
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+
+EOPM
+
+pp_done;
diff --git a/Known_problems b/Known_problems
new file mode 100644
index 0000000..f181b6b
--- /dev/null
+++ b/Known_problems
@@ -0,0 +1,138 @@
+The following issues have been reported with this version of PDL:
+
+
+- A bug in Netpbm from versions 10.56.00 through 10.61.2 may
+ result in a an invalid conversion of RAST images to PNM
+ format on some platforms, resulting in a failed picrgb test.
+
+
+- Bugs in Netpbm versions earlier than 10.58.00 result in
+ invalid 16bit PNG image IO and failing tests.
+
+
+- GLUT readline support in perldl with the -glut option not
+ yet implemented for win32. Work in progress.
+
+
+- A change in perl-5.14 on how the 'x' operator works affects
+ PDL's overload of that operator for matrix multiplication.
+ This can affect code using parentheses to group. An example
+ that shows the problem is code like:
+
+ f( ($pdl0 * $pdl1) x $pdl2 )
+
+ which now gives an error. The fix is to force the element-wise
+ operation in parentheses to be treated in scalar context rather
+ than list context. E.g.,
+
+ f( scalar($p0 * $p1) x $p2 );
+
+ Please see
+ http://mailman.jach.hawaii.edu/pipermail//pdl-porters/2012-February/004423.html
+ for a more detailed discussion and additional work-arounds.
+
+
+- On MS Windows, perl 5.14 (and perhaps later), it is reported that
+ PDL::Graphics::PLplot cannot be sucessfully built as part of the
+ PDL build. It compiles ok, but the resultant binary files are
+ unusable. Workaround is to build PDL first, then build
+ PDL::Graphics::PLplot separately.
+
+
+- Some versions of MinGW gcc (used to compile for win32 perls)
+ crash in compilation of large, PP-generated files. The work-
+ around is to disable optimization for those file. See the
+ INSTALL file for a hand fix.
+
+
+- The current Ctrl-C logic in the PDL shells (pdl2 and perldl)
+ doesn't work the same with the perl's new "safe signals". A
+ workaround to the problem is to set the PERL_SIGNALS environment
+ variable to "unsafe". See sf.net feature request #3308168
+ for details and any future status.
+
+
+- The Perl debugger for perls 5.10.1 through 5.14.x has a new
+ "feature" leading to false fails for lvalue subroutines when
+ run under the debugger. If you need to debug such code with
+ an affected perl version, the work around is to use an
+ intermediate temporary variable assignment as in:
+
+ $piddle->slice('0:10') .= 100; # original slice code
+ ($tmp = $piddle->slice('0:10')) .= 100; # work around perl -d "feature"
+
+ The problem is understood and it appears that the error has
+ been replaced by a warning with perl-5.15.1 and is fixed in
+ perl-5.16.0. NOTE: the work-around is ugly but effective.
+
+
+- Multiline q'' constructs are broken in the Devel::REPL versions
+ 1.003012 and 1.003013 so you'll need to use perldl or avoid
+ splitting quoted strings across lines. A fix is being investigated.
+
+
+- The demo 3d and 3d2 windows do not close (can not be closed)
+ after the demo finishes. You need to exit the perldl shell
+ to have the window close.
+
+
+- When you close a TriD graphics window with the frame widget
+ the whole process exits including the perldl shell.
+
+
+- Extremely verbose but not particularly helpful text output from
+ the configure-build-test process.
+
+
+- Directory completion in the interactive PDL shells (perldl and pdl2)
+ using Term::ReadLine::Perl adds a space after each directory expansion.
+ To continue to complete, one must delete the space before typing <TAB>
+ again. The problem has been reported as a Term::ReadLine::Perl bug.
+
+
+- PDL on Cygwin+32bit windows has only about 300MB which can cause
+ out of memory crashes with large data sets. For 64bit windows hosts
+ 2GB is available.
+
+
+- minimum/maximum/min/max inconsistently handle NaN values.
+ NaNs for the first element of a pdl will propagate to the
+ result while if the first element is a number, then the
+ result will be a number. The answer for max/min should not
+ depend on the order of the input values.
+
+
+- The following SourceForge bugs are outstanding at time of the
+ PDL-2.007 release:
+
+ 343 longlong constructor and display lose digits due to implicit double precision conversions
+ 340 orover of byte data returns long type
+ 339 PDL::Complex support is inconsistent and incomplete
+ 334 Test coverage is incomplete
+ 332 "isn't numeric in null operation" warning could be more helpful
+ 330 NiceSlice can get confused by comments to cause compilation errors
+ 324 PDL re-install wipes out non-core docs
+ 322 PDL::Demos system needs overhaul
+ 321 Several core modules do not have man pages
+ 319 PDL::Index does not render on websites
+ 313 clip() edge case not handled right
+ 312 Wrong results in corner empty-set cases
+ 308 propagate badflag with .=
+ 274 'help funname' fails to show multiple function names
+ 268 PLplot still unusable with X
+ 261 max() fails on nan
+ 254 online docs don't link to functions in other PDL modules
+ 238 NiceSlice affects code where it should not
+ 232 perl -d chokes on lvalue functions
+
+ Fixed in perl 5.16.x or use work around.
+
+ 210 default PDL build output too long
+ 147 closing TriD window kills perldl shell
+
+
+For more information on these and other PDL issues, and for
+submissions of patches (bug patches are always welcome!),
+see the PDL mailing lists. Links to archive list discussions
+and how to register for the mailing lists can be found at
+http://pdl.perl.org/?page=mailing-lists .
diff --git a/Lib/CallExt/CallExt.pm b/Lib/CallExt/CallExt.pm
new file mode 100644
index 0000000..b6648cd
--- /dev/null
+++ b/Lib/CallExt/CallExt.pm
@@ -0,0 +1,242 @@
+
+package PDL::CallExt;
+
+ at EXPORT_OK = qw( callext callext_cc );
+%EXPORT_TAGS = (Func=>[@EXPORT_OK]);
+ at EXPORT = @EXPORT_OK;
+
+use Config;
+use PDL::Core;
+use PDL::Exporter;
+use DynaLoader;
+use Carp;
+ at ISA = qw( PDL::Exporter DynaLoader );
+
+bootstrap PDL::CallExt;
+
+=head1 NAME
+
+PDL::CallExt - call functions in external shared libraries
+
+=head1 SYNOPSIS
+
+ use PDL::CallExt;
+ callext('file.so', 'foofunc', $x, $y); # pass piddles to foofunc()
+
+ % perl -MPDL::CallExt -e callext_cc file.c
+
+=head1 DESCRIPTION
+
+callext() loads in a shareable object (i.e. compiled code) using Perl's
+dynamic loader, calls the named function and passes a list of piddle arguments
+to it.
+
+It provides a reasonably portable way of doing this, including compiling the
+code with the right flags, though it requires simple perl and C wrapper
+routines to be written. You may prefer to use PP, which is much more
+portable. See L<PDL::PP>. You should definitely use the latter for a 'proper'
+PDL module, or if you run in to the limitations of this module.
+
+=head1 API
+
+callext_cc() allows one to compile the shared objects using Perl's knowledge
+of compiler flags.
+
+The named function (e.g. 'foofunc') must take a list of piddle structures as
+arguments, there is now way of doing portable general argument construction
+hence this limitation.
+
+In detail the code in the original file.c would look like this:
+
+ #include "pdlsimple.h" /* Declare simple piddle structs - note this .h file
+ contains NO perl/PDL dependencies so can be used
+ standalone */
+
+ int foofunc(int nargs, pdlsimple **args); /* foofunc prototype */
+
+
+i.e. foofunc() takes an array of pointers to pdlsimple structs. The use is
+similar to that of C<main(int nargs, char **argv)> in UNIX C applications.
+
+pdlsimple.h defines a simple N-dimensional data structure which looks like this:
+
+ struct pdlsimple {
+ int datatype; /* whether byte/int/float etc. */
+ void *data; /* Generic pointer to the data block */
+ int nvals; /* Number of data values */
+ PDL_Long *dims; /* Array of data dimensions */
+ int ndims; /* Number of data dimensions */
+ };
+
+(PDL_Long is always a 4 byte int and is defined in pdlsimple.h)
+
+This is a simplification of the internal reprensation of piddles in PDL which is
+more complicated because of threading, dataflow, etc. It will usually be found
+somewhere like /usr/local/lib/perl5/site_perl/PDL/pdlsimple.h
+
+Thus to actually use this to call real functions one would need to right a wrapper.
+e.g. to call a 2D image processing routine:
+
+ void myimage_processer(double* image, int nx, int ny);
+
+ int foofunc(int nargs, pdlsimple **args) {
+ pdlsimple* image = pdlsimple[0];
+ myimage_processer( image->data, *(image->dims), *(image->dims+1) );
+ ...
+ }
+
+Obviously a real wrapper would include more error and argument checking.
+
+This might be compiled (e.g. Linux):
+
+ cc -shared -o mycode.so mycode.c
+
+In general Perl knows how to do this, so you should be able to get
+away with:
+
+ perl -MPDL::CallExt -e callext_cc file.c
+
+callext_cc() is a function defined in PDL::CallExt to generate the
+correct compilation flags for shared objects.
+
+If their are problems you will need to refer to you C compiler manual to find
+out how to generate shared libraries.
+
+See t/callext.t in the distribution for a working example.
+
+It is up to the caller to ensure datatypes of piddles are correct - if not
+peculiar results or SEGVs will result.
+
+
+=head1 FUNCTIONS
+
+=head2 callext
+
+=for ref
+
+Call a function in an external library using Perl dynamic loading
+
+=for usage
+
+ callext('file.so', 'foofunc', $x, $y); # pass piddles to foofunc()
+
+The file must be compiled with dynamic loading options
+(see C<callext_cc>). See the module docs C<PDL::Callext>
+for a description of the API.
+
+=head2 callext_cc
+
+=for ref
+
+Compile external C code for dynamic loading
+
+=for usage
+
+Usage:
+
+ % perl -MPDL::CallExt -e callext_cc file.c -o file.so
+
+This works portably because when Perl has built in knowledge of how to do
+dynamic loading on the system on which it was installed.
+See the module docs C<PDL::Callext> for a description of
+the API.
+
+=cut
+
+sub callext{
+ die "Usage: callext(\$file,\$symbol, \@pdl_args)" if scalar(@_)<2;
+ my($file,$symbol, @pdl_args) = @_;
+
+ my $libref = DynaLoader::dl_load_file($file);
+ my $err = DynaLoader::dl_error(); barf $err if !defined $libref;
+ my $symref = DynaLoader::dl_find_symbol($libref, $symbol);
+ $err = DynaLoader::dl_error(); barf $err if !defined $symref;
+
+ _callext_int($symref, @pdl_args);
+1;}
+
+# Compile external C program correctly
+
+#
+# callext_cc
+#
+# The old version of this routine was taking unstructured arguments and
+# happily passed this though the C compiler. Unfortunately, on platforms
+# like HP-UX, we need to make separate cc and ld runs in order to create the
+# shared objects.
+#
+# The signature of the function was therefore changed starting at PDL 2.0.
+# It is now:
+#
+# ($src, $ccflags, $ldflags, $output)
+#
+# In its simplest invocation, it can be just $src, and the output will be
+# derived from the source file. Otherwise, $ccflags add extra C flags, $ldflags
+# adds extra ld flags, and $output specifies the final target output file name.
+# If left blank, it will be in the same directory where $src lied.
+#
+sub callext_cc {
+ my @args = @_>0 ? @_ : @ARGV;
+ my ($src, $ccflags, $ldflags, $output) = @args;
+ my $cc_obj;
+ ($cc_obj = $src) =~ s/\.c$/$Config{_o}/;
+ my $ld_obj = $output;
+ ($ld_obj = $cc_obj) =~ s/\.o$/\.$Config{dlext}/ unless defined $output;
+
+ # Output flags for compiler depend on os.
+ # -o on cc and gcc, or /Fo" " on MS Visual Studio
+ # Need a start and end string
+ my $do = ( $Config{cc} eq 'cl' ? '/Fo"' : '-o ');
+ my $eo = ( $^O =~ /MSWin/i ? '"' : '' );
+
+ # Compiler command
+ # Placing $ccflags *before* installsitelib/PDL/Core enables us to include
+ # the appropriate 'pdlsimple.h' during 'make test'.
+ my $cc_cmd = join(' ', map { $Config{$_} } qw(cc ccflags cccdlflags)) .
+ " $ccflags -I$Config{installsitelib}/PDL/Core -c $src $do$cc_obj$eo";
+
+ # The linker output flag is -o on cc and gcc, and -out: on MS Visual Studio
+ my $o = ( $Config{cc} eq 'cl' ? '-out:' : '-o ');
+
+ # Setup the LD command. Do not want the env var on Windows
+ my $ld_cmd = ( $^O =~ /MSWin/i ? ' ' : 'LD_RUN_PATH="" ');
+
+ my $libs = $^O =~ /MSWin/i ?
+ $Config{libs} :
+ ''; # used to be $Config{libs} but that bombs
+ # on recent debian platforms
+ $ld_cmd .=
+ join(' ', map { $Config{$_} } qw(ld lddlflags)) .
+ " $libs $ldflags $o$ld_obj $cc_obj";
+ my $cmd = "$cc_cmd; $ld_cmd";
+ print $cmd,"\n";
+
+ # Run the command in two steps so that we can check status
+ # of each and also so that we dont have to rely on ';' command
+ # separator
+
+ system $cc_cmd and croak " compiling $src";
+
+ # Fix up ActiveState-built perl. Is this a reliable fix ?
+ $ld_cmd =~ s/\-nodefaultlib//g if $Config{cc} eq 'cl';
+
+ system $ld_cmd and croak "Error linking $cc_obj";
+ return 1;
+}
+
+=head1 AUTHORS
+
+Copyright (C) Karl Glazebrook 1997.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
+
+# Exit with OK status
+
+1;
+
diff --git a/Lib/CallExt/CallExt.xs b/Lib/CallExt/CallExt.xs
new file mode 100644
index 0000000..6a3a261
--- /dev/null
+++ b/Lib/CallExt/CallExt.xs
@@ -0,0 +1,65 @@
+/*
+ * We used to say "THIS FILE WAS GENERATED BY PDL::PP! Do not modify!"
+ * but it has been hand-modified since then.
+ */
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "pdl.h"
+#include "pdlcore.h"
+#include "pdlsimple.h"
+
+static Core* PDL; /* Structure hold core C functions */
+SV* CoreSV; /* Get's pointer to perl var holding core structure */
+
+/*
+ * Call an external C routine loaded dynamically - pass PDL args list
+ *
+ * Not sure whether should be 'ENABLE' or 'DISABLE' for the PROTOTYPES
+ * argument below. We only seem to need the line to stop perl from
+ * complaining about the line being missing during build time anyway.
+ */
+
+MODULE = PDL::CallExt PACKAGE = PDL::CallExt
+
+PROTOTYPES: DISABLE
+
+void
+_callext_int(...)
+ PPCODE:
+ int (*symref)(int npdl, pdlsimple **x);
+ int npdl = items-1;
+ pdlsimple **x;
+ pdl *t;
+ int i;
+
+ symref = (int(*)(int, pdlsimple**)) INT2PTR(void*,SvIV(ST(0)));
+
+ New( 42, x, npdl, pdlsimple* ); /* Ptr array */
+ for(i=0; i<npdl; i++) {
+ t = PDL->SvPDLV(ST(i+1));
+ PDL->make_physical(t);
+ PDL->make_physdims(t);
+ New(42, x[i], 1, pdlsimple); /* Each ptr */
+ x[i]->datatype = t->datatype;
+ x[i]->data = t->data;
+ x[i]->nvals = t->nvals;
+ x[i]->dims = t->dims;
+ x[i]->ndims = t->ndims;
+ }
+
+ i = (*symref)(npdl, x);
+ if (i==0)
+ barf("Error calling external routine");
+
+ for(i=0; i<npdl; i++) /* Free stuff */
+ Safefree(x[i]);
+ Safefree(x);
+
+BOOT:
+ /* Get pointer to structure of core shared C routines */
+ CoreSV = perl_get_sv("PDL::SHARE",FALSE); /* SV* value */
+ if (CoreSV==NULL)
+ croak("This module requires use of PDL::Core first");
+ PDL = INT2PTR(Core*,SvIV( CoreSV )); /* Core* value */
+
diff --git a/Lib/CallExt/Makefile.PL b/Lib/CallExt/Makefile.PL
new file mode 100644
index 0000000..b1b9e65
--- /dev/null
+++ b/Lib/CallExt/Makefile.PL
@@ -0,0 +1,14 @@
+
+# Makefile.PL for PDL::CallExt module
+my $malloclib = $PDL::Config{MALLOCDBG}->{libs};
+my $mallocinc = $PDL::Config{MALLOCDBG}->{include};
+
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ 'NAME' => 'PDL::CallExt',
+ 'VERSION_FROM' => '../../Basic/Core/Version.pm',
+ 'INC' => "-I../../Basic/Core $mallocinc",
+ 'LIBS' => [$malloclib],
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
diff --git a/Lib/Compression/Makefile.PL b/Lib/Compression/Makefile.PL
new file mode 100644
index 0000000..847d1f2
--- /dev/null
+++ b/Lib/Compression/Makefile.PL
@@ -0,0 +1,14 @@
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+ at pack = (["compression.pd",Compression,PDL::Compression]);
+%hash = pdlpp_stdargs_int(@pack);
+
+$hash{OBJECT} = "" unless exists $hash{OBJECT};
+$hash{OBJECT} .= "ricecomp";
+
+WriteMakefile( pdlpp_stdargs_int(@::pack) );
+
+# Add genpp rule
+sub MY::postamble { pdlpp_postamble_int(@::pack); }
+
diff --git a/Lib/Compression/compression.pd b/Lib/Compression/compression.pd
new file mode 100644
index 0000000..9fe1f04
--- /dev/null
+++ b/Lib/Compression/compression.pd
@@ -0,0 +1,256 @@
+pp_addhdr('
+#include "ricecomp.c"
+');
+
+pp_addpm({At=>'Top'},<<'EOD');
+
+=head1 NAME
+
+PDL::Compression - compression utilities
+
+=head1 DESCRIPTION
+
+These routines generally accept some data as a PDL and compress it
+into a smaller PDL. Algorithms typically work on a single dimension
+and thread over other dimensions, producing a threaded table of
+compressed values if more than one dimension is fed in.
+
+The Rice algorithm, in particular, is designed to be identical to the
+RICE_1 algorithm used in internal FITS-file compression (see PDL::IO::FITS).
+
+
+=head1 SYNOPSIS
+
+ use PDL::Compression
+
+ ($b,$asize) = $a->rice_compress();
+ $c = $b->rice_expand($asize);
+
+=cut
+
+
+EOD
+
+pp_addpm({At=>'Bot'},<<'EOD');
+
+=head1 AUTHORS
+
+Copyright (C) 2010 Craig DeForest.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+The Rice compression library is derived from the similar library in
+the CFITSIO 3.24 release, and is licensed under yet more more lenient
+terms than PDL itself; that notice is present in the file "ricecomp.c".
+
+=head1 BUGS
+
+=over 3
+
+=item * Currently headers are ignored.
+
+=item * Currently there is only one compression algorithm.
+
+=back
+
+=head1 TODO
+
+=over 3
+
+=item * Add object encapsulation
+
+=item * Add test suite
+
+=back
+
+=cut
+
+
+EOD
+
+pp_addpm(<<'EOD');
+
+=head1 METHODS
+
+=cut
+
+
+EOD
+
+pp_def(
+ "rice_compress",
+ HandleBad => 0,
+ Pars => 'in(n); [o]out(m); int[o]len(); lbuf(n)',
+ OtherPars => "int blocksize", # in OtherPars to avoid autopromotion
+ GenericTypes =>['B','S','US','L'],
+ Doc => <<'EOD',
+
+=for ref
+
+Squishes an input PDL along the 0 dimension by Rice compression. In
+scalar context, you get back only the compressed PDL; in list context,
+you also get back ancillary information that is required to uncompress
+the data with rice_uncompress.
+
+Multidimensional data are threaded over - each row is compressed
+separately, and the returned PDL is squished to the maximum compressed
+size of any row. If any of the streams could not be compressed (the
+algorithm produced longer output), the corresponding length is set to -1
+and the row is treated as if it had length 0.
+
+Rice compression only works on integer data types -- if you have
+floating point data you must first quantize them.
+
+The underlying algorithm is identical to the Rice compressor used in
+CFITSIO (and is used by PDL::IO::FITS to load and save compressed FITS
+images).
+
+The optional blocksize indicates how many samples are to be compressed
+as a unit; it defaults to 32.
+
+How it works:
+
+Rice compression is a subset of Golomb compression, and works on data sets
+where variation between adjacent samples is typically small compared to the
+dynamic range of each sample. In this implementation (originally written
+by Richard White and contributed to CFITSIO in 1999), the data are divided
+into blocks of samples (by default 32 samples per block). Each block
+has a running difference applied, and the difference is bit-folded to make
+it positive definite. High order bits of the difference stream are discarded,
+and replaced with a unary representation; low order bits are preserved. Unary
+representation is very efficient for small numbers, but large jumps could
+give rise to ludicrously large bins in a plain Golomb code; such large jumps
+("high entropy" samples) are simply recorded directly in the output stream.
+
+Working on astronomical or solar image data, typical compression ratios of
+2-3 are achieved.
+
+=for usage
+
+ $out = $pdl->rice_compress($blocksize);
+ ($out, $len, $blocksize, $dim0) = $pdl->rice_compress;
+
+ $new = $out->rice_expand;
+
+=cut
+
+
+EOD
+ PMCode => <<'EOD',
+sub PDL::rice_compress {
+ my $in = shift;
+ my $blocksize = shift || 32;
+
+ ## Reject floating-point inputs
+ if( $in->type != byte &&
+ $in->type != short &&
+ $in->type != ushort &&
+ $in->type != long
+ ) {
+ die("rice_compress: input needs to have type byte, short, ushort, or long, not ".($in->type)."\n");
+ }
+
+ # output buffer starts the same size; truncate at the end.
+ my ($out) = zeroes($in);
+
+ # line buffer is here to make sure we don't get fouled up by transpositions
+ my ($lbuf) = zeroes($in->type, $in->dim(0));
+
+ # lengths go here
+ my ($len) = zeroes(long, $in->slice("(0)")->dims);
+
+ &PDL::_rice_compress_int( $in, $out, $len, $lbuf, $blocksize );
+
+ $l = $len->max;
+ $out = $out->slice("0:".($l-1))->sever;
+
+ if(wantarray) {
+ return ($out, $in->dim(0), $blocksize, $len);
+ } else {
+ return $out;
+ }
+}
+EOD
+ Code => <<'EOD',
+
+// Copy current row into the row buffer (to ensure
+// contiguous location in memory)
+loop(n) %{
+ $lbuf() = $in();
+%}
+
+$len() = 1 + ( rcomp( &($lbuf(n=>0)),
+ sizeof($lbuf(n=>0)),
+ $SIZE(n),
+ (unsigned char *)(&($out(m=>0))),
+ $SIZE(m) * sizeof($out(m=>0)),
+ $COMP(blocksize)
+ )
+ - 1
+ ) / sizeof($out(m=>0));
+
+
+EOD
+);
+
+pp_def(
+ "rice_expand",
+ HandleBad=>0,
+ Pars=>'in(n); [o]out(m); lbuf(n)',
+ OtherPars=>'int blocksize',
+ GenericTypes=>['B','S','US','L'],
+ Doc=><<'EOD',
+
+=for ref
+
+Unsquishes a PDL that has been squished by rice_expand.
+
+=for usage
+
+ ($out, $len, $blocksize, $dim0) = $pdl->rice_compress;
+ $copy = $out->rice_expand($dim0, $blocksize);
+
+=cut
+
+
+EOD
+ PMCode => <<'EOD',
+sub PDL::rice_expand {
+ my $squished = shift;
+ my $dim0 =shift;
+ my $blocksize = shift || 32;
+
+ # Allocate output array
+ my $out = zeroes( $squished->slice("(0),*$dim0") );
+
+ # Allocate row buffer to avoid weird memory edge case
+ my $lbuf = zeroes($squished->type, $squished->dim(0));
+
+ &PDL::_rice_expand_int( $squished, $out, $lbuf, $blocksize );
+
+ return $out;
+}
+EOD
+ Code=><<'EOD',
+
+loop(n) %{
+ $lbuf() = $in();
+%}
+
+rdecomp( (unsigned char *)(&($lbuf(n=>0))),
+ $SIZE(n) * sizeof($lbuf(n=>0)),
+ &($out(m=>0)),
+ sizeof($out(m=>0)),
+ $SIZE(m),
+ $COMP(blocksize)
+ );
+
+EOD
+);
+
+
+pp_done();
+
diff --git a/Lib/Compression/ricecomp.c b/Lib/Compression/ricecomp.c
new file mode 100644
index 0000000..0b84377
--- /dev/null
+++ b/Lib/Compression/ricecomp.c
@@ -0,0 +1,696 @@
+/**********************************************************************
+ * A general purpose limited-entropy Rice compressor library
+ *
+ * The Rice algorithm is described by Rice, R.F., Yeh, P.-S., and
+ * Miller, W. H. 1993, in Proc. of the 9th AIAA Computing in Aerospace
+ * Conference, AIAA-93-45411-CP. Rice algorithms in general are simplified
+ * Golomb codes that are useful for coding data with certain statistical
+ * properties (generally, that differences between samples are typically
+ * smaller than the coded dynamic range). This code compresses blocks
+ * of samples (typically 16 or 32 samples at a time) that are stored
+ * in normal 2's complement signed integer form, with a settable number
+ * of 8-bit bytes per sample.
+ *
+ * Strict Rice coding gives rise
+ * (in principle) to extremely large symbols in the worst high-entropy
+ * case, so this library includes a block-level switch
+ *
+ * Assumptions: int is 32 bits ("long int"); short is 16 bits, byte is 8 bits.
+ *
+ * HISTORICAL NOTE:
+ *
+ * This compression library is modified from the CFITSIO library,
+ * which is distributed by the U.S. government under the above
+ * Free-compatible license. The code was originally written by
+ * Richard White at the STScI and contributed to CFITSIO in July 1999.
+ * The code has been further modified (Craig DeForest) to work in a
+ * more general-purpose way than just within CFITSIO.
+ *
+ *
+ * LICENSING & COPYRIGHT:
+ *
+ * Portions of this code are copyright (c) U.S. Government; the
+ * modifications are copyright (c) Craig DeForest. The entire library
+ * (including modifications) is licensed under the following terms
+ * (inherited from CFITSIO v. 3.24):
+ *
+ * Permission to freely use, copy, modify, and distribute this software
+ * and its documentation without fee is hereby granted, provided that this
+ * copyright notice and disclaimer of warranty appears in all copies.
+ *
+ * DISCLAIMER:
+ *
+ * THE SOFTWARE IS PROVIDED 'AS IS' WITHOUT ANY WARRANTY OF ANY KIND,
+ * EITHER EXPRESSED, IMPLIED, OR STATUTORY, INCLUDING, BUT NOT LIMITED
+ * TO, ANY WARRANTY THAT THE SOFTWARE WILL CONFORM TO SPECIFICATIONS,
+ * ANY IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
+ * PURPOSE, AND FREEDOM FROM INFRINGEMENT, AND ANY WARRANTY THAT THE
+ * DOCUMENTATION WILL CONFORM TO THE SOFTWARE, OR ANY WARRANTY THAT
+ * THE SOFTWARE WILL BE ERROR FREE. IN NO EVENT SHALL NASA BE LIABLE
+ * FOR ANY DAMAGES, INCLUDING, BUT NOT LIMITED TO, DIRECT, INDIRECT,
+ * SPECIAL OR CONSEQUENTIAL DAMAGES, ARISING OUT OF, RESULTING FROM,
+ * OR IN ANY WAY CONNECTED WITH THIS SOFTWARE, WHETHER OR NOT BASED
+ * UPON WARRANTY, CONTRACT, TORT , OR OTHERWISE, WHETHER OR NOT INJURY
+ * WAS SUSTAINED BY PERSONS OR PROPERTY OR OTHERWISE, AND WHETHER OR
+ * NOT LOSS WAS SUSTAINED FROM, OR AROSE OUT OF THE RESULTS OF, OR USE
+ * OF, THE SOFTWARE OR SERVICES PROVIDED HEREUNDER.
+ *
+ */
+
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+typedef unsigned char Buffer_t;
+typedef struct {
+ int bitbuffer; /* bit buffer */
+ int bits_to_go; /* bits to go in buffer */
+ Buffer_t *start; /* start of buffer */
+ Buffer_t *current; /* current position in buffer */
+ Buffer_t *end; /* end of buffer */
+} Buffer;
+
+#define putcbuf(c,mf) ((*(mf->current)++ = c), 0)
+
+static void start_outputing_bits(Buffer *buffer);
+static int done_outputing_bits(Buffer *buffer);
+static int output_nbits(Buffer *buffer, int bits, int n);
+
+/**********************************************************************
+ * rcomp
+ *
+ * Usage:
+ * bytes = rcomp( a, sampsiz, nx, buf, buflen, nblock )
+ *
+ * a is a pointer to the input buffer, which contains signed integer
+ * data to be encoded, either as bytes, shorts, or longs.
+ *
+ * sampsiz tells the sample size in bytes (1, 2, or 4)
+ *
+ * nx is the number of input samples to encode.
+ *
+ * buf is a pointer to the output buffer, which must be predeclared.
+ *
+ * clen is the size of the output buffer, in bytes.
+ *
+ * nblock is the coding block size to use, in samples (typ. 16 or 32)
+ *
+ *
+ * The data are encoded (and hopefully compressed) into the output buffer,
+ * and the length of the encoded data is returned. In case of failure
+ * (e.g. buffer too small) -1 is returned.
+ *
+ * The CFITSIO code has this broken out into multiple routines for
+ * different data types, but I (CED) have recombined them: the
+ * overhead of using a couple of switch() statements to combine them
+ * is believed (by me) to be negligible on modern architectures: the
+ * process is close to memory-bound, and branch prediction on high end
+ * microprocessors makes the type switches take 0 cycles anyway on
+ * most iterations.
+ *
+ */
+
+int rcomp(void *a_v, /* input array */
+ int bsize, /* sample size (in bytes) */
+ int nx, /* number of input pixels */
+ unsigned char *c, /* output buffer */
+ int clen, /* max length of output */
+ int nblock) /* coding block size */
+{
+Buffer bufmem, *buffer = &bufmem;
+int *a = (int *)a_v;
+int i, j, thisblock;
+int lastpix, nextpix, pdiff;
+int v, fs, fsmask, top, fsmax, fsbits, bbits;
+int lbitbuffer, lbits_to_go;
+unsigned int psum;
+double pixelsum, dpsum;
+unsigned int *diff;
+
+ // Blocksize is picked so that boundaries lie on 64-bit word edges for all data types
+ if(nblock & 0x7 ) {
+ fprintf(stderr,"rcomp: nblock must be divisible by 4 (is %d)\n",nblock);
+ fflush(stderr);
+ return(-1);
+ }
+
+ /* Magic numbers from fits_rcomp in CFITSIO; these have to match the ones in
+ * rdecomp, below
+ */
+ switch(bsize) {
+ case 1: // byte
+ fsbits = 3;
+ fsmax = 6;
+ break;
+ case 2: // int
+ fsbits = 4;
+ fsmax = 14;
+ break;
+ case 4: // long
+ fsbits = 5;
+ fsmax = 25;
+ break;
+ default:
+ fprintf(stderr,"rcomp: bsize must be 1, 2, or 4 bytes");
+ fflush(stderr);
+ return(-1);
+ }
+
+ bbits = 1<<fsbits;
+
+ /*
+ * Set up buffer pointers
+ */
+ buffer->start = c;
+ buffer->current = c;
+ buffer->end = c+clen;
+ buffer->bits_to_go = 8;
+
+ /*
+ * array for differences mapped to non-negative values
+ * Treat as an array of longs so it works in all cases
+ *
+ */
+ diff = (unsigned int *) malloc(nblock*sizeof(unsigned int));
+ if (diff == (unsigned int *) NULL) {
+ fprintf(stderr,"rcomp: insufficient memory (allocating %d ints for internal buffer)",nblock);
+ fflush(stderr);
+ return(-1);
+ }
+ /*
+ * Code in blocks of nblock pixels
+ */
+ start_outputing_bits(buffer);
+
+ /* write out first sample to the first bsize bytes of the buffer */
+ {
+ int a0;
+ int z;
+ a0 = a[0];
+ z = output_nbits(buffer, a0, bsize * 8);
+ if (z) {
+ // no error message - buffer overruns are silent
+ free(diff);
+ return(-1);
+ }
+ }
+
+ /* the first difference will always be zero */
+ switch(bsize) {
+ case 1: lastpix = *((char *)a); break;
+ case 2: lastpix = *((short *)a); break;
+ case 4: lastpix = *((int *)a); break;
+ default: break; // never happens (would be caught by first switch)
+ }
+
+ thisblock = nblock;
+
+ for (i=0; i<nx; i += nblock) {
+ /* last block may be shorter */
+ if (nx-i < nblock) thisblock = nx-i;
+ /*
+ * Compute differences of adjacent pixels and map them to unsigned values.
+ * Note that this may overflow the integer variables -- that's
+ * OK, because we can recover when decompressing. If we were
+ * compressing shorts or bytes, would want to do this arithmetic
+ * with short/byte working variables (though diff will still be
+ * passed as an int.)
+ *
+ * compute sum of mapped pixel values at same time
+ * use double precision for sum to allow 32-bit integer inputs
+ *
+ * This is the last time we refer directly to the input data - they
+ * are converted from byte/short/long format to long diffs, so
+ * no more type switches are needed.
+ *
+ */
+ pixelsum = 0.0;
+ for (j=0; j<thisblock; j++) {
+ switch(bsize) {
+ case 1: nextpix = ((char *)a)[i+j]; break;
+ case 2: nextpix = ((short *)a)[i+j]; break;
+ case 4: nextpix = ((int *)a)[i+j]; break;
+ default: break; // never happens
+ }
+
+ pdiff = nextpix - lastpix;
+ diff[j] = (unsigned int) ((pdiff<0) ? ~(pdiff<<1) : (pdiff<<1));
+ pixelsum += diff[j];
+ lastpix = nextpix;
+
+ }
+
+ /*
+ * compute number of bits to split from sum
+ */
+ dpsum = (pixelsum - (thisblock/2) - 1)/thisblock;
+ if (dpsum < 0) dpsum = 0.0;
+ psum = ((unsigned int) dpsum ) >> 1;
+ for (fs = 0; psum>0; fs++) psum >>= 1;
+
+ /*
+ * write the codes
+ * fsbits ID bits used to indicate split level
+ */
+ if (fs >= fsmax) {
+ /* Special high entropy case when FS >= fsmax
+ * Just write pixel difference values directly, no Rice coding at all.
+ */
+ if (output_nbits(buffer, fsmax+1, fsbits) ) {
+ // no error message - buffer overrun is silent.
+ free(diff);
+ return(-1);
+ }
+ for (j=0; j<thisblock; j++) {
+ if (output_nbits(buffer, diff[j], bbits) ) {
+ free(diff);
+ return(-1);
+ }
+ }
+ } else if (fs == 0 && pixelsum == 0) {
+ /*
+ * special low entropy case when FS = 0 and pixelsum=0 (all
+ * pixels in block are zero.)
+ * Output a 0 and return
+ */
+ if (output_nbits(buffer, 0, fsbits) ) {
+ free(diff);
+ return(-1);
+ }
+ } else {
+ /* normal case: not either very high or very low entropy */
+ if (output_nbits(buffer, fs+1, fsbits) ) {
+ free(diff);
+ return(-1);
+ }
+ fsmask = (1<<fs) - 1;
+ /*
+ * local copies of bit buffer to improve optimization
+ */
+ lbitbuffer = buffer->bitbuffer;
+ lbits_to_go = buffer->bits_to_go;
+ for (j=0; j<thisblock; j++) {
+ v = diff[j];
+ top = v >> fs;
+ /*
+ * top is coded by top zeros + 1
+ */
+ if (lbits_to_go >= top+1) {
+ lbitbuffer <<= top+1;
+ lbitbuffer |= 1;
+ lbits_to_go -= top+1;
+ } else {
+ lbitbuffer <<= lbits_to_go;
+ putcbuf(lbitbuffer & 0xff,buffer);
+
+ for (top -= lbits_to_go; top>=8; top -= 8) {
+ putcbuf(0, buffer);
+ }
+ lbitbuffer = 1;
+ lbits_to_go = 7-top;
+ }
+ /*
+ * bottom FS bits are written without coding
+ * code is output_nbits, moved into this routine to reduce overheads
+ * This code potentially breaks if FS>24, so I am limiting
+ * FS to 24 by choice of FSMAX above.
+ */
+ if (fs > 0) {
+ lbitbuffer <<= fs;
+ lbitbuffer |= v & fsmask;
+ lbits_to_go -= fs;
+ while (lbits_to_go <= 0) {
+ putcbuf((lbitbuffer>>(-lbits_to_go)) & 0xff,buffer);
+ lbits_to_go += 8;
+ }
+ }
+ }
+
+ /* check if overflowed output buffer */
+ if (buffer->current > buffer->end) {
+ free(diff);
+ return(-1);
+ }
+ buffer->bitbuffer = lbitbuffer;
+ buffer->bits_to_go = lbits_to_go;
+ }
+ }
+ done_outputing_bits(buffer);
+ free(diff);
+ /*
+ * return number of bytes used
+ */
+ return(buffer->current - buffer->start);
+}
+
+/*---------------------------------------------------------------------------*/
+/* bit_output.c
+ *
+ * Bit output routines
+ * Procedures return zero on success, EOF on end-of-buffer
+ *
+ * Programmer: R. White Date: 20 July 1998
+ */
+
+/* Initialize for bit output */
+
+static void start_outputing_bits(Buffer *buffer)
+{
+ /*
+ * Buffer is empty to start with
+ */
+ buffer->bitbuffer = 0;
+ buffer->bits_to_go = 8;
+}
+
+/*---------------------------------------------------------------------------*/
+/* Output N bits (N must be <= 32) */
+
+static int output_nbits(Buffer *buffer, int bits, int n)
+{
+/* local copies */
+int lbitbuffer;
+int lbits_to_go;
+ /* AND mask for the right-most n bits */
+ static unsigned int mask[33] =
+ {0,
+ 0x1, 0x3, 0x7, 0xf, 0x1f, 0x3f, 0x7f, 0xff,
+ 0x1ff, 0x3ff, 0x7ff, 0xfff, 0x1fff, 0x3fff, 0x7fff, 0xffff,
+ 0x1ffff, 0x3ffff, 0x7ffff, 0xfffff, 0x1fffff, 0x3fffff, 0x7fffff, 0xffffff,
+ 0x1ffffff, 0x3ffffff, 0x7ffffff, 0xfffffff, 0x1fffffff, 0x3fffffff, 0x7fffffff, 0xffffffff};
+
+ /*
+ * insert bits at end of bitbuffer
+ */
+
+ lbitbuffer = buffer->bitbuffer;
+ lbits_to_go = buffer->bits_to_go;
+ if (lbits_to_go+n > 32) {
+ /*
+ * special case for large n: put out the top lbits_to_go bits first
+ * note that 0 < lbits_to_go <= 8
+ */
+ lbitbuffer <<= lbits_to_go;
+/* lbitbuffer |= (bits>>(n-lbits_to_go)) & ((1<<lbits_to_go)-1); */
+ lbitbuffer |= (bits>>(n-lbits_to_go)) & *(mask+lbits_to_go);
+
+ if(buffer->current >= buffer->end - 1)
+ return 1;
+
+ putcbuf(lbitbuffer & 0xff,buffer);
+ n -= lbits_to_go;
+ lbits_to_go = 8;
+ }
+ lbitbuffer <<= n;
+/* lbitbuffer |= ( bits & ((1<<n)-1) ); */
+ lbitbuffer |= ( bits & *(mask+n) );
+ lbits_to_go -= n;
+ while (lbits_to_go <= 0) {
+ /*
+ * bitbuffer full, put out top 8 bits
+ */
+ if(buffer->current >= buffer->end)
+ return 1;
+
+ putcbuf((lbitbuffer>>(-lbits_to_go)) & 0xff,buffer);
+ lbits_to_go += 8;
+ }
+ buffer->bitbuffer = lbitbuffer;
+ buffer->bits_to_go = lbits_to_go;
+
+ if(buffer->bits_to_go < 8 && buffer->current >= buffer->end -2)
+ return 1;
+
+ return(0);
+}
+/*---------------------------------------------------------------------------*/
+/* Flush out the last bits */
+
+static int done_outputing_bits(Buffer *buffer)
+{
+ if(buffer->bits_to_go < 8) {
+ putcbuf(buffer->bitbuffer<<buffer->bits_to_go,buffer);
+ }
+ return(0);
+}
+
+
+/**********************************************************************
+ * rdecomp
+ *
+ * Usage:
+ * errflag = rdecomp(a, clen, outbuf, sampsiz, nx, nblock)
+ *
+ * a is a pointer to the input buffer, which contains rice-compressed
+ * data (e.g. from rcomp, above).
+ *
+ * clen is the length of the input buffer, in bytes.
+ *
+ * outbuf is a pointer to the output buffer, which should be
+ * a pre-allocated array of chars, shorts, or longs according to
+ * sampsiz.
+ *
+ * sampsiz tells the sample size in bytes (1, 2, or 4)
+ *
+ * nx tells the number of samples in the output buffer (which are
+ * all expected to be present in the compressed stream).
+ *
+ * nblock is the block size, in samples, for compression.
+ *
+ *
+ * The data are decoded into the output buffer. On normal completion
+ * 0 is returned.
+ */
+
+int rdecomp (unsigned char *c, /* input buffer */
+ int clen, /* length of input (bytes) */
+ void *array, /* output array */
+ int bsize, /* bsize - bytes per pix of output */
+ int nx, /* number of output pixels */
+ int nblock) /* coding block size (in pixels) */
+{
+ int i, k, imax;
+ int nbits, nzero, fs;
+ unsigned char *cend, bytevalue;
+ unsigned int b, diff, lastpix;
+ int fsmax, fsbits, bbits;
+ static int *nonzero_count = (int *)NULL;
+
+ /*
+ * From bsize derive:
+ * FSBITS = # bits required to store FS
+ * FSMAX = maximum value for FS
+ * BBITS = bits/pixel for direct coding
+ *
+ * (These magic numbers have to match the ones in rcomp above.)
+ */
+
+
+ switch (bsize) {
+ case 1:
+ fsbits = 3;
+ fsmax = 6;
+ break;
+ case 2:
+ fsbits = 4;
+ fsmax = 14;
+ break;
+ case 4:
+ fsbits = 5;
+ fsmax = 25;
+ break;
+ default:
+ fprintf(stderr,"rdecomp: bsize must be 1, 2, or 4 bytes");
+ fflush(stderr);
+ return 1;
+ }
+
+ bbits = 1<<fsbits;
+
+ if (nonzero_count == (int *) NULL) {
+ /*
+ * nonzero_count is lookup table giving number of bits
+ * in 8-bit values not including leading zeros; gets allocated
+ * and calculated the first time through
+ */
+
+ /* NOTE!!! This memory never gets freed (permanent table) */
+ nonzero_count = (int *) malloc(256*sizeof(int));
+ if (nonzero_count == (int *) NULL) {
+ fprintf(stderr,"rdecomp: insufficient memory!\n");
+ fflush(stderr);
+ return 1;
+ }
+ nzero = 8;
+ k = 128;
+ for (i=255; i>=0; ) {
+ for ( ; i>=k; i--) nonzero_count[i] = nzero;
+ k = k/2;
+ nzero--;
+ }
+ }
+
+ /*
+ * Decode in blocks of nblock pixels
+ */
+
+ /* first bytes of input buffer contain the value of the first */
+ /* integer value, without any encoding */
+
+
+ cend = c + clen;
+
+ lastpix = 0;
+ switch(bsize) {
+ case 4:
+ bytevalue = c[0];
+ lastpix = lastpix | (bytevalue<<24);
+ bytevalue = c[1];
+ lastpix = lastpix | (bytevalue<<16);
+ bytevalue = c[2];
+ lastpix = lastpix | (bytevalue<<8);
+ bytevalue = c[3];
+ lastpix = lastpix | bytevalue;
+ c+=4;
+ break;
+ case 2:
+ bytevalue = c[0];
+ lastpix = lastpix | (bytevalue<<8);
+ bytevalue = c[1];
+ lastpix = lastpix | bytevalue;
+ c+=2;
+ break;
+ case 1:
+ lastpix = c[0];
+ c++;
+ break;
+ default: // never happens
+ break;
+ }
+
+ b = *c++; /* bit buffer */
+ nbits = 8; /* number of bits remaining in b */
+ for (i = 0; i<nx; ) {
+ /* get the FS value from first fsbits */
+ nbits -= fsbits;
+ while (nbits < 0) {
+ b = (b<<8) | (*c++);
+ nbits += 8;
+ }
+ fs = (b >> nbits) - 1;
+
+ b &= (1<<nbits)-1;
+ /* loop over the next block */
+ imax = i + nblock;
+ if (imax > nx) imax = nx;
+ if (fs<0) {
+ /* low-entropy case, all zero differences */
+ for ( ; i<imax; i++) {
+ switch(bsize) {
+ case 1: ((char *)array)[i] = lastpix; break;
+ case 2: ((short *)array)[i] = lastpix; break;
+ case 4: ((int *)array)[i] = lastpix; break;
+ default: break;
+ }
+ }
+ } else if (fs==fsmax) {
+ /* high-entropy case, directly coded pixel values */
+ for ( ; i<imax; i++) {
+ k = bbits - nbits;
+ diff = b<<k;
+ for (k -= 8; k >= 0; k -= 8) {
+ b = *c++;
+ diff |= b<<k;
+ }
+ if (nbits>0) {
+ b = *c++;
+ diff |= b>>(-k);
+ b &= (1<<nbits)-1;
+ } else {
+ b = 0;
+ }
+ /*
+ * undo mapping and differencing
+ * Note that some of these operations will overflow the
+ * unsigned int arithmetic -- that's OK, it all works
+ * out to give the right answers in the output file.
+ */
+ if ((diff & 1) == 0) {
+ diff = diff>>1;
+ } else {
+ diff = ~(diff>>1);
+ }
+
+ switch(bsize) {
+ case 1:
+ ((char *)array)[i] = diff + lastpix;
+ lastpix = ((char *)array)[i];
+ break;
+ case 2:
+ ((short *)array)[i] = diff + lastpix;
+ lastpix = ((short *)array)[i];
+ break;
+ case 4:
+ ((int *)array)[i] = diff + lastpix;
+ lastpix = ((int *)array)[i];
+ break;
+ default: // never happens
+ break;
+ }
+ }
+ } else {
+ /* normal case, Rice coding */
+ for ( ; i<imax; i++) {
+ /* count number of leading zeros */
+ while (b == 0) {
+ nbits += 8;
+ b = *c++;
+ }
+ nzero = nbits - nonzero_count[b];
+ nbits -= nzero+1;
+ /* flip the leading one-bit */
+ b ^= 1<<nbits;
+ /* get the FS trailing bits */
+ nbits -= fs;
+ while (nbits < 0) {
+ b = (b<<8) | (*c++);
+ nbits += 8;
+ }
+ diff = (nzero<<fs) | (b>>nbits);
+ b &= (1<<nbits)-1;
+
+ /* undo mapping and differencing */
+ if ((diff & 1) == 0) {
+ diff = diff>>1;
+ } else {
+ diff = ~(diff>>1);
+ }
+
+ switch(bsize) {
+ case 1:
+ ((char *)array)[i] = diff + lastpix;
+ lastpix = ((char *)array)[i];
+ break;
+ case 2:
+ ((short *)array)[i] = diff + lastpix;
+ lastpix = ((short *)array)[i];
+ break;
+ case 4:
+ ((int *)array)[i] = diff + lastpix;
+ lastpix = ((int *)array)[i];
+ break;
+ default: // never happens
+ break;
+ }
+ }
+ }
+ if (c > cend) {
+ fprintf(stderr,"rdecomp: decompression error: hit end of compressed byte stream\n");
+ fflush(stderr);
+ return 1;
+ }
+ }
+ return 0;
+}
+
diff --git a/Lib/DiskCache.pm b/Lib/DiskCache.pm
new file mode 100644
index 0000000..4996b1c
--- /dev/null
+++ b/Lib/DiskCache.pm
@@ -0,0 +1,422 @@
+=head1 NAME
+
+PDL::DiskCache -- Non-memory-resident array object
+
+=head1 SYNOPSIS
+
+NON-OO:
+
+ use PDL::DiskCache;
+ tie @a,'PDL::DiskCache', \@files, \%options;
+ imag $a[3];
+
+OO:
+
+ use PDL::DiskCache;
+ $a = diskcache(\@files,\%options);
+ imag $a->[3];
+
+or
+
+ use PDL::DiskCache;
+ $a = new PDL::DiskCache(\@files,\%options);
+ imag $a->[4];
+
+=over 3
+
+=item \@files
+
+an array ref containing a list of file names
+
+=item \%options
+
+a hash ref containing options for the PDL::DiskCache object (see "TIEARRAY"
+below for details)
+
+=back
+
+=head1 DESCRIPTION
+
+A PDL::DiskCache object is a perl L<"tied array"|perltie> that is useful
+for operations where you have to look at a large collection of PDLs one
+or a few at a time (such as tracking features through an image sequence).
+You can write prototype code that uses a perl list of a few PDLs, then
+scale up to to millions of PDLs simply by handing the prototype code
+a DiskCache tied array instead of a native perl array. The individual
+PDLs are stored on disk and a few of them are swapped into memory on a
+FIFO basis. You can set whether the data are read-only or writeable.
+
+By default, PDL::DiskCache uses FITS files to represent the PDLs, but
+you can use any sort of file at all -- the read/write routines are the
+only place where it examines the underlying data, and you can specify
+the routines to use at construction time (or, of course, subclass
+PDL::DiskCache).
+
+Items are swapped out on a FIFO basis, so if you have 10 slots
+and an expression with 10 items in it then you're OK (but you probably
+want more slots than that); but if you use more items in an expression than
+there are slots, thrashing will occur!
+
+The hash ref interface is kept for historical reasons; you can access
+the sync() and purge() method calls directly from the returned array ref.
+
+=head1 Shortcomings & caveats
+
+There's no file locking, so you could really hose yourself by having two of
+these things going at once on the same files.
+
+Since this is a tied array, things like Dumper traverse it transparently.
+That is sort-of good but also sort-of dangerous. You wouldn't want to
+PDL::Dumper::sdump() a large PDL::DiskCache, for example -- that would defeat
+the purpose of using a PDL::DiskCache in the first place.
+
+
+
+=head1 Author, license, no warranty
+
+Copyright 2001, Craig DeForest
+
+This code may be distributed under the same terms as Perl itself
+(license available at L<http://www.perl.org>). Copying, reverse engineering,
+distribution, and modification are explicitly allowed so long as this notice
+is preserved intact and modified versions are clearly marked as such.
+
+If you modify the code and it's useful, please send a copy of the modified
+version to cdeforest at solar.stanford.edu.
+
+This package comes with NO WARRANTY.
+
+=head1 FUNCTIONS
+
+=cut
+
+######################################################################
+# Package initialization
+$PDL::DiskCache::VERSION = 1.1;
+
+use strict;
+use Carp;
+
+=head2 diskcache
+
+Object constructor.
+
+=for usage
+
+ $a = diskcache(\@f,\%options);
+
+Options
+
+=over 3
+
+=item
+
+See the TIEARRAY options,below.
+
+=back
+
+=cut
+
+sub diskcache {
+ my($f,$opt) = @_;
+ return PDL::DiskCache::new('PDL::DiskCache',$f,$opt);
+}
+
+sub PDL::DiskCache::new {
+ my($class,$f,$opt) = @_;
+ my($a)=[];
+
+ my($b) = tie @{$a},$class,$f,$opt;
+ if($opt->{bless}) {
+ $a = bless($a,$class);
+ }
+
+ if(wantarray) {
+ return ($a,bless($b,$class));
+ } else {
+ return $a;
+ }
+}
+
+*PDL::DiskCache::diskcache = *diskcache;
+
+=head2 TIEARRAY
+
+=for ref
+
+Tied-array constructor; invoked by perl during object construction.
+
+=for usage
+
+ TIEARRAY(class,\@f,\%options)
+
+Options
+
+=over 3
+
+=item ro (default 0)
+
+If set, treat the files as read-only (modifications
+to the tied array will only persist until the changed elements are
+swapped out)
+
+=item rw (default 1)
+
+If set, allow reading and writing to the files.
+Because there's currently no way to determine reliably whether a PDL
+has been modified, rw files are always written to disk when they're
+swapped out -- this causes a slight performance hit.
+
+=item mem (default 20)
+
+Number of files to be cached in memory at once.
+
+=item read (default \&rfits)
+
+A function ref pointing to code that will read
+list objects from disk. The function must have the same syntax as
+rfits: $object = rfits(filename).
+
+=item write (default \&wfits)
+
+A function ref pointing to code that will
+write list objects to disk. The function must have the same syntax as
+wfits: func(object,filename).
+
+=item bless (default 0)
+
+If set to a nonzero value, then the array ref gets
+blessed into the DiskCache class for for easier access to the "purge"
+and "sync" methods. This means that you can say C<< $a->sync >> instead
+of the more complex C<< (%{tied @$a})->sync >>, but C<ref $a> will return
+"PDL::DiskCache" instead of "ARRAY", which could break some code.
+
+=item verbose (default 0)
+
+Get chatty.
+
+=back
+
+=cut
+
+sub PDL::DiskCache::TIEARRAY {
+ my($class,$f,$opt) = @_;
+
+ croak "PDL::DiskCache needs array ref as 2nd arg (did you pass an array instead?)\n"
+ if(ref $f ne 'ARRAY');
+ my($new) = {files => $f # File list
+ , n => scalar(@{$f}) # no. of el.
+ , write => $opt->{write} || \&main::wfits # Write routine
+ , read => $opt->{read} || \&main::rfits # Read routine
+ , mem => $opt->{mem} || 20 # No. of mem slots
+ , rw => (!($opt->{ro})) # rw or ro
+ , fdex => [] # Current file stored in each slot, by slot
+ , slot => [] # Current slot in which each file is stored
+ , cache => [] # Actual cached stuff gets held here
+ , opt => {} # Options stashed here for later reference
+ , cache_next => 0 # Next cache slot to be used
+ };
+ foreach $_(keys %{$opt}) {
+ $new->{opt}->{$_} = $opt->{$_};
+ }
+
+ return bless($new,$class);
+}
+
+=head2 purge
+
+Remove an item from the oldest slot in the cache, writing to disk as necessary.
+You also send in how many slots to purge (default 1; sending in -1 purges
+everything.)
+
+For most uses, a nice MODIFIED flag in the data structure could save
+some hassle here. But PDLs can get modified out from under us
+with slicing and .= -- so for now we always assume everything is tainted
+and must be written to disk.
+
+=cut
+
+sub PDL::DiskCache::purge {
+ my($me,$n) = @_,1;
+ $me = (tied @{$me}) if("$me" =~ m/^PDL\:\:DiskCache\=ARRAY/);
+
+ $n = $me->{mem} if($n<0);
+
+ print "purging $n items..." if($me->{opt}->{verbose});
+
+
+ my($dex) = $me->{cache_next};
+
+ local($_);
+ for(1..$n) {
+ if($me->{rw}) {
+ print "writing $me->{files}->[$me->{fdex}->[$dex]]: "
+ if($me->{opt}->{verbose});
+
+ eval {&{$me->{write}}($me->{cache}->[$dex],
+ $me->{files}->[$me->{fdex}->[$dex]]);
+ };
+ print "WARNING: PDL::DiskCache::purge: problems with write of ".$me->{files}->[$me->{fdex}->[$dex]].", item $me->{fdex}->[$dex] from slot $dex: `$@' (".$me->{opt}->{varname}.") \n" if($@);
+ $@ = 0;
+
+ print "ok.\n" if($me->{opt}->{verbose});
+ }
+
+
+ print "Purging item $dex (file $me->{fdex}->[$dex])...\n" if($me->{opt}->{verbose});
+ undef $me->{slot}->[$me->{fdex}->[$dex]]; # Purge from slot location list
+ undef $me->{fdex}->[$dex]; # Purge from slot fdex list
+ undef $me->{cache}->[$dex]; # Purge from memory
+
+ $dex++;
+ $dex %= $me->{mem};
+ }
+ print "...done with purge.\n" if($me->{opt}->{verbose});
+}
+
+sub PDL::DiskCache::FETCH {
+ my($me,$i) = @_;
+
+ if($i < 0 || $i >= $me->{n}) {
+ carp("PDL::DiskCache: Element $i is outside range of 0-",$me->{n}-1,"\n");
+ return undef;
+ }
+
+ if(defined $me->{slot}->[$i]) {
+ print "Item $i is in the cache...\n" if ($me->{opt}->{verbose});
+ return ($me->{cache}->[$me->{slot}->[$i]]);
+ }
+
+ ### Got here -- we have to get the item from disk.
+
+ print "Item $i ($me->{files}->[$i]) not present. Retrieving..."
+ if($me->{opt}->{verbose});
+
+ if(defined($me->{fdex}->[$me->{cache_next}])) {
+ print "cache full..." if($me->{opt}->{verbose});
+
+ $me->purge(1);
+ }
+
+ my($a) = $me->{cache_next};
+ $me->{cache}->[$a] = eval {
+ &{$me->{read}}($me->{files}->[$i])
+ } ;
+ undef $@; # Keep this from hanging anything else.
+ print "result is ",(defined $me->{cache}->[$a] ? "" : "un")."defined.\n"
+ if($me->{opt}->{verbose});
+
+ $me->{slot}->[$i] = $me->{cache_next};
+ $me->{fdex}->[$me->{cache_next}] = $i;
+ $me->{cache_next}++;
+ $me->{cache_next} %= $me->{mem};
+ $me->{cache}->[$a];
+}
+
+sub PDL::DiskCache::STORE {
+ my($me, $i, $val) = @_;
+
+ if( $me->{slot}->[$i] ) {
+ print "Storing index $i, in cache\n" if($me->{opt}->{verbose});
+ $me->sync;
+ return $me->{cache}->[$me->{slot}->[$i]] = $val;
+ } else {
+ print "Storing index $i, not in cache\n" if($me->{opt}->{verbose});
+ if(defined ($me->{fdex}->[$me->{cache_next}])) {
+ print "cache full..." if($me->{opt}->{verbose});
+ $me->purge(1);
+ }
+
+ my($a) = $me->{cache_next};
+ $me->{slot}->[$i] = $a;
+ $me->{fdex}->[$a] = $i;
+ $me->{cache_next}++;
+ $me->{cache_next} %= $me->{mem};
+ $me->sync;
+ return $me->{cache}->[$a] = $val;
+ }
+
+ croak("This never happens");
+
+}
+
+sub PDL::DiskCache::FETCHSIZE {
+ my($me) = shift;
+
+ $me->{n};
+}
+
+sub PDL::DiskCache::STORESIZE {
+ my($me,$newsize) = @_;
+
+ if($newsize > $me->{n}) {
+ croak("PDL::DiskCache: Can't augment array size (yet)!\n");
+ }
+
+ for( my($i) = $newsize-1; $i<$me->{n}; $i++ ) {
+ if(defined $me->{slot}->[$i]) {
+ if($me->{rw}) {
+ print "Writing $me->{files}->[$me->{fdex}->[$i]]\n"
+ if($me->{opt}->{verbose});
+ eval {&{$me->{write}}($me->{cache}->[$me->{slot}->[$i]],
+ $me->{files}->[$i]);
+ };
+ $@ = 0; # Keep from hanging anything else
+ }
+ undef $me->{fdex}->[$me->{slot}->[$i]];
+ }
+ }
+ $#{$me->{slot}} = $newsize-1;
+ $#{$me->{files}} = $newsize-1;
+ $me->{n} = $newsize;
+}
+
+=head2 sync
+
+In a rw cache, flush all items out to disk but retain them in the cache.
+This is useful primarily for cache protection and could be slow. Because
+we have no way of knowing what's modified and what's not in the cache,
+all elements are always flushed from an rw cache. For ro caches,
+this is a not-too-slow (but safe) no-op.
+
+=cut
+
+sub PDL::DiskCache::sync {
+ my($me) = shift;
+ $me = (tied @{$me}) if("$me" =~ m/^PDL\:\:DiskCache\=ARRAY/);
+
+ print "PDL::DiskCache::sync\n" if($me->{opt}->{verbose});
+
+ if($me->{rw}) {
+ for(0..$me->{mem}-1) {
+ if(defined $me->{fdex}->[$_]) {
+
+ print " writing $me->{files}->[$me->{fdex}->[$_]]...\n"
+ if($me->{opt}->{verbose});
+
+ eval {&{$me->{write}}($me->{cache}->[$_],
+ $me->{files}->[$me->{fdex}->[$_]]);
+ };
+ $@ = 0; # keep from hanging anything else
+ }
+ }
+ }
+}
+
+=head2 DESTROY
+
+This is the perl hook for object destruction. It just makes a call to
+"sync", to flush the cache out to disk. Destructor calls from perl don't
+happen at a guaranteed time, so be sure to call "sync" if you need to
+ensure that the files get flushed out, e.g. to use 'em somewhere else.
+
+=cut
+
+sub PDL::DiskCache::DESTROY {
+ my($me) = shift;
+
+ $me->sync;
+}
+
+# return true
+1;
diff --git a/Lib/FFT/Makefile.PL b/Lib/FFT/Makefile.PL
new file mode 100644
index 0000000..40c67f9
--- /dev/null
+++ b/Lib/FFT/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for PDL::Primitive module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+ at pack = (["fft.pd",FFT,PDL::FFT]);
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{OBJECT} .= ' fftn.o';
+$hash{DEFINE} .= ' -DFFT_FLOAT';
+$hash{LIBS} = ['-lm'] unless $^O =~ /MSWin/;
+
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Lib/FFT/fft.pd b/Lib/FFT/fft.pd
new file mode 100644
index 0000000..291e055
--- /dev/null
+++ b/Lib/FFT/fft.pd
@@ -0,0 +1,609 @@
+
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::FFT - FFTs for PDL
+
+=head1 DESCRIPTION
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!WARNING!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+As of PDL-2.006_04, the direction of the FFT/IFFT has been
+reversed to match the usage in the FFTW library and the convention
+in use generally.
+!!!!!!!!!!!!!!!!!!!!!!!!!!WARNING!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+FFTs for PDL. These work for arrays of any dimension, although ones
+with small prime factors are likely to be the quickest. The forward
+FFT is unnormalized while the inverse FFT is normalized so that the
+IFFT of the FFT returns the original values.
+
+For historical reasons, these routines work in-place and do not recognize
+the in-place flag. That should be fixed.
+
+=head1 SYNOPSIS
+
+ use PDL::FFT qw/:Func/;
+
+ fft($real, $imag);
+ ifft($real, $imag);
+ realfft($real);
+ realifft($real);
+
+ fftnd($real,$imag);
+ ifftnd($real,$imag);
+
+ $kernel = kernctr($image,$smallk);
+ fftconvolve($image,$kernel);
+
+=head1 DATA TYPES
+
+The underlying C library upon which this module is based performs FFTs
+on both single precision and double precision floating point piddles.
+Performing FFTs on integer data types is not reliable. Consider the
+following FFT on piddles of type 'double':
+
+ $r = pdl(0,1,0,1);
+ $i = zeroes($r);
+ fft($r,$i);
+ print $r,$i;
+ [2 0 -2 0] [0 0 0 0]
+
+But if $r and $i are unsigned short integers (ushorts):
+
+ $r = pdl(ushort,0,1,0,1);
+ $i = zeroes($r);
+ fft($r,$i);
+ print $r,$i;
+ [2 0 65534 0] [0 0 0 0]
+
+This used to occur because L<PDL::PP|PDL::PP> converts the ushort
+piddles to floats or doubles, performs the FFT on them, and then
+converts them back to ushort, causing the overflow where the amplitude
+of the frequency should be -2.
+
+Therefore, if you pass in a piddle of integer datatype (byte, short,
+ushort, long) to any of the routines in PDL::FFT, your data will be
+promoted to a double-precision piddle. If you pass in a float, the
+single-precision FFT will be performed.
+
+=head1 FREQUENCIES
+
+For even-sized input arrays, the frequencies are packed like normal
+for FFTs (where N is the size of the array and D is the physical step
+size between elements):
+
+ 0, 1/ND, 2/ND, ..., (N/2-1)/ND, 1/2D, -(N/2-1)/ND, ..., -1/ND.
+
+which can easily be obtained (taking the Nyquist frequency to be
+positive) using
+
+C<< $kx = $real->xlinvals(-($N/2-1)/$N/$D,1/2/$D)->rotate(-($N/2 -1)); >>
+
+For odd-sized input arrays the Nyquist frequency is not directly
+acessible, and the frequencies are
+
+ 0, 1/ND, 2/ND, ..., (N/2-0.5)/ND, -(N/2-0.5)/ND, ..., -1/ND.
+
+which can easily be obtained using
+
+C<< $kx = $real->xlinvals(-($N/2-0.5)/$N/$D,($N/2-0.5)/$N/$D)->rotate(-($N-1)/2); >>
+
+
+=head1 ALTERNATIVE FFT PACKAGES
+
+Various other modules - such as
+L<PDL::FFTW|PDL::FFTW> and L<PDL::Slatec|PDL::Slatec> -
+contain FFT routines.
+However, unlike PDL::FFT, these modules are optional,
+and so may not be installed.
+
+=cut
+
+EOD
+
+pp_addhdr('
+int fftn (int ndim, const int dims[], double Re[], double Im[],
+ int iSign, double scaling);
+int fftnf (int ndim, const int dims[], float Re[], float Im[],
+ int iSign, float scaling);
+void fft_free();
+');
+pp_addxs('','
+
+int
+fft_free()
+ CODE:
+ fft_free();
+ RETVAL = 1;
+ OUTPUT:
+ RETVAL
+');
+pp_def('_fft',
+ Pars => '[o,nc]real(n); [o,nc]imag(n);',
+ 'NoPthread' => 1, # underlying fft code (fftn.c) isn't threadsafe
+ GenericTypes => [F,D],
+ Code => '$TFD(fftnf,fftn)
+ ($SIZE(n), NULL , $P(real),$P(imag), -1, 1.);',
+ Doc=>undef
+);
+
+pp_def('_ifft',
+ Pars => '[o,nc]real(n); [o,nc]imag(n);',
+ 'NoPthread' => 1, # underlying fft code (fftn.c) isn't threadsafe
+ GenericTypes => [F,D],
+ Code => '$TFD(fftnf,fftn)
+ ($SIZE(n), NULL , $P(real),$P(imag), 1, -1.);',
+ Doc=>undef
+);
+
+pp_add_exported('',"fft ifft fftnd ifftnd fftconvolve realfft realifft kernctr");
+
+pp_addpm(<<'EOD');
+
+use Carp;
+use PDL::Core qw/:Func/;
+use PDL::Basic qw/:Func/;
+use PDL::Types;
+use PDL::ImageND qw/kernctr/; # moved to ImageND since FFTW uses it too
+
+END {
+ # tidying up required after using fftn
+ print "Freeing FFT space\n" if $PDL::verbose;
+ fft_free();
+}
+
+sub todecimal {
+ my ($arg) = @_;
+ $arg = $arg->double if (($arg->get_datatype != $PDL_F) &&
+ ($arg->get_datatype != $PDL_D));
+ $_[0] = $arg;
+1;}
+
+=head2 fft()
+
+=for ref
+
+Complex 1-D FFT of the "real" and "imag" arrays [inplace].
+
+=for sig
+
+ Signature: ([o,nc]real(n); [o,nc]imag(n))
+
+=for usage
+
+fft($real,$imag);
+
+=cut
+
+*fft = \&PDL::fft;
+
+sub PDL::fft {
+ # Convert the first argument to decimal and check for trouble.
+ eval { todecimal($_[0]); };
+ if ($@) {
+ $@ =~ s/ at .*//s;
+ barf("Error in FFT with first argument: $@");
+ }
+ # Convert the second argument to decimal and check for trouble.
+ eval { todecimal($_[1]); };
+ if ($@) {
+ $@ =~ s/ at .*//s;
+ my $message = "Error in FFT with second argument: $@";
+ $message .= '. Did you forget to supply the second (imaginary) piddle?'
+ if ($message =~ /undefined value/);
+ barf($message);
+ }
+ _fft($_[0],$_[1]);
+}
+
+
+=head2 ifft()
+
+=for ref
+
+Complex inverse 1-D FFT of the "real" and "imag" arrays [inplace].
+
+=for sig
+
+ Signature: ([o,nc]real(n); [o,nc]imag(n))
+
+=for usage
+
+ifft($real,$imag);
+
+=cut
+
+*ifft = \&PDL::ifft;
+
+sub PDL::ifft {
+ # Convert the first argument to decimal and check for trouble.
+ eval { todecimal($_[0]); };
+ if ($@) {
+ $@ =~ s/ at .*//s;
+ barf("Error in FFT with first argument: $@");
+ }
+ # Convert the second argument to decimal and check for trouble.
+ eval { todecimal($_[1]); };
+ if ($@) {
+ $@ =~ s/ at .*//s;
+ my $message = "Error in FFT with second argument: $@";
+ $message .= '. Did you forget to supply the second (imaginary) piddle?'
+ if ($message =~ /undefined value/);
+ barf($message);
+ }
+ _ifft($_[0],$_[1]);
+}
+
+=head2 realfft()
+
+=for ref
+
+One-dimensional FFT of real function [inplace].
+
+The real part of the transform ends up in the first half of the array
+and the imaginary part of the transform ends up in the second half of
+the array.
+
+=for usage
+
+ realfft($real);
+
+=cut
+
+*realfft = \&PDL::realfft;
+
+sub PDL::realfft {
+ barf("Usage: realfft(real(*)") if $#_ != 0;
+ my ($a) = @_;
+ todecimal($a);
+# FIX: could eliminate $b
+ my ($b) = 0*$a;
+ fft($a,$b);
+ my ($n) = int((($a->dims)[0]-1)/2); my($t);
+ ($t=$a->slice("-$n:-1")) .= $b->slice("1:$n");
+ undef;
+}
+
+=head2 realifft()
+
+=for ref
+
+Inverse of one-dimensional realfft routine [inplace].
+
+=for usage
+
+ realifft($real);
+
+=cut
+
+*realifft = \&PDL::realifft;
+
+sub PDL::realifft {
+ use PDL::Ufunc 'max';
+ barf("Usage: realifft(xfm(*)") if $#_ != 0;
+ my ($a) = @_;
+ todecimal($a);
+ my ($n) = int((($a->dims)[0]-1)/2); my($t);
+# FIX: could eliminate $b
+ my ($b) = 0*$a;
+ ($t=$b->slice("1:$n")) .= $a->slice("-$n:-1");
+ ($t=$a->slice("-$n:-1")) .= $a->slice("$n:1");
+ ($t=$b->slice("-$n:-1")) .= -$b->slice("$n:1");
+ ifft($a,$b);
+# Sanity check -- shouldn't happen
+ carp "Bad inverse transform in realifft" if max(abs($b)) > 1e-6*max(abs($a));
+ undef;
+}
+
+=head2 fftnd()
+
+=for ref
+
+N-dimensional FFT over all pdl dims of input (inplace)
+
+=for example
+
+ fftnd($real,$imag);
+
+=cut
+
+*fftnd = \&PDL::fftnd;
+
+sub PDL::fftnd {
+ barf "Must have real and imaginary parts for fftnd" if $#_ != 1;
+ my ($r,$i) = @_;
+ my ($n) = $r->getndims;
+ barf "Dimensions of real and imag must be the same for fft"
+ if ($n != $i->getndims);
+ $n--;
+ todecimal($r);
+ todecimal($i);
+ # need the copy in case $r and $i point to same memory
+ $i = $i->copy;
+ foreach (0..$n) {
+ fft($r,$i);
+ $r = $r->mv(0,$n);
+ $i = $i->mv(0,$n);
+ }
+ $_[0] = $r; $_[1] = $i;
+ undef;
+}
+
+=head2 ifftnd()
+
+=for ref
+
+N-dimensional inverse FFT over all pdl dims of input (inplace)
+
+=for example
+
+ ifftnd($real,$imag);
+
+=cut
+
+*ifftnd = \&PDL::ifftnd;
+
+sub PDL::ifftnd {
+ barf "Must have real and imaginary parts for ifftnd" if $#_ != 1;
+ my ($r,$i) = @_;
+ my ($n) = $r->getndims;
+ barf "Dimensions of real and imag must be the same for ifft"
+ if ($n != $i->getndims);
+ todecimal($r);
+ todecimal($i);
+ # need the copy in case $r and $i point to same memory
+ $i = $i->copy;
+ $n--;
+ foreach (0..$n) {
+ ifft($r,$i);
+ $r = $r->mv(0,$n);
+ $i = $i->mv(0,$n);
+ }
+ $_[0] = $r; $_[1] = $i;
+ undef;
+}
+
+EOD
+
+# This version uses the fft routines' internal row/column swapping.
+# Doing this instead through PDL seems quicker at the moment.
+
+if (0) {
+pp_def('fftnd',
+ Pars => 'int dims(n); [o,nc]real(m); [o,nc]imag(m);',
+ GenericTypes => [F,D],
+ PMCode => '
+
+sub PDL::fftnd{
+ barf("Usage: fftnd(real(*), imag(*)") if $#_ != 1;
+ my($a,$b) = @_;
+ my(@dimsa) = $a->dims;
+ my(@dimsb) = $b->dims;
+ my($dimsa) = long \@dimsa;
+ foreach(@dimsa) {
+ barf "Real and imaginary arrays must have same dimensions"
+ if ($_ != shift @dimsb);
+ }
+ &PDL::_fftnd_int($dimsa, $a->clump(-1), $b->clump(-1));
+}
+
+',
+ Code => ' int *dima, ns=$SIZE(n), j;
+ dima = (int *) malloc(ns*sizeof(int));
+ if (!dima)
+ barf("fftnd: Out of memory for dimension array");
+ for (j=0;j<ns;j++)
+ dima[j] = $dims(n=>j);
+ $TFD(fftnf,fftn)(ns, dima, $P(real),$P(imag), 1, 1.);
+ free(dima);
+',
+ Doc=>'N-dimensional FFT [inplace].'
+);
+
+pp_def('ifftnd',
+ Pars => 'int dims(n); [o,nc]real(m); [o,nc]imag(m);',
+ GenericTypes => [F,D],
+ PMCode => '
+
+sub PDL::ifftnd{
+ barf("Usage: ifftnd(real(*), imag(*)") if $#_ != 1;
+ my($a,$b) = @_;
+ my(@dimsa) = $a->dims;
+ my(@dimsb) = $b->dims;
+ my($dimsa) = long \@dimsa;
+ foreach(@dimsa) {
+ barf "Real and imaginary arrays must have same dimensions"
+ if ($_ != shift @dimsb);
+ }
+ &PDL::_ifftnd_int($dimsa, $a->clump(-1), $b->clump(-1));
+}
+
+',
+ Code => ' int *dima, ns=$SIZE(n), j;
+ dima = (int *) malloc(ns*sizeof(int));
+ if (!dima)
+ barf("ifftnd: Out of memory for dimension array");
+ for (j=0;j<ns;j++)
+ dima[j] = $dims(n=>j);
+ $TFD(fftnf,fftn)(ns, dima, $P(real),$P(imag), -1, -1.);
+ free(dima);
+',
+ Doc=>'N-dimensional inverse FFT [inplace].'
+);
+}
+
+pp_addpm(<<'EOD');
+
+=head2 fftconvolve()
+
+=for ref
+
+N-dimensional convolution with periodic boundaries (FFT method)
+
+=for usage
+
+ $kernel = kernctr($image,$smallk);
+ fftconvolve($image,$kernel);
+
+fftconvolve works inplace, and returns an error array in kernel as an
+accuracy check -- all the values in it should be negligible.
+
+See also L<PDL::ImageND::convolveND|PDL::ImageND/convolveND>, which
+performs speed-optimized convolution with a variety of boundary conditions.
+
+The sizes of the image and the kernel must be the same.
+L<kernctr|PDL::ImageND/kernctr> centres a small kernel to emulate the
+behaviour of the direct convolution routines.
+
+The speed cross-over between using straight convolution
+(L<PDL::Image2D::conv2d()|PDL::Image2D/conv2d>) and
+these fft routines is for kernel sizes roughly 7x7.
+
+=cut
+
+*fftconvolve = \&PDL::fftconvolve;
+
+sub PDL::fftconvolve {
+ barf "Must have image & kernel for fftconvolve" if $#_ != 1;
+ my ($a, $k) = @_;
+
+ my ($ar,$ai,$kr,$ki,$cr,$ci);
+
+ $ar = $a->copy;
+ $ai = $ar->zeros;
+ fftnd($ar, $ai);
+
+ $kr = $k->copy;
+ $ki = $kr->zeroes;
+ fftnd($kr,$ki);
+
+ $cr = $ar->zeroes;
+ $ci = $ai->zeroes;
+ cmul($ar,$ai,$kr,$ki,$cr,$ci);
+
+ ifftnd($cr,$ci);
+ $_[0] = $cr;
+ $_[1] = $ci;
+
+ ($cr,$ci);
+}
+
+sub PDL::fftconvolve_inplace {
+ barf "Must have image & kernel for fftconvolve" if $#_ != 1;
+ my ($hr, $hi) = @_;
+ my ($n) = $hr->getndims;
+ todecimal($hr); # Convert to double unless already float or double
+ todecimal($hi); # Convert to double unless already float or double
+ # need the copy in case $r and $i point to same memory
+ $hi = $hi->copy;
+ $hr = $hr->copy;
+ fftnd($hr,$hi);
+ convmath($hr->clump(-1),$hi->clump(-1));
+ my ($str1, $str2, $tmp, $i);
+ chop($str1 = '-1:1,' x $n);
+ chop($str2 = '1:-1,' x $n);
+
+# FIX: do these inplace -- cuts the arithmetic by a factor 2 as well.
+
+ ($tmp = $hr->slice($str2)) += $hr->slice($str1)->copy;
+ ($tmp = $hi->slice($str2)) -= $hi->slice($str1)->copy;
+ for ($i = 0; $i<$n; $i++) {
+ chop ($str1 = ('(0),' x $i).'-1:1,'.('(0),'x($n-$i-1)));
+ chop ($str2 = ('(0),' x $i).'1:-1,'.('(0),'x($n-$i-1)));
+ ($tmp = $hr->slice($str2)) += $hr->slice($str1)->copy;
+ ($tmp = $hi->slice($str2)) -= $hi->slice($str1)->copy;
+ }
+ $hr->clump(-1)->set(0,$hr->clump(-1)->at(0)*2);
+ $hi->clump(-1)->set(0,0.);
+ ifftnd($hr,$hi);
+ $_[0] = $hr; $_[1] = $hi;
+ ($hr,$hi);
+}
+
+EOD
+
+# convmath does local part of the maths necessary to handle a,b which
+# result from FFT of image & kernel in parallel.
+
+pp_def('convmath',
+ Pars => '[o,nc]a(m); [o,nc]b(m);',
+ Code => '
+ $GENERIC() t1, t2;
+ loop(m) %{
+ t1 = $a();
+ t2 = $b();
+ $a() = t1*t2/2;
+ $b() = (t2*t2-t1*t1)/4;
+ %}
+',
+# Doc => undef,
+ Doc => 'Internal routine doing maths for convolution'
+);
+
+pp_def('cmul',
+ Pars => 'ar(); ai(); br(); bi(); [o]cr(); [o]ci();',
+ Code => '
+ $GENERIC() ar, ai, br, bi;
+ ar = $ar();
+ ai = $ai();
+ br = $br();
+ bi = $bi();
+ $cr() = ar*br-ai*bi;
+ $ci() = ar*bi+ai*br;
+',
+ Doc => 'Complex multiplication'
+);
+pp_def('cdiv',
+ Pars => 'ar(); ai(); br(); bi(); [o]cr(); [o]ci();',
+ Code => '
+ $GENERIC() ar, ai, br, bi, tt, dn;
+ ar = $ar();
+ ai = $ai();
+ br = $br();
+ bi = $bi();
+ if (fabs(br) > fabs(bi)) {
+ tt = bi/br;
+ dn = br + tt*bi;
+ $cr() = (ar+tt*ai)/dn;
+ $ci() = (ai-tt*ar)/dn;
+ } else {
+ tt = br/bi;
+ dn = br*tt + bi;
+ $cr() = (ar*tt+ai)/dn;
+ $ci() = (ai*tt-ar)/dn;
+ }
+',
+ Doc => 'Complex division'
+);
+
+pp_addpm(<<'ENDPM');
+
+1; # OK
+
+ENDPM
+
+pp_addpm(<<'EOD');
+
+=head1 BUGS
+
+Where the source is marked `FIX', could re-implement using phase-shift
+factors on the transforms and some real-space bookkeeping, to save
+some temporary space and redundant transforms.
+
+=head1 AUTHOR
+
+This file copyright (C) 1997, 1998 R.J.R. Williams
+(rjrw at ast.leeds.ac.uk), Karl Glazebrook (kgb at aaoepp.aao.gov.au),
+Tuomas J. Lukka, (lukka at husc.harvard.edu). All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+
+=cut
+
+EOD
+
+pp_done();
+
diff --git a/Lib/FFT/fftn.c b/Lib/FFT/fftn.c
new file mode 100644
index 0000000..07aa0b5
--- /dev/null
+++ b/Lib/FFT/fftn.c
@@ -0,0 +1,1208 @@
+/*--------------------------------*-C-*---------------------------------*
+ * File:
+ * fftn.c
+ *
+ * multivariate complex Fourier transform, computed in place
+ * using mixed-radix Fast Fourier Transform algorithm.
+ *
+ * Fortran code by:
+ * RC Singleton, Stanford Research Institute, Sept. 1968
+ * NIST Guide to Available Math Software.
+ * Source for module FFT from package GO.
+ * Retrieved from NETLIB on Wed Jul 5 11:50:07 1995.
+ * translated by f2c (version 19950721) and with lots of cleanup
+ * to make it resemble C by:
+ * MJ Olesen, Queen's University at Kingston, 1995-97
+ */
+/*{{{ Copyright: */
+/*
+ * Copyright(c)1995,97 Mark Olesen <olesen at me.QueensU.CA>
+ * Queen's Univ at Kingston (Canada)
+ *
+ * Permission to use, copy, modify, and distribute this software for
+ * any purpose without fee is hereby granted, provided that this
+ * entire notice is included in all copies of any software which is
+ * or includes a copy or modification of this software and in all
+ * copies of the supporting documentation for such software.
+ *
+ * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR
+ * IMPLIED WARRANTY. IN PARTICULAR, NEITHER THE AUTHOR NOR QUEEN'S
+ * UNIVERSITY AT KINGSTON MAKES ANY REPRESENTATION OR WARRANTY OF ANY
+ * KIND CONCERNING THE MERCHANTABILITY OF THIS SOFTWARE OR ITS
+ * FITNESS FOR ANY PARTICULAR PURPOSE.
+ *
+ * All of which is to say that you can do what you like with this
+ * source code provided you don't try to sell it as your own and you
+ * include an unaltered copy of this message (including the
+ * copyright).
+ *
+ * It is also implicitly understood that bug fixes and improvements
+ * should make their way back to the general Internet community so
+ * that everyone benefits.
+ *----------------------------------------------------------------------*/
+/*}}}*/
+/*{{{ notes: */
+/*
+ * Public:
+ * fft_free
+ * fftn / fftnf
+ * (these are documented in the header file)
+ *
+ * Private:
+ * fftradix / fftradixf
+ *
+ * ----------------------------------------------------------------------*
+ * int fftradix (REAL Re[], REAL Im[], size_t nTotal, size_t nPass,
+ * size_t nSpan, int iSign, size_t maxFactors,
+ * size_t maxPerm);
+ *
+ * RE and IM hold the real and imaginary components of the data, and
+ * return the resulting real and imaginary Fourier coefficients.
+ * Multidimensional data *must* be allocated contiguously. There is
+ * no limit on the number of dimensions.
+ *
+ *
+ * Although there is no limit on the number of dimensions, fftradix()
+ * must be called once for each dimension, but the calls may be in
+ * any order.
+ *
+ * NTOTAL = the total number of complex data values
+ * NPASS = the dimension of the current variable
+ * NSPAN/NPASS = the spacing of consecutive data values while indexing
+ * the current variable
+ * ISIGN - see above documentation
+ *
+ * example:
+ * tri-variate transform with Re[n1][n2][n3], Im[n1][n2][n3]
+ *
+ * fftradix (Re, Im, n1*n2*n3, n1, n1, 1, maxf, maxp);
+ * fftradix (Re, Im, n1*n2*n3, n2, n1*n2, 1, maxf, maxp);
+ * fftradix (Re, Im, n1*n2*n3, n3, n1*n2*n3, 1, maxf, maxp);
+ *
+ * single-variate transform,
+ * NTOTAL = N = NSPAN = (number of complex data values),
+ *
+ * fftradix (Re, Im, n, n, n, 1, maxf, maxp);
+ *
+ * The data can also be stored in a single array with alternating
+ * real and imaginary parts, the magnitude of ISIGN is changed to 2
+ * to give correct indexing increment, and data [0] and data [1] used
+ * to pass the initial addresses for the sequences of real and
+ * imaginary values,
+ *
+ * example:
+ * REAL data [2*NTOTAL];
+ * fftradix (&data[0], &data[1], NTOTAL, nPass, nSpan, 2, maxf, maxp);
+ *
+ * for temporary allocation:
+ *
+ * MAXFACTORS >= the maximum prime factor of NPASS
+ * MAXPERM >= the number of prime factors of NPASS. In addition,
+ * if the square-free portion K of NPASS has two or more prime
+ * factors, then MAXPERM >= (K-1)
+ *
+ * storage in FACTOR for a maximum of 15 prime factors of NPASS. if
+ * NPASS has more than one square-free factor, the product of the
+ * square-free factors must be <= 210 array storage for maximum prime
+ * factor of 23 the following two constants should agree with the
+ * array dimensions.
+ * ----------------------------------------------------------------------*/
+/*}}}*/
+/*{{{ Revisions: */
+/*
+ * 26 July 95 John Beale
+ * - added maxf and maxp as parameters to fftradix()
+ *
+ * 28 July 95 Mark Olesen <olesen at me.QueensU.CA>
+ * - cleaned-up the Fortran 66 goto spaghetti, only 3 labels remain.
+ *
+ * - added fft_free() to provide some measure of control over
+ * allocation/deallocation.
+ *
+ * - added fftn() wrapper for multidimensional FFTs
+ *
+ * - use -DFFT_NOFLOAT or -DFFT_NODOUBLE to avoid compiling that
+ * precision. Note suffix `f' on the function names indicates
+ * float precision.
+ *
+ * - revised documentation
+ *
+ * 31 July 95 Mark Olesen <olesen at me.QueensU.CA>
+ * - added GNU Public License
+ * - more cleanup
+ * - define SUN_BROKEN_REALLOC to use malloc() instead of realloc()
+ * on the first pass through, apparently needed for old libc
+ * - removed #error directive in favour of some code that simply
+ * won't compile (generate an error that way)
+ *
+ * 1 Aug 95 Mark Olesen <olesen at me.QueensU.CA>
+ * - define FFT_RADIX4 to only have radix 2, radix 4 transforms
+ * - made fftradix /fftradixf () static scope, just use fftn()
+ * instead. If you have good ideas about fixing the factors
+ * in fftn() please do so.
+ *
+ * 8 Jan 95 mj olesen <olesen at me.QueensU.CA>
+ * - fixed typo's, including one that broke scaling for scaling by
+ * total number of matrix elements or the square root of same
+ * - removed unnecessary casts from allocations
+ *
+ * 10 Dec 96 mj olesen <olesen at me.QueensU.CA>
+ * - changes defines to compile *without* float support by default,
+ * use -DFFT_FLOAT to enable.
+ * - shifted some variables to local scope (better hints for optimizer)
+ * - added Michael Steffens <Michael.Steffens at mbox.muk.uni-hannover.de>
+ * Fortran 90 module
+ * - made it simpler to pass dimensions for 1D FFT.
+ *
+ * 23 Feb 97 Mark Olesen <olesen at me.QueensU.CA>
+ * - removed the GNU Public License (see 21 July 1995 entry),
+ * which should make it clear why I have the right to do so.
+ * - Added copyright notice and submitted to netlib
+ * - Moved documentation for the public functions to the header
+ * files where is will always be available.
+ *
+ * 11 Nov 97 Robin Williams <rjrw at ast.leeds.ac.uk>
+ * - fixed all temporaries to double precision using REALFIX,
+ * following suggestion from Scott Wurcer
+ * ----------------------------------------------------------------------*/
+/*}}}*/
+#ifndef _FFTN_C
+#define _FFTN_C
+/* we use CPP to re-include this same file for double/float cases */
+
+#if !defined (lint) && !defined (__FILE__)
+#error Your compiler is sick!
+/* define __FILE__ yourself (a string) eg, something like
+D__FILE__=\"fftn.c\" */
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "fftn.h"
+
+/*{{{ defines/constants */
+#ifndef M_PI
+# define M_PI 3.14159265358979323846264338327950288
+#endif
+
+#ifndef SIN60
+# define SIN60 0.86602540378443865 /* sin(60 deg) */
+# define COS72 0.30901699437494742 /* cos(72 deg) */
+# define SIN72 0.95105651629515357 /* sin(72 deg) */
+#endif
+/*}}}*/
+
+/*{{{ static parameters - for memory management */
+static size_t SpaceAlloced = 0;
+static size_t MaxPermAlloced = 0;
+
+/* temp space, (void *) since both float and double routines use it */
+static void * Tmp0 = NULL; /* temp space for real part */
+static void * Tmp1 = NULL; /* temp space for imaginary part */
+static void * Tmp2 = NULL; /* temp space for Cosine values */
+static void * Tmp3 = NULL; /* temp space for Sine values */
+static int * Perm = NULL; /* Permutation vector */
+
+#define NFACTOR 11
+static int factor [NFACTOR];
+/*}}}*/
+
+/*{{{ fft_free() */
+void
+fft_free (void)
+{
+ SpaceAlloced = MaxPermAlloced = 0;
+ if (Tmp0) { free (Tmp0); Tmp0 = NULL; }
+ if (Tmp1) { free (Tmp1); Tmp1 = NULL; }
+ if (Tmp2) { free (Tmp2); Tmp2 = NULL; }
+ if (Tmp3) { free (Tmp3); Tmp3 = NULL; }
+ if (Perm) { free (Perm); Perm = NULL; }
+}
+/*}}}*/
+
+/* return the number of factors */
+static int
+factorize (int nPass, int * kt)
+{
+ int nFactor = 0;
+ int j, jj;
+
+ *kt = 0;
+ /* determine the factors of n */
+ while ((nPass % 16) == 0) /* factors of 4 */
+ {
+ factor [nFactor++] = 4;
+ nPass /= 16;
+ }
+ j = 3; jj = 9; /* factors of 3, 5, 7, ... */
+ do {
+ while ((nPass % jj) == 0)
+ {
+ factor [nFactor++] = j;
+ nPass /= jj;
+ }
+ j += 2;
+ jj = j * j;
+ } while (jj <= nPass);
+ if (nPass <= 4)
+ {
+ *kt = nFactor;
+ factor [nFactor] = nPass;
+ if (nPass != 1)
+ nFactor++;
+ }
+ else
+ {
+ if (nPass - (nPass / 4 << 2) == 0)
+ {
+ factor [nFactor++] = 2;
+ nPass /= 4;
+ }
+ *kt = nFactor;
+ j = 2;
+ do {
+ if ((nPass % j) == 0)
+ {
+ factor [nFactor++] = j;
+ nPass /= j;
+ }
+ j = ((j + 1) / 2 << 1) + 1;
+ } while (j <= nPass);
+ }
+ if (*kt)
+ {
+ j = *kt;
+ do
+ factor [nFactor++] = factor [--j];
+ while (j);
+ }
+
+ return nFactor;
+}
+
+/* re-include this source file on the second pass through */
+/*{{{ defines for re-including double precision */
+#ifdef FFT_NODOUBLE
+# ifndef FFT_FLOAT
+# define FFT_FLOAT
+# endif
+#else
+# undef REALFIX
+# undef REAL
+# undef FFTN
+# undef FFTNS
+# undef FFTRADIX
+# undef FFTRADIXS
+/* defines for double */
+# define REAL double
+# define REALFIX double
+# define FFTN fftn
+# define FFTNS "fftn"
+# define FFTRADIX fftradix
+# define FFTRADIXS "fftradix"
+/* double precision routine */
+static int
+fftradix (double Re[], double Im[],
+ size_t nTotal, size_t nPass, size_t nSpan, int isign,
+ int maxFactors, int maxPerm);
+# include __FILE__ /* include this file again */
+#endif
+/*}}}*/
+
+/*{{{ defines for re-including float precision */
+#ifdef FFT_FLOAT
+# undef REAL
+# undef REALFIX
+# undef FFTN
+# undef FFTNS
+# undef FFTRADIX
+# undef FFTRADIXS
+/* defines for float */
+# define REAL float
+# define REALFIX double
+# define FFTN fftnf /* trailing 'f' for float */
+# define FFTNS "fftnf" /* name for error message */
+# define FFTRADIX fftradixf /* trailing 'f' for float */
+# define FFTRADIXS "fftradixf" /* name for error message */
+/* float precision routine */
+static int
+fftradixf (float Re[], float Im[],
+ size_t nTotal, size_t nPass, size_t nSpan, int isign,
+ int maxFactors, int maxPerm);
+# include __FILE__ /* include this file again */
+#endif
+/*}}}*/
+#else /* _FFTN_C */
+
+/*
+ * use macros to access the Real/Imaginary parts so that it's possible
+ * to substitute different macros if a complex struct is used
+ */
+
+#ifndef Re_Data
+# define Re_Data(i) Re[i]
+# define Im_Data(i) Im[i]
+#endif
+
+/*
+ *
+ */
+int
+FFTN (int ndim,
+ const int dims [],
+ REAL Re [],
+ REAL Im [],
+ int iSign,
+ REAL scaling)
+{
+ size_t nTotal;
+ int maxFactors, maxPerm;
+
+ /*
+ * tally the number of elements in the data array
+ * and determine the number of dimensions
+ */
+ nTotal = 1;
+ if (ndim)
+ {
+ if (dims != NULL)
+ {
+ int i;
+ /* number of dimensions was specified */
+ for (i = 0; i < ndim; i++)
+ {
+ if (dims [i] <= 0) goto Dimension_Error;
+ nTotal *= dims [i];
+ }
+ }
+ else
+ nTotal *= ndim;
+ }
+ else
+ {
+ int i;
+ /* determine # of dimensions from zero-terminated list */
+ if (dims == NULL) goto Dimension_Error;
+ for (ndim = i = 0; dims [i]; i++)
+ {
+ if (dims [i] <= 0)
+ goto Dimension_Error;
+ nTotal *= dims [i];
+ ndim++;
+ }
+ }
+
+ /* determine maximum number of factors and permuations */
+#if 1
+ /*
+ * follow John Beale's example, just use the largest dimension and don't
+ * worry about excess allocation. May be someone else will do it?
+ */
+ if (dims != NULL)
+ {
+ int i;
+ for (maxFactors = maxPerm = 1, i = 0; i < ndim; i++)
+ {
+ if (dims [i] > maxFactors) maxFactors = dims [i];
+ if (dims [i] > maxPerm) maxPerm = dims [i];
+ }
+ }
+ else
+ {
+ maxFactors = maxPerm = nTotal;
+ }
+#else
+ /* use the constants used in the original Fortran code */
+ maxFactors = 23;
+ maxPerm = 209;
+#endif
+ /* loop over the dimensions: */
+ if (dims != NULL)
+ {
+ size_t nSpan = 1;
+ int i;
+
+ for (i = 0; i < ndim; i++)
+ {
+ int ret;
+ nSpan *= dims [i];
+ ret = FFTRADIX (Re, Im, nTotal, dims [i], nSpan, iSign,
+ maxFactors, maxPerm);
+ /* exit, clean-up already done */
+ if (ret)
+ return ret;
+ }
+ }
+ else
+ {
+ int ret;
+ ret = FFTRADIX (Re, Im, nTotal, nTotal, nTotal, iSign,
+ maxFactors, maxPerm);
+ /* exit, clean-up already done */
+ if (ret)
+ return ret;
+ }
+
+ /* Divide through by the normalizing constant: */
+ if (scaling && scaling != 1.0)
+ {
+ int i;
+
+ if (iSign < 0) iSign = -iSign;
+ if (scaling < 0.0)
+ scaling = (scaling < -1.0) ? sqrt (nTotal) : nTotal;
+
+ scaling = 1.0 / scaling; /* multiply is often faster */
+ for (i = 0; i < nTotal; i += iSign)
+ {
+ Re_Data (i) *= scaling;
+ Im_Data (i) *= scaling;
+ }
+ }
+ return 0;
+
+ Dimension_Error:
+ fprintf (stderr, "Error: " FFTNS "() - dimension error\n");
+ fft_free (); /* free-up memory */
+ return -1;
+}
+
+/*----------------------------------------------------------------------*/
+/*
+ * singleton's mixed radix routine
+ *
+ * could move allocation out to fftn(), but leave it here so that it's
+ * possible to make this a standalone function
+ */
+static int
+FFTRADIX (REAL Re [],
+ REAL Im [],
+ size_t nTotal,
+ size_t nPass,
+ size_t nSpan,
+ int iSign,
+ int maxFactors,
+ int maxPerm)
+{
+ int ii, nFactor, kspan, ispan, inc;
+ int j, jc, jf, jj, k, k1, k3, kk, kt, nn, ns, nt;
+
+ REALFIX radf;
+ REALFIX c1, c2, c3, cd;
+ REALFIX s1, s2, s3, sd;
+
+ REALFIX * Rtmp = NULL; /* temp space for real part*/
+ REALFIX * Itmp = NULL; /* temp space for imaginary part */
+ REALFIX * Cos = NULL; /* Cosine values */
+ REALFIX * Sin = NULL; /* Sine values */
+
+#ifndef FFT_RADIX4
+ REALFIX s60 = SIN60; /* sin(60 deg) */
+ REALFIX s72 = SIN72; /* sin(72 deg) */
+ REALFIX c72 = COS72; /* cos(72 deg) */
+#endif
+ REALFIX pi2 = M_PI; /* use PI first, 2 PI later */
+
+ /* gcc complains about k3 being uninitialized, but I can't find out where
+ * or why ... it looks okay to me.
+ *
+ * initialize to make gcc happy
+ */
+ k3 = 0;
+
+ /* gcc complains about c2, c3, s2,s3 being uninitialized, but they're
+ * only used for the radix 4 case and only AFTER the (s1 == 0.0) pass
+ * through the loop at which point they will have been calculated.
+ *
+ * initialize to make gcc happy
+ */
+ c2 = c3 = s2 = s3 = 0.0;
+
+ /* Parameter adjustments, was fortran so fix zero-offset */
+ Re--;
+ Im--;
+
+ if (nPass < 2)
+ return 0;
+
+ /* allocate storage */
+ if (SpaceAlloced < maxFactors * sizeof (REALFIX))
+ {
+#ifdef SUN_BROKEN_REALLOC
+ if (!SpaceAlloced) /* first time */
+ {
+ SpaceAlloced = maxFactors * sizeof (REALFIX);
+ Tmp0 = malloc (SpaceAlloced);
+ Tmp1 = malloc (SpaceAlloced);
+ Tmp2 = malloc (SpaceAlloced);
+ Tmp3 = malloc (SpaceAlloced);
+ }
+ else
+ {
+#endif
+ SpaceAlloced = maxFactors * sizeof (REALFIX);
+ Tmp0 = realloc (Tmp0, SpaceAlloced);
+ Tmp1 = realloc (Tmp1, SpaceAlloced);
+ Tmp2 = realloc (Tmp2, SpaceAlloced);
+ Tmp3 = realloc (Tmp3, SpaceAlloced);
+#ifdef SUN_BROKEN_REALLOC
+ }
+#endif
+ }
+ else
+ {
+ /* allow full use of alloc'd space */
+ maxFactors = SpaceAlloced / sizeof (REALFIX);
+ }
+ if (MaxPermAlloced < maxPerm)
+ {
+#ifdef SUN_BROKEN_REALLOC
+ if (!MaxPermAlloced) /* first time */
+ Perm = malloc (maxPerm * sizeof(int));
+ else
+#endif
+ Perm = realloc (Perm, maxPerm * sizeof(int));
+ MaxPermAlloced = maxPerm;
+ }
+ else
+ {
+ /* allow full use of alloc'd space */
+ maxPerm = MaxPermAlloced;
+ }
+ if (!Tmp0 || !Tmp1 || !Tmp2 || !Tmp3 || !Perm) goto Memory_Error;
+
+ /* assign pointers */
+ Rtmp = (REALFIX *) Tmp0;
+ Itmp = (REALFIX *) Tmp1;
+ Cos = (REALFIX *) Tmp2;
+ Sin = (REALFIX *) Tmp3;
+
+ /*
+ * Function Body
+ */
+ inc = iSign;
+ if (iSign < 0)
+ {
+#ifndef FFT_RADIX4
+ s60 = -s60;
+ s72 = -s72;
+#endif
+ pi2 = -pi2;
+ inc = -inc; /* absolute value */
+ }
+
+ /* adjust for strange increments */
+ nt = inc * nTotal;
+ ns = inc * nSpan;
+ kspan = ns;
+
+ nn = nt - inc;
+ jc = ns / nPass;
+ radf = pi2 * (double) jc;
+ pi2 *= 2.0; /* use 2 PI from here on */
+
+ ii = 0;
+ jf = 0;
+ /* determine the factors of n */
+
+ nFactor = factorize (nPass, &kt);
+ /* test that nFactors is in range */
+ if (nFactor > NFACTOR)
+ {
+ fprintf (stderr, "Error: " FFTRADIXS "() - exceeded number of factors\n");
+ goto Memory_Error;
+ }
+
+ /* compute fourier transform */
+ for (;;) {
+ sd = radf / (double) kspan;
+ cd = sin (sd);
+ cd = 2.0 * cd * cd;
+ sd = sin (sd + sd);
+ kk = 1;
+ ii++;
+
+ switch (factor [ii - 1]) {
+ case 2:
+ /* transform for factor of 2 (including rotation factor) */
+ kspan /= 2;
+ k1 = kspan + 2;
+ do {
+ do {
+ REALFIX tmpr;
+ REALFIX tmpi;
+ int k2;
+
+ k2 = kk + kspan;
+ tmpr = Re_Data (k2);
+ tmpi = Im_Data (k2);
+ Re_Data (k2) = Re_Data (kk) - tmpr;
+ Im_Data (k2) = Im_Data (kk) - tmpi;
+ Re_Data (kk) += tmpr;
+ Im_Data (kk) += tmpi;
+ kk = k2 + kspan;
+ } while (kk <= nn);
+ kk -= nn;
+ } while (kk <= jc);
+ if (kk > kspan)
+ goto Permute_Results; /* exit infinite loop */
+ do {
+ int k2;
+
+ c1 = 1.0 - cd;
+ s1 = sd;
+ do {
+ REALFIX tmp;
+ do {
+ do {
+ REALFIX tmpr;
+ REALFIX tmpi;
+
+ k2 = kk + kspan;
+ tmpr = Re_Data (kk) - Re_Data (k2);
+ tmpi = Im_Data (kk) - Im_Data (k2);
+ Re_Data (kk) += Re_Data (k2);
+ Im_Data (kk) += Im_Data (k2);
+ Re_Data (k2) = c1 * tmpr - s1 * tmpi;
+ Im_Data (k2) = s1 * tmpr + c1 * tmpi;
+ kk = k2 + kspan;
+ } while (kk < nt);
+ k2 = kk - nt;
+ c1 = -c1;
+ kk = k1 - k2;
+ } while (kk > k2);
+ tmp = c1 - (cd * c1 + sd * s1);
+ s1 = sd * c1 - cd * s1 + s1;
+ c1 = 2.0 - (tmp * tmp + s1 * s1);
+ s1 *= c1;
+ c1 *= tmp;
+ kk += jc;
+ } while (kk < k2);
+ k1 += (inc + inc);
+ kk = (k1 - kspan) / 2 + jc;
+ } while (kk <= jc + jc);
+ break;
+
+ case 4: /* transform for factor of 4 */
+ ispan = kspan;
+ kspan /= 4;
+
+ do {
+ c1 = 1.0;
+ s1 = 0.0;
+ do {
+ do {
+ REALFIX ajm, ajp, akm, akp;
+ REALFIX bjm, bjp, bkm, bkp;
+ int k2;
+
+ k1 = kk + kspan;
+ k2 = k1 + kspan;
+ k3 = k2 + kspan;
+ akp = Re_Data (kk) + Re_Data (k2);
+ akm = Re_Data (kk) - Re_Data (k2);
+
+ ajp = Re_Data (k1) + Re_Data (k3);
+ ajm = Re_Data (k1) - Re_Data (k3);
+
+ bkp = Im_Data (kk) + Im_Data (k2);
+ bkm = Im_Data (kk) - Im_Data (k2);
+
+ bjp = Im_Data (k1) + Im_Data (k3);
+ bjm = Im_Data (k1) - Im_Data (k3);
+
+ Re_Data (kk) = akp + ajp;
+ Im_Data (kk) = bkp + bjp;
+ ajp = akp - ajp;
+ bjp = bkp - bjp;
+ if (iSign < 0)
+ {
+ akp = akm + bjm;
+ bkp = bkm - ajm;
+ akm -= bjm;
+ bkm += ajm;
+ }
+ else
+ {
+ akp = akm - bjm;
+ bkp = bkm + ajm;
+ akm += bjm;
+ bkm -= ajm;
+ }
+ /* avoid useless multiplies */
+ if (s1 == 0.0)
+ {
+ Re_Data (k1) = akp;
+ Re_Data (k2) = ajp;
+ Re_Data (k3) = akm;
+ Im_Data (k1) = bkp;
+ Im_Data (k2) = bjp;
+ Im_Data (k3) = bkm;
+ }
+ else
+ {
+ Re_Data (k1) = akp * c1 - bkp * s1;
+ Re_Data (k2) = ajp * c2 - bjp * s2;
+ Re_Data (k3) = akm * c3 - bkm * s3;
+ Im_Data (k1) = akp * s1 + bkp * c1;
+ Im_Data (k2) = ajp * s2 + bjp * c2;
+ Im_Data (k3) = akm * s3 + bkm * c3;
+ }
+ kk = k3 + kspan;
+ } while (kk <= nt);
+
+ c2 = c1 - (cd * c1 + sd * s1);
+ s1 = sd * c1 - cd * s1 + s1;
+ c1 = 2.0 - (c2 * c2 + s1 * s1);
+ s1 *= c1;
+ c1 *= c2;
+ /* values of c2, c3, s2, s3 that will get used next time */
+ c2 = c1 * c1 - s1 * s1;
+ s2 = 2.0 * c1 * s1;
+ c3 = c2 * c1 - s2 * s1;
+ s3 = c2 * s1 + s2 * c1;
+ kk = kk - nt + jc;
+ } while (kk <= kspan);
+ kk = kk - kspan + inc;
+ } while (kk <= jc);
+ if (kspan == jc)
+ goto Permute_Results; /* exit infinite loop */
+ break;
+
+ default:
+ /* transform for odd factors */
+#ifdef FFT_RADIX4
+ fprintf (stderr, "Error: " FFTRADIXS "(): compiled for radix 2/4 only\n");
+ fft_free (); /* free-up memory */
+ return -1;
+ break;
+#else /* FFT_RADIX4 */
+ ispan = kspan;
+ k = factor [ii - 1];
+ kspan /= factor [ii - 1];
+
+ switch (factor [ii - 1]) {
+ case 3: /* transform for factor of 3 (optional code) */
+ do {
+ do {
+ REALFIX aj, tmpr;
+ REALFIX bj, tmpi;
+ int k2;
+
+ k1 = kk + kspan;
+ k2 = k1 + kspan;
+ tmpr = Re_Data (kk);
+ tmpi = Im_Data (kk);
+ aj = Re_Data (k1) + Re_Data (k2);
+ bj = Im_Data (k1) + Im_Data (k2);
+ Re_Data (kk) = tmpr + aj;
+ Im_Data (kk) = tmpi + bj;
+ tmpr -= 0.5 * aj;
+ tmpi -= 0.5 * bj;
+ aj = (Re_Data (k1) - Re_Data (k2)) * s60;
+ bj = (Im_Data (k1) - Im_Data (k2)) * s60;
+ Re_Data (k1) = tmpr - bj;
+ Re_Data (k2) = tmpr + bj;
+ Im_Data (k1) = tmpi + aj;
+ Im_Data (k2) = tmpi - aj;
+ kk = k2 + kspan;
+ } while (kk < nn);
+ kk -= nn;
+ } while (kk <= kspan);
+ break;
+
+ case 5: /* transform for factor of 5 (optional code) */
+ c2 = c72 * c72 - s72 * s72;
+ s2 = 2.0 * c72 * s72;
+ do {
+ do {
+ REALFIX aa, aj, ak, ajm, ajp, akm, akp;
+ REALFIX bb, bj, bk, bjm, bjp, bkm, bkp;
+ int k2, k4;
+
+ k1 = kk + kspan;
+ k2 = k1 + kspan;
+ k3 = k2 + kspan;
+ k4 = k3 + kspan;
+ akp = Re_Data (k1) + Re_Data (k4);
+ akm = Re_Data (k1) - Re_Data (k4);
+ bkp = Im_Data (k1) + Im_Data (k4);
+ bkm = Im_Data (k1) - Im_Data (k4);
+ ajp = Re_Data (k2) + Re_Data (k3);
+ ajm = Re_Data (k2) - Re_Data (k3);
+ bjp = Im_Data (k2) + Im_Data (k3);
+ bjm = Im_Data (k2) - Im_Data (k3);
+ aa = Re_Data (kk);
+ bb = Im_Data (kk);
+ Re_Data (kk) = aa + akp + ajp;
+ Im_Data (kk) = bb + bkp + bjp;
+ ak = akp * c72 + ajp * c2 + aa;
+ bk = bkp * c72 + bjp * c2 + bb;
+ aj = akm * s72 + ajm * s2;
+ bj = bkm * s72 + bjm * s2;
+ Re_Data (k1) = ak - bj;
+ Re_Data (k4) = ak + bj;
+ Im_Data (k1) = bk + aj;
+ Im_Data (k4) = bk - aj;
+ ak = akp * c2 + ajp * c72 + aa;
+ bk = bkp * c2 + bjp * c72 + bb;
+ aj = akm * s2 - ajm * s72;
+ bj = bkm * s2 - bjm * s72;
+ Re_Data (k2) = ak - bj;
+ Re_Data (k3) = ak + bj;
+ Im_Data (k2) = bk + aj;
+ Im_Data (k3) = bk - aj;
+ kk = k4 + kspan;
+ } while (kk < nn);
+ kk -= nn;
+ } while (kk <= kspan);
+ break;
+
+ default:
+ k = factor [ii - 1];
+ if (jf != k)
+ {
+ jf = k;
+ s1 = pi2 / (double) jf;
+ c1 = cos (s1);
+ s1 = sin (s1);
+ if (jf > maxFactors)
+ goto Memory_Error;
+ Cos [jf - 1] = 1.0;
+ Sin [jf - 1] = 0.0;
+ j = 1;
+ do {
+ Cos [j - 1] = Cos [k - 1] * c1 + Sin [k - 1] * s1;
+ Sin [j - 1] = Cos [k - 1] * s1 - Sin [k - 1] * c1;
+ k--;
+ Cos [k - 1] = Cos [j - 1];
+ Sin [k - 1] = -Sin [j - 1];
+ j++;
+ } while (j < k);
+ }
+ do {
+ do {
+ REALFIX aa, ak;
+ REALFIX bb, bk;
+ int k2;
+
+ aa = ak = Re_Data (kk);
+ bb = bk = Im_Data (kk);
+
+ k1 = kk;
+ k2 = kk + ispan;
+ j = 1;
+ k1 += kspan;
+ do {
+ k2 -= kspan;
+ Rtmp [j] = Re_Data (k1) + Re_Data (k2);
+ ak += Rtmp [j];
+ Itmp [j] = Im_Data (k1) + Im_Data (k2);
+ bk += Itmp [j];
+ j++;
+ Rtmp [j] = Re_Data (k1) - Re_Data (k2);
+ Itmp [j] = Im_Data (k1) - Im_Data (k2);
+ j++;
+ k1 += kspan;
+ } while (k1 < k2);
+ Re_Data (kk) = ak;
+ Im_Data (kk) = bk;
+
+ k1 = kk;
+ k2 = kk + ispan;
+ j = 1;
+ do {
+ REALFIX aj = 0.0;
+ REALFIX bj = 0.0;
+
+ k1 += kspan;
+ k2 -= kspan;
+ jj = j;
+ ak = aa;
+ bk = bb;
+ k = 1;
+ do {
+ ak += Rtmp [k] * Cos [jj - 1];
+ bk += Itmp [k] * Cos [jj - 1];
+ k++;
+ aj += Rtmp [k] * Sin [jj - 1];
+ bj += Itmp [k] * Sin [jj - 1];
+ k++;
+ jj += j;
+ if (jj > jf)
+ jj -= jf;
+ } while (k < jf);
+ k = jf - j;
+ Re_Data (k1) = ak - bj;
+ Im_Data (k1) = bk + aj;
+ Re_Data (k2) = ak + bj;
+ Im_Data (k2) = bk - aj;
+ j++;
+ } while (j < k);
+ kk += ispan;
+ } while (kk <= nn);
+ kk -= nn;
+ } while (kk <= kspan);
+ break;
+ }
+ /* multiply by rotation factor (except for factors of 2 and 4) */
+ if (ii == nFactor)
+ goto Permute_Results; /* exit infinite loop */
+ kk = jc + 1;
+ do {
+ c2 = 1.0 - cd;
+ s1 = sd;
+ do {
+ c1 = c2;
+ s2 = s1;
+ kk += kspan;
+ do {
+ REALFIX tmp;
+ do {
+ REALFIX ak;
+ ak = Re_Data (kk);
+ Re_Data (kk) = c2 * ak - s2 * Im_Data (kk);
+ Im_Data (kk) = s2 * ak + c2 * Im_Data (kk);
+ kk += ispan;
+ } while (kk <= nt);
+ tmp = s1 * s2;
+ s2 = s1 * c2 + c1 * s2;
+ c2 = c1 * c2 - tmp;
+ kk = kk - nt + kspan;
+ } while (kk <= ispan);
+ c2 = c1 - (cd * c1 + sd * s1);
+ s1 += sd * c1 - cd * s1;
+ c1 = 2.0 - (c2 * c2 + s1 * s1);
+ s1 *= c1;
+ c2 *= c1;
+ kk = kk - ispan + jc;
+ } while (kk <= kspan);
+ kk = kk - kspan + jc + inc;
+ } while (kk <= jc + jc);
+ break;
+#endif /* FFT_RADIX4 */
+ }
+ }
+
+/* permute the results to normal order -- done in two stages */
+/* permutation for square factors of n */
+Permute_Results:
+ Perm [0] = ns;
+ if (kt)
+ {
+ int k2;
+
+ k = kt + kt + 1;
+ if (k > nFactor)
+ k--;
+ Perm [k] = jc;
+ j = 1;
+ do {
+ Perm [j] = Perm [j - 1] / factor [j - 1];
+ Perm [k - 1] = Perm [k] * factor [j - 1];
+ j++;
+ k--;
+ } while (j < k);
+ k3 = Perm [k];
+ kspan = Perm [1];
+ kk = jc + 1;
+ k2 = kspan + 1;
+ j = 1;
+ if (nPass != nTotal)
+ {
+ /* permutation for multivariate transform */
+ Permute_Multi:
+ do {
+ do {
+ k = kk + jc;
+ do {
+ /* swap
+ * Re_Data (kk) <> Re_Data (k2)
+ * Im_Data (kk) <> Im_Data (k2)
+ */
+ REALFIX tmp;
+ tmp = Re_Data (kk); Re_Data (kk) = Re_Data (k2); Re_Data (k2) = tmp;
+ tmp = Im_Data (kk); Im_Data (kk) = Im_Data (k2); Im_Data (k2) = tmp;
+ kk += inc;
+ k2 += inc;
+ } while (kk < k);
+ kk += (ns - jc);
+ k2 += (ns - jc);
+ } while (kk < nt);
+ k2 = k2 - nt + kspan;
+ kk = kk - nt + jc;
+ } while (k2 < ns);
+ do {
+ do {
+ k2 -= Perm [j - 1];
+ j++;
+ k2 = Perm [j] + k2;
+ } while (k2 > Perm [j - 1]);
+ j = 1;
+ do {
+ if (kk < k2)
+ goto Permute_Multi;
+ kk += jc;
+ k2 += kspan;
+ } while (k2 < ns);
+ } while (kk < ns);
+ }
+ else
+ {
+ /* permutation for single-variate transform (optional code) */
+Permute_Single:
+ do {
+ /* swap
+ * Re_Data (kk) <> Re_Data (k2)
+ * Im_Data (kk) <> Im_Data (k2)
+ */
+ REALFIX t;
+ t = Re_Data (kk); Re_Data (kk) = Re_Data (k2); Re_Data (k2) = t;
+ t = Im_Data (kk); Im_Data (kk) = Im_Data (k2); Im_Data (k2) = t;
+ kk += inc;
+ k2 += kspan;
+ } while (k2 < ns);
+ do {
+ do {
+ k2 -= Perm [j - 1];
+ j++;
+ k2 = Perm [j] + k2;
+ } while (k2 > Perm [j - 1]);
+ j = 1;
+ do {
+ if (kk < k2)
+ goto Permute_Single;
+ kk += inc;
+ k2 += kspan;
+ } while (k2 < ns);
+ } while (kk < ns);
+ }
+ jc = k3;
+ }
+
+ if ((kt << 1) + 1 >= nFactor)
+ return 0;
+ ispan = Perm [kt];
+
+ /* permutation for square-free factors of n */
+ j = nFactor - kt;
+ factor [j] = 1;
+ do {
+ factor [j - 1] *= factor [j];
+ j--;
+ } while (j != kt);
+ nn = factor [kt] - 1;
+ kt++;
+ if (nn > maxPerm)
+ goto Memory_Error;
+
+ j = jj = 0;
+ for (;;) {
+ int k2;
+
+ k = kt + 1;
+ k2 = factor [kt - 1];
+ kk = factor [k - 1];
+ j++;
+ if (j > nn)
+ break; /* exit infinite loop */
+ jj += kk;
+ while (jj >= k2)
+ {
+ jj -= k2;
+ k2 = kk;
+ kk = factor [k++];
+ jj += kk;
+ }
+ Perm [j - 1] = jj;
+ }
+ /* determine the permutation cycles of length greater than 1 */
+ j = 0;
+ for (;;) {
+ do {
+ kk = Perm [j++];
+ } while (kk < 0);
+ if (kk != j)
+ {
+ do {
+ k = kk;
+ kk = Perm [k - 1];
+ Perm [k - 1] = -kk;
+ } while (kk != j);
+ k3 = kk;
+ }
+ else
+ {
+ Perm [j - 1] = -j;
+ if (j == nn)
+ break; /* exit infinite loop */
+ }
+ }
+
+ maxFactors *= inc;
+
+ /* reorder a and b, following the permutation cycles */
+ for (;;) {
+ j = k3 + 1;
+ nt -= ispan;
+ ii = nt - inc + 1;
+ if (nt < 0)
+ break; /* exit infinite loop */
+ do {
+ do {
+ j--;
+ } while (Perm [j - 1] < 0);
+ jj = jc;
+ do {
+ int k2;
+
+ if (jj < maxFactors) kspan = jj; else kspan = maxFactors;
+
+ jj -= kspan;
+ k = Perm [j - 1];
+ kk = jc * k + ii + jj;
+
+ k1 = kk + kspan;
+ k2 = 0;
+ do {
+ Rtmp [k2] = Re_Data (k1);
+ Itmp [k2] = Im_Data (k1);
+ k2++;
+ k1 -= inc;
+ } while (k1 != kk);
+
+ do {
+ k1 = kk + kspan;
+ k2 = k1 - jc * (k + Perm [k - 1]);
+ k = -Perm [k - 1];
+ do {
+ Re_Data (k1) = Re_Data (k2);
+ Im_Data (k1) = Im_Data (k2);
+ k1 -= inc;
+ k2 -= inc;
+ } while (k1 != kk);
+ kk = k2;
+ } while (k != j);
+
+ k1 = kk + kspan;
+ k2 = 0;
+ do {
+ Re_Data (k1) = Rtmp [k2];
+ Im_Data (k1) = Itmp [k2];
+ k2++;
+ k1 -= inc;
+ } while (k1 != kk);
+ } while (jj);
+ } while (j != 1);
+ }
+ return 0; /* exit point here */
+
+ /* alloc or other problem, do some clean-up */
+Memory_Error:
+ fprintf (stderr, "Error: " FFTRADIXS "() - insufficient memory.\n");
+ fft_free (); /* free-up memory */
+ return -1;
+}
+#endif /* _FFTN_C */
+/*----------------------- end-of-file (C source) -----------------------*/
diff --git a/Lib/FFT/fftn.h b/Lib/FFT/fftn.h
new file mode 100644
index 0000000..58a2c46
--- /dev/null
+++ b/Lib/FFT/fftn.h
@@ -0,0 +1,115 @@
+/*--------------------------------*-C-*---------------------------------*
+ * File:
+ * fftn.h
+ *
+ * Singleton's multivariate complex Fourier transform, computed in
+ * place using mixed-radix Fast Fourier Transform algorithm.
+ *
+ * Called here `fftn' since it does a radix-n FFT on n-dimensional data
+ *
+ * Copyright(c)1995,97 Mark Olesen <olesen at me.QueensU.CA>
+ * Queen's Univ at Kingston (Canada)
+ *
+ * Permission to use, copy, modify, and distribute this software for
+ * any purpose without fee is hereby granted, provided that this
+ * entire notice is included in all copies of any software which is
+ * or includes a copy or modification of this software and in all
+ * copies of the supporting documentation for such software.
+ *
+ * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR
+ * IMPLIED WARRANTY. IN PARTICULAR, NEITHER THE AUTHOR NOR QUEEN'S
+ * UNIVERSITY AT KINGSTON MAKES ANY REPRESENTATION OR WARRANTY OF ANY
+ * KIND CONCERNING THE MERCHANTABILITY OF THIS SOFTWARE OR ITS
+ * FITNESS FOR ANY PARTICULAR PURPOSE.
+ *
+ * All of which is to say that you can do what you like with this
+ * source code provided you don't try to sell it as your own and you
+ * include an unaltered copy of this message (including the
+ * copyright).
+ *
+ * It is also implicitly understood that bug fixes and improvements
+ * should make their way back to the general Internet community so
+ * that everyone benefits.
+ *
+ * Brief overview of parameters:
+ * ---------------------------------------------------------------------*
+ * Re[]: real value array
+ * Im[]: imaginary value array
+ * nTotal: total number of complex values
+ * nPass: number of elements involved in this pass of transform
+ * nSpan: nspan/nPass = number of bytes to increment pointer
+ * in Re[] and Im[]
+ * isign: exponent: +1 = forward -1 = reverse
+ * scaling: normalizing constant by which the final result is DIVIDED
+ * scaling == -1, normalize by total dimension of the transform
+ * scaling < -1, normalize by the square-root of the total dimension
+ *
+ *
+ * Slightly more detailed information:
+ * ----------------------------------------------------------------------*
+ * void fft_free (void);
+ *
+ * free-up allocated temporary storage after finished all the Fourier
+ * transforms.
+ *
+ * ----------------------------------------------------------------------*
+ *
+ * int fftn (int ndim, const int dims[], REAL Re[], REAL Im[],
+ * int iSign, double scaling);
+ *
+ * NDIM = the total number dimensions
+ * DIMS = a vector of array sizes
+ * if NDIM is zero then DIMS must be zero-terminated
+ *
+ * RE and IM hold the real and imaginary components of the data, and
+ * return the resulting real and imaginary Fourier coefficients.
+ * Multidimensional data *must* be allocated contiguously. There is
+ * no limit on the number of dimensions.
+ *
+ * ISIGN = the sign of the complex exponential
+ * (ie, forward or inverse FFT)
+ * the magnitude of ISIGN (normally 1) is used to determine
+ * the correct indexing increment (see below).
+ *
+ * SCALING = normalizing constant by which the final result is DIVIDED
+ * if SCALING == -1, normalize by total dimension of the transform
+ * if SCALING < -1, normalize by the square-root of the total dimension
+ *
+ * example:
+ * tri-variate transform with Re[n3][n2][n1], Im[n3][n2][n1]
+ *
+ * int dims[3] = {n1,n2,n3}
+ * fftn (3, dims, Re, Im, 1, scaling);
+ *
+ * or, using a null terminated dimension list
+ * int dims[4] = {n1,n2,n3,0}
+ * fftn (0, dims, Re, Im, 1, scaling);
+ * ----------------------------------------------------------------------*/
+#ifndef _FFTN_H
+#define _FFTN_H
+#ifdef __cplusplus
+extern "C" {
+#endif
+ extern void fft_free (void);
+
+ /* double precision routine */
+ extern int fftn (int /* ndim */,
+ const int /* dims */[],
+ double /* Re */[],
+ double /* Im */[],
+ int /* isign */,
+ double /* scaling */);
+
+ /* float precision routine */
+ extern int fftnf (int /* ndim */,
+ const int /* dims */[],
+ float /* Re */[],
+ float /* Im */[],
+ int /* isign */,
+ float /* scaling */);
+
+#ifdef __cplusplus
+}
+#endif
+#endif /* _FFTN_H */
+/*----------------------- end-of-file (C header) -----------------------*/
diff --git a/Lib/Filter/LinPred.pm b/Lib/Filter/LinPred.pm
new file mode 100644
index 0000000..58c97ea
--- /dev/null
+++ b/Lib/Filter/LinPred.pm
@@ -0,0 +1,286 @@
+=head1 NAME
+
+PDL::Filter::LinPred - Linear predictive filtering
+
+=head1 SYNOPSIS
+
+ $a = new PDL::Filter::LinPred(
+ {NLags => 10,
+ LagInterval => 2,
+ LagsBehind => 2,
+ Data => $dat});
+
+ ($pd,$corrslic) = $a->predict($dat);
+
+=head1 DESCRIPTION
+
+A filter by doing linear prediction: tries to predict the next value
+in a data stream as accurately as possible. The filtered data is the
+predicted value. The parameters are
+
+=over 8
+
+=item NLags
+
+Number of time lags used for prediction
+
+=item LagInterval
+
+How many points each lag should be
+
+=item LagsBehind
+
+If, for some strange reason, you wish to predict not the next but
+the one after that (i.e. usually f(t) is predicted from f(t-1) and f(t-2)
+etc., but with LagsBehind => 2, f(t) is predicted from f(t-2) and f(t-3)).
+
+=item Data
+
+The input data, which may contain other dimensions past the first (time).
+The extraneous dimensions are assumed to represent epochs so the data
+is just concatenated.
+
+=item AutoCovar
+
+As an alternative to B<Data>, you can just give the temporal autocorrelation
+function.
+
+=item Smooth
+
+Don't do prediction or filtering but smoothing.
+
+=back
+
+The method B<predict> gives a prediction for some data plus a corresponding
+slice of the data, if evaluated in list context. This slice is given
+so that you may, if you wish, easily plot them atop each other.
+
+The rest of the documentation is under lazy evaluation.
+
+=head1 AUTHOR
+
+Copyright (C) Tuomas J. Lukka 1997.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
+
+package PDL::Filter::LinSmooth;
+use PDL;
+use PDL::Basic;
+use PDL::Slatec;
+use PDL::Slices;
+use PDL::Primitive;
+use strict;
+
+ at PDL::Filter::LinSmooth::ISA = qw/PDL::Filter::LinPred/;
+
+sub _ntotlags {
+ my($this) = @_;
+ return 2 * ( $this->{NLags} + $this->{LagsBehind} );
+}
+
+# nlags == 3, lagsbehind == 1 -> totlags = 7
+#
+# Symautocor: 6543210123456
+# -> lags(nlags) ->
+#
+# 43210123456
+# 54321012345
+# 65432101234
+
+# SMOOTH
+sub _mk_mat {
+ my($this) = @_;
+
+ local $PDL::Debug = 1;
+
+ my $n = $this->{LagsBehind};
+ my $nl = $this->{NLags};
+ my $nl1 = $nl-1;
+
+ my $auc = $this->{AutoCor};
+
+ my $autocov = PDL::float PDL->zeroes($nl*2,$nl*2);
+ $this->{AutoCov} = $autocov;
+
+ my $sal = $this->{SymAutoCor}->px->lags(0,1,$this->{NLags})->px;
+ print "L,LB: $nl,$n\n";
+
+ my ($tmp,$tmp2);
+ PDL::Graphics::PG::imag ($sal->copy);
+
+# First, the 2 diagonal slices
+ ($tmp = $autocov->slice("$nl:-1,$nl:-1")->px) .=
+ ($tmp2 = $autocov->slice("0:".($nl-1).",0:".($nl-1))->px) .=
+ $sal->slice(($this->{NLags}+2*$this->{LagsBehind}-1).":".
+ (-1-($this->{NLags}+2*$this->{LagsBehind}+1)))->px;
+
+# Then, the off-diagonal slices
+ ($tmp = $autocov->slice("-1:$nl,$nl1:0")) .=
+ ($tmp2 = $autocov->slice("0:$nl1,$nl:-1")) .=
+ $sal->slice("0:$nl1");
+
+ # Invert it
+
+ my $autocinv = inv($autocov);
+# print "$autocinv,$auc,$n\n"; $auc->slice("$n:-1");
+ $this->{AutoSliceUsed} = PDL->zeroes(2*$nl)->float;
+
+ ($tmp = $this->{AutoSliceUsed}->slice("0:$nl1"))
+ .= $auc->slice(($n+$nl-1).":$n");
+
+ ($tmp = $this->{AutoSliceUsed}->slice("-1:$nl"))
+ .= $auc->slice(($n+$nl-1).":$n");
+
+ inner($autocinv->xchg(0,1),$this->{AutoSliceUsed},(my $tdw=PDL->null));
+
+ $this->{AutoCov} = $autocov;
+ $this->{AutoCovInv} = $autocinv;
+ $this->{Weights} = $tdw;
+}
+
+sub predict ($$) {
+ my($this,$data) = @_;
+ my $nl = $this->{NLags};
+ my $nl1 = $nl - 1;
+
+ my $ldata = $data->lags(0,$this->{LagInterval},$this->{NTotLags}+1);
+ print "PREDICT, weights: $this->{Weights}\n";
+
+ inner($ldata->xchg(0,1)->slice("-$nl:-1"),
+ $this->{Weights}->slice("-$nl:-1"),
+ (my $pred1=PDL->null));
+ inner($ldata->xchg(0,1)->slice("0:$nl1"),
+ $this->{Weights}->slice("0:$nl1"),
+ (my $pred2=PDL->null));
+
+ my $pred = $pred1 + $pred2;
+
+ return wantarray ?
+ ($pred,$ldata->slice(":,(".($nl+$this->{LagsBehind}).")"),
+ $pred1, $pred2) :
+ $pred ;
+}
+
+package PDL::Filter::LinPred;
+use PDL;
+use PDL::Basic;
+use PDL::Slatec;
+use PDL::Slices;
+use PDL::Primitive;
+use strict;
+
+sub _ntotlags {
+ my($this) = @_;
+ return $this->{NLags} + $this->{LagsBehind} + 1;
+}
+
+# Create the autocovariance matrix in Toeplitz form
+
+# FILTER
+sub _mk_mat {
+ my($this) = @_;
+
+ local $PDL::Debug = 1;
+
+ my $n = $this->{LagsBehind};
+ my $nl = $this->{NLags};
+ my $nl1 = $nl-1;
+
+ my $auc = $this->{AutoCor};
+
+ print "AUTOCOR: $auc\n";
+
+ my $sal = $this->{SymAutoCor}->lags(0,1,$this->{NLags})->px;
+
+ my $autocov =
+ $sal->slice(($this->{LagsBehind}-1).":".(-1-($this->{LagsBehind}+1)))
+ ->copy()->px;
+ $this->{AutoCov} = $autocov;
+
+ $| = 1;
+ print "AUTOCOV: \n\n\n";
+ $autocov->dump;
+
+ print "FOOBAR\n";
+
+# Invert it
+ my $autocinv = inv($autocov);
+
+ $this->{AutoSliceUsed} = $auc->slice("$n:-1");
+ inner($autocinv->xchg(0,1),$this->{AutoSliceUsed},(my $tdw=PDL->null));
+
+ $this->{AutoCov} = $autocov;
+ $this->{AutoCovInv} = $autocinv;
+ $this->{Weights} = $tdw;
+}
+
+sub chkdefault ($$) {
+ my ($var,$def);
+ return $def if !ref $var && $var == 0;
+ return defined $var ? $var : $def;
+}
+
+sub new ($$) {
+ my($type,$pars) = @_;
+ my $this = bless {},$type;
+ $this->{NLags} = chkdefault(delete $pars->{NLags}, 2);
+ $this->{LagInterval} = chkdefault(delete $pars->{LagInterval}, 1);
+ $this->{LagsBehind} = chkdefault(delete $pars->{LagsBehind}, 1);
+ $this->{Smooth} = (delete $pars->{Smooth});
+
+ $this->{NDeleted} = $this->{LagInterval} * ($this->{NLags} +
+ $this->{LagsBehind}) - 1;
+ $this->{NTotLags} = $this->_ntotlags();
+ (my $data = delete $pars->{Data}) ;
+ my ($auc,$auc1);
+ if(defined $data) {
+ my $atmp;
+ my $n = $this->{NTotLags};
+ my $da = avg($data);
+# Compute autocovariance
+ my $ldata = $data->lags(0,$this->{LagInterval},$n);
+# XXX This takes too much space.. define a special function.
+ inner($ldata->slice(":,0"),$ldata, ($atmp=PDL->null));
+ sumover($atmp->xchg(0,1),($auc=PDL->null));
+ $auc /= $ldata->getdim(0) * $data->getdim(1);
+ $auc -= $da ** 2;
+# print "AUC: $auc\n";
+ } elsif(defined ($auc1 = delete $pars->{AutoCovar})) {
+ if($this->{LagInterval} != 1) {
+ $auc = $auc1->slice("0:$this->{LagInterval}:-1");
+ } else {
+ $auc = $auc1;
+ }
+ } else {
+ barf "Nothing to compute autocovariance from!";
+ }
+ $this->{AutoCor} = $auc;
+ my $n = $this->{NTotLags};
+ $this->{SymAutoCor} =
+ (PDL->zeroes($n * 2 - 1)->float);
+ my $tmp;
+ ($tmp = $this->{SymAutoCor}->slice("0:".($n-2))) .=
+ $auc->slice("-1:1");
+ ($tmp = $this->{SymAutoCor}->slice(($n-1).":-1")) .=
+ $auc->slice("0:-1");
+ $this->_mk_mat();
+ $this;
+}
+
+sub predict ($$) {
+ my($this,$data) = @_;
+ my $ldata = $data->lags(0,$this->{LagInterval},$this->{NTotLags});
+ print "PREDICT, weights: $this->{Weights}\n";
+ inner($ldata->xchg(0,1)->slice("$this->{LagsBehind}:-1"),
+ $this->{Weights},
+ (my $pred=PDL->null));
+ return wantarray ? ($pred,$ldata->slice(":,(0)")) :
+ $pred ;
+}
+
diff --git a/Lib/Filter/Linear.pm b/Lib/Filter/Linear.pm
new file mode 100644
index 0000000..2577642
--- /dev/null
+++ b/Lib/Filter/Linear.pm
@@ -0,0 +1,90 @@
+=head1 NAME
+
+PDL::Filter::Linear - linear filtering for PDL
+
+=head1 SYNOPSIS
+
+ $a = new PDL::Filter::Linear(
+ {Weights => $v,
+ Point => 10});
+
+ $b = new PDL::Filter::Gaussian(15,2); # 15 points, 2 std devn.
+
+ ($pred,$corrslic) = $a->predict($dat);
+
+=head1 DESCRIPTION
+
+A wrapper for generic linear filters.
+Just for convenience. This should in the future use DataPresenter.
+
+Also, this class should at some point learn to do FFT whenever it is
+useful.
+
+=cut
+
+package PDL::Filter::Linear;
+use PDL;
+use PDL::Basic;
+use PDL::Slices;
+use PDL::Primitive;
+use strict;
+
+sub new($$) {
+ my($type,$pars) = @_;
+
+ my $this = bless {},$type;
+ barf("Must specify weights\n") unless defined $pars->{Weights};
+ $this->{Weights} = delete $pars->{Weights};
+ $this->{Point} = defined $pars->{Point} ? $pars->{Point} : 0;
+ $this;
+}
+
+sub predict($$) {
+ my($this,$data) = @_;
+ my $ldata = $data->lags(0,1,$this->{Weights}->getdim(0));
+ inner($ldata->xchg(0,1),$this->{Weights},
+ (my $pred = PDL->null));
+ return wantarray ? ($pred,$ldata->slice(":,($this->{Point})")) :
+ $pred ;
+}
+
+package PDL::Filter::Gaussian;
+use PDL; use PDL::Basic; use PDL::Slices; use PDL::Primitive;
+use strict;
+
+ at PDL::Filter::Gaussian::ISA = qw/PDL::Filter::Linear/;
+
+sub new($$) {
+ my($type,$npoints,$sigma) = @_;
+ my $cent = int($npoints/2);
+ my $x = ((PDL->zeroes($npoints )->xvals) - $cent)->float;
+ my $y = exp(-($x**2)/(2*$sigma**2));
+# Normalize to unit total
+ $y /= sum($y);
+ return PDL::Filter::Linear::new($type,{Weights => $y,
+ Point => $cent});
+}
+
+# Savitzky-Golay (see Numerical Recipes)
+package PDL::Filter::SavGol;
+use PDL; use PDL::Basic; use PDL::Slices; use PDL::Primitive;
+use strict;
+
+ at PDL::Filter::Gaussian::ISA = qw/PDL::Filter::Linear/;
+
+# XXX Doesn't work
+sub new($$) {
+ my($type,$deg,$nleft,$nright) = @_;
+ my $npoints = $nright + $nleft + 1;
+ my $x = ((PDL->zeroes($npoints )->xvals) - $nleft)->float;
+ my $mat1 = ((PDL->zeroes($npoints,$deg+1)->xvals))->float;
+ for(0..$deg-1) {
+ (my $tmp = $mat1->slice(":,($_)")) .= ($x ** $_);
+ }
+ my $y;
+# Normalize to unit total
+ return PDL::Filter::Linear::new($type,{Weights => $y,
+ Point => $nleft});
+}
+
+
diff --git a/Lib/Filter/Makefile.PL b/Lib/Filter/Makefile.PL
new file mode 100644
index 0000000..e9de58f
--- /dev/null
+++ b/Lib/Filter/Makefile.PL
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ NAME => 'PDL::Filter',
+ VERSION_FROM => '../../Basic/Core/Version.pm',
+ PM => {
+ map {($_ => '$(INST_LIBDIR)/Filter/'.$_)} <*.pm>
+ },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+ );
+__END__
+
diff --git a/Lib/Fit/Gaussian/Makefile.PL b/Lib/Fit/Gaussian/Makefile.PL
new file mode 100644
index 0000000..163cd52
--- /dev/null
+++ b/Lib/Fit/Gaussian/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for PDL::Fit::Gaussian module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+ at pack = (["gaussian.pd",Gaussian,PDL::Fit::Gaussian]);
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{OBJECT} .= ' ';
+$hash{DEFINE} .= ' ';
+$hash{LIBS} = ['-lm'] unless $^O =~ /MSWin/;
+
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Lib/Fit/Gaussian/gauss.c b/Lib/Fit/Gaussian/gauss.c
new file mode 100644
index 0000000..d30fefb
--- /dev/null
+++ b/Lib/Fit/Gaussian/gauss.c
@@ -0,0 +1,464 @@
+/*LINTLIBRARY*/
+/* gauss.c
+
+ This code provides gaussian fitting routines.
+
+ Copyright (C) 1997 Karl Glazebrook and Alison Offer Real code
+
+ Note it is not clear to me that this code is fully debugged. The reason
+ I say that is because I tried using the linear eqn solving routines called
+ elsewhere and they were giving erroneous results. So steal from this
+ code with caution! However it does give good fits to reasonable looking
+ gaussians and tests show correct parameters.
+
+ KGB 29/Oct/2002
+ */
+
+
+#include <stdio.h>
+#include <math.h>
+
+#define NPAR 3
+#define MAXITER 1000
+
+
+/* Malloc 2D ptr array e.g. a[nx][ny] */
+
+static double **malloc2D (int nx, int ny)
+{
+ int i;
+ double **p;
+ p = (double**) malloc( nx*sizeof(double*) ); /* 1D array of ptrs p[i] */
+ if (p==NULL)
+ return NULL;
+ for (i=0;i<nx;i++) {
+ p[i] = (double*) malloc( ny*sizeof(double) );
+ if (p[i] == NULL) {
+ free(p);
+ return(NULL);
+ }
+ }
+
+ return (double**) p;
+}
+
+/* Free a 2D ptr array */
+
+static void free2D (double **p, int nx, int ny)
+{
+ int i;
+
+ for (i=0;i<nx;i++)
+ free(p[i]);
+
+ free(p);
+}
+
+
+/* ======================================================================== */
+
+static void seta (int npar, int npoints, double a[NPAR][NPAR], double **d,
+ double *sig)
+{
+ int i,j,k;
+
+ for(i=0; i<npar; i++)
+ {
+ for (j=0; j<npar; j++)
+ {
+ a[i][j] = 0.0;
+ for(k=0; k<npoints; k++)
+ a[i][j] += d[k][i] * d[k][j] / sig[k];
+ }
+ }
+}
+
+static void setb (int npar, int npoints, double b[NPAR], double **d,
+ double *y, double *yfit, double *sig)
+{
+ int i,k;
+
+ for(i=0; i<npar; i++) {
+ b[i]=0.0;
+ for(k=0; k<npoints; k++)
+ b[i] += d[k][i] * (y[k] - yfit[k]) / sig[k];
+ }
+}
+
+/* ========================================================================
+
+ returns the fitted function in yfit and the partial derivatives in d
+
+ here f = b exp ( - ((x - c)/a)^2)
+*/
+
+static void funct (int npoints, int npar, double *x, double *yfit,
+ double **d, double par[NPAR])
+{
+ int i;
+ double a,b,c,arg;
+
+ a=par[0]; b=par[1]; c=par[2];
+
+ for(i=0; i<npoints; i++) {
+ arg = (x[i]-c) /a; arg *= arg;
+ yfit[i] = b * exp(-arg);
+ d[i][0] = 2.0 * arg * yfit[i] / a;
+ d[i][1] = yfit[i] / b;
+ d[i][2] = 2.0 * arg * yfit[i] / (x[i]-c);
+ }
+}
+
+
+/* These have been checked */
+
+
+/*
+
+ IMPORTANT NOTE: I tried using decomp()+leneq() routines
+ elsewhere and they were giving erroneous results.
+ So steal from this code with caution!
+
+ KGB 29/Oct/2002
+ */
+
+
+/* =======================================================================
+
+ LU decomposition of matrix x using Crouts algotithm with partial
+ pivoting.
+
+ Returns decomposition in x and permutation of rows in iorder
+
+*/
+
+static void decomp (int n, int ndim, double x[NPAR][NPAR], int iorder[NPAR])
+{
+ int icol, irow, isum, iexc, ipivot;
+ double store, xmax, sum, eps=1e-16;
+
+ /* initialise iorder */
+
+ for(iexc=1; iexc<=n; iexc++)
+ iorder[iexc-1] = iexc;
+
+ /* loop over columns */
+
+ for (icol = 1; icol<=n; icol++) {
+
+ /* U - matrix */
+
+ if (icol>1) {
+ for (irow=1; irow<=icol-1; irow++) {
+ sum = x[irow-1][icol-1];
+ for (isum=1; isum<=irow-1; isum++)
+ sum -= x[irow-1][isum-1]*x[isum-1][irow-1];
+ x[irow-1][icol-1] = sum;
+ }
+ }
+
+ /* L - matrix plus diagonal element of U matrix */
+
+ xmax = 0; ipivot = icol;
+ for (irow=icol; irow<=n; irow++) {
+ sum = x[irow-1][icol-1];
+ if (icol>1) {
+ for(isum=1; isum<=icol-1; isum++)
+ sum -= x[irow-1][isum-1] * x[isum-1][icol-1];
+ }
+ if (fabs(sum)>xmax) {
+ xmax = sum;
+ ipivot = irow;
+ }
+ x[irow-1][icol-1] = sum;
+ }
+
+ /* if xmax is very small replace by epsilon to avoid
+ dividing by zero */
+
+ if (fabs(xmax)<eps)
+ x[ipivot-1][icol-1] = eps;
+
+ /* Partial Pivoting - look for maximum x(i,j<=i) and interchange
+ rows if necessary to put this on the diagonal */
+
+ if (ipivot!=icol) {
+ iexc = iorder[ipivot-1];
+ iorder[ipivot-1] = iorder[icol-1];
+ iorder[icol-1] = iexc;
+ for(iexc=1; iexc<=n; iexc++) {
+ store = x[ipivot-1][iexc-1];
+ x[ipivot-1][iexc-1] = x[icol-1][iexc-1];
+ x[icol-1][iexc-1] = store;
+ }
+ }
+
+ /* divide new L-matrix elements by new diagonal element */
+
+ if (icol<n) {
+ for (irow=icol+1; irow<=n; irow++)
+ x[irow-1][icol-1] /= x[icol-1][icol-1];
+ }
+ }
+}
+
+
+/*
+
+ IMPORTANT NOTE: I tried using decomp()+leneq() routines
+ elsewhere and they were giving erroneous results.
+ So steal from this code with caution!
+
+ KGB 29/Oct/2002
+ */
+
+/* ========================================================================
+
+ x[i<=j[]j] is U-matrix from LU-decomposition
+ x[i>j][j] is L-matrix (diagonal elements are unity)
+ iorder is the permutation of the rows
+
+ b is the input vector, d is the solution vector
+*/
+
+static void lineq (int n, int ndim, double x[NPAR][NPAR], double b[NPAR],
+ double d[NPAR], int iorder[NPAR])
+{
+ int i,isum;
+ double sum;
+
+ /* solving X.b = d ==> (L.U).b = d
+ or L.(U.b) = d
+
+ first re-order the vector */
+
+ for (i=1; i<=n; i++)
+ d[i-1] = b[iorder[i-1]-1];
+
+ /* first find (U.b) */
+
+ for(i=2; i<=n; i++) {
+ sum = d[i-1];
+ for (isum=1; isum<=i-1; isum++)
+ sum -= x[i-1][isum-1] * d[isum-1];
+ d[i-1] = sum;
+ }
+
+ /* Now fill out d (solution of X.b) by back substitution */
+
+ d[n-1] /= x[n-1][n-1];
+ for (i=n-1; i>=1; i--){
+ sum = d[i-1];
+ for (isum=i+1; isum<=n; isum++)
+ sum -= x[i-1][isum-1] * d[isum-1];
+ d[i-1] = sum / x[i-1][i-1];
+ }
+
+}
+
+
+/* ========================================================================
+
+ My C version of Alison's subroutine to fit a non-linear functions using the
+ Levenberg-Marquardt algorithm
+
+ input: npoints = number of data points
+ npar = number of parameters in fit
+ par = initial estimates of parameters
+ sigma = errors on data (sigma^2)
+
+ output: par = output parameters
+ r = residuals (y(i) - yfit(i))
+ a = estimated covariance matrix of std errs
+ in fitted params.
+*/
+
+
+static int marquardt (int npoints, int npar, double*x, double *y,
+ double* sig, double par[NPAR], double* r,
+ double a[NPAR][NPAR])
+{
+ int i,k, done, decrease, niter;
+ int iorder[NPAR];
+ double *yfit, **d, **d2, tmp;
+ double par2[NPAR], delta[NPAR], b[NPAR], aprime[NPAR][NPAR];
+
+ double lambda, chisq, chisq2, eps=0.001, lamfac=2.0;
+
+ /* Memory allocation */
+
+ yfit = (double*) malloc( npoints*sizeof(double));
+ if (yfit==NULL)
+ return(1);
+
+ d = malloc2D( npoints, NPAR);
+ if (d==NULL) {
+ free(yfit); return(1);
+ }
+
+ d2 = malloc2D( npoints, NPAR);
+ if (d2==NULL) {
+ free(yfit); free2D(d,npoints,NPAR); return(1);
+ }
+
+ /* Not enough points */
+
+ if (npoints < npar) {
+ free(yfit); free2D(d,npoints,NPAR); free2D(d2,npoints,NPAR);
+ return(2);
+ }
+
+ lambda = 0.001; done = 0; decrease = 0; niter = 1;
+
+ /* Get the value for the initial fit and the value of the derivatives
+ for the current estimate of the parameters */
+
+ funct(npoints, npar, x, yfit, d, par);
+
+ /* Calculate chi^2 */
+
+ chisq = 0;
+ for (k=0; k<npoints; k++) {
+ tmp = y[k] - yfit[k];
+ chisq += tmp*tmp / sig[k];
+ }
+
+ /* Set up initial matrices; curvature matrix a and b */
+
+ seta(npar,npoints,a,d,sig);
+ setb(npar,npoints,b,d,y,yfit,sig);
+
+ /* Main Loop */
+
+ while(!done) {
+
+ /* Set up a' */
+
+ for (k=0; k<npar; k++) {
+ for (i=0; i<npar; i++) {
+ aprime[i][k] = a[i][k];
+ }
+ aprime[k][k] = a[k][k] * (1.0 + lambda);
+ }
+
+ /* Solve Matrix Equation: a'.delta = b */
+
+
+/*
+
+ IMPORTANT NOTE: I tried using decomp()+leneq() routines
+ elsewhere and they were giving erroneous results.
+ So steal from this code with caution!
+
+ KGB 29/Oct/2002
+ */
+ decomp(npar ,npar, aprime, iorder);
+ lineq(npar, npar, aprime, b, delta, iorder);
+
+ /* Increment parameters in work space and evaluate new chisq */
+
+ for (i=0; i<NPAR; i++){
+ if (i<npar)
+ par2[i] = par[i] + delta[i];
+ else
+ par2[i] = par[i];
+ }
+
+ funct(npoints, npar, x, r, d2, par2);
+ chisq2 = 0.0;
+
+ for (k=0; k<npoints; k++) {
+ tmp = y[k] - r[k];
+ chisq2 += tmp*tmp / sig[k];
+ }
+
+ /* SUccess ? */
+
+ /* printf ("diag: %lf %lf %lf\n", chisq, chisq2,
+ fabs(((chisq - chisq2)/chisq))); */
+
+ if (chisq2<=chisq) {
+
+ /* Test convergence */
+
+ if (chisq == chisq2)
+ done = 1;
+ if (fabs(((chisq - chisq2)/chisq)) < eps && decrease )
+ done = 1;
+ for (k=0; k<npoints; k++)
+ yfit[k] = r[k];
+
+ for (i=0; i<NPAR; i++) {
+ par[i] = par2[i];
+ for (k=0; k<npoints; k++) {
+ d[k][i] = d2[k][i];
+ }
+ }
+
+ if (!done) {
+ seta(npar,npoints,a,d,sig); setb(npar,npoints,b,d,y,yfit,sig);
+ chisq = chisq2; lambda = lambda / lamfac; decrease = 1;
+ }
+ }
+ else {
+
+ decrease = 0;
+ lambda *= lamfac;
+ }
+ niter++;
+
+ /* Failure to converge after numerous iterations */
+
+ if (niter>MAXITER) {
+ free(yfit); free2D(d,npoints,NPAR); free2D(d2,npoints,NPAR);
+ return(3);
+ }
+ }
+
+ /* Success!!! - compute residual and covariance matrix then return
+
+ first calculating inverse of aprime */
+
+ for (i=0; i<npar; i++)
+ delta[i] = 0.0;
+ for (i=0; i<npar; i++) {
+ delta[i] = 1.0;
+ lineq (npar, NPAR, aprime, delta, b, iorder);
+ for (k=0; k<npar; k++)
+ a[k][i] = b[k];
+ }
+
+ for (k=0; k<npoints; k++)
+ r[k] = y[k] - yfit[k];
+
+ free(yfit); free2D(d,npoints,NPAR); free2D(d2,npoints,NPAR);
+
+ return(0);
+}
+
+/* qsort doubles */
+static void lqsortD (double* xx, int a, int b)
+{
+ int i,j;
+
+ double t, median;
+
+ i = a; j = b;
+ median = xx[(i+j) / 2];
+ do {
+ while (xx[i] < median)
+ i++;
+ while (median < xx[j])
+ j--;
+ if (i <= j) {
+ t = xx[i]; xx[i] = xx[j]; xx[j] = t;
+ i++; j--;
+ }
+ } while (i <= j);
+
+ if (a < j)
+ lqsortD(xx,a,j);
+ if (i < b)
+ lqsortD(xx,i,b);
+}
+
diff --git a/Lib/Fit/Gaussian/gaussian.pd b/Lib/Fit/Gaussian/gaussian.pd
new file mode 100644
index 0000000..0dcb25f
--- /dev/null
+++ b/Lib/Fit/Gaussian/gaussian.pd
@@ -0,0 +1,216 @@
+
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::Fit::Gaussian - routines for fitting gaussians
+
+=head1 DESCRIPTION
+
+
+This module contains some custom gaussian fitting routines.
+These were developed in collaboration with Alison Offer,
+they do a reasonably robust job and are quite useful.
+
+Gaussian fitting is something I do a lot of, so I figured
+it was worth putting in my special code.
+
+Note it is not clear to me that this code is fully debugged. The reason
+I say that is because I tried using the internal linear eqn solving
+C routines called elsewhere and they were giving erroneous results.
+So steal from this code with caution! However it does give good fits to
+reasonable looking gaussians and tests show correct parameters.
+
+ KGB 29/Oct/2002
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::Fit::Gaussian;
+ ($cen, $pk, $fwhm, $back, $err, $fit) = fitgauss1d($x, $data);
+ ($pk, $fwhm, $back, $err, $fit) = fitgauss1dr($r, $data);
+
+=head1 FUNCTIONS
+
+=head2 fitgauss1d
+
+=for ref
+
+Fit 1D Gassian to data piddle
+
+=for example
+
+ ($cen, $pk, $fwhm, $back, $err, $fit) = fitgauss1d($x, $data);
+
+=for usage
+
+ ($cen, $pk, $fwhm, $back, $err, $fit) = fitgauss1d($x, $data);
+
+=for signature
+
+ xval(n); data(n); [o]xcentre();[o]peak_ht(); [o]fwhm();
+ [o]background();int [o]err(); [o]datafit(n);
+ [t]sig(n); [t]xtmp(n); [t]ytmp(n); [t]yytmp(n); [t]rtmp(n);
+
+Fits a 1D Gaussian robustly free parameters are the centre, peak height,
+FWHM. The background is NOT fit, because I find this is generally
+unreliable, rather a median is determined in the 'outer' 10% of
+pixels (i.e. those at the start/end of the data piddle). The initial
+estimate of the FWHM is the length of the piddle/3, so it might fail
+if the piddle is too long. (This is non-robust anyway). Most data
+does just fine and this is a good default gaussian fitter.
+
+SEE ALSO: fitgauss1dr() for fitting radial gaussians
+
+=head2 fitgauss1dr
+
+=for ref
+
+Fit 1D Gassian to radial data piddle
+
+=for example
+
+ ($pk, $fwhm2, $back, $err, $fit) = fitgauss1dr($r, $data);
+
+=for usage
+
+ ($pk, $fwhm2, $back, $err, $fit) = fitgauss1dr($r, $data);
+
+=for signature
+
+ xval(n); data(n); [o]peak_ht(); [o]fwhm();
+ [o]background();int [o]err(); [o]datafit(n);
+ [t]sig(n); [t]xtmp(n); [t]ytmp(n); [t]yytmp(n); [t]rtmp(n);
+
+Fits a 1D radial Gaussian robustly free parameters are the peak height,
+FWHM. Centre is assumed to be X=0 (i.e. start of piddle).
+The background is NOT fit, because I find this is generally
+unreliable, rather a median is determined in the 'outer' 10% of
+pixels (i.e. those at the end of the data piddle). The initial
+estimate of the FWHM is the length of the piddle/3, so it might fail
+if the piddle is too long. (This is non-robust anyway). Most data
+does just fine and this is a good default gaussian fitter.
+
+SEE ALSO: fitgauss1d() to fit centre as well.
+
+=cut
+
+EOD
+pp_addhdr('
+#include "gauss.c"
+');
+
+
+
+for $name ('fitgauss1d','fitgauss1dr') {
+pp_def($name,
+ Pars => 'xval(n); data(n); '.($name eq 'fitgauss1dr' ? '' : '[o]xcentre();').
+ '[o]peak_ht(); [o]fwhm();
+ [o]background();int [o]err(); [o]datafit(n);
+ [t]sig(n); [t]ytmp(n); [t]yytmp(n); [t]rtmp(n);',
+ GenericTypes => [D],
+ Code => '
+ int i, nb;
+ double ymax, xmax, xmin, val, xval, xcenguess, bkg, par[NPAR], a[NPAR][NPAR];
+ ymax = -1e-30; xmax = -1e-30; xmin = 1e30;
+ $err() = 0;
+ loop(n) %{
+ val = $data();
+ xval = $xval();
+ $ytmp() = val;
+ $sig() = 1.0; /* Room for expansion */
+
+ if (val>ymax) /* Various max and mins */
+ ymax = val;
+ if (xval>xmax)
+ xmax = xval;
+ if (xval<xmin)
+ xmin = xval;
+ %}
+
+ /* Find background points - outer 10% */
+ nb = 0;
+ loop(n) %{
+ if ( abs($xval()-xmin) > 0.9*abs(xmax-xmin) ) {
+ $yytmp(n=>nb) = $ytmp();
+ nb++;
+ }
+ %}
+
+ /* Estimate background and xcentroid */
+ bkg = 0;
+ xcenguess = 0.0;
+ if (nb>0) {
+ lqsortD( $P(yytmp), 0, nb-1 );
+ i = (nb-1)/2;
+ bkg = $yytmp( n=>i ); /* Median */
+ }
+ val = 0.0; xcenguess = 0.0;
+ loop(n) %{
+ $ytmp() -= bkg;
+ xcenguess += $ytmp() * $xval();
+ val += $ytmp();
+ %}
+ xcenguess /= val;
+
+ par[2] = xcenguess;
+ par[1] = ymax-bkg;
+ par[0] = (xmax-xmin)/3; /* 1/3 of given box */
+
+ /* fprintf (stderr, "gauss...1 %f %f %f\n", par[0], par[1], par[2]); */
+
+ /* Do the fit */
+
+ '.($name eq 'fitgauss1dr' ? '
+
+ par[2] = 0.0;
+ $err() = marquardt ($SIZE(n), 2, $P(xval), $P(ytmp), $P(sig), par, $P(rtmp), a);
+
+ ' : '
+ $err() = marquardt ($SIZE(n), 3, $P(xval), $P(ytmp), $P(sig), par, $P(rtmp), a);
+ $xcentre() = par[2];
+ ') .'
+
+ $fwhm() = (fabs(par[0]))*2.0*sqrt(log(2.0)); /* Ret Values */
+
+ $peak_ht() = par[1];
+ $background() = bkg;
+
+ loop(n) %{
+ val = ( (double) $xval() - par[2] ) / par[0];
+ $datafit() = par[1] * exp (- val * val) + bkg;
+ %}
+
+ ',
+ Doc=>undef
+);
+}
+
+pp_addpm(<<'ENDPM');
+
+1; # OK
+
+ENDPM
+
+pp_addpm(<<'EOD');
+
+=head1 BUGS
+
+May not converge for weird data, still pretty good!
+
+=head1 AUTHOR
+
+This file copyright (C) 1999, Karl Glazebrook (kgb at aaoepp.aao.gov.au),
+Gaussian fitting code by Alison Offer
+(aro at aaocbn.aao.gov.au). All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+
+=cut
+
+EOD
+
+pp_done();
+
diff --git a/Lib/Fit/LM.pm b/Lib/Fit/LM.pm
new file mode 100644
index 0000000..a351bda
--- /dev/null
+++ b/Lib/Fit/LM.pm
@@ -0,0 +1,314 @@
+=head1 NAME
+
+PDL::Fit::LM -- Levenberg-Marquardt fitting routine for PDL
+
+=head1 DESCRIPTION
+
+This module provides fitting functions for PDL. Currently, only
+Levenberg-Marquardt fitting is implemented. Other procedures should
+be added as required. For a fairly concise overview on fitting
+see Numerical Recipes, chapter 15 "Modeling of data".
+
+=head1 SYNOPSIS
+
+ use PDL::Fit::LM;
+ $ym = lmfit $x, $y, $sig, \&expfunc, $a, {Maxiter => 300};
+
+=head1 FUNCTIONS
+
+=cut
+
+package PDL::Fit::LM;
+
+ at EXPORT_OK = qw( lmfit tlmfit);
+%EXPORT_TAGS = (Func=>[@EXPORT_OK]);
+
+use PDL::Core;
+use PDL::Exporter;
+use PDL::Options;
+use PDL::Slatec; # for matrix inversion
+
+ at ISA = qw( PDL::Exporter );
+
+=head2 lmfit
+
+=for ref
+
+Levenberg-Marquardt fitting of a user supplied model function
+
+=for example
+
+ ($ym,$a,$covar,$iters) =
+ lmfit $x, $y, $sig, \&expfunc, $a, {Maxiter => 300, Eps => 1e-3};
+
+Options:
+
+=for options
+
+ Maxiter: maximum number of iterations before giving up
+ Eps: convergence citerium for fit; success when normalized change
+ in chisquare smaller than Eps
+
+The user supplied sub routine reference should accept 4 arguments
+
+=over 4
+
+=item *
+
+a vector of independent values $x
+
+=item *
+
+a vector of fitting parameters
+
+=item *
+
+a vector of dependent variables that will be assigned upon return
+
+=item *
+
+a matrix of partial derivatives with respect to the fitting parameters
+that will be assigned upon return
+
+=back
+
+As an example take this definition of a single exponential with
+3 parameters (width, amplitude, offset):
+
+ sub expdec {
+ my ($x,$par,$ym,$dyda) = @_;
+ my ($a,$b,$c) = map {$par->slice("($_)")} (0..2);
+ my $arg = $x/$a;
+ my $ex = exp($arg);
+ $ym .= $b*$ex+$c;
+ my (@dy) = map {$dyda->slice(",($_)")} (0..2);
+ $dy[0] .= -$b*$ex*$arg/$a;
+ $dy[1] .= $ex;
+ $dy[2] .= 1;
+ }
+
+Note usage of the C<.=> operator for assignment
+
+In scalar context returns a vector of the fitted dependent
+variable. In list context returns fitted y-values, vector
+of fitted parameters, an estimate of the covariance matrix
+(as an indicator of goodness of fit) and number of iterations
+performed.
+
+=cut
+
+sub PDL::lmfit {
+ my ($x,$y,$sig,$func,$a,$opt) = @_; # not using $ia right now
+ $opt = {iparse( { Maxiter => 200,
+ Eps => 1e-4}, ifhref($opt))};
+ my ($maxiter,$eps) = map {$opt->{$_}} qw/Maxiter Eps/;
+ # initialize some variables
+ my ($isig2,$chisq) = (1/($sig*$sig),0);
+ my ($ym,$al,$cov,$bet,$oldbet,$olda,$oldal,$ochisq,$di,$pivt,$info) =
+ map {null} (0..10);
+ my ($aldiag,$codiag); # the diagonals for later updating
+ # this will break threading
+ my $dyda = zeroes($x->type,$x->getdim(0),$a->getdim(0));
+ my $alv = zeroes($x->type,$x->getdim(0),$a->getdim(0),$a->getdim(0));
+ my ($iter,$lambda) = (0,0.001);
+
+ do {
+ if ($iter>0) {
+ $cov .= $al;
+ # local $PDL::debug = 1;
+ $codiag .= $aldiag*(1+$lambda);
+ gefa $cov, $pivt, $info; # gefa + gesl = solution by Gaussian elem.
+ gesl $cov, $pivt, $bet, 0; # solution returned in $bet
+ # lusd($cov,$bet,$da);
+ # print "changing by $da\n";
+ $a += $bet; # what we used to call $da is now $bet
+ }
+ &$func($x,$a,$ym,$dyda);
+ $chisq = ($y-$ym)*($y-$ym);
+ $chisq *= $isig2;
+ $chisq = $chisq->sumover; # calculate chi^2
+ $dyda->xchg(0,1)->outer($dyda->xchg(0,1),$alv->mv(0,2));
+ $alv *= $isig2;
+ $alv->sumover($al); # calculate alpha
+ (($y-$ym)*$isig2*$dyda)->sumover($bet); # calculate beta
+ if ($iter == 0) {$olda .= $a; $ochisq .= $chisq; $oldbet .= $bet;
+ $oldal .= $al; $aldiag = $al->diagonal(0,1);
+ $cov .= $al; $codiag = $cov->diagonal(0,1)}
+ $di .= abs($chisq-$ochisq);
+ # print "$iter: chisq, lambda, dlambda: $chisq, $lambda,",$di/$chisq,"\n";
+ if ($chisq < $ochisq) {
+ $lambda *= 0.1;
+ $ochisq .= $chisq;
+ $olda .= $a;
+ $oldbet .= $bet;
+ $oldal .= $al;
+ } else {
+ $lambda *= 10;
+ $chisq .= $ochisq;
+ $a .= $olda; # go back to previous a
+ $bet .= $oldbet; # and beta
+ $al .= $oldal; # and alpha
+ }
+ } while ($iter++==0 || $iter < $maxiter && $di/$chisq > $eps);
+ barf "iteration did not converge" if $iter >= $maxiter && $di/$chisq > $eps;
+ # return inv $al as estimate of covariance matrix
+ return wantarray ? ($ym,$a,matinv($al),$iter) : $ym;
+}
+*lmfit = \&PDL::lmfit;
+
+=pod
+
+An extended example script that uses lmfit is included below.
+This nice example was provided by John Gehman and should
+help you to master the initial hurdles. It can also be found in
+the F<Example/Fit> directory.
+
+ use PDL;
+ use PDL::Math;
+ use PDL::Fit::LM;
+ use strict;
+
+
+ ### fit using pdl's lmfit (Marquardt-Levenberg non-linear least squares fitting)
+ ###
+ ### `lmfit' Syntax:
+ ###
+ ### ($ym,$a,$covar,$iters)
+ ### = lmfit $x, $y, $sig, \&fn, $initp, {Maxiter => 300, Eps => 1e-3};
+ ###
+ ### Explanation of variables
+ ###
+ ### OUTPUT
+ ### $ym = pdl of fitted values
+ ### $a = pdl of paramters
+ ### $covar = covariance matrix
+ ### $iters = number of iterations actually used
+ ###
+ ### INPUT
+ ### $x = x data
+ ### $y = y data
+ ### $sig = weights for y data (can be set to scalar 1 for equal weighting)
+ ### \&fn = reference to function provided by user (more on this below)
+ ### $initp = initial values for floating parameters
+ ### (needs to be explicitly set prior to use of lmfit)
+ ### Maxiter = maximum iterations
+ ### Eps = convergence criterium (maximum normalized change in Chi Sq.)
+
+ ### Example:
+ # make up experimental data:
+ my $xdata = pdl sequence 5;
+ my $ydata = pdl [1.1,1.9,3.05,4,4.9];
+
+ # set initial prameters in a pdl (order in accord with fit function below)
+ my $initp = pdl [0,1];
+
+ # Weight all y data equally (else specify different weights in a pdl)
+ my $wt = 1;
+
+ # Use lmfit. Fourth input argument is reference to user-defined
+ # subroutine ( here \&linefit ) detailed below.
+ my ($yf,$pf,$cf,$if) = lmfit $xdata, $ydata, $wt, \&linefit, $initp;
+
+ # Note output
+ print "\nXDATA\n$xdata\nY DATA\n$ydata\n\nY DATA FIT\n$yf\n\n";
+ print "Slope and Intercept\n$pf\n\nCOVARIANCE MATRIX\n$cf\n\n";
+ print "NUMBER ITERATIONS\n$if\n\n";
+
+
+ # simple example of user defined fit function. Guidelines included on
+ # how to write your own function subroutine.
+ sub linefit {
+
+ # leave this line as is
+ my ($x,$par,$ym,$dyda) = @_;
+
+ # $m and $b are fit parameters, internal to this function
+ # call them whatever make sense to you, but replace (0..1)
+ # with (0..x) where x is equal to your number of fit parameters
+ # minus 1
+ my ($m,$b) = map { $par->slice("($_)") } (0..1);
+
+ # Write function with dependent variable $ym,
+ # independent variable $x, and fit parameters as specified above.
+ # Use the .= (dot equals) assignment operator to express the equality
+ # (not just a plain equals)
+ $ym .= $m * $x + $b;
+
+ # Edit only the (0..1) part to (0..x) as above
+ my (@dy) = map {$dyda -> slice(",($_)") } (0..1);
+
+ # Partial derivative of the function with respect to first
+ # fit parameter ($m in this case). Again, note .= assignment
+ # operator (not just "equals")
+ $dy[0] .= $x;
+
+ # Partial derivative of the function with respect to next
+ # fit parameter ($b in this case)
+ $dy[1] .= 1;
+
+ # Add $dy[ ] .= () lines as necessary to supply
+ # partial derivatives for all floating paramters.
+ }
+
+=cut
+
+# the OtherPar is the sub routine ref
+
+=head2 tlmfit
+
+=for ref
+
+threaded version of Levenberg-Marquardt fitting routine mfit
+
+=for example
+
+ tlmfit $x, $y, float(1)->dummy(0), $na, float(200), float(1e-4),
+ $ym=null, $afit=null, \&expdec;
+
+
+=for sig
+
+ Signature: tlmfit(x(n);y(n);sig(n);a(m);iter();eps();[o] ym(n);[o] ao(m);
+ OtherPar => subref)
+
+a threaded version of C<lmfit> by using perl threading. Direct
+threading in C<lmfit> seemed difficult since we have an if condition
+in the iteration. In principle that can be worked around by
+using C<where> but .... Send a threaded C<lmfit> version if
+you work it out!
+
+Since we are using perl threading here speed is not really great
+but it is just convenient to have a threaded version for many
+applications (no explicit for-loops required, etc). Suffers from
+some of the current limitations of perl level threading.
+
+=cut
+
+
+thread_define 'tlmfit(x(n);y(n);sig(n);a(m);iter();eps();[o] ym(n);[o] ao(m)),
+ NOtherPars => 1',
+ over {
+ $_[7] .= $_[3]; # copy our parameter guess into the output
+ $_[6] .= PDL::lmfit $_[0],$_[1],$_[2],$_[8],$_[7],{Maxiter => $_[4],
+ Eps => $_[5]};
+ };
+
+1;
+
+=head1 BUGS
+
+Not known yet.
+
+=head1 AUTHOR
+
+This file copyright (C) 1999, Christian Soeller
+(c.soeller at auckland.ac.nz). All rights reserved. There is no
+warranty. You are allowed to redistribute this software documentation
+under certain conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution, the
+copyright notice should be included in the file.
+
+=cut
+
+# return true
+1;
diff --git a/Lib/Fit/Linfit.pm b/Lib/Fit/Linfit.pm
new file mode 100644
index 0000000..0fcb9e2
--- /dev/null
+++ b/Lib/Fit/Linfit.pm
@@ -0,0 +1,166 @@
+=head1 NAME
+
+PDL::Fit::Linfit - routines for fitting data with linear combinations of functions.
+
+=head1 DESCRIPTION
+
+This module contains routines to perform general curve-fits to a set (linear combination)
+of specified functions.
+
+Given a set of Data:
+
+ (y0, y1, y2, y3, y4, y5, ...ynoPoints-1)
+
+The fit routine tries to model y as:
+
+ y' = beta0*x0 + beta1*x1 + ... beta_noCoefs*x_noCoefs
+
+Where x0, x1, ... x_noCoefs, is a set of functions (curves) that
+the are combined linearly using the beta coefs to yield an approximation
+of the input data.
+
+The Sum-Sq error is reduced to a minimum in this curve fit.
+
+B<Inputs:>
+
+=over 1
+
+=item $data
+
+This is your data you are trying to fit. Size=n
+
+=item $functions
+
+2D array. size (n, noCoefs). Row 0 is the evaluation
+of function x0 at all the points in y. Row 1 is the evaluation of
+of function x1 at all the points in y, ... etc.
+
+Example of $functions array Structure:
+
+$data is a set of 10 points that we are trying to model using
+the linear combination of 3 functions.
+
+ $functions = ( [ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 ], # Constant Term
+ [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ], # Linear Slope Term
+ [ 0, 2, 4, 9, 16, 25, 36, 49, 64, 81] # quadradic term
+ )
+
+=back
+
+=head1 SYNOPSIS
+
+ $yfit = linfit1d $data, $funcs
+
+
+=head1 FUNCTIONS
+
+=head2 linfit1d
+
+=for ref
+
+1D Fit linear combination of supplied functions to data using min chi^2 (least squares).
+
+=for usage
+
+ Usage: ($yfit, [$coeffs]) = linfit1d [$xdata], $data, $fitFuncs, [Options...]
+
+=for sig
+
+ Signature: (xdata(n); ydata(n); $fitFuncs(n,order); [o]yfit(n); [o]coeffs(order))
+
+Uses a standard matrix inversion method to do a least
+squares/min chi^2 fit to data.
+
+Returns the fitted data and optionally the coefficients.
+
+One can thread over extra dimensions to do multiple fits (except
+the order can not be threaded over - i.e. it must be one fixed
+set of fit functions C<fitFuncs>.
+
+The data is normalised internally to avoid overflows (using the
+mean of the abs value) which are common in large polynomial
+series but the returned fit, coeffs are in
+unnormalised units.
+
+
+=for example
+
+ # Generate data from a set of functions
+ $xvalues = sequence(100);
+ $data = 3*$xvalues + 2*cos($xvalues) + 3*sin($xvalues*2);
+
+ # Make the fit Functions
+ $fitFuncs = cat $xvalues, cos($xvalues), sin($xvalues*2);
+
+ # Now fit the data, Coefs should be the coefs in the linear combination
+ # above: 3,2,3
+ ($yfit, $coeffs) = linfit1d $data,$fitFuncs;
+
+
+=for options
+
+ Options:
+ Weights Weights to use in fit, e.g. 1/$sigma**2 (default=1)
+
+
+=cut
+
+package PDL::Fit::Linfit;
+
+ at EXPORT_OK = qw( linfit1d );
+%EXPORT_TAGS = (Func=>[@EXPORT_OK]);
+
+use PDL::Core;
+use PDL::Basic;
+use PDL::Exporter;
+ at ISA = qw( PDL::Exporter );
+use PDL::Options ':Func';
+use PDL::Slatec; # For matinv()
+
+sub PDL::linfit1d {
+ my $opthash = ref($_[-1]) eq "HASH" ? pop(@_) : {} ;
+ my %opt = parse( { Weights=>ones(1) }, $opthash ) ;
+ barf "Usage: linfit1d incorrect args\n" if $#_<1 or $#_ > 3;
+ my ($x, $y, $fitfuncs) = @_;
+ if ($#_ == 1) {
+ ($y, $fitfuncs) = @_;
+ $x = $y->xvals;
+ }
+
+ my $wt = $opt{Weights};
+
+ # Internally normalise data
+
+ my $ymean = (abs($y)->sum)/($y->nelem);
+ $ymean = 1 if $ymean == 0;
+ my $y2 = $y / $ymean;
+
+ # Do the fit
+
+ my $M = $fitfuncs->xchg(0,1);
+ my $C = $M->xchg(0,1) x ($M * $wt->dummy(0)) ;
+ my $Y = $M->xchg(0,1) x ($y2->dummy(0) * $wt->dummy(0));
+
+ # Fitted coefficients vector
+
+ $a = matinv($C) x $Y;
+
+ # Fitted data
+
+ $yfit = ($M x $a)->clump(2); # Remove first dim=1
+
+ $yfit *= $ymean; # Un-normalise
+ if (wantarray) {
+ my $coeff = $a->clump(2);
+ $coeff *= $ymean; # Un-normalise
+ return ($yfit, $coeff);
+ }
+ else{
+ return $yfit;
+ }
+
+}
+*linfit1d = \&PDL::linfit1d;
+
+
+1;
diff --git a/Lib/Fit/Makefile.PL b/Lib/Fit/Makefile.PL
new file mode 100644
index 0000000..a2e1273
--- /dev/null
+++ b/Lib/Fit/Makefile.PL
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+
+
+WriteMakefile(
+ 'NAME' => 'PDL::Fit',
+ VERSION_FROM => '../../Basic/Core/Version.pm',
+ DIR => [ qw/Gaussian/ ],
+ PM => { map {($_ => '$(INST_LIBDIR)/Fit/'.$_)} <*.pm> },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
diff --git a/Lib/Fit/Polynomial.pm b/Lib/Fit/Polynomial.pm
new file mode 100644
index 0000000..1ebcdd1
--- /dev/null
+++ b/Lib/Fit/Polynomial.pm
@@ -0,0 +1,154 @@
+=head1 NAME
+
+PDL::Fit::Polynomial - routines for fitting with polynomials
+
+=head1 DESCRIPTION
+
+This module contains routines for doing simple
+polynomial fits to data
+
+=head1 SYNOPSIS
+
+ $yfit = fitpoly1d $data;
+
+
+=head1 FUNCTIONS
+
+=head2 fitpoly1d
+
+=for ref
+
+Fit 1D polynomials to data using min chi^2 (least squares)
+
+=for usage
+
+ Usage: ($yfit, [$coeffs]) = fitpoly1d [$xdata], $data, $order, [Options...]
+
+=for sig
+
+ Signature: (x(n); y(n); [o]yfit(n); [o]coeffs(order))
+
+Uses a standard matrix inversion method to do a least
+squares/min chi^2 polynomial fit to data. Order=2 is a linear
+fit (two parameters).
+
+Returns the fitted data and optionally the coefficients.
+
+One can thread over extra dimensions to do multiple fits (except
+the order can not be threaded over - i.e. it must be one fixed
+scalar number like "4").
+
+The data is normalised internally to avoid overflows (using the
+mean of the abs value) which are common in large polynomial
+series but the returned fit, coeffs are in
+unnormalised units.
+
+
+=for example
+
+ $yfit = fitpoly1d $data,2; # Least-squares line fit
+ ($yfit, $coeffs) = fitpoly1d $x, $y, 4; # Fit a cubic
+
+ $fitimage = fitpoly1d $image,3 # Fit a quadratic to each row of an image
+
+ $myfit = fitpoly1d $line, 2, {Weights => $w}; # Weighted fit
+
+=for options
+
+ Options:
+ Weights Weights to use in fit, e.g. 1/$sigma**2 (default=1)
+
+
+=cut
+
+package PDL::Fit::Polynomial;
+
+ at EXPORT_OK = qw( fitpoly1d );
+%EXPORT_TAGS = (Func=>[@EXPORT_OK]);
+
+use PDL::Core;
+use PDL::Basic;
+use PDL::Exporter;
+ at ISA = qw( PDL::Exporter );
+
+use PDL::Options ':Func';
+# use PDL::Slatec; # For matinv()
+use PDL::MatrixOps; # for inv(), using this instead of call to Slatec routine
+
+
+sub PDL::fitpoly1d {
+ my $opthash = ref($_[-1]) eq "HASH" ? pop(@_) : {} ;
+ my %opt = parse( { Weights=>ones(1) }, $opthash ) ;
+ barf "Usage: fitpoly1d incorrect args\n" if $#_<1 or $#_ > 2;
+ my ($x, $y, $order) = @_;
+ if ($#_ == 1) {
+ ($y, $order) = @_;
+ $x = $y->xvals;
+ }
+
+ my $wt = $opt{Weights};
+
+ # Internally normalise data
+
+ # means for each 1D data set
+ my $xmean = (abs($x)->average)->dummy(0); # dummy for correct threading
+ my $ymean = (abs($y)->average)->dummy(0);
+ (my $tmp = $ymean->where($ymean == 0)) .= 1 if any $ymean == 0;
+ ($tmp = $xmean->where($xmean == 0)) .= 1 if any $xmean == 0;
+ my $y2 = $y / $ymean;
+ my $x2 = $x / $xmean;
+
+ # Do the fit
+
+ my $pow = sequence($order);
+ my $M = $x2->dummy(0) ** $pow;
+ my $C = $M->xchg(0,1) x ($M * $wt->dummy(0)) ;
+ my $Y = $M->xchg(0,1) x ($y2->dummy(0) * $wt->dummy(0));
+
+ # Fitted coefficients vector
+
+ # $a = matinv($C) x $Y;
+ $a = inv($C) x $Y; # use inv() instead of matinv() to avoid Slatec dependency
+
+ # Fitted data
+
+ $yfit = ($M x $a)->clump(2); # Remove first dim=1
+
+ $yfit *= $ymean; # Un-normalise
+ if (wantarray) {
+ my $coeff = $a->clump(2);
+ $coeff *= $ymean / ($xmean ** $pow); # Un-normalise
+ return ($yfit, $coeff);
+ }
+ else{
+ return $yfit;
+ }
+
+}
+*fitpoly1d = \&PDL::fitpoly1d;
+
+=head1 BUGS
+
+May not work too well for data with large dynamic range.
+
+=head1 SEE ALSO
+
+L<PDL::Slatec/"polyfit">
+
+=head1 AUTHOR
+
+This file copyright (C) 1999, Karl Glazebrook (kgb at aaoepp.aao.gov.au).
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+
+=cut
+
+
+
+1;
+
+
diff --git a/Lib/Func.pm b/Lib/Func.pm
new file mode 100644
index 0000000..10b4e5a
--- /dev/null
+++ b/Lib/Func.pm
@@ -0,0 +1,948 @@
+
+=head1 NAME
+
+PDL::Func - interpolation, integration, & gradient estimation (differentiation) of functions
+
+=head1 SYNOPSIS
+
+ use PDL::Func;
+ use PDL::Math;
+
+ # somewhat pointless way to estimate cos and sin,
+ # but is shows that you can thread if you want to
+ # (and the library lets you)
+ #
+ my $obj = PDL::Func->init( Interpolate => "Hermite" );
+ #
+ my $x = pdl( 0 .. 45 ) * 4 * 3.14159 / 180;
+ my $y = cat( sin($x), cos($x) );
+ $obj->set( x => $x, y => $y, bc => "simple" );
+ #
+ my $xi = pdl( 0.5, 1.5, 2.5 );
+ my $yi = $obj->interpolate( $xi );
+ #
+ print "sin( $xi ) equals ", $yi->slice(':,(0)'), "\n";
+ sin( [0.5 1.5 2.5] ) equals [0.87759844 0.070737667 -0.80115622]
+ #
+ print "cos( $xi ) equals ", $yi->slice(':,(1)'), "\n";
+ cos( [0.5 1.5 2.5] ) equals [ 0.4794191 0.99768655 0.59846449]
+ #
+ print sin($xi), "\n", cos($xi), "\n";
+ [0.47942554 0.99749499 0.59847214]
+ [0.87758256 0.070737202 -0.80114362]
+
+=head1 DESCRIPTION
+
+This module aims to contain useful functions. Honest.
+
+=head1 INTERPOLATION AND MORE
+
+This module aims to provide a relatively-uniform interface
+to the various interpolation methods available to PDL.
+The idea is that a different interpolation scheme
+can be used just by changing an attribute of a C<PDL::Func>
+object.
+Some interpolation schemes (as exemplified by the SLATEC
+library) also provide additional functionality, such as
+integration and gradient estimation.
+
+Throughout this documentation, C<$x> and C<$y> refer to the function
+to be interpolated whilst C<$xi> and C<$yi> are the interpolated values.
+
+The avaliable types, or I<schemes>, of interpolation are listed below.
+Also given are the valid attributes for each scheme: the flag value
+indicates whether it can be set (s), got (g), and if it is
+required (r) for the method to work.
+
+=over 4
+
+=item Interpolate => Linear
+
+An extravagent way of calling the linear interpolation routine
+L<PDL::Primitive::interpolate|PDL::Primitive/interpolate>.
+
+The valid attributes are:
+
+ Attribute Flag Description
+ x sgr x positions of data
+ y sgr function values at x positions
+ err g error flag
+
+=item Interpolate => Hermite
+
+Use the piecewice cubic Hermite interpolation routines
+from the SLATEC library.
+Only available if L<PDL::Slatec|PDL::Slatec> is installed.
+
+The valid attributes are:
+
+ Attribute Flag Description
+ x sgr x positions of data
+ y sgr function values at x positions
+ bc sgr boundary conditions
+ g g estimated gradient at x positions
+ err g error flag
+
+Given the initial set of points C<(x,y)>, an estimate of the
+gradient is made at these points, using the given boundary
+conditions. The gradients are stored in the C<g> attribute,
+accessible via:
+
+ $gradient = $obj->get( 'g' );
+
+However, as this gradient is only calculated 'at the last moment',
+C<g> will only contain data I<after> one of
+C<interpolate>, C<gradient>, or C<integrate> is used.
+
+=back
+
+=head2 Boundary conditions for the Hermite routines
+
+If your data is monotonic, and you are not too bothered about
+edge effects, then the default value of C<bc> of C<simple> is for you.
+Otherwise, take a look at the description of
+L<PDL::Slatec::chic|PDL::Slatec/chic> and use a hash reference
+for the C<bc> attribute, with the following keys:
+
+=over 3
+
+=item monotonic
+
+0 if the interpolant is to be monotonic in each interval (so
+the gradient will be 0 at each switch point),
+otherwise the gradient is calculated using a 3-point difference
+formula at switch points.
+If E<gt> 0 then the interpolant is forced to lie close to the
+data, if E<lt> 0 no such control is imposed.
+Default = B<0>.
+
+=item start
+
+A perl list of one or two elements. The first element defines how the
+boundary condition for the start of the array is to be calculated;
+it has a range of C<-5 .. 5>, as given for the C<ic> parameter
+of L<chic|PDL::Slatec/chic>.
+The second element, only used if options 2, 1, -1, or 2
+are chosen, contains the value of the C<vc> parameter.
+Default = B<[ 0 ]>.
+
+=item end
+
+As for C<start>, but for the end of the data.
+
+=back
+
+An example would be
+
+ $obj->set( bc => { start => [ 1, 0 ], end => [ 1, -1 ] } )
+
+which sets the first derivative at the first point to 0,
+and at the last point to -1.
+
+=head2 Errors
+
+The C<status> method provides a simple mechanism to check if
+the previous method was successful.
+If the function returns an error flag, then it is stored
+in the C<err> attribute.
+To find out which routine was used, use the
+C<routine> method.
+
+=cut
+
+#' fool emacs
+
+package PDL::Func;
+
+use strict;
+use Carp;
+
+####################################################################
+#
+# what modules are available ?
+#
+my %modules;
+BEGIN {
+ eval "use PDL::Slatec";
+ $modules{slatec} = ($@ ? 0 : 1);
+}
+
+####################################################################
+
+## Public routines:
+
+=head1 FUNCTIONS
+
+=head2 PDL::Func::init
+
+=for usage
+
+ $obj = PDL::Func->init( Interpolate => "Hermite", x => $x, y => $y );
+ $obj = PDL::Func->init( { x => $x, y => $y } );
+
+=for ref
+
+Create a PDL::Func object, which can interpolate, and possibly
+integrate and calculate gradients of a dataset.
+
+If not specified, the value of Interpolate is taken to be
+C<Linear>, which means the interpolation is performed by
+L<PDL::Primitive::interpolate|PDL::Primitive/interpolate>.
+A value of C<Hermite> uses piecewise cubic Hermite functions,
+which also allows the integral and gradient of the data
+to be estimated.
+
+Options can either be provided directly to the method, as in the
+first example, or within a hash reference, as shown in the second
+example.
+
+=cut
+
+# meaning of types:
+# required - required, if this attr is changed, we need to re-initialise
+# settable - can be changed with a init() or set() command
+# gettable - can be read with a get() command
+#
+# do we really need gettable? Not currently, that's for sure,
+# as everything is gettable
+
+my %attr =
+ (
+ Default => {
+ x => { required => 1, settable => 1, gettable => 1 },
+ y => { required => 1, settable => 1, gettable => 1 },
+ err => { gettable => 1 },
+ },
+ Linear => {},
+ Hermite => {
+ bc => { settable => 1, gettable => 1, required => 1, default => "simple" },
+ g => { gettable => 1 },
+ },
+ );
+
+sub init {
+ my $this = shift;
+ my $class = ref($this) || $this;
+
+ # class structure
+ my $self = { };
+
+ # make $self into an object
+ bless $self, $class;
+
+ # set up default attributes
+ #
+ my ( %opt ) = @_;
+ $opt{Interpolate} = "Linear" unless exists $opt{Interpolate};
+
+ # set variables
+ $self->set( %opt );
+
+ # return the object
+ return $self;
+
+} # sub: init()
+
+#####################################################################
+
+# $self->_init_attr( $interpolate )
+#
+# set up the object for the given interpolation method
+# - uses the values stored in %attr to fill in the
+# fields in $self AFTER clearing the object
+#
+# NOTE: called by set()
+#
+sub _init_attr {
+ my $self = shift;
+ my $interpolate = shift;
+
+ croak "ERROR: Unknown interpolation scheme <$interpolate>.\n"
+ unless defined $attr{$interpolate};
+
+ # fall over if slatec library isn't present
+ # and asking for Hermite interpolation
+ croak "ERROR: Hermite interpolation is not available without PDL::Slatec.\n"
+ if $interpolate eq "Interpolate" and $modules{slatec} == 0;
+
+ # clear out the old data (if it's not the first time through)
+ $self->{attributes} = {};
+ $self->{values} = {};
+ $self->{types} = { required => 0, settable => 0, gettable => 0 };
+ $self->{flags} = { scheme => $interpolate, status => 1, routine => "none", changed => 1 };
+
+ # set up default values
+ my $ref = $attr{Default};
+ foreach my $attr ( keys %{$ref} ) {
+ # set default values
+ foreach my $type ( keys %{$self->{types}} ) {
+ $self->{attributes}{$attr}{$type} = $self->{types}{$type};
+ }
+
+ # change the values to those supplied
+ foreach my $type ( keys %{$ref->{$attr}} ) {
+ $self->{attributes}{$attr}{$type} = $ref->{$attr}{$type}
+ if exists $self->{types}{$type};
+ }
+ # set value to undef
+ $self->{values}{$attr} = undef;
+ }
+
+ # now set up for the particular interpolation scheme
+ $ref = $attr{$interpolate};
+ foreach my $attr ( keys %{$ref} ) {
+ # set default values, if not known
+ unless ( defined $self->{attributes}{$attr} ) {
+ foreach my $type ( keys %{$self->{types}} ) {
+ $self->{attributes}{$attr}{$type} = $self->{types}{$type};
+ }
+ }
+
+ # change the values to those supplied
+ foreach my $type ( keys %{$ref->{$attr}} ) {
+ next if $type eq "default";
+ $self->{attributes}{$attr}{$type} = $ref->{$attr}{$type}
+ if exists $self->{types}{$type};
+ }
+ # set value to default value/undef
+ $self->{values}{$attr} =
+ exists $ref->{$attr}{default} ? $ref->{$attr}{default} : undef;
+ }
+} # sub: _init_attr()
+
+####################################################################
+
+# call this at the start of each method that needs data
+# stored in the object. This function ensures that all required
+# attributes exist and, if necessary, re-initialises the object
+# - ie if the data has changed.
+#
+sub _check_attr {
+ my $self = shift;
+ return unless $self->{flags}{changed};
+
+ my @emsg;
+ foreach my $name ( keys %{ $self->{attributes} } ) {
+ if( $self->{attributes}{$name}{required} ) {
+ push @emsg, $name unless defined($self->{values}{$name});
+ }
+ }
+ croak "ERROR - the following attributes must be supplied:\n [ @emsg ]\n"
+ unless $#emsg == -1;
+
+ $self->{flags}{routine} = "none";
+ $self->{flags}{status} = 1;
+
+ $self->_initialise;
+ $self->{flags}{changed} = 0;
+
+} # sub: _check_attr()
+
+####################################################################
+
+# for a given scheme, it may be necessary to perform certain
+# operations before the main routine of a method is called.
+# It's done here.
+#
+# Due to lazy evaluation we try to do this as late as possible -
+# _initialise() should only be called by _check_attr()
+# [ at least at the moment ]
+#
+sub _initialise {
+ my $self = shift;
+
+ my $iflag = $self->scheme();
+ if ( $iflag eq "Hermite" ) {
+ _init_hermite( $self );
+ }
+
+} # sub: _initialise()
+
+# something has changed, so we need to recalculate the gradient
+# - actually, some changes don't invalidate the gradient,
+# however, with the current design, it's impossible to know
+# this. (poor design)
+#
+sub _init_hermite {
+ my $self = shift;
+
+ # set up error flags
+ $self->{flags}{status} = 0;
+ $self->{flags}{routine} = "none";
+
+ # get values in one go
+ my ( $x, $y, $bc ) = $self->_get_value( qw( x y bc ) );
+
+ # check 1st dimention of x and y are the same
+ # ie allow the possibility of threading
+ my $xdim = $x->getdim( 0 );
+ my $ydim = $y->getdim( 0 );
+ croak "ERROR: x and y piddles must have the same first dimension.\n"
+ unless $xdim == $ydim;
+
+ my ( $g, $ierr );
+ if ( ref($bc) eq "HASH" ) {
+ my $monotonic = $bc->{monotonic} || 0;
+ my $start = $bc->{start} || [ 0 ];
+ my $end = $bc->{end} || [ 0 ];
+
+ my $ic = $x->short( $start->[0], $end->[0] );
+ my $vc = $x->float( 0, 0 );
+
+ if ( $#$start == 1 ) { $vc->set( 0, $start->[1] ); }
+ if ( $#$end == 1 ) { $vc->set( 1, $end->[1] ); }
+
+ my $wk = $x->zeroes( $x->float, 2*$xdim );
+ croak "ERROR: Hermite interpolation is not available without PDL::Slatec.\n"
+ if $modules{slatec} == 0;
+ ( $g, $ierr ) = chic( $ic, $vc, $monotonic, $x, $y, $wk );
+
+ $self->{flags}{routine} = "chic";
+
+ } elsif ( $bc eq "simple" ) {
+ # chim
+ croak "ERROR: Hermite interpolation is not available without PDL::Slatec.\n"
+ if $modules{slatec} == 0;
+ ( $g, $ierr ) = chim( $x, $y );
+
+ $self->{flags}{routine} = "chim";
+
+ } else {
+ # Unknown boundary condition
+ croak "ERROR: unknown boundary condition <$bc>.\n";
+ # return;
+ }
+
+ $self->_set_value( g => $g, err => $ierr );
+
+ if ( all $ierr == 0 ) {
+ # everything okay
+ $self->{flags}{status} = 1;
+ } elsif ( any $ierr < 0 ) {
+ # a problem
+ $self->{flags}{status} = 0;
+ } else {
+ # there were switches in monotonicity
+ $self->{flags}{status} = -1;
+ }
+
+
+}
+
+####################################################################
+####################################################################
+
+# a version of set that ignores the settable flag
+# and doesn't bother about the presence of an Interpolate
+# value.
+#
+# - for use by the class, not by the public
+#
+# it still ignores unknown attributes
+#
+sub _set_value {
+ my $self = shift;
+ my %attrs = ( @_ );
+
+ foreach my $attr ( keys %attrs ) {
+ if ( exists($self->{values}{$attr}) ) {
+ $self->{values}{$attr} = $attrs{$attr};
+ $self->{flags}{changed} = 1;
+ }
+ }
+
+} # sub: _set_value()
+
+# a version of get that ignores the gettable flag
+# - for use by the class, not by the public
+#
+# an unknown attribute returns an undef
+#
+sub _get_value {
+ my $self = shift;
+
+ my @ret;
+ foreach my $name ( @_ ) {
+ if ( exists $self->{values}{$name} ) {
+ push @ret, $self->{values}{$name};
+ } else {
+ push @ret, undef;
+ }
+ }
+
+ return wantarray ? @ret : $ret[0];
+
+} # sub: _get_value()
+
+####################################################################
+
+=head2 PDL::Func::set
+
+=for usage
+
+ my $nset = $obj->set( x => $newx, y => $newy );
+ my $nset = $obj->set( { x => $newx, y => $newy } );
+
+=for ref
+
+Set attributes for a PDL::Func object.
+
+The return value gives the number of the supplied attributes
+which were actually set.
+
+=cut
+
+sub set {
+ my $self = shift;
+ return if $#_ == -1;
+
+ my $vref;
+ if ( $#_ == 0 and ref($_[0]) eq "HASH" ) {
+ $vref = shift;
+ } else {
+ my %vals = ( @_ );
+ $vref = \%vals;
+ }
+
+ # initialise attributes IFF Interpolate
+ # is specified
+ #
+ $self->_init_attr( $vref->{Interpolate} )
+ if exists $vref->{Interpolate};
+
+ my $ctr = 0;
+ foreach my $name ( keys %{$vref} ) {
+ next if $name eq "Interpolate";
+ if ( exists $self->{attributes}{$name}{settable} ) {
+ $self->{values}{$name} = $vref->{$name};
+ $ctr++;
+ }
+ }
+
+ $self->{flags}{changed} = 1 if $ctr;
+ $self->{flags}{status} = 1;
+ return $ctr;
+
+} # sub: set()
+
+####################################################################
+
+=head2 PDL::Func::get
+
+=for usage
+
+ my $x = $obj->get( x );
+ my ( $x, $y ) = $obj->get( qw( x y ) );
+
+=for ref
+
+Get attributes from a PDL::Func object.
+
+Given a list of attribute names, return a list of
+their values; in scalar mode return a scalar value.
+If the supplied list contains an unknown attribute,
+C<get> returns a value of C<undef> for that
+attribute.
+
+=cut
+
+sub get {
+ my $self = shift;
+
+ my @ret;
+ foreach my $name ( @_ ) {
+ if ( exists $self->{attributes}{$name}{gettable} ) {
+ push @ret, $self->{values}{$name};
+ } else {
+ push @ret, undef;
+ }
+ }
+
+ return wantarray ? @ret : $ret[0];
+
+} # sub: get()
+
+####################################################################
+#
+# access to flags - have individual methods for these
+
+=head2 PDL::Func::scheme
+
+=for usage
+
+ my $scheme = $obj->scheme;
+
+=for ref
+
+Return the type of interpolation of a PDL::Func object.
+
+Returns either C<Linear> or C<Hermite>.
+
+=cut
+
+sub scheme { return $_[0]->{flags}{scheme}; }
+
+=head2 PDL::Func::status
+
+=for usage
+
+ my $status = $obj->status;
+
+=for ref
+
+Returns the status of a PDL::Func object.
+
+This method provides a high-level indication of
+the success of the last method called
+(except for C<get> which is ignored).
+Returns B<1> if everything is okay, B<0> if
+there has been a serious error,
+and B<-1> if there
+was a problem which was not serious.
+In the latter case, C<$obj-E<gt>get("err")> may
+provide more information, depending on the
+particular scheme in use.
+
+=cut
+
+sub status { return $_[0]->{flags}{status}; }
+
+=head2 PDL::Func::routine
+
+=for usage
+
+ my $name = $obj->routine;
+
+=for ref
+
+Returns the name of the last routine called by a PDL::Func object.
+
+This is mainly useful for decoding the value stored in the
+C<err> attribute.
+
+=cut
+
+sub routine { return $_[0]->{flags}{routine}; }
+
+=head2 PDL::Func::attributes
+
+=for usage
+
+ $obj->attributes;
+ PDL::Func->attributes;
+
+=for ref
+
+Print out the flags for the attributes of a PDL::Func object.
+
+Useful in case the documentation is just too opaque!
+
+=for example
+
+ PDL::Func->attributes;
+ Flags Attribute
+ SGR x
+ SGR y
+ G err
+
+=cut
+
+# note, can be called with the class, rather than just
+# an object. However, not of great use, as this will only
+# ever return the values for Interpolate => Linear
+#
+# to allow this, I've used a horrible hack - we actually
+# create an object and then print out the attributes from that
+# Ugh!
+#
+# It would have been useful if I'd stuck to sub-classes
+# for different schemes
+#
+sub attributes {
+ my $self = shift;
+
+ # ugh
+ $self = $self->init unless ref($self);
+
+ print "Flags Attribute\n";
+ while ( my ( $attr, $hashref ) = each %{$self->{attributes}} ) {
+ my $flag = "";
+ $flag .= "S" if $hashref->{settable};
+ $flag .= "G" if $hashref->{gettable};
+ $flag .= "R" if $hashref->{required};
+
+ printf " %-3s %s\n", $flag, $attr;
+ }
+ return;
+} # sub: attributes()
+
+####################################################################
+
+=head2 PDL::Func::interpolate
+
+=for usage
+
+ my $yi = $obj->interpolate( $xi );
+
+=for ref
+
+Returns the interpolated function at a given set of points
+(PDL::Func).
+
+A status value of -1, as returned by the C<status> method,
+means that some of the C<$xi> points lay outside the
+range of the data. The values for these points
+were calculated by extrapolation (the details depend on the
+scheme being used).
+
+=cut
+
+sub interpolate {
+ my $self = shift;
+ my $xi = shift;
+
+ croak 'Usage: $obj->interpolate( $xi )' . "\n"
+ unless defined $xi;
+
+ # check everything is fine
+ $self->_check_attr();
+
+ # get values in one go
+ my ( $x, $y ) = $self->_get_value( qw( x y ) );
+
+ # farm off to routines
+ my $iflag = $self->scheme;
+ if ( $iflag eq "Linear" ) {
+ return _interp_linear( $self, $xi, $x, $y );
+ } elsif ( $iflag eq "Hermite" ) {
+ return _interp_hermite( $self, $xi, $x, $y );
+ }
+
+} # sub: interpolate()
+
+sub _interp_linear {
+ my ( $self, $xi, $x, $y ) = ( @_ );
+
+ my ( $yi, $err ) = PDL::Primitive::interpolate( $xi, $x, $y );
+
+ $self->{flags}{status} = (any $err) ? -1 : 1;
+ $self->_set_value( err => $err );
+ $self->{flags}{routine} = "interpolate";
+
+ return $yi;
+} # sub: _interp_linear()
+
+sub _interp_hermite {
+ my ( $self, $xi, $x, $y ) = ( @_ );
+
+ # get gradient
+ my $g = $self->_get_value( 'g' );
+
+ my ( $yi, $ierr ) = chfe( $x, $y, $g, 0, $xi );
+ $self->{flags}{routine} = "chfe";
+ $self->_set_value( err => $ierr );
+
+ if ( all $ierr == 0 ) {
+ # everything okay
+ $self->{flags}{status} = 1;
+ } elsif ( all $ierr > 0 ) {
+ # extrapolation was required
+ $self->{flags}{status} = -1;
+ } else {
+ # a problem
+ $self->{flags}{status} = 0;
+ }
+
+ return $yi;
+} # sub: _interp_linear()
+
+=head2 PDL::Func::gradient
+
+=for usage
+
+ my $gi = $obj->gradient( $xi );
+ my ( $yi, $gi ) = $obj->gradient( $xi );
+
+=for ref
+
+Returns the derivative and, optionally,
+the interpolated function for the C<Hermite>
+scheme (PDL::Func).
+
+=cut
+
+sub gradient {
+ my $self = shift;
+ my $xi = shift;
+
+ croak 'Usage: $obj->gradient( $xi )' . "\n"
+ unless defined $xi;
+
+ croak 'Error: can not call gradient for Interpolate => "Linear".' ."\n"
+ unless $self->scheme eq "Hermite";
+
+ # check everything is fine
+ $self->_check_attr();
+
+ # get values in one go
+ my ( $x, $y, $g ) = $self->_get_value( qw( x y g ) );
+
+ my ( $yi, $gi, $ierr ) = chfd( $x, $y, $g, 0, $xi );
+ $self->{flags}{routine} = "chfd";
+ $self->_set_value( err => $ierr );
+
+ if ( all $ierr == 0 ) {
+ # everything okay
+ $self->{flags}{status} = 1;
+ } elsif ( all $ierr > 0 ) {
+ # extrapolation was required
+ $self->{flags}{status} = -1;
+ } else {
+ # a problem
+ $self->{flags}{status} = 0;
+ }
+
+ # note order of values
+ return wantarray ? ( $yi, $gi ) : $gi;
+
+} # sub: gradient
+
+=head2 PDL::Func::integrate
+
+=for usage
+
+ my $ans = $obj->integrate( index => pdl( 2, 5 ) );
+ my $ans = $obj->integrate( x => pdl( 2.3, 4.5 ) );
+
+=for ref
+
+Integrate the function stored in the PDL::Func
+object, if the scheme is C<Hermite>.
+
+The integration can either be between points of
+the original C<x> array (C<index>), or arbitrary x values
+(C<x>). For both cases, a two element piddle
+should be given,
+to specify the start and end points of the integration.
+
+=over 7
+
+=item index
+
+The values given refer to the indices of the points
+in the C<x> array.
+
+=item x
+
+The array contains the actual values to integrate between.
+
+=back
+
+If the C<status> method returns a value of -1, then
+one or both of the integration limits did not
+lie inside the C<x> array. I<Caveat emptor> with the
+result in such a case.
+
+=cut
+
+sub integrate {
+ my $self = shift;
+
+ croak 'Usage: $obj->integrate( $type => $limits )' . "\n"
+ unless $#_ == 1;
+
+ croak 'Error: can not call integrate for Interpolate => "Linear".' ."\n"
+ unless $self->{flags}{scheme} eq "Hermite";
+
+ # check everything is fine
+ $self->_check_attr();
+
+ $self->{flags}{status} = 0;
+ $self->{flags}{routine} = "none";
+
+ my ( $type, $indices ) = ( @_ );
+
+ croak "Unknown type ($type) sent to integrate method.\n"
+ unless $type eq "x" or $type eq "index";
+
+ my $fdim = $indices->getdim(0);
+ croak "Indices must have a first dimension of 2, not $fdim.\n"
+ unless $fdim == 2;
+
+ my $lo = $indices->slice('(0)');
+ my $hi = $indices->slice('(1)');
+
+ my ( $x, $y, $g ) = $self->_get_value( qw( x y g ) );
+ my ( $ans, $ierr );
+
+ if ( $type eq "x" ) {
+ ( $ans, $ierr ) = chia( $x, $y, $g, 0, $lo, $hi );
+ $self->{flags}{routine} = "chia";
+
+ if ( all $ierr == 0 ) {
+ # everything okay
+ $self->{flags}{status} = 1;
+ } elsif ( any $ierr < 0 ) {
+ # a problem
+ $self->{flags}{status} = 0;
+ } else {
+ # out of range
+ $self->{flags}->{status} = -1;
+ }
+
+ } else {
+ ( $ans, $ierr ) = chid( $x, $y, $g, 0, $lo, $hi );
+ $self->{flags}->{routine} = "chid";
+
+ if ( all $ierr == 0 ) {
+ # everything okay
+ $self->{flags}{status} = 1;
+ } elsif ( all $ierr != -4 ) {
+ # a problem
+ $self->{flags}{status} = 0;
+ } else {
+ # out of range (ierr == -4)
+ $self->{flags}{status} = -1;
+ }
+
+ }
+
+ $self->_set_value( err => $ierr );
+ return $ans;
+
+} # sub: integrate()
+
+####################################################################
+
+=head1 TODO
+
+It should be relatively easy to provide an interface to other
+interpolation routines, such as those provided by the
+Gnu Scientific Library (GSL), or the B-spline routines
+in the SLATEC library.
+
+In the documentation, the methods are preceeded by C<PDL::Func::>
+to avoid clashes with functions such as C<set> when using
+the C<help> or C<apropos> commands within I<perldl> or I<pdl2>.
+
+=head1 HISTORY
+
+Amalgamated C<PDL::Interpolate> and C<PDL::Interpolate::Slatec>
+to form C<PDL::Func>. Comments greatly appreciated on the
+current implementation, as it is not too sensible.
+
+Thanks to Robin Williams, Halld�r Olafsson, and Vince McIntyre.
+
+=head1 AUTHOR
+
+Copyright (C) 2000,2001 Doug Burke (dburke at cfa.harvard.edu).
+All rights reserved. There is no warranty.
+You are allowed to redistribute this software / documentation as
+described in the file COPYING in the PDL distribution.
+
+=cut
+
+####################################################################
+# End with a true
+1;
+
diff --git a/Lib/GIS/Makefile.PL b/Lib/GIS/Makefile.PL
new file mode 100644
index 0000000..448c1b7
--- /dev/null
+++ b/Lib/GIS/Makefile.PL
@@ -0,0 +1,9 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'PDL::Lib::GIS',
+ VERSION_FROM => '../../Basic/Core/Version.pm',
+ DIR => [ qw/ Proj / ],
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
diff --git a/Lib/GIS/Proj/Makefile.PL b/Lib/GIS/Proj/Makefile.PL
new file mode 100644
index 0000000..5bb487b
--- /dev/null
+++ b/Lib/GIS/Proj/Makefile.PL
@@ -0,0 +1,207 @@
+#
+# Makefile.PL for PDL::GIS::Proj
+#
+# Judd Taylor, USF IMaRS
+# 18 March 2003
+#
+
+use ExtUtils::MakeMaker;
+use Config;
+PDL::Core::Dev->import();
+
+use lib '../../../inc';
+use Devel::CheckLib;
+
+BEGIN
+{
+ # Generic descripton of how to optionally add this package to the PDL Tree:
+ $package_name = "PDL::GIS::Proj";
+ $lib_name = "Proj";
+ $find_libs = [ 'libproj.so', 'libproj.a' ];
+ $find_incs = [ 'proj_api.h' ];
+ $config_flag = 'WITH_PROJ';
+ $config_libs = 'PROJ_LIBS';
+ $config_incs = 'PROJ_INC';
+ @lib_locations = (
+ '/usr/lib64',
+ '/usr/local/lib64',
+ '/lib64',
+ '/usr/lib',
+ '/usr/local/lib',
+ '/lib',
+ split(/ /, $Config{libpth}),
+ );
+ @inc_locations = (
+ '/usr/include',
+ '/usr/local/include',
+ $Config{usrinc},
+ );
+
+ #
+ # You probably won't need to edit anything below here (until the very end):
+ #
+
+ $msg = "";
+ $forcebuild=0; # Note: forcebuild not used
+
+ if (defined $PDL::Config{$config_flag} && $PDL::Config{$config_flag}==0)
+ {
+ $msg = "\n Will skip build of $package_name on this system \n";
+ goto skip;
+ }
+
+ if (defined $PDL::Config{$config_flag} && $PDL::Config{$config_flag}==1)
+ {
+ print "\n Will forcibly try and build $package_name on this system \n\n";
+ $forcebuild=1;
+ }
+
+ # Look for Proj4 includes/libs
+
+ # get locations from perldl.conf, if specified there:
+ @lib_locations = @{$PDL::Config{$config_libs}}
+ if( defined $PDL::Config{$config_libs} );
+ @inc_locations = @{$PDL::Config{$config_incs}}
+ if( defined $PDL::Config{$config_incs} );
+
+ #
+ # Do the search:
+ #
+
+ my $fl; #fl stores find_lib iterator for use in $msg
+
+ foreach my $libdir ( @lib_locations )
+ {
+ my $found = 0;
+ foreach my $find_lib ( @$find_libs )
+ {
+ $fl = $find_lib;
+ if ( -e "$libdir/$find_lib" )
+ {
+ $gis_proj_lib_path = $libdir; # use a variable name that's unique to this Makefile.PL
+ print "\t$package_name: Found $libdir/$find_lib\n";
+ $found = 1;
+ }
+ last if $found;
+ }
+ last if $found;
+ } # foreach $libdir...
+
+ unless( defined( $gis_proj_lib_path ) )
+ {
+ $msg .= "\tCannot find $lib_name library, $fl.\n"
+ . "\tPlease add the correct library path to Makefile.PL or install $lib_name.\n";
+ }
+
+
+ # Look for the include files:
+ my $fi;
+ foreach my $incdir ( @inc_locations )
+ {
+ foreach my $find_inc ( @$find_incs )
+ {
+ $fi = $find_inc;
+ if ( -e "$incdir/$find_inc" )
+ {
+ $include_path = $incdir;
+ last;
+ }
+ }
+ }
+
+ unless( defined( $include_path ) )
+ {
+ $msg .= "\tCannot find $lib_name header file, $fi.\n"
+ . "\tPlease add the correct library path to Makefile.PL or install $lib_name.\n";
+ }
+
+ # Check for PROJ4 library version
+ {
+ open PJAPI, "$include_path/proj_api.h" or warn "Couldn't open '$include_path/proj_api.h': $!";
+ while (<PJAPI>) {
+ $PJ_VERSION = $1 if m/^\# define \s+ PJ_VERSION \s+ (\d+)/x ;
+ if (defined($PJ_VERSION)) {
+ warn " Got PJ_VERSION=$PJ_VERSION\n";
+ last;
+ }
+ }
+ close PJAPI;
+ }
+
+ #
+ # Make sure everything we wanted is found:
+ #
+ unless( defined( $include_path ) && defined( $gis_proj_lib_path ) )
+ {
+ $msg .= " Skipping build of $package_name.\n";
+ }
+
+ skip:
+
+ if ($msg && $forcebuild==0 or !defined($PJ_VERSION))
+ {
+ warn " Testing support libraries for $package_name:\n$msg\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ $donot = 1;
+ $PDL::Config{$config_flag}=0;
+ }
+ else
+ {
+ my $infomsg = 'check for projUV';
+ my $header = 'proj_api.h';
+ my $include = "#include <$header>";
+ my $progbody = 'projUV puv = { 5.0, 10.0 };';
+ my $libs = "-L$gis_proj_lib_path -lproj -lm";
+ my $cflags = "-I$include_path";
+
+ if (trylink($infomsg,$include,$progbody,$libs,$cflags) or $forcebuild) {
+ # now see if pj_init works
+ if (
+ check_lib(
+ function=>'projPJ mypj = pj_init_plus("+proj=eqc +lon_0=0"); if (! mypj) return 1; else return 0;',
+ header=>$header,
+ incpath=>$include_path,
+ lib=>'proj',
+ libpath=>$gis_proj_lib_path,
+ ) or $forcebuild ) {
+ print " Building $package_name. Turn off $config_flag if there are any problems\n\n";
+ $PDL::Config{$config_flag}=1;
+ $donot = 0;
+ }
+ else {
+ warn " PROJ4 library found but cannot initialize projection, won't build\n";
+ $PDL::Config{$config_flag}=0;
+ $msg =~ s/\n//g; # TODO: update $msg for tests
+ unless ($donot) {
+ write_dummy_make( $msg );
+ $donot = 1;
+ }
+ }
+ }
+ else {
+ warn " Include+Library configuration for PROJ4 does not support the projUV type\n";
+ $PDL::Config{$config_flag}=0;
+ $msg =~ s/\n//g; # TODO: update $msg for tests
+ unless ($donot) {
+ write_dummy_make( $msg );
+ $donot = 1;
+ }
+ }
+ }
+
+} # BEGIN...
+
+return if $donot; # yes, this must be return (exit will kill Makefile.PL process)
+
+## $DB::single = 1; # uncomment to have debugger stop here
+$ppfile = "Proj.pd";
+$package = [$ppfile, Proj, $package_name];
+%hash = pdlpp_stdargs($package);
+$hash{VERSION_FROM} = $ppfile;
+#$hash{TYPEMAPS} = [&PDL_TYPEMAP()];
+$hash{LIBS} = ["-L$gis_proj_lib_path -lproj -lm"];
+$hash{INC} = PDL_INCLUDE() . " -I$include_path" . ( ($PJ_VERSION==480) ? " -Iinclude/" : '' );
+WriteMakefile(%hash);
+
+sub MY::postamble { pdlpp_postamble_int( $package ); }
diff --git a/Lib/GIS/Proj/Proj.pd b/Lib/GIS/Proj/Proj.pd
new file mode 100644
index 0000000..efd6185
--- /dev/null
+++ b/Lib/GIS/Proj/Proj.pd
@@ -0,0 +1,699 @@
+#
+# Proj.pd - PP def file for the Proj4->PDL interface.
+#
+# COPYRIGHT NOTICE:
+#
+# Copyright 2003 Judd Taylor, USF Institute for Marine Remote Sensing (judd at marine.usf.edu).
+#
+# Now GPL!
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+use strict;
+use PDL;
+
+use vars qw( $VERSION );
+$VERSION = "1.32";
+
+pp_addpm(<<'EODOC');
+=head1 NAME
+
+PDL::GIS::Proj - PDL interface to the Proj4 projection library.
+
+=head1 DESCRIPTION
+
+PDL interface to the Proj4 projection library.
+
+For more information on the proj library, see: http://www.remotesensing.org/proj/
+
+=head1 AUTHOR
+
+Judd Taylor, Orbital Systems, Ltd.
+judd dot t at orbitalsystems dot com
+
+=head1 DATE
+
+18 March 2003
+
+=head1 CHANGES
+
+=head2 1.32 (29 March 2006) Judd Taylor
+
+ - Getting ready to merge this into the PDL CVS.
+
+=head2 1.31 (???) Judd Taylor
+
+ - Can't remember what was in that version
+
+=head2 1.30 (16 September 2003) Judd Taylor
+
+ - The get_proj_info() function actually works now.
+
+=head2 1.20 (24 April 2003) Judd Taylor
+
+ - Added get_proj_info().
+
+=head2 1.10 (23 April 2003) Judd Taylor
+
+ - Changed from using the proj_init() type API in projects.h to the
+ - proj_init_plus() API in proj_api.h. The old one was not that stable...
+
+=head2 1.00 (18 March 2003) Judd Taylor
+
+ - Initial version
+
+=head1 COPYRIGHT NOTICE
+
+Copyright 2003 Judd Taylor, USF Institute for Marine Remote Sensing (judd at marine.usf.edu).
+
+GPL Now!
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+=head1 SUBROUTINES
+
+=cut
+
+
+EODOC
+
+#
+# Header files:
+#
+pp_addhdr(<<'EOHDR');
+#include "projects.h"
+#include "proj_api.h"
+#include <string.h>
+
+EOHDR
+
+pp_addpm(<<'EOPM');
+
+=head2 fwd_transform($lon(pdl), $lat(pdl), $params)
+
+Proj4 forward transformation $params is a string of the projection transformation
+parameters.
+
+Returns two pdls for x and y values respectively. The units are dependant on Proj4
+behavior. They will be PDL->null if an error has occurred.
+
+BadDoc: Ignores bad elements of $lat and $lon, and sets the corresponding elements
+of $x and $y to BAD
+
+=cut
+
+
+sub fwd_transform
+{
+ my ($lon, $lat, $params) = @_;
+ my $x = null;
+ my $y = null;
+
+ #print "Projection transformation parameters: \'$params\'\n";
+
+ _fwd_trans( $lon, $lat, $x, $y, $params );
+
+ return ($x, $y);
+} # End of fwd_transform()...
+
+=head2 inv_transform($x(pdl), $y(pdl), $params)
+
+Proj4 inverse transformation $params is a string of the projection transformation
+parameters.
+
+Returns two pdls for lat and lon values respectively. The units are dependant on Proj4
+behavior. They will be PDL->null if an error has occurred.
+
+BadDoc: Ignores bad elements of $lat and $lon, and sets the corresponding elements
+of $x and $y to BAD
+
+=cut
+
+
+sub inv_transform
+{
+ my ($x, $y, $params) = @_;
+ my $lon = null;
+ my $lat = null;
+
+ #print "Projection transformation parameters: \'$params\'\n";
+
+ _inv_trans( $x, $y, $lon, $lat, $params );
+ return ($lon, $lat);
+} # End of fwd_transform()...
+
+=head2 get_proj_info($params_string)
+
+Returns a string with information about what parameters proj will
+actually use, this includes defaults, and +init=file stuff. It's
+the same as running 'proj -v'. It uses the proj command line, so
+it might not work with all shells. I've tested it with bash.
+
+=cut
+
+
+sub get_proj_info
+{
+ my $params = shift;
+ my @a = split(/\n/, `echo | proj -v $params`);
+ pop(@a);
+ return join("\n", @a);
+} # End of get_proj_info()...
+
+EOPM
+
+pp_add_exported('', ' fwd_transform inv_transform get_proj_info ');
+
+#
+# Forward transformation:
+#
+pp_def( '_fwd_trans',
+ Pars => 'lon(n);
+ lat(n);
+ [o] x(n);
+ [o] y(n);',
+ GenericTypes => ['D'],
+ Inplace => ['lon', 'x', 'lat', 'y'],
+ OtherPars => 'char* params;',
+ HandleBad => 1,
+ Doc => undef,
+ #BadDoc => 'Ignores bad elements of $lat and $lon, and sets '
+ # . 'the corresponding elements of $x and $y to BAD',
+ Code => <<'EOCODE',
+/* vars needed: */
+char* func = "_fwd_trans()";
+char errstr[255];
+projUV in, out;
+projPJ proj;
+const double d2r = DEG_TO_RAD;
+
+/* Init the projection */
+proj = pj_init_plus( $COMP(params) );
+if( proj == NULL )
+{
+ croak("%s: Projection initialization failed: %s\n", func, pj_strerrno(pj_errno));
+}
+
+/* Loop over the values converting as we go */
+loop (n)
+%{
+ in.u = $lon() * d2r;
+ in.v = $lat() * d2r;
+
+ out = pj_fwd(in, proj);
+ if (out.u == HUGE_VAL)
+ {
+ croak("%s: Projection conversion failed at (%f, %f): %s\n",
+ func, $lon(), $lat(), pj_strerrno(pj_errno));
+ }
+ $x() = out.u;
+ $y() = out.v;
+%}
+pj_free(proj);
+EOCODE
+
+
+ BadCode => <<'EOBAD');
+/* vars needed: */
+char* func = "_fwd_trans()";
+char errstr[255];
+projUV in, out;
+projPJ proj;
+const double d2r = DEG_TO_RAD;
+
+/* Init the projection */
+proj = pj_init_plus( $COMP(params) );
+if( proj == NULL )
+{
+ croak("%s: Projection initialization failed: %s\n", func, pj_strerrno(pj_errno));
+}
+
+/* Loop over the values converting as we go */
+loop (n)
+%{
+ if ( $ISBAD(lon()) || $ISBAD(lat()) )
+ {
+ $SETBAD(x());
+ $SETBAD(y());
+ }
+ else
+ {
+ in.u = $lon() * d2r;
+ in.v = $lat() * d2r;
+
+ out = pj_fwd(in, proj);
+ if (out.u == HUGE_VAL)
+ {
+ croak("%s: Projection conversion failed at (%f, %f): %s\n",
+ func, $lon(), $lat(), pj_strerrno(pj_errno));
+ }
+ $x() = out.u;
+ $y() = out.v;
+ }
+%}
+EOBAD
+
+#
+# INPLACE Forward transformation: (Call this one directly)
+#
+
+
+pp_addpm( <<'ENDPM' );
+#
+# Wrapper sub for _fwd_trans_inplace that sets a default for the quiet variable.
+#
+sub fwd_trans_inplace
+{
+ my $lon = shift;
+ my $lat = shift;
+ my $params = shift;
+ my $quiet = shift || 0;
+
+ _fwd_trans_inplace( $lon, $lat, $params, $quiet );
+} # End of fwd_trans_inplace()...
+
+ENDPM
+
+pp_add_exported('', 'fwd_trans_inplace');
+
+pp_def( '_fwd_trans_inplace',
+ Pars => 'lon();
+ lat();',
+ GenericTypes => ['F', 'D'],
+ OtherPars => 'char* params; int quiet;',
+ HandleBad => 1,
+ Doc => undef,
+ #BadDoc => 'Ignores bad elements of $lat and $lon, and sets '
+ # . 'the corresponding elements of $x and $y to BAD',
+ Code => <<'EOCODE',
+/* vars needed: */
+char* func = "_fwd_trans_inplace()";
+char errstr[255];
+projUV in, out;
+projPJ proj;
+const double d2r = DEG_TO_RAD;
+
+/* Init the projection */
+proj = pj_init_plus( $COMP(params) );
+if( proj == NULL )
+{
+ croak("%s: Projection initialization failed: %s\n", func, pj_strerrno(pj_errno));
+}
+
+/* Loop over the values converting as we go */
+threadloop
+%{
+ in.u = $lon() * d2r;
+ in.v = $lat() * d2r;
+
+ out = pj_fwd(in, proj);
+ if (out.u == HUGE_VAL)
+ {
+ croak("%s: Projection conversion failed at (%f, %f): %s\n",
+ func, $lon(), $lat(), pj_strerrno(pj_errno));
+ }
+ $lon() = out.u;
+ $lat() = out.v;
+%}
+pj_free(proj);
+EOCODE
+
+
+ BadCode => <<'EOBAD');
+/* vars needed: */
+char* func = "_fwd_trans_inplace[BADCODE]()";
+char errstr[255];
+projUV in, out;
+projPJ proj;
+const double d2r = DEG_TO_RAD;
+int loud = ! $COMP(quiet);
+
+/* Init the projection */
+proj = pj_init_plus( $COMP(params) );
+if( proj == NULL )
+{
+ croak("%s: Projection initialization failed: %s\n", func, pj_strerrno(pj_errno));
+}
+
+/* Loop over the values converting as we go */
+threadloop
+%{
+ if ( !($ISBAD(lon()) || $ISBAD(lat())) )
+ {
+ in.u = $lon() * d2r;
+ in.v = $lat() * d2r;
+
+ out = pj_fwd(in, proj);
+ if (out.u != HUGE_VAL)
+ {
+ $lon() = out.u;
+ $lat() = out.v;
+ }
+ else
+ {
+ $SETBAD( lon() );
+ $SETBAD( lat() );
+ if( loud )
+ {
+ sprintf(errstr, "%s: Projection conversion failed at (%f, %f): %s\n",
+ func, $lon(), $lat(), pj_strerrno(pj_errno));
+ fprintf( stderr, "%s", errstr );
+ fprintf( stderr, "%s: NOTE: Subsequent errors may have occured, but I'm only reporting the first!\n", func );
+ }
+ }
+ }
+%}
+pj_free(proj);
+EOBAD
+
+
+#
+# Inverse Transformation:
+#
+pp_def( '_inv_trans',
+ Pars => 'x(n);
+ y(n);
+ [o] lon(n);
+ [o] lat(n);',
+ GenericTypes => ['D'],
+ OtherPars => 'char* params;',
+ HandleBad => 1,
+ Doc => undef,
+ #BadDoc => 'Ignores bad elements of $x and $y, and sets '
+ # . 'the corresponding elements of $lon and $lat to BAD',
+ Code => <<'EOCODE',
+/* vars needed: */
+char errstr[255];
+projUV in, out;
+projPJ proj;
+const double r2d = RAD_TO_DEG;
+
+/* Init the projection */
+proj = pj_init_plus( $COMP(params) );
+if( proj == NULL )
+{
+ croak("Projection initialization failed: %s\n", pj_strerrno(pj_errno));
+}
+
+/* Loop over the values converting as we go */
+loop (n)
+%{
+ in.u = $x();
+ in.v = $y();
+
+ out = pj_inv(in, proj);
+ if (out.u == HUGE_VAL)
+ {
+ croak("Projection conversion failed: %s\n", pj_strerrno(pj_errno));
+ }
+
+ $lon() = out.u * r2d;
+ $lat() = out.v * r2d;
+%}
+
+pj_free(proj);
+EOCODE
+
+
+ BadCode => <<'EOBAD' );
+/* vars needed: */
+char errstr[255];
+projUV in, out;
+projPJ proj;
+const double r2d = RAD_TO_DEG;
+
+/* Init the projection */
+proj = pj_init_plus( $COMP(params) );
+if( proj == NULL )
+{
+ croak("Projection initialization failed: %s\n", pj_strerrno(pj_errno));
+}
+
+/* Loop over the values converting as we go */
+loop (n)
+%{
+ if ( $ISBAD(x()) || $ISBAD(y()) )
+ {
+ $SETBAD(lon());
+ $SETBAD(lat());
+ }
+ else
+ {
+ in.u = $x();
+ in.v = $y();
+
+ out = pj_inv(in, proj);
+ if (out.u == HUGE_VAL)
+ {
+ croak("Projection conversion failed: %s\n", pj_strerrno(pj_errno));
+ }
+
+ $lon() = out.u * r2d;
+ $lat() = out.v * r2d;
+ }
+%}
+pj_free(proj);
+EOBAD
+
+#
+# INPLACE Inverse Transformation: (call it directly)
+#
+
+pp_addpm( <<'ENDPM' );
+#
+# Wrapper sub for _fwd_trans_inplace that sets a default for the quiet variable.
+#
+sub inv_trans_inplace
+{
+ my $lon = shift;
+ my $lat = shift;
+ my $params = shift;
+ my $quiet = shift || 0;
+
+ _inv_trans_inplace( $lon, $lat, $params, $quiet );
+} # End of fwd_trans_inplace()...
+
+ENDPM
+
+pp_add_exported('', 'inv_trans_inplace');
+
+pp_def( '_inv_trans_inplace',
+ Pars => 'x();
+ y();',
+ GenericTypes => ['F','D'],
+ OtherPars => 'char* params; int quiet;',
+ HandleBad => 1,
+ Doc => undef,
+ #BadDoc => 'Ignores bad elements of $x and $y, and sets '
+ # . 'the corresponding elements of $lon and $lat to BAD',
+ Code => <<'EOCODE',
+/* vars needed: */
+char* func = "_inv_trans_inplace()";
+char errstr[255];
+projUV in, out;
+projPJ proj;
+const double r2d = RAD_TO_DEG;
+
+/* Init the projection */
+proj = pj_init_plus( $COMP(params) );
+if( proj == NULL )
+{
+ croak("%s: Projection initialization failed: %s\n", func, pj_strerrno(pj_errno));
+}
+
+/* Loop over the values converting as we go */
+threadloop
+%{
+ in.u = $x();
+ in.v = $y();
+
+ out = pj_inv(in, proj);
+ if (out.u == HUGE_VAL)
+ {
+ croak("%s: Projection conversion failed: %s\n", func, pj_strerrno(pj_errno));
+ }
+
+ $x() = out.u * r2d;
+ $y() = out.v * r2d;
+%}
+pj_free(proj);
+EOCODE
+
+
+ BadCode => <<'EOBAD' );
+/* vars needed: */
+char* func = "_inv_trans_inplace[BADCODE]()";
+char errstr[255];
+projUV in, out;
+projPJ proj;
+const double r2d = RAD_TO_DEG;
+int loud = ! $COMP(quiet);
+
+/* Init the projection */
+proj = pj_init_plus( $COMP(params) );
+if( proj == NULL )
+{
+ croak("%s: Projection initialization failed: %s\n", func, pj_strerrno(pj_errno));
+}
+
+/* Loop over the values converting as we go */
+threadloop
+%{
+ if ( ! ($ISBAD(x()) || $ISBAD(y())) )
+ {
+ in.u = $x();
+ in.v = $y();
+
+ out = pj_inv(in, proj);
+ if (out.u != HUGE_VAL)
+ {
+ $x() = out.u * r2d;
+ $y() = out.v * r2d;
+ }
+ else
+ {
+ $SETBAD( x() );
+ $SETBAD( y() );
+ if( loud )
+ {
+ /* Don't croak, just set the output to bad: */
+ sprintf(errstr, "%s: Projection conversion failed at (%f, %f): %s\n",
+ func, $x(), $y(), pj_strerrno(pj_errno));
+ fprintf( stderr, "%s", errstr );
+ fprintf( stderr, "%s: NOTE: Subsequent errors may have occured, but I'm only reporting the first!\n", func );
+ }
+ }
+ }
+%}
+pj_free(proj);
+EOBAD
+
+#
+# Utility functions for getting projection description information (in a general case).
+#
+
+pp_addxs('', <<'ENDXS' );
+
+HV*
+load_projection_descriptions()
+ CODE:
+ struct PJ_LIST *lp;
+ SV* scalar_val;
+ RETVAL = newHV();
+
+ for (lp = pj_get_list_ref() ; lp->id ; ++lp)
+ {
+ scalar_val = newSVpv( *lp->descr, 0 );
+ hv_store( RETVAL, lp->id, strlen( lp->id ), scalar_val, 0 );
+ }
+ OUTPUT:
+ RETVAL
+
+ENDXS
+pp_add_exported('', ' load_projection_descriptions ');
+
+
+#
+# Perl code to finish loading the projetion information by parsing the descriptions:
+#
+
+pp_addpm( <<'ENDPM' );
+
+sub load_projection_information
+{
+ my $descriptions = PDL::GIS::Proj::load_projection_descriptions();
+
+ my $info = {};
+
+ foreach my $projection ( keys %$descriptions )
+ {
+ my $description = $descriptions->{$projection};
+
+ my $hash = {};
+ $hash->{CODE} = $projection;
+
+
+
+ my @lines = split( /\n/, $description );
+ chomp @lines;
+
+ # Full name of this projection:
+ $hash->{NAME} = $lines[0];
+
+ # The second line is usually a list of projection types this one is:
+ my $temp = $lines[1];
+ $temp =~ s/no inv\.*,*//;
+ $temp =~ s/or//;
+ my @temp_types = split(/[,&\s]/, $temp );
+ my @types = grep( /.+/, @temp_types );
+ $hash->{CATEGORIES} = \@types;
+
+ # If there's more than 2 lines, then it usually is a listing of parameters:
+
+ # General parameters for all projections:
+ $hash->{PARAMS}->{GENERAL} =
+ [ qw( x_0 y_0 lon_0 units init no_defs geoc over ) ];
+
+ # Earth Figure Parameters:
+ $hash->{PARAMS}->{EARTH} =
+ [ qw( ellps b f rf e es R R_A R_V R_a R_g R_h R_lat_g ) ];
+
+ # Projection Specific Parameters:
+ my @proj_params = ();
+ if( $#lines >= 2 )
+ {
+ foreach my $i ( 2 .. $#lines )
+ {
+ my $text = $lines[$i];
+ my @temp2 = split( /\s+/, $text );
+ my @params = grep( /.+/, @temp2 );
+ foreach my $param (@params)
+ {
+ $param =~ s/=//;
+ $param =~ s/[,\[\]]//sg;
+ next if $param =~ /^and$/;
+ next if $param =~ /^or$/;
+ next if $param =~ /^Special$/;
+ next if $param =~ /^for$/;
+ next if $param =~ /^Madagascar$/;
+ next if $param =~ /^fixed$/;
+ next if $param =~ /^Earth$/;
+ next if $param =~ /^For$/;
+ next if $param =~ /^CH1903$/;
+ push(@proj_params, $param);
+ }
+ }
+ }
+ $hash->{PARAMS}->{PROJ} = \@proj_params;
+
+ # Can this projection do inverse?
+ $hash->{INVERSE} = ( $description =~ /no inv/ ) ? 0 : 1;
+
+ $info->{$projection} = $hash;
+ }
+
+ # A couple of overrides:
+ #
+ $info->{ob_tran}->{PARAMS}->{PROJ} =
+ [ 'o_proj', 'o_lat_p', 'o_lon_p', 'o_alpha', 'o_lon_c',
+ 'o_lat_c', 'o_lon_1', 'o_lat_1', 'o_lon_2', 'o_lat_2' ];
+
+ $info->{nzmg}->{CATEGORIES} = [ 'fixed Earth' ];
+
+ return $info;
+} # End of load_projection_information()...
+
+
+ENDPM
+pp_add_exported('', ' load_projection_information ');
+
+pp_done();
+
+
+
+
+
diff --git a/Lib/GIS/Proj/README b/Lib/GIS/Proj/README
new file mode 100644
index 0000000..205fc89
--- /dev/null
+++ b/Lib/GIS/Proj/README
@@ -0,0 +1,53 @@
+NAME
+
+ PDL::Transform::Proj
+
+DESCRIPTION
+
+ This is a port of the Proj library to PDL.
+
+COPYRIGHT NOTICE
+
+ Copyright 2003 Judd Taylor, USF Institute for Marine Remote Sensing (judd at marine.usf.edu).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ I'm making it GPL now, so I should probably update the above notice!
+
+PREREQUISITES
+
+ Proj4 C library (tested with 4.4.5)
+ Perl (tested with 5.8.0)
+ PDL (tested with 2.3.4 with BadVals)
+
+BUILD INSTRUCTIONS
+
+ 1. Install the Proj4 library if you haven't already.
+
+ 2. Edit the Makefile.PL to point the $proj4_include_path and $proj4_lib_path variables
+ to your installation of the Proj4 library.
+
+ 3. Make the makefiles with the command:
+ shell> perl Makefile.PL
+
+ 4. Build the software with the command:
+ shell> make
+
+ 5. Install the software with the command:
+ shell> make install
+
+ 6. Test the software (option) using the included script test_proj4.pl.
+ NOTE: There are no regression tests yet, but if something is wrong with the install,
+ it will probably break the test script.
+
+USAGE
+
+ See the POD in the lib itself, and check out the test script.
+
+CHANGES
+
+ 1.0: Inital version
+
+
diff --git a/Lib/GIS/Proj/TODO b/Lib/GIS/Proj/TODO
new file mode 100644
index 0000000..894f088
--- /dev/null
+++ b/Lib/GIS/Proj/TODO
@@ -0,0 +1,5 @@
+#
+# TODO for version 1.32 of PDL::Transform::Proj:
+#
+
+
diff --git a/Lib/GIS/Proj/include/projects.h b/Lib/GIS/Proj/include/projects.h
new file mode 100644
index 0000000..ce255a6
--- /dev/null
+++ b/Lib/GIS/Proj/include/projects.h
@@ -0,0 +1,476 @@
+/******************************************************************************
+ * $Id: projects.h 2121 2011-11-22 22:51:47Z warmerdam $
+ *
+ * Project: PROJ.4
+ * Purpose: Primary (private) include file for PROJ.4 library.
+ * Author: Gerald Evenden
+ *
+ ******************************************************************************
+ * Copyright (c) 2000, Frank Warmerdam
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included
+ * in all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+ * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+ * DEALINGS IN THE SOFTWARE.
+ *****************************************************************************/
+
+/* General projections header file */
+#ifndef PROJECTS_H
+#define PROJECTS_H
+
+#ifdef _MSC_VER
+# ifndef _CRT_SECURE_NO_DEPRECATE
+# define _CRT_SECURE_NO_DEPRECATE
+# endif
+# ifndef _CRT_NONSTDC_NO_DEPRECATE
+# define _CRT_NONSTDC_NO_DEPRECATE
+# endif
+#endif
+
+/* standard inclusions */
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifdef __cplusplus
+#define C_NAMESPACE extern "C"
+#define C_NAMESPACE_VAR extern "C"
+extern "C" {
+#else
+#define C_NAMESPACE extern
+#define C_NAMESPACE_VAR
+#endif
+
+#ifndef NULL
+# define NULL 0
+#endif
+
+#ifndef FALSE
+# define FALSE 0
+#endif
+
+#ifndef TRUE
+# define TRUE 1
+#endif
+
+#ifndef MAX
+# define MIN(a,b) ((a<b) ? a : b)
+# define MAX(a,b) ((a>b) ? a : b)
+#endif
+
+#ifndef ABS
+# define ABS(x) ((x<0) ? (-1*(x)) : x)
+#endif
+
+ /* maximum path/filename */
+#ifndef MAX_PATH_FILENAME
+#define MAX_PATH_FILENAME 1024
+#endif
+ /* prototype hypot for systems where absent */
+#ifndef _WIN32
+extern double hypot(double, double);
+#endif
+
+#ifdef _WIN32_WCE
+# include <wce_stdlib.h>
+# include <wce_stdio.h>
+# define rewind wceex_rewind
+# define getenv wceex_getenv
+# define strdup _strdup
+# define hypot _hypot
+#endif
+
+ /* some useful constants */
+#define HALFPI 1.5707963267948966
+#define FORTPI 0.78539816339744833
+#define PI 3.14159265358979323846
+#define TWOPI 6.2831853071795864769
+
+/* environment parameter name */
+#ifndef PROJ_LIB
+#define PROJ_LIB "PROJ_LIB"
+#endif
+/* maximum tag id length for +init and default files */
+#ifndef ID_TAG_MAX
+#define ID_TAG_MAX 50
+#endif
+
+/* Use WIN32 as a standard windows 32 bit declaration */
+#if defined(_WIN32) && !defined(WIN32) && !defined(_WIN32_WCE)
+# define WIN32
+#endif
+
+#if defined(_WINDOWS) && !defined(WIN32) && !defined(_WIN32_WCE)
+# define WIN32
+#endif
+
+/* directory delimiter for DOS support */
+#ifdef WIN32
+#define DIR_CHAR '\\'
+#else
+#define DIR_CHAR '/'
+#endif
+
+/* proj thread context */
+typedef struct {
+ int last_errno;
+ int debug_level;
+ void (*logger)(void *, int, const char *);
+ void *app_data;
+} projCtx_t;
+
+/* datum_type values */
+#define PJD_UNKNOWN 0
+#define PJD_3PARAM 1
+#define PJD_7PARAM 2
+#define PJD_GRIDSHIFT 3
+#define PJD_WGS84 4 /* WGS84 (or anything considered equivelent) */
+
+/* library errors */
+#define PJD_ERR_GEOCENTRIC -45
+#define PJD_ERR_AXIS -47
+#define PJD_ERR_GRID_AREA -48
+
+#define USE_PROJUV
+
+typedef struct { double u, v; } projUV;
+typedef struct { double r, i; } COMPLEX;
+
+#ifndef PJ_LIB__
+#define XY projUV
+#define LP projUV
+#else
+typedef struct { double x, y; } XY;
+typedef struct { double lam, phi; } LP;
+#endif
+
+typedef union { double f; int i; char *s; } PJ_VALUE;
+struct PJconsts;
+
+struct PJ_LIST {
+ char *id; /* projection keyword */
+ struct PJconsts *(*proj)(struct PJconsts*);/* projection entry point */
+ char * const *descr; /* description text */
+};
+struct PJ_ELLPS {
+ char *id; /* ellipse keyword name */
+ char *major; /* a= value */
+ char *ell; /* elliptical parameter */
+ char *name; /* comments */
+};
+struct PJ_UNITS {
+ char *id; /* units keyword */
+ char *to_meter; /* multiply by value to get meters */
+ char *name; /* comments */
+};
+
+struct PJ_DATUMS {
+ char *id; /* datum keyword */
+ char *defn; /* ie. "to_wgs84=..." */
+ char *ellipse_id; /* ie from ellipse table */
+ char *comments; /* EPSG code, etc */
+};
+
+struct PJ_PRIME_MERIDIANS {
+ char *id; /* prime meridian keyword */
+ char *defn; /* offset from greenwich in DMS format. */
+};
+
+struct DERIVS {
+ double x_l, x_p; /* derivatives of x for lambda-phi */
+ double y_l, y_p; /* derivatives of y for lambda-phi */
+};
+
+struct FACTORS {
+ struct DERIVS der;
+ double h, k; /* meridinal, parallel scales */
+ double omega, thetap; /* angular distortion, theta prime */
+ double conv; /* convergence */
+ double s; /* areal scale factor */
+ double a, b; /* max-min scale error */
+ int code; /* info as to analytics, see following */
+};
+#define IS_ANAL_XL_YL 01 /* derivatives of lon analytic */
+#define IS_ANAL_XP_YP 02 /* derivatives of lat analytic */
+#define IS_ANAL_HK 04 /* h and k analytic */
+#define IS_ANAL_CONV 010 /* convergence analytic */
+ /* parameter list struct */
+typedef struct ARG_list {
+ struct ARG_list *next;
+ char used;
+ char param[1]; } paralist;
+ /* base projection data structure */
+
+
+typedef struct PJconsts {
+ projCtx_t *ctx;
+ XY (*fwd)(LP, struct PJconsts *);
+ LP (*inv)(XY, struct PJconsts *);
+ void (*spc)(LP, struct PJconsts *, struct FACTORS *);
+ void (*pfree)(struct PJconsts *);
+ const char *descr;
+ paralist *params; /* parameter list */
+ int over; /* over-range flag */
+ int geoc; /* geocentric latitude flag */
+ int is_latlong; /* proj=latlong ... not really a projection at all */
+ int is_geocent; /* proj=geocent ... not really a projection at all */
+ double
+ a, /* major axis or radius if es==0 */
+ a_orig, /* major axis before any +proj related adjustment */
+ es, /* e ^ 2 */
+ es_orig, /* es before any +proj related adjustment */
+ e, /* eccentricity */
+ ra, /* 1/A */
+ one_es, /* 1 - e^2 */
+ rone_es, /* 1/one_es */
+ lam0, phi0, /* central longitude, latitude */
+ x0, y0, /* easting and northing */
+ k0, /* general scaling factor */
+ to_meter, fr_meter; /* cartesian scaling */
+
+ int datum_type; /* PJD_UNKNOWN/3PARAM/7PARAM/GRIDSHIFT/WGS84 */
+ double datum_params[7];
+ struct _pj_gi **gridlist;
+ int gridlist_count;
+
+ int has_geoid_vgrids;
+ struct _pj_gi **vgridlist_geoid;
+ int vgridlist_geoid_count;
+ double vto_meter, vfr_meter;
+
+ double from_greenwich; /* prime meridian offset (in radians) */
+ double long_wrap_center; /* 0.0 for -180 to 180, actually in radians*/
+ int is_long_wrap_set;
+ char axis[4];
+
+#ifdef PROJ_PARMS__
+PROJ_PARMS__
+#endif /* end of optional extensions */
+} PJ;
+
+/* public API */
+#include "proj_api.h"
+
+/* Generate pj_list external or make list from include file */
+#ifndef PJ_LIST_H
+extern struct PJ_LIST pj_list[];
+#else
+#define PROJ_HEAD(id, name) \
+ struct PJconsts *pj_##id(struct PJconsts*); extern char * const pj_s_##id;
+
+#ifndef lint
+#define DO_PJ_LIST_ID
+#endif
+#include PJ_LIST_H
+#ifndef lint
+#undef DO_PJ_LIST_ID
+#endif
+#undef PROJ_HEAD
+#define PROJ_HEAD(id, name) {#id, pj_##id, &pj_s_##id},
+ struct PJ_LIST
+pj_list[] = {
+#include PJ_LIST_H
+ {0, 0, 0},
+ };
+#undef PROJ_HEAD
+#endif
+
+#ifndef PJ_ELLPS__
+extern struct PJ_ELLPS pj_ellps[];
+#endif
+
+#ifndef PJ_UNITS__
+extern struct PJ_UNITS pj_units[];
+#endif
+
+#ifndef PJ_DATUMS__
+extern struct PJ_DATUMS pj_datums[];
+extern struct PJ_PRIME_MERIDIANS pj_prime_meridians[];
+#endif
+
+#ifdef PJ_LIB__
+ /* repeatative projection code */
+#define PROJ_HEAD(id, name) static const char des_##id [] = name
+#define ENTRYA(name) \
+ C_NAMESPACE_VAR const char * const pj_s_##name = des_##name; \
+ C_NAMESPACE PJ *pj_##name(PJ *P) { if (!P) { \
+ if( (P = (PJ*) pj_malloc(sizeof(PJ))) != NULL) { \
+ memset( P, 0, sizeof(PJ) ); \
+ P->pfree = freeup; P->fwd = 0; P->inv = 0; \
+ P->spc = 0; P->descr = des_##name;
+#define ENTRYX } return P; } else {
+#define ENTRY0(name) ENTRYA(name) ENTRYX
+#define ENTRY1(name, a) ENTRYA(name) P->a = 0; ENTRYX
+#define ENTRY2(name, a, b) ENTRYA(name) P->a = 0; P->b = 0; ENTRYX
+#define ENDENTRY(p) } return (p); }
+#define E_ERROR(err) { pj_ctx_set_errno( P->ctx, err); freeup(P); return(0); }
+#define E_ERROR_0 { freeup(P); return(0); }
+#define F_ERROR { pj_ctx_set_errno( P->ctx, -20); return(xy); }
+#define I_ERROR { pj_ctx_set_errno( P->ctx, -20); return(lp); }
+#define FORWARD(name) static XY name(LP lp, PJ *P) { XY xy = {0.0,0.0}
+#define INVERSE(name) static LP name(XY xy, PJ *P) { LP lp = {0.0,0.0}
+#define FREEUP static void freeup(PJ *P) {
+#define SPECIAL(name) static void name(LP lp, PJ *P, struct FACTORS *fac)
+#endif
+#define MAX_TAB_ID 80
+typedef struct { float lam, phi; } FLP;
+typedef struct { int lam, phi; } ILP;
+
+struct CTABLE {
+ char id[MAX_TAB_ID]; /* ascii info */
+ LP ll; /* lower left corner coordinates */
+ LP del; /* size of cells */
+ ILP lim; /* limits of conversion matrix */
+ FLP *cvs; /* conversion matrix */
+};
+
+typedef struct _pj_gi {
+ char *gridname; /* identifying name of grid, eg "conus" or ntv2_0.gsb */
+ char *filename; /* full path to filename */
+
+ const char *format; /* format of this grid, ie "ctable", "ntv1",
+ "ntv2" or "missing". */
+
+ int grid_offset; /* offset in file, for delayed loading */
+
+ struct CTABLE *ct;
+
+ struct _pj_gi *next;
+ struct _pj_gi *child;
+} PJ_GRIDINFO;
+
+/* procedure prototypes */
+double dmstor(const char *, char **);
+double dmstor_ctx(projCtx ctx, const char *, char **);
+void set_rtodms(int, int);
+char *rtodms(char *, double, int, int);
+double adjlon(double);
+double aacos(projCtx,double), aasin(projCtx,double), asqrt(double), aatan2(double, double);
+PJ_VALUE pj_param(projCtx ctx, paralist *, const char *);
+paralist *pj_mkparam(char *);
+int pj_ell_set(projCtx ctx, paralist *, double *, double *);
+int pj_datum_set(projCtx,paralist *, PJ *);
+int pj_prime_meridian_set(paralist *, PJ *);
+int pj_angular_units_set(paralist *, PJ *);
+
+paralist *pj_clone_paralist( const paralist* );
+paralist*pj_search_initcache( const char *filekey );
+void pj_insert_initcache( const char *filekey, const paralist *list);
+
+double *pj_enfn(double);
+double pj_mlfn(double, double, double, double *);
+double pj_inv_mlfn(projCtx, double, double, double *);
+double pj_qsfn(double, double, double);
+double pj_tsfn(double, double, double);
+double pj_msfn(double, double, double);
+double pj_phi2(projCtx, double, double);
+double pj_qsfn_(double, PJ *);
+double *pj_authset(double);
+double pj_authlat(double, double *);
+COMPLEX pj_zpoly1(COMPLEX, COMPLEX *, int);
+COMPLEX pj_zpolyd1(COMPLEX, COMPLEX *, int, COMPLEX *);
+FILE *pj_open_lib(projCtx, char *, char *);
+
+int pj_deriv(LP, double, PJ *, struct DERIVS *);
+int pj_factors(LP, PJ *, double, struct FACTORS *);
+
+struct PW_COEF {/* row coefficient structure */
+ int m; /* number of c coefficients (=0 for none) */
+ double *c; /* power coefficients */
+};
+
+/* Approximation structures and procedures */
+typedef struct { /* Chebyshev or Power series structure */
+ projUV a, b; /* power series range for evaluation */
+ /* or Chebyshev argument shift/scaling */
+ struct PW_COEF *cu, *cv;
+ int mu, mv; /* maximum cu and cv index (+1 for count) */
+ int power; /* != 0 if power series, else Chebyshev */
+} Tseries;
+Tseries *mk_cheby(projUV, projUV, double, projUV *, projUV (*)(projUV), int, int, int);
+projUV bpseval(projUV, Tseries *);
+projUV bcheval(projUV, Tseries *);
+projUV biveval(projUV, Tseries *);
+void *vector1(int, int);
+void **vector2(int, int, int);
+void freev2(void **v, int nrows);
+int bchgen(projUV, projUV, int, int, projUV **, projUV(*)(projUV));
+int bch2bps(projUV, projUV, projUV **, int, int);
+/* nadcon related protos */
+LP nad_intr(LP, struct CTABLE *);
+LP nad_cvt(LP, int, struct CTABLE *);
+struct CTABLE *nad_init(projCtx ctx, char *);
+struct CTABLE *nad_ctable_init( projCtx ctx, FILE * fid );
+int nad_ctable_load( projCtx ctx, struct CTABLE *, FILE * fid );
+struct CTABLE *nad_ctable2_init( projCtx ctx, FILE * fid );
+int nad_ctable2_load( projCtx ctx, struct CTABLE *, FILE * fid );
+void nad_free(struct CTABLE *);
+
+/* higher level handling of datum grid shift files */
+
+int pj_apply_vgridshift( PJ *defn, const char *listname,
+ PJ_GRIDINFO ***gridlist_p,
+ int *gridlist_count_p,
+ int inverse,
+ long point_count, int point_offset,
+ double *x, double *y, double *z );
+int pj_apply_gridshift_2( PJ *defn, int inverse,
+ long point_count, int point_offset,
+ double *x, double *y, double *z );
+int pj_apply_gridshift_3( projCtx ctx,
+ PJ_GRIDINFO **gridlist, int gridlist_count,
+ int inverse, long point_count, int point_offset,
+ double *x, double *y, double *z );
+
+PJ_GRIDINFO **pj_gridlist_from_nadgrids( projCtx, const char *, int * );
+void pj_deallocate_grids();
+
+PJ_GRIDINFO *pj_gridinfo_init( projCtx, const char * );
+int pj_gridinfo_load( projCtx, PJ_GRIDINFO * );
+void pj_gridinfo_free( projCtx, PJ_GRIDINFO * );
+
+void *proj_mdist_ini(double);
+double proj_mdist(double, double, double, const void *);
+double proj_inv_mdist(projCtx ctx, double, const void *);
+void *pj_gauss_ini(double, double, double *,double *);
+LP pj_gauss(projCtx, LP, const void *);
+LP pj_inv_gauss(projCtx, LP, const void *);
+
+extern char const pj_release[];
+
+struct PJ_ELLPS *pj_get_ellps_ref( void );
+struct PJ_DATUMS *pj_get_datums_ref( void );
+struct PJ_UNITS *pj_get_units_ref( void );
+struct PJ_LIST *pj_get_list_ref( void );
+struct PJ_PRIME_MERIDIANS *pj_get_prime_meridians_ref( void );
+
+#ifndef DISABLE_CVSID
+# if defined(__GNUC__) && __GNUC__ >= 4
+# define PJ_CVSID(string) static char pj_cvsid[] __attribute__((used)) = string;
+# else
+# define PJ_CVSID(string) static char pj_cvsid[] = string; \
+static char *cvsid_aw() { return( cvsid_aw() ? ((char *) NULL) : pj_cvsid ); }
+# endif
+#else
+# define PJ_CVSID(string)
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* end of basic projections header */
diff --git a/Lib/GSL/DIFF/FUNC.c b/Lib/GSL/DIFF/FUNC.c
new file mode 100644
index 0000000..295aeea
--- /dev/null
+++ b/Lib/GSL/DIFF/FUNC.c
@@ -0,0 +1,41 @@
+static SV* ext_funname;
+static gsl_function F;
+
+double FUNC(double x,void * p);
+
+double FUNC(double x,void * p){
+
+ double res;
+ int count;
+
+ dSP;
+ SV* funname;
+
+ /* get function name on the perl side */
+ funname = ext_funname;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSVnv(x)));
+
+ PUTBACK;
+
+ count=call_sv(funname,G_SCALAR);
+
+ SPAGAIN;
+
+ if (count!=1)
+ croak("error calling perl function\n");
+
+ /* recover output value */
+ res = POPn;
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ return res;
+}
diff --git a/Lib/GSL/DIFF/Makefile.PL b/Lib/GSL/DIFF/Makefile.PL
new file mode 100644
index 0000000..6d0c951
--- /dev/null
+++ b/Lib/GSL/DIFF/Makefile.PL
@@ -0,0 +1,76 @@
+# PDL interface to GSL differentation routines
+# Makefile.PL for a package defined by PP code.
+
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+my $msg = undef;
+my $forcebuild=0;
+my $skip = 0;
+
+# this Makefile uses get_gsl_libs which is defined in
+# the parent Makefile.PL
+
+sub gsl_diff_links_ok {
+ my($lib,$inc) = @_;
+ return defined($lib) && defined($inc) &&
+ trylink 'gsl diff libraries',
+ << 'EOI',
+#include <math.h>
+#include <gsl/gsl_math.h>
+#include <gsl/gsl_diff.h>
+
+double f (double x, void * params)
+{
+ return pow (x, 1.5);
+}
+
+EOI
+ << 'EOB', $lib, $inc;
+ gsl_function F;
+ double result, abserr;
+
+ F.function = &f;
+ F.params = 0;
+
+ gsl_diff_central (&F, 2.0, &result, &abserr);
+ gsl_diff_forward (&F, 0.0, &result, &abserr);
+ gsl_diff_backward (&F, 0.0, &result, &abserr);
+
+EOB
+}
+
+if (defined $PDL::Config{WITH_GSL} && $PDL::Config{WITH_GSL}==0) {
+ $msg = "\n Will skip build of PDL::GSL::DIFF on this system \n";
+ $skip = 1;
+} elsif (defined $PDL::Config{WITH_GSL} && $PDL::Config{WITH_GSL}==1) {
+ print "\n Will forcibly try and build PDL::GSL::DIFF on this system \n\n";
+ $forcebuild=1;
+}
+
+if (($skip && !$forcebuild) ||
+ !gsl_diff_links_ok($GSL_libs, $GSL_includes)) {
+ warn "trying to force GSL build but link test failed\n".
+ "\t -- aborting GSL build\n" if $forcebuild;
+ $msg ||=
+ "\n GSL Libraries not found... Skipping build of PDL::GSL::DIFF.\n";
+ warn $msg . "\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ return;
+} else {
+ print "\n Building PDL::GSL::DIFF.",
+ "Turn off WITH_GSL if there are any problems\n\n";
+}
+
+ at pack = (["gsl_diff.pd",DIFF,PDL::GSL::DIFF]);
+%hash = pdlpp_stdargs_int(@::pack);
+
+$hash{INC} .= " $GSL_includes";
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Lib/GSL/DIFF/gsl_diff.pd b/Lib/GSL/DIFF/gsl_diff.pd
new file mode 100644
index 0000000..d935088
--- /dev/null
+++ b/Lib/GSL/DIFF/gsl_diff.pd
@@ -0,0 +1,174 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSL::DIFF - PDL interface to numerical differentiation routines in GSL
+
+=head1 DESCRIPTION
+
+This is an interface to the numerical differentiation package present in the
+GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::GSL::DIFF;
+
+ my $x0 = 3.3;
+
+ my @res = gsldiff(\&myfunction,$x0);
+ # same as above:
+ @res = gsldiff(\&myfunction,$x0,{Method => 'central'});
+
+ # use only values greater than $x0 to get the derivative
+ @res = gsldiff(\&myfunction,$x0,{Method => 'forward'});
+
+ # use only values smaller than $x0 to get the derivative
+ @res = gsldiff(\&myfunction,$x0,{Method => 'backward'});
+
+ sub myfunction{
+ my ($x) = @_;
+ return $x**2;
+ }
+
+=head1 FUNCTIONS
+
+=head2 gsldiff()
+
+=for ref
+
+This functions serves as an interface to the three differentiation
+functions present in GSL: gsl_diff_central, gsl_diff_backward and
+gsl_diff_forward. To compute the derivative, the central method uses
+values greater and smaller than the point at which the derivative is
+to be evaluated, while backward and forward use only values smaller
+and greater respectively. gsldiff() returns both the derivative
+and an absolute error estimate. The default method is 'central',
+others can be specified by passing an option.
+
+Please check the GSL documentation for more information.
+
+=for usage
+
+Usage:
+
+ ($d,$abserr) = gsldiff($function_ref,$x,{Method => $method});
+
+=for example
+
+Example:
+
+ #derivative using default method ('central')
+ ($d,$abserr) = gsldiff(\&myf,3.3);
+
+ #same as above with method set explicitly
+ ($d,$abserr) = gsldiff(\&myf,3.3,{Method => 'central'});
+
+ #using backward & forward methods
+ ($d,$abserr) = gsldiff(\&myf,3.3,{Method => 'backward'});
+ ($d,$abserr) = gsldiff(\&myf,3.3,{Method => 'forward'});
+
+ sub myf{
+ my ($x) = @_;
+ return exp($x);
+ }
+
+=head1 BUGS
+
+Feedback is welcome. Log bugs in the PDL bug database (the
+database is always linked from L<http://pdl.perl.org>).
+
+=head1 SEE ALSO
+
+L<PDL>
+
+The GSL documentation is online at
+
+ http://www.gnu.org/software/gsl/manual/
+
+=head1 AUTHOR
+
+This file copyright (C) 2003 Andres Jordan <andresj at physics.rutgers.edu>
+All rights reserved. There is no warranty. You are allowed to redistribute
+this software documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL differentiation routines were written by David Morrison.
+
+=cut
+
+
+EOD
+
+pp_addhdr('
+#include<stdio.h>
+#include<gsl/gsl_math.h>
+#include<gsl/gsl_diff.h>
+
+#include "FUNC.c"
+
+');
+
+pp_addpm('
+sub gsldiff{
+ my $opt;
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Method => \'central\'}; }
+ die \'Usage: gsldiff(function_ref, x, {Options} )\'
+ if $#_<1 || $#_>2;
+ my ($f,$x) = @_;
+ my ($res,$abserr);
+ if($$opt{Method}=~/cent/i){
+ ($res,$abserr) = PDL::GSL::DIFF::diff_central($x,$f);
+ }
+ elsif($$opt{Method}=~/back/i){
+ ($res,$abserr) = PDL::GSL::DIFF::diff_backward($x,$f);
+ }
+ elsif($$opt{Method}=~/forw/i){
+ ($res,$abserr) = PDL::GSL::DIFF::diff_forward($x,$f);
+ }
+ else{
+ barf("Unknown differentiation method $method in gsldiff\n");
+ }
+ return ($res,$abserr);
+}
+
+');
+
+pp_add_exported('gsldiff');
+
+pp_def('diff_central',
+ Pars => 'double x(); double [o] res(); double [o] abserr();',
+ OtherPars => 'SV* funcion;',
+ Docs => undef,
+ Code => '
+ext_funname = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+gsl_diff_central (&F, $x(), $P(res), $P(abserr));
+');
+
+pp_def('diff_backward',
+ Pars => 'double x(); double [o] res(); double [o] abserr();',
+ OtherPars => 'SV* funcion;',
+ Docs => undef,
+ Code => '
+ext_funname = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+gsl_diff_backward (&F, $x(), $P(res), $P(abserr));
+');
+
+pp_def('diff_forward',
+ Pars => 'double x(); double [o] res(); double [o] abserr();',
+ OtherPars => 'SV* funcion;',
+ Docs => undef,
+ Code => '
+ext_funname = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+gsl_diff_forward (&F, $x(), $P(res), $P(abserr));
+');
+
+pp_done();
+
diff --git a/Lib/GSL/INTEG/FUNC.c b/Lib/GSL/INTEG/FUNC.c
new file mode 100644
index 0000000..a2097e6
--- /dev/null
+++ b/Lib/GSL/INTEG/FUNC.c
@@ -0,0 +1,55 @@
+#define max_nested_integrals 20
+
+static SV* ext_funname[max_nested_integrals - 1];
+static int current_fun = -1;
+static gsl_function F;
+
+double FUNC(double x,void * p);
+
+double FUNC(double x,void * p){
+
+ SV* funname;
+
+ int count;
+
+ I32 ax ;
+
+ double res;
+ double* resp;
+
+ dSP;
+
+ resp = &res;
+
+
+ ENTER;
+ SAVETMPS;
+
+ /* get function name on the perl side */
+ funname = ext_funname[current_fun];
+
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSVnv(x)));
+
+ PUTBACK;
+
+ count=call_sv(funname,G_SCALAR);
+
+ SPAGAIN;
+ SP -= count ;
+ ax = (SP - PL_stack_base) + 1 ;
+
+ if (count!=1)
+ croak("error calling perl function\n");
+
+ /* recover output value */
+ /*res = POPn;*/
+ *resp = SvNV(ST(0));
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ return res;
+}
diff --git a/Lib/GSL/INTEG/Makefile.PL b/Lib/GSL/INTEG/Makefile.PL
new file mode 100644
index 0000000..b97ee0d
--- /dev/null
+++ b/Lib/GSL/INTEG/Makefile.PL
@@ -0,0 +1,76 @@
+# PDL interface to GSL differentation routines
+# Makefile.PL for a package defined by PP code.
+
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+my $msg = undef;
+my $forcebuild=0;
+my $skip = 0;
+
+# this Makefile uses get_gsl_libs which is defined in
+# the parent Makefile.PL
+
+sub gsl_integ_links_ok {
+ my($lib,$inc) = @_;
+ return defined($lib) && defined($inc) &&
+ trylink 'gsl numerical integration libraries',
+ << 'EOI',
+#include <math.h>
+#include <gsl/gsl_math.h>
+#include <gsl/gsl_errno.h>
+#include <gsl/gsl_integration.h>
+
+double f (double x, void * params)
+{
+ return pow (x, 1.5);
+}
+
+EOI
+ << 'EOB', $lib, $inc;
+ gsl_function F;
+ double result, abserr;
+ int ierr, neval;
+
+ F.function = &f;
+ F.params = 0;
+
+ ierr = gsl_integration_qng(&F,1.0,2.0,0.0,1e-6,&result,&abserr,&neval);
+
+EOB
+}
+
+if (defined $PDL::Config{WITH_GSL} && $PDL::Config{WITH_GSL}==0) {
+ $msg = "\n Will skip build of PDL::GSL::INTEG on this system \n";
+ $skip = 1;
+} elsif (defined $PDL::Config{WITH_GSL} && $PDL::Config{WITH_GSL}==1) {
+ print "\n Will forcibly try and build PDL::GSL::INTEG on this system \n\n";
+ $forcebuild=1;
+}
+
+if (($skip && !$forcebuild) ||
+ !gsl_integ_links_ok($GSL_libs, $GSL_includes)) {
+ warn "trying to force GSL build but link test failed\n".
+ "\t -- aborting GSL build\n" if $forcebuild;
+ $msg ||=
+ "\n GSL Libraries not found... Skipping build of PDL::GSL::INTEG.\n";
+ warn $msg . "\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ return;
+} else {
+ print "\n Building PDL::GSL::INTEG.",
+ "Turn off WITH_GSL if there are any problems\n\n";
+}
+
+ at pack = (["gsl_integ.pd",INTEG,PDL::GSL::INTEG]);
+%hash = pdlpp_stdargs_int(@::pack);
+
+$hash{INC} .= " $GSL_includes";
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Lib/GSL/INTEG/gsl_integ.pd b/Lib/GSL/INTEG/gsl_integ.pd
new file mode 100644
index 0000000..2f506b4
--- /dev/null
+++ b/Lib/GSL/INTEG/gsl_integ.pd
@@ -0,0 +1,979 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSL::INTEG - PDL interface to numerical integration routines in GSL
+
+=head1 DESCRIPTION
+
+This is an interface to the numerical integration package present in the
+GNU Scientific Library, which is an implementation of QUADPACK.
+
+Functions are named B<gslinteg_{algorithm}> where {algorithm}
+is the QUADPACK naming convention. The available functions are:
+
+=over 3
+
+=item gslinteg_qng: Non-adaptive Gauss-Kronrod integration
+
+=item gslinteg_qag: Adaptive integration
+
+=item gslinteg_qags: Adaptive integration with singularities
+
+=item gslinteg_qagp: Adaptive integration with known singular points
+
+=item gslinteg_qagi: Adaptive integration on infinite interval of the form (-\infty,\infty)
+
+=item gslinteg_qagiu: Adaptive integration on infinite interval of the form (a,\infty)
+
+=item gslinteg_qagil: Adaptive integration on infinite interval of the form (-\infty,b)
+
+=item gslinteg_qawc: Adaptive integration for Cauchy principal values
+
+=item gslinteg_qaws: Adaptive integration for singular functions
+
+=item gslinteg_qawo: Adaptive integration for oscillatory functions
+
+=item gslinteg_qawf: Adaptive integration for Fourier integrals
+
+=back
+
+Each algorithm computes an approximation to the integral, I,
+of the function f(x)w(x), where w(x) is a weight function
+(for general integrands w(x)=1). The user provides absolute
+and relative error bounds (epsabs,epsrel) which specify
+the following accuracy requirement:
+
+|RESULT - I| <= max(epsabs, epsrel |I|)
+
+
+The routines will fail to converge if the
+error bounds are too stringent, but always return the best
+approximation obtained up to that stage
+
+All functions return the result, and estimate of the absolute
+error and an error flag (which is zero if there were no problems).
+You are responsible for checking for any errors, no warnings are issued
+unless the option {Warn => 'y'} is specified in which case
+the reason of failure will be printed.
+
+You can nest integrals up to 20 levels. If you find yourself in
+the unlikely situation that you need more, you can change the value
+of 'max_nested_integrals' in the first line of the file 'FUNC.c'
+and recompile.
+
+=for ref
+
+Please check the GSL documentation for more information.
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::GSL::INTEG;
+
+ my $a = 1.2;
+ my $b = 3.7;
+ my $epsrel = 0;
+ my $epsabs = 1e-6;
+
+ # Non adaptive integration
+ my ($res,$abserr,$ierr,$neval) = gslinteg_qng(\&myf,$a,$b,$epsrel,$epsabs);
+ # Warnings on
+ my ($res,$abserr,$ierr,$neval) = gslinteg_qng(\&myf,$a,$b,$epsrel,$epsabs,{Warn=>'y'});
+
+ # Adaptive integration with warnings on
+ my $limit = 1000;
+ my $key = 5;
+ my ($res,$abserr,$ierr) = gslinteg_qag(\&myf,$a,$b,$epsrel,
+ $epsabs,$limit,$key,{Warn=>'y'});
+
+ sub myf{
+ my ($x) = @_;
+ return exp(-$x**2);
+ }
+
+=head1 FUNCTIONS
+
+=head2 gslinteg_qng() -- Non-adaptive Gauss-Kronrod integration
+
+This function applies the Gauss-Kronrod 10-point, 21-point, 43-point and 87-point
+integration rules in succession until an estimate of the integral of f over ($a,$b)
+is achieved within the desired absolute and relative error limits, $epsabs and $epsrel.
+It is meant for fast integration of smooth functions. It returns an array with the
+result, an estimate of the absolute error, an error flag and the number of function
+evaluations performed.
+
+=for usage
+
+Usage:
+
+ ($res,$abserr,$ierr,$neval) = gslinteg_qng($function_ref,$a,$b,
+ $epsrel,$epsabs,[{Warn => $warn}]);
+
+=for example
+
+Example:
+
+ my ($res,$abserr,$ierr,$neval) = gslinteg_qng(\&f,0,1,0,1e-9);
+ # with warnings on
+ my ($res,$abserr,$ierr,$neval) = gslinteg_qng(\&f,0,1,0,1e-9,{Warn => 'y'});
+
+ sub f{
+ my ($x) = @_;
+ return ($x**2.6)*log(1.0/$x);
+ }
+
+
+=head2 gslinteg_qag() -- Adaptive integration
+
+This function applies an integration rule adaptively until an estimate of
+the integral of f over ($a,$b) is achieved within the desired absolute and
+relative error limits, $epsabs and $epsrel. On each iteration the adaptive
+integration strategy bisects the interval with the largest error estimate;
+the maximum number of allowed subdivisions is given by the parameter $limit.
+The integration rule is determined by the
+value of $key, which has to be one of (1,2,3,4,5,6) and correspond to
+the 15, 21, 31, 41, 51 and 61 point Gauss-Kronrod rules respectively.
+It returns an array with the result, an estimate of the absolute error
+and an error flag.
+
+=for ref
+
+Please check the GSL documentation for more information.
+
+=for usage
+
+Usage:
+
+ ($res,$abserr,$ierr) = gslinteg_qag($function_ref,$a,$b,$epsrel,
+ $epsabs,$limit,$key,[{Warn => $warn}]);
+
+=for example
+
+Example:
+
+ my ($res,$abserr,$ierr) = gslinteg_qag(\&f,0,1,0,1e-10,1000,1);
+ # with warnings on
+ my ($res,$abserr,$ierr) = gslinteg_qag(\&f,0,1,0,1e-10,1000,1,{Warn => 'y'});
+
+ sub f{
+ my ($x) = @_;
+ return ($x**2.6)*log(1.0/$x);
+ }
+
+=head2 gslinteg_qags() -- Adaptive integration with singularities
+
+This function applies the Gauss-Kronrod 21-point integration rule
+adaptively until an estimate of the integral of f over ($a,$b) is
+achieved within the desired absolute and relative error limits,
+$epsabs and $epsrel. The algorithm is such that it
+accelerates the convergence of the integral in the presence of
+discontinuities and integrable singularities.
+The maximum number of allowed subdivisions done by the adaptive
+algorithm must be supplied in the parameter $limit.
+
+=for ref
+
+Please check the GSL documentation for more information.
+
+=for usage
+
+Usage:
+
+ ($res,$abserr,$ierr) = gslinteg_qags($function_ref,$a,$b,$epsrel,
+ $epsabs,$limit,[{Warn => $warn}]);
+
+=for example
+
+Example:
+
+ my ($res,$abserr,$ierr) = gslinteg_qags(\&f,0,1,0,1e-10,1000);
+ # with warnings on
+ ($res,$abserr,$ierr) = gslinteg_qags(\&f,0,1,0,1e-10,1000,{Warn => 'y'});
+
+ sub f{
+ my ($x) = @_;
+ return ($x)*log(1.0/$x);
+ }
+
+=head2 gslinteg_qagp() -- Adaptive integration with known singular points
+
+This function applies the adaptive integration algorithm used by
+gslinteg_qags taking into account the location of singular points
+until an estimate of
+the integral of f over ($a,$b) is achieved within the desired absolute and
+relative error limits, $epsabs and $epsrel.
+Singular points are supplied in the piddle $points, whose endpoints
+determine the integration range.
+So, for example, if the function has singular points at x_1 and x_2 and the
+integral is desired from a to b (a < x_1 < x_2 < b), $points = pdl(a,x_1,x_2,b).
+The maximum number of allowed subdivisions done by the adaptive
+algorithm must be supplied in the parameter $limit.
+
+=for ref
+
+Please check the GSL documentation for more information.
+
+=for usage
+
+Usage:
+
+ ($res,$abserr,$ierr) = gslinteg_qagp($function_ref,$points,$epsabs,
+ $epsrel,$limit,[{Warn => $warn}])
+
+=for example
+
+Example:
+
+ my $points = pdl(0,1,sqrt(2),3);
+ my ($res,$abserr,$ierr) = gslinteg_qagp(\&f,$points,0,1e-3,1000);
+ # with warnings on
+ ($res,$abserr,$ierr) = gslinteg_qagp(\&f,$points,0,1e-3,1000,{Warn => 'y'});
+
+ sub f{
+ my ($x) = @_;
+ my $x2 = $x**2;
+ my $x3 = $x**3;
+ return $x3 * log(abs(($x2-1.0)*($x2-2.0)));
+ }
+
+=head2 gslinteg_qagi() -- Adaptive integration on infinite interval
+
+This function estimates the integral of the function f over the
+infinite interval (-\infty,+\infty) within the desired absolute and
+relative error limits, $epsabs and $epsrel.
+After a transformation, the algorithm
+of gslinteg_qags with a 15-point Gauss-Kronrod rule is used.
+The maximum number of allowed subdivisions done by the adaptive
+algorithm must be supplied in the parameter $limit.
+
+=for ref
+
+Please check the GSL documentation for more information.
+
+=for usage
+
+Usage:
+
+ ($res,$abserr,$ierr) = gslinteg_qagi($function_ref,$epsabs,
+ $epsrel,$limit,[{Warn => $warn}]);
+
+=for example
+
+Example:
+
+ my ($res,$abserr,$ierr) = gslinteg_qagi(\&myfn,1e-7,0,1000);
+ # with warnings on
+ ($res,$abserr,$ierr) = gslinteg_qagi(\&myfn,1e-7,0,1000,{Warn => 'y'});
+
+ sub myfn{
+ my ($x) = @_;
+ return exp(-$x - $x*$x) ;
+ }
+
+
+=head2 gslinteg_qagiu() -- Adaptive integration on infinite interval
+
+This function estimates the integral of the function f over the
+infinite interval (a,+\infty) within the desired absolute and
+relative error limits, $epsabs and $epsrel.
+After a transformation, the algorithm
+of gslinteg_qags with a 15-point Gauss-Kronrod rule is used.
+The maximum number of allowed subdivisions done by the adaptive
+algorithm must be supplied in the parameter $limit.
+
+=for ref
+
+Please check the GSL documentation for more information.
+
+=for usage
+
+Usage:
+
+ ($res,$abserr,$ierr) = gslinteg_qagiu($function_ref,$a,$epsabs,
+ $epsrel,$limit,[{Warn => $warn}]);
+
+=for example
+
+Example:
+
+ my $alfa = 1;
+ my ($res,$abserr,$ierr) = gslinteg_qagiu(\&f,99.9,1e-7,0,1000);
+ # with warnings on
+ ($res,$abserr,$ierr) = gslinteg_qagiu(\&f,99.9,1e-7,0,1000,{Warn => 'y'});
+
+ sub f{
+ my ($x) = @_;
+ if (($x==0) && ($alfa == 1)) {return 1;}
+ if (($x==0) && ($alfa > 1)) {return 0;}
+ return ($x**($alfa-1))/((1+10*$x)**2);
+ }
+
+=head2 gslinteg_qagil() -- Adaptive integration on infinite interval
+
+This function estimates the integral of the function f over the
+infinite interval (-\infty,b) within the desired absolute and
+relative error limits, $epsabs and $epsrel.
+After a transformation, the algorithm
+of gslinteg_qags with a 15-point Gauss-Kronrod rule is used.
+The maximum number of allowed subdivisions done by the adaptive
+algorithm must be supplied in the parameter $limit.
+
+=for ref
+
+Please check the GSL documentation for more information.
+
+=for usage
+
+Usage:
+
+ ($res,$abserr,$ierr) = gslinteg_qagl($function_ref,$b,$epsabs,
+ $epsrel,$limit,[{Warn => $warn}]);
+
+=for example
+
+Example:
+
+ my ($res,$abserr,$ierr) = gslinteg_qagil(\&myfn,1.0,1e-7,0,1000);
+ # with warnings on
+ ($res,$abserr,$ierr) = gslinteg_qagil(\&myfn,1.0,1e-7,0,1000,{Warn => 'y'});
+
+ sub myfn{
+ my ($x) = @_;
+ return exp($x);
+ }
+
+=head2 gslinteg_qawc() -- Adaptive integration for Cauchy principal values
+
+This function computes the Cauchy principal value of the integral of f over (a,b),
+with a singularity at c, I = \int_a^b dx f(x)/(x - c). The integral is
+estimated within the desired absolute and relative error limits, $epsabs and $epsrel.
+The maximum number of allowed subdivisions done by the adaptive
+algorithm must be supplied in the parameter $limit.
+
+=for ref
+
+Please check the GSL documentation for more information.
+
+=for usage
+
+Usage:
+
+ ($res,$abserr,$ierr) = gslinteg_qawc($function_ref,$a,$b,$c,$epsabs,$epsrel,$limit)
+
+=for example
+
+Example:
+
+ my ($res,$abserr,$ierr) = gslinteg_qawc(\&f,-1,5,0,0,1e-3,1000);
+ # with warnings on
+ ($res,$abserr,$ierr) = gslinteg_qawc(\&f,-1,5,0,0,1e-3,1000,{Warn => 'y'});
+
+ sub f{
+ my ($x) = @_;
+ return 1.0 / (5.0 * $x * $x * $x + 6.0) ;
+ }
+
+=head2 gslinteg_qaws() -- Adaptive integration for singular functions
+
+The algorithm in gslinteg_qaws is designed for integrands with algebraic-logarithmic
+singularities at the end-points of an integration region.
+Specifically, this function computes the integral given by
+I = \int_a^b dx f(x) (x-a)^alpha (b-x)^beta log^mu (x-a) log^nu (b-x).
+The integral is
+estimated within the desired absolute and relative error limits, $epsabs and $epsrel.
+The maximum number of allowed subdivisions done by the adaptive
+algorithm must be supplied in the parameter $limit.
+
+=for ref
+
+Please check the GSL documentation for more information.
+
+=for usage
+
+Usage:
+
+ ($res,$abserr,$ierr) =
+ gslinteg_qawc($function_ref,$alpha,$beta,$mu,$nu,$a,$b,
+ $epsabs,$epsrel,$limit,[{Warn => $warn}]);
+
+=for example
+
+Example:
+
+ my ($res,$abserr,$ierr) = gslinteg_qaws(\&f,0,0,1,0,0,1,0,1e-7,1000);
+ # with warnings on
+ ($res,$abserr,$ierr) = gslinteg_qaws(\&f,0,0,1,0,0,1,0,1e-7,1000,{Warn => 'y'});
+
+ sub f{
+ my ($x) = @_;
+ if($x==0){return 0;}
+ else{
+ my $u = log($x);
+ my $v = 1 + $u*$u;
+ return 1.0/($v*$v);
+ }
+ }
+
+=head2 gslinteg_qawo() -- Adaptive integration for oscillatory functions
+
+This function uses an adaptive algorithm to compute the integral of f over
+(a,b) with the weight function sin(omega*x) or cos(omega*x) -- which of
+sine or cosine is used is determined by the parameter $opt ('cos' or 'sin').
+The integral is
+estimated within the desired absolute and relative error limits, $epsabs and $epsrel.
+The maximum number of allowed subdivisions done by the adaptive
+algorithm must be supplied in the parameter $limit.
+
+=for ref
+
+Please check the GSL documentation for more information.
+
+=for usage
+
+Usage:
+
+ ($res,$abserr,$ierr) = gslinteg_qawo($function_ref,$omega,$sin_or_cos,
+ $a,$b,$epsabs,$epsrel,$limit,[opt])
+
+=for example
+
+Example:
+
+ my $PI = 3.14159265358979323846264338328;
+ my ($res,$abserr,$ierr) = PDL::GSL::INTEG::gslinteg_qawo(\&f,10*$PI,'sin',0,1,0,1e-7,1000);
+ # with warnings on
+ ($res,$abserr,$ierr) = PDL::GSL::INTEG::gslinteg_qawo(\&f,10*$PI,'sin',0,1,0,1e-7,1000,{Warn => 'y'});
+
+ sub f{
+ my ($x) = @_;
+ if($x==0){return 0;}
+ else{ return log($x);}
+ }
+
+
+=head2 gslinteg_qawf() -- Adaptive integration for Fourier integrals
+
+This function attempts to compute a Fourier integral of the function
+f over the semi-infinite interval [a,+\infty). Specifically, it attempts
+tp compute I = \int_a^{+\infty} dx f(x)w(x), where w(x) is sin(omega*x)
+or cos(omega*x) -- which of sine or cosine is used is determined by
+the parameter $opt ('cos' or 'sin').
+The integral is
+estimated within the desired absolute error limit $epsabs.
+The maximum number of allowed subdivisions done by the adaptive
+algorithm must be supplied in the parameter $limit.
+
+=for ref
+
+Please check the GSL documentation for more information.
+
+=for usage
+
+Usage:
+
+ gslinteg_qawf($function_ref,$omega,$sin_or_cos,$a,$epsabs,$limit,[opt])
+
+=for example
+
+Example:
+
+ my ($res,$abserr,$ierr) = gslinteg_qawf(\&f,$PI/2.0,'cos',0,1e-7,1000);
+ # with warnings on
+ ($res,$abserr,$ierr) = gslinteg_qawf(\&f,$PI/2.0,'cos',0,1e-7,1000,{Warn => 'y'});
+
+ sub f{
+ my ($x) = @_;
+ if ($x == 0){return 0;}
+ return 1.0/sqrt($x)
+ }
+
+
+=head1 BUGS
+
+Feedback is welcome. Log bugs in the PDL bug database (the
+database is always linked from L<http://pdl.perl.org>).
+
+=head1 SEE ALSO
+
+L<PDL>
+
+The GSL documentation is online at
+
+ http://www.gnu.org/software/gsl/manual/
+
+=head1 AUTHOR
+
+This file copyright (C) 2003,2005 Andres Jordan <ajordan at eso.org>
+All rights reserved. There is no warranty. You are allowed to redistribute
+this software documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL integration routines were written by Brian Gough. QUADPACK
+was written by Piessens, Doncker-Kapenga, Uberhuber and Kahaner.
+
+=cut
+
+
+EOD
+
+pp_add_exported('','gslinteg_qng gslinteg_qag gslinteg_qags gslinteg_qagp
+ gslinteg_qagi gslinteg_qagiu gslinteg_qagil gslinteg_qawc
+ gslinteg_qaws gslinteg_qawo gslinteg_qawf');
+
+pp_addhdr('
+#include <math.h>
+#include <gsl/gsl_math.h>
+#include <gsl/gsl_integration.h>
+#include <gsl/gsl_errno.h>
+/* GSL Glue code contains it\'s own "warn" variable and doesn\'t call perl\'s warn function */
+/* (which can cause problems when perl\'s warn is called in a separate pthread), */
+/* so we undefine the warn redefinition */
+#undef warn
+
+#include "FUNC.c"
+
+void my_handler (const char * reason,
+ const char * file,
+ int line,
+ int gsl_errno){
+printf("Warning: %s at line %d of GSL file %s\n",reason,line,file);
+}
+
+');
+
+pp_addpm('
+sub gslinteg_qng{
+ my ($opt,$warn);
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Warn => \'n\'}; }
+ if($$opt{Warn}=~/y/i) { $warn = 1;}
+ else {$warn = 0;}
+ my ($f,$a,$b,$epsabs,$epsrel) = @_;
+ barf \'Usage: gslinteg_qng($function_ref,$a,$b,$epsabs,$epsrel,[opt]) \'
+ unless ($#_ == 4);
+ my ($res,$abserr,$neval,$ierr) = qng_meat($a,$b,$epsabs,$epsrel,$warn,$f);
+ return ($res,$abserr,$ierr,$neval);
+}
+');
+pp_def('qng_meat',
+ Pars => 'double a(); double b(); double epsabs();
+ double epsrel(); double [o] result(); double [o] abserr();
+ int [o] neval(); int [o] ierr(); int warn()',
+ OtherPars => 'SV* funcion;',
+ Docs => undef,
+ Code => '
+gsl_error_handler_t * old_handler;
+if ($warn() == 1) { old_handler = gsl_set_error_handler(&my_handler); }
+else { gsl_set_error_handler_off ();}
+current_fun++;
+if (current_fun >= (max_nested_integrals)) barf("Too many nested integrals, sorry!\n");
+ext_funname[current_fun] = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+$ierr() = gsl_integration_qng(&F,$a(),$b(),$epsabs(),$epsrel(),$P(result),$P(abserr),(size_t *) $P(neval));
+current_fun--;
+');
+
+pp_addpm('
+sub gslinteg_qag{
+ my ($opt,$warn);
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Warn => \'n\'}; }
+ if($$opt{Warn}=~/y/i) { $warn = 1;}
+ else {$warn = 0;}
+ my ($f,$a,$b,$epsabs,$epsrel,$limit,$key) = @_;
+ barf \'Usage: gslinteg_qag($function_ref,$a,$b,$epsabs,$epsrel,$limit,$key,[opt]) \'
+ unless ($#_ == 6);
+ my ($res,$abserr,$ierr) = qag_meat($a,$b,$epsabs,$epsrel,$limit,$key,$limit,$warn,$f);
+ return ($res,$abserr,$ierr);
+}
+');
+
+pp_def('qag_meat',
+ Pars => 'double a(); double b(); double epsabs();double epsrel(); int limit();
+ int key(); double [o] result(); double [o] abserr();int n();int [o] ierr();int warn();',
+ OtherPars => 'SV* funcion;',
+ Docs => undef,
+ Code =>'
+gsl_error_handler_t * old_handler;
+if ($warn() == 1) { old_handler = gsl_set_error_handler(&my_handler); }
+else { gsl_set_error_handler_off ();}
+{gsl_integration_workspace *w;
+current_fun++;
+if (current_fun >= (max_nested_integrals)) barf("Too many nested integrals, sorry!\n");
+ext_funname[current_fun] = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+w = gsl_integration_workspace_alloc((size_t) $n());
+$ierr() = gsl_integration_qag(&F,$a(),$b(),$epsabs(),$epsrel(),(size_t) $limit(),$key(),w,$P(result),$P(abserr));
+gsl_integration_workspace_free(w);
+current_fun--;
+}
+');
+
+pp_addpm('
+sub gslinteg_qags{
+ my ($opt,$warn);
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Warn => \'n\'}; }
+ if($$opt{Warn}=~/y/i) { $warn = 1;}
+ else {$warn = 0;}
+ my ($f,$a,$b,$epsabs,$epsrel,$limit) = @_;
+ barf \'Usage: gslinteg_qags($function_ref,$a,$b,$epsabs,$epsrel,$limit,[opt]) \'
+ unless ($#_ == 5);
+ my ($res,$abserr,$ierr) = qags_meat($a,$b,$epsabs,$epsrel,$limit,$limit,$warn,$f);
+ return ($res,$abserr,$ierr);
+}
+');
+pp_def('qags_meat',
+ Pars => 'double a(); double b(); double epsabs();double epsrel(); int limit();
+ double [o] result(); double [o] abserr();int n();int [o] ierr();int warn();',
+ OtherPars => 'SV* funcion;',
+ Docs => undef,
+ Code =>'
+gsl_error_handler_t * old_handler;
+if ($warn() == 1) { old_handler = gsl_set_error_handler(&my_handler); }
+else { gsl_set_error_handler_off ();}
+{gsl_integration_workspace *w;
+current_fun++;
+if (current_fun >= (max_nested_integrals)) barf("Too many nested integrals, sorry!\n");
+ext_funname[current_fun] = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+w = gsl_integration_workspace_alloc((size_t) $n());
+$ierr() = gsl_integration_qags(&F,$a(),$b(),$epsabs(),$epsrel(),(size_t) $limit(),w,$P(result),$P(abserr));
+gsl_integration_workspace_free(w);
+current_fun--;
+}
+');
+
+pp_addpm('
+sub gslinteg_qagp{
+ my ($opt,$warn);
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Warn => \'n\'}; }
+ if($$opt{Warn}=~/y/i) { $warn = 1;}
+ else {$warn = 0;}
+ my ($f,$points,$epsabs,$epsrel,$limit) = @_;
+ barf \'Usage: gslinteg_qagp($function_ref,$points,$epsabs,$epsrel,$limit,[opt]) \'
+ unless ($#_ == 4);
+ my ($res,$abserr,$ierr) = qagp_meat($points,$epsabs,$epsrel,$limit,$limit,$warn,$f);
+ return ($res,$abserr,$ierr);
+}
+');
+pp_def('qagp_meat',
+ Pars => 'double pts(l); double epsabs();double epsrel();int limit();
+ double [o] result(); double [o] abserr();int n();int [o] ierr();int warn();',
+ OtherPars => 'SV* funcion;',
+ Code =>'
+gsl_error_handler_t * old_handler;
+if ($warn() == 1) { old_handler = gsl_set_error_handler(&my_handler); }
+else { gsl_set_error_handler_off ();}
+{gsl_integration_workspace *w;
+current_fun++;
+if (current_fun >= (max_nested_integrals)) barf("Too many nested integrals, sorry!\n");
+ext_funname[current_fun] = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+w = gsl_integration_workspace_alloc((size_t) $n());
+$ierr() = gsl_integration_qagp(&F,$P(pts),(size_t) $SIZE(l),$epsabs(),$epsrel(),(size_t) $limit(),w,$P(result),$P(abserr));
+gsl_integration_workspace_free(w);
+current_fun--;
+}
+');
+
+pp_addpm('
+sub gslinteg_qagi{
+ my ($opt,$warn);
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Warn => \'n\'}; }
+ if($$opt{Warn}=~/y/i) { $warn = 1;}
+ else {$warn = 0;}
+ my ($f,$epsabs,$epsrel,$limit) = @_;
+ barf \'Usage: gslinteg_qagi($function_ref,$epsabs,$epsrel,$limit,[opt]) \'
+ unless ($#_ == 3);
+ my ($res,$abserr,$ierr) = qagi_meat($epsabs,$epsrel,$limit,$limit,$warn,$f);
+ return ($res,$abserr,$ierr);
+}
+');
+pp_def('qagi_meat',
+ Pars => 'double epsabs();double epsrel(); int limit();
+ double [o] result(); double [o] abserr(); int n(); int [o] ierr();int warn();',
+ OtherPars => 'SV* funcion;',
+ Code =>'
+gsl_error_handler_t * old_handler;
+if ($warn() == 1) { old_handler = gsl_set_error_handler(&my_handler); }
+else { gsl_set_error_handler_off ();}
+{gsl_integration_workspace *w;
+current_fun++;
+if (current_fun >= (max_nested_integrals)) barf("Too many nested integrals, sorry!\n");
+ext_funname[current_fun] = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+w = gsl_integration_workspace_alloc((size_t) $n());
+$ierr() = gsl_integration_qagi(&F,$epsabs(),$epsrel(),(size_t) $limit(),w,$P(result),$P(abserr));
+gsl_integration_workspace_free(w);
+current_fun--;
+}
+');
+
+pp_addpm('
+sub gslinteg_qagiu{
+ my ($opt,$warn);
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Warn => \'n\'}; }
+ if($$opt{Warn}=~/y/i) { $warn = 1;}
+ else {$warn = 0;}
+ my ($f,$a,$epsabs,$epsrel,$limit) = @_;
+ barf \'Usage: gslinteg_qagiu($function_ref,$a,$epsabs,$epsrel,$limit,[opt]) \'
+ unless ($#_ == 4);
+ my ($res,$abserr,$ierr) = qagiu_meat($a,$epsabs,$epsrel,$limit,$limit,$warn,$f);
+ return ($res,$abserr,$ierr);
+}
+');
+pp_def('qagiu_meat',
+ Pars => 'double a(); double epsabs();double epsrel();int limit();
+ double [o] result(); double [o] abserr();int n();int [o] ierr();int warn();',
+ OtherPars => 'SV* funcion;',
+ Docs => undef,
+ Code =>'
+gsl_error_handler_t * old_handler;
+if ($warn() == 1) { old_handler = gsl_set_error_handler(&my_handler); }
+else { gsl_set_error_handler_off ();}
+{gsl_integration_workspace *w;
+current_fun++;
+if (current_fun >= (max_nested_integrals)) barf("Too many nested integrals, sorry!\n");
+ext_funname[current_fun] = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+w = gsl_integration_workspace_alloc((size_t) $n());
+$ierr() = gsl_integration_qagiu(&F,$a(),$epsabs(),$epsrel(),(size_t) $limit(),w,$P(result),$P(abserr));
+gsl_integration_workspace_free(w);
+current_fun--;
+}
+');
+
+pp_addpm('
+sub gslinteg_qagil{
+ my ($opt,$warn);
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Warn => \'n\'}; }
+ if($$opt{Warn}=~/y/i) { $warn = 1;}
+ else {$warn = 0;}
+ my ($f,$b,$epsabs,$epsrel,$limit) = @_;
+ barf \'Usage: gslinteg_qagil($function_ref,$b,$epsabs,$epsrel,$limit,[opt]) \'
+ unless ($#_ == 4);
+ my ($res,$abserr,$ierr) = qagil_meat($b,$epsabs,$epsrel,$limit,$limit,$warn,$f);
+ return ($res,$abserr,$ierr);
+}
+');
+pp_def('qagil_meat',
+ Pars => 'double b(); double epsabs();double epsrel();int limit();
+ double [o] result(); double [o] abserr();int n();int [o] ierr();int warn();',
+ OtherPars => 'SV* funcion;',
+ Docs => undef,
+ Code =>'
+gsl_error_handler_t * old_handler;
+if ($warn() == 1) { old_handler = gsl_set_error_handler(&my_handler); }
+else { gsl_set_error_handler_off ();}
+{gsl_integration_workspace *w;
+current_fun++;
+if (current_fun >= (max_nested_integrals)) barf("Too many nested integrals, sorry!\n");
+ext_funname[current_fun] = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+w = gsl_integration_workspace_alloc((size_t) $n());
+$ierr() = gsl_integration_qagil(&F,$b(),$epsabs(),$epsrel(),(size_t) $limit(),w,$P(result),$P(abserr));
+gsl_integration_workspace_free(w);
+current_fun--;
+}
+');
+
+pp_addpm('
+sub gslinteg_qawc{
+ my ($opt,$warn);
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Warn => \'n\'}; }
+ if($$opt{Warn}=~/y/i) { $warn = 1;}
+ else {$warn = 0;}
+ my ($f,$a,$b,$c,$epsabs,$epsrel,$limit) = @_;
+ barf \'Usage: gslinteg_qawc($function_ref,$a,$b,$c,$epsabs,$epsrel,$limit,[opt]) \'
+ unless ($#_ == 6);
+ my ($res,$abserr,$ierr) = qawc_meat($a,$b,$c,$epsabs,$epsrel,$limit,$limit,$warn,$f);
+ return ($res,$abserr,$ierr);
+}
+');
+pp_def('qawc_meat',
+ Pars => 'double a(); double b(); double c(); double epsabs();double epsrel();int limit();
+ double [o] result(); double [o] abserr();int n();int [o] ierr();int warn();',
+ OtherPars => 'SV* funcion;',
+ Code =>'
+gsl_error_handler_t * old_handler;
+if ($warn() == 1) { old_handler = gsl_set_error_handler(&my_handler); }
+else { gsl_set_error_handler_off ();}
+{gsl_integration_workspace *w;
+current_fun++;
+if (current_fun >= (max_nested_integrals)) barf("Too many nested integrals, sorry!\n");
+ext_funname[current_fun] = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+w = gsl_integration_workspace_alloc((size_t) $n());
+$ierr() = gsl_integration_qawc(&F,$a(),$b(),$c(),$epsabs(),$epsrel(),(size_t) $limit(),w,$P(result),$P(abserr));
+gsl_integration_workspace_free(w);
+current_fun--;
+}
+');
+
+pp_addpm('
+sub gslinteg_qaws{
+ my ($opt,$warn);
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Warn => \'n\'}; }
+ if($$opt{Warn}=~/y/i) { $warn = 1;}
+ else {$warn = 0;}
+ my ($f,$alpha,$beta,$mu,$nu,$a,$b,$epsabs,$epsrel,$limit) = @_;
+ barf \'Usage: gslinteg_qaws($function_ref,$alpha,$beta,$mu,$nu,$a,$b,$epsabs,$epsrel,$limit,[opt]) \'
+ unless ($#_ == 9);
+ my ($res,$abserr,$ierr) = qaws_meat($a,$b,$epsabs,$epsrel,$limit,$limit,$alpha,$beta,$mu,$nu,$warn,$f);
+ return ($res,$abserr,$ierr);
+}
+');
+pp_def('qaws_meat',
+ Pars => 'double a(); double b();double epsabs();double epsrel();int limit();
+ double [o] result(); double [o] abserr();int n();
+ double alpha(); double beta(); int mu(); int nu();int [o] ierr();int warn();',
+ OtherPars => 'SV* funcion;',
+ Code => '
+gsl_error_handler_t * old_handler;
+if ($warn() == 1) { old_handler = gsl_set_error_handler(&my_handler); }
+else { gsl_set_error_handler_off ();}
+{gsl_integration_qaws_table * qtab;
+gsl_integration_workspace *w;
+
+qtab = gsl_integration_qaws_table_alloc($alpha(),$beta(),$mu(),$nu());
+
+current_fun++;
+if (current_fun >= (max_nested_integrals)) barf("Too many nested integrals, sorry!\n");
+ext_funname[current_fun] = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+w = gsl_integration_workspace_alloc((size_t) $n());
+$ierr() = gsl_integration_qaws(&F,$a(),$b(),qtab,$epsabs(),$epsrel(),(size_t) $limit(),w,$P(result),$P(abserr));
+gsl_integration_workspace_free(w);
+gsl_integration_qaws_table_free(qtab);
+current_fun--;
+}
+');
+
+pp_addpm('
+sub gslinteg_qawo{
+ my ($opt,$warn);
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Warn => \'n\'}; }
+ if($$opt{Warn}=~/y/i) { $warn = 1;}
+ else {$warn = 0;}
+ my ($f,$omega,$sincosopt,$a,$b,$epsabs,$epsrel,$limit) = @_;
+ barf \'Usage: gslinteg_qawo($function_ref,$omega,$sin_or_cos,$a,$b,$epsabs,$epsrel,$limit,[opt]) \'
+ unless ($#_ == 7);
+ my $OPTION_SIN_COS;
+ if($sincosopt=~/cos/i){ $OPTION_SIN_COS = 0;}
+ elsif($sincosopt=~/sin/i){ $OPTION_SIN_COS = 1;}
+ else { barf("Error in argument 3 of function gslinteg_qawo: specify \'cos\' or \'sin\'\n");}
+
+ my $L = $b - $a;
+ my $nlevels = $limit;
+ my ($res,$abserr,$ierr) = qawo_meat($a,$b,$epsabs,$epsrel,$limit,$limit,$OPTION_SIN_COS,$omega,$L,$nlevels,$warn,$f);
+ return ($res,$abserr,$ierr);
+}
+');
+pp_def('qawo_meat',
+ Pars => 'double a(); double b();double epsabs();double epsrel();int limit();
+ double [o] result(); double [o] abserr();int n();
+ int sincosopt(); double omega(); double L(); int nlevels();int [o] ierr();int warn();',
+ OtherPars => 'SV* funcion;',
+ Code => '
+gsl_error_handler_t * old_handler;
+if ($warn() == 1) { old_handler = gsl_set_error_handler(&my_handler); }
+else { gsl_set_error_handler_off ();}
+{gsl_integration_qawo_table * qtab;
+gsl_integration_workspace *w;
+enum gsl_integration_qawo_enum T;
+
+T = GSL_INTEG_SINE;
+if ($sincosopt() == 0){ T = GSL_INTEG_COSINE ;}
+
+qtab = gsl_integration_qawo_table_alloc($omega(),$L(),T,(size_t) $nlevels());
+
+current_fun++;
+if (current_fun >= (max_nested_integrals)) barf("Too many nested integrals, sorry!\n");
+ext_funname[current_fun] = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+w = gsl_integration_workspace_alloc((size_t) $n());
+$ierr() = gsl_integration_qawo(&F,$a(),$epsabs(),$epsrel(),(size_t) $limit(),w,qtab,$P(result),$P(abserr));
+gsl_integration_workspace_free(w);
+gsl_integration_qawo_table_free(qtab);
+current_fun--;
+}
+');
+
+pp_addpm('
+sub gslinteg_qawf{
+ my ($opt,$warn);
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Warn => \'n\'}; }
+ if($$opt{Warn}=~/y/i) { $warn = 1;}
+ else {$warn = 0;}
+ my ($f,$omega,$sincosopt,$a,$epsabs,$limit) = @_;
+ barf \'Usage: gslinteg_qawf($function_ref,$omega,$sin_or_cos,$a,$epsabs,$limit,[opt]) \'
+ unless ($#_ == 5);
+ my $OPTION_SIN_COS;
+ if($sincosopt=~/cos/i){ $OPTION_SIN_COS = 0;}
+ elsif($sincosopt=~/sin/i){ $OPTION_SIN_COS = 1;}
+ else { barf("Error in argument 3 of function gslinteg_qawf: specify \'cos\' or \'sin\'\n");}
+ my $nlevels = $limit;
+ my ($res,$abserr,$ierr) = qawf_meat($a,$epsabs,$limit,$limit,$OPTION_SIN_COS,$omega,$nlevels,$warn,$f);
+ return ($res,$abserr,$ierr);
+}
+');
+
+pp_def('qawf_meat',
+ Pars => 'double a(); double epsabs();int limit();
+ double [o] result(); double [o] abserr();int n();
+ int sincosopt(); double omega(); int nlevels();int [o] ierr();int warn();',
+ OtherPars => 'SV* funcion;',
+ Code => '
+gsl_error_handler_t * old_handler;
+if ($warn() == 1) { old_handler = gsl_set_error_handler(&my_handler); }
+else { gsl_set_error_handler_off ();}
+{gsl_integration_qawo_table * qtab;
+gsl_integration_workspace *w;
+gsl_integration_workspace *cw;
+enum gsl_integration_qawo_enum T;
+
+T = GSL_INTEG_SINE;
+if ($sincosopt() == 0){ T = GSL_INTEG_COSINE ;}
+
+qtab = gsl_integration_qawo_table_alloc($omega(),1.,T,(size_t) $nlevels());
+
+current_fun++;
+if (current_fun >= (max_nested_integrals)) barf("Too many nested integrals, sorry!\n");
+ext_funname[current_fun] = $COMP(funcion);
+F.function = &FUNC;
+F.params = 0;
+
+w = gsl_integration_workspace_alloc((size_t) $n());
+cw = gsl_integration_workspace_alloc((size_t) $n());
+
+$ierr() = gsl_integration_qawf(&F,$a(),$epsabs(),(size_t) $limit(),w,cw,qtab,$P(result),$P(abserr));
+
+gsl_integration_workspace_free(w);
+gsl_integration_workspace_free(cw);
+gsl_integration_qawo_table_free(qtab);
+current_fun--;
+}
+');
+
+
+pp_done();
diff --git a/Lib/GSL/INTERP/Makefile.PL b/Lib/GSL/INTERP/Makefile.PL
new file mode 100644
index 0000000..7d04889
--- /dev/null
+++ b/Lib/GSL/INTERP/Makefile.PL
@@ -0,0 +1,83 @@
+# PDL interface to GSL interpolation routines
+# Makefile.PL for a package defined by PP code.
+
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+my $msg = undef;
+my $forcebuild=0;
+my $skip = 0;
+
+# this Makefile uses get_gsl_libs which is defined in
+# the parent Makefile.PL
+
+sub gsl_interp_links_ok {
+ my($lib,$inc) = @_;
+ return defined($lib) && defined($inc) &&
+ trylink 'gsl interp libraries',
+ << 'EOI',
+#include <math.h>
+#include <gsl/gsl_errno.h>
+#include <gsl/gsl_spline.h>
+EOI
+ << 'EOB', $lib, $inc;
+
+ int i;
+ double xi, yi, x[10], y[10];
+
+ for (i = 0; i < 10; i++)
+ {
+ x[i] = i + 0.5 * sin (i);
+ y[i] = i + cos (i * i);
+ }
+ {
+ gsl_interp_accel *acc
+ = gsl_interp_accel_alloc ();
+ gsl_spline *spline
+ = gsl_spline_alloc (gsl_interp_cspline, 10);
+
+ gsl_spline_init (spline, x, y, 10);
+
+ yi = gsl_spline_eval (spline, x[0] + 0.01, acc);
+
+ gsl_spline_free (spline);
+ gsl_interp_accel_free(acc);
+ }
+
+EOB
+}
+
+if (defined $PDL::Config{WITH_GSL} && $PDL::Config{WITH_GSL}==0) {
+ $msg = "\n Will skip build of PDL::GSL::INTERP on this system \n";
+ $skip = 1;
+} elsif (defined $PDL::Config{WITH_GSL} && $PDL::Config{WITH_GSL}==1) {
+ print "\n Will forcibly try and build PDL::GSL::INTERP on this system \n\n";
+ $forcebuild=1;
+}
+
+if (($skip && !$forcebuild) ||
+ !gsl_interp_links_ok($GSL_libs, $GSL_includes)) {
+ warn "trying to force GSL build but link test failed\n".
+ "\t -- aborting GSL build\n" if $forcebuild;
+ $msg ||=
+ "\n GSL Libraries not found... Skipping build of PDL::GSL::INTERP.\n";
+ warn $msg . "\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ return;
+} else {
+ print "\n Building PDL::GSL::INTERP.",
+ "Turn off WITH_GSL if there are any problems\n\n";
+}
+
+ at pack = (["gsl_interp.pd",INTERP,PDL::GSL::INTERP]);
+%hash = pdlpp_stdargs_int(@::pack);
+
+$hash{INC} .= " $GSL_includes";
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Lib/GSL/INTERP/gsl_interp.pd b/Lib/GSL/INTERP/gsl_interp.pd
new file mode 100644
index 0000000..a3b5859
--- /dev/null
+++ b/Lib/GSL/INTERP/gsl_interp.pd
@@ -0,0 +1,456 @@
+pp_bless('PDL::GSL::INTERP'); # make the functions generated go into our namespace
+
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSL::INTERP - PDL interface to Interpolation routines in GSL
+
+=head1 DESCRIPTION
+
+This is an interface to the interpolation package present in the
+GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::GSL::INTERP;
+
+ my $x = sequence(10);
+ my $y = exp($x);
+
+ my $spl = PDL::GSL::INTERP->init('cspline',$x,$y);
+
+ my $res = $spl->eval(4.35);
+ $res = $spl->deriv(4.35);
+ $res = $spl->deriv2(4.35);
+ $res = $spl->integ(2.1,7.4);
+
+=head1 FUNCTIONS
+
+=head2 init()
+
+=for ref
+
+The init method initializes a new instance of INTERP. It needs as
+input an interpolation type and two piddles holding the x and y
+values to be interpolated. The GSL routines require that x be
+monotonically increasing and a quicksort is performed by default to
+ensure that. You can skip the quicksort by passing the option
+{Sort => 0}.
+
+The available interpolation types are :
+
+=over 2
+
+=item linear
+
+=item polynomial
+
+=item cspline (natural cubic spline)
+
+=item cspline_periodic (periodic cubic spline)
+
+=item akima (natural akima spline)
+
+=item akima_periodic (periodic akima spline)
+
+=back
+
+Please check the GSL documentation for more information.
+
+=for usage
+
+Usage:
+
+ $blessed_ref = PDL::GSL::INTERP->init($interp_method,$x,$y,$opt);
+
+=for example
+
+Example:
+
+ $x = sequence(10);
+ $y = exp($x);
+
+ $spl = PDL::GSL::INTERP->init('cspline',$x,$y)
+ $spl = PDL::GSL::INTERP->init('cspline',$x,$y,{Sort => 1}) #same as above
+
+ # no sorting done on x, user is certain that x is monotonically increasing
+ $spl = PDL::GSL::INTERP->init('cspline',$x,$y,{Sort => 0});
+
+=head2 eval()
+
+=for ref
+
+The function eval returns the interpolating function at a given point. By default
+it will barf if you try to extrapolate, to comply silently if the point to be
+evaluated is out of range pass the option {Extrapolate => 1}
+
+=for usage
+
+Usage:
+
+ $result = $spl->eval($points,$opt);
+
+=for example
+
+Example:
+
+ my $res = $spl->eval($x)
+ $res = $spl->eval($x,{Extrapolate => 0}) #same as above
+
+ # silently comply if $x is out of range
+ $res = $spl->eval($x,{Extrapolate => 1})
+
+=head2 deriv()
+
+=for ref
+
+The deriv function returns the derivative of the
+interpolating function at a given point. By default
+it will barf if you try to extrapolate, to comply silently if the point to be
+evaluated is out of range pass the option {Extrapolate => 1}
+
+=for usage
+
+Usage:
+
+ $result = $spl->deriv($points,$opt);
+
+=for example
+
+Example:
+
+ my $res = $spl->deriv($x)
+ $res = $spl->deriv($x,{Extrapolate => 0}) #same as above
+
+ # silently comply if $x is out of range
+ $res = $spl->deriv($x,{Extrapolate => 1})
+
+
+=head2 deriv2()
+
+=for ref
+
+The deriv2 function returns the second derivative
+of the interpolating function at a given point. By default
+it will barf if you try to extrapolate, to comply silently if the point to be
+evaluated is out of range pass the option {Extrapolate => 1}
+
+
+=for usage
+
+Usage:
+
+ $result = $spl->deriv2($points,$opt);
+
+=for example
+
+Example:
+
+ my $res = $spl->deriv2($x)
+ $res = $spl->deriv2($x,{Extrapolate => 0}) #same as above
+
+ # silently comply if $x is out of range
+ $res = $spl->deriv2($x,{Extrapolate => 1})
+
+=head2 integ()
+
+=for ref
+
+The integ function returns the integral
+of the interpolating function between two points.
+By default it will barf if you try to extrapolate,
+to comply silently if one of the integration limits
+is out of range pass the option {Extrapolate => 1}
+
+
+=for usage
+
+Usage:
+
+ $result = $spl->integ($a,$b,$opt);
+
+=for example
+
+Example:
+
+ my $res = $spl->integ($a,$b)
+ $res = $spl->integ($a,$b,{Extrapolate => 0}) #same as above
+
+ # silently comply if $a or $b are out of range
+ $res = $spl->eval($a,$b,{Extrapolate => 1})
+
+=head1 BUGS
+
+Feedback is welcome.
+
+=head1 SEE ALSO
+
+L<PDL>
+
+The GSL documentation is online at
+
+ http://www.gnu.org/software/gsl/manual/
+
+=head1 AUTHOR
+
+This file copyright (C) 2003 Andres Jordan <andresj at physics.rutgers.edu>
+All rights reserved. There is no warranty. You are allowed to redistribute this
+software/documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL interpolation module was written by Gerard Jungman.
+
+=cut
+
+
+EOD
+
+pp_addhdr('
+#include<string.h>
+#include<math.h>
+#include<gsl/gsl_errno.h>
+#include<gsl/gsl_spline.h>
+#include "gslerr.h"
+
+typedef gsl_spline GslSpline;
+typedef gsl_interp_accel GslAccel;
+
+');
+
+pp_addpm('
+sub init{
+ my $opt;
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Sort => 1}; }
+ my ($class,$type,$x,$y) = @_;
+ if( (ref($x) ne \'PDL\') || (ref($y) ne \'PDL\') ){
+ barf("Have to pass piddles as arguments to init method\n");
+ }
+ if($$opt{Sort} != 0){
+ my $idx = PDL::Ufunc::qsorti($x);
+ $x = $x->index($idx);
+ $y = $y->index($idx);
+ }
+ my $ene = nelem($x);
+ my $obj1 = new_spline($type,$ene);
+ my $obj2 = new_accel();
+ init_meat($x,$y,$$obj1);
+ my @ret_a = ($obj1,$obj2);
+ return bless(\@ret_a, $class);
+}
+');
+
+pp_def('init_meat',
+ Pars => 'double x(n); double y(n);',
+ OtherPars => 'IV spl',
+ Doc => undef,
+ Code =>'
+GSLERR(gsl_spline_init,( INT2PTR(gsl_spline *, $COMP(spl)), $P(x),$P(y),$SIZE(n)));'
+);
+
+pp_addpm('
+sub eval{
+ my $opt;
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Extrapolate => 0}; }
+ my ($obj,$x) = @_;
+ my $s_obj = $$obj[0];
+ my $a_obj = $$obj[1];
+ if($$opt{Extrapolate} == 0){
+ return eval_meat($x,$$s_obj,$$a_obj);
+ }
+ else{
+ return eval_meat_ext($x,$$s_obj,$$a_obj);
+ }
+}
+');
+
+pp_def('eval_meat',
+ Pars => 'double x(); double [o] out();',
+ OtherPars => 'IV spl;IV acc;',
+ Doc => undef,
+
+ # BadCode added 5/31/2005, D. Hunt
+ HandleBad => 1,
+ BadCode => '
+ if ($ISBAD($x())) {
+ $out() = $x();
+ } else {
+ GSLERR(gsl_spline_eval_e,( INT2PTR(gsl_spline *, $COMP(spl)), $x(), INT2PTR(gsl_interp_accel *, $COMP(acc)), $P(out)));
+ }
+ ',
+
+ Code =>'
+GSLERR(gsl_spline_eval_e,( INT2PTR(gsl_spline *, $COMP(spl)), $x(), INT2PTR(gsl_interp_accel *, $COMP(acc)), $P(out)));
+');
+pp_def('eval_meat_ext',
+ Pars => 'double x(); double [o] out();',
+ OtherPars => 'IV spl;IV acc;',
+ Doc => undef,
+ Code =>'
+$out() = gsl_spline_eval( INT2PTR(gsl_spline *, $COMP(spl)), $x(), INT2PTR(gsl_interp_accel *, $COMP(acc)));
+');
+
+
+
+pp_addpm('
+sub deriv{
+ my $opt;
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Extrapolate => 0}; }
+ my ($obj,$x) = @_;
+ my $s_obj = $$obj[0];
+ my $a_obj = $$obj[1];
+ if($$opt{Extrapolate} == 0){
+ return eval_deriv_meat($x,$$s_obj,$$a_obj);
+ }
+ else{
+ return eval_deriv_meat_ext($x,$$s_obj,$$a_obj);
+ }
+}
+');
+
+pp_def('eval_deriv_meat',
+ Pars => 'double x(); double [o] out();',
+ OtherPars => 'IV spl;IV acc;',
+ Doc => undef,
+ Code =>'
+GSLERR(gsl_spline_eval_deriv_e,( INT2PTR(gsl_spline *, $COMP(spl)), $x(), INT2PTR(gsl_interp_accel *, $COMP(acc)), $P(out)));
+');
+pp_def('eval_deriv_meat_ext',
+ Pars => 'double x(); double [o] out();',
+ OtherPars => 'IV spl;IV acc;',
+ Doc => undef,
+ Code =>'
+$out() = gsl_spline_eval_deriv( INT2PTR(gsl_spline *, $COMP(spl)), $x(), INT2PTR(gsl_interp_accel *, $COMP(acc)));
+');
+
+pp_addpm('
+sub deriv2{
+ my $opt;
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Extrapolate => 0}; }
+ my ($obj,$x) = @_;
+ my $s_obj = $$obj[0];
+ my $a_obj = $$obj[1];
+ if($$opt{Extrapolate} == 0){
+ return eval_deriv2_meat($x,$$s_obj,$$a_obj);
+ }
+ else{
+ return eval_deriv2_meat_ext($x,$$s_obj,$$a_obj);
+ }
+}
+');
+
+pp_def('eval_deriv2_meat',
+ Pars => 'double x(); double [o] out();',
+ OtherPars => 'IV spl;IV acc;',
+ Doc => undef,
+ Code =>'
+GSLERR(gsl_spline_eval_deriv2_e,( INT2PTR(gsl_spline *, $COMP(spl)), $x(), INT2PTR(gsl_interp_accel *, $COMP(acc)), $P(out)));
+');
+pp_def('eval_deriv2_meat_ext',
+ Pars => 'double x(); double [o] out();',
+ OtherPars => 'IV spl;IV acc;',
+ Doc => undef,
+ Code =>'
+$out() = gsl_spline_eval_deriv2( INT2PTR(gsl_spline *, $COMP(spl)), $x(), INT2PTR(gsl_interp_accel *, $COMP(acc)));
+');
+
+pp_addpm('
+sub integ{
+ my $opt;
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Extrapolate => 0}; }
+ my ($obj,$a,$b) = @_;
+ my $s_obj = $$obj[0];
+ my $a_obj = $$obj[1];
+ if($$opt{Extrapolate} == 0){
+ return eval_integ_meat($a,$b,$$s_obj,$$a_obj);
+ }
+ else{
+ return eval_integ_meat_ext($a,$b,$$s_obj,$$a_obj);
+ }
+}
+');
+
+pp_def('eval_integ_meat',
+ Pars => 'double a(); double b(); double [o] out();',
+ OtherPars => 'IV spl;IV acc;',
+ Doc => undef,
+ Code =>'
+GSLERR(gsl_spline_eval_integ_e,( INT2PTR(gsl_spline *, $COMP(spl)), $a(), $b(), INT2PTR(gsl_interp_accel *, $COMP(acc)),$P(out)));
+');
+pp_def('eval_integ_meat_ext',
+ Pars => 'double a(); double b(); double [o] out();',
+ OtherPars => 'IV spl;IV acc;',
+ Doc => undef,
+ Code =>'
+$out() = gsl_spline_eval_integ( INT2PTR(gsl_spline *, $COMP(spl)), $a(), $b(), INT2PTR(gsl_interp_accel *, $COMP(acc)));
+');
+
+
+# XS functions for the INTERP objects
+
+pp_addxs('','
+MODULE = PDL::GSL::INTERP PACKAGE = PDL::GSL::INTERP
+
+#define DEF_INTERP(X) if (!strcmp(TYPE,#X)) spline=gsl_spline_alloc( gsl_interp_ ## X , ene); strcat(ula,#X ", ");
+
+GslSpline *
+new_spline (TYPE,ene)
+ char *TYPE
+ int ene
+ CODE:
+ GslSpline * spline = NULL;
+ char ula[100];
+strcpy(ula,"");
+DEF_INTERP(linear);
+DEF_INTERP(polynomial);
+DEF_INTERP(cspline);
+DEF_INTERP(cspline_periodic);
+DEF_INTERP(akima);
+DEF_INTERP(akima_periodic);
+ if (spline==NULL) {
+ barf("Unknown interpolation type, please use one of the following: %s", ula);
+ }
+ else
+ RETVAL = spline;
+ OUTPUT:
+ RETVAL
+
+GslAccel *
+new_accel ()
+ CODE:
+ GslAccel * accel = NULL;
+ accel = gsl_interp_accel_alloc();
+ if (accel == NULL){
+ barf("Problem allocating accelerator object\n");
+ }
+ RETVAL = accel;
+ OUTPUT:
+ RETVAL
+
+MODULE = PDL::GSL::INTERP PACKAGE = GslSplinePtr PREFIX = spl_
+
+void
+spl_DESTROY(spline)
+ GslSpline * spline
+ CODE:
+ gsl_spline_free(spline);
+
+MODULE = PDL::GSL::INTERP PACKAGE = GslAccelPtr PREFIX = acc_
+
+void
+acc_DESTROY(accel)
+ GslAccel * accel
+ CODE:
+ gsl_interp_accel_free(accel);
+
+');
+
+pp_export_nothing;
+pp_done();
+
diff --git a/Lib/GSL/INTERP/gslerr.h b/Lib/GSL/INTERP/gslerr.h
new file mode 100644
index 0000000..fbdeceb
--- /dev/null
+++ b/Lib/GSL/INTERP/gslerr.h
@@ -0,0 +1,7 @@
+
+static int status;
+static char buf[200];
+
+/* Turn off GSL default handler. 10/18/2010 Jason Lin */
+#define GSLERR(x,y) gsl_set_error_handler_off (); if (status = x y) {sprintf(buf,"Error in %s: %s",# x ,gsl_strerror(status));barf(buf);}
+
diff --git a/Lib/GSL/INTERP/typemap b/Lib/GSL/INTERP/typemap
new file mode 100644
index 0000000..b86d3e4
--- /dev/null
+++ b/Lib/GSL/INTERP/typemap
@@ -0,0 +1,3 @@
+TYPEMAP
+GslSpline * T_PTROBJ
+GslAccel * T_PTROBJ
diff --git a/Lib/GSL/MROOT/FUNC.c b/Lib/GSL/MROOT/FUNC.c
new file mode 100644
index 0000000..eff6b63
--- /dev/null
+++ b/Lib/GSL/MROOT/FUNC.c
@@ -0,0 +1,222 @@
+// This file copyright (C) 2006 Andres Jordan <ajordan at eso.org>
+// and Simon Casassus <simon at das.uchile.cl>
+// All rights reserved. There is no warranty. You are allowed to
+// redistribute this software/documentation under certain conditions.
+// For details, see the file COPYING in the PDL distribution. If this file
+// is separated from the PDL distribution, the copyright notice should be
+// included in the file.
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <gsl/gsl_vector.h>
+#include <gsl/gsl_multiroots.h>
+
+static SV* ext_funname1;
+
+static int ene;
+
+void DFF(int* n, double* x, double* vector);
+int my_f (const gsl_vector * v, void * params, gsl_vector * df);
+
+void DFF(int* n, double* xval, double* vector){
+ //this version tries just to get the output
+ SV* funname;
+
+ double* xpass; int i;
+ int count;
+ I32 ax ;
+
+ pdl* px;
+ SV* pxsv;
+
+ pdl* pvector;
+ SV* pvectorsv;
+
+ int ndims;
+ PDL_Long *pdims;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ ndims = 1;
+ pdims = (PDL_Long *) PDL->smalloc((STRLEN) ((ndims) * sizeof(*pdims)) );
+
+ pdims[0] = (PDL_Long) ene;
+
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv("PDL", 0)));
+ PUTBACK;
+ perl_call_method("initialize", G_SCALAR);
+ SPAGAIN;
+ pxsv = POPs;
+ PUTBACK;
+ px = PDL->SvPDLV(pxsv);
+
+ PDL->converttype( &px, PDL_D, PDL_PERM );
+ PDL->children_changesoon(px,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED);
+ PDL->setdims (px,pdims,ndims);
+ px->state &= ~PDL_NOMYDIMS;
+ px->state |= PDL_ALLOCATED | PDL_DONTTOUCHDATA;
+ PDL->changed(px,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED,0);
+
+ px->data = (void *) xval;
+
+ /* get function name on the perl side */
+ funname = ext_funname1;
+
+ PUSHMARK(SP);
+
+ XPUSHs(pxsv);
+
+ PUTBACK;
+
+ count=call_sv(funname,G_SCALAR);
+
+
+ SPAGAIN;
+ SP -= count ;
+ ax = (SP - PL_stack_base) + 1 ;
+
+ if (count!=1)
+ croak("error calling perl function\n");
+
+ /* recover output value */
+
+
+ pvectorsv = ST(0);
+ pvector = PDL->SvPDLV(pvectorsv);
+
+ PDL->make_physical(pvector);
+
+ xpass = (double *) pvector->data;
+
+
+ for(i=0;i<ene;i++) {
+ vector[i] = xpass[i];
+ }
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+}
+
+
+int my_f (const gsl_vector * v, void * params, gsl_vector * df)
+{
+ double *dp = (double *)params;
+ int* nelem; int i;
+ double* xfree;
+ double* vector;
+
+ int iloop;
+
+ nelem = (int *) malloc(sizeof(int));
+ *nelem = (int) dp[0];
+
+ xfree = (double *) malloc(*nelem * sizeof(double));
+
+ vector = (double *) malloc(*nelem * sizeof(double));
+
+ for (iloop=0;iloop< *nelem;iloop++) {
+ xfree[iloop] = gsl_vector_get(v, iloop);
+ vector[iloop] = gsl_vector_get(v, iloop) * gsl_vector_get(v, iloop);
+ }
+
+
+ DFF(nelem, xfree, vector);
+
+ for (iloop=0;iloop< *nelem;iloop++) {
+ gsl_vector_set(df, iloop, vector[iloop]);
+ }
+
+
+ free(nelem);
+ free(xfree);
+ free(vector);
+ return GSL_SUCCESS ;
+
+}
+
+int
+print_state (size_t iter, gsl_multiroot_fsolver * s)
+{
+ printf ("iter = %3u x = % .3f % .3f "
+ "f(x) = % .3e % .3e\n",
+ iter,
+ gsl_vector_get (s->x, 0),
+ gsl_vector_get (s->x, 1),
+ gsl_vector_get (s->f, 0),
+ gsl_vector_get (s->f, 1));
+ return 1;
+}
+
+
+int fsolver (double *xfree, int nelem, double epsabs, int method)
+{
+
+ gsl_multiroot_fsolver_type *T;
+ gsl_multiroot_fsolver *s;
+
+ int status;
+ size_t i, iter = 0;
+
+ size_t n = nelem;
+ double p[1] = { nelem };
+ int iloop;
+
+ // struct func_params p = {1.0, 10.0};
+
+ gsl_multiroot_function func = {&my_f, n, p};
+
+ gsl_vector *x = gsl_vector_alloc (n);
+
+ for (iloop=0;iloop<nelem; iloop++) {
+ //printf("in fsovler2D, C side, input is %g \n",xfree[iloop]);
+ gsl_vector_set (x, iloop, xfree[iloop]);
+ }
+
+
+ switch (method){
+ case 0 : T = (gsl_multiroot_fsolver_type *) gsl_multiroot_fsolver_hybrids; break;
+ case 1 : T = (gsl_multiroot_fsolver_type *) gsl_multiroot_fsolver_hybrid; break;
+ case 2 : T = (gsl_multiroot_fsolver_type *) gsl_multiroot_fsolver_dnewton; break;
+ case 3 : T = (gsl_multiroot_fsolver_type *) gsl_multiroot_fsolver_broyden; break;
+ default: barf("Something is wrong: could not assing fsolver type...\n"); break;
+ }
+
+
+ s = gsl_multiroot_fsolver_alloc (T, nelem);
+
+
+ gsl_multiroot_fsolver_set (s, &func, x);
+
+
+ do
+ {
+ iter++;
+ //printf("GSL iter %d \n",iter);
+ status = gsl_multiroot_fsolver_iterate (s);
+
+ if (status) /* check if solver is stuck */
+ break;
+ status =
+ gsl_multiroot_test_residual (s->f, epsabs);
+ }
+ while (status == GSL_CONTINUE && iter < 1000);
+
+ if (status)
+ warn ("Final status = %s\n", gsl_strerror (status));
+
+ for (iloop=0;iloop<nelem; iloop++) {
+ xfree[iloop] = gsl_vector_get (s->x, iloop);
+ }
+
+ gsl_multiroot_fsolver_free (s);
+ gsl_vector_free (x);
+
+
+ return 0;
+
+}
diff --git a/Lib/GSL/MROOT/Makefile.PL b/Lib/GSL/MROOT/Makefile.PL
new file mode 100644
index 0000000..12cd87e
--- /dev/null
+++ b/Lib/GSL/MROOT/Makefile.PL
@@ -0,0 +1,110 @@
+# PDL interface to GSL differentation routines
+# Makefile.PL for a package defined by PP code.
+
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+my $msg = undef;
+my $forcebuild=0;
+my $skip = 0;
+
+# this Makefile uses get_gsl_libs which is defined in
+# the parent Makefile.PL
+
+sub gsl_mroot_links_ok {
+ my($lib,$inc) = @_;
+ return defined($lib) && defined($inc) &&
+ trylink 'gsl multidimensional root finding libraries',
+ << 'EOI',
+#include <stdio.h>
+#include <stdlib.h>
+#include <gsl/gsl_math.h>
+#include <gsl/gsl_errno.h>
+#include <gsl/gsl_vector.h>
+#include <gsl/gsl_multiroots.h>
+ struct rparams{
+ double a;
+ double b;
+ };
+ int rosenbrock_f (const gsl_vector * x, void *params,gsl_vector * f){
+ double a = ((struct rparams *) params)->a;
+ double b = ((struct rparams *) params)->b;
+ const double x0 = gsl_vector_get (x, 0);
+ const double x1 = gsl_vector_get (x, 1);
+ const double y0 = a * (1 - x0);
+ const double y1 = b * (x1 - x0 * x0);
+ gsl_vector_set (f, 0, y0);
+ gsl_vector_set (f, 1, y1);
+ return GSL_SUCCESS;
+ }
+EOI
+ << 'EOB', $lib, $inc;
+
+ const gsl_multiroot_fsolver_type *T;
+ gsl_multiroot_fsolver *s;
+ int status;
+ size_t i, iter = 0;
+ const size_t n = 2;
+ struct rparams p = {1.0, 10.0};
+ gsl_multiroot_function f = {&rosenbrock_f, n, &p};
+ double x_init[2] = {-10.0, -5.0};
+ gsl_vector *x = gsl_vector_alloc (n);
+ gsl_vector_set (x, 0, x_init[0]);
+ gsl_vector_set (x, 1, x_init[1]);
+
+ T = gsl_multiroot_fsolver_hybrids;
+ s = gsl_multiroot_fsolver_alloc (T, 2);
+ gsl_multiroot_fsolver_set (s, &f, x);
+
+ do
+ {
+ iter++;
+ status = gsl_multiroot_fsolver_iterate (s);
+ if (status)
+ break;
+ status =
+ gsl_multiroot_test_residual (s->f, 1e-7);
+ }
+ while (status == GSL_CONTINUE && iter < 1000);
+
+ gsl_multiroot_fsolver_free (s);
+ gsl_vector_free (x);
+ return 0;
+
+EOB
+}
+
+if (defined $PDL::Config{WITH_GSL} && $PDL::Config{WITH_GSL}==0) {
+ $msg = "\n Will skip build of PDL::GSL::MROOT on this system \n";
+ $skip = 1;
+} elsif (defined $PDL::Config{WITH_GSL} && $PDL::Config{WITH_GSL}==1) {
+ print "\n Will forcibly try and build PDL::GSL::MROOT on this system \n\n";
+ $forcebuild=1;
+}
+
+if (($skip && !$forcebuild) ||
+ !gsl_mroot_links_ok($GSL_libs, $GSL_includes)) {
+ warn "trying to force GSL build but link test failed\n".
+ "\t -- aborting GSL build\n" if $forcebuild;
+ $msg ||=
+ "\n GSL Libraries not found... Skipping build of PDL::GSL::MROOT.\n";
+ warn $msg . "\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ return;
+} else {
+ print "\n Building PDL::GSL::MROOT.",
+ "Turn off WITH_GSL if there are any problems\n\n";
+}
+
+ at pack = (["gsl_mroot.pd",MROOT,PDL::GSL::MROOT]);
+%hash = pdlpp_stdargs_int(@::pack);
+
+$hash{INC} .= " $GSL_includes";
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Lib/GSL/MROOT/gsl_mroot.pd b/Lib/GSL/MROOT/gsl_mroot.pd
new file mode 100644
index 0000000..7bfba3b
--- /dev/null
+++ b/Lib/GSL/MROOT/gsl_mroot.pd
@@ -0,0 +1,132 @@
+pp_bless('PDL::GSLMROOT');
+
+pp_add_exported('','gslmroot_fsolver');
+
+pp_addhdr('
+#include <math.h>
+#include "FUNC.c"
+
+');
+
+pp_addpm('
+sub gslmroot_fsolver{
+ my ($x, $f_vect) = @_;
+ my $opt;
+ if (ref($_[$#_]) eq \'HASH\'){ $opt = pop @_; }
+ else{ $opt = {Method => 0, EpsAbs => 1e-3}; }
+ if( (ref($x) ne \'PDL\')){
+ barf("Have to pass piddle as first argument to fsolver\n");
+ }
+ my $res = $x->copy;
+ fsolver_meat($res, $$opt{\'EpsAbs\'}, $$opt{\'Method\'}, $f_vect);
+ return $res;
+}
+');
+
+
+pp_def('fsolver_meat',
+ Pars => 'double xfree(n); double epsabs(); int method();',
+ OtherPars => 'SV* funcion1;',
+ Docs => undef,
+ Code =>'
+ext_funname1 = $COMP(funcion1);
+ene = $SIZE(n);
+fsolver($P(xfree), $SIZE(n), $epsabs(), $method());
+');
+
+pp_addpm({At=>Top},<<'EOD');
+
+
+=head1 NAME
+
+PDL::GSL::MROOT - PDL interface to multidimensional root-finding routines in GSL
+
+=head1 DESCRIPTION
+
+This is an interface to the multidimensional root-finding package present in the
+GNU Scientific Library.
+
+At the moment there is a single function B<gslmroot_fsolver> which provides an interface
+to the algorithms in the GSL library that do not use derivatives.
+
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::GSL::MROOT;
+
+ my $init = pdl (-10.00, -5.0);
+ my $epsabs = 1e-7;
+
+
+ $res = gslmroot_fsolver($init, \&rosenbrock,
+ {Method => 0, EpsAbs => $epsabs});
+
+
+ sub rosenbrock{
+ my ($x) = @_;
+ my $a = 1;
+ my $b = 10;
+ my $y = zeroes($x);
+
+ my $y0 = $y->slice(0);
+ $y0 .= $a * (1 - $x->slice(0));
+
+ my $y1 = $y->slice(1);
+ $y1 .= $b * ($x->slice(1) - $x->slice(0)**2);
+
+ return $y;
+ }
+
+
+=head1 FUNCTIONS
+
+=head2 gslmroot_fsolver -- Multidimensional root finder without using derivatives
+
+This function provides an interface to the multidimensional root finding algorithms
+in the GSL library. It takes a minimum of two argumennts: a piddle $init with an
+initial guess for the roots of the system and a reference to a function. The latter
+function must return a piddle whose i-th element is the i-th equation evaluated at
+the vector x (a piddle which is the sole input to this function). See the example in
+the Synopsis above for an illustration. The function returns a piddle with the roots
+for the system of equations.
+
+Two optional arguments can be specified as shown below. One is B<Method>, which can
+take the values 0,1,2,3. They correspond to the 'hybrids', 'hybrid', 'dnewton' and
+'broyden' algorithms respectively (see GSL documentation for details). The other
+optional argument is B<Epsabs>, which sets the absolute accuracy to which the roots
+of the system of equations are required. The default value for Method is 0 ('hybrids'
+algorithm) and the default for Epsabs is 1e-3.
+
+=for usage
+
+Usage:
+
+ $res = gslmroot_fsolver($init, $function_ref,
+ [{Method => $method, Epsabs => $epsabs}]);
+
+=for ref
+
+=head1 SEE ALSO
+
+L<PDL>
+
+The GSL documentation is online at
+
+ http://www.gnu.org/software/gsl/manual/
+
+
+=head1 AUTHOR
+
+This file copyright (C) 2006 Andres Jordan <ajordan at eso.org>
+and Simon Casassus <simon at das.uchile.cl>
+All rights reserved. There is no warranty. You are allowed to redistribute this
+software/documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+=cut
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/Makefile.PL b/Lib/GSL/Makefile.PL
new file mode 100644
index 0000000..30cbf9e
--- /dev/null
+++ b/Lib/GSL/Makefile.PL
@@ -0,0 +1,69 @@
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+# the real stuff happens in the subdirs
+#
+# DJB (12/30/03)
+# - would it not make sense to do all the checks here and just
+# write a dummy makefile if GSL support is not available
+# (as done with some of the other modules; or is it possible/desireable
+# to compile only some of the GSL modules here?)
+#
+sub get_gsl_libs {
+ warn << 'EOW' if ref $PDL::Config{GSL_LIBS};
+ The GSL_LIBS config variable must be a string (!)
+ not a reference. You should probably leave it undefined
+ and rely on gsl-config. Build will likely fail.
+EOW
+
+ my $lib = ($PDL::Config{GSL_LIBS} or
+ `gsl-config --libs` or
+ warn "\tno GSL link info (libgsl probably not available)\n");
+ my $inc = ($PDL::Config{GSL_INC} or
+ `gsl-config --cflags` or
+ warn "\tno GSL include info (libgsl probably not available)\n\n");
+ chomp $lib; chomp $inc;
+
+ # print STDERR "Lib: $lib\nInc: $inc\n";
+
+ return ($inc,$lib);
+}
+
+# these will be used in the subdirs
+($GSL_includes, $GSL_libs) = get_gsl_libs();
+
+# Version check
+my $MINVERSION = "1.3";
+my $version = `gsl-config --version`;
+chomp $version;
+my $new_enough = 0;
+
+if ($version =~ /^\s*$/) {
+ warn "\tno GSL version info found (gsl-config not installed?)\n\n";
+ $version = 'UNKNOWN VERSION';
+} else {
+ my @is_parts =split /\./,$version;
+ my @needed_parts=split /\./,$MINVERSION;
+
+ $needed_parts[-1]--;
+ for (my $i=0; $i<=$#needed_parts; $i++) {
+ my $is_part=(exists $is_parts[$i] ? $is_parts[$i] : 0);
+ $new_enough=($is_part > $needed_parts[$i]);
+ last if ($new_enough);
+ }
+}
+if (! $new_enough) {
+ warn "\n Not building GSL modules: GSL version $version found, need at least $MINVERSION\n\n";
+ write_dummy_make("Not building GSL modules: GSL version $version found, but need at least $MINVERSION");
+ $PDL::Config{WITH_GSL} = 0;
+} elsif ( defined($PDL::Config{WITH_GSL}) and ! $PDL::Config{WITH_GSL} ) {
+ warn "\n Not building GSL modules: WITH_GSL=> 0\n\n";
+ write_dummy_make("Not building GSL modules: WITH_GSL=> 0");
+} else {
+ $PDL::Config{WITH_GSL} = 1;
+ WriteMakefile(
+ 'NAME' => 'PDL::GSL',
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+ );
+}
+sub MY::postamble {}
diff --git a/Lib/GSL/RNG/Makefile.PL b/Lib/GSL/RNG/Makefile.PL
new file mode 100644
index 0000000..530c4c7
--- /dev/null
+++ b/Lib/GSL/RNG/Makefile.PL
@@ -0,0 +1,70 @@
+# PDL interface to GSL RNG and randist
+# Makefile.PL for a package defined by PP code.
+
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+my $msg = undef;
+my $forcebuild=0;
+my $skip = 0;
+
+# this Makefile uses get_gsl_libs which is defined in
+# the parent Makefile.PL
+
+sub gsl_rng_links_ok {
+ my($lib,$inc) = @_;
+ return defined($lib) && defined($inc) &&
+ trylink 'gsl rng libraries',
+ << 'EOI',
+#include <gsl/gsl_rng.h>
+#include <gsl/gsl_randist.h>
+EOI
+ << 'EOB', $lib, $inc;
+
+ const gsl_rng_type * T;
+ gsl_rng * r;
+ double mu = 3.0;
+
+ T = gsl_rng_default;
+ r = gsl_rng_alloc (T);
+ {
+ unsigned int k = gsl_ran_poisson (r, mu);
+ }
+
+EOB
+}
+
+if (defined $PDL::Config{WITH_GSL} && $PDL::Config{WITH_GSL}==0) {
+ $msg = "\n Will skip build of PDL::GSL::RNG on this system \n";
+ $skip = 1;
+} elsif (defined $PDL::Config{WITH_GSL} && $PDL::Config{WITH_GSL}==1) {
+ print "\n Will forcibly try and build PDL::GSL::RNG on this system \n\n";
+ $forcebuild=1;
+}
+
+if (($skip && !$forcebuild) ||
+ !gsl_rng_links_ok($GSL_libs, $GSL_includes)) {
+ warn "trying to force GSL build but link test failed\n".
+ "\t -- aborting GSL build\n" if $forcebuild;
+ $msg ||=
+ "\n GSL Libraries not found... Skipping build of PDL::GSL::RNG.\n";
+ warn $msg . "\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ return;
+} else {
+ print "\n Building PDL::GSL::RNG.",
+ "Turn off WITH_GSL if there are any problems\n\n";
+}
+
+ at pack = (["gsl_random.pd",RNG,PDL::GSL::RNG]);
+%hash = pdlpp_stdargs_int(@::pack);
+
+$hash{INC} .= " $GSL_includes";
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
diff --git a/Lib/GSL/RNG/README b/Lib/GSL/RNG/README
new file mode 100644
index 0000000..01fc4ae
--- /dev/null
+++ b/Lib/GSL/RNG/README
@@ -0,0 +1,10 @@
+PDL interface to GSL 1.X rng and randist functions.
+
+by Christian Pellegrin <chri at infis.univ.ts.it>, Copyleft, 1999
+see COPYING in the root of the PDL build tree.
+
+This is an interface to the random number generator part
+of the GNU Scientific Library. The documentation is
+in the .pd file and is automaticaly generated.
+
+
diff --git a/Lib/GSL/RNG/gsl_random.pd b/Lib/GSL/RNG/gsl_random.pd
new file mode 100644
index 0000000..dcec709
--- /dev/null
+++ b/Lib/GSL/RNG/gsl_random.pd
@@ -0,0 +1,1273 @@
+
+pp_bless('PDL::GSL::RNG'); # make the functions generated go into our namespace, and
+ # not PDL's namespace
+
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSL::RNG - PDL interface to RNG and randist routines in GSL
+
+=head1 DESCRIPTION
+
+This is an interface to the rng and randist packages present
+in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+ use PDL;
+ use PDL::GSL::RNG;
+
+ $rng = PDL::GSL::RNG->new('taus');
+
+ $rng->set_seed(time());
+
+ $a=zeroes(5,5,5)
+
+ $rng->get_uniform($a); # inplace
+
+ $b=$rng->get_uniform(3,4,5); # creates new pdl
+
+=head1 FUNCTIONS
+
+=head2 new()
+
+=for ref
+
+The new method initializes a new instance of the RNG.
+
+The avaible RNGs are:
+coveyou cmrg fishman18 fishman20 fishman2x gfsr4 knuthran
+knuthran2 knuthran2002 lecuyer21 minstd mrg mt19937 mt19937_1999
+mt19937_1998 r250 ran0 ran1 ran2 ran3 rand rand48 random128_bsd
+random128_glibc2 random128_libc5 random256_bsd random256_glibc2
+random256_libc5 random32_bsd random32_glibc2 random32_libc5
+random64_bsd random64_glibc2 random64_libc5 random8_bsd
+random8_glibc2 random8_libc5 random_bsd random_glibc2
+random_libc5 randu ranf ranlux ranlux389 ranlxd1 ranlxd2 ranlxs0
+ranlxs1 ranlxs2 ranmar slatec taus taus2 taus113 transputer tt800
+uni uni32 vax waterman14 zuf default
+The last one (default) uses the enviroment variable
+GSL_RNG_TYPE. Note that only a few of these rngs are recommended
+for general use. Please check the GSL documentation for more
+information.
+
+=for usage
+
+Usage:
+
+ $blessed_ref = PDL::GSL::RNG->new($RNG_name);
+
+Example:
+
+=for example
+
+ $rng = PDL::GSL::RNG->new('taus');
+
+=head2 set_seed();
+
+=for ref
+
+Sets the RNG seed.
+
+Usage:
+
+=for usage
+
+ $rng->set_seed($integer);
+
+Example:
+
+=for example
+
+ $rng->set_seed(666);
+
+=head2 min()
+
+=for ref
+
+Return the minimum value generable by this RNG.
+
+Usage:
+
+=for usage
+
+ $integer = $rng->min();
+
+Example:
+
+=for example
+
+ $min = $rng->min(); $max = $rng->max();
+
+=head2 max()
+
+=for ref
+
+Return the maximum value generable by the RNG.
+
+Usage:
+
+=for usage
+
+ $integer = $rng->max();
+
+Example:
+
+=for example
+
+ $min = $rng->min(); $max = $rng->max();
+
+=head2 name()
+
+=for ref
+
+Returns the name of the RNG.
+
+Usage:
+
+=for usage
+
+ $string = $rng->name();
+
+Example:
+
+=for example
+
+ $name = $rng->name();
+
+=head2 get_uniform()
+
+=for ref
+
+This function creates a piddle with given dimensions or accept an
+existing piddle and fills it. get_uniform() returns values 0<=x<1,
+
+Usage:
+
+=for usage
+
+ $piddle = $rng->get_uniform($list_of_integers)
+ $rng->get_uniform($piddle);
+
+Example:
+
+=for example
+
+ $a = zeroes 5,6; $max=100;
+ $o = $rng->get_uniform(10,10); $rng->get_uniform($a);
+
+=head2 get_uniform_pos()
+
+=for ref
+
+This function creates a piddle with given dimensions or accept an
+existing piddle and fills it. get_uniform_pos() returns values 0<x<1,
+
+Usage:
+
+=for usage
+
+ $piddle = $rng->get_uniform_pos($list_of_integers)
+ $rng->get_uniform_pos($piddle);
+
+Example:
+
+=for example
+
+ $a = zeroes 5,6;
+ $o = $rng->get_uniform_pos(10,10); $rng->get_uniform_pos($a);
+
+=head2 get()
+
+=for ref
+
+This function creates a piddle with given dimensions or accept an
+existing piddle and fills it. get() returns integer values
+beetween a minimum and a maximum specific to evry RNG.
+
+Usage:
+
+=for usage
+
+ $piddle = $rng->get($list_of_integers)
+ $rng->get($piddle);
+
+Example:
+
+=for example
+
+ $a = zeroes 5,6;
+ $o = $rng->get(10,10); $rng->get($a);
+
+=head2 get_int()
+
+=for ref
+
+This function creates a piddle with given dimensions or accept an
+existing piddle and fills it. get_int() returns integer values
+beetween 0 and $max.
+
+Usage:
+
+=for usage
+
+ $piddle = $rng->get($max, $list_of_integers)
+ $rng->get($max, $piddle);
+
+Example:
+
+=for example
+
+ $a = zeroes 5,6; $max=100;
+ $o = $rng->get(10,10); $rng->get($a);
+
+=head2 ran_gaussian()
+
+=for ref
+
+These functions return random deviates from given distribution.
+
+The general form is
+
+ ran_[distrib](args)
+
+where distrib can be any of the ones shown below.
+
+They accept the parameters of the distribution and a specification of
+where to put output. This spec can be in form of list of integers that
+specify the dimensions of the ouput piddle or an existing piddle that
+will be filled with values inplace.
+
+Usage:
+
+=for usage
+
+ # gaussian dist
+ $piddle = $rng->ran_gaussian($sigma,[list of integers]);
+ $rng->ran_gaussian($sigma,$piddle);
+
+ # gaussian tail
+ $piddle = $rng->ran_ugaussian_tail($tail,[list of integers]);
+ $rng->ran_ugaussian_tail($tail,$piddle);
+
+ # exponential dist
+ $piddle = $rng->ran_exponential($mu,[list of integers]);
+ $rng->ran_exponential($mu,$piddle);
+
+ # laplacian dist
+ $piddle = $rng->ran_laplace($mu,[list of integers]);
+ $rng->ran_laplace($mu,$piddle);
+
+ $piddle = $rng->ran_exppow($mu,$a,[list of integers]);
+ $rng->ran_exppow($mu,$a,$piddle);
+
+ $piddle = $rng->ran_cauchy($mu,[list of integers]);
+ $rng->ran_cauchy($mu,$piddle);
+
+ $piddle = $rng->ran_rayleigh($sigma,[list of integers]);
+ $rng->ran_rayleigh($sigma,$piddle);
+
+ $piddle = $rng->ran_rayleigh_tail($a,$sigma,[list of integers]);
+ $rng->ran_rayleigh_tail($a,$sigma,$piddle);
+
+ $piddle = $rng->ran_levy($mu,$a,[list of integers]);
+ $rng->ran_levy($mu,$a,$piddle);
+
+ $piddle = $rng->ran_gamma($a,$b,[list of integers]);
+ $rng->ran_gamma($a,$b,$piddle);
+
+ $piddle = $rng->ran_flat($a,$b,[list of integers]);
+ $rng->ran_flat($a,$b,$piddle);
+
+ $piddle = $rng->ran_lognormal($zeta, $sigma,[list of integers]);
+ $rng->ran_lognormal($zeta, $sigma,$piddle);
+
+ $piddle = $rng->ran_chisq($nu,[list of integers]);
+ $rng->ran_chisq($nu,$piddle);
+
+ $piddle = $rng->ran_fdist($nu1, $nu2,[list of integers]);
+ $rng->ran_fdist($nu1, $nu2,$piddle);
+
+ $piddle = $rng->ran_tdist($nu,[list of integers]);
+ $rng->ran_tdist($nu,$piddle);
+
+ $piddle = $rng->ran_beta($a,$b,[list of integers]);
+ $rng->ran_beta($a,$b,$piddle);
+
+ $piddle = $rng->ran_logistic($m,[list of integers]u)
+ $rng->ran_logistic($m,$piddleu)
+
+ $piddle = $rng->ran_pareto($a,$b,[list of integers]);
+ $rng->ran_pareto($a,$b,$piddle);
+
+ $piddle = $rng->ran_weibull($mu,$a,[list of integers]);
+ $rng->ran_weibull($mu,$a,$piddle);
+
+ $piddle = $rng->ran_gumbel1($a,$b,[list of integers]);
+ $rng->ran_gumbel1($a,$b,$piddle);
+
+ $piddle = $rng->ran_gumbel2($a,$b,[list of integers]);
+ $rng->ran_gumbel2($a,$b,$piddle);
+
+ $piddle = $rng->ran_poisson($mu,[list of integers]);
+ $rng->ran_poisson($mu,$piddle);
+
+ $piddle = $rng->ran_bernoulli($p,[list of integers]);
+ $rng->ran_bernoulli($p,$piddle);
+
+ $piddle = $rng->ran_binomial($p,$n,[list of integers]);
+ $rng->ran_binomial($p,$n,$piddle);
+
+ $piddle = $rng->ran_negative_binomial($p,$n,[list of integers]);
+ $rng->ran_negative_binomial($p,$n,$piddle);
+
+ $piddle = $rng->ran_pascal($p,$n,[list of integers]);
+ $rng->ran_pascal($p,$n,$piddle);
+
+ $piddle = $rng->ran_geometric($p,[list of integers]);
+ $rng->ran_geometric($p,$piddle);
+
+ $piddle = $rng->ran_hypergeometric($n1, $n2, $t,[list of integers]);
+ $rng->ran_hypergeometric($n1, $n2, $t,$piddle);
+
+ $piddle = $rng->ran_logarithmic($p,[list of integers]);
+ $rng->ran_logarithmic($p,$piddle);
+
+Example:
+
+=for example
+
+ $o = $rng->ran_gaussian($sigma,10,10);
+ $rng->ran_gaussian($sigma,$a);
+
+
+=head2 ran_gaussian_var()
+
+=for ref
+
+This method is similar to L<ran_[distrib]()|/ran_gaussian()> except that it
+takes the
+parameters of the distribution as a piddle and returns a piddle of equal
+dimensions. Of course, you can use the same set of distributions as in
+the previous method (see also the L<ran_gaussian|/ran_gaussian()> entry above).
+
+Usage:
+
+=for usage
+
+ $piddle = $rng->ran_[distribution]_var($distr_parameters_list,$piddle_dim_list);
+ $rng->ran_[distribution]_var($distr_parameters_list,$piddle);
+
+Example:
+
+=for example
+
+ $sigma_pdl = rvals zeroes 11,11;
+ $o = $rng->ran_gaussian_var($sigma_pdl);
+
+=head2 ran_additive_gaussian()
+
+=for ref
+
+Add Gaussian noise of given sigma to a piddle.
+
+Usage:
+
+=for usage
+
+ $rng->ran_additive_gaussian($sigma,$piddle);
+
+Example:
+
+=for example
+
+ $rng->ran_additive_gaussian(1,$image);
+
+=head2 ran_additive_poisson()
+
+=for ref
+
+Add Poisson noise of given sigma to a piddle.
+
+Usage:
+
+=for usage
+
+ $rng->ran_additive_poisson($mu,$piddle);
+
+Example:
+
+=for example
+
+ $rng->ran_additive_poisson(1,$image);
+
+=head2 ran_feed_poisson()
+
+=for ref
+
+This method simulates shot noise, taking the values of piddle as
+values for mu to be fed in the poissonian RNG.
+
+Usage:
+
+=for usage
+
+ $rng->ran_feed_poisson($piddle);
+
+Example:
+
+=for example
+
+ $rng->ran_feed_poisson($image);
+
+=head2 ran_bivariate_gaussian()
+
+=for ref
+
+Generates $n bivariate gaussian random deviates.
+
+Usage:
+
+=for usage
+
+ $piddle = $rng->ran_bivariate_gaussian($sigma_x,$sigma_y,$rho,$n);
+
+Example:
+
+=for example
+
+ $o = $rng->ran_bivariate_gaussian(1,2,0.5,1000);
+
+=head2 ran_dir()
+
+=for ref
+
+Returns C<$n> random vectors in C<$ndim> dimensions.
+
+Usage:
+
+=for usage
+
+ $piddle = $rng->ran_dir($ndim,$n);
+
+Example:
+
+=for example
+
+ $o = $rng->ran_dir($ndim,$n);
+
+=head2 ran_discrete_preproc()
+
+=for ref
+
+This method returns a handle that must be used when calling
+ran_discrete(). You specify the probability of the integer number
+that are returned by ran_discrete().
+
+Usage:
+
+=for usage
+
+ $discrete_dist_handle = $rng->ran_discrete_preproc($double_piddle_prob);
+
+Example:
+
+=for example
+
+ $prob = pdl [0.1,0.3,0.6];
+ $ddh = $rng->ran_discrete_preproc($prob);
+ $o = $rng->ran_discrete($discrete_dist_handle,100);
+
+=head2 ran_discrete()
+
+=for ref
+
+Is used to get the desired samples once a proper handle has been
+enstablished (see ran_discrete_preproc()).
+
+Usage:
+
+=for usage
+
+ $piddle = $rng->ran_discrete($discrete_dist_handle,$num);
+
+Example:
+
+=for example
+
+ $prob = pdl [0.1,0.3,0.6];
+ $ddh = $rng->ran_discrete_preproc($prob);
+ $o = $rng->ran_discrete($discrete_dist_handle,100);
+
+=head2 ran_shuffle()
+
+=for ref
+
+Shuffles values in piddle
+
+Usage:
+
+=for usage
+
+ $rng->ran_shuffle($piddle);
+
+=head2 ran_shuffle_vec()
+
+=for ref
+
+Shuffles values in piddle
+
+Usage:
+
+=for usage
+
+ $rng->ran_shuffle_vec(@vec);
+
+=head2 ran_choose()
+
+=for ref
+
+Chooses values from $inpiddle to $outpiddle.
+
+Usage:
+
+=for usage
+
+ $rng->ran_choose($inpiddle,$outpiddle);
+
+=head2 ran_choose_vec()
+
+=for ref
+
+Chooses $n values from @vec.
+
+Usage:
+
+=for usage
+
+ @choosen = $rng->ran_choose_vec($n, at vec);
+
+=head2 ran_ver()
+
+=for ref
+
+Returns a piddle with $n values generated by the Verhulst map from $x0 and
+paramater $r.
+
+Usage:
+
+=for usage
+
+ $rng->ran_ver($x0, $r, $n);
+
+=head2 ran_caos()
+
+=for ref
+
+Returns values from Verhuls map with $r=4.0 and randomly choosen
+$x0. The values are scaled by $m.
+
+Usage:
+
+=for usage
+
+ $rng->ran_caos($m,$n);
+
+=head1 BUGS
+
+Feedback is welcome. Log bugs in the PDL bug database (the
+database is always linked from L<http://pdl.perl.org/>).
+
+=head1 SEE ALSO
+
+L<PDL>
+
+The GSL documentation is online at
+L<http://www.gnu.org/software/gsl/manual/html_node/>
+
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+Docs mangled by C. Soeller. All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL RNG and randist modules were written by James Theiler.
+
+=cut
+
+
+EOD
+
+# PP interface to RNG
+
+
+##############################
+#
+# make_get_sub generates a wrapper PDL subroutine that handles the
+# fill-a-PDL and create-a-PDL cases for each of the GSL functions.
+# --CED
+#
+sub make_get_sub {
+ my ($fname,$par) =@_;
+ my $s;
+
+ $s = '
+sub ' . $fname . ' {
+my ($obj,' . $par . '@var) = @_;';
+
+ if ($par ne '') {
+ my $ss=$par;
+
+ $ss =~ s/,//;
+ $s .= 'if (!(' . $ss . '>0)) {barf("first parameter must be an int >0")};';
+ }
+
+$s .= 'if (ref($var[0]) eq \'PDL\') {
+ gsl_' . $fname . '_meat($var[0],' . $par . '$$obj);
+ return $var[0];
+}
+else {
+ my $p;
+
+ $p = zeroes @var;
+ gsl_' . $fname . '_meat($p,' . $par . '$$obj);
+ return $p;
+}
+}
+'
+}
+
+pp_addpm(<<'EOPM');
+
+use strict;
+
+# PDL::GSL::RNG::nullcreate just creates a null PDL. Used
+# for the GSL functions that create PDLs
+sub nullcreate{
+
+ my ($type,$arg) = @_;
+
+ PDL->nullcreate($arg);
+}
+EOPM
+
+pp_addpm(make_get_sub('get_uniform',''));
+pp_addpm(make_get_sub('get_uniform_pos',''));
+pp_addpm(make_get_sub('get',''));
+pp_addpm(make_get_sub('get_int','$n,'));
+
+pp_addhdr('
+#include <string.h>
+
+#include "gsl/gsl_rng.h"
+#include "gsl/gsl_randist.h"
+
+
+');
+
+sub pp_defnd { # hide the docs
+ my ($name, %hash) = @_;
+ pp_def($name,%hash,Doc=>undef);
+}
+
+pp_defnd(
+ 'gsl_get_uniform_meat',
+ Pars => '[o]a()',
+ GenericTypes => [F,D],
+ OtherPars => 'IV rng',
+ Code => '
+$a() = gsl_rng_uniform(INT2PTR(gsl_rng *, $COMP(rng)));');
+
+pp_defnd(
+ 'gsl_get_uniform_pos_meat',
+ Pars => '[o]a()',
+ GenericTypes => [F,D],
+ OtherPars => 'IV rng',
+ Code => '
+$a() = gsl_rng_uniform_pos(INT2PTR(gsl_rng *, $COMP(rng)));');
+
+pp_defnd(
+ 'gsl_get_meat',
+ Pars => '[o]a()',
+ OtherPars => 'IV rng',
+ Code => '
+$a() = gsl_rng_get(INT2PTR(gsl_rng *, $COMP(rng)));');
+
+pp_defnd(
+ 'gsl_get_int_meat',
+ Pars => '[o]a()',
+ OtherPars => 'int n; IV rng',
+ Code => '
+$a() = gsl_rng_uniform_int(INT2PTR(gsl_rng *, $COMP(rng)),$COMP(n));');
+
+# randist stuff
+
+sub add_randist {
+ my ($name,$npar) = @_;
+ my ($pars1,$fcall1,$arglist);
+
+ if ($npar==1) {
+ $pars1='double a; IV rng';
+ $fcall1='$COMP(a)';
+ $arglist='$a,';
+ $pars2='a()';
+ $fcall2='$a()';
+ }
+ if ($npar==2) {
+ $pars1='double a; double b; IV rng';
+ $fcall1='$COMP(a),$COMP(b)';
+ $arglist='$a,$b,';
+ $pars2='a();b()';
+ $fcall2='$a(),$b()';
+ }
+ if ($npar==3) {
+ $pars1='double a; double b; double c; IV rng';
+ $fcall1='$COMP(a),$COMP(b),$COMP(c)';
+ $arglist='$a,$b,$c,';
+ $pars2='a();b();c()';
+ $fcall2='$a(),$b(),$c()';
+ }
+
+ pp_defnd(
+ 'ran_' . $name . '_meat',
+ Pars => '[o]x()',
+ OtherPars => $pars1,
+ Code =>'
+$x() = gsl_ran_' . $name . '(INT2PTR(gsl_rng *, $COMP(rng)),' . $fcall1 . ');');
+
+ pp_addpm('
+sub ran_' . $name . ' {
+my ($obj,' . $arglist . '@var) = @_;
+if (ref($var[0]) eq \'PDL\') {
+ ran_' . $name . '_meat($var[0],' . $arglist . '$$obj);
+ return $var[0];
+}
+else {
+ my $p;
+
+ $p = zeroes @var;
+ ran_' . $name . '_meat($p,' . $arglist . '$$obj);
+ return $p;
+}
+}
+');
+
+ pp_defnd(
+ 'ran_' . $name . '_var_meat',
+ Pars => $pars2 . ';[o]x()',
+ OtherPars => 'IV rng',
+ Code =>'
+$x() = gsl_ran_' . $name . '(INT2PTR(gsl_rng *, $COMP(rng)),' . $fcall2 . ');');
+
+ pp_addpm('
+sub ran_' . $name . '_var {
+my ($obj, at var) = @_;
+ if (scalar(@var) != ' . $npar . ') {barf("Bad number of parameters!");}
+ return ran_' . $name . '_var_meat(@var,$$obj);
+}
+');
+
+# pp_defnd(
+# 'ran_' . $name . '_add_meat',
+# Pars => '[o]x()',
+# OtherPars => $pars1,
+# Code =>'
+#$x() += gsl_ran_' . $name . '(INT2PTR(gsl_rng *, $COMP(rng)),' . $fcall1 . ');');
+
+# pp_addpm('
+#sub ran_' . $name . '_add {
+#my ($obj,' . $arglist . '@var) = @_;
+#if (ref($var[0]) eq \'PDL\') {
+# PDL::ran_' . $name . '_add_meat($var[0],' . $arglist . '$$obj);
+# return $var[0];
+#}
+#else {
+# barf("In add mode you must specify a piddle!");
+#}
+#}
+#');
+
+# if ($npar==1) {
+# pp_defnd(
+# 'ran_' . $name . '_feed_meat',
+# Pars => '[o]x()',
+# OtherPars => 'IV rng',
+# Code =>'
+#$x() = gsl_ran_' . $name . '(INT2PTR(gsl_rng *, $COMP(rng)), $x());');
+
+# pp_addpm('
+#sub ran_' . $name . '_feed {
+#my ($obj, @var) = @_;
+#if (ref($var[0]) eq \'PDL\') {
+# PDL::ran_' . $name . '_feed_meat($var[0], $$obj);
+# return $var[0];
+#}
+#else {
+# barf("In feed mode you must specify a piddle!");
+#}
+#}
+#');
+# }
+
+}
+
+add_randist('gaussian',1);
+add_randist('ugaussian_tail',1);
+add_randist('exponential',1);
+add_randist('laplace',1);
+add_randist('exppow',2);
+add_randist('cauchy',1);
+add_randist('rayleigh',1);
+add_randist('rayleigh_tail',2);
+add_randist('levy',2);
+add_randist('gamma',2);
+add_randist('flat',2);
+add_randist('lognormal',2);
+add_randist('chisq',1);
+add_randist('fdist',2);
+add_randist('tdist',1);
+add_randist('beta',2);
+add_randist('logistic',1);
+add_randist('pareto',2);
+add_randist('weibull',2);
+add_randist('gumbel1',2);
+add_randist('gumbel2',2);
+add_randist('poisson',1);
+add_randist('bernoulli',1);
+add_randist('binomial',2);
+add_randist('negative_binomial',2);
+add_randist('pascal',2);
+add_randist('geometric',1);
+add_randist('hypergeometric',3);
+add_randist('logarithmic',1);
+
+# specific rnadist
+
+pp_defnd(
+ 'ran_additive_gaussian_meat',
+ Pars => ';[o]x()',
+ OtherPars => 'double sigma; IV rng',
+ Code =>'$x() += gsl_ran_gaussian(INT2PTR(gsl_rng *, $COMP(rng)), $COMP(sigma));');
+
+pp_addpm('
+ sub ran_additive_gaussian {
+ my ($obj,$sigma, at var) = @_;
+ if (ref($var[0]) eq \'PDL\') {
+ ran_additive_gaussian_meat($var[0],$sigma,$$obj);
+ return $var[0];
+ }
+ else {
+ barf("In additive gaussian mode you must specify a piddle!");
+ }
+ }
+ ');
+
+pp_defnd(
+ 'ran_additive_poisson_meat',
+ Pars => ';[o]x()',
+ OtherPars => 'double sigma; IV rng',
+ Code =>'$x() += gsl_ran_poisson(INT2PTR(gsl_rng *, $COMP(rng)), $COMP(sigma));');
+
+pp_addpm('
+ sub ran_additive_poisson {
+ my ($obj,$sigma, at var) = @_;
+ if (ref($var[0]) eq \'PDL\') {
+ ran_additive_poisson_meat($var[0],$sigma,$$obj);
+ return $var[0];
+ }
+ else {
+ barf("In additive poisson mode you must specify a piddle!");
+ }
+ }
+ ');
+
+pp_defnd(
+ 'ran_feed_poisson_meat',
+ Pars => ';[o]x()',
+ OtherPars => 'IV rng',
+ Code =>'$x() = gsl_ran_poisson(INT2PTR(gsl_rng *, $COMP(rng)), $x());');
+
+pp_addpm('
+ sub ran_feed_poisson {
+ my ($obj, at var) = @_;
+ if (ref($var[0]) eq \'PDL\') {
+ ran_feed_poisson_meat($var[0],$$obj);
+ return $var[0];
+ }
+ else {
+ barf("In poisson mode you must specify a piddle!");
+ }
+ }
+ ');
+
+pp_defnd(
+ 'ran_bivariate_gaussian_meat',
+ Pars => ';[o]x(n)',
+ OtherPars => 'double sigma_x; double sigma_y; double rho; IV rng',
+ Code =>'
+double xx,yy;
+gsl_ran_bivariate_gaussian(INT2PTR(gsl_rng *, $COMP(rng)), $COMP(sigma_x), $COMP(sigma_y),$COMP(rho), &xx, &yy);
+$x(n=>0)=xx;
+$x(n=>1)=yy;
+');
+
+pp_addpm('
+ sub ran_bivariate_gaussian {
+ my ($obj,$sigma_x,$sigma_y,$rho,$n) = @_;
+ if ($n>0) {
+ my $p = zeroes(2,$n);
+ ran_bivariate_gaussian_meat($p,$sigma_x,$sigma_y,$rho,$$obj);
+ return $p;
+ }
+ else {
+ barf("Not enough parameters for gaussian bivariate!");
+ }
+ }
+ ');
+
+pp_defnd(
+ 'ran_dir_2d_meat',
+ Pars => ';[o]x(n)',
+ OtherPars => 'IV rng',
+ Code =>'
+double xx,yy;
+gsl_ran_dir_2d(INT2PTR(gsl_rng *, $COMP(rng)), &xx, &yy);
+$x(n=>0)=xx;
+$x(n=>1)=yy;
+');
+
+pp_defnd(
+ 'ran_dir_3d_meat',
+ Pars => ';[o]x(n)',
+ OtherPars => 'IV rng',
+ Code =>'
+double xx,yy,zz;
+gsl_ran_dir_3d(INT2PTR(gsl_rng *, $COMP(rng)), &xx, &yy, &zz);
+$x(n=>0)=xx;
+$x(n=>1)=yy;
+$x(n=>2)=zz;
+');
+
+$MAX_DIMENSIONS = 100;
+
+pp_defnd(
+ 'ran_dir_nd_meat',
+ Pars => ';[o]x(n)',
+ OtherPars => 'int ns => n; IV rng',
+ Code =>'
+double xxx[' . $MAX_DIMENSIONS .'];
+gsl_ran_dir_nd(INT2PTR(gsl_rng *, $COMP(rng)), $COMP(ns), xxx);
+loop (n) %{ $x() = xxx[n]; %}');
+
+pp_addpm('
+ sub ran_dir {
+ my ($obj,$ndim,$n) = @_;
+ if ($n>0) {
+ my $p = zeroes($ndim,$n);
+ if ($ndim==2) { ran_dir_2d_meat($p,$$obj); }
+ elsif ($ndim==3) { ran_dir_3d_meat($p,$$obj); }
+ elsif ($ndim>=4 && $ndim<=' . $MAX_DIMENSIONS . ') { ran_dir_nd_meat($p,$ndim,$$obj); }
+ else { barf("Bad number of dimensions!"); }
+ return $p;
+ }
+ else {
+ barf("Not enough parameters for random vectors!");
+ }
+ }
+ ');
+
+pp_defnd(
+ 'ran_discrete_meat',
+ Pars => ';[o]x()',
+ OtherPars => 'IV rng_discrete; IV rng',
+ Code =>'
+$x()=gsl_ran_discrete(INT2PTR(gsl_rng *, $COMP(rng)), INT2PTR(gsl_ran_discrete_t *, $COMP(rng_discrete))); ');
+
+ pp_addpm('
+sub ran_discrete {
+my ($obj, $rdt, @var) = @_;
+if (ref($var[0]) eq \'PDL\') {
+ ran_discrete_meat($var[0], $$rdt, $$obj);
+ return $var[0];
+}
+else {
+ my $p;
+
+ $p = zeroes @var;
+ ran_discrete_meat($p, $$rdt, $$obj);
+ return $p;
+}
+}
+');
+
+ pp_addpm('
+sub ran_shuffle_vec {
+my ($obj, at in) = @_;
+my (@out,$i,$p);
+
+$p = long [0..$#in];
+$obj->ran_shuffle($p);
+for($i=0;$i<scalar(@in);$i++) {
+$out[$p->at($i)]=$in[$i];
+}
+return @out;
+}
+');
+
+ pp_addpm('
+sub ran_choose_vec {
+my ($obj,$nout, at in) = @_;
+my (@out,$i,$pin,$pout);
+
+$pin = long [0..$#in];
+$pout = long [0..($nout-1)];
+$obj->ran_choose($pin,$pout);
+for($i=0;$i<$nout;$i++) {
+$out[$i]=$in[$pout->at($i)];
+}
+return @out;
+}
+');
+
+
+pp_defnd(
+ 'ran_ver_meat',
+ Pars => ';[o]x(n)',
+ OtherPars => 'double x0; double r;int ns => n; IV rng',
+ Code =>'
+double xx=$COMP(x0);
+
+loop (n) %{ $x() = xx; xx = $COMP(r)*(1-xx)*xx; %}');
+
+pp_defnd(
+ 'ran_caos_meat',
+ Pars => ';[o]x(n)',
+ OtherPars => 'double m; int ns => n; IV rng',
+ Code =>'
+double xx=gsl_ran_gaussian(INT2PTR(gsl_rng *, $COMP(rng)),0.1)+0.5;
+
+loop (n) %{ $x() = (xx-0.5)*$COMP(m); xx = 4.0*(1-xx)*xx; %}');
+
+pp_addpm('
+ sub ran_ver {
+ my ($obj,$x0,$r,$n) = @_;
+ if ($n>0) {
+ my $p = zeroes($n);
+ ran_ver_meat($p,$x0,$r,$n,$$obj);
+ return $p;
+ }
+ else {
+ barf("Not enough parameters for ran_ver!");
+ }
+ }
+ ');
+
+pp_addpm('
+ sub ran_caos {
+ my ($obj,$m,$n) = @_;
+ if ($n>0) {
+ my $p = zeroes($n);
+ ran_caos_meat($p,$m,$n,$$obj);
+ return $p;
+ }
+ else {
+ barf("Not enough parameters for ran_caos!");
+ }
+ }
+ ');
+
+# XS function for the RNG object
+
+pp_addxs('','
+MODULE = PDL::GSL::RNG PACKAGE = PDL::GSL::RNG
+
+#define DEF_RNG(X) if (!strcmp(TYPE,#X)) rng=gsl_rng_alloc( gsl_rng_ ## X ); strcat(rngs,#X ", ");
+
+gsl_rng *
+new (CLASS,TYPE)
+ char *CLASS
+ char *TYPE
+ CODE:
+ gsl_rng * rng = NULL;
+ char rngs[5000];
+strcpy(rngs,"");
+DEF_RNG(borosh13)
+DEF_RNG(coveyou)
+DEF_RNG(cmrg)
+DEF_RNG(fishman18)
+DEF_RNG(fishman20)
+DEF_RNG(fishman2x)
+DEF_RNG(gfsr4)
+DEF_RNG(knuthran)
+DEF_RNG(knuthran2)
+DEF_RNG(knuthran2002)
+DEF_RNG(lecuyer21)
+DEF_RNG(minstd)
+DEF_RNG(mrg)
+DEF_RNG(mt19937)
+DEF_RNG(mt19937_1999)
+DEF_RNG(mt19937_1998)
+DEF_RNG(r250)
+DEF_RNG(ran0)
+DEF_RNG(ran1)
+DEF_RNG(ran2)
+DEF_RNG(ran3)
+DEF_RNG(rand)
+DEF_RNG(rand48)
+DEF_RNG(random128_bsd)
+DEF_RNG(random128_glibc2)
+DEF_RNG(random128_libc5)
+DEF_RNG(random256_bsd)
+DEF_RNG(random256_glibc2)
+DEF_RNG(random256_libc5)
+DEF_RNG(random32_bsd)
+DEF_RNG(random32_glibc2)
+DEF_RNG(random32_libc5)
+DEF_RNG(random64_bsd)
+DEF_RNG(random64_glibc2)
+DEF_RNG(random64_libc5)
+DEF_RNG(random8_bsd)
+DEF_RNG(random8_glibc2)
+DEF_RNG(random8_libc5)
+DEF_RNG(random_bsd)
+DEF_RNG(random_glibc2)
+DEF_RNG(random_libc5)
+DEF_RNG(randu)
+DEF_RNG(ranf)
+DEF_RNG(ranlux)
+DEF_RNG(ranlux389)
+DEF_RNG(ranlxd1)
+DEF_RNG(ranlxd2)
+DEF_RNG(ranlxs0)
+DEF_RNG(ranlxs1)
+DEF_RNG(ranlxs2)
+DEF_RNG(ranmar)
+DEF_RNG(slatec)
+DEF_RNG(taus)
+DEF_RNG(taus2)
+DEF_RNG(taus113)
+DEF_RNG(transputer)
+DEF_RNG(tt800)
+DEF_RNG(uni)
+DEF_RNG(uni32)
+DEF_RNG(vax)
+DEF_RNG(waterman14)
+DEF_RNG(zuf)
+DEF_RNG(default)
+ if (rng==NULL) {
+ barf("Unknown RNG, plese use one of the following: %s", rngs);
+ }
+ else
+ RETVAL = rng;
+ OUTPUT:
+ RETVAL
+
+void
+set_seed(rng, seed)
+ gsl_rng * rng
+ int seed
+ CODE:
+ gsl_rng_set(rng,seed);
+
+unsigned int
+min(rng)
+ gsl_rng * rng
+ CODE:
+ RETVAL = gsl_rng_min(rng);
+ OUTPUT:
+ RETVAL
+
+unsigned int
+max(rng)
+ gsl_rng * rng
+ CODE:
+ RETVAL = gsl_rng_max(rng);
+ OUTPUT:
+ RETVAL
+
+char*
+name(rng)
+ gsl_rng * rng
+ CODE:
+ RETVAL = (char *) gsl_rng_name(rng);
+ OUTPUT:
+ RETVAL
+
+void
+DESTROY(sv)
+ SV * sv
+ CODE:
+ gsl_rng *rng = INT2PTR(gsl_rng *, SvIV((SV*)SvRV(sv)));
+ /* fprintf(stderr,"Freeing %d\n",rng); */
+ gsl_rng_free((gsl_rng *) rng);
+
+gsl_ran_discrete_t *
+ran_discrete_preproc(rng, p)
+ gsl_rng * rng
+ pdl * p
+ CODE:
+ int n;
+
+ if (p->ndims!=1 || p->datatype!=PDL_D) {
+ barf("Bad input to ran_discrete_preproc!");
+ }
+ n = p->dims[0];
+ PDL->make_physical(p);
+ RETVAL = gsl_ran_discrete_preproc(n,(double *) p->data);
+ OUTPUT:
+ RETVAL
+
+void
+ran_shuffle(rng, in)
+ gsl_rng * rng
+ pdl * in
+ CODE:
+ int size, n;
+
+ n = in->nvals;
+ PDL->make_physical(in);
+ switch(in->datatype) {
+ case PDL_B: size=sizeof(PDL_Byte); break;
+ case PDL_S: size=sizeof(PDL_Short); break;
+ case PDL_US: size=sizeof(PDL_Ushort); break;
+ case PDL_L: size=sizeof(PDL_Long); break;
+ case PDL_F: size=sizeof(PDL_Float); break;
+ case PDL_D: size=sizeof(PDL_Double); break;
+ }
+ gsl_ran_shuffle(rng,(double *) in->data,n,size);
+
+void
+ran_choose(rng, in, out)
+ gsl_rng * rng
+ pdl * in
+ pdl * out
+ CODE:
+ int size, n,m;
+
+ n = in->nvals;
+ m = out->nvals;
+ if (in->datatype != out->datatype) barf("Data Types must match for ran_chooser");
+ PDL->make_physical(in);
+ PDL->make_physical(out);
+ switch(in->datatype) {
+ case PDL_B: size=sizeof(PDL_Byte); break;
+ case PDL_S: size=sizeof(PDL_Short); break;
+ case PDL_US: size=sizeof(PDL_Ushort); break;
+ case PDL_L: size=sizeof(PDL_Long); break;
+ case PDL_F: size=sizeof(PDL_Float); break;
+ case PDL_D: size=sizeof(PDL_Double); break;
+ }
+ gsl_ran_choose(rng,(double *) out->data, m, (double *) in->data,n,size);
+
+');
+
+
+pp_core_importList(' qw/ zeroes long barf /'); # import just a named list to our namespace, so we don't get warning
+ # messages like 'warning 'min' redefined at line ...'
+
+pp_export_nothing; # set to not export anything. (This is a OO package, it doesn't need to export any methods.)
+
+pp_done();
diff --git a/Lib/GSL/RNG/typemap b/Lib/GSL/RNG/typemap
new file mode 100644
index 0000000..d7c3505
--- /dev/null
+++ b/Lib/GSL/RNG/typemap
@@ -0,0 +1,12 @@
+TYPEMAP
+gsl_rng * ANY_OBJ
+gsl_ran_discrete_t * T_PTROBJ
+
+OUTPUT
+ANY_OBJ
+ sv_setref_pv($arg, CLASS, (void *) $var);
+
+INPUT
+ANY_OBJ
+ $var = INT2PTR($type, SvIV((SV*)SvRV($arg)))
+
diff --git a/Lib/GSL/SF/Makefile.PL b/Lib/GSL/SF/Makefile.PL
new file mode 100644
index 0000000..7404d98
--- /dev/null
+++ b/Lib/GSL/SF/Makefile.PL
@@ -0,0 +1,60 @@
+# PDL interface to GSL Special functions
+# Makefile.PL for a package defined by PP code.
+
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+sub gsl_sf_links_ok {
+ my($lib,$inc) = @_;
+ return defined($lib) && defined($inc) &&
+ trylink 'gsl SF libraries',
+ << 'EOI',
+#include <gsl/gsl_sf_bessel.h>
+EOI
+ << 'EOB', $lib, $inc;
+
+ double x = 5.0;
+ double expected = -0.17759677131433830434739701;
+
+ double y = gsl_sf_bessel_J0 (x);
+
+ return 0;
+
+EOB
+}
+
+$skip = 0;
+$msg = undef;
+$forcebuild=0;
+
+if (defined $PDL::Config{WITH_GSL} && $PDL::Config{WITH_GSL}==0) {
+ $msg = "\n Will skip build of PDL::GSLSF on this system \n";
+ $skip = 1;
+} elsif (defined $PDL::Config{WITH_GSL} && $PDL::Config{WITH_GSL}==1) {
+ print "\n Will forcibly try and build PDL::GSLSF on this system \n\n";
+ $forcebuild=1;
+}
+
+if (($skip && !$forcebuild) ||
+ !gsl_sf_links_ok($GSL_libs, $GSL_includes)) {
+ warn "trying to force GSL build but link test failed\n".
+ "\t -- aborting GSL build\n" if $forcebuild;
+ $msg ||=
+ "\n GSL Libraries not found... Skipping build of PDL::GSLSF.\n";
+ warn $msg . "\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ return;
+} else {
+ print "\n Building PDL::GSLSF.",
+ "Turn off WITH_GSL if there are any problems\n\n";
+}
+
+WriteMakefile(
+ 'NAME' => 'PDL::GSLSF',
+ VERSION => '0.5',
+ # VERSION_FROM => '../../Basic/Core/Version.pm',
+ #DIR => [ qw/airy bessel chebyshev clausen coulomb coupling dawson debye dilog elementary ellint elljac erf exp expint fermi_dirac gamma gegenbauer hyperg laguerre legendre log poly pow_int psi synchrotron transport trig zeta/ ],
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
diff --git a/Lib/GSL/SF/README b/Lib/GSL/SF/README
new file mode 100644
index 0000000..465f8ea
--- /dev/null
+++ b/Lib/GSL/SF/README
@@ -0,0 +1,14 @@
+This is a port of the original PDL GSL Special Functions interface by
+Christian Pellegrin <chri at infis.univ.trieste.it> to GSL 1.x. Only some
+minor tweaks were necessary to get it going but documentation and
+testing is in dire need of improvement!
+
+We need:
+
+ - an example for every function (C<=for example> section in docs).
+
+ - a test for every function (to go into t/gsl_sf.t)
+
+Patches by GSL SF users are most welcome!
+
+2002 Christian Soeller
diff --git a/Lib/GSL/SF/airy/Makefile.PL b/Lib/GSL/SF/airy/Makefile.PL
new file mode 100644
index 0000000..6906325
--- /dev/null
+++ b/Lib/GSL/SF/airy/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+
+ at pack = (['gsl_sf_airy.pd','AIRY','PDL::GSLSF::AIRY']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/airy/gsl_sf_airy.pd b/Lib/GSL/SF/airy/gsl_sf_airy.pd
new file mode 100644
index 0000000..41f8e41
--- /dev/null
+++ b/Lib/GSL/SF/airy/gsl_sf_airy.pd
@@ -0,0 +1,138 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::AIRY - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_airy_Ai',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_airy_Ai_e,($x(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Airy Function Ai(x).'
+ );
+
+pp_def('gsl_sf_airy_Bi',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_airy_Bi_e,($x(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Airy Function Bi(x).'
+ );
+
+pp_def('gsl_sf_airy_Ai_scaled',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_airy_Ai_scaled_e,($x(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Scaled Airy Function Ai(x). Ai(x) for x < 0 and exp(+2/3 x^{3/2}) Ai(x) for x > 0.'
+ );
+
+pp_def('gsl_sf_airy_Bi_scaled',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_airy_Bi_scaled_e,($x(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Scaled Airy Function Bi(x). Bi(x) for x < 0 and exp(+2/3 x^{3/2}) Bi(x) for x > 0.'
+ );
+
+pp_def('gsl_sf_airy_Ai_deriv',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_airy_Ai_deriv_e,($x(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Derivative Airy Function Ai`(x).'
+ );
+
+pp_def('gsl_sf_airy_Bi_deriv',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_airy_Bi_deriv_e,($x(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Derivative Airy Function Bi`(x).'
+ );
+
+pp_def('gsl_sf_airy_Ai_deriv_scaled',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_airy_Ai_deriv_scaled_e,($x(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Derivative Scaled Airy Function Ai(x). Ai`(x) for x < 0 and exp(+2/3 x^{3/2}) Ai`(x) for x > 0.'
+ );
+
+pp_def('gsl_sf_airy_Bi_deriv_scaled',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_airy_Bi_deriv_scaled_e,($x(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Derivative Scaled Airy Function Bi(x). Bi`(x) for x < 0 and exp(+2/3 x^{3/2}) Bi`(x) for x > 0.'
+ );
+
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/bessel/Makefile.PL b/Lib/GSL/SF/bessel/Makefile.PL
new file mode 100644
index 0000000..1e43f91
--- /dev/null
+++ b/Lib/GSL/SF/bessel/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+
+ at pack = (['gsl_sf_bessel.pd','BESSEL','PDL::GSLSF::BESSEL']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/bessel/gsl_sf_bessel.pd b/Lib/GSL/SF/bessel/gsl_sf_bessel.pd
new file mode 100644
index 0000000..7ab655f
--- /dev/null
+++ b/Lib/GSL/SF/bessel/gsl_sf_bessel.pd
@@ -0,0 +1,364 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::BESSEL - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_bessel_Jn',
+ GenericTypes => [D],
+ OtherPars =>'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_Jn_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Regular Bessel Function J_n(x).'
+ );
+
+pp_def('gsl_sf_bessel_J_array',
+ GenericTypes => [D],
+ OtherPars =>'int s; int n=>num',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_bessel_Jn_array,($COMP(s),$COMP(s)+$COMP(n)-1,$x(),$P(y)))
+',
+ Doc =>'Array of Regular Bessel Functions J_{s}(x) to J_{s+n-1}(x).'
+ );
+
+pp_def('gsl_sf_bessel_Yn',
+ GenericTypes => [D],
+ OtherPars =>'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_Yn_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'IrRegular Bessel Function Y_n(x).'
+ );
+
+pp_def('gsl_sf_bessel_Y_array',
+ GenericTypes => [D],
+ OtherPars =>'int s; int n=>num',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_bessel_Yn_array,($COMP(s),$COMP(s)+$COMP(n)-1,$x(),$P(y)))
+',
+ Doc =>'Array of Regular Bessel Functions Y_{s}(x) to Y_{s+n-1}(x).'
+ );
+
+pp_def('gsl_sf_bessel_In',
+ GenericTypes => [D],
+ OtherPars =>'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_In_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Regular Modified Bessel Function I_n(x).'
+ );
+
+pp_def('gsl_sf_bessel_I_array',
+ GenericTypes => [D],
+ OtherPars =>'int s; int n=>num',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_bessel_In_array,($COMP(s),$COMP(s)+$COMP(n)-1,$x(),$P(y)))
+',
+ Doc =>'Array of Regular Modified Bessel Functions I_{s}(x) to I_{s+n-1}(x).'
+ );
+
+pp_def('gsl_sf_bessel_In_scaled',
+ GenericTypes => [D],
+ OtherPars =>'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_In_scaled_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Scaled Regular Modified Bessel Function exp(-|x|) I_n(x).'
+ );
+
+pp_def('gsl_sf_bessel_I_scaled_array',
+ GenericTypes => [D],
+ OtherPars =>'int s; int n=>num',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_bessel_In_scaled_array,($COMP(s),$COMP(s)+$COMP(n)-1,$x(),$P(y)))
+',
+ Doc =>'Array of Scaled Regular Modified Bessel Functions exp(-|x|) I_{s}(x) to exp(-|x|) I_{s+n-1}(x).'
+ );
+
+pp_def('gsl_sf_bessel_Kn',
+ GenericTypes => [D],
+ OtherPars =>'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_Kn_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'IrRegular Modified Bessel Function K_n(x).'
+ );
+
+pp_def('gsl_sf_bessel_K_array',
+ GenericTypes => [D],
+ OtherPars =>'int s; int n=>num',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_bessel_Kn_array,($COMP(s),$COMP(s)+$COMP(n)-1,$x(),$P(y)))
+',
+ Doc =>'Array of IrRegular Modified Bessel Functions K_{s}(x) to K_{s+n-1}(x).'
+ );
+
+pp_def('gsl_sf_bessel_Kn_scaled',
+ GenericTypes => [D],
+ OtherPars =>'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_Kn_scaled_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Scaled IrRegular Modified Bessel Function exp(-|x|) K_n(x).'
+ );
+
+pp_def('gsl_sf_bessel_K_scaled_array',
+ GenericTypes => [D],
+ OtherPars =>'int s; int n=>num',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_bessel_Kn_scaled_array,($COMP(s),$COMP(s)+$COMP(n)-1,$x(),$P(y)))
+',
+ Doc =>'Array of Scaled IrRegular Modified Bessel Functions exp(-|x|) K_{s}(x) to exp(-|x|) K_{s+n-1}(x).'
+ );
+
+pp_def('gsl_sf_bessel_jl',
+ GenericTypes => [D],
+ OtherPars =>'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_jl_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Regular Sphericl Bessel Function J_n(x).'
+ );
+
+pp_def('gsl_sf_bessel_j_array',
+ GenericTypes => [D],
+ OtherPars =>'int n=>num',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_bessel_jl_array,($COMP(n)-1,$x(),$P(y)))
+',
+ Doc =>'Array of Spherical Regular Bessel Functions J_{0}(x) to J_{n-1}(x).'
+ );
+
+pp_def('gsl_sf_bessel_yl',
+ GenericTypes => [D],
+ OtherPars =>'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_yl_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'IrRegular Spherical Bessel Function y_n(x).'
+ );
+
+pp_def('gsl_sf_bessel_y_array',
+ GenericTypes => [D],
+ OtherPars =>'int n=>num',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_bessel_yl_array,($COMP(n)-1,$x(),$P(y)))
+',
+ Doc =>'Array of Regular Spherical Bessel Functions y_{0}(x) to y_{n-1}(x).'
+ );
+
+pp_def('gsl_sf_bessel_il_scaled',
+ GenericTypes => [D],
+ OtherPars =>'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_il_scaled_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Scaled Regular Modified Spherical Bessel Function exp(-|x|) i_n(x).'
+ );
+
+pp_def('gsl_sf_bessel_i_scaled_array',
+ GenericTypes => [D],
+ OtherPars =>'int n=>num',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_bessel_il_scaled_array,($COMP(n)-1,$x(),$P(y)))
+',
+ Doc =>'Array of Scaled Regular Modified Spherical Bessel Functions exp(-|x|) i_{0}(x) to exp(-|x|) i_{n-1}(x).'
+ );
+
+pp_def('gsl_sf_bessel_kl_scaled',
+ GenericTypes => [D],
+ OtherPars =>'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_kl_scaled_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Scaled IrRegular Modified Spherical Bessel Function exp(-|x|) k_n(x).'
+ );
+
+pp_def('gsl_sf_bessel_k_scaled_array',
+ GenericTypes => [D],
+ OtherPars =>'int n=>num',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_bessel_kl_scaled_array,($COMP(n)-1,$x(),$P(y)))
+',
+ Doc =>'Array of Scaled IrRegular Modified Spherical Bessel Functions exp(-|x|) k_{s}(x) to exp(-|x|) k_{s+n-1}(x).'
+ );
+
+pp_def('gsl_sf_bessel_Jnu',
+ GenericTypes => [D],
+ OtherPars =>'double n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_Jnu_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Regular Cylindrical Bessel Function J_nu(x).'
+ );
+
+pp_def('gsl_sf_bessel_Ynu',
+ GenericTypes => [D],
+ OtherPars =>'double n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_Ynu_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'IrRegular Cylindrical Bessel Function J_nu(x).'
+ );
+
+pp_def('gsl_sf_bessel_Inu_scaled',
+ GenericTypes => [D],
+ OtherPars =>'double n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_Inu_scaled_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Scaled Modified Cylindrical Bessel Function exp(-|x|) I_nu(x).'
+ );
+
+pp_def('gsl_sf_bessel_Inu',
+ GenericTypes => [D],
+ OtherPars =>'double n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_Inu_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Modified Cylindrical Bessel Function I_nu(x).'
+ );
+
+pp_def('gsl_sf_bessel_Knu_scaled',
+ GenericTypes => [D],
+ OtherPars =>'double n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_Knu_scaled_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Scaled Modified Cylindrical Bessel Function exp(-|x|) K_nu(x).'
+ );
+
+pp_def('gsl_sf_bessel_Knu',
+ GenericTypes => [D],
+ OtherPars =>'double n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_Knu_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Modified Cylindrical Bessel Function K_nu(x).'
+ );
+
+pp_def('gsl_sf_bessel_lnKnu',
+ GenericTypes => [D],
+ OtherPars =>'double n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_bessel_lnKnu_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Logarithm of Modified Cylindrical Bessel Function K_nu(x).'
+ );
+
+
+pp_addpm({At=>Bot},<<'EOD');
+
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/clausen/Makefile.PL b/Lib/GSL/SF/clausen/Makefile.PL
new file mode 100644
index 0000000..24df44a
--- /dev/null
+++ b/Lib/GSL/SF/clausen/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_clausen.pd','CLAUSEN','PDL::GSLSF::CLAUSEN']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/clausen/gsl_sf_clausen.pd b/Lib/GSL/SF/clausen/gsl_sf_clausen.pd
new file mode 100644
index 0000000..2c137bf
--- /dev/null
+++ b/Lib/GSL/SF/clausen/gsl_sf_clausen.pd
@@ -0,0 +1,53 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::CLAUSEN - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_clausen',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_clausen_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Clausen Integral. Cl_2(x) := Integrate[-Log[2 Sin[t/2]], {t,0,x}]'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/coulomb/Makefile.PL b/Lib/GSL/SF/coulomb/Makefile.PL
new file mode 100644
index 0000000..f5b2d49
--- /dev/null
+++ b/Lib/GSL/SF/coulomb/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_coulomb.pd','COULOMB','PDL::GSLSF::COULOMB']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/coulomb/gsl_sf_coulomb.pd b/Lib/GSL/SF/coulomb/gsl_sf_coulomb.pd
new file mode 100644
index 0000000..914150d
--- /dev/null
+++ b/Lib/GSL/SF/coulomb/gsl_sf_coulomb.pd
@@ -0,0 +1,101 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::COULOMB - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include <gsl/gsl_errno.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_hydrogenicR',
+ GenericTypes => [D],
+ OtherPars =>'int n; int l; double z',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_hydrogenicR_e,($COMP(n),$COMP(l),$COMP(z),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Normalized Hydrogenic bound states. Radial dipendence.'
+ );
+
+pp_def('gsl_sf_coulomb_wave_FGp_array',
+ GenericTypes => [D],
+ OtherPars =>'double lam_min; int kmax=>n; double eta',
+ Pars=>'double x(); double [o]fc(n); double [o]fcp(n); double [o]gc(n); double [o]gcp(n); int [o]ovfw(); double [o]fe(n); double [o]ge(n);',
+ Code =>'
+int s;
+s = gsl_sf_coulomb_wave_FGp_array($COMP(lam_min),$COMP(kmax),$COMP(eta),$x(),$PP(fc),$PP(fcp),$PP(gc),$PP(gcp),$PP(fe),$PP(ge));
+if (s==GSL_EOVRFLW) {
+$ovfw()=1;
+}
+else {if (s) {sprintf(buf,"Error in gsl_sf_coulomb_wave_FGp_array: %s",gsl_strerror(s));barf("%s", buf);}
+else {$ovfw()=0;}}
+',
+ Doc =>' Coulomb wave functions F_{lam_F}(eta,x), G_{lam_G}(eta,x) and their derivatives; lam_G := lam_F - k_lam_G. if ovfw is signaled then F_L(eta,x) = fc[k_L] * exp(fe) and similar. '
+ );
+
+
+pp_def('gsl_sf_coulomb_wave_sphF_array',
+ GenericTypes => [D],
+ OtherPars =>'double lam_min; int kmax=>n; double eta',
+ Pars=>'double x(); double [o]fc(n); int [o]ovfw(); double [o]fe(n);',
+ Code =>'
+int s;
+s = gsl_sf_coulomb_wave_sphF_array($COMP(lam_min),$COMP(kmax),$COMP(eta),$x(),$PP(fc),$PP(fe));
+if (s==GSL_EOVRFLW) {
+$ovfw()=1;
+}
+else {if (s) {sprintf(buf,"Error in gsl_sf_coulomb_wave_sphF_array: %s",gsl_strerror(s));barf("%s", buf);}
+else {$ovfw()=0;}}
+',
+ Doc =>' Coulomb wave function divided by the argument, F(xi, eta)/xi. This is the function which reduces to spherical Bessel functions in the limit eta->0. '
+ );
+
+pp_def('gsl_sf_coulomb_CL_e',
+ GenericTypes => [D],
+ Pars=>'double L(); double eta(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_coulomb_CL_e,($L(),$eta(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Coulomb wave function normalization constant. [Abramowitz+Stegun 14.1.8, 14.1.9].'
+ );
+
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/coupling/Makefile.PL b/Lib/GSL/SF/coupling/Makefile.PL
new file mode 100644
index 0000000..8f3c86f
--- /dev/null
+++ b/Lib/GSL/SF/coupling/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_coupling.pd','COUPLING','PDL::GSLSF::COUPLING']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/coupling/gsl_sf_coupling.pd b/Lib/GSL/SF/coupling/gsl_sf_coupling.pd
new file mode 100644
index 0000000..1ff44cc
--- /dev/null
+++ b/Lib/GSL/SF/coupling/gsl_sf_coupling.pd
@@ -0,0 +1,78 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::COUPLING - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_coupling_3j',
+ GenericTypes => [L],
+ Pars=>'ja(); jb(); jc(); ma(); mb(); mc(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_coupling_3j_e,($ja(),$jb(),$jc(),$ma(),$mb(),$mc(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'3j Symbols: (ja jb jc) over (ma mb mc).'
+ );
+
+pp_def('gsl_sf_coupling_6j',
+ GenericTypes => [L],
+ Pars=>'ja(); jb(); jc(); jd(); je(); jf(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_coupling_3j_e,($ja(),$jb(),$jc(),$jd(),$je(),$jf(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'6j Symbols: (ja jb jc) over (jd je jf).'
+ );
+
+pp_def('gsl_sf_coupling_9j',
+ GenericTypes => [L],
+ Pars=>'ja(); jb(); jc(); jd(); je(); jf(); jg(); jh(); ji(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_coupling_9j_e,($ja(),$jb(),$jc(),$jd(),$je(),$jf(),$jg(),$jh(),$ji(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'9j Symbols: (ja jb jc) over (jd je jf) over (jg jh ji).'
+ );
+
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/dawson/Makefile.PL b/Lib/GSL/SF/dawson/Makefile.PL
new file mode 100644
index 0000000..964269b
--- /dev/null
+++ b/Lib/GSL/SF/dawson/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_dawson.pd','DAWSON','PDL::GSLSF::DAWSON']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/dawson/gsl_sf_dawson.pd b/Lib/GSL/SF/dawson/gsl_sf_dawson.pd
new file mode 100644
index 0000000..9c826cd
--- /dev/null
+++ b/Lib/GSL/SF/dawson/gsl_sf_dawson.pd
@@ -0,0 +1,53 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::DAWSON - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_dawson',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_dawson_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Dawsons integral: Exp[-x^2] Integral[ Exp[t^2], {t,0,x}]'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/debye/Makefile.PL b/Lib/GSL/SF/debye/Makefile.PL
new file mode 100644
index 0000000..5193edb
--- /dev/null
+++ b/Lib/GSL/SF/debye/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_debye.pd','DEBYE','PDL::GSLSF::DEBYE']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/debye/gsl_sf_debye.pd b/Lib/GSL/SF/debye/gsl_sf_debye.pd
new file mode 100644
index 0000000..64a604f
--- /dev/null
+++ b/Lib/GSL/SF/debye/gsl_sf_debye.pd
@@ -0,0 +1,89 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::DEBYE - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_debye_1',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_debye_1_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'D_n(x) := n/x^n Integrate[t^n/(e^t - 1), {t,0,x}]'
+ );
+
+pp_def('gsl_sf_debye_2',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_debye_2_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'D_n(x) := n/x^n Integrate[t^n/(e^t - 1), {t,0,x}]'
+ );
+
+pp_def('gsl_sf_debye_3',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_debye_3_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'D_n(x) := n/x^n Integrate[t^n/(e^t - 1), {t,0,x}]'
+ );
+
+pp_def('gsl_sf_debye_4',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_debye_4_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'D_n(x) := n/x^n Integrate[t^n/(e^t - 1), {t,0,x}]'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/dilog/Makefile.PL b/Lib/GSL/SF/dilog/Makefile.PL
new file mode 100644
index 0000000..e5f83d8
--- /dev/null
+++ b/Lib/GSL/SF/dilog/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_dilog.pd','DILOG','PDL::GSLSF::DILOG']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/dilog/gsl_sf_dilog.pd b/Lib/GSL/SF/dilog/gsl_sf_dilog.pd
new file mode 100644
index 0000000..8129aba
--- /dev/null
+++ b/Lib/GSL/SF/dilog/gsl_sf_dilog.pd
@@ -0,0 +1,69 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::DILOG - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_dilog',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_dilog_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'/* Real part of DiLogarithm(x), for real argument. In Lewins notation, this is Li_2(x). Li_2(x) = - Re[ Integrate[ Log[1-s] / s, {s, 0, x}] ]'
+ );
+
+pp_def('gsl_sf_complex_dilog',
+ GenericTypes => [D],
+ Pars=>'double r(); double t(); double [o]re(); double [o]im(); double [o]ere(); double [o]eim()',
+ Code =>'
+gsl_sf_result re;
+gsl_sf_result im;
+GSLERR(gsl_sf_complex_dilog_e,($r(),$t(),&re,&im))
+$re() = re.val;
+$ere() = re.err;
+$im() = im.val;
+$eim() = im.err;
+',
+ Doc =>'DiLogarithm(z), for complex argument z = r Exp[i theta].'
+ );
+
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/elementary/Makefile.PL b/Lib/GSL/SF/elementary/Makefile.PL
new file mode 100644
index 0000000..8e10048
--- /dev/null
+++ b/Lib/GSL/SF/elementary/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_elementary.pd','ELEMENTARY','PDL::GSLSF::ELEMENTARY']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/elementary/gsl_sf_elementary.pd b/Lib/GSL/SF/elementary/gsl_sf_elementary.pd
new file mode 100644
index 0000000..df6652c
--- /dev/null
+++ b/Lib/GSL/SF/elementary/gsl_sf_elementary.pd
@@ -0,0 +1,66 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::ELEMENTARY - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_multiply',
+ GenericTypes => [D],
+ Pars=>'double x(); double xx(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_multiply_e,($x(),$xx(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Multiplication.'
+ );
+
+pp_def('gsl_sf_multiply_err',
+ GenericTypes => [D],
+ Pars=>'double x(); double xe(); double xx(); double xxe(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_multiply_err_e,($x(),$xe(),$xx(),$xxe(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Multiplication with associated errors.'
+ );
+
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/ellint/Makefile.PL b/Lib/GSL/SF/ellint/Makefile.PL
new file mode 100644
index 0000000..7651b6f
--- /dev/null
+++ b/Lib/GSL/SF/ellint/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_ellint.pd','ELLINT','PDL::GSLSF::ELLINT']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/ellint/gsl_sf_ellint.pd b/Lib/GSL/SF/ellint/gsl_sf_ellint.pd
new file mode 100644
index 0000000..da3be24
--- /dev/null
+++ b/Lib/GSL/SF/ellint/gsl_sf_ellint.pd
@@ -0,0 +1,164 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::ELLINT - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_ellint_Kcomp',
+ GenericTypes => [D],
+ Pars=>'double k(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_ellint_Kcomp_e,($k(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Legendre form of complete elliptic integrals K(k) = Integral[1/Sqrt[1 - k^2 Sin[t]^2], {t, 0, Pi/2}].'
+ );
+
+pp_def('gsl_sf_ellint_Ecomp',
+ GenericTypes => [D],
+ Pars=>'double k(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_ellint_Ecomp_e,($k(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Legendre form of complete elliptic integrals E(k) = Integral[ Sqrt[1 - k^2 Sin[t]^2], {t, 0, Pi/2}]'
+ );
+
+pp_def('gsl_sf_ellint_F',
+ GenericTypes => [D],
+ Pars=>'double phi(); double k(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_ellint_F_e,($phi(),$k(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Legendre form of incomplete elliptic integrals F(phi,k) = Integral[1/Sqrt[1 - k^2 Sin[t]^2], {t, 0, phi}]'
+ );
+
+pp_def('gsl_sf_ellint_E',
+ GenericTypes => [D],
+ Pars=>'double phi(); double k(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_ellint_E_e,($phi(),$k(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Legendre form of incomplete elliptic integrals E(phi,k) = Integral[ Sqrt[1 - k^2 Sin[t]^2], {t, 0, phi}]'
+ );
+
+pp_def('gsl_sf_ellint_P',
+ GenericTypes => [D],
+ Pars=>'double phi(); double k(); double n();
+ double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_ellint_P_e,($phi(),$k(),$n(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Legendre form of incomplete elliptic integrals P(phi,k,n) = Integral[(1 + n Sin[t]^2)^(-1)/Sqrt[1 - k^2 Sin[t]^2], {t, 0, phi}]'
+ );
+
+pp_def('gsl_sf_ellint_D',
+ GenericTypes => [D],
+ Pars=>'double phi(); double k(); double n();
+ double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_ellint_D_e,($phi(),$k(),$n(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Legendre form of incomplete elliptic integrals D(phi,k,n)'
+ );
+
+pp_def('gsl_sf_ellint_RC',
+ GenericTypes => [D],
+ Pars=>'double x(); double yy(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_ellint_RC_e,($x(),$yy(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Carlsons symmetric basis of functions RC(x,y) = 1/2 Integral[(t+x)^(-1/2) (t+y)^(-1)], {t,0,Inf}'
+ );
+
+pp_def('gsl_sf_ellint_RD',
+ GenericTypes => [D],
+ Pars=>'double x(); double yy(); double z(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_ellint_RD_e,($x(),$yy(),$z(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Carlsons symmetric basis of functions RD(x,y,z) = 3/2 Integral[(t+x)^(-1/2) (t+y)^(-1/2) (t+z)^(-3/2), {t,0,Inf}]'
+ );
+
+pp_def('gsl_sf_ellint_RF',
+ GenericTypes => [D],
+ Pars=>'double x(); double yy(); double z(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_ellint_RF_e,($x(),$yy(),$z(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Carlsons symmetric basis of functions RF(x,y,z) = 1/2 Integral[(t+x)^(-1/2) (t+y)^(-1/2) (t+z)^(-1/2), {t,0,Inf}]'
+ );
+
+pp_def('gsl_sf_ellint_RJ',
+ GenericTypes => [D],
+ Pars=>'double x(); double yy(); double z(); double p(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_ellint_RJ_e,($x(),$yy(),$z(),$p(),GSL_PREC_DOUBLE,&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Carlsons symmetric basis of functions RJ(x,y,z,p) = 3/2 Integral[(t+x)^(-1/2) (t+y)^(-1/2) (t+z)^(-1/2) (t+p)^(-1), {t,0,Inf}]'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>,
+2002 Christian Soeller.
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/elljac/Makefile.PL b/Lib/GSL/SF/elljac/Makefile.PL
new file mode 100644
index 0000000..f9abad6
--- /dev/null
+++ b/Lib/GSL/SF/elljac/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_elljac.pd','ELLJAC','PDL::GSLSF::ELLJAC']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/elljac/gsl_sf_elljac.pd b/Lib/GSL/SF/elljac/gsl_sf_elljac.pd
new file mode 100644
index 0000000..65509a9
--- /dev/null
+++ b/Lib/GSL/SF/elljac/gsl_sf_elljac.pd
@@ -0,0 +1,50 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::ELLJAC - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_elljac',
+ GenericTypes => [D],
+ Pars=>'double u(); double m(); double [o]sn(); double [o]cn(); double [o]dn()',
+ Code =>'
+if (gsl_sf_elljac_e($u(),$m(),$PP(sn),$PP(cn),$PP(dn))) {barf("Error in gsl_sf_elljac");};
+',
+ Doc =>'Jacobian elliptic functions sn, dn, cn by descending Landen transformations'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/erf/Makefile.PL b/Lib/GSL/SF/erf/Makefile.PL
new file mode 100644
index 0000000..33e480c
--- /dev/null
+++ b/Lib/GSL/SF/erf/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_erf.pd','ERF','PDL::GSLSF::ERF']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/erf/gsl_sf_erf.pd b/Lib/GSL/SF/erf/gsl_sf_erf.pd
new file mode 100644
index 0000000..107b53a
--- /dev/null
+++ b/Lib/GSL/SF/erf/gsl_sf_erf.pd
@@ -0,0 +1,102 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::ERF - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_erfc',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_erfc_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Complementary Error Function erfc(x) := 2/Sqrt[Pi] Integrate[Exp[-t^2], {t,x,Infinity}]'
+ );
+
+pp_def('gsl_sf_log_erfc',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_log_erfc_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Log Complementary Error Function'
+ );
+
+pp_def('gsl_sf_erf',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_erf_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Error Function erf(x) := 2/Sqrt[Pi] Integrate[Exp[-t^2], {t,0,x}]'
+ );
+
+pp_def('gsl_sf_erf_Z',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_erf_Z_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Z(x) : Abramowitz+Stegun 26.2.1'
+ );
+
+pp_def('gsl_sf_erf_Q',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_erf_Q_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Q(x) : Abramowitz+Stegun 26.2.1'
+ );
+
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/exp/Makefile.PL b/Lib/GSL/SF/exp/Makefile.PL
new file mode 100644
index 0000000..547445d
--- /dev/null
+++ b/Lib/GSL/SF/exp/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_exp.pd','EXP','PDL::GSLSF::EXP']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/exp/gsl_sf_exp.pd b/Lib/GSL/SF/exp/gsl_sf_exp.pd
new file mode 100644
index 0000000..8110b7e
--- /dev/null
+++ b/Lib/GSL/SF/exp/gsl_sf_exp.pd
@@ -0,0 +1,80 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::EXP - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+
+#include "../gslerr.h"
+
+');
+
+pp_def('gsl_sf_exp',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_exp_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Exponential'
+ );
+
+pp_def('gsl_sf_exprel_n',
+ GenericTypes => [D],
+ OtherPars => 'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_exprel_n_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'N-relative Exponential. exprel_N(x) = N!/x^N (exp(x) - Sum[x^k/k!, {k,0,N-1}]) = 1 + x/(N+1) + x^2/((N+1)(N+2)) + ... = 1F1(1,1+N,x)'
+ );
+
+pp_def('gsl_sf_exp_err',
+ GenericTypes => [D],
+ Pars=>'double x(); double dx(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_exp_err_e,($x(),$dx(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Exponential of a quantity with given error.'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/expint/Makefile.PL b/Lib/GSL/SF/expint/Makefile.PL
new file mode 100644
index 0000000..45a5deb
--- /dev/null
+++ b/Lib/GSL/SF/expint/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_expint.pd','EXPINT','PDL::GSLSF::EXPINT']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/expint/gsl_sf_expint.pd b/Lib/GSL/SF/expint/gsl_sf_expint.pd
new file mode 100644
index 0000000..0b2780a
--- /dev/null
+++ b/Lib/GSL/SF/expint/gsl_sf_expint.pd
@@ -0,0 +1,153 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::EXPINT - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+
+#include "../gslerr.h"
+
+');
+
+pp_def('gsl_sf_expint_E1',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_expint_E1_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'E_1(x) := Re[ Integrate[ Exp[-xt]/t, {t,1,Infinity}] ]'
+ );
+
+pp_def('gsl_sf_expint_E2',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_expint_E2_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'E_2(x) := Re[ Integrate[ Exp[-xt]/t^2, {t,1,Infity}] ]'
+ );
+
+pp_def('gsl_sf_expint_Ei',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_expint_Ei_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Ei(x) := PV Integrate[ Exp[-t]/t, {t,-x,Infinity}]'
+ );
+
+pp_def('gsl_sf_Shi',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_Shi_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Shi(x) := Integrate[ Sinh[t]/t, {t,0,x}]'
+ );
+
+pp_def('gsl_sf_Chi',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_Chi_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Chi(x) := Re[ M_EULER + log(x) + Integrate[(Cosh[t]-1)/t, {t,0,x}] ]'
+ );
+
+pp_def('gsl_sf_expint_3',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_expint_3_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Ei_3(x) := Integral[ Exp[-t^3], {t,0,x}]'
+ );
+
+pp_def('gsl_sf_Si',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_Si_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Si(x) := Integrate[ Sin[t]/t, {t,0,x}]'
+ );
+
+pp_def('gsl_sf_Ci',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_Ci_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Ci(x) := -Integrate[ Cos[t]/t, {t,x,Infinity}]'
+ );
+
+pp_def('gsl_sf_atanint',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_atanint_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'AtanInt(x) := Integral[ Arctan[t]/t, {t,0,x}]'
+ );
+
+
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/fermi_dirac/Makefile.PL b/Lib/GSL/SF/fermi_dirac/Makefile.PL
new file mode 100644
index 0000000..2b15777
--- /dev/null
+++ b/Lib/GSL/SF/fermi_dirac/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_fermi_dirac.pd','FERMI_DIRAC','PDL::GSLSF::FERMI_DIRAC']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/fermi_dirac/gsl_sf_fermi_dirac.pd b/Lib/GSL/SF/fermi_dirac/gsl_sf_fermi_dirac.pd
new file mode 100644
index 0000000..1338764
--- /dev/null
+++ b/Lib/GSL/SF/fermi_dirac/gsl_sf_fermi_dirac.pd
@@ -0,0 +1,115 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::FERMI_DIRAC - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+Please note that:
+
+Complete Fermi-Dirac Integrals:
+
+ F_j(x) := 1/Gamma[j+1] Integral[ t^j /(Exp[t-x] + 1), {t,0,Infinity}]
+
+
+Incomplete Fermi-Dirac Integrals:
+
+ F_j(x,b) := 1/Gamma[j+1] Integral[ t^j /(Exp[t-x] + 1), {t,b,Infinity}]
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+
+#include "../gslerr.h"
+
+');
+
+pp_def('gsl_sf_fermi_dirac_int',
+ GenericTypes => [D],
+ OtherPars => 'int j',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_fermi_dirac_int_e,($COMP(j),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Complete integral F_j(x) for integer j'
+ );
+
+pp_def('gsl_sf_fermi_dirac_mhalf',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_fermi_dirac_mhalf_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Complete integral F_{-1/2}(x)'
+ );
+
+pp_def('gsl_sf_fermi_dirac_half',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_fermi_dirac_half_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Complete integral F_{1/2}(x)'
+ );
+
+pp_def('gsl_sf_fermi_dirac_3half',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_fermi_dirac_3half_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Complete integral F_{3/2}(x)'
+ );
+
+pp_def('gsl_sf_fermi_dirac_inc_0',
+ GenericTypes => [D],
+ OtherPars => 'double b',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_fermi_dirac_inc_0_e,($x(),$COMP(b),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Incomplete integral F_0(x,b) = ln(1 + e^(b-x)) - (b-x)'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/gamma/Makefile.PL b/Lib/GSL/SF/gamma/Makefile.PL
new file mode 100644
index 0000000..4e6fead
--- /dev/null
+++ b/Lib/GSL/SF/gamma/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_gamma.pd','GAMMA','PDL::GSLSF::GAMMA']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/gamma/gsl_sf_gamma.pd b/Lib/GSL/SF/gamma/gsl_sf_gamma.pd
new file mode 100644
index 0000000..1f5bc4e
--- /dev/null
+++ b/Lib/GSL/SF/gamma/gsl_sf_gamma.pd
@@ -0,0 +1,285 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::GAMMA - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+
+#include "../gslerr.h"
+
+');
+
+pp_def('gsl_sf_lngamma',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]s(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+double sgn;
+GSLERR(gsl_sf_lngamma_sgn_e,($x(),&r,&sgn))
+$y() = r.val;
+$e() = r.err;
+$s() = sgn;
+',
+ Doc =>'Log[Gamma(x)], x not a negative integer Uses real Lanczos method. Determines the sign of Gamma[x] as well as Log[|Gamma[x]|] for x < 0. So Gamma[x] = sgn * Exp[result_lg].'
+ );
+
+pp_def('gsl_sf_gamma',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_gamma_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Gamma(x), x not a negative integer'
+ );
+
+pp_def('gsl_sf_gammastar',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_gammastar_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Regulated Gamma Function, x > 0 Gamma^*(x) = Gamma(x)/(Sqrt[2Pi] x^(x-1/2) exp(-x)) = (1 + 1/(12x) + ...), x->Inf'
+ );
+
+pp_def('gsl_sf_gammainv',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_gammainv_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'1/Gamma(x)'
+ );
+
+pp_def('gsl_sf_lngamma_complex',
+ GenericTypes => [D],
+ Pars=>'double zr(); double zi(); double [o]x(); double [o]y(); double [o]xe(); double [o]ye()',
+ Code =>'
+gsl_sf_result r;
+gsl_sf_result ri;
+GSLERR(gsl_sf_lngamma_complex_e,($zr(),$zi(),&r,&ri))
+$x() = r.val;
+$xe() = r.err;
+$y() = ri.val;
+$ye() = ri.err;
+',
+ Doc =>'Log[Gamma(z)] for z complex, z not a negative integer. Calculates: lnr = log|Gamma(z)|, arg = arg(Gamma(z)) in (-Pi, Pi]'
+ );
+
+pp_def('gsl_sf_taylorcoeff',
+ GenericTypes => [D],
+ OtherPars => 'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_taylorcoeff_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'x^n / n!'
+ );
+
+pp_def('gsl_sf_fact',
+ GenericTypes => [L],
+ Pars=>'x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_fact_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'n!'
+ );
+
+pp_def('gsl_sf_doublefact',
+ GenericTypes => [L],
+ Pars=>'x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_doublefact_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'n!! = n(n-2)(n-4)'
+ );
+
+pp_def('gsl_sf_lnfact',
+ GenericTypes => [L],
+ Pars=>'x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_lnfact_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'ln n!'
+ );
+
+pp_def('gsl_sf_lndoublefact',
+ GenericTypes => [L],
+ Pars=>'x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_lndoublefact_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'ln n!!'
+ );
+
+pp_def('gsl_sf_lnchoose',
+ GenericTypes => [L],
+ Pars=>'n(); m(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_lnchoose_e,($n(), $m(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'log(n choose m)'
+ );
+
+pp_def('gsl_sf_choose',
+ GenericTypes => [L],
+ Pars=>'n(); m(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_choose_e,($n(), $m(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'n choose m'
+ );
+
+pp_def('gsl_sf_lnpoch',
+ GenericTypes => [D],
+ OtherPars => 'double a',
+ Pars=>'double x(); double [o]y(); double [o]s(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+double sgn;
+GSLERR(gsl_sf_lnpoch_sgn_e,($COMP(a),$x(),&r,&sgn))
+$y() = r.val;
+$e() = r.err;
+$s() = sgn;
+',
+ Doc =>'Logarithm of Pochammer (Apell) symbol, with sign information. result = log( |(a)_x| ), sgn = sgn( (a)_x ) where (a)_x := Gamma[a + x]/Gamma[a]'
+ );
+
+pp_def('gsl_sf_poch',
+ GenericTypes => [D],
+ OtherPars => 'double a',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_poch_e,($COMP(a),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Pochammer (Apell) symbol (a)_x := Gamma[a + x]/Gamma[x]'
+ );
+
+pp_def('gsl_sf_pochrel',
+ GenericTypes => [D],
+ OtherPars => 'double a',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_pochrel_e,($COMP(a),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Relative Pochammer (Apell) symbol ((a,x) - 1)/x where (a,x) = (a)_x := Gamma[a + x]/Gamma[a]'
+ );
+
+pp_def('gsl_sf_gamma_inc_Q',
+ GenericTypes => [D],
+ OtherPars => 'double a',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_gamma_inc_Q_e,($COMP(a),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Normalized Incomplete Gamma Function Q(a,x) = 1/Gamma(a) Integral[ t^(a-1) e^(-t), {t,x,Infinity} ]'
+ );
+
+pp_def('gsl_sf_gamma_inc_P',
+ GenericTypes => [D],
+ OtherPars => 'double a',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_gamma_inc_P_e,($COMP(a),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Complementary Normalized Incomplete Gamma Function P(a,x) = 1/Gamma(a) Integral[ t^(a-1) e^(-t), {t,0,x} ]'
+ );
+
+pp_def('gsl_sf_lnbeta',
+ GenericTypes => [D],
+ Pars=>'double a(); double b(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_lnbeta_e,($a(),$b(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Logarithm of Beta Function Log[B(a,b)]'
+ );
+
+pp_def('gsl_sf_beta',
+ GenericTypes => [D],
+ OtherPars => '',
+ Pars=>'double a(); double b();double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_beta_e,($a(),$b(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Beta Function B(a,b)'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/gegenbauer/Makefile.PL b/Lib/GSL/SF/gegenbauer/Makefile.PL
new file mode 100644
index 0000000..9751bc9
--- /dev/null
+++ b/Lib/GSL/SF/gegenbauer/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_gegenbauer.pd','GEGENBAUER','PDL::GSLSF::GEGENBAUER']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/gegenbauer/gsl_sf_gegenbauer.pd b/Lib/GSL/SF/gegenbauer/gsl_sf_gegenbauer.pd
new file mode 100644
index 0000000..338c612
--- /dev/null
+++ b/Lib/GSL/SF/gegenbauer/gsl_sf_gegenbauer.pd
@@ -0,0 +1,65 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::GEGENBAUER - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_gegenpoly_n',
+ GenericTypes => [D],
+ OtherPars =>'int n; double lambda',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_gegenpoly_n_e,($COMP(n),$COMP(lambda), $x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Evaluate Gegenbauer polynomials.'
+ );
+
+pp_def('gsl_sf_gegenpoly_array',
+ GenericTypes => [D],
+ OtherPars =>'int n=>num; double lambda',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_gegenpoly_array,($COMP(n)-1,$COMP(lambda),$x(),$P(y)))
+',
+ Doc =>'Calculate array of Gegenbauer polynomials from 0 to n-1.'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/gslerr.h b/Lib/GSL/SF/gslerr.h
new file mode 100644
index 0000000..2b3b649
--- /dev/null
+++ b/Lib/GSL/SF/gslerr.h
@@ -0,0 +1,5 @@
+
+static int status;
+static char buf[200];
+
+#define GSLERR(x,y) if (status = x y) {snprintf(buf,200,"Error in %s: %s", #x, gsl_strerror(status));barf("%s", buf);}
diff --git a/Lib/GSL/SF/hyperg/Makefile.PL b/Lib/GSL/SF/hyperg/Makefile.PL
new file mode 100644
index 0000000..97e9be1
--- /dev/null
+++ b/Lib/GSL/SF/hyperg/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_hyperg.pd','HYPERG','PDL::GSLSF::HYPERG']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/hyperg/gsl_sf_hyperg.pd b/Lib/GSL/SF/hyperg/gsl_sf_hyperg.pd
new file mode 100644
index 0000000..9146ecc
--- /dev/null
+++ b/Lib/GSL/SF/hyperg/gsl_sf_hyperg.pd
@@ -0,0 +1,147 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::HYPERG - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_hyperg_0F1',
+ GenericTypes => [D],
+ OtherPars =>'double c',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_hyperg_0F1_e,($COMP(c), $x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'/* Hypergeometric function related to Bessel functions 0F1[c,x] = Gamma[c] x^(1/2(1-c)) I_{c-1}(2 Sqrt[x]) Gamma[c] (-x)^(1/2(1-c)) J_{c-1}(2 Sqrt[-x])'
+ );
+
+pp_def('gsl_sf_hyperg_1F1',
+ GenericTypes => [D],
+ OtherPars =>'double a; double b',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_hyperg_1F1_e,($COMP(a),$COMP(b), $x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Confluent hypergeometric function for integer parameters. 1F1[a,b,x] = M(a,b,x)'
+ );
+
+pp_def('gsl_sf_hyperg_U',
+ GenericTypes => [D],
+ OtherPars =>'double a; double b',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_hyperg_U_e,($COMP(a),$COMP(b), $x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Confluent hypergeometric function for integer parameters. U(a,b,x)'
+ );
+
+pp_def('gsl_sf_hyperg_2F1',
+ GenericTypes => [D],
+ OtherPars =>'double a; double b; double c',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_hyperg_2F1_e,($COMP(a),$COMP(b), $COMP(c),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Confluent hypergeometric function for integer parameters. 2F1[a,b,c,x]'
+ );
+
+pp_def('gsl_sf_hyperg_2F1_conj',
+ GenericTypes => [D],
+ OtherPars =>'double a; double b; double c',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_hyperg_2F1_conj_e,($COMP(a),$COMP(b), $COMP(c),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Gauss hypergeometric function 2F1[aR + I aI, aR - I aI, c, x]'
+ );
+
+pp_def('gsl_sf_hyperg_2F1_renorm',
+ GenericTypes => [D],
+ OtherPars =>'double a; double b; double c',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_hyperg_2F1_renorm_e,($COMP(a),$COMP(b), $COMP(c),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Renormalized Gauss hypergeometric function 2F1[a,b,c,x] / Gamma[c]'
+ );
+
+pp_def('gsl_sf_hyperg_2F1_conj_renorm',
+ GenericTypes => [D],
+ OtherPars =>'double a; double b; double c',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_hyperg_2F1_conj_renorm_e,($COMP(a),$COMP(b), $COMP(c),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Renormalized Gauss hypergeometric function 2F1[aR + I aI, aR - I aI, c, x] / Gamma[c]'
+ );
+
+pp_def('gsl_sf_hyperg_2F0',
+ GenericTypes => [D],
+ OtherPars =>'double a; double b',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_hyperg_2F0_e,($COMP(a),$COMP(b), $x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Mysterious hypergeometric function. The series representation is a divergent hypergeometric series. However, for x < 0 we have 2F0(a,b,x) = (-1/x)^a U(a,1+a-b,-1/x)'
+ );
+
+
+pp_addpm({At=>Bot},<<'EOD');
+
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/laguerre/Makefile.PL b/Lib/GSL/SF/laguerre/Makefile.PL
new file mode 100644
index 0000000..560f363
--- /dev/null
+++ b/Lib/GSL/SF/laguerre/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_laguerre.pd','LAGUERRE','PDL::GSLSF::LAGUERRE']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/laguerre/gsl_sf_laguerre.pd b/Lib/GSL/SF/laguerre/gsl_sf_laguerre.pd
new file mode 100644
index 0000000..cbb867f
--- /dev/null
+++ b/Lib/GSL/SF/laguerre/gsl_sf_laguerre.pd
@@ -0,0 +1,55 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::LAGUERRE - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_laguerre_n',
+ GenericTypes => [D],
+ OtherPars =>'int n; double a',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_laguerre_n_e,($COMP(n),$COMP(a), $x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Evaluate generalized Laguerre polynomials.'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/legendre/Makefile.PL b/Lib/GSL/SF/legendre/Makefile.PL
new file mode 100644
index 0000000..408a13b
--- /dev/null
+++ b/Lib/GSL/SF/legendre/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_legendre.pd','LEGENDRE','PDL::GSLSF::LEGENDRE']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/legendre/gsl_sf_legendre.pd b/Lib/GSL/SF/legendre/gsl_sf_legendre.pd
new file mode 100644
index 0000000..c0b5f3c
--- /dev/null
+++ b/Lib/GSL/SF/legendre/gsl_sf_legendre.pd
@@ -0,0 +1,225 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::LEGENDRE - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_legendre_Pl',
+ GenericTypes => [D],
+ OtherPars =>'int l',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_legendre_Pl_e,($COMP(l),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'P_l(x)'
+ );
+
+pp_def('gsl_sf_legendre_Pl_array',
+ GenericTypes => [D],
+ OtherPars =>'int l=>num',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_legendre_Pl_array,($COMP(l)-1,$x(),$P(y)))
+',
+ Doc =>'P_l(x) from 0 to n-1.'
+ );
+
+pp_def('gsl_sf_legendre_Ql',
+ GenericTypes => [D],
+ OtherPars =>'int l',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_legendre_Ql_e,($COMP(l),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Q_l(x)'
+ );
+
+pp_def('gsl_sf_legendre_Plm',
+ GenericTypes => [D],
+ OtherPars =>'int l; int m',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_legendre_Plm_e,($COMP(l),$COMP(m),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'P_lm(x)'
+ );
+
+pp_def('gsl_sf_legendre_Plm_array',
+ GenericTypes => [D],
+ OtherPars =>'int l=>num; int m',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_legendre_Plm_array,($COMP(l)-2+$COMP(m),$COMP(m),$x(),$P(y)))
+',
+ Doc =>'P_lm(x) for l from 0 to n-2+m.'
+ );
+
+pp_def('gsl_sf_legendre_sphPlm',
+ GenericTypes => [D],
+ OtherPars =>'int l; int m',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_legendre_sphPlm_e,($COMP(l),$COMP(m),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'P_lm(x), normalized properly for use in spherical harmonics'
+ );
+
+pp_def('gsl_sf_legendre_sphPlm_array',
+ GenericTypes => [D],
+ OtherPars =>'int n=>num; int m',
+ Pars=>'double x(); double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_legendre_sphPlm_array,($COMP(n)-2+$COMP(m),$COMP(m),$x(),$P(y)))
+',
+ Doc =>'P_lm(x), normalized properly for use in spherical harmonics for l from 0 to n-2+m.'
+ );
+
+pp_def('gsl_sf_conicalP_half',
+ GenericTypes => [D],
+ OtherPars =>'double lambda',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_conicalP_half_e,($COMP(lambda),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Irregular Spherical Conical Function P^{1/2}_{-1/2 + I lambda}(x)'
+ );
+
+pp_def('gsl_sf_conicalP_mhalf',
+ GenericTypes => [D],
+ OtherPars =>'double lambda',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_conicalP_mhalf_e,($COMP(lambda),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Regular Spherical Conical Function P^{-1/2}_{-1/2 + I lambda}(x)'
+ );
+
+pp_def('gsl_sf_conicalP_0',
+ GenericTypes => [D],
+ OtherPars =>'double lambda',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_conicalP_0_e,($COMP(lambda),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Conical Function P^{0}_{-1/2 + I lambda}(x)'
+ );
+
+pp_def('gsl_sf_conicalP_1',
+ GenericTypes => [D],
+ OtherPars =>'double lambda',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_conicalP_1_e,($COMP(lambda),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Conical Function P^{1}_{-1/2 + I lambda}(x)'
+ );
+
+pp_def('gsl_sf_conicalP_sph_reg',
+ GenericTypes => [D],
+ OtherPars =>'int l; double lambda',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_conicalP_sph_reg_e,($COMP(l),$COMP(lambda),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Regular Spherical Conical Function P^{-1/2-l}_{-1/2 + I lambda}(x)'
+ );
+
+pp_def('gsl_sf_conicalP_cyl_reg_e',
+ GenericTypes => [D],
+ OtherPars =>'int m; double lambda',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_conicalP_cyl_reg_e,($COMP(m),$COMP(lambda),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Regular Cylindrical Conical Function P^{-m}_{-1/2 + I lambda}(x)'
+ );
+
+pp_def('gsl_sf_legendre_H3d',
+ GenericTypes => [D],
+ OtherPars =>'int l; double lambda; double eta',
+ Pars=>'double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_legendre_H3d_e,($COMP(l),$COMP(lambda),$COMP(eta),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'lth radial eigenfunction of the Laplacian on the 3-dimensional hyperbolic space.'
+ );
+
+pp_def('gsl_sf_legendre_H3d_array',
+ GenericTypes => [D],
+ OtherPars =>'int l=>num; double lambda; double eta',
+ Pars=>'double [o]y(num)',
+ Code =>'
+GSLERR(gsl_sf_legendre_H3d_array,($COMP(l)-1,$COMP(lambda),$COMP(eta),$P(y)))
+',
+ Doc =>'Array of H3d(ell), for l from 0 to n-1.'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/log/Makefile.PL b/Lib/GSL/SF/log/Makefile.PL
new file mode 100644
index 0000000..1cd185a
--- /dev/null
+++ b/Lib/GSL/SF/log/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_log.pd','LOG','PDL::GSLSF::LOG']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/log/gsl_sf_log.pd b/Lib/GSL/SF/log/gsl_sf_log.pd
new file mode 100644
index 0000000..302907c
--- /dev/null
+++ b/Lib/GSL/SF/log/gsl_sf_log.pd
@@ -0,0 +1,72 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::LOG - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+
+#include "../gslerr.h"
+
+');
+
+pp_def('gsl_sf_log',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_log_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Provide a logarithm function with GSL semantics.'
+ );
+
+
+pp_def('gsl_sf_complex_log',
+ GenericTypes => [D],
+ Pars=>'double zr(); double zi(); double [o]x(); double [o]y(); double [o]xe(); double [o]ye()',
+ Code =>'
+gsl_sf_result r;
+gsl_sf_result ri;
+GSLERR(gsl_sf_complex_log_e,($zr(),$zi(),&r,&ri))
+$x() = r.val;
+$xe() = r.err;
+$y() = ri.val;
+$ye() = ri.err;
+',
+ Doc =>'Complex Logarithm exp(lnr + I theta) = zr + I zi Returns argument in [-pi,pi].'
+ );
+
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/poly/Makefile.PL b/Lib/GSL/SF/poly/Makefile.PL
new file mode 100644
index 0000000..6491ee6
--- /dev/null
+++ b/Lib/GSL/SF/poly/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_poly.pd','POLY','PDL::GSLSF::POLY']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/poly/gsl_sf_poly.pd b/Lib/GSL/SF/poly/gsl_sf_poly.pd
new file mode 100644
index 0000000..cc2010b
--- /dev/null
+++ b/Lib/GSL/SF/poly/gsl_sf_poly.pd
@@ -0,0 +1,56 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::POLY - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+NOTE: this should actually be PDL::POLY for consistency but I don't want to get into edits
+changing the directory structure at this time. These fixes should allow things to build.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+
+#include <gsl/gsl_poly.h>
+
+#include "../gslerr.h"
+
+');
+
+pp_def('gsl_poly_eval',
+ GenericTypes => [D],
+ Pars=>'double x(); double c(m); double [o]y()',
+ Code =>'
+$y() = gsl_poly_eval($P(c),$SIZE(m),$x());
+',
+ Doc =>'c[0] + c[1] x + c[2] x^2 + ... + c[m-1] x^(m-1)'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/pow_int/Makefile.PL b/Lib/GSL/SF/pow_int/Makefile.PL
new file mode 100644
index 0000000..0ecd997
--- /dev/null
+++ b/Lib/GSL/SF/pow_int/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_pow_int.pd','POW_INT','PDL::GSLSF::POW_INT']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/pow_int/gsl_sf_pow_int.pd b/Lib/GSL/SF/pow_int/gsl_sf_pow_int.pd
new file mode 100644
index 0000000..5bd33c1
--- /dev/null
+++ b/Lib/GSL/SF/pow_int/gsl_sf_pow_int.pd
@@ -0,0 +1,57 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::POW_INT - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+
+#include "../gslerr.h"
+
+');
+
+pp_def('gsl_sf_pow_int',
+ GenericTypes => [D],
+ OtherPars => 'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_pow_int_e,($x(),$COMP(n),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Calculate x^n.'
+ );
+
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/psi/Makefile.PL b/Lib/GSL/SF/psi/Makefile.PL
new file mode 100644
index 0000000..5393810
--- /dev/null
+++ b/Lib/GSL/SF/psi/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_psi.pd','PSI','PDL::GSLSF::PSI']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/psi/gsl_sf_psi.pd b/Lib/GSL/SF/psi/gsl_sf_psi.pd
new file mode 100644
index 0000000..700d412
--- /dev/null
+++ b/Lib/GSL/SF/psi/gsl_sf_psi.pd
@@ -0,0 +1,85 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::PSI - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+Poly-Gamma Functions
+
+psi(m,x) := (d/dx)^m psi(0,x) = (d/dx)^{m+1} log(gamma(x))
+
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+
+#include "../gslerr.h"
+
+');
+
+pp_def('gsl_sf_psi',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_psi_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Di-Gamma Function psi(x).'
+ );
+
+pp_def('gsl_sf_psi_1piy',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_psi_1piy_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Di-Gamma Function Re[psi(1 + I y)]'
+ );
+
+pp_def('gsl_sf_psi_n',
+ GenericTypes => [D],
+ OtherPars => 'int n',
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_psi_n_e,($COMP(n),$x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Poly-Gamma Function psi^(n)(x)'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/synchrotron/Makefile.PL b/Lib/GSL/SF/synchrotron/Makefile.PL
new file mode 100644
index 0000000..1f6faad
--- /dev/null
+++ b/Lib/GSL/SF/synchrotron/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_synchrotron.pd','SYNCHROTRON','PDL::GSLSF::SYNCHROTRON']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/synchrotron/gsl_sf_synchrotron.pd b/Lib/GSL/SF/synchrotron/gsl_sf_synchrotron.pd
new file mode 100644
index 0000000..9841e36
--- /dev/null
+++ b/Lib/GSL/SF/synchrotron/gsl_sf_synchrotron.pd
@@ -0,0 +1,67 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::SYNCHROTRON - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+
+#include "../gslerr.h"
+
+');
+
+pp_def('gsl_sf_synchrotron_1',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_synchrotron_1_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'First synchrotron function: synchrotron_1(x) = x Integral[ K_{5/3}(t), {t, x, Infinity}]'
+ );
+
+pp_def('gsl_sf_synchrotron_2',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_synchrotron_2_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Second synchroton function: synchrotron_2(x) = x * K_{2/3}(x)'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/transport/Makefile.PL b/Lib/GSL/SF/transport/Makefile.PL
new file mode 100644
index 0000000..670917c
--- /dev/null
+++ b/Lib/GSL/SF/transport/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_transport.pd','TRANSPORT','PDL::GSLSF::TRANSPORT']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/transport/gsl_sf_transport.pd b/Lib/GSL/SF/transport/gsl_sf_transport.pd
new file mode 100644
index 0000000..585dc20
--- /dev/null
+++ b/Lib/GSL/SF/transport/gsl_sf_transport.pd
@@ -0,0 +1,95 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::TRANSPORT - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+
+Transport function:
+ J(n,x) := Integral[ t^n e^t /(e^t - 1)^2, {t,0,x}]
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+
+#include "../gslerr.h"
+
+');
+
+pp_def('gsl_sf_transport_2',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_transport_2_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'J(2,x)'
+ );
+
+pp_def('gsl_sf_transport_3',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_transport_3_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'J(3,x)'
+ );
+
+pp_def('gsl_sf_transport_4',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_transport_4_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'J(4,x)'
+ );
+
+pp_def('gsl_sf_transport_5',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_transport_5_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'J(5,x)'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/trig/Makefile.PL b/Lib/GSL/SF/trig/Makefile.PL
new file mode 100644
index 0000000..f664599
--- /dev/null
+++ b/Lib/GSL/SF/trig/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_trig.pd','TRIG','PDL::GSLSF::TRIG']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/trig/gsl_sf_trig.pd b/Lib/GSL/SF/trig/gsl_sf_trig.pd
new file mode 100644
index 0000000..fdd179f
--- /dev/null
+++ b/Lib/GSL/SF/trig/gsl_sf_trig.pd
@@ -0,0 +1,221 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::TRIG - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+
+#include "../gslerr.h"
+
+');
+
+pp_def('gsl_sf_sin',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_sin_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Sin(x) with GSL semantics.'
+ );
+
+pp_def('gsl_sf_cos',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_cos_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Cos(x) with GSL semantics.'
+ );
+
+pp_def('gsl_sf_hypot',
+ GenericTypes => [D],
+ Pars=>'double x(); double xx(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_hypot_e,($x(),$xx(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Hypot(x,xx) with GSL semantics.'
+ );
+
+pp_def('gsl_sf_complex_sin',
+ GenericTypes => [D],
+ Pars=>'double zr(); double zi(); double [o]x(); double [o]y(); double [o]xe(); double [o]ye()',
+ Code =>'
+gsl_sf_result r;
+gsl_sf_result ri;
+GSLERR(gsl_sf_complex_sin_e,($zr(),$zi(),&r,&ri))
+$x() = r.val;
+$xe() = r.err;
+$y() = ri.val;
+$ye() = ri.err;
+',
+ Doc =>'Sin(z) for complex z'
+ );
+
+pp_def('gsl_sf_complex_cos',
+ GenericTypes => [D],
+ Pars=>'double zr(); double zi(); double [o]x(); double [o]y(); double [o]xe(); double [o]ye()',
+ Code =>'
+gsl_sf_result r;
+gsl_sf_result ri;
+GSLERR(gsl_sf_complex_cos_e,($zr(),$zi(),&r,&ri))
+$x() = r.val;
+$xe() = r.err;
+$y() = ri.val;
+$ye() = ri.err;
+',
+ Doc =>'Cos(z) for complex z'
+ );
+
+pp_def('gsl_sf_complex_logsin',
+ GenericTypes => [D],
+ Pars=>'double zr(); double zi(); double [o]x(); double [o]y(); double [o]xe(); double [o]ye()',
+ Code =>'
+gsl_sf_result r;
+gsl_sf_result ri;
+GSLERR(gsl_sf_complex_logsin_e,($zr(),$zi(),&r,&ri))
+$x() = r.val;
+$xe() = r.err;
+$y() = ri.val;
+$ye() = ri.err;
+',
+ Doc =>'Log(Sin(z)) for complex z'
+ );
+
+pp_def('gsl_sf_lnsinh',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_lnsinh_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Log(Sinh(x)) with GSL semantics.'
+ );
+
+pp_def('gsl_sf_lncosh',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_lncosh_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Log(Cos(x)) with GSL semantics.'
+ );
+
+pp_def('gsl_sf_polar_to_rect',
+ GenericTypes => [D],
+ Pars=>'double r(); double t(); double [o]x(); double [o]y(); double [o]xe(); double [o]ye()',
+ Code =>'
+gsl_sf_result r;
+gsl_sf_result ri;
+GSLERR(gsl_sf_polar_to_rect,($r(),$t(),&r,&ri))
+$x() = r.val;
+$xe() = r.err;
+$y() = ri.val;
+$ye() = ri.err;
+',
+ Doc =>'Convert polar to rectlinear coordinates.'
+ );
+
+pp_def('gsl_sf_rect_to_polar',
+ GenericTypes => [D],
+ Pars=>'double x(); double y(); double [o]r(); double [o]t(); double [o]re(); double [o]te()',
+ Code =>'
+gsl_sf_result r;
+gsl_sf_result ri;
+GSLERR(gsl_sf_rect_to_polar,($x(),$y(),&r,&ri))
+$r() = r.val;
+$re() = r.err;
+$t() = ri.val;
+$te() = ri.err;
+',
+ Doc =>'Convert rectlinear to polar coordinates. return argument in range [-pi, pi].'
+ );
+
+pp_def('gsl_sf_angle_restrict_symm',
+ GenericTypes => [D],
+ Pars=>'double [o]y();',
+ Code =>'
+GSLERR(gsl_sf_angle_restrict_symm_e,($P(y)))
+',
+ Doc =>'Force an angle to lie in the range (-pi,pi].'
+ );
+
+pp_def('gsl_sf_angle_restrict_pos',
+ GenericTypes => [D],
+ Pars=>'double [o]y();',
+ Code =>'
+GSLERR(gsl_sf_angle_restrict_pos_e,($P(y)))
+',
+ Doc =>'Force an angle to lie in the range [0,2 pi).'
+ );
+
+pp_def('gsl_sf_sin_err',
+ GenericTypes => [D],
+ Pars=>'double x(); double dx(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_sin_err_e,($x(),$dx(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Sin(x) for quantity with an associated error.'
+ );
+
+pp_def('gsl_sf_cos_err',
+ GenericTypes => [D],
+ Pars=>'double x(); double dx(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_cos_err_e,($x(),$dx(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Cos(x) for quantity with an associated error.'
+ );
+
+
+pp_addpm({At=>Bot},<<'EOD');
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/GSL/SF/zeta/Makefile.PL b/Lib/GSL/SF/zeta/Makefile.PL
new file mode 100644
index 0000000..8a91aef
--- /dev/null
+++ b/Lib/GSL/SF/zeta/Makefile.PL
@@ -0,0 +1,21 @@
+
+# Makefile.PL for a package defined by PP code.
+# DON'T CHANGE: AUTO GENERATED BY mkmkfiles.pl
+
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import;
+
+
+ at pack = (['gsl_sf_zeta.pd','ZETA','PDL::GSLSF::ZETA']);
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{INC} .= ' '.$GSL_includes;
+push @{$hash{LIBS}},$GSL_libs;
+WriteMakefile(%hash);
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+} # Add genpp rule
+
diff --git a/Lib/GSL/SF/zeta/gsl_sf_zeta.pd b/Lib/GSL/SF/zeta/gsl_sf_zeta.pd
new file mode 100644
index 0000000..f7d33d6
--- /dev/null
+++ b/Lib/GSL/SF/zeta/gsl_sf_zeta.pd
@@ -0,0 +1,79 @@
+pp_addpm({At=>Top},<<'EOD');
+=head1 NAME
+
+PDL::GSLSF::ZETA - PDL interface to GSL Special Functions
+
+=head1 DESCRIPTION
+
+This is an interface to the Special Function package present in the GNU Scientific Library.
+
+=head1 SYNOPSIS
+
+=cut
+
+
+EOD
+
+# PP interface to GSL
+
+pp_addhdr('
+#include <gsl/gsl_sf.h>
+#include "../gslerr.h"
+');
+
+pp_def('gsl_sf_zeta',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_zeta_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Riemann Zeta Function zeta(x) = Sum[ k^(-s), {k,1,Infinity} ], s != 1.0'
+ );
+
+pp_def('gsl_sf_hzeta',
+ GenericTypes => [D],
+ OtherPars =>'double q',
+ Pars=>'double s(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_hzeta_e,($s(), $COMP(q), &r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Hurwicz Zeta Function zeta(s,q) = Sum[ (k+q)^(-s), {k,0,Infinity} ]'
+ );
+
+pp_def('gsl_sf_eta',
+ GenericTypes => [D],
+ Pars=>'double x(); double [o]y(); double [o]e()',
+ Code =>'
+gsl_sf_result r;
+GSLERR(gsl_sf_eta_e,($x(),&r))
+$y() = r.val;
+$e() = r.err;
+',
+ Doc =>'Eta Function eta(s) = (1-2^(1-s)) zeta(s)'
+ );
+
+pp_addpm({At=>Bot},<<'EOD');
+
+=head1 AUTHOR
+
+This file copyright (C) 1999 Christian Pellegrin <chri at infis.univ.trieste.it>
+All rights reserved. There
+is no warranty. You are allowed to redistribute this software /
+documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+The GSL SF modules were written by G. Jungman.
+
+=cut
+
+
+EOD
+
+pp_done();
diff --git a/Lib/Image2D/Makefile.PL b/Lib/Image2D/Makefile.PL
new file mode 100644
index 0000000..c4db4b1
--- /dev/null
+++ b/Lib/Image2D/Makefile.PL
@@ -0,0 +1,36 @@
+
+# Makefile.PL for PDL::Image2D module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+ at pack = (["image2d.pd",Image2D,PDL::Image2D]);
+
+%hash = pdlpp_stdargs_int( @pack );
+$hash{LIBS} = [ '-lm' ];
+
+# On windows we do not have an rint function (at least on VC++)
+# Should do a proper test for rint similar to that done for
+# PDL::Math. For now, simply test architecture
+if ($^O =~ /MSWin/i) {
+ $hash{DEFINE} = " -DNEEDS_RINT";
+}
+
+# what code do we want compiled and linked in?
+# rotate.c is included directly into image2d.pd
+#
+# for $file ( qw( rotate resample ) ) {
+for $file ( qw( resample ) ) {
+ my $n = "$file\$(OBJ_EXT)";
+ $hash{OBJECT} .= " $n";
+ $hash{clean}{FILES} .= " $n";
+}
+
+WriteMakefile( %hash );
+
+# Add genpp rule
+sub MY::postamble { pdlpp_postamble_int(@::pack); }
+
diff --git a/Lib/Image2D/image2d.pd b/Lib/Image2D/image2d.pd
new file mode 100644
index 0000000..3ba7602
--- /dev/null
+++ b/Lib/Image2D/image2d.pd
@@ -0,0 +1,2417 @@
+use strict;
+use PDL::Types;
+
+pp_addpm({At=>'Top'},<<'EOD');
+
+=head1 NAME
+
+PDL::Image2D - Miscellaneous 2D image processing functions
+
+=head1 DESCRIPTION
+
+Miscellaneous 2D image processing functions - for want
+of anywhere else to put them.
+
+=head1 SYNOPSIS
+
+ use PDL::Image2D;
+
+=cut
+
+use PDL; # ensure qsort routine available
+use PDL::Math;
+use Carp;
+
+use strict;
+
+EOD
+
+pp_addpm({At=>'Bot'},<<'EOD');
+
+=head1 AUTHORS
+
+Copyright (C) Karl Glazebrook 1997 with additions by Robin Williams
+(rjrw at ast.leeds.ac.uk), Tim Jeness (timj at jach.hawaii.edu),
+and Doug Burke (burke at ifa.hawaii.edu).
+
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+EOD
+
+#################################################
+# BEGIN INTERNAL FUNCTION DECLARATIONS #
+#################################################
+
+pp_addhdr('
+#define MAXSEC 32
+#define line(x1, x2, y) for (k=x1;k<=x2;k++) \
+ { /* printf("line from %d to %d\n",x1,x2); */ \
+ image[k+wx*y] = col; }
+#define PX(n) ps[2*n]
+#define PY(n) ps[2*n+1]
+
+void polyfill(PDL_Long *image, int wx, int wy, float *ps, int n,
+ PDL_Long col, int *ierr)
+{
+ int ymin, ymax, xmin, xmax, fwrd = 1, i, j, k, nsect;
+ int x[MAXSEC], temp, l;
+ float s1, s2, t1, t2;
+
+ ymin = PY(0); ymax = PY(0);
+ xmin = PX(0); xmax = PX(0);
+ *ierr = 0;
+
+ for (i=1; i<n; i++) {
+ ymin = ymin > PY(i) ? PY(i) : ymin;
+ ymax = ymax < PY(i) ? PY(i) : ymax;
+ xmin = xmin > PX(i) ? PX(i) : xmin;
+ xmax = xmax < PX(i) ? PX(i) : xmax;
+ }
+ if (xmin < 0 || xmax >= wx || ymin < 0 || ymax >= wy) {
+ *ierr = 1; /* clipping */
+ return;
+ }
+ s1 = PX(n-1);
+ t1 = PY(n-1);
+ for (l=ymin; l<= ymax; l++) {
+ nsect = 0;
+ fwrd = 1;
+ for (i=0; i<n; i++) {
+ s2 = PX(i);
+ t2 = PY(i);
+ if ((t1 < l && l <= t2) || (t1 >= l && l > t2)) {
+ if (nsect > MAXSEC) {
+ *ierr = 2; /* too complex */
+ return;
+ }
+ x[nsect] = (s1+(s2-s1)*((l-t1)/(t2-t1)));
+ nsect += 1;
+ }
+ s1 = s2;
+ t1 = t2;
+ }
+ /* sort the intersections */
+ for (i=1; i<nsect; i++)
+ for (j=0; j<i; j++)
+ if (x[j] > x[i]) {
+ temp = x[j];
+ x[j] = x[i];
+ x[i] = temp;
+ }
+ if (fwrd) {
+ for (i=0; i<nsect-1; i += 2)
+ line(x[i],x[i+1],l);
+ fwrd = 0;
+ } else {
+ for (i=nsect-1; i>0; i -= 2)
+ line(x[i-1],x[i],l);
+ fwrd = 1;
+ }
+ }
+}
+
+');
+
+pp_def('polyfill_pp',
+ HandleBad => 0, # a marker
+ Pars => 'int [o,nc] im(m,n); float ps(two=2,np); int col()',
+ Code => 'int ierr = 0, nerr;
+ threadloop %{
+ polyfill($P(im), $SIZE(m), $SIZE(n), $P(ps), $SIZE(np), $col(), &nerr);
+ ierr = ierr < nerr ? nerr : ierr;
+ %}
+ if (ierr) warn("errors during polygonfilling");
+ ',
+ Doc => undef,
+ PMFunc => ''
+);
+
+my %pnpolyFields = (
+ 'pnpoly_pp' => {'pars' => 'a(m,n); ps(k,l); int [o] msk(m,n)', 'special' => '$msk() = c;'},
+ 'pnpolyfill_pp' => {'pars' => '[o,nc] a(m,n); ps(k,l); int col()', 'special' => 'if(c) { $a() = $col(); }'}
+);
+
+for my $name (keys %pnpolyFields) {
+ pp_def($name,
+ HandleBad => 0,
+ PMFunc => '',
+ Doc => undef,
+ Pars => $pnpolyFields{$name}->{'pars'},
+ Code => '
+ int i, j, c, nvert;
+ nvert = $SIZE(l);
+
+ #define VERTX(q) $ps(k=>0,l=>q)
+ #define VERTY(q) $ps(k=>1,l=>q)
+
+ threadloop %{
+ loop(n) %{
+ loop(m) %{
+ c = 0;
+ for(i=0,j=nvert-1;i<nvert;j=i++) {
+ if( ((VERTY(i)>n) != (VERTY(j)>n)) &&
+ (m < (VERTX(j)-VERTX(i)) * (n-VERTY(i)) / (VERTY(j)-VERTY(i)) + VERTX(i)) )
+ c = !c;
+ }
+ ' . $pnpolyFields{$name}->{'special'} .'
+ %}
+ %}
+ %}
+
+ #undef VERTX
+ #undef VERTY
+ '
+ );
+}
+
+pp_export_nothing(); # Clear the export list
+
+#################################################
+# END INTERNAL FUNCTION DECLARATIONS #
+#################################################
+
+
+pp_addhdr('
+
+#define IsNaN(x) (x != x)
+
+/* Fast Modulus with proper negative behaviour */
+
+#define REALMOD(a,b) {while ((a)>=(b)) (a) -= (b); while ((a)<0) (a) += (b);}
+
+/* rint is missing on some platforms (eg Win32) */
+
+#ifdef NEEDS_RINT
+#define rint(X) floor( X + 0.5 )
+#endif
+
+');
+
+for (keys %PDL::Types::typehash) {
+ my $ctype = $PDL::Types::typehash{$_}{ctype};
+ my $ppsym = $PDL::Types::typehash{$_}{ppsym};
+
+ pp_addhdr << "EOH";
+
+/*
+ * this routine is based on code referenced from
+ * http://www.eso.org/~ndevilla/median/
+ * the original algorithm is described in Numerical Recipes
+*/
+
+#define ELEM_SWAP(a,b) { register $ctype t=(a);(a)=(b);(b)=t; }
+
+$ctype quick_select_$ppsym($ctype arr[], int n)
+{
+ int low, high ;
+ int median;
+ int middle, ll, hh;
+
+ low = 0 ; high = n-1 ; median = (low + high) / 2;
+ for (;;) {
+ if (high <= low) /* One element only */
+ return arr[median] ;
+
+ if (high == low + 1) { /* Two elements only */
+ if (arr[low] > arr[high])
+ ELEM_SWAP(arr[low], arr[high]) ;
+ return arr[median] ;
+ }
+
+ /* Find median of low, middle and high items; swap into position low */
+ middle = (low + high) / 2;
+ if (arr[middle] > arr[high]) ELEM_SWAP(arr[middle], arr[high]) ;
+ if (arr[low] > arr[high]) ELEM_SWAP(arr[low], arr[high]) ;
+ if (arr[middle] > arr[low]) ELEM_SWAP(arr[middle], arr[low]) ;
+
+ /* Swap low item (now in position middle) into position (low+1) */
+ ELEM_SWAP(arr[middle], arr[low+1]) ;
+
+ /* Nibble from each end towards middle, swapping items when stuck */
+ ll = low + 1;
+ hh = high;
+ for (;;) {
+ do ll++; while (arr[low] > arr[ll]) ;
+ do hh--; while (arr[hh] > arr[low]) ;
+
+ if (hh < ll)
+ break;
+
+ ELEM_SWAP(arr[ll], arr[hh]) ;
+ }
+
+ /* Swap middle item (in position low) back into correct position */
+ ELEM_SWAP(arr[low], arr[hh]) ;
+
+ /* Re-set active partition */
+ if (hh <= median)
+ low = ll;
+ if (hh >= median)
+ high = hh - 1;
+ }
+}
+
+#undef ELEM_SWAP
+EOH
+
+}
+
+my %init =
+ (
+ i => { size => 'm_size', off => 'poff', init => '1-p_size' },
+ j => { size => 'n_size', off => 'qoff', init => '1-q_size' },
+ );
+
+# requires 'int $var, ${var}2' to have been declared in the c code
+# (along with [pq]off and [pq]_size)
+#
+sub init_map {
+ my $var = shift;
+
+ my $loop = $var;
+ my $loop2 = "${var}2";
+
+ my $href = $init{$var} ||
+ die "ERROR: unknown variable sent to init_map()\n";
+ my $size = $href->{size} ||
+ die "ERROR: unable to find size for $var\n";
+ my $off = $href->{off} ||
+ die "ERROR: unable to find off for $var\n";
+ my $init = $href->{init} ||
+ die "ERROR: unable to find init for $var\n";
+
+ return
+"for ( $loop = $init; $loop< $size; ${loop}++) {
+ $loop2 = $loop + $off;
+ switch (opt) {
+ case 1: /* REFLECT */
+ if (${loop2}<0)
+ $loop2 = -${loop2}-1;
+ else if ($loop2 >= $size)
+ $loop2 = 2*${size}-(${loop2}+1);
+ break;
+ case 2: /* TRUNCATE */
+ if (${loop2}<0 || ${loop2} >= $size)
+ $loop2 = -1;
+ break;
+ case 3: /* REPLICATE */
+ if (${loop2}<0)
+ $loop2 = 0;
+ if (${loop2} >= $size)
+ $loop2 = $size-1;
+ break;
+ default:
+ REALMOD($loop2,$size);
+ }
+ map${var}\[$loop] = $loop2;
+ }\n";
+
+} # sub: init_map()
+
+sub init_vars {
+ my $href = shift || { };
+ $href->{vars} = '' unless defined $href->{vars};
+ $href->{malloc} = '' unless defined $href->{malloc};
+ $href->{check} = '' unless defined $href->{check};
+
+ my $str = $href->{vars};
+ $str .= "int i,j, i1,j1, i2,j2, poff, qoff;";
+ $str .=
+ 'int opt = $COMP(opt);
+ int m_size = $COMP(__m_size);
+ int n_size = $COMP(__n_size);
+ int p_size = $COMP(__p_size);
+ int q_size = $COMP(__q_size);
+ int *mapi, *mapj;
+
+ mapi = (int *) malloc((p_size+m_size)*sizeof(int));
+ mapj = (int *) malloc((q_size+n_size)*sizeof(int));
+ ';
+ $str .= $href->{malloc} . "\n";
+ $str .= "if ($href->{check} (mapi==NULL) || (mapj==NULL))\n";
+ $str .= ' barf("Out of Memory");
+
+ poff = p_size/2; mapi += p_size-1;
+ qoff = q_size/2; mapj += q_size-1;
+';
+
+ return $str;
+} # sub: init_vars()
+
+pp_def('conv2d', Doc=><<'EOD',
+
+=for ref
+
+2D convolution of an array with a kernel (smoothing)
+
+For large kernels, using a FFT routine,
+such as L<fftconvolve()|PDL::FFT/fftconvolve()> in C<PDL::FFT>,
+will be quicker.
+
+=for usage
+
+ $new = conv2d $old, $kernel, {OPTIONS}
+
+=for example
+
+ $smoothed = conv2d $image, ones(3,3), {Boundary => Reflect}
+
+=for options
+
+ Boundary - controls what values are assumed for the image when kernel
+ crosses its edge:
+ => Default - periodic boundary conditions
+ (i.e. wrap around axis)
+ => Reflect - reflect at boundary
+ => Truncate - truncate at boundary
+ => Replicate - repeat boundary pixel values
+
+=cut
+
+EOD
+ BadDoc =>
+'Unlike the FFT routines, conv2d is able to process bad values.',
+ HandleBad => 1,
+ Pars => 'a(m,n); kern(p,q); [o]b(m,n);',
+ OtherPars => 'int opt;',
+ PMCode => '
+
+sub PDL::conv2d {
+ my $opt; $opt = pop @_ if ref($_[$#_]) eq \'HASH\';
+ die \'Usage: conv2d( a(m,n), kern(p,q), [o]b(m,n), {Options} )\'
+ if $#_<1 || $#_>2;
+ my($a,$kern) = @_;
+ my $c = $#_ == 2 ? $_[2] : $a->nullcreate;
+ &PDL::_conv2d_int($a,$kern,$c,
+ (!(defined $opt && exists $$opt{Boundary}))?0:
+ (($$opt{Boundary} eq "Reflect") +
+ 2*($$opt{Boundary} eq "Truncate") +
+ 3*($$opt{Boundary} eq "Replicate")));
+ return $c;
+}
+
+',
+ Code =>
+ init_vars( { vars => 'PDL_Double tmp;' } ) .
+ init_map("i") .
+ init_map("j") .
+'
+ threadloop %{
+ for(j=0; j<n_size; j++) {
+ for(i=0; i<m_size; i++) {
+ tmp = 0;
+ for(j1=0; j1<q_size; j1++) {
+ j2 = mapj[j-j1];
+
+ if (j2 >= 0) {
+ for(i1=0; i1<p_size; i1++) {
+ i2 = mapi[i-i1];
+ if (i2 >= 0)
+ tmp += $a(m=>i2,n=>j2) * $kern(p=>i1,q=>j1);
+ } /* for: i1 */
+ } /* if: j2 >= 0 */
+ } /* for: j1 */
+ $b(m=>i,n=>j) = tmp;
+ } /* for: i */
+ } /* for: j */
+ %}
+ free(mapj+1-q_size); free(mapi+1-p_size);',
+ BadCode =>
+ init_vars( { vars => 'PDL_Double tmp; int flag;' } ) .
+ init_map("i") .
+ init_map("j") .
+'
+ threadloop %{
+ for(j=0; j<n_size; j++) {
+ for(i=0; i<m_size; i++) {
+ tmp = 0;
+ for(j1=0; j1<q_size; j1++) {
+ j2 = mapj[j-j1];
+
+ if (j2 >= 0) {
+ for(i1=0; i1<p_size; i1++) {
+ i2 = mapi[i-i1];
+ if (i2 >= 0) {
+ if ( $ISGOOD(a(m=>i2,n=>j2)) && $ISGOOD(kern(p=>i1,q=>j1)) ) {
+ tmp += $a(m=>i2,n=>j2) * $kern(p=>i1,q=>j1);
+ flag = 1;
+ } /* if: good */
+ } /* if: i2 >= 0 */
+ } /* for: i1 */
+ } /* if: j2 >= 0 */
+ } /* for: j1 */
+ if ( flag ) { $b(m=>i,n=>j) = tmp; }
+ else { $SETBAD(b(m=>i,n=>j)); }
+ } /* for: i */
+ } /* for: j */
+ %}
+ free(mapj+1-q_size); free(mapi+1-p_size);',
+
+); # pp_def: conv2d
+
+pp_def('med2d', Doc=> <<'EOD',
+
+=for ref
+
+2D median-convolution of an array with a kernel (smoothing)
+
+Note: only points in the kernel E<gt>0 are included in the median, other
+points are weighted by the kernel value (medianing lots of zeroes
+is rather pointless)
+
+=for usage
+
+ $new = med2d $old, $kernel, {OPTIONS}
+
+=for example
+
+ $smoothed = med2d $image, ones(3,3), {Boundary => Reflect}
+
+=for options
+
+ Boundary - controls what values are assumed for the image when kernel
+ crosses its edge:
+ => Default - periodic boundary conditions (i.e. wrap around axis)
+ => Reflect - reflect at boundary
+ => Truncate - truncate at boundary
+ => Replicate - repeat boundary pixel values
+
+=cut
+
+EOD
+ BadDoc =>
+'Bad values are ignored in the calculation. If all elements within the
+kernel are bad, the output is set bad.',
+ HandleBad => 1,
+ Pars => 'a(m,n); kern(p,q); [o]b(m,n);',
+ OtherPars => 'int opt;',
+ PMCode => '
+
+sub PDL::med2d {
+ my $opt; $opt = pop @_ if ref($_[$#_]) eq \'HASH\';
+ die \'Usage: med2d( a(m,n), kern(p,q), [o]b(m,n), {Options} )\'
+ if $#_<1 || $#_>2;
+ my($a,$kern) = @_;
+ croak "med2d: kernel must contain some positive elements.\n"
+ if all( $kern <= 0 );
+ my $c = $#_ == 2 ? $_[2] : $a->nullcreate;
+ &PDL::_med2d_int($a,$kern,$c,
+ (!(defined $opt && exists $$opt{Boundary}))?0:
+ (($$opt{Boundary} eq "Reflect") +
+ 2*($$opt{Boundary} eq "Truncate") +
+ 3*($$opt{Boundary} eq "Replicate")));
+ return $c;
+}
+
+',
+ Code =>
+ init_vars( { vars => 'PDL_Double *tmp, kk; int count;',
+ malloc => 'tmp = malloc(p_size*q_size*sizeof(PDL_Double));',
+ check => '(tmp==NULL) || ' } ) .
+ init_map("i") .
+ init_map("j") .
+'
+ threadloop %{
+ for(j=0; j<n_size; j++) {
+ for(i=0; i<m_size; i++) {
+ count = 0;
+ for(j1=0; j1<q_size; j1++) {
+ j2 = mapj[j-j1];
+
+ if (j2 >= 0)
+ for(i1=0; i1<p_size; i1++) {
+ i2 = mapi[i-i1];
+ if (i2 >= 0) {
+ kk = $kern(p=>i1,q=>j1);
+ if (kk>0) {
+ tmp[count++] = $a(m=>i2,n=>j2) * kk;
+ }
+ } /* if: i2 >= 0 */
+ } /* for: i1 */
+ } /* for: j1 */
+
+ PDL->qsort_D( tmp, 0, count-1 );
+ $b(m=>i,n=>j) = tmp[(count-1)/2];
+
+ } /* for: i */
+ } /* for: j */
+ %}
+ free(mapj+1-q_size); free(mapi+1-p_size); free(tmp);
+',
+ BadCode =>
+ init_vars( { vars => 'PDL_Double *tmp, kk, aa; int count, flag;',
+ malloc => 'tmp = malloc(p_size*q_size*sizeof(PDL_Double));',
+ check => '(tmp==NULL) || ' } ) .
+ init_map("i") .
+ init_map("j") .
+'
+ threadloop %{
+ for(j=0; j<n_size; j++) {
+ for(i=0; i<m_size; i++) {
+ count = 0;
+ flag = 0;
+ for(j1=0; j1<q_size; j1++) {
+ j2 = mapj[j-j1];
+
+ if (j2 >= 0)
+ for(i1=0; i1<p_size; i1++) {
+ i2 = mapi[i-i1];
+ if (i2 >= 0) {
+ kk = $kern(p=>i1,q=>j1);
+ aa = $a(m=>i2,n=>j2);
+ if ( $ISGOODVAR(kk,kern) && $ISGOODVAR(aa,a) ) {
+ flag = 1;
+ if ( kk > 0 ) {
+ tmp[count++] = aa * kk;
+ }
+ }
+ } /* if: i2 >= 0 */
+ } /* for: i1 */
+ } /* for: j1 */
+ if ( flag == 0 ) {
+ $SETBAD(b(m=>i,n=>j));
+ } else {
+
+ PDL->qsort_D( tmp, 0, count-1 );
+ $b(m=>i,n=>j) = tmp[(count-1)/2];
+
+ }
+ } /* for: i */
+ } /* for: j */
+ %}
+ free(mapj+1-q_size); free(mapi+1-p_size); free(tmp);
+'
+
+); # pp_def: med2d
+
+pp_def('med2df', Doc=> <<'EOD',
+
+=for ref
+
+2D median-convolution of an array in a pxq window (smoothing)
+
+Note: this routine does the median over all points in a rectangular
+ window and is not quite as flexible as C<med2d> in this regard
+ but slightly faster instead
+
+=for usage
+
+ $new = med2df $old, $xwidth, $ywidth, {OPTIONS}
+
+=for example
+
+ $smoothed = med2df $image, 3, 3, {Boundary => Reflect}
+
+=for options
+
+ Boundary - controls what values are assumed for the image when kernel
+ crosses its edge:
+ => Default - periodic boundary conditions (i.e. wrap around axis)
+ => Reflect - reflect at boundary
+ => Truncate - truncate at boundary
+ => Replicate - repeat boundary pixel values
+
+=cut
+
+EOD
+ Pars => 'a(m,n); [o]b(m,n);',
+ # funny parameter names to avoid special case in 'init_vars'
+ OtherPars => 'int __p_size; int __q_size; int opt;',
+ PMCode => '
+
+sub PDL::med2df {
+ my $opt; $opt = pop @_ if ref($_[$#_]) eq \'HASH\';
+ die \'Usage: med2df( a(m,n), [o]b(m,n), p, q, {Options} )\'
+ if $#_<2 || $#_>3;
+ my($a,$p,$q) = @_;
+ croak "med2df: kernel must contain some positive elements.\n"
+ if $p == 0 && $q == 0;
+ my $c = $#_ == 3 ? $_[3] : $a->nullcreate;
+ &PDL::_med2df_int($a,$c,$p,$q,
+ (!(defined $opt && exists $$opt{Boundary}))?0:
+ (($$opt{Boundary} eq "Reflect") +
+ 2*($$opt{Boundary} eq "Truncate") +
+ 3*($$opt{Boundary} eq "Replicate")));
+ return $c;
+}
+
+',
+ Code =>
+ init_vars( { vars => '$GENERIC() *tmp, kk; int count;',
+ malloc => 'tmp = malloc(p_size*q_size*sizeof($GENERIC()));',
+ check => '(tmp==NULL) || ' } ) .
+ init_map("i") .
+ init_map("j") .
+'
+ threadloop %{
+ for(j=0; j<n_size; j++) {
+ for(i=0; i<m_size; i++) {
+ count = 0;
+ for(j1=0; j1<q_size; j1++) {
+ j2 = mapj[j-j1];
+
+ if (j2 >= 0)
+ for(i1=0; i1<p_size; i1++) {
+ i2 = mapi[i-i1];
+ if (i2 >= 0) {
+ tmp[count++] = $a(m=>i2,n=>j2);
+ } /* if: i2 >= 0 */
+ } /* for: i1 */
+ } /* for: j1 */
+
+ $b(m=>i,n=>j) =
+ quick_select_$TBSULNQFD(B,S,U,L,N,Q,F,D) (tmp, count );
+
+ } /* for: i */
+ } /* for: j */
+ %}
+ free(mapj+1-q_size); free(mapi+1-p_size); free(tmp);
+',
+
+); # pp_def: med2df
+
+pp_addhdr(<<'EOH');
+#define EZ(x) ez ? 0 : (x)
+EOH
+pp_def('box2d',
+ Pars => 'a(n,m); [o] b(n,m)',
+ OtherPars => 'int wx; int wy; int edgezero',
+ Code => '
+ register int nx = 0.5*$COMP(wx);
+ register int ny = 0.5*$COMP(wy);
+ register int xs = $SIZE(n);
+ register int ys = $SIZE(m);
+ register int ez = $COMP(edgezero);
+ double div, sum, lsum;
+ int xx,yy,y,ind1,ind2,first;
+
+ div = 1/((2.0*nx+1)*(2.0*ny+1));
+
+ threadloop %{
+ first = 1;
+ for (y=0;y<ys;y++)
+ for (xx=0; xx<nx; xx++) {
+ ind1 = xs-1-xx; /* rightmost strip */
+ $b(n=>xx,m=>y) = EZ($a(n=>xx,m=>y));
+ $b(n=>ind1,m=>y) = EZ($a(n=>ind1,m=>y));
+ }
+ for (xx=0;xx<xs;xx++)
+ for (y=0; y<ny; y++) {
+ ind1 = ys-1-y; /* topmost strip */
+ $b(n=>xx,m=>y) = EZ($a(n=>xx,m=>y));
+ $b(n=>xx,m=>ind1) = EZ($a(n=>xx,m=>ind1));
+ }
+ for (y=ny;y<ys-ny;y++) {
+ if (first) {
+ first = 0;
+ lsum = 0;
+ for (yy=y-ny;yy<=y+ny;yy++) /* initialize sum */
+ for (xx=0;xx<=2*nx;xx++)
+ lsum += $a(n=>xx,m=>yy);
+ } else {
+ ind1 = y-ny-1;
+ ind2 = y+ny;
+ for (xx=0;xx<=2*nx;xx++) {
+ lsum -= $a(n=>xx,m=>ind1); /* remove top pixels */
+ lsum += $a(n=>xx,m=>ind2); /* add bottom pixels */
+ }
+ }
+ sum = lsum;
+ $b(n=>nx,m=>y) = div*sum; /* and assign */
+ for (xx=nx+1;xx<xs-nx;xx++) { /* loop along line */
+ ind1 = xx-nx-1;
+ ind2 = xx+nx;
+ for (yy=y-ny;yy<=y+ny;yy++) {
+ sum -= $a(n=>ind1,m=>yy); /* remove leftmost data */
+ sum += $a(n=>ind2,m=>yy); /* and add rightmost */
+ }
+ $b(n=>xx,m=>y) = div*sum; /* and assign */
+ }
+ }
+ %}',
+ Doc => << 'EOD',
+
+=for ref
+
+fast 2D boxcar average
+
+=for example
+
+ $smoothim = $im->box2d($wx,$wy,$edgezero=1);
+
+The edgezero argument controls if edge is set to zero (edgezero=1)
+or just keeps the original (unfiltered) values.
+
+C<box2d> should be updated to support similar edge options
+as C<conv2d> and C<med2d> etc.
+
+Boxcar averaging is a pretty crude way of filtering. For serious stuff
+better filters are around (e.g., use L<conv2d|conv2d> with the appropriate
+kernel). On the other hand it is fast and computational cost grows only
+approximately linearly with window size.
+
+=cut
+
+EOD
+); # pp_def box2d
+
+=head2 patch2d
+
+=cut
+
+pp_def('patch2d',
+ Doc=><<'EOD',
+
+=for ref
+
+patch bad pixels out of 2D images using a mask
+
+=for usage
+
+ $patched = patch2d $data, $bad;
+
+C<$bad> is a 2D mask array where 1=bad pixel 0=good pixel.
+Pixels are replaced by the average of their non-bad neighbours;
+if all neighbours are bad, the original data value is
+copied across.
+
+=cut
+
+EOD
+ BadDoc =>
+'This routine does not handle bad values - use L<patchbad2d|/patchbad2d> instead',
+ HandleBad => 0,
+ Pars => 'a(m,n); int bad(m,n); [o]b(m,n);',
+ Code =>
+ 'int m_size, n_size, i,j, i1,j1, i2,j2, norm;
+ double tmp;
+
+ m_size = $COMP(__m_size); n_size = $COMP(__n_size);
+
+ threadloop %{
+
+ for(j=0; j<n_size; j++) {
+ for(i=0; i<m_size; i++) {
+
+ $b(m=>i,n=>j) = $a(m=>i,n=>j);
+
+ if ( $bad(m=>i,n=>j)==1 ) {
+ tmp = 0; norm=0;
+ for(j1=-1; j1<=1; j1++) {
+ j2 = j+j1;
+ if ( j2>=0 && j2<n_size ) {
+ for(i1=-1; i1<=1; i1++) {
+ /* ignore central pixel, which we know is bad */
+ if ( i1!=0 || j1!=0 ) {
+ i2 = i+i1;
+ if ( i2>=0 && i2<m_size && $bad(m=>i2,n=>j2)!=1 ) {
+ tmp += $a(m=>i2,n=>j2);
+ norm++;
+ }
+ } /* if: i1!=0 || j1!=0 */
+ } /* for: i1 */
+ }
+ } /* for: j1 */
+
+ if (norm>0) { /* Patch */
+ $b(m=>i,n=>j) = tmp/norm;
+ }
+
+ } /* if: bad() */
+
+ } /* for: i */
+ } /* for: j */
+
+ %} /* threadloop */
+
+ ', # Code
+);
+
+pp_def('patchbad2d',
+ Doc=><<'EOD',
+
+=for ref
+
+patch bad pixels out of 2D images containing bad values
+
+=for usage
+
+ $patched = patchbad2d $data;
+
+Pixels are replaced by the average of their non-bad neighbours;
+if all neighbours are bad, the output is set bad.
+If the input piddle contains I<no> bad values, then a straight copy
+is performed (see L<patch2d|/patch2d>).
+
+=cut
+
+EOD
+ BadDoc =>
+'patchbad2d handles bad values. The output piddle I<may> contain
+bad values, depending on the pattern of bad values in the input piddle.',
+ HandleBad => 1,
+ Pars => 'a(m,n); [o]b(m,n);',
+ Code => 'loop(n,m) %{ $b() = $a(); %}', # just copy
+ CopyBadStatusCode => '', # handled by BadCode
+ BadCode =>
+ 'int m_size, n_size, i,j, i1,j1, i2,j2, norm, flag;
+ double tmp;
+ $GENERIC(a) a_val;
+
+ flag = 0;
+ m_size = $COMP(__m_size); n_size = $COMP(__n_size);
+
+ threadloop %{
+
+ for(j=0; j<n_size; j++) {
+ for(i=0; i<m_size; i++) {
+
+ a_val = $a(m=>i,n=>j);
+ if ( $ISGOODVAR(a_val,a) ) {
+ $b(m=>i,n=>j) = a_val;
+
+ } else {
+ tmp = 0; norm=0;
+ for(j1=-1; j1<=1; j1++) {
+ j2 = j+j1;
+ if ( j2>=0 && j2<n_size ) {
+ for(i1=-1; i1<=1; i1++) {
+ /* ignore central pixel, which we know is bad */
+ if ( i1!=0 || j1!=0 ) {
+ i2 = i+i1;
+ if ( i2>=0 && i2<m_size ) {
+ a_val = $a(m=>i2,n=>j2);
+ if ( $ISGOODVAR(a_val,a) ) {
+ tmp += a_val;
+ norm++;
+ }
+ }
+ } /* if: i1!=0 || j1!=0 */
+ } /* for: i1 */
+ }
+ } /* for: j1 */
+
+ /* Patch */
+ if (norm>0) {
+ $b(m=>i,n=>j) = tmp/norm;
+ } else {
+ $SETBAD(b(m=>i,n=>j));
+ flag = 1;
+ }
+
+ } /* if: ISGOODVAR() */
+
+ } /* for: i */
+ } /* for: j */
+
+ %} /* threadloop */
+
+ /* handle bad flag */
+ if ( flag ) $PDLSTATESETBAD(b);
+ ', # BadCode
+);
+
+pp_def('max2d_ind',
+ Doc=><<'EOD',
+
+=for ref
+
+Return value/position of maximum value in 2D image
+
+Contributed by Tim Jeness
+
+=cut
+
+EOD
+
+ BadDoc=><<'EOD',
+
+Bad values are excluded from the search. If all pixels
+are bad then the output is set bad.
+
+EOD
+
+ HandleBad => 1,
+ Pars => 'a(m,n); [o]val(); int [o]x(); int[o]y();',
+ Code => '
+ double cur; int curind1; int curind2;
+ curind1=0;
+ curind2=0;
+ loop(m) %{
+ loop(n) %{
+ if((!m && !n) || $a() > cur || IsNaN(cur)) {
+ cur = $a(); curind1 = m; curind2 = n;
+ }
+ %}
+ %}
+ $val() = cur;
+ $x() = curind1;
+ $y() = curind2;
+ ',
+ BadCode => '
+ double cur; int curind1; int curind2;
+ curind1 = -1;
+ curind2 = -1;
+ loop(m) %{
+ loop(n) %{
+ if( $ISGOOD(a()) && ( (!n && !m) || ($a() > cur) ) ) {
+ cur = $a(); curind1 = m; curind2 = n;
+ }
+ %}
+ %}
+ if ( curind1 < 0 ) {
+ $SETBAD(val());
+ $SETBAD(x());
+ $SETBAD(y());
+ } else {
+ $val() = cur;
+ $x() = curind1;
+ $y() = curind2;
+ }
+ ');
+
+pp_def('centroid2d',
+
+ Doc=><<'EOD',
+
+=for ref
+
+Refine a list of object positions in 2D image by centroiding in a box
+
+C<$box> is the full-width of the box, i.e. the window
+is C<+/- $box/2>.
+
+=cut
+
+EOD
+
+ BadDoc=><<'EOD',
+Bad pixels are excluded from the centroid calculation. If all elements are
+bad (or the pixel sum is 0 - but why would you be centroiding
+something with negatives in...) then the output values are set bad.
+
+EOD
+
+ HandleBad => 1,
+ Pars => 'im(m,n); x(); y(); box(); [o]xcen(); [o]ycen();',
+
+ Code => '
+ int i,j,i1,i2,j1,j2,m_size,n_size;
+ double sum,data,sumx,sumy;
+
+ m_size = $SIZE(m); n_size = $SIZE(n);
+
+ i1 = $x() - $box()/2; i1 = i1<0 ? 0 : i1;
+ i2 = $x() + $box()/2; i2 = i2>=m_size ? m_size-1 : i2;
+ j1 = $y() - $box()/2; j1 = j1<0 ? 0 : j1;
+ j2 = $y() + $box()/2; j2 = j2>=n_size ? n_size-1 : j2;
+
+ sum = sumx = sumy = 0;
+ for(j=j1; j<=j2; j++) { for(i=i1; i<=i2; i++) {
+ data = $im(m=>i,n=>j);
+ sum += data;
+ sumx += data*i;
+ sumy += data*j;
+ }}
+ $xcen() = sumx/sum;
+ $ycen() = sumy/sum;
+',
+
+ BadCode => '
+ int i,j,i1,i2,j1,j2,m_size,n_size;
+ double sum,data,sumx,sumy;
+
+ m_size = $SIZE(m); n_size = $SIZE(n);
+
+ i1 = $x() - $box()/2; i1 = i1<0 ? 0 : i1;
+ i2 = $x() + $box()/2; i2 = i2>=m_size ? m_size-1 : i2;
+ j1 = $y() - $box()/2; j1 = j1<0 ? 0 : j1;
+ j2 = $y() + $box()/2; j2 = j2>=n_size ? n_size-1 : j2;
+
+ sum = sumx = sumy = 0;
+ for(j=j1; j<=j2; j++) {
+ for(i=i1; i<=i2; i++) {
+ data = $im(m=>i,n=>j);
+ if ( $ISGOODVAR(data,im) ) {
+ sum += data;
+ sumx += data*i;
+ sumy += data*j;
+ }
+ }
+ }
+ /*
+ * if sum == 0 then we will flag as bad -- although it could just mean that
+ * there is negative values in the dataset.
+ * - should use a better check than != 0.0 ...
+ */
+ if ( sum != 0.0 ) {
+ $xcen() = sumx/sum;
+ $ycen() = sumy/sum;
+ } else {
+ $SETBAD(xcen());
+ $SETBAD(ycen());
+ }
+'
+);
+
+pp_addhdr('
+
+/* Add an equivalence to a list - used by pdl_ccNcompt */
+
+void AddEquiv ( PDL_Long* equiv, PDL_Long i, PDL_Long j) {
+
+ PDL_Long k, tmp;
+
+ if (i==j)
+ return;
+
+ k = j;
+ do {
+ k = equiv[k];
+ } while ( k != j && k != i );
+
+ if ( k == j ) {
+ tmp = equiv[i];
+ equiv[i] = equiv[j];
+ equiv[j] = tmp;
+ }
+}
+
+');
+
+pp_add_exported('', 'cc8compt','cc4compt');
+pp_addpm(<<'EOPM');
+
+=head2 cc8compt
+
+=for ref
+
+Connected 8-component labeling of a binary image.
+
+Connected 8-component labeling of 0,1 image - i.e. find separate
+segmented objects and fill object pixels with object number.
+8-component labeling includes all neighboring pixels.
+This is just a front-end to ccNcompt. See also L<cc4compt|cc4compt>.
+
+=for example
+
+ $segmented = cc8compt( $image > $threshold );
+
+=head2 cc4compt
+
+=for ref
+
+Connected 4-component labeling of a binary image.
+
+Connected 4-component labeling of 0,1 image - i.e. find separate
+segmented objects and fill object pixels with object number.
+4-component labling does not include the diagonal neighbors.
+This is just a front-end to ccNcompt. See also L<cc8compt|cc8compt>.
+
+=for example
+
+ $segmented = cc4compt( $image > $threshold );
+
+=cut
+
+sub PDL::cc8compt{
+return ccNcompt(shift,8);
+}
+*cc8compt = \&PDL::cc8compt;
+
+sub PDL::cc4compt{
+return ccNcompt(shift,4);
+}
+*cc4compt = \&PDL::cc4compt;
+
+EOPM
+
+pp_def('ccNcompt',Doc=>'
+
+=for ref
+
+Connected component labeling of a binary image.
+
+Connected component labeling of 0,1 image - i.e. find separate
+segmented objects and fill object pixels with object number.
+See also L<cc4compt|cc4compt> and L<cc8compt|cc8compt>.
+
+The connectivity parameter must be 4 or 8.
+
+=for example
+
+ $segmented = ccNcompt( $image > $threshold, 4);
+
+ $segmented2 = ccNcompt( $image > $threshold, 8);
+
+where the second parameter specifies the connectivity (4 or 8) of the labeling.
+
+=cut
+
+',
+ HandleBad => 0, # a marker
+ Pars => 'a(m,n); [o]b(m,n);',
+ OtherPars => 'int con',
+ Code => '
+
+ PDL_Long i,j,k;
+ PDL_Long newlabel;
+ PDL_Long neighbour[4];
+ PDL_Long nfound;
+ PDL_Long pass,count,next,this;
+ PDL_Long *equiv;
+ PDL_Long i1,j1,i2;
+ PDL_Long nx = $SIZE(m);
+ PDL_Long ny = $SIZE(n);
+
+ if ($COMP(con)!=4 && $COMP(con)!=8)
+ barf("In ccNcompt, connectivity must be 4 or 8, you gave %d",$COMP(con));
+ loop(n) %{ loop(m) %{ /* Copy */
+ $b() = $a();
+ %} %}
+
+ /* 1st pass counts max possible compts, 2nd records equivalences */
+
+ for (pass = 0; pass<2; pass++) {
+
+ if (pass==1) {
+ equiv = (PDL_Long*) malloc((newlabel+1)*sizeof(PDL_Long));
+ if (equiv==(PDL_Long*)0)
+ barf("Out of memory");
+ for(i=0;i<=newlabel;i++)
+ equiv[i]=i;
+ }
+
+ newlabel = 1; /* Running label */
+
+ for(j=0; j<ny; j++) { for(i=0; i<nx; i++) { /* Loop over image pixels */
+
+ nfound = 0; /* Number of neighbour >0 */
+
+ i1 = i-1; j1 = j-1; i2 = i+1; /*West x, North y, East x*/
+
+ if ($b(m=>i, n=>j) > 0) { /* Check 4 neighbour already seen */
+
+ if (i>0 && $b(m=>i1, n=>j)>0) /*West*/
+ neighbour[nfound++] = $b(m=>i1, n=>j); /* Store label of it */
+ if (j>0 && $b(m=>i, n=>j1)>0) /*North*/
+ neighbour[nfound++] = $b(m=>i, n=>j1);
+ if (j>0 && i>0 && $b(m=>i1, n=>j1)>0 && $COMP(con)==8) /*North-West*/
+ neighbour[nfound++] = $b(m=>i1, n=>j1);
+ if (j>0 && i<(nx-1) && $b(m=>i2, n=>j1)>0 && $COMP(con)==8) /*North-East*/
+ neighbour[nfound++] = $b(m=>i2, n=>j1);
+
+ if (nfound==0) { /* Assign new label */
+ $b(m=>i, n=>j) = newlabel++;
+ }
+ else {
+ $b(m=>i, n=>j) = neighbour[0];
+ if (nfound>1 && pass == 1) { /* Assign equivalents */
+ for(k=1; k<nfound; k++)
+ AddEquiv( equiv, (PDL_Long)$b(m=>i, n=>j),
+ neighbour[k] );
+ }
+ }
+ }
+
+ else { /* No label */
+
+ $b(m=>i, n=>j) = 0;
+ }
+
+ }} /* End of image loop */
+
+ } /* Passes */
+
+ /* Replace each cycle by single label */
+
+ count = 0;
+ for (i = 1; i <= newlabel; i++)
+ if ( i <= equiv[i] ) {
+ count++;
+ this = i;
+ while ( equiv[this] != i ) {
+ next = equiv[this];
+ equiv[this] = count;
+ this = next;
+ }
+ equiv[this] = count;
+ }
+
+
+ /* Now remove equivalences */
+
+ for(j=0; j<ny; j++) { for(i=0; i<nx; i++) { /* Loop over image pixels */
+ $b(m=>i, n=>j) = equiv[ (PDL_Long) $b(m=>i, n=>j) ] ;
+ }}
+
+ free(equiv); /* Tidy */
+');
+
+pp_add_exported('polyfill');
+pp_addpm(<<'EOPM');
+=head2 polyfill
+
+=for ref
+
+fill the area of the given polygon with the given colour.
+
+This function works inplace, i.e. modifies C<im>.
+
+=for usage
+
+ polyfill($im,$ps,$colour,[\%options]);
+
+The default method of determining which points lie inside of the polygon used
+is not as strict as the method used in L<pnpoly|pnpoly>. Often, it includes vertices
+and edge points. Set the C<Method> option to change this behaviour.
+
+=for option
+
+Method - Set the method used to determine which points lie in the polygon.
+ => Default - internal PDL algorithm
+ => pnpoly - use the L<pnpoly|pnpoly> algorithm
+
+=for example
+
+ # Make a convex 3x3 square of 1s in an image using the pnpoly algorithm
+ $ps = pdl([3,3],[3,6],[6,6],[6,3]);
+ polyfill($im,$ps,1,{'Method' =>'pnpoly'});
+
+=cut
+sub PDL::polyfill {
+ my $opt;
+ $opt = pop @_ if ref($_[-1]) eq 'HASH';
+ barf('Usage: polyfill($im,$ps,$colour,[\%options])') unless @_==3;
+ my ($im,$ps,$colour) = @_;
+
+ if($opt) {
+ use PDL::Options qw();
+ my $parsed = PDL::Options->new({'Method' => undef});
+ $parsed->options($opt);
+ if( $parsed->current->{'Method'} eq 'pnpoly' ) {
+ PDL::pnpolyfill_pp($im,$ps,$colour);
+ }
+ }
+ else
+ {
+ PDL::polyfill_pp($im,$ps,$colour);
+ }
+ return $im;
+
+}
+
+*polyfill = \&PDL::polyfill;
+
+EOPM
+
+pp_add_exported('', 'pnpoly');
+pp_addpm(<<'EOPM');
+
+=head2 pnpoly
+
+=for ref
+
+'points in a polygon' selection from a 2-D piddle
+
+=for usage
+
+ $mask = $img->pnpoly($ps);
+
+ # Old style, do not use
+ $mask = pnpoly($x, $y, $px, $py);
+
+For a closed polygon determined by the sequence of points in {$px,$py}
+the output of pnpoly is a mask corresponding to whether or not each
+coordinate (x,y) in the set of test points, {$x,$y}, is in the interior
+of the polygon. This is the 'points in a polygon' algorithm from
+L<http://www.ecse.rpi.edu/Homepages/wrf/Research/Short_Notes/pnpoly.html>
+and vectorized for PDL by Karl Glazebrook.
+
+=for example
+
+ # define a 3-sided polygon (a triangle)
+ $ps = pdl([3, 3], [20, 20], [34, 3]);
+
+ # $tri is 0 everywhere except for points in polygon interior
+ $tri = $img->pnpoly($ps);
+
+ With the second form, the x and y coordinates must also be specified.
+ B< I<THIS IS MAINTAINED FOR BACKWARD COMPATIBILITY ONLY> >.
+
+ $px = pdl( 3, 20, 34 );
+ $py = pdl( 3, 20, 3 );
+ $x = $img->xvals; # get x pixel coords
+ $y = $img->yvals; # get y pixel coords
+
+ # $tri is 0 everywhere except for points in polygon interior
+ $tri = pnpoly($x,$y,$px,$py);
+
+=cut
+
+# From: http://www.ecse.rpi.edu/Homepages/wrf/Research/Short_Notes/pnpoly.html
+#
+# Fixes needed to pnpoly code:
+#
+# Use topdl() to ensure piddle args
+#
+# Add POD docs for usage
+#
+# Calculate first term in & expression to use to fix divide-by-zero when
+# the test point is in line with a vertical edge of the polygon.
+# By adding the value of $mask we prevent a divide-by-zero since the &
+# operator does not "short circuit".
+
+sub PDL::pnpoly {
+ barf('Usage: $mask = pnpoly($img, $ps);') unless(@_==2 || @_==4);
+ my ($tx, $ty, $vertx, $verty) = @_;
+
+ # if only two inputs, use the pure PP version
+ unless( defined $vertx ) {
+ barf("ps must contain pairwise points.\n") unless $ty->getdim(0) == 2;
+
+ # Input mapping: $img => $tx, $ps => $ty
+ return PDL::pnpoly_pp($tx,$ty);
+ }
+
+ my $testx = PDL::Core::topdl($tx)->dummy(0);
+ my $testy = PDL::Core::topdl($ty)->dummy(0);
+ my $vertxj = PDL::Core::topdl($vertx)->rotate(1);
+ my $vertyj = PDL::Core::topdl($verty)->rotate(1);
+ my $mask = ( ($verty>$testy) == ($vertyj>$testy) );
+ my $c = sumover( ! $mask & ( $testx < ($vertxj-$vertx) * ($testy-$verty)
+ / ($vertyj-$verty+$mask) + $vertx) ) % 2;
+ return $c;
+}
+
+*pnpoly = \&PDL::pnpoly;
+
+EOPM
+
+pp_add_exported('', 'polyfillv');
+pp_addpm(<<'EOPM');
+
+=head2 polyfillv
+
+=for ref
+
+return the (dataflown) area of an image described by a polygon
+
+=for usage
+
+ polyfillv($im,$ps,[\%options]);
+
+The default method of determining which points lie inside of the polygon used
+is not as strict as the method used in L<pnpoly|pnpoly>. Often, it includes vertices
+and edge points. Set the C<Method> option to change this behaviour.
+
+=for option
+
+Method - Set the method used to determine which points lie in the polygon.
+ => Default - internal PDL algorithm
+ => pnpoly - use the L<pnpoly|pnpoly> algorithm
+
+=for example
+
+ # increment intensity in area bounded by $poly using the pnpoly algorithm
+ $im->polyfillv($poly,{'Method'=>'pnpoly'})++; # legal in perl >= 5.6
+
+ # compute average intensity within area bounded by $poly using the default algorithm
+ $av = $im->polyfillv($poly)->avg;
+
+=cut
+
+sub PDL::polyfillv :lvalue {
+ my $opt;
+ $opt = pop @_ if ref($_[-1]) eq 'HASH';
+ barf('Usage: polyfillv($im,$ps,[\%options])') unless @_==2;
+
+ my ($im,$ps) = @_;
+ barf("ps must contain pairwise points.\n") unless $ps->getdim(0) == 2;
+
+ if($opt) {
+ use PDL::Options qw();
+ my $parsed = PDL::Options->new({'Method' => undef});
+ $parsed->options($opt);
+ return $im->where(PDL::pnpoly_pp($im, $ps)) if $parsed->current->{'Method'} eq 'pnpoly';
+ }
+
+ my $msk = zeroes(long,$im->dims);
+ PDL::polyfill_pp($msk, $ps, 1);
+ return $im->where($msk);
+}
+*polyfillv = \&PDL::polyfillv;
+
+EOPM
+
+pp_addhdr('#include "rotate.c"'."\n\n");
+pp_add_exported('','rotnewsz');
+pp_addxs('
+
+void
+rotnewsz(m,n,angle)
+ int m
+ int n
+ float angle
+ PPCODE:
+ int newcols, newrows;
+
+ if (getnewsize(m,n,angle,&newcols,&newrows) != 0)
+ croak("wrong angle (should be between -90 and +90)");
+ EXTEND(sp,2);
+ PUSHs(sv_2mortal(newSVnv(newcols)));
+ PUSHs(sv_2mortal(newSVnv(newrows)));
+');
+
+pp_def('rot2d',
+ HandleBad => 0,
+ Pars => 'im(m,n); float angle(); bg(); int aa(); [o] om(p,q)',
+ Code => 'int ierr;
+ if ((ierr = rotate($P(im),$P(om),$SIZE(m),$SIZE(n),$SIZE(p),
+ $SIZE(q),$angle(),$bg(),$aa())) != 0)
+ if (ierr == -1)
+ croak("error during rotate, wrong angle");
+ else
+ croak("wrong output dims, did you set them?");
+ ',
+ # ugly workaround since $SIZE(m) and $SIZE(n) are not initialized
+ # when the redodimscode is called
+ # need to fix this!
+ RedoDimsCode => 'int ncols, nrows;
+ if ($PDL(im)->ndims < 2)
+ croak("need > 2d piddle");
+ if (getnewsize($PDL(im)->dims[0],$PDL(im)->dims[1],
+ $angle(), &ncols,
+ &nrows) != 0)
+ croak("error during rotate, wrong angle");
+ /* printf("o: %d, p: %d\n",ncols,nrows); */
+ $SIZE(p) = ncols;
+ $SIZE(q) = nrows;',
+ GenericTypes => ['B'],
+ Doc => << 'EOD',
+
+=for ref
+
+rotate an image by given C<angle>
+
+=for example
+
+ # rotate by 10.5 degrees with antialiasing, set missing values to 7
+ $rot = $im->rot2d(10.5,7,1);
+
+This function rotates an image through an C<angle> between -90 and + 90
+degrees. Uses/doesn't use antialiasing depending on the C<aa> flag.
+Pixels outside the rotated image are set to C<bg>.
+
+Code modified from pnmrotate (Copyright Jef Poskanzer) with an algorithm based
+on "A Fast Algorithm for General Raster Rotation" by Alan Paeth,
+Graphics Interface '86, pp. 77-81.
+
+Use the C<rotnewsz> function to find out about the dimension of the
+newly created image
+
+ ($newcols,$newrows) = rotnewsz $oldn, $oldm, $angle;
+
+L<PDL::Transform|PDL::Transform> offers a more general interface to
+distortions, including rotation, with various types of sampling; but
+rot2d is faster.
+
+=cut
+
+EOD
+);
+
+pp_def('bilin2d',
+ HandleBad => 0,
+ Pars => 'I(n,m); O(q,p)',
+ Doc=><<'EOD',
+
+=for ref
+
+Bilinearly maps the first piddle in the second. The
+interpolated values are actually added to the second
+piddle which is supposed to be larger than the first one.
+
+=cut
+
+EOD
+,
+ Code =>'
+ int i,j,ii,jj,ii1,jj1,num;
+ double x,y,dx,dy,y1,y2,y3,y4,t,u,sum;
+
+ if ($SIZE(q)>=$SIZE(n) && $SIZE(p)>=$SIZE(m)) {
+ threadloop %{
+ dx = ((double) ($SIZE(n)-1)) / ($SIZE(q)-1);
+ dy = ((double) ($SIZE(m)-1)) / ($SIZE(p)-1);
+ for(i=0,x=0;i<$SIZE(q);i++,x+=dx) {
+ for(j=0,y=0;j<$SIZE(p);j++,y+=dy) {
+ ii = (int) floor(x);
+ if (ii>=($SIZE(n)-1)) ii = $SIZE(n)-2;
+ jj = (int) floor(y);
+ if (jj>=($SIZE(m)-1)) jj = $SIZE(m)-2;
+ ii1 = ii+1;
+ jj1 = jj+1;
+ y1 = $I(n=>ii,m=>jj);
+ y2 = $I(n=>ii1,m=>jj);
+ y3 = $I(n=>ii1,m=>jj1);
+ y4 = $I(n=>ii,m=>jj1);
+ t = x-ii;
+ u = y-jj;
+ $O(q=>i,p=>j) += (1-t)*(1-u)*y1 + t*(1-u)*y2 + t*u*y3 + (1-t)*u*y4;
+ }
+ }
+ %}
+ }
+ else {
+ barf("the second matrix must be greater than first! (bilin2d)");
+ }
+');
+
+pp_def('rescale2d',
+ HandleBad => 0,
+ Pars => 'I(m,n); O(p,q)',
+ Doc=><<'EOD',
+
+=for ref
+
+The first piddle is rescaled to the dimensions of the second
+(expanding or meaning values as needed) and then added to it in place.
+Nothing useful is returned.
+
+If you want photometric accuracy or automatic FITS header metadata
+tracking, consider using L<PDL::Transform::map|PDL::Transform/map>
+instead: it does these things, at some speed penalty compared to
+rescale2d.
+
+=cut
+
+EOD
+,
+ Code =>'
+int ix,iy,ox,oy,i,j,lx,ly,cx,cy,xx,yy,num;
+double kx,ky,temp;
+
+ix = $SIZE(m);
+iy = $SIZE(n);
+ox = $SIZE(p);
+oy = $SIZE(q);
+
+if(ox >= ix && oy >= iy) {
+ threadloop %{
+ kx = ((double) (ox)) / (ix);
+ ky = ((double) (oy)) / (iy);
+ lx = 0;
+ for(i=0;i<ix;i++) {
+ ly = 0;
+ for(j=0;j<iy;j++) {
+ cx = rint((i+1)*kx)-1;
+ cy = rint((j+1)*ky)-1;
+ for(xx=lx;xx<=cx;xx++)
+ for(yy=ly;yy<=cy;yy++) {
+/* fprintf(stderr,"i: %d, j: %d, xx: %d, yy: %d\n",i,j,xx,yy); */
+ $O(p=>xx,q=>yy) += $I(m=>i,n=>j);
+ }
+ ly = cy + 1;
+ }
+ lx = cx + 1;
+ }
+ %}
+}
+else if(ox < ix && oy < iy) {
+ threadloop %{
+ kx = ((double) (ix)) / (ox);
+ ky = ((double) (iy)) / (oy);
+ lx = 0;
+ for(i=0;i<ox;i++) {
+ ly = 0;
+ for(j=0;j<oy;j++) {
+ cx = rint((i+1)*kx)-1;
+ cy = rint((j+1)*ky)-1;
+ temp = 0.0;
+ num = 0;
+ for(xx=lx;xx<=cx;xx++)
+ for(yy=ly;yy<=cy;yy++) {
+/* fprintf(stderr,"i: %d, j: %d, xx: %d, yy: %d\n",i,j,xx,yy); */
+ temp += $I(n=>yy,m=>xx);
+ num++;
+ }
+ $O(p=>i,q=>j) += temp/num;
+ ly = cy + 1;
+ }
+ lx = cx + 1;
+ }
+ %}
+}
+else if(ox >= ix && oy < iy) {
+ threadloop %{
+ kx = ((double) (ox)) / (ix);
+ ky = ((double) (iy)) / (oy);
+ lx = 0;
+ for(i=0;i<ix;i++) {
+ ly = 0;
+ for(j=0;j<oy;j++) {
+ cx = rint((i+1)*kx)-1;
+ cy = rint((j+1)*ky)-1;
+ temp = 0.0;
+ num = 0;
+ for(yy=ly;yy<=cy;yy++) {
+/* fprintf(stderr,"1 i: %d, j: %d, xx: %d, yy: %d\n",i,j,xx,yy); */
+ temp += $I(n=>yy,m=>i);
+ num++;
+ }
+ for(xx=lx;xx<=cx;xx++) {
+/* fprintf(stderr,"2 i: %d, j: %d, xx: %d, yy: %d\n",i,j,xx,yy); */
+ $O(p=>xx,q=>j) += temp/num;
+ }
+ ly = cy + 1;
+ }
+ lx = cx + 1;
+ }
+ %}
+}
+else if(ox < ix && oy >= iy) {
+ threadloop %{
+ kx = ((double) (ix)) / (ox);
+ ky = ((double) (oy)) / (iy);
+ lx = 0;
+ for(i=0;i<ox;i++) {
+ ly = 0;
+ for(j=0;j<iy;j++) {
+ cx = rint((i+1)*kx)-1;
+ cy = rint((j+1)*ky)-1;
+ temp = 0.0;
+ num = 0;
+ for(xx=lx;xx<=cx;xx++) {
+/* fprintf(stderr,"1 i: %d, j: %d, xx: %d, yy: %d\n",i,j,xx,yy); */
+ temp += $I(n=>j,m=>xx);
+ num++;
+ }
+ for(yy=ly;yy<=cy;yy++) {
+/* fprintf(stderr,"2 i: %d, j: %d, xx: %d, yy: %d\n",i,j,xx,yy); */
+ $O(p=>i,q=>yy) += temp/num;
+ }
+ ly = cy + 1;
+ }
+ lx = cx + 1;
+ }
+ %}
+}
+else barf("I am not supposed to be here, please report the bug to <chri at infis.univ.ts.it>");
+ ');
+
+# functions to make handling 2D polynomial mappings a bit easier
+#
+pp_add_exported('', 'fitwarp2d applywarp2d');
+
+pp_addpm( '
+
+=head2 fitwarp2d
+
+=for ref
+
+Find the best-fit 2D polynomial to describe
+a coordinate transformation.
+
+=for usage
+
+ ( $px, $py ) = fitwarp2d( $x, $y, $u, $v, $nf. { options } )
+
+Given a set of points in the output plane (C<$u,$v>), find
+the best-fit (using singular-value decomposition) 2D polynomial
+to describe the mapping back to the image plane (C<$x,$y>).
+The order of the fit is controlled by the C<$nf> parameter
+(the maximum power of the polynomial is C<$nf - 1>), and you
+can restrict the terms to fit using the C<FIT> option.
+
+C<$px> and C<$py> are C<np> by C<np> element piddles which describe
+a polynomial mapping (of order C<np-1>)
+from the I<output> C<(u,v)> image to the I<input> C<(x,y)> image:
+
+ x = sum(j=0,np-1) sum(i=0,np-1) px(i,j) * u^i * v^j
+ y = sum(j=0,np-1) sum(i=0,np-1) py(i,j) * u^i * v^j
+
+The transformation is returned for the reverse direction (ie
+output to input image) since that is what is required by the
+L<warp2d()|/warp2d> routine. The L<applywarp2d()|/applywarp2d>
+routine can be used to convert a set of C<$u,$v> points given
+C<$px> and C<$py>.
+
+Options:
+
+=for options
+
+ FIT - which terms to fit? default ones(byte,$nf,$nf)
+ THRESH - in svd, remove terms smaller than THRESH * max value
+ default is 1.0e-5
+
+=over 4
+
+=item FIT
+
+C<FIT> allows you to restrict which terms of the polynomial to fit:
+only those terms for which the FIT piddle evaluates to true will be
+evaluated. If a 2D piddle is sent in, then it is
+used for the x and y polynomials; otherwise
+C<$fit-E<gt>slice(":,:,(0)")> will be used for C<$px> and
+C<$fit-E<gt>slice(":,:,(1)")> will be used for C<$py>.
+
+=item THRESH
+
+Remove all singular values whose valus is less than C<THRESH>
+times the largest singular value.
+
+=back
+
+The number of points must be at least equal to the number of
+terms to fit (C<$nf*$nf> points for the default value of C<FIT>).
+
+=for example
+
+ # points in original image
+ $x = pdl( 0, 0, 100, 100 );
+ $y = pdl( 0, 100, 100, 0 );
+ # get warped to these positions
+ $u = pdl( 10, 10, 90, 90 );
+ $v = pdl( 10, 90, 90, 10 );
+ #
+ # shift of origin + scale x/y axis only
+ $fit = byte( [ [1,1], [0,0] ], [ [1,0], [1,0] ] );
+ ( $px, $py ) = fitwarp2d( $x, $y, $u, $v, 2, { FIT => $fit } );
+ print "px = ${px}py = $py";
+ px =
+ [
+ [-12.5 1.25]
+ [ 0 0]
+ ]
+ py =
+ [
+ [-12.5 0]
+ [ 1.25 0]
+ ]
+ #
+ # Compared to allowing all 4 terms
+ ( $px, $py ) = fitwarp2d( $x, $y, $u, $v, 2 );
+ print "px = ${px}py = $py";
+ px =
+ [
+ [ -12.5 1.25]
+ [ 1.110223e-16 -1.1275703e-17]
+ ]
+ py =
+ [
+ [ -12.5 1.6653345e-16]
+ [ 1.25 -5.8546917e-18]
+ ]
+
+=head2 applywarp2d
+
+=for ref
+
+Transform a set of points using a 2-D polynomial mapping
+
+=for usage
+
+ ( $x, $y ) = applywarp2d( $px, $py, $u, $v )
+
+Convert a set of points (stored in 1D piddles C<$u,$v>)
+to C<$x,$y> using the 2-D polynomial with coefficients stored in C<$px>
+and C<$py>. See L<fitwarp2d()|/fitwarp2d>
+for more information on the format of C<$px> and C<$py>.
+
+=cut
+
+# use SVD to fit data. Assuming no errors.
+sub _svd ($$$) {
+ my $basis = shift;
+ my $y = shift;
+ my $thresh = shift;
+
+ # if we had errors for these points, would normalise the
+ # basis functions, and the output array, by these errors here
+
+ # perform the SVD
+ my ( $svd_u, $svd_w, $svd_v ) = svd( $basis );
+
+ # remove any singular values
+ $svd_w *= ( $svd_w >= ($svd_w->max * $thresh ) );
+
+ # perform the back substitution
+ #
+ my $tmp = $y x $svd_u;
+ if ( $PDL::Bad::Status ) {
+ $tmp /= $svd_w->setvaltobad(0.0);
+ $tmp->inplace->setbadtoval(0.0);
+ } else {
+ # not checked
+ my $mask = ($svd_w == 0.0);
+ $tmp /= ( $svd_w + $mask );
+ $tmp *= ( 1 - $mask );
+ }
+
+ my $ans = sumover( $svd_v * $tmp );
+
+ return $ans;
+
+} # sub: _svd()
+
+sub _mkbasis ($$$$) {
+ my $fit = shift;
+ my $npts = shift;
+ my $u = shift;
+ my $v = shift;
+
+ my $n = $fit->getdim(0) - 1;
+ my $ncoeff = sum( $fit );
+
+ my $basis = zeroes( $u->type, $ncoeff, $npts );
+ my $k = 0;
+ foreach my $j ( 0 .. $n ) {
+ my $tmp_v = $v**$j;
+ foreach my $i ( 0 .. $n ) {
+ if ( $fit->at($i,$j) ) {
+ my $tmp = $basis->slice("($k),:");
+ $tmp .= $tmp_v * $u**$i;
+ $k++;
+ }
+ }
+ }
+ return $basis;
+
+} # sub: _mkbasis()
+
+sub PDL::fitwarp2d {
+ croak "Usage: (\$px,\$py) = fitwarp2d(x(m);y(m);u(m);v(m);\$nf; { options })"
+ if $#_ < 4 or ( $#_ >= 5 and ref($_[5]) ne "HASH" );
+
+ my $x = shift;
+ my $y = shift;
+ my $u = shift;
+ my $v = shift;
+ my $nf = shift;
+
+ my $opts = PDL::Options->new( { FIT => ones(byte,$nf,$nf), THRESH => 1.0e-5 } );
+ $opts->options( $_[0] ) if $#_ > -1;
+ my $oref = $opts->current();
+
+ # safety checks
+ my $npts = $x->nelem;
+ croak "fitwarp2d: x, y, u, and v must be the same size (and 1D)"
+ unless $npts == $y->nelem and $npts == $u->nelem and $npts == $v->nelem
+ and $x->getndims == 1 and $y->getndims == 1 and $u->getndims == 1 and $v->getndims == 1;
+
+ my $svd_thresh = $$oref{THRESH};
+ croak "fitwarp2d: THRESH option must be >= 0."
+ if $svd_thresh < 0;
+
+ my $fit = $$oref{FIT};
+ my $fit_ndim = $fit->getndims();
+ croak "fitwarp2d: FIT option must be sent a (\$nf,\$nf[,2]) element piddle"
+ unless UNIVERSAL::isa($fit,"PDL") and
+ ($fit_ndim == 2 or ($fit_ndim == 3 and $fit->getdim(2) == 2)) and
+ $fit->getdim(0) == $nf and $fit->getdim(1) == $nf;
+
+ # how many coeffs to fit (first we ensure $fit is either 0 or 1)
+ $fit = convert( $fit != 0, byte );
+
+ my ( $fitx, $fity, $ncoeffx, $ncoeffy, $ncoeff );
+ if ( $fit_ndim == 2 ) {
+ $fitx = $fit;
+ $fity = $fit;
+ $ncoeff = $ncoeffx = $ncoeffy = sum( $fit );
+ } else {
+ $fitx = $fit->slice(",,(0)");
+ $fity = $fit->slice(",,(1)");
+ $ncoeffx = sum($fitx);
+ $ncoeffy = sum($fity);
+ $ncoeff = $ncoeffx > $ncoeffy ? $ncoeffx : $ncoeffy;
+ }
+
+ croak "fitwarp2d: number of points must be >= \$ncoeff"
+ unless $npts >= $ncoeff;
+
+ # create the basis functions for the SVD fitting
+ my ( $basisx, $basisy );
+ $basisx = _mkbasis( $fitx, $npts, $u, $v );
+ if ( $fit_ndim == 2 ) {
+ $basisy = $basisx;
+ } else {
+ $basisy = _mkbasis( $fity, $npts, $u, $v );
+ }
+
+ my $px = _svd( $basisx, $x, $svd_thresh );
+ my $py = _svd( $basisy, $y, $svd_thresh );
+
+ # convert into $nf x $nf element piddles, if necessary
+ my $nf2 = $nf * $nf;
+
+ return ( $px->reshape($nf,$nf), $py->reshape($nf,$nf) )
+ if $ncoeff == $nf2 and $ncoeffx == $ncoeffy;
+
+ # re-create the matrix
+ my $xtmp = zeroes( $nf, $nf );
+ my $ytmp = zeroes( $nf, $nf );
+
+ my $kx = 0;
+ my $ky = 0;
+ foreach my $i ( 0 .. ($nf - 1) ) {
+ foreach my $j ( 0 .. ($nf - 1) ) {
+ if ( $fitx->at($i,$j) ) {
+ $xtmp->set($i,$j, $px->at($kx) );
+ $kx++;
+ }
+ if ( $fity->at($i,$j) ) {
+ $ytmp->set($i,$j, $py->at($ky) );
+ $ky++;
+ }
+ }
+ }
+
+ return ( $xtmp, $ytmp )
+
+} # sub: fitwarp2d
+
+*fitwarp2d = \&PDL::fitwarp2d;
+
+sub PDL::applywarp2d {
+ # checks
+ croak "Usage: (\$x,\$y) = applywarp2d(px(nf,nf);py(nf,nf);u(m);v(m);)"
+ if $#_ != 3;
+
+ my $px = shift;
+ my $py = shift;
+ my $u = shift;
+ my $v = shift;
+ my $npts = $u->nelem;
+
+ # safety check
+ croak "applywarp2d: u and v must be the same size (and 1D)"
+ unless $npts == $u->nelem and $npts == $v->nelem
+ and $u->getndims == 1 and $v->getndims == 1;
+
+ my $nf = $px->getdim(0);
+ my $nf2 = $nf * $nf;
+
+ # could remove terms with 0 coeff here
+ # (would also have to remove them from px/py for
+ # the matrix multiplication below)
+ #
+ my $mat = _mkbasis( ones(byte,$nf,$nf), $npts, $u, $v );
+
+ my $x = reshape( $mat x $px->clump(-1)->transpose(), $npts );
+ my $y = reshape( $mat x $py->clump(-1)->transpose(), $npts );
+ return ( $x, $y );
+
+} # sub: applywarp2d
+
+*applywarp2d = \&PDL::applywarp2d;
+
+' );
+
+## resampling routines taken from v3.6-0 of the Eclipse package
+## http://www.eso.org/eclipse by Nicolas Devillard
+##
+
+pp_addhdr( '#include "resample.h"' . "\n" );
+
+# pod for warp2d
+# and support routine
+#
+pp_addpm( <<'EOD');
+
+=head2 warp2d
+
+=for sig
+
+ Signature: (img(m,n); double px(np,np); double py(np,np); [o] warp(m,n); { options })
+
+=for ref
+
+Warp a 2D image given a polynomial describing the I<reverse> mapping.
+
+=for usage
+
+ $out = warp2d( $img, $px, $py, { options } );
+
+Apply the polynomial transformation encoded in the C<$px> and
+C<$py> piddles to warp the input image C<$img> into the output
+image C<$out>.
+
+The format for the polynomial transformation is described in
+the documentation for the L<fitwarp2d()|/fitwarp2d> routine.
+
+At each point C<x,y>, the closest 16 pixel values are combined
+with an interpolation kernel to calculate the value at C<u,v>.
+The interpolation is therefore done in the image, rather than
+Fourier, domain.
+By default, a C<tanh> kernel is used, but this can be changed
+using the C<KERNEL> option discussed below
+(the choice of kernel depends on the frequency content of the input image).
+
+The routine is based on the C<warping> command from
+the Eclipse data-reduction package - see http://www.eso.org/eclipse/ - and
+for further details on image resampling see
+Wolberg, G., "Digital Image Warping", 1990, IEEE Computer
+Society Press ISBN 0-8186-8944-7).
+
+Currently the output image is the same size as the input one,
+which means data will be lost if the transformation reduces
+the pixel scale. This will (hopefully) be changed soon.
+
+=for example
+
+ $img = rvals(byte,501,501);
+ imag $img, { JUSTIFY => 1 };
+ #
+ # use a not-particularly-obvious transformation:
+ # x = -10 + 0.5 * $u - 0.1 * $v
+ # y = -20 + $v - 0.002 * $u * $v
+ #
+ $px = pdl( [ -10, 0.5 ], [ -0.1, 0 ] );
+ $py = pdl( [ -20, 0 ], [ 1, 0.002 ] );
+ $wrp = warp2d( $img, $px, $py );
+ #
+ # see the warped image
+ imag $warp, { JUSTIFY => 1 };
+
+The options are:
+
+=for options
+
+ KERNEL - default value is tanh
+ NOVAL - default value is 0
+
+C<KERNEL> is used to specify which interpolation kernel to use
+(to see what these kernels look like, use the
+L<warp2d_kernel()|/warp2d_kernel> routine).
+The options are:
+
+=over 4
+
+=item tanh
+
+Hyperbolic tangent: the approximation of an ideal box filter by the
+product of symmetric tanh functions.
+
+=item sinc
+
+For a correctly sampled signal, the ideal filter in the fourier domain is a rectangle,
+which produces a C<sinc> interpolation kernel in the spatial domain:
+
+ sinc(x) = sin(pi * x) / (pi * x)
+
+However, it is not ideal for the C<4x4> pixel region used here.
+
+=item sinc2
+
+This is the square of the sinc function.
+
+=item lanczos
+
+Although defined differently to the C<tanh> kernel, the result is very
+similar in the spatial domain. The Lanczos function is defined as
+
+ L(x) = sinc(x) * sinc(x/2) if abs(x) < 2
+ = 0 otherwise
+
+=item hann
+
+This kernel is derived from the following function:
+
+ H(x) = a + (1-a) * cos(2*pi*x/(N-1)) if abs(x) < 0.5*(N-1)
+ = 0 otherwise
+
+with C<a = 0.5> and N currently equal to 2001.
+
+=item hamming
+
+This kernel uses the same C<H(x)> as the Hann filter, but with
+C<a = 0.54>.
+
+=back
+
+C<NOVAL> gives the value used to indicate that a pixel in the
+output image does not map onto one in the input image.
+
+=cut
+
+# support routine
+{
+ my %warp2d = map { ($_,1) } qw( tanh sinc sinc2 lanczos hamming hann );
+
+ # note: convert to lower case
+ sub _check_kernel ($$) {
+ my $kernel = lc shift;
+ my $code = shift;
+ barf "Unknown kernel $kernel sent to $code\n" .
+ "\tmust be one of [" . join(',',keys %warp2d) . "]\n"
+ unless exists $warp2d{$kernel};
+ return $kernel;
+ }
+}
+
+EOD
+
+pp_def(
+ 'warp2d',
+ Doc=> undef,
+ HandleBad => 0,
+ Pars => 'img(m,n); double px(np,np); double py(np,np); [o] warp(m,n);',
+ OtherPars => 'char *kernel_type; double noval;',
+ GenericTypes => [ 'F', 'D' ],
+ PMCode => '
+
+sub PDL::warp2d {
+ my $opts = PDL::Options->new( { KERNEL => "tanh", NOVAL => 0 } );
+ $opts->options( pop(@_) ) if ref($_[$#_]) eq "HASH";
+
+ die "Usage: warp2d( in(m,n), px(np,np); py(np,np); [o] out(m,n), {Options} )"
+ if $#_<2 || $#_>3;
+ my $img = shift;
+ my $px = shift;
+ my $py = shift;
+ my $out = $#_ == -1 ? PDL->null() : shift;
+
+ # safety checks
+ my $copt = $opts->current();
+ my $kernel = _check_kernel( $$copt{KERNEL}, "warp2d" );
+
+ &PDL::_warp2d_int( $img, $px, $py, $out, $kernel, $$copt{NOVAL} );
+ return $out;
+}
+
+',
+ Code => '
+
+ int i, j, k ;
+ int ncoeff, lx_out, ly_out ;
+ int lx_3, ly_3 ;
+ double cur ;
+ double neighbors[16] ;
+ double rsc[8],
+ sumrs ;
+ double x, y ;
+ int px, py ;
+ int tabx, taby ;
+ double *kernel, *poly ;
+ int da[16], db[16] ;
+
+ /* Generate default interpolation kernel */
+ kernel = generate_interpolation_kernel( $COMP(kernel_type) ) ;
+ if (kernel == NULL) {
+ croak( "Ran out of memory building kernel\n" );
+ }
+
+ /* Compute sizes */
+ ncoeff = $SIZE(np);
+ lx_out = $SIZE(m); /* is this right? */
+ ly_out = $SIZE(n);
+ lx_3 = lx_out - 3;
+ ly_3 = ly_out - 3;
+
+ /* Pre compute leaps for 16 closest neighbors positions */
+ da[0] = -1; db[0] = -1;
+ da[1] = 0; db[1] = -1;
+ da[2] = 1; db[2] = -1;
+ da[3] = 2; db[3] = -1;
+
+ da[4] = -1; db[4] = 0;
+ da[5] = 0; db[5] = 0;
+ da[6] = 1; db[6] = 0;
+ da[7] = 2; db[7] = 0;
+
+ da[8] = -1; db[8] = 1;
+ da[9] = 0; db[9] = 1;
+ da[10] = 1; db[10] = 1;
+ da[11] = 2; db[11] = 1;
+
+ da[12] = -1; db[12] = 2;
+ da[13] = 0; db[13] = 2;
+ da[14] = 1; db[14] = 2;
+ da[15] = 2; db[15] = 2;
+
+ /* allocate memory for polynomial */
+ poly = malloc( ncoeff * sizeof(double) );
+ if ( poly == NULL ) {
+ croak( "Ran out of memory\n" );
+ }
+ poly[0] = 1.0;
+
+ /* Loop over the output image */
+ threadloop %{
+ loop(n) %{
+
+ /* fill in poly array */
+ for ( k = 1; k < ncoeff; k++ ) {
+ poly[k] = (double) n * poly[k-1];
+ }
+
+ loop(m) %{
+
+ /* Compute the original source for this pixel */
+ x = poly2d_compute( ncoeff, $P(px), (double) m, poly );
+ y = poly2d_compute( ncoeff, $P(py), (double) m, poly );
+
+ /* Which is the closest integer positioned neighbor? */
+ px = (int)x ;
+ py = (int)y ;
+
+ if ((px < 1) || (px > lx_3) || (py < 1) || (py > ly_3))
+ $warp() = ($GENERIC()) $COMP(noval);
+ else {
+
+ /* Now feed the positions for the closest 16 neighbors */
+ for (k=0 ; k<16 ; k++) {
+ i = px + da[k]; j = py + db[k];
+ neighbors[k] = (double) $img( m => i, n => j );
+ }
+
+ /* Which tabulated value index shall we use? */
+ tabx = (x - (double)px) * (double)(TABSPERPIX) ;
+ taby = (y - (double)py) * (double)(TABSPERPIX) ;
+
+ /* Compute resampling coefficients */
+ /* rsc[0..3] in x, rsc[4..7] in y */
+
+ rsc[0] = kernel[TABSPERPIX + tabx] ;
+ rsc[1] = kernel[tabx] ;
+ rsc[2] = kernel[TABSPERPIX - tabx] ;
+ rsc[3] = kernel[2 * TABSPERPIX - tabx] ;
+ rsc[4] = kernel[TABSPERPIX + taby] ;
+ rsc[5] = kernel[taby] ;
+ rsc[6] = kernel[TABSPERPIX - taby] ;
+ rsc[7] = kernel[2 * TABSPERPIX - taby] ;
+
+ sumrs = (rsc[0]+rsc[1]+rsc[2]+rsc[3]) *
+ (rsc[4]+rsc[5]+rsc[6]+rsc[7]) ;
+
+ /* Compute interpolated pixel now */
+ cur = rsc[4] * ( rsc[0]*neighbors[0] +
+ rsc[1]*neighbors[1] +
+ rsc[2]*neighbors[2] +
+ rsc[3]*neighbors[3] ) +
+ rsc[5] * ( rsc[0]*neighbors[4] +
+ rsc[1]*neighbors[5] +
+ rsc[2]*neighbors[6] +
+ rsc[3]*neighbors[7] ) +
+ rsc[6] * ( rsc[0]*neighbors[8] +
+ rsc[1]*neighbors[9] +
+ rsc[2]*neighbors[10] +
+ rsc[3]*neighbors[11] ) +
+ rsc[7] * ( rsc[0]*neighbors[12] +
+ rsc[1]*neighbors[13] +
+ rsc[2]*neighbors[14] +
+ rsc[3]*neighbors[15] ) ;
+
+ /* Copy the value to the output image */
+ $warp() = ($GENERIC()) (cur/sumrs);
+
+ } /* if: edge or interior */
+
+ %} /* loop(m) */
+ %} /* loop(n) */
+ %} /* threadloop */
+
+ free(poly);
+ free(kernel) ;
+
+',
+ ); # pp_def: warp2d
+
+pp_addxs( '
+
+int
+_get_kernel_size()
+ PROTOTYPE:
+ CODE:
+ RETVAL = KERNEL_SAMPLES;
+ OUTPUT:
+ RETVAL
+
+');
+
+pp_add_exported('', 'warp2d_kernel');
+pp_addpm( '
+
+=head2 warp2d_kernel
+
+=for ref
+
+Return the specified kernel, as used by L<warp2d|/warp2d>
+
+=for usage
+
+ ( $x, $k ) = warp2d_kernel( $name )
+
+The valid values for C<$name> are the same as the C<KERNEL> option
+of L<warp2d()|/warp2d>.
+
+=for example
+
+ line warp2d_kernel( "hamming" );
+
+=cut
+
+'); # pp_addpm
+
+# this is not very clever, but it's a pain to create a valid
+# piddle in XS code
+#
+pp_def( 'warp2d_kernel',
+ Doc => undef,
+ HandleBad => 0,
+ PMCode => '
+
+sub PDL::warp2d_kernel ($) {
+ my $kernel = _check_kernel( shift, "warp2d_kernel" );
+
+ my $nelem = _get_kernel_size();
+ my $x = zeroes( $nelem );
+ my $k = zeroes( $nelem );
+
+ &PDL::_warp2d_kernel_int( $x, $k, $kernel );
+ return ( $x, $k );
+
+# return _get_kernel( $kernel );
+}
+*warp2d_kernel = \&PDL::warp2d_kernel;
+
+',
+ Pars => '[o] x(n); [o] k(n);',
+ OtherPars => 'char *name;',
+ GenericTypes => [ 'D' ],
+ Code => '
+
+ double *kernel, xx;
+
+ if ( $SIZE(n) != KERNEL_SAMPLES ) {
+ croak( "Internal error in warp2d_kernel - mismatch in kernel size\n" );
+ }
+
+ kernel = generate_interpolation_kernel($COMP(name));
+ if ( kernel == NULL ) {
+ croak( "unable to allocate memory for kernel" );
+ }
+
+ /* fill in piddles */
+ xx = 0.0;
+ threadloop %{
+ loop (n) %{
+ $x() = xx;
+ $k() = kernel[n];
+ xx += 1.0 / (double) TABSPERPIX;
+ %}
+ %}
+
+ /* free the kernel */
+ free( kernel );
+
+'); # pp_addpm
+
+pp_done();
diff --git a/Lib/Image2D/resample.c b/Lib/Image2D/resample.c
new file mode 100644
index 0000000..799f1fe
--- /dev/null
+++ b/Lib/Image2D/resample.c
@@ -0,0 +1,362 @@
+/*
+ * resample.c
+ * - a hacked version of
+ * ipow.c, poly2d.c, and resampling.c
+ * from version 3.6-0 of the Eclipse library (ESO)
+ * by Nicolas Devillard
+ *
+ * see http://www.eso.org/eclipse for further details
+ */
+
+#include "resample.h"
+
+/*-------------------------------------------------------------------------*/
+/**
+ @name ipow
+ @memo Same as pow(x,y) but for integer values of y only (faster).
+ @param x A double number.
+ @param p An integer power.
+ @return x to the power p.
+ @doc
+
+ This is much faster than the math function due to the integer. Some
+ compilers make this optimization already, some do not.
+
+ p can be positive, negative or null.
+ */
+/*--------------------------------------------------------------------------*/
+
+double ipow(double x, int p)
+{
+ double r, recip ;
+
+ /* Get rid of trivial cases */
+ switch (p) {
+ case 0:
+ return 1.00 ;
+
+ case 1:
+ return x ;
+
+ case 2:
+ return x*x ;
+
+ case 3:
+ return x*x*x ;
+
+ case -1:
+ return 1.00 / x ;
+
+ case -2:
+ return (1.00 / x) * (1.00 / x) ;
+ }
+ if (p>0) {
+ r = x ;
+ while (--p) r *= x ;
+ } else {
+ r = recip = 1.00 / x ;
+ while (++p) r *= recip ;
+ }
+ return r;
+}
+
+
+/*
+ * compute the value of a 2D polynomial at a point
+ * - it assumes that ncoeff is a small number, so there's
+ * little point in pre-calculating ipow(u,i)
+ */
+
+double
+poly2d_compute( int ncoeff, double *c, double u, double *vpow ) {
+ double out;
+ int i, j, k;
+
+ out = 0.00;
+ k = 0;
+ for( j = 0; j < ncoeff; j++ ) {
+ for( i = 0; i < ncoeff; i++ ) {
+ out += c[k] * ipow( u, i ) * vpow[j];
+ k++;
+ }
+ }
+ return out;
+}
+
+/*-------------------------------------------------------------------------*/
+/**
+ @name sinc
+ @memo Cardinal sine.
+ @param x double value.
+ @return 1 double.
+ @doc
+
+ Compute the value of the function sinc(x)=sin(pi*x)/(pi*x) at the
+ requested x.
+ */
+/*--------------------------------------------------------------------------*/
+
+double
+sinc(double x)
+{
+ if (fabs(x)<1e-4)
+ return (double)1.00 ;
+ else
+ return ((sin(x * (double)PI_NUMB)) / (x * (double)PI_NUMB)) ;
+} /* sinc() */
+
+/**
+ @name reverse_tanh_kernel
+ @memo Bring a hyperbolic tangent kernel from Fourier to normal space.
+ @param data Kernel samples in Fourier space.
+ @param nn Number of samples in the input kernel.
+ @return void
+ @doc
+
+ Bring back a hyperbolic tangent kernel from Fourier to normal space. Do
+ not try to understand the implementation and DO NOT MODIFY THIS FUNCTION.
+ */
+/*--------------------------------------------------------------------------*/
+
+#define KERNEL_SW(a,b) tempr=(a);(a)=(b);(b)=tempr
+static void reverse_tanh_kernel(double * data, int nn)
+{
+ unsigned long n,
+ mmax,
+ m,
+ i, j,
+ istep ;
+ double wtemp,
+ wr,
+ wpr,
+ wpi,
+ wi,
+ theta;
+ double tempr,
+ tempi;
+
+ n = (unsigned long)nn << 1;
+ j = 1;
+ for (i=1 ; i<n ; i+=2) {
+ if (j > i) {
+ KERNEL_SW(data[j-1],data[i-1]);
+ KERNEL_SW(data[j],data[i]);
+ }
+ m = n >> 1;
+ while (m>=2 && j>m) {
+ j -= m;
+ m >>= 1;
+ }
+ j += m;
+ }
+ mmax = 2;
+ while (n > mmax) {
+ istep = mmax << 1;
+ theta = 2 * M_PI / mmax;
+ wtemp = sin(0.5 * theta);
+ wpr = -2.0 * wtemp * wtemp;
+ wpi = sin(theta);
+ wr = 1.0;
+ wi = 0.0;
+ for (m=1 ; m<mmax ; m+=2) {
+ for (i=m ; i<=n ; i+=istep) {
+ j = i + mmax;
+ tempr = wr * data[j-1] - wi * data[j];
+ tempi = wr * data[j] + wi * data[j-1];
+ data[j-1] = data[i-1] - tempr;
+ data[j] = data[i] - tempi;
+ data[i-1] += tempr;
+ data[i] += tempi;
+ }
+ wr = (wtemp = wr) * wpr - wi * wpi + wr;
+ wi = wi * wpr + wtemp * wpi + wi;
+ }
+ mmax = istep;
+ }
+} /* reverse_tanh_kernel() */
+#undef KERNEL_SW
+
+/*-------------------------------------------------------------------------*/
+/**
+ @name generate_tanh_kernel
+ @memo Generate a hyperbolic tangent kernel.
+ @param steep Steepness of the hyperbolic tangent parts.
+ @return 1 pointer to a newly allocated array of doubles.
+ @doc
+
+ The following function builds up a good approximation of a box filter. It
+ is built from a product of hyperbolic tangents. It has the following
+ properties:
+
+ \begin{itemize}
+ \item It converges very quickly towards +/- 1.
+ \item The converging transition is very sharp.
+ \item It is infinitely differentiable everywhere (i.e. smooth).
+ \item The transition sharpness is scalable.
+ \end{itemize}
+
+ The returned array must be deallocated using free().
+ */
+/*--------------------------------------------------------------------------*/
+
+#define hk_gen(x,s) (((tanh(s*(x+0.5))+1)/2)*((tanh(s*(-x+0.5))+1)/2))
+
+double * generate_tanh_kernel(double steep)
+{
+ double * kernel ;
+ double * x ;
+ double width ;
+ double inv_np ;
+ double ind ;
+ int i ;
+ int np ;
+ int samples ;
+
+ width = (double)TABSPERPIX / 2.0 ;
+ samples = KERNEL_SAMPLES ;
+ np = 32768 ; /* Hardcoded: should never be changed */
+ inv_np = 1.00 / (double)np ;
+
+ /*
+ * Generate the kernel expression in Fourier space
+ * with a correct frequency ordering to allow standard FT
+ */
+ x = (double *) malloc((2*np+1)*sizeof(double)) ;
+ for (i=0 ; i<np/2 ; i++) {
+ ind = (double)i * 2.0 * width * inv_np ;
+ x[2*i] = hk_gen(ind, steep) ;
+ x[2*i+1] = 0.00 ;
+ }
+ for (i=np/2 ; i<np ; i++) {
+ ind = (double)(i-np) * 2.0 * width * inv_np ;
+ x[2*i] = hk_gen(ind, steep) ;
+ x[2*i+1] = 0.00 ;
+ }
+
+ /*
+ * Reverse Fourier to come back to image space
+ */
+ reverse_tanh_kernel(x, np) ;
+
+ /*
+ * Allocate and fill in returned array
+ */
+ kernel = (double *) malloc(samples * sizeof(double)) ;
+ for (i=0 ; i<samples ; i++) {
+ kernel[i] = 2.0 * width * x[2*i] * inv_np ;
+ }
+ free(x) ;
+ return kernel ;
+
+} /* generate_tanh_kernel() */
+
+
+/*-------------------------------------------------------------------------*/
+/**
+ @name generate_interpolation_kernel
+ @memo Generate an interpolation kernel to use in this module.
+ @param kernel_type Type of interpolation kernel.
+ @return 1 newly allocated array of doubles.
+ @doc
+
+ Provide the name of the kernel you want to generate. Supported kernel
+ types are:
+
+ \begin{tabular}{ll}
+ NULL & default kernel, currently "tanh" \\
+ "default" & default kernel, currently "tanh" \\
+ "tanh" & Hyperbolic tangent \\
+ "sinc2" & Square sinc \\
+ "lanczos" & Lanczos2 kernel \\
+ "hamming" & Hamming kernel \\
+ "hann" & Hann kernel
+ \end{tabular}
+
+ The returned array of doubles is ready of use in the various re-sampling
+ functions in this module. It must be deallocated using free().
+ */
+/*--------------------------------------------------------------------------*/
+
+double *
+generate_interpolation_kernel(char * kernel_type)
+{
+ double * tab ;
+ int i ;
+ double x ;
+ double alpha ;
+ double inv_norm ;
+ int samples = KERNEL_SAMPLES ;
+
+ if (kernel_type==NULL) {
+ tab = generate_interpolation_kernel("tanh") ;
+ } else if (!strcmp(kernel_type, "default")) {
+ tab = generate_interpolation_kernel("tanh") ;
+ } else if (!strcmp(kernel_type, "sinc")) {
+ tab = (double *) malloc(samples * sizeof(double)) ;
+ tab[0] = 1.0 ;
+ tab[samples-1] = 0.0 ;
+ for (i=1 ; i<samples ; i++) {
+ x = (double)KERNEL_WIDTH * (double)i/(double)(samples-1) ;
+ tab[i] = sinc(x) ;
+ }
+ } else if (!strcmp(kernel_type, "sinc2")) {
+ tab = (double *) malloc(samples * sizeof(double)) ;
+ tab[0] = 1.0 ;
+ tab[samples-1] = 0.0 ;
+ for (i=1 ; i<samples ; i++) {
+ x = 2.0 * (double)i/(double)(samples-1) ;
+ tab[i] = sinc(x) ;
+ tab[i] *= tab[i] ;
+ }
+ } else if (!strcmp(kernel_type, "lanczos")) {
+ tab = (double *) malloc(samples * sizeof(double)) ;
+ for (i=0 ; i<samples ; i++) {
+ x = (double)KERNEL_WIDTH * (double)i/(double)(samples-1) ;
+ if (fabs(x)<2) {
+ tab[i] = sinc(x) * sinc(x/2) ;
+ } else {
+ tab[i] = 0.00 ;
+ }
+ }
+ } else if (!strcmp(kernel_type, "hamming")) {
+ tab = (double *) malloc(samples * sizeof(double)) ;
+ alpha = 0.54 ;
+ inv_norm = 1.00 / (double)(samples - 1) ;
+ for (i=0 ; i<samples ; i++) {
+ x = (double)i ;
+ if (i<(samples-1)/2) {
+ tab[i] = alpha + (1-alpha) * cos(2.0*PI_NUMB*x*inv_norm) ;
+ } else {
+ tab[i] = 0.0 ;
+ }
+ }
+ } else if (!strcmp(kernel_type, "hann")) {
+ tab = (double *) malloc(samples * sizeof(double)) ;
+ alpha = 0.50 ;
+ inv_norm = 1.00 / (double)(samples - 1) ;
+ for (i=0 ; i<samples ; i++) {
+ x = (double)i ;
+ if (i<(samples-1)/2) {
+ tab[i] = alpha + (1-alpha) * cos(2.0*PI_NUMB*x*inv_norm) ;
+ } else {
+ tab[i] = 0.0 ;
+ }
+ }
+ } else if (!strcmp(kernel_type, "tanh")) {
+ tab = generate_tanh_kernel(TANH_STEEPNESS) ;
+ } else {
+ /**
+ ** trapped at perl level, so should never reach here
+ e_error("unrecognized kernel type [%s]: aborting generation",
+ kernel_type) ;
+ **/
+ return NULL ;
+ }
+
+ return tab ;
+
+} /* generate_interpolation_kernel() */
+
+/***********
+ *** END ***
+ ***********/
diff --git a/Lib/Image2D/resample.h b/Lib/Image2D/resample.h
new file mode 100644
index 0000000..1f2d517
--- /dev/null
+++ b/Lib/Image2D/resample.h
@@ -0,0 +1,41 @@
+/*
+ * resample.h - based on code from version 3.6-0 of the Eclipse library (ESO)
+ * by Nicolas Devillard
+ *
+ * see http://www.eso.org/eclipse for further details
+ */
+
+#ifndef _PDL_RESAMPLE_H_
+#define _PDL_RESAMPLE_H_
+
+#include <stdlib.h>
+#include <math.h>
+
+#ifndef NULL
+#define NULL (0L)
+#endif
+
+/* Number of tabulations in kernel */
+#define TABSPERPIX (1000)
+#define KERNEL_WIDTH (2.0)
+#define KERNEL_SAMPLES (1+(int)(TABSPERPIX * KERNEL_WIDTH))
+
+#define TANH_STEEPNESS (5.0)
+
+#ifndef PI_NUMB
+#define PI_NUMB (3.1415926535897932384626433832795)
+#endif
+
+#ifndef M_PI
+#define M_PI PI_NUMB
+#endif
+
+/* declare functions */
+
+double
+poly2d_compute( int ncoeff, double *c, double u, double *vpow );
+
+double *
+generate_interpolation_kernel(char * kernel_type);
+
+#endif
diff --git a/Lib/Image2D/rotate.c b/Lib/Image2D/rotate.c
new file mode 100644
index 0000000..4a3fdf2
--- /dev/null
+++ b/Lib/Image2D/rotate.c
@@ -0,0 +1,250 @@
+/* rotate.c - code modified from pnmrotate.c which included the following
+ copyright notice
+*/
+
+/* pnmrotate.c - read a portable anymap and rotate it by some angle
+**
+** Copyright (C) 1989, 1991 by Jef Poskanzer.
+**
+** Permission to use, copy, modify, and distribute this software and its
+** documentation for any purpose and without fee is hereby granted, provided
+** that the above copyright notice appear in all copies and that both that
+** copyright notice and this permission notice appear in supporting
+** documentation. This software is provided "as is" without express or
+** implied warranty.
+*/
+
+#include <stdlib.h>
+#include <math.h>
+
+#ifndef M_PI
+#define M_PI 3.14159265358979323846
+#endif /*M_PI*/
+
+#define SCALE 4096
+#define HALFSCALE 2048
+
+typedef unsigned char imT; /* image type */
+
+static imT* my_allocarray(int cols, int rows)
+{
+ imT *arr = NULL;
+ if ((arr = malloc(sizeof(imT)*cols*rows)) == NULL)
+ croak("error getting memory for temporary array");
+ return arr;
+}
+
+int getnewsize(int cols, int rows, float fangle, int *newcols, int *newrows)
+{
+ float xshearfac, yshearfac, new0;
+ int tempcols, yshearjunk, x2shearjunk;
+
+ if ( fangle < -90.0 || fangle > 90.0 )
+ /* error( "angle must be between -90 and 90 degrees" ); */
+ return -1;
+ fangle = fangle * M_PI / 180.0; /* convert to radians */
+
+ xshearfac = tan( fangle / 2.0 );
+ if ( xshearfac < 0.0 )
+ xshearfac = -xshearfac;
+ yshearfac = sin( fangle );
+ if ( yshearfac < 0.0 )
+ yshearfac = -yshearfac;
+
+ tempcols = rows * xshearfac + cols + 0.999999;
+ yshearjunk = ( tempcols - cols ) * yshearfac;
+ *newrows = tempcols * yshearfac + rows + 0.999999;
+ x2shearjunk = ( *newrows - rows - yshearjunk ) * xshearfac;
+ *newrows -= 2 * yshearjunk;
+ *newcols = *newrows * xshearfac + tempcols + 0.999999 - 2 * x2shearjunk;
+ /* printf("oldrows: %d, oldcols: %d\n",rows,cols);
+ printf("newrows: %d, newcols: %d\n",*newrows,*newcols);
+ */
+ return 0; /* OK */
+}
+
+int rotate(imT *im, imT *out, int cols, int rows, int nc, int nr,
+ float fangle, imT bgval, int antialias)
+{
+ float xshearfac, yshearfac, new0;
+ int intnew0;
+ imT *xelrow, *newxelrow, *temp1xels, *temp2xels, *nxP, *xP, prevxel, x;
+ int tempcols, newcols, yshearjunk, x2shearjunk, row, col, new, newrows;
+ register long fracnew0, omfracnew0;
+
+ /* other angles should do a simple multiple of 90 degrees rotate before
+ calling this one */
+ if ( fangle < -90.0 || fangle > 90.0 )
+ /* error( "angle must be between -90 and 90 degrees" ); */
+ return -1;
+ fangle = fangle * M_PI / 180.0; /* convert to radians */
+
+ xshearfac = tan( fangle / 2.0 );
+ if ( xshearfac < 0.0 )
+ xshearfac = -xshearfac;
+ yshearfac = sin( fangle );
+ if ( yshearfac < 0.0 )
+ yshearfac = -yshearfac;
+
+ tempcols = rows * xshearfac + cols + 0.999999;
+ yshearjunk = ( tempcols - cols ) * yshearfac;
+ newrows = tempcols * yshearfac + rows + 0.999999;
+ x2shearjunk = ( newrows - rows - yshearjunk ) * xshearfac;
+ newrows -= 2 * yshearjunk;
+ newcols = newrows * xshearfac + tempcols + 0.999999 - 2 * x2shearjunk;
+
+ /* check that the output has the right size */
+ if (nc != newcols || nr != newrows)
+ return -2;
+
+ /* First shear X into temp1xels. */
+ temp1xels = my_allocarray( tempcols, rows );
+ for ( row = 0; row < rows; ++row )
+ {
+ xelrow = im + row * cols; /* current row to process */
+ if ( fangle > 0 )
+ new0 = row * xshearfac;
+ else
+ new0 = ( rows - row ) * xshearfac;
+ intnew0 = (int) new0;
+
+ if ( antialias )
+ {
+ fracnew0 = ( new0 - intnew0 ) * SCALE;
+ omfracnew0 = SCALE - fracnew0;
+
+ for ( col = 0, nxP = temp1xels+row*tempcols;
+ col < tempcols; ++col, ++nxP )
+ *nxP = bgval;
+
+ prevxel = bgval;
+ for ( col = 0, nxP = temp1xels+row*tempcols+intnew0, xP = xelrow;
+ col < cols; ++col, ++nxP, ++xP )
+ {
+ *nxP = (fracnew0 * prevxel + omfracnew0 * *xP + HALFSCALE )
+ / SCALE;
+ prevxel = *xP;
+ }
+ if ( fracnew0 > 0 && intnew0 + cols < tempcols )
+ {
+ *nxP =
+ ( fracnew0 * prevxel + omfracnew0 * bgval + HALFSCALE )
+ / SCALE;
+ }
+ }
+ else
+ {
+ for ( col = 0, nxP = temp1xels+row*tempcols;
+ col < intnew0; ++col, ++nxP )
+ *nxP = bgval;
+ for ( col = 0, xP = xelrow; col < cols; ++col, ++nxP, ++xP )
+ *nxP = *xP;
+ for ( col = intnew0 + cols; col < tempcols; ++col, ++nxP )
+ *nxP = bgval;
+ }
+ }
+ /* Now inverse shear Y from temp1 into temp2. */
+ temp2xels = my_allocarray( tempcols, newrows );
+ for ( col = 0; col < tempcols; ++col )
+ {
+ if ( fangle > 0 )
+ new0 = ( tempcols - col ) * yshearfac;
+ else
+ new0 = col * yshearfac;
+ intnew0 = (int) new0;
+ fracnew0 = ( new0 - intnew0 ) * SCALE;
+ omfracnew0 = SCALE - fracnew0;
+ intnew0 -= yshearjunk;
+
+ for ( row = 0; row < newrows; ++row )
+ temp2xels[row*tempcols+col] = bgval;
+
+ if ( antialias )
+ {
+ prevxel = bgval;
+ for ( row = 0; row < rows; ++row )
+ {
+ new = row + intnew0;
+ if ( new >= 0 && new < newrows )
+ {
+ nxP = temp2xels+new*tempcols+col;
+ x = temp1xels[row*tempcols+col];
+ *nxP =
+ ( fracnew0 * prevxel + omfracnew0 * x + HALFSCALE )
+ / SCALE;
+ prevxel = x;
+ }
+ }
+ if ( fracnew0 > 0 && intnew0 + rows < newrows )
+ {
+ nxP = temp2xels+(intnew0 + rows)*tempcols+col;
+ *nxP = ( fracnew0 * prevxel + omfracnew0 * bgval + HALFSCALE )
+ / SCALE ;
+ }
+ }
+ else
+ {
+ for ( row = 0; row < rows; ++row )
+ {
+ new = row + intnew0;
+ if ( new >= 0 && new < newrows )
+ temp2xels[new*tempcols+col] = temp1xels[row*tempcols+col];
+ }
+ }
+ }
+ free(temp1xels);
+
+ for ( row = 0; row < newrows; ++row )
+ {
+ newxelrow = out + row*newcols;;
+ if ( fangle > 0 )
+ new0 = row * xshearfac;
+ else
+ new0 = ( newrows - row ) * xshearfac;
+ intnew0 = (int) new0;
+ fracnew0 = ( new0 - intnew0 ) * SCALE;
+ omfracnew0 = SCALE - fracnew0;
+ intnew0 -= x2shearjunk;
+
+ for ( col = 0, nxP = newxelrow; col < newcols; ++col, ++nxP )
+ *nxP = bgval;
+
+ if ( antialias )
+ {
+ prevxel = bgval;
+ for ( col = 0, xP = temp2xels+row*tempcols;
+ col < tempcols; ++col, ++xP )
+ {
+ new = intnew0 + col;
+ if ( new >= 0 && new < newcols )
+ {
+ nxP = &(newxelrow[new]);
+ *nxP =
+ ( fracnew0 * prevxel + omfracnew0 * *xP + HALFSCALE )
+ / SCALE;
+ prevxel = *xP;
+ }
+ }
+ if ( fracnew0 > 0 && intnew0 + tempcols < newcols )
+ {
+ nxP = &(newxelrow[intnew0 + tempcols]);
+ *nxP =
+ ( fracnew0 * prevxel + omfracnew0 * bgval + HALFSCALE )
+ / SCALE;
+ }
+ }
+ else
+ {
+ for ( col = 0, xP = temp2xels+row*tempcols;
+ col < tempcols; ++col, ++xP )
+ {
+ new = intnew0 + col;
+ if ( new >= 0 && new < newcols )
+ newxelrow[new] = *xP;
+ }
+ }
+
+ }
+ free(temp2xels);
+ return 0; /* OK */
+}
diff --git a/Lib/ImageND/Makefile.PL b/Lib/ImageND/Makefile.PL
new file mode 100644
index 0000000..42c33f4
--- /dev/null
+++ b/Lib/ImageND/Makefile.PL
@@ -0,0 +1,10 @@
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+ at pack = (["imagend.pd",ImageND,PDL::ImageND]);
+
+WriteMakefile( pdlpp_stdargs_int(@::pack) );
+
+# Add genpp rule
+sub MY::postamble { pdlpp_postamble_int(@::pack); }
+
diff --git a/Lib/ImageND/imagend.pd b/Lib/ImageND/imagend.pd
new file mode 100644
index 0000000..b866f14
--- /dev/null
+++ b/Lib/ImageND/imagend.pd
@@ -0,0 +1,857 @@
+
+pp_addpm({At=>'Top'},<<'EOD');
+
+=head1 NAME
+
+PDL::ImageND - useful image processing in N dimensions
+
+=head1 DESCRIPTION
+
+These routines act on PDLs as N-dimensional objects, not as threaded
+sets of 0-D or 1-D objects. The file is sort of a catch-all for
+broadly functional routines, most of which could legitimately
+be filed elsewhere (and probably will, one day).
+
+ImageND is not a part of the PDL core (v2.4) and hence must be explicitly
+loaded.
+
+=head1 SYNOPSIS
+
+ use PDL::ImageND;
+
+ $b = $a->convolveND($kernel,{bound=>'periodic'});
+ $b = $a->rebin(50,30,10);
+
+=cut
+
+
+EOD
+
+pp_addpm({At=>'Bot'},<<'EOD');
+
+=head1 AUTHORS
+
+Copyright (C) Karl Glazebrook and Craig DeForest, 1997, 2003
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+
+EOD
+
+# N-dim utilities
+
+pp_addhdr('
+
+/* Compute offset of (x,y,z,...) position in row-major list */
+
+PDL_Indx ndim_get_offset(PDL_Indx* pos, PDL_Indx* dims, PDL_Long ndims) {
+ PDL_Long i;
+ PDL_Indx result,size;
+ size = 1;
+ result = 0;
+ for (i=0; i<ndims; i++) {
+ if (i>0)
+ size = size*dims[i-1];
+ result = result + pos[i]*size;
+ }
+ return result;
+}
+
+/* Increrement a position pointer array by one row */
+
+void ndim_row_plusplus ( PDL_Indx* pos, PDL_Indx* dims, PDL_Long ndims ) {
+
+ PDL_Long noescape;
+ PDL_Indx i;
+
+ i=1; noescape=1;
+
+ while(noescape) {
+
+ (pos[i])++;
+
+ if (pos[i]==dims[i]) { /* Carry */
+ if (i>=(ndims)-1) {
+ noescape = 0; /* Exit */
+ }else{
+ pos[i]=0;
+ i++;
+ }
+ }else{
+ noescape = 0; /* Exit */
+ }
+ }
+}
+
+');
+
+pp_addpm(<<'EOD');
+
+use Carp;
+
+EOD
+
+pp_add_exported('','kernctr');
+
+
+pp_def('convolve',Doc=><<'EOD',
+=for ref
+
+N-dimensional convolution (Deprecated; use convolveND)
+
+=for usage
+
+$new = convolve $a, $kernel
+
+Convolve an array with a kernel, both of which are N-dimensional. This
+routine does direct convolution (by copying) but uses quasi-periodic
+boundary conditions: each dim "wraps around" to the next higher row in
+the next dim.
+
+This routine is kept for backwards compatibility with earlier scripts;
+for most purposes you want L<convolveND|PDL::ImageND/convolveND> instead:
+it runs faster and handles a variety of boundary conditions.
+
+=cut
+
+
+EOD
+ Pars => 'a(m); b(n); indx adims(p); indx bdims(q); [o]c(m);',
+ PMCode => '
+
+# Custom Perl wrapper
+
+sub PDL::convolve{
+ my($a,$b,$c) = @_;
+ barf("Usage: convolve(a(*), b(*), [o]c(*)") if $#_<1 || $#_>2;
+ $c = PDL->null if $#_<2;
+ &PDL::_convolve_int( $a->clump(-1), $b->clump(-1),
+ long([$a->dims]), long([$b->dims]),
+ ($c->getndims>1? $c->clump(-1) : $c)
+ );
+ $c->setdims([$a->dims]);
+
+ if($a->is_inplace) {
+ $a .= $c;
+ $a->set_inplace(0);
+ return $a;
+ }
+ return $c;
+}
+
+',
+ Code => '
+ PDL_Indx *dimsa = $P(adims);
+ PDL_Indx *dimsb = $P(bdims);
+ PDL_Indx andims = $SIZE(p);
+ PDL_Indx bndims = $SIZE(q);
+ PDL_Indx anvals = $SIZE(m);
+ PDL_Indx bnvals = $SIZE(n);
+ PDL_Indx *pos,*off;
+ double cc;
+
+ PDL_Indx i,i2,j,k,n,offcen,cen,ncen,nrow;
+
+ if (andims != bndims)
+ barf("Arguments do not have the same dimensionality");
+ for(i=0; i<andims; i++)
+ if (dimsb[i]>dimsa[i])
+ barf("Second argument must be smaller in all dimensions that first"
+);
+
+ pos = (PDL_Indx*) malloc( andims * sizeof(PDL_Indx) ); /* Init pos[] */
+ if (pos==NULL)
+ barf("Out of Memory\n");
+ for (i=0; i<andims; i++) /* Zero */
+ pos[i]=0;
+
+ /* Find middle pixel in b */
+ i=0; nrow = dimsb[0];
+ while(i<bnvals) {
+ for (j=0; j<nrow; j++) { /* For each row */
+ pos[0]=j;
+
+ for(k=0;k<bndims;k++) { /* Is centre? */
+ if (pos[k] != dimsb[k]/2)
+ goto getout_$GENERIC();
+ }
+ ncen = i;
+getout_$GENERIC(): i++;
+ }
+ pos[0]=0;
+ ndim_row_plusplus( pos, dimsb, bndims );
+ }
+
+ for (i=0; i<andims; i++) /* Zero */
+ pos[i]=0;
+
+ /* Initialise offset array to handle the relative coords efficiently */
+
+ off = (PDL_Indx*) malloc(bnvals*sizeof(PDL_Indx)); /* Offset array */
+ if (off==NULL)
+ barf("Out of Memory\n");
+
+ i=0;
+ while(i<bnvals) {
+ n = ndim_get_offset(pos, dimsa, andims); /* Start of row in A */
+ for (j=0; j<nrow; j++) { /* Fill row */
+ off[i] = n+j;
+ if (i==ncen)
+ offcen = off[i]; /* Offset to middle */
+ i++;
+ }
+ ndim_row_plusplus( pos, dimsa, andims );
+ }
+
+ for(i=0;i<bnvals;i++) /* Subtract center offset */
+ off[i]=offcen-off[i];
+
+ /* Now convolve the data */
+
+ for(i=0; i<anvals; i++) {
+ cc = 0;
+ for(j=0; j<bnvals; j++) {
+ i2 = (i+off[j]+anvals) % anvals ;
+ cc += $a( m=> i2 ) * $b(n=>j) ;
+ }
+ $c(m=>i) = cc;
+ }
+ free(pos); free(off);
+
+');
+
+
+pp_add_exported('',"ninterpol");
+
+pp_addpm(<<'EOD');
+
+=head2 ninterpol()
+
+=for ref
+
+N-dimensional interpolation routine
+
+=for sig
+
+ Signature: ninterpol(point(),data(n),[o]value())
+
+=for usage
+
+ $value = ninterpol($point, $data);
+
+C<ninterpol> uses C<interpol> to find a linearly interpolated value in
+N dimensions, assuming the data is spread on a uniform grid. To use
+an arbitrary grid distribution, need to find the grid-space point from
+the indexing scheme, then call C<ninterpol> -- this is far from
+trivial (and ill-defined in general).
+
+See also L<interpND|PDL::Primitive/interpND>, which includes boundary
+conditions and allows you to switch the method of interpolation, but
+which runs somewhat slower.
+
+=cut
+
+
+*ninterpol = \&PDL::ninterpol;
+
+sub PDL::ninterpol {
+ use PDL::Math 'floor';
+ use PDL::Primitive 'interpol';
+ print 'Usage: $a = ninterpolate($point(s), $data);' if $#_ != 1;
+ my ($p, $y) = @_;
+ my ($ip) = floor($p);
+ # isolate relevant N-cube
+ $y = $y->slice(join (',',map($_.':'.($_+1),list $ip)));
+ for (list ($p-$ip)) { $y = interpol($_,$y->xvals,$y); }
+ $y;
+}
+
+EOD
+
+pp_def('rebin',Doc=><<'EOD',
+=for ref
+
+N-dimensional rebinning algorithm
+
+=for usage
+
+$new = rebin $a, $dim1, $dim2,..;.
+$new = rebin $a, $template;
+$new = rebin $a, $template, {Norm => 1};
+
+Rebin an N-dimensional array to newly specified dimensions.
+Specifying `Norm' keeps the sum constant, otherwise the intensities
+are kept constant. If more template dimensions are given than for the
+input pdl, these dimensions are created; if less, the final dimensions
+are maintained as they were.
+
+So if C<$a> is a 10 x 10 pdl, then C<rebin($a,15)> is a 15 x 10 pdl,
+while C<rebin($a,15,16,17)> is a 15 x 16 x 17 pdl (where the values
+along the final dimension are all identical).
+
+Expansion is performed by sampling; reduction is performed by averaging.
+If you want different behavior, use L<PDL::Transform::map|PDL::Transform/map>
+instead. PDL::Transform::map runs slower but is more flexible.
+
+=cut
+
+
+EOD
+ Pars => 'a(m); [o]b(n);',
+ OtherPars => 'int ns => n',
+ PMCode => '
+
+# Custom Perl wrapper
+
+sub PDL::rebin {
+ my($a) = shift;
+ my($opts) = ref $_[-1] eq "HASH" ? pop : {};
+ my(@idims) = $a->dims;
+ my(@odims) = ref $_[0] ? $_[0]->dims : @_;
+ my($i,$b);
+ foreach $i (0..$#odims) {
+ if ($i > $#idims) { # Just dummy extra dimensions
+ $a = $a->dummy($i,$odims[$i]);
+ next;
+ # rebin_int can cope with all cases, but code
+ # 1->n and n->1 separately for speed
+ } elsif ($odims[$i] != $idims[$i]) { # If something changes
+ if (!($odims[$i] % $idims[$i])) { # Cells map 1 -> n
+ my ($r) = $odims[$i]/$idims[$i];
+ $b = $a->mv($i,0)->dummy(0,$r)->clump(2);
+ } elsif (!($idims[$i] % $odims[$i])) { # Cells map n -> 1
+ my ($r) = $idims[$i]/$odims[$i];
+ $a = $a->mv($i,0);
+ # -> copy so won\'t corrupt input PDL
+ $b = $a->slice("0:-1:$r")->copy;
+ foreach (1..$r-1) {
+ $b += $a->slice("$_:-1:$r");
+ }
+ $b /= $r;
+ } else { # Cells map n -> m
+ &PDL::_rebin_int($a->mv($i,0), $b = null, $odims[$i]);
+ }
+ $a = $b->mv(0,$i);
+ }
+ }
+ if (exists $opts->{Norm} and $opts->{Norm}) {
+ my ($norm) = 1;
+ for $i (0..$#odims) {
+ if ($i > $#idims) {
+ $norm /= $odims[$i];
+ } else {
+ $norm *= $idims[$i]/$odims[$i];
+ }
+ }
+ return $a * $norm;
+ } else {
+ # Explicit copy so i) can\'t corrupt input PDL through this link
+ # ii) don\'t waste space on invisible elements
+ return $a -> copy;
+ }
+}
+',
+ Code => '
+ int ms = $SIZE(m);
+ int nv = $PRIV(ns);
+ int i;
+ double u, d;
+ $GENERIC(a) av;
+ threadloop %{
+ i = 0;
+ d = -1;
+ loop (n) %{ $b() = 0; %}
+ loop (m) %{
+ av = $a();
+ u = nv*((m+1.)/ms)-1;
+ while (i <= u) {
+ $b(n => i) += (i-d)*av;
+ d = i;
+ i++;
+ }
+ if (i < nv) $b(n => i) += (u-d)*av;
+ d = u;
+ %}
+ %}
+');
+
+
+pp_addpm(<<'EOD');
+
+=head2 circ_mean_p
+
+=for ref
+
+Calculates the circular mean of an n-dim image and returns
+the projection. Optionally takes the center to be used.
+
+=for usage
+
+ $cmean=circ_mean_p($im);
+ $cmean=circ_mean_p($im,{Center => [10,10]});
+
+=cut
+
+
+sub circ_mean_p {
+ my ($a,$opt) = @_;
+ my ($rad,$sum,$norm);
+
+ if (defined $opt) {
+ $rad = long PDL::rvals($a,$opt);
+ }
+ else {
+ $rad = long rvals $a;
+ }
+ $sum = zeroes($rad->max+1);
+ PDL::indadd $a->clump(-1), $rad->clump(-1), $sum; # this does the real work
+ $norm = zeroes($rad->max+1);
+ PDL::indadd pdl(1), $rad->clump(-1), $norm; # equivalent to get norm
+ $sum /= $norm;
+ return $sum;
+}
+
+=head2 circ_mean
+
+=for ref
+
+Smooths an image by applying circular mean.
+Optionally takes the center to be used.
+
+=for usage
+
+ circ_mean($im);
+ circ_mean($im,{Center => [10,10]});
+
+=cut
+
+
+sub circ_mean {
+ my ($a,$opt) = @_;
+ my ($rad,$sum,$norm,$a1);
+
+ if (defined $opt) {
+ $rad = long PDL::rvals($a,$opt);
+ }
+ else {
+ $rad = long rvals $a;
+ }
+ $sum = zeroes($rad->max+1);
+ PDL::indadd $a->clump(-1), $rad->clump(-1), $sum; # this does the real work
+ $norm = zeroes($rad->max+1);
+ PDL::indadd pdl(1), $rad->clump(-1), $norm; # equivalent to get norm
+ $sum /= $norm;
+ $a1 = $a->clump(-1);
+ $a1 .= $sum->index($rad->clump(-1));
+
+ return $a;
+}
+
+EOD
+
+pp_add_exported('','circ_mean circ_mean_p');
+
+
+pp_addpm(<<'EOPM');
+
+=head2 kernctr
+
+=for ref
+
+`centre' a kernel (auxiliary routine to fftconvolve)
+
+=for usage
+
+ $kernel = kernctr($image,$smallk);
+ fftconvolve($image,$kernel);
+
+kernctr centres a small kernel to emulate the behaviour of the direct
+convolution routines.
+
+=cut
+
+
+*kernctr = \&PDL::kernctr;
+
+sub PDL::kernctr {
+ # `centre' the kernel, to match kernel & image sizes and
+ # emulate convolve/conv2d. FIX: implement with phase shifts
+ # in fftconvolve, with option tag
+ barf "Must have image & kernel for kernctr" if $#_ != 1;
+ my ($imag, $kern) = @_;
+ my (@ni) = $imag->dims;
+ my (@nk) = $kern->dims;
+ barf "Kernel and image must have same number of dims" if $#ni != $#nk;
+ my ($newk) = zeroes(double, at ni);
+ my ($k,$n,$d,$i, at stri, at strk, at b);
+ for ($i=0; $i <= $#ni; $i++) {
+ $k = $nk[$i];
+ $n = $ni[$i];
+ barf "Kernel must be smaller than image in all dims" if ($n < $k);
+ $d = int(($k-1)/2);
+ $stri[$i][0] = "0:$d,";
+ $strk[$i][0] = (-$d-1).":-1,";
+ $stri[$i][1] = $d == 0 ? '' : ($d-$k+1).':-1,';
+ $strk[$i][1] = $d == 0 ? '' : '0:'.($k-$d-2).',';
+ }
+ # kernel is split between the 2^n corners of the cube
+ my ($nchunk) = 2 << $#ni;
+ CHUNK:
+ for ($i=0; $i < $nchunk; $i++) {
+ my ($stri,$strk);
+ for ($n=0, $b=$i; $n <= $#ni; $n++, $b >>= 1) {
+ next CHUNK if $stri[$n][$b & 1] eq '';
+ $stri .= $stri[$n][$b & 1];
+ $strk .= $strk[$n][$b & 1];
+ }
+ chop ($stri); chop ($strk);
+ ($t = $newk->slice($stri)) .= $kern->slice($strk);
+ }
+ $newk;
+}
+
+EOPM
+
+
+pp_def(
+ 'convolveND',
+ Doc=><<'EOD',
+
+=for ref
+
+Speed-optimized convolution with selectable boundary conditions
+
+=for usage
+
+$new = convolveND($a, $kernel, [ {options} ]);
+
+Conolve an array with a kernel, both of which are N-dimensional.
+
+If the kernel has fewer dimensions than the array, then the extra array
+dimensions are threaded over. There are options that control the boundary
+conditions and method used.
+
+The kernel's origin is taken to be at the kernel's center. If your
+kernel has a dimension of even order then the origin's coordinates get
+rounded up to the next higher pixel (e.g. (1,2) for a 3x4 kernel).
+This mimics the behavior of the earlier L<convolve|convolve> and
+L<fftconvolve|PDL::FFT/fftconvolve()> routines, so convolveND is a drop-in
+replacement for them.
+
+
+The kernel may be any size compared to the image, in any dimension.
+
+The kernel and the array are not quite interchangeable (as in mathematical
+convolution): the code is inplace-aware only for the array itself, and
+the only allowed boundary condition on the kernel is truncation.
+
+convolveND is inplace-aware: say C<convolveND(inplace $a ,$k)> to modify
+a variable in-place. You don't reduce the working memory that way -- only
+the final memory.
+
+OPTIONS
+
+Options are parsed by PDL::Options, so unique abbreviations are accepted.
+
+=over 3
+
+=item boundary (default: 'truncate')
+
+The boundary condition on the array, which affects any pixel closer
+to the edge than the half-width of the kernel.
+
+The boundary conditions are the same as those accepted by
+L<range|PDL::Slices/range>, because this option is passed directly
+into L<range|PDL::Slices/range>. Useful options are 'truncate' (the
+default), 'extend', and 'periodic'. You can select different boundary
+conditions for different axes -- see L<range|PDL::Slices/range> for more
+detail.
+
+The (default) truncate option marks all the near-boundary pixels as BAD if
+you have bad values compiled into your PDL and the array's badflag is set.
+
+=item method (default: 'auto')
+
+The method to use for the convolution. Acceptable alternatives are
+'direct', 'fft', or 'auto'. The direct method is an explicit
+copy-and-multiply operation; the fft method takes the Fourier
+transform of the input and output kernels. The two methods give the
+same answer to within double-precision numerical roundoff. The fft
+method is much faster for large kernels; the direct method is faster
+for tiny kernels. The tradeoff occurs when the array has about 400x
+more pixels than the kernel.
+
+The default method is 'auto', which chooses direct or fft convolution
+based on the size of the input arrays.
+
+=back
+
+NOTES
+
+At the moment there's no way to thread over kernels. That could/should
+be fixed.
+
+The threading over input is cheesy and should probably be fixed:
+currently the kernel just gets dummy dimensions added to it to match
+the input dims. That does the right thing tersely but probably runs slower
+than a dedicated threadloop.
+
+The direct copying code uses PP primarily for the generic typing: it includes
+its own threadloops.
+
+=cut
+
+
+EOD
+ PMCode => <<'EOD',
+
+use PDL::Options;
+
+# Perl wrapper conditions the data to make life easier for the PP sub.
+
+sub PDL::convolveND {
+ my($a0,$k,$opt0) = @_;
+ my $inplace = $a0->is_inplace;
+ my $a = $a0->new_or_inplace;
+
+
+ barf("convolveND: kernel (".join("x",$k->dims).") has more dims than source (".join("x",$a->dims).")\n")
+ if($a->ndims < $k->ndims);
+
+
+ # Coerce stuff all into the same type. Try to make sense.
+ # The trivial conversion leaves dataflow intact (nontrivial conversions
+ # don't), so the inplace code is OK. Non-inplace code: let the existing
+ # PDL code choose what type is best.
+ my $type;
+ if($inplace) {
+ $type = $a0->get_datatype;
+ } else {
+ my $z = $a->flat->index(0) + $k->flat->index(0);
+ $type = $z->get_datatype;
+ }
+ $a = $a->convert($type);
+ $k = $k->convert($type);
+
+
+ ## Handle options -- $def is a static variable so it only gets set up once.
+ our $def;
+ unless(defined($def)) {
+ $def = new PDL::Options( {
+ Method=>'a',
+ Boundary=>'t'
+ }
+ );
+ $def->minmatch(1);
+ $def->casesens(0);
+ }
+
+ my $opt = $def->options(PDL::Options::ifhref($opt0));
+
+ ###
+ # If the kernel has too few dimensions, we thread over the other
+ # dims -- this is the same as supplying the kernel with dummy dims of
+ # order 1, so, er, we do that.
+ $k = $k->dummy($a->dims - 1, 1)
+ if($a->ndims > $k->ndims);
+ my $kdims = pdl($k->dims);
+
+ ###
+ # Decide whether to FFT or directly convolve: if we're in auto mode,
+ # choose based on the relative size of the image and kernel arrays.
+ my $fft = ( ($opt->{Method} =~ m/^a/i) ?
+ ( $a->nelem > 2500 and ($a->nelem) <= ($k->nelem * 500) ) :
+ ( $opt->{Method} !~ m/^[ds]/i )
+ );
+
+ ###
+ # Pad the array to include boundary conditions
+ my $adims = pdl($a->dims);
+ my $koff = ($kdims/2)->ceil - 1;
+
+ my $aa = $a->range( -$koff, $adims + $kdims, $opt->{Boundary} )
+ ->sever;
+
+ if($fft) {
+ # The eval here keeps conflicts from happening at compile time
+ eval "use PDL::FFT" ;
+
+ print "convolveND: using FFT method\n" if($PDL::debug);
+
+ # FFT works best on doubles; do our work there then cast back
+ # at the end.
+ $aa = double($aa);
+ my $aai = $aa->zeroes;
+
+ my $kk = $aa->zeroes;
+ my $kki = $aa->zeroes;
+ my $tmp; # work around new perl -d "feature"
+ ($tmp = $kk->range( - ($kdims/2)->floor, $kdims, 'p')) .= $k;
+ PDL::fftnd($kk, $kki);
+ PDL::fftnd($aa, $aai);
+
+ {
+ my($ii) = $kk * $aai + $aa * $kki;
+ $aa = $aa * $kk - $kki * $aai;
+ $aai .= $ii;
+ }
+
+ PDL::ifftnd($aa,$aai);
+ $a .= $aa->range( $koff, $adims);
+
+ } else {
+ print "convolveND: using direct method\n" if($PDL::debug);
+
+ ### The first argument is a dummy to set $GENERIC.
+ &PDL::_convolveND_int( $k->flat->index(0), $k, $aa, $a );
+
+ }
+
+
+ $a;
+}
+
+EOD
+ Pars=>'k0()',
+ OtherPars=>'SV *k; SV *aa; SV *a;',
+
+Code => <<'EOD'
+/*
+ * Direct convolution
+ *
+ * Because the kernel is usually the smaller of the two arrays to be convolved,
+ * we thread kernel-first to keep it in the processor's cache. The strategy:
+ * work on a padded copy of the original image, so that (even with boundary
+ * conditions) the geometry of the kernel is linearly related to the input
+ * array. Otherwise, follow the path blazed by Karl in convolve(): keep track
+ * of the offsets for each kernel element in a flattened original PDL.
+ *
+ * The first (PP) argument is a dummy that's only used to set the GENERIC()
+ * macro. The other three arguments should all have the same type as the
+ * first arguments, and are all passed in as SVs. They are: the kernel,
+ * the padded copy of the input PDL, and a pre-allocated output PDL. The
+ * input PDL should be padded by the dimensionality of the kernel.
+ *
+ */
+
+
+ short ndims;
+
+ PDL_Indx *koffs, *koff; /* the "s<foo>" variables are static */
+ $GENERIC() *kvals, *kval; /* scratchspace designed to avoid dynamic */
+ static PDL_Indx skoffs[256]; /* allocation. The cost ia about 2k per */
+ static $GENERIC() skvals[256]; /* datatype, or about 20k of memory. */
+
+ $GENERIC() *aptr;
+ $GENERIC() *aaptr;
+
+ PDL_Indx *ivec;
+ static PDL_Indx sivec[16];
+
+ PDL_Indx i,j;
+
+ pdl *k = PDL->SvPDLV($COMP(k));
+ pdl *a = PDL->SvPDLV($COMP(a));
+ pdl *aa = PDL->SvPDLV($COMP(aa));
+
+ if(!k || !a || !aa)
+ barf("convolveND: Can't convert args to PDLs (should never happen)\n");
+
+ PDL->make_physical(aa);
+ PDL->make_physical(a);
+ PDL->make_physical(k);
+
+ ndims = aa->ndims;
+ if(ndims != k->ndims || ndims != aa->ndims)
+ barf("convolveND: dims don't agree (should never happen)\n");
+
+ /* Allocate scratchpads if necessary */
+ /* This is done in boneheaded but safe manner ('coz we can't be sure */
+ /* of the relationship between the size of GENERIC and the size of */
+ /* a pointer). */
+ if(k->nvals <= 256) {
+ koffs = skoffs;
+ kvals = skvals;
+ } else {
+ koffs = (PDL_Indx *) (PDL->smalloc((STRLEN) (k->nvals * sizeof(PDL_Indx))));
+ kvals = ($GENERIC() *)(PDL->smalloc((STRLEN) (k->nvals * sizeof($GENERIC()))));
+ }
+
+ if(ndims < 16) {
+ ivec = sivec;
+ } else {
+ ivec = (PDL_Indx *) (PDL->smalloc((STRLEN) (ndims * sizeof(PDL_Indx))));
+ }
+
+ if(!ivec || !koffs || !kvals)
+ barf("convolveND: out of memory\n");
+
+ /************************************/
+ /* Fill up the koffs & kvals arrays */
+ /* koffs gets relative offsets into aa for each kernel value; */
+ /* kvals gets the kernel values in the same order (flattened) */
+ for(i=0;i<ndims;ivec[i++] = 0) ;
+ koff = koffs;
+ kval = kvals;
+ j = 0; /* j gets current aa data offset */
+ aptr = ($GENERIC() *)k->data + k->nvals - 1;
+
+
+ do {
+ PDL_Indx acc;
+
+ *(kval++) = *aptr; /* Copy kernel value into kernel list */
+
+ *(koff++) = j; /* Copy current aa offset into koffs list */
+
+ /* Advance k-vector */
+ for(i=0;
+ (i < ndims) &&
+ (aptr -= k->dimincs[i]) && /* Funky pre-test part of loop */
+ (j += aa->dimincs[i]) && /* Funky pre-test part of loop */
+ (++(ivec[i]) >= k->dims[i]);
+ i++) {
+ ivec[i] = 0;
+ aptr += k->dimincs[i] * k->dims[i];
+ j -= aa->dimincs[i] * k->dims[i];
+ }
+ } while(i<ndims);
+
+ /******************************/
+ /* Now do the actual convolution: for each vector in a, */
+ /* accumulate the appropriate aa-sum and stick it into a. */
+ for(i=0;i<ndims;ivec[i++] = 0) ;
+ aptr = a->data;
+ aaptr = aa->data;
+ do {
+ $GENERIC() acc = 0;
+ koff = koffs;
+ kval = kvals;
+ for(i=0;i<k->nvals;i++)
+ acc += aaptr[*(koff++)] * (*(kval++));
+ *aptr = acc;
+
+ /* Advance a-vector and aa-vector */
+ for(i=0;
+ (i<ndims) &&
+ (aptr += a->dimincs[i]) && /* Funky pre-test part of loop */
+ (aaptr += aa->dimincs[i]) && /* Funky pre-test part of loop */
+ (++(ivec[i]) >= a->dims[i]);
+ i++) {
+ ivec[i] = 0;
+ aptr -= a->dimincs[i] * ( a->dims[i]);
+ aaptr -= aa->dimincs[i] * ( a->dims[i]); /* sic */
+ }
+ } while(i<ndims);
+
+EOD
+);
+
+
+pp_done();
+
diff --git a/Lib/ImageRGB/Makefile.PL b/Lib/ImageRGB/Makefile.PL
new file mode 100644
index 0000000..7481041
--- /dev/null
+++ b/Lib/ImageRGB/Makefile.PL
@@ -0,0 +1,20 @@
+
+# Makefile.PL for PDL::Examples module.
+
+# Use this as a template for the Makefile.PL for
+# any external PDL module.
+
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+ at pack = (["imagergb.pd",ImageRGB,PDL::ImageRGB]);
+
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{'OBJECT'} .= ' ppm_quant$(OBJ_EXT)';
+$hash{'clean'}{FILES} .= ' ppm_quant$(OBJ_EXT)';
+
+WriteMakefile(%hash);
+
+# Add genpp rule
+sub MY::postamble { pdlpp_postamble_int(@::pack); }
+
diff --git a/Lib/ImageRGB/imagergb.pd b/Lib/ImageRGB/imagergb.pd
new file mode 100644
index 0000000..ba0b069
--- /dev/null
+++ b/Lib/ImageRGB/imagergb.pd
@@ -0,0 +1,267 @@
+
+pp_add_exported('',"interlrgb rgbtogr bytescl cquant ");
+pp_addhdr('
+#include "pdlppm.h" /* Local decs */
+');
+
+
+############################## PM CODE ########################################
+
+pp_addpm({At=>Top},<<'EOD');
+
+=head1 NAME
+
+PDL::ImageRGB -- some utility functions for RGB image data handling
+
+=head1 DESCRIPTION
+
+Collection of a few commonly used routines involved in handling of RGB, palette
+and grayscale images. Not much more than a start. Should be a good place to
+exercise some of the thread/map/clump PP stuff.
+
+Other stuff that should/could go here:
+
+=over 3
+
+=item *
+color space conversion
+
+=item *
+common image filters
+
+=item *
+image rebinning
+
+=back
+
+=head1 SYNOPSIS
+
+ use PDL::ImageRGB;
+
+=cut
+
+
+use vars qw( $typecheck $EPS );
+
+use PDL::Core;
+use PDL::Basic;
+use PDL::Primitive;
+use PDL::Types;
+
+use Carp;
+use strict 'vars';
+
+
+$PDL::ImageRGB::EPS = 1e-7; # there is probably a more portable way
+
+=head1 FUNCTIONS
+
+=head2 cquant
+
+=for ref
+
+quantize and reduce colours in 8-bit images
+
+=for usage
+
+ ($out, $lut) = cquant($image [,$ncols]);
+
+This function does color reduction for <=8bit displays and accepts 8bit RGB
+and 8bit palette images. It does this through an interface to the ppm_quant
+routine from the pbmplus package that implements the median cut routine which
+intellegently selects the 'best' colors to represent your image on a <= 8bit
+display (based on the median cut algorithm). Optional args: $ncols sets the
+maximum nunmber of colours used for the output image (defaults to 256).
+There are images where a different color
+reduction scheme gives better results (it seems this is true for images
+containing large areas with very smoothly changing colours).
+
+Returns a list containing the new palette image (type PDL_Byte) and the RGB
+colormap.
+
+=cut
+
+# full threading support intended
+*cquant = \&PDL::cquant;
+sub PDL::cquant {
+ barf 'Usage: ($out,$olut) = cquant($image[,$ncols])'
+ if $#_<0 || $#_>1;
+ my $image = shift;
+ my $ncols;
+ if ($#_ >= 0 ) { $ncols=shift; } else { $ncols = 256; };
+ my @Dims = $image->dims;
+ my ($out, $olut) = (null,null);
+
+ barf "input must be byte (3,x,x)" if (@Dims < 2) || ($Dims[0] != 3)
+ || ($image->get_datatype != $PDL_B);
+ cquant_c($image,$out,$olut,$ncols);
+ return ($out,$olut);
+}
+
+
+=head2 interlrgb
+
+=for ref
+
+Make an RGB image from a palette image and its lookup table.
+
+=for usage
+
+ $rgb = $palette_im->interlrgb($lut)
+
+Input should be of an integer type and the lookup table (3,x,...). Will perform
+the lookup for any N-dimensional input pdl (i.e. 0D, 1D, 2D, ...). Uses the
+index command but will not dataflow by default. If you want it to dataflow the
+dataflow_forward flag must be set in the $lut piddle (you can do that by saying
+$lut->set_dataflow_f(1)).
+
+=cut
+
+# interlace a palette image, input as 8bit-image, RGB-lut (3,x,..) to
+# (R,G,B) format for each pixel in the image
+# should already support threading
+*interlrgb=\&PDL::interlrgb;
+sub PDL::interlrgb {
+ my ($pdl,$lut) = @_;
+ my $res;
+ # for our purposes $lut should be (3,z) where z is the number
+ # of colours in the lut
+ barf "exspecting (3,x) input" if ($lut->dims)[0] != 3;
+ # do the conversion as an implicitly threaded index lookup
+ if ($lut->fflows) {
+ $res = $lut->xchg(0,1)->index($pdl->dummy(0));
+ } else {
+ $res = $lut->xchg(0,1)->index($pdl->dummy(0))->sever;
+ }
+ return $res;
+}
+
+
+=head2 rgbtogr
+
+=for ref
+
+Converts an RGB image to a grey scale using standard transform
+
+=for usage
+
+ $gr = $rgb->rgbtogr
+
+Performs a conversion of an RGB input image (3,x,....) to a
+greyscale image (x,.....) using standard formula:
+
+ Grey = 0.301 R + 0.586 G + 0.113 B
+
+=cut
+
+# convert interlaced rgb image to grayscale
+# will convert any (3,...) dim pdl, i.e. also single lines,
+# stacks of RGB images, etc since implicit threading takes care of this
+# should already support threading
+*rgbtogr = \&PDL::rgbtogr;
+sub PDL::rgbtogr {
+ barf "Usage: \$im->rgbtogr" if $#_ < 0;
+ my $im = shift;
+ barf "rgbtogr: exspecting RGB (3,...) input"
+ if (($im->dims)[0] != 3);
+
+ my $type = $im->get_datatype;
+ my $rgb = float([77,150,29])/256; # vector for rgb conversion
+ my $oim = null; # flag PP we want it to allocate
+ inner($im,$rgb,$oim); # do the conversion as a threaded inner prod
+
+ return $oim->convert($type); # convert back to original type
+}
+
+=head2 bytescl
+
+=for ref
+
+Scales a pdl into a specified data range (default 0-255)
+
+=for usage
+
+ $scale = $im->bytescl([$top])
+
+By default $top=255, otherwise you have to give the desired top value as an
+argument to C<bytescl>. Normally C<bytescl> doesn't rescale data that fits
+already in the bounds 0..$top (it only does the type conversion if required).
+If you want to force it to rescale so that the max of the output is at $top and
+the min at 0 you give a negative $top value to indicate this.
+
+=cut
+
+# scale any pdl linearly so that its data fits into the range
+# 0<=x<=$ncols where $ncols<=255
+# returns scaled data with type converted to byte
+# doesn't rescale but just typecasts if data already fits into range, i.e.
+# data ist not necessarily stretched to 0..$ncols
+# needs some changes for full threading support ?? (explicit threading?)
+*bytescl = \&PDL::bytescl;
+sub PDL::bytescl {
+ barf 'Usage: bytescl $im[,$top]' if $#_ < 0;
+ my $pdl = shift;
+ my ($top,$force) = (255,0);
+ $top = shift if $#_ > -1;
+ if ($top < 0) { $force=1; $top *= -1; }
+ $top = 255 if $top > 255;
+
+ print "bytescl: scaling from 0..$top\n" if $PDL::debug;
+ my ($max, $min);
+ $max = max $pdl;
+ $min = min $pdl;
+ return byte $pdl if ($min >= 0 && $max <= $top && !$force);
+
+ # check for pathological cases
+ if (($max-$min) < $EPS) {
+ print "bytescl: pathological case\n" if $PDL::debug;
+ return byte $pdl
+ if (abs($max) < $EPS) || ($max >= 0 && $max <= $top);
+ return byte ($pdl/$max);
+ }
+
+ my $type = $pdl->get_datatype > $PDL_F ? $PDL_D : $PDL_F;
+ return byte ($top*($pdl->convert($type)-$min)/($max-$min)+0.5);
+}
+
+;# Exit with OK status
+
+1;
+
+=head1 BUGS
+
+This package doesn't yet contain enough useful functions!
+
+=head1 AUTHOR
+
+Copyright 1997 Christian Soeller <c.soeller at auckland.ac.nz>
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+=cut
+
+
+EOD
+
+################################ XS CODE #################################
+# a is the input image
+# b is the output image and c the output lut
+pp_def(
+ 'cquant_c',Doc=>undef,
+ Pars => 'a(m,n,o); [o]b(n,o); [o]c(m,p);',
+ GenericTypes => [B],
+ OtherPars => 'int psz => p',
+ Code => 'int status;
+ if ($SIZE(m) != 3) barf("need RGB data (3,x,...)");
+ status = ppm_quant($P(a), NULL, NULL, $SIZE(n),
+ $SIZE(o),$P(b), NULL, $P(c), 0,
+ $SIZE(p), 1);
+ if (!status)
+ barf("ppm_quant returned error status");'
+);
+
+pp_done();
diff --git a/Lib/ImageRGB/pdlppm.h b/Lib/ImageRGB/pdlppm.h
new file mode 100644
index 0000000..a8a7f0d
--- /dev/null
+++ b/Lib/ImageRGB/pdlppm.h
@@ -0,0 +1,5 @@
+/* prototypes of functions in ppm_quant.c */
+int ppm_quant(unsigned char *rin, unsigned char *gin, unsigned char *bin,
+ int cols, int rows, unsigned char *pic8, unsigned char *ilut,
+ unsigned char *olut, int ilen, int newcolors,
+ int mode);
diff --git a/Lib/ImageRGB/ppm_quant.c b/Lib/ImageRGB/ppm_quant.c
new file mode 100644
index 0000000..25c1135
--- /dev/null
+++ b/Lib/ImageRGB/ppm_quant.c
@@ -0,0 +1,672 @@
+/* going to turn it into a standalone module (cut out of xv24to8.c)
+ * final goal: turn into call_external module for idl
+ */
+
+#include <stdio.h>
+#include <stdlib.h> /* qsort */
+
+
+#ifdef DEBUG_OUT
+#define StartCursor() fprintf(stderr,"%%idlppm_quant: choosing colors")
+#define WaitCursor() fputc('.',stderr)
+#define FinishCursor() fputc('\n',stderr)
+#define FatalError(x) { fprintf(stderr,x); return(NULL); }
+#else
+#define StartCursor()
+#define WaitCursor()
+#define FinishCursor()
+#define FatalError(x) return(0)
+#endif
+
+typedef unsigned char byte;
+
+
+/***************************************************************/
+/* The following code based on code from the 'pbmplus' package */
+/* written by Jef Poskanzer */
+/***************************************************************/
+
+
+/* ppmquant.c - quantize the colors in a pixmap down to a specified number
+**
+** Copyright (C) 1989, 1991 by Jef Poskanzer.
+**
+** Permission to use, copy, modify, and distribute this software and its
+** documentation for any purpose and without fee is hereby granted, provided
+** that the above copyright notice appear in all copies and that both that
+** copyright notice and this permission notice appear in supporting
+** documentation. This software is provided "as is" without express or
+** implied warranty.
+*/
+
+
+typedef unsigned char pixval;
+
+#define PPM_MAXMAXVAL 255
+typedef struct { pixval r, g, b; } pixel;
+
+#define PPM_GETR(p) ((p).r)
+#define PPM_GETG(p) ((p).g)
+#define PPM_GETB(p) ((p).b)
+
+#define PPM_ASSIGN(p,red,grn,blu) \
+ { (p).r = (red); (p).g = (grn); (p).b = (blu); }
+
+#define PPM_EQUAL(p,q) ( (p).r == (q).r && (p).g == (q).g && (p).b == (q).b )
+
+
+/* Color scaling macro -- to make writing ppmtowhatever easier. */
+
+#define PPM_DEPTH(newp,p,oldmaxval,newmaxval) \
+ PPM_ASSIGN( (newp), \
+ (int) PPM_GETR(p) * (newmaxval) / ((int)oldmaxval), \
+ (int) PPM_GETG(p) * (newmaxval) / ((int)oldmaxval), \
+ (int) PPM_GETB(p) * (newmaxval) / ((int)oldmaxval) )
+
+
+/* Luminance macro. */
+
+/*
+ * #define PPM_LUMIN(p) \
+ * ( 0.299 * PPM_GETR(p) + 0.587 * PPM_GETG(p) + 0.114 * PPM_GETB(p) )
+ */
+
+/* Luminance macro, using only integer ops. Returns an int (*256) JHB */
+#define PPM_LUMIN(p) \
+ ( 77 * PPM_GETR(p) + 150 * PPM_GETG(p) + 29 * PPM_GETB(p) )
+
+/* Color histogram stuff. */
+
+typedef struct chist_item* chist_vec;
+struct chist_item { pixel color;
+ int value;
+ };
+
+typedef struct chist_list_item* chist_list;
+struct chist_list_item { struct chist_item ch;
+ chist_list next;
+ };
+
+typedef chist_list* chash_table;
+
+typedef struct box* box_vector;
+struct box {
+ int index;
+ int colors;
+ int sum;
+};
+
+
+#define MAXCOLORS 32767
+#define CLUSTER_MAXVAL 63
+
+#define LARGE_LUM
+#define REP_AVERAGE_PIXELS
+
+#define FS_SCALE 1024
+
+#define HASH_SIZE 6553
+
+#define ppm_hashpixel(p) ((((int) PPM_GETR(p) * 33023 + \
+ (int) PPM_GETG(p) * 30013 + \
+ (int) PPM_GETB(p) * 27011) & 0x7fffffff) \
+ % HASH_SIZE)
+
+
+
+/*** function defs ***/
+#define PARM(x) x
+static chist_vec mediancut PARM((chist_vec, int, int, int, int));
+static int redcompare PARM((const void *, const void *));
+static int greencompare PARM((const void *, const void *));
+static int bluecompare PARM((const void *, const void *));
+static int sumcompare PARM((const void *, const void *));
+static chist_vec ppm_computechist PARM((pixel **, int,int,int,int *));
+static chash_table ppm_computechash PARM((pixel **, int,int,int,int *));
+static chist_vec ppm_chashtochist PARM((chash_table, int));
+static chash_table ppm_allocchash PARM((void));
+static void ppm_freechist PARM((chist_vec));
+static void ppm_freechash PARM((chash_table));
+
+int ppm_quant(byte *rin, byte *gin, byte *bin, int cols, int rows,
+ byte *pic8, byte *imap, byte *omap,
+ int len, int newcolors, int mode);
+
+static int DEBUG=0;
+
+#define SEPARATE 0
+#define PACKED 1
+#define PALETTE 2
+
+/* rmap, gmap, bmap 256 byte arrays
+** pic24 rows*cols*3 size byte array
+** pic8 rows*cols byte array
+** newcolors number of new colors to put into look-up table
+*/
+
+/****************************************************************************/
+int ppm_quant(byte *rin, byte *gin, byte *bin, int cols, int rows, byte *pic8, byte *imap,
+ byte *omap, int len, int newcolors, int mode)
+{
+ byte *map;
+ pixel** pixels;
+ register pixel* pP;
+ int row;
+ register int col, limitcol;
+ pixval maxval, newmaxval;
+ int colors;
+ register int index;
+ chist_vec chv, colormap;
+ chash_table cht;
+ int i;
+ unsigned char *picptr;
+ static char *fn = "ppmquant()";
+
+ index = 0;
+ maxval = 255;
+
+ /*
+ * reformat 24-bit image (3 bytes per pixel) into 2-dimensional
+ * array of pixel structures
+ */
+
+ if (DEBUG) fprintf(stderr,"%s: remapping to ppm-style internal fmt\n", fn);
+ WaitCursor();
+
+ pixels = (pixel **) malloc(rows * sizeof(pixel *));
+ if (!pixels) FatalError("couldn't allocate 'pixels' array");
+ for (row=0; row<rows; row++) {
+ pixels[row] = (pixel *) malloc(cols * sizeof(pixel));
+ if (!pixels[row]) FatalError("couldn't allocate a row of pixels array");
+ switch (mode) {
+ case SEPARATE:
+ for (col=0, pP=pixels[row]; col<cols; col++, pP++) {
+ pP->r = *rin++;
+ pP->g = *gin++;
+ pP->b = *bin++;
+ }
+ break;
+ case PACKED:
+ for (col=0, pP=pixels[row]; col<cols; col++, pP++) {
+ pP->r = *rin++;
+ pP->g = *rin++;
+ pP->b = *rin++;
+ }
+ break;
+ case PALETTE:
+ for (col=0, pP=pixels[row]; col<cols; col++, pP++) {
+ pP->r = imap[*rin*3];
+ pP->g = imap[*rin*3+1];
+ pP->b = imap[*rin*3+2];
+ }
+ break;
+ default:
+ return 0;
+ break;
+ }
+
+ }
+ if (DEBUG) fprintf(stderr,"%s: done format remapping\n", fn);
+
+
+
+
+ /*
+ * attempt to make a histogram of the colors, unclustered.
+ * If at first we don't succeed, lower maxval to increase color
+ * coherence and try again. This will eventually terminate, with
+ * maxval at worst 15, since 32^3 is approximately MAXCOLORS.
+ */
+
+ WaitCursor();
+ for ( ; ; ) {
+ if (DEBUG) fprintf(stderr, "%s: making histogram\n", fn);
+
+ chv = ppm_computechist(pixels, cols, rows, MAXCOLORS, &colors);
+ if (chv != (chist_vec) 0) break;
+
+ if (DEBUG) fprintf(stderr, "%s: too many colors!\n", fn);
+ newmaxval = maxval / 2;
+ if (DEBUG) fprintf(stderr, "%s: rescaling colors (maxval=%d) %s\n",
+ fn, newmaxval, "to improve clustering");
+
+ for (row=0; row<rows; ++row)
+ for (col=0, pP=pixels[row]; col<cols; ++col, ++pP)
+ PPM_DEPTH( *pP, *pP, maxval, newmaxval );
+ maxval = newmaxval;
+ }
+
+ if (DEBUG) fprintf(stderr,"%s: %d colors found\n", fn, colors);
+
+
+
+ /*
+ * Step 3: apply median-cut to histogram, making the new colormap.
+ */
+
+ WaitCursor();
+ if (DEBUG) fprintf(stderr, "%s: choosing %d colors\n", fn, newcolors);
+ colormap = mediancut(chv, colors, rows * cols, maxval, newcolors);
+ ppm_freechist(chv);
+
+
+
+ /*
+ * Step 4: map the colors in the image to their closest match in the
+ * new colormap, and write 'em out.
+ */
+
+ if (DEBUG) fprintf(stderr,"%s: mapping image to new colors\n", fn);
+ cht = ppm_allocchash();
+
+ picptr = pic8;
+ for (row = 0; row < rows; ++row) {
+ col = 0; limitcol = cols; pP = pixels[row];
+
+ if ((row & 0x1f) == 0) WaitCursor();
+ do {
+ int hash;
+ chist_list chl;
+
+ /* Check hash table to see if we have already matched this color. */
+
+ hash = ppm_hashpixel(*pP);
+ for (chl = cht[hash]; chl; chl = chl->next)
+ if (PPM_EQUAL(chl->ch.color, *pP)) {index = chl->ch.value; break;}
+
+ if (!chl /*index = -1*/) {/* No; search colormap for closest match. */
+ register int i, r1, g1, b1, r2, g2, b2;
+ register long dist, newdist;
+
+ r1 = PPM_GETR( *pP );
+ g1 = PPM_GETG( *pP );
+ b1 = PPM_GETB( *pP );
+ dist = 2000000000;
+
+ for (i=0; i<newcolors; i++) {
+ r2 = PPM_GETR( colormap[i].color );
+ g2 = PPM_GETG( colormap[i].color );
+ b2 = PPM_GETB( colormap[i].color );
+
+ newdist = ( r1 - r2 ) * ( r1 - r2 ) +
+ ( g1 - g2 ) * ( g1 - g2 ) +
+ ( b1 - b2 ) * ( b1 - b2 );
+
+ if (newdist<dist) { index = i; dist = newdist; }
+ }
+
+ hash = ppm_hashpixel(*pP);
+ chl = (chist_list) malloc(sizeof(struct chist_list_item));
+ if (!chl) FatalError("ran out of memory adding to hash table");
+
+ chl->ch.color = *pP;
+ chl->ch.value = index;
+ chl->next = cht[hash];
+ cht[hash] = chl;
+ }
+
+ *picptr++ = index;
+
+ ++col;
+ ++pP;
+ }
+ while (col != limitcol);
+ }
+
+ /* rescale the colormap */
+ map = omap;
+ for (i=0; i<newcolors; i++) {
+ PPM_DEPTH(colormap[i].color, colormap[i].color, maxval, 255);
+ *map++ = PPM_GETR( colormap[i].color );
+ *map++ = PPM_GETG( colormap[i].color );
+ *map++ = PPM_GETB( colormap[i].color );
+ }
+
+ /* free the pixels array */
+ for (i=0; i<rows; i++) free(pixels[i]);
+ free(pixels);
+
+ /* free cht and colormap */
+ ppm_freechist(colormap);
+ ppm_freechash(cht);
+
+ return 1;
+}
+
+
+
+/*
+** Here is the fun part, the median-cut colormap generator. This is based
+** on Paul Heckbert's paper "Color Image Quantization for Frame Buffer
+** Display", SIGGRAPH '82 Proceedings, page 297.
+*/
+
+
+
+/****************************************************************************/
+static chist_vec mediancut( chv, colors, sum, maxval, newcolors )
+ chist_vec chv;
+ int colors, sum, newcolors;
+ int maxval;
+{
+ chist_vec colormap;
+ box_vector bv;
+ register int bi, i;
+ int boxes;
+
+ bv = (box_vector) malloc(sizeof(struct box) * newcolors);
+ colormap = (chist_vec)
+ malloc(sizeof(struct chist_item) * newcolors );
+
+ if (!bv || !colormap) FatalError("unable to malloc in mediancut()");
+
+ for (i=0; i<newcolors; i++)
+ PPM_ASSIGN(colormap[i].color, 0, 0, 0);
+
+ /*
+ * Set up the initial box.
+ */
+ bv[0].index = 0;
+ bv[0].colors = colors;
+ bv[0].sum = sum;
+ boxes = 1;
+
+
+ /*
+ ** Main loop: split boxes until we have enough.
+ */
+
+ while ( boxes < newcolors ) {
+ register int indx, clrs;
+ int sm;
+ register int minr, maxr, ming, maxg, minb, maxb, v;
+ int halfsum, lowersum;
+
+ /*
+ ** Find the first splittable box.
+ */
+ for (bi=0; bv[bi].colors<2 && bi<boxes; bi++) ;
+ if (bi == boxes) break; /* ran out of colors! */
+
+ indx = bv[bi].index;
+ clrs = bv[bi].colors;
+ sm = bv[bi].sum;
+
+ /*
+ ** Go through the box finding the minimum and maximum of each
+ ** component - the boundaries of the box.
+ */
+ minr = maxr = PPM_GETR( chv[indx].color );
+ ming = maxg = PPM_GETG( chv[indx].color );
+ minb = maxb = PPM_GETB( chv[indx].color );
+
+ for (i=1; i<clrs; i++) {
+ v = PPM_GETR( chv[indx + i].color );
+ if (v < minr) minr = v;
+ if (v > maxr) maxr = v;
+
+ v = PPM_GETG( chv[indx + i].color );
+ if (v < ming) ming = v;
+ if (v > maxg) maxg = v;
+
+ v = PPM_GETB( chv[indx + i].color );
+ if (v < minb) minb = v;
+ if (v > maxb) maxb = v;
+ }
+
+ /*
+ ** Find the largest dimension, and sort by that component. I have
+ ** included two methods for determining the "largest" dimension;
+ ** first by simply comparing the range in RGB space, and second
+ ** by transforming into luminosities before the comparison. You
+ ** can switch which method is used by switching the commenting on
+ ** the LARGE_ defines at the beginning of this source file.
+ */
+ {
+ /* LARGE_LUM version */
+
+ pixel p;
+ int rl, gl, bl;
+
+ PPM_ASSIGN(p, maxr - minr, 0, 0);
+ rl = PPM_LUMIN(p);
+
+ PPM_ASSIGN(p, 0, maxg - ming, 0);
+ gl = PPM_LUMIN(p);
+
+ PPM_ASSIGN(p, 0, 0, maxb - minb);
+ bl = PPM_LUMIN(p);
+
+ if (rl >= gl && rl >= bl)
+ qsort((char*) &(chv[indx]), (size_t) clrs, sizeof(struct chist_item),
+ redcompare );
+ else if (gl >= bl)
+ qsort((char*) &(chv[indx]), (size_t) clrs, sizeof(struct chist_item),
+ greencompare );
+ else
+ qsort((char*) &(chv[indx]), (size_t) clrs, sizeof(struct chist_item),
+ bluecompare );
+ }
+
+ /*
+ ** Now find the median based on the counts, so that about half the
+ ** pixels (not colors, pixels) are in each subdivision.
+ */
+ lowersum = chv[indx].value;
+ halfsum = sm / 2;
+ for (i=1; i<clrs-1; i++) {
+ if (lowersum >= halfsum) break;
+ lowersum += chv[indx + i].value;
+ }
+
+ /*
+ ** Split the box, and sort to bring the biggest boxes to the top.
+ */
+ bv[bi].colors = i;
+ bv[bi].sum = lowersum;
+ bv[boxes].index = indx + i;
+ bv[boxes].colors = clrs - i;
+ bv[boxes].sum = sm - lowersum;
+ ++boxes;
+ qsort((char*) bv, (size_t) boxes, sizeof(struct box), sumcompare);
+ } /* while (boxes ... */
+
+ /*
+ ** Ok, we've got enough boxes. Now choose a representative color for
+ ** each box. There are a number of possible ways to make this choice.
+ ** One would be to choose the center of the box; this ignores any structure
+ ** within the boxes. Another method would be to average all the colors in
+ ** the box - this is the method specified in Heckbert's paper. A third
+ ** method is to average all the pixels in the box. You can switch which
+ ** method is used by switching the commenting on the REP_ defines at
+ ** the beginning of this source file.
+ */
+
+ for (bi=0; bi<boxes; bi++) {
+ /* REP_AVERAGE_PIXELS version */
+ register int indx = bv[bi].index;
+ register int clrs = bv[bi].colors;
+ register long r = 0, g = 0, b = 0, sum = 0;
+
+ for (i=0; i<clrs; i++) {
+ r += PPM_GETR( chv[indx + i].color ) * chv[indx + i].value;
+ g += PPM_GETG( chv[indx + i].color ) * chv[indx + i].value;
+ b += PPM_GETB( chv[indx + i].color ) * chv[indx + i].value;
+ sum += chv[indx + i].value;
+ }
+
+ r = r / sum; if (r>maxval) r = maxval; /* avoid math errors */
+ g = g / sum; if (g>maxval) g = maxval;
+ b = b / sum; if (b>maxval) b = maxval;
+
+ PPM_ASSIGN( colormap[bi].color, r, g, b );
+ }
+
+ free(bv);
+ return colormap;
+}
+
+
+/**********************************/
+static int redcompare(p1, p2)
+ const void *p1, *p2;
+{
+ return (int) PPM_GETR( ((chist_vec)p1)->color ) -
+ (int) PPM_GETR( ((chist_vec)p2)->color );
+}
+
+/**********************************/
+static int greencompare(p1, p2)
+ const void *p1, *p2;
+{
+ return (int) PPM_GETG( ((chist_vec)p1)->color ) -
+ (int) PPM_GETG( ((chist_vec)p2)->color );
+}
+
+/**********************************/
+static int bluecompare(p1, p2)
+ const void *p1, *p2;
+{
+ return (int) PPM_GETB( ((chist_vec)p1)->color ) -
+ (int) PPM_GETB( ((chist_vec)p2)->color );
+}
+
+/**********************************/
+static int sumcompare(p1, p2)
+ const void *p1, *p2;
+{
+ return ((box_vector) p2)->sum - ((box_vector) p1)->sum;
+}
+
+
+
+/****************************************************************************/
+static chist_vec
+ ppm_computechist(pixels, cols, rows, maxcolors, colorsP)
+ pixel** pixels;
+ int cols, rows, maxcolors;
+ int* colorsP;
+{
+ chash_table cht;
+ chist_vec chv;
+
+ cht = ppm_computechash(pixels, cols, rows, maxcolors, colorsP);
+ if (!cht) return (chist_vec) 0;
+
+ chv = ppm_chashtochist(cht, maxcolors);
+ ppm_freechash(cht);
+ return chv;
+}
+
+
+/****************************************************************************/
+static chash_table ppm_computechash(pixels, cols, rows,
+ maxcolors, colorsP )
+ pixel** pixels;
+ int cols, rows, maxcolors;
+ int* colorsP;
+{
+ chash_table cht;
+ register pixel* pP;
+ chist_list chl;
+ int col, row, hash;
+
+ cht = ppm_allocchash( );
+ *colorsP = 0;
+
+ /* Go through the entire image, building a hash table of colors. */
+ for (row=0; row<rows; row++)
+ for (col=0, pP=pixels[row]; col<cols; col++, pP++) {
+ hash = ppm_hashpixel(*pP);
+
+ for (chl = cht[hash]; chl != (chist_list) 0; chl = chl->next)
+ if (PPM_EQUAL(chl->ch.color, *pP)) break;
+
+ if (chl != (chist_list) 0) ++(chl->ch.value);
+ else {
+ if ((*colorsP)++ > maxcolors) {
+ ppm_freechash(cht);
+ return (chash_table) 0;
+ }
+
+ chl = (chist_list) malloc(sizeof(struct chist_list_item));
+ if (!chl) FatalError("ran out of memory computing hash table");
+
+ chl->ch.color = *pP;
+ chl->ch.value = 1;
+ chl->next = cht[hash];
+ cht[hash] = chl;
+ }
+ }
+
+ return cht;
+}
+
+
+/****************************************************************************/
+static chash_table ppm_allocchash()
+{
+ chash_table cht;
+ int i;
+
+ cht = (chash_table) malloc( HASH_SIZE * sizeof(chist_list) );
+ if (!cht) FatalError("ran out of memory allocating hash table");
+
+ for (i=0; i<HASH_SIZE; i++ )
+ cht[i] = (chist_list) 0;
+
+ return cht;
+}
+
+
+/****************************************************************************/
+static chist_vec ppm_chashtochist( cht, maxcolors )
+ chash_table cht;
+ int maxcolors;
+{
+ chist_vec chv;
+ chist_list chl;
+ int i, j;
+
+ /* Now collate the hash table into a simple chist array. */
+ chv = (chist_vec) malloc( maxcolors * sizeof(struct chist_item) );
+
+ /* (Leave room for expansion by caller.) */
+ if (!chv) FatalError("ran out of memory generating histogram");
+
+ /* Loop through the hash table. */
+ j = 0;
+ for (i=0; i<HASH_SIZE; i++)
+ for (chl = cht[i]; chl != (chist_list) 0; chl = chl->next) {
+ /* Add the new entry. */
+ chv[j] = chl->ch;
+ ++j;
+ }
+
+ return chv;
+}
+
+
+/****************************************************************************/
+static void ppm_freechist( chv )
+ chist_vec chv;
+{
+ free( (char*) chv );
+}
+
+
+/****************************************************************************/
+static void ppm_freechash( cht )
+ chash_table cht;
+{
+ int i;
+ chist_list chl, chlnext;
+
+ for (i=0; i<HASH_SIZE; i++)
+ for (chl = cht[i]; chl != (chist_list) 0; chl = chlnext) {
+ chlnext = chl->next;
+ free( (char*) chl );
+ }
+
+ free( (char*) cht );
+}
diff --git a/Lib/Interpolate/Interpolate.pm b/Lib/Interpolate/Interpolate.pm
new file mode 100644
index 0000000..d616e89
--- /dev/null
+++ b/Lib/Interpolate/Interpolate.pm
@@ -0,0 +1,580 @@
+
+=head1 NAME
+
+PDL::Interpolate - provide a consistent interface to the interpolation routines available in PDL
+
+=head1 SYNOPSIS
+
+ use PDL::Interpolate;
+
+ my $i = new PDL::Interpolate( x => $x, y = $y );
+ my $y = $i->interpolate( $xi );
+
+=head1 DESCRIPTION
+
+This module aims to provide a relatively-uniform interface
+to the various interpolation methods available to PDL.
+The idea is that a different interpolation scheme
+can be used just by changing the C<new> call.
+
+At present, PDL::Interpolate itself just provides
+a somewhat-convoluted interface to the C<interpolate>
+function of L<PDL::Primitive|PDL::Primitive/interpolate>.
+However, it is expected that derived classes,
+such as
+L<PDL::Interpolate::Slatec|PDL::Interpolate::Slatec>,
+will actually be used in real-world situations.
+
+To use, create a PDL::Interpolate (or a derived class)
+object, supplying it with its required attributes.
+
+=head1 LIBRARIES
+
+Currently, the avaliable classes are
+
+=over 4
+
+=item PDL::Interpolate
+
+Provides an interface to the interpolation routines of PDL.
+At present this is the linear interpolation routine
+L<PDL::Primitive::interpol|PDL::Primitive/interpol>.
+
+=item PDL::Interpolate::Slatec
+
+The SLATEC library contains several approaches to interpolation:
+piecewise cubic Hermite functions and B-splines.
+At present, only the former method is available.
+
+=back
+
+It should be relatively easy to provide an interface to other
+interpolation routines, such as those provided by the
+Gnu Scientific Library (GSL).
+
+=head1 ATTRIBUTES
+
+The attributes (or options) of an object are as follows;
+derived classes may modify this list.
+
+ Attribute Flag Description
+ x sgr x positions of data
+ y sgr function values at x positions
+ bc g boundary conditions
+ err g error flag
+ type g type of interpolation
+
+A flag of C<s> means that a user can set this attribute
+with the L<new|/new> or L<set|/set> methods,
+a flag of C<g> means that the user can obtain the
+value of this attribute using L<get|/get>,
+and a flag of C<r> means that the attribute is required
+when an object is created (see the L<new|/new> method).
+
+ Attribute Default value
+ bc "none"
+ type "linear"
+
+If a routine is sent an attribute it does not understand, then
+it ignores that attribute, except for L<get|/get>, which
+returns C<undef> for that value.
+
+=head1 METHODS
+
+The default methods are described below. However, defined classes
+may extend them as they see fit, and add new methods.
+
+Throughout this documentation, C<$x> and C<$y> refer to the function
+to be interpolated whilst C<$xi> and C<$yi> are the interpolated values.
+
+=head1 THREADING
+
+The class will thread properly if the routines it calls do so.
+See the SYNOPSIS section of L<PDL::Interpolate::Slatec>
+(if available) for an example.
+
+=cut
+
+package PDL::Interpolate;
+
+use Carp;
+use strict;
+
+####################################################################
+
+## Public routines:
+
+=head2 new
+
+=for usage
+
+ $obj = new PDL::Interpolate( x => $x, y => $y );
+
+=for ref
+
+Create a PDL::Interpolate object.
+
+The required L<attributes|/attributes> are
+C<x> and C<y>.
+At present the only available interpolation method
+is C<"linear"> - which just uses
+L<PDL::Primitive::interpolate|PDL::Primitive::interpolate> - and
+there are no options for boundary conditions, which is why
+the C<type> and C<bc> attributes can not be changed.
+
+=cut
+
+# meaning of types:
+# required - required, if this attr is changed, we need to re-initialise
+# settable - can be changed with a new() or set() command
+# gettable - can be read with a get() command
+#
+sub new {
+ my $this = shift;
+ my $class = ref($this) || $this;
+
+ # class structure
+ my $self = {
+ attributes => {},
+ values => {},
+ types => { required => 0, settable => 0, gettable => 0 },
+ flags => { library => "PDL", status => 1, routine => "none", changed => 1 },
+ };
+
+ # make $self into an object
+ bless $self, $class;
+
+ # set up default attributes
+ #
+ $self->_add_attr(
+ x => { required => 1, settable => 1, gettable => 1 },
+ y => { required => 1, settable => 1, gettable => 1 },
+ bc => { gettable => 1 },
+ err => { gettable => 1 },
+ type => { gettable => 1 },
+ );
+ $self->_set_value(
+ bc => "none",
+ type => "linear",
+ );
+
+ # set variables
+ # - expect sub-classes to call this new with no variables, so $#_ == -1
+ $self->set( @_ ) if ( @_ );
+
+ # return the object
+ return $self;
+
+} # sub: new()
+
+#####################################################################
+
+# in _add_attr(), _change_attr() and _add_attr_type()
+# we set flags->changed to 1 when something changes. It's
+# a bit over the top to do this, as these should only be called when
+# creating the object, when the changed flag should be set to 1 anyway
+
+# add attributes to the object and sets value to undef
+#
+# supply a hash array, keys == variable name,
+# values are a hash array with keys matching
+# $self->{values}, which also gives the default value
+# for the type
+#
+# this can only be used to create an attribute -
+# see _change_attr() to change an already exsiting attribute.
+#
+# the fields are set to the default values, then filled in with the supplied values
+# any value that is unknown is ignored
+#
+sub _add_attr {
+ my $self = shift;
+ my %attrs = ( @_ );
+
+ foreach my $attr ( keys %attrs ) {
+ croak "ERROR: adding an attribute ($attr) which is already known.\n"
+ if defined $self->{attributes}->{$attr};
+
+ # set default values
+ foreach my $type ( keys %{$self->{types}} ) {
+ $self->{attributes}->{$attr}->{$type} = $self->{types}->{$type};
+ }
+
+ # change the values to those supplied
+ foreach my $type ( keys %{$attrs{$attr}} ) {
+ $self->{attributes}->{$attr}->{$type} = $attrs{$attr}->{$type}
+ if exists $self->{types}->{$type};
+ }
+ # set value to undef
+ $self->{values}->{$attr} = undef;
+ }
+ $self->{flags}->{changed} = 1;
+
+} # sub: _add_attr()
+
+# changes attributes of the object
+#
+# the given attributes MUST already exist
+#
+sub _change_attr {
+ my $self = shift;
+ my %attrs = ( @_ );
+
+ foreach my $attr ( keys %attrs ) {
+ croak "ERROR: changing an attribute ($attr) which is not known.\n"
+ unless defined $self->{attributes}->{$attr};
+
+ # change the values to those supplied
+ foreach my $type ( keys %{$attrs{$attr}} ) {
+ if ( exists $self->{types}->{$type} ) {
+ $self->{attributes}->{$attr}->{$type} = $attrs{$attr}->{$type};
+ $self->{flags}->{changed} = 1;
+ }
+ }
+ }
+} # sub: _change_attr()
+
+# adds the given types to the allowed list, and
+# updates all attributes to contain the default value
+#
+# Useful for sub-classes which add new types
+#
+sub _add_attr_type {
+ my $self = shift;
+ my %types = ( @_ );
+
+ foreach my $type ( keys %types ) {
+ croak "ERROR: adding type ($type) that is already known.\n"
+ if exists $self->{types}->{$type};
+ $self->{types}->{$type} = $types{$type};
+
+ # loop through each attribute, adding this type
+ foreach my $attr ( keys %{$self->{attributes}} ) {
+ $self->{attributes}->{$attr}->{$type} = $types{$type};
+ }
+
+ $self->{flags}->{changed} = 1;
+ }
+} # sub: _add_attr_type()
+
+####################################################################
+
+# if an attribute has changed, check all required attributes
+# still exist and re-initialise the object (for PDL::Interpolate
+# this is a nop)
+#
+sub _check_attr {
+ my $self = shift;
+ return unless $self->{flags}->{changed};
+
+ my @emsg;
+ foreach my $name ( keys %{ $self->{attributes} } ) {
+ if( $self->{attributes}->{$name}->{required} ) {
+ push @emsg, $name unless defined($self->{values}->{$name});
+ }
+ }
+ croak "ERROR - the following attributes must be supplied:\n [ @emsg ]\n"
+ unless $#emsg == -1;
+
+ $self->{flags}->{routine} = "none";
+ $self->{flags}->{status} = 1;
+
+ $self->_initialise;
+ $self->{flags}->{new} = 0;
+
+} # sub: check_attr()
+
+####################################################################
+#
+# method to be over-ridden by sub-classes
+
+# PDL::Interpolate needs no initialisation
+#
+sub _initialise {}
+
+####################################################################
+
+# a version of set that ignores the settable flag
+# - for use by the class, not by the public
+#
+# it still ignores unknown attributes
+#
+sub _set_value {
+ my $self = shift;
+ my %attrs = ( @_ );
+
+ foreach my $attr ( keys %attrs ) {
+ if ( exists($self->{values}->{$attr}) ) {
+ $self->{values}->{$attr} = $attrs{$attr};
+ $self->{flags}->{changed} = 1;
+ }
+ }
+
+} # sub: _set_value()
+
+# a version of get that ignores the gettable flag
+# - for use by the class, not by the public
+#
+# an unknown attribute returns an undef
+#
+sub _get_value {
+ my $self = shift;
+
+ my @ret;
+ foreach my $name ( @_ ) {
+ if ( exists $self->{values}->{$name} ) {
+ push @ret, $self->{values}->{$name};
+ } else {
+ push @ret, undef;
+ }
+ }
+
+ return wantarray ? @ret : $ret[0];
+
+} # sub: _get_value()
+
+####################################################################
+
+=head2 set
+
+=for usage
+
+ my $nset = $obj->set( x = $newx, $y => $newy );
+
+=for ref
+
+Set attributes for a PDL::Interpolate object.
+
+The return value gives the number of the supplied attributes
+which were actually set.
+
+=cut
+
+sub set {
+ my $self = shift;
+ my %vals = ( @_ );
+
+ my $ctr = 0;
+ foreach my $name ( keys %vals ) {
+ if ( exists $self->{attributes}->{$name}->{settable} ) {
+ $self->{values}->{$name} = $vals{$name};
+ $ctr++;
+ }
+ }
+
+ $self->{flags}->{changed} = 1 if $ctr;
+ return $ctr;
+
+} # sub: set()
+
+####################################################################
+
+=head2 get
+
+=for usage
+
+ my $x = $obj->get( x );
+ my ( $x, $y ) = $obj->get( qw( x y ) );
+
+=for ref
+
+Get attributes from a PDL::Interpolate object.
+
+Given a list of attribute names, return a list of
+their values; in scalar mode return a scalar value.
+If the supplied list contains an unknown attribute,
+C<get> returns a value of C<undef> for that
+attribute.
+
+=cut
+
+sub get {
+ my $self = shift;
+
+ my @ret;
+ foreach my $name ( @_ ) {
+ if ( exists $self->{attributes}->{$name}->{gettable} ) {
+ push @ret, $self->{values}->{$name};
+ } else {
+ push @ret, undef;
+ }
+ }
+
+ return wantarray ? @ret : $ret[0];
+
+} # sub: get()
+
+####################################################################
+
+=head2 interpolate
+
+=for usage
+
+ my $yi = $obj->interpolate( $xi );
+
+=for ref
+
+Returns the interpolated function at a given set of points.
+
+A status value of -1, as returned by the C<status> method,
+means that some of the C<$xi> points lay outside the
+range of the data. The values for these points
+were calculated using linear extrapolation.
+
+=cut
+
+sub interpolate {
+ my $self = shift;
+ my $xi = shift;
+
+ croak 'Usage: $obj->interpolate( $xi )' . "\n"
+ unless defined $xi;
+
+ # check everything is fine
+ $self->_check_attr();
+
+ # get values in one go
+ my ( $x, $y ) = $self->_get_value( qw( x y ) );
+
+ my ( $yi, $err ) = PDL::Primitive::interpolate( $xi, $x, $y );
+
+ if ( any $err ) {
+ $self->{flags}->{status} = -1;
+ } else {
+ $self->{flags}->{status} = 1;
+ }
+ $self->_set_value( err => $err );
+
+ $self->{flags}->{routine} = "interpolate";
+
+ return $yi;
+}
+
+####################################################################
+#
+# access to flags - have individual methods for these
+
+=head2 status
+
+=for usage
+
+ my $status = $obj->status;
+
+=for ref
+
+Returns the status of a PDL::Interpolate object
+
+Returns B<1> if everything is okay, B<0> if
+there has been a serious error since the last time
+C<status> was called, and B<-1> if there
+was a problem which was not serious.
+In the latter case, C<$obj-E<gt>get("err")> may
+provide more information, depending on the
+particular class.
+
+=cut
+
+sub status { my $self = shift; return $self->{flags}->{status}; }
+
+=head2 library
+
+=for usage
+
+ my $name = $obj->library;
+
+=for ref
+
+Returns the name of the library used by a PDL::Interpolate object
+
+For PDL::Interpolate, the library name is C<"PDL">.
+
+=cut
+
+sub library { my $self = shift; return $self->{flags}->{library}; }
+
+=head2 routine
+
+=for usage
+
+ my $name = $obj->routine;
+
+=for ref
+
+Returns the name of the last routine called by a PDL::Interpolate object.
+
+For PDL::Interpolate, the only routine used is C<"interpolate">.
+This will be more useful when calling derived classes,
+in particular when trying to decode the values stored in the
+C<err> attribute.
+
+=cut
+
+sub routine { my $self = shift; return $self->{flags}->{routine}; }
+
+=head2 attributes
+
+=for usage
+
+ $obj->attributes;
+ PDL::Interpolate::attributes;
+
+=for ref
+
+Print out the flags for the attributes of an object.
+Useful in case the documentation is just too opaque!
+
+=for example
+
+ PDL::Interpolate->attributes;
+ Flags Attribute
+ SGR x
+ SGR y
+ G err
+ G type
+ G bc
+
+=cut
+
+# note, can be called with the class, rather than just
+# an object
+#
+# to allow this, I've used a horrible hack - we actually
+# create an object and then print out the attributes from that
+# Ugh!
+#
+sub attributes {
+ my $self = shift;
+
+ # ugh
+ $self = $self->new unless ref($self);
+
+ print "Flags Attribute\n";
+ while ( my ( $attr, $hashref ) = each %{$self->{attributes}} ) {
+ my $flag = "";
+ $flag .= "S" if $hashref->{settable};
+ $flag .= "G" if $hashref->{gettable};
+ $flag .= "R" if $hashref->{required};
+
+ printf " %-3s %s\n", $flag, $attr;
+ }
+ return;
+}
+
+####################################################################
+
+=head1 AUTHOR
+
+Copyright (C) 2000 Doug Burke (burke at ifa.hawaii.edu).
+All rights reserved. There is no warranty.
+You are allowed to redistribute this software / documentation as
+described in the file COPYING in the PDL distribution.
+
+=head1 SEE ALSO
+
+L<PDL>, perltoot(1).
+
+=cut
+
+####################################################################
+# End with a true
+1;
diff --git a/Lib/Interpolate/Makefile.PL b/Lib/Interpolate/Makefile.PL
new file mode 100644
index 0000000..6121e42
--- /dev/null
+++ b/Lib/Interpolate/Makefile.PL
@@ -0,0 +1,8 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => "PDL::Interpolate",
+ VERSION_FROM => "../../Basic/Core/Version.pm",
+ DIR => [ 'Slatec' ],
+);
+
diff --git a/Lib/Interpolate/Slatec/Makefile.PL b/Lib/Interpolate/Slatec/Makefile.PL
new file mode 100644
index 0000000..1c47968
--- /dev/null
+++ b/Lib/Interpolate/Slatec/Makefile.PL
@@ -0,0 +1,29 @@
+use ExtUtils::MakeMaker;
+
+PDL::Core::Dev->import();
+
+# do we build PDL::Interpolate::Slatec ?
+
+$msg = "\n Will skip build of PDL::Interpolate::Slatec\n";
+$build=0;
+
+if ($^O =~ /win32/i) {
+ $msg = "\n Win32 systems not yet supported: no build of PDL::Interpolate::Slatec\n";
+} elsif (defined $PDL_CONFIG{WITH_SLATEC} and $PDL_CONFIG{WITH_SLATEC} != 0 ) {
+ $build=1;
+}
+
+if ($build==0) {
+ warn $msg . "\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ return;
+} else {
+ print "\n Building PDL::Interpolate::Slatec.\n\n";
+}
+
+WriteMakefile(
+ NAME => "PDL::Interpolate::Slatec",
+ VERSION_FROM => "../../../Basic/Core/Version.pm",
+);
+
diff --git a/Lib/Interpolate/Slatec/Slatec.pm b/Lib/Interpolate/Slatec/Slatec.pm
new file mode 100644
index 0000000..7aa03a2
--- /dev/null
+++ b/Lib/Interpolate/Slatec/Slatec.pm
@@ -0,0 +1,421 @@
+
+=head1 NAME
+
+PDL::Interpolate::Slatec - simple interface to SLATEC interpolation routines
+
+=head1 SYNOPSIS
+
+ use PDL::Interpolate::Slatec;
+ use PDL::Math;
+
+ # somewhat pointless way to estimate cos and sin,
+ # but is shows that you can thread if you want to
+ #
+ my $x = pdl( 0 .. 45 ) * 4 * 3.14159 / 180;
+ my $y = cat( sin($x), cos($x) );
+ #
+ my $obj = new PDL::Interpolate::Slatec( x => $x, y = $y );
+ #
+ my $xi = pdl( 0.5, 1.5, 2.5 );
+ my $yi = $obj->interpolate( $xi );
+ #
+ print "cos( $xi ) equals ", $yi->slice(':,(0)'), "\n";
+ cos( [0.5 1.5 2.5] ) equals [0.87759844 0.070737667 -0.80115622]
+ #
+ print "sin( $xi ) equals ", $yi->slice(':,(1)'), "\n";
+ sin( [0.5 1.5 2.5] ) equals [ 0.4794191 0.99768655 0.59846449]
+ #
+ print cos($xi), "\n", sin($xi), "\n";
+ [0.87758256 0.070737202 -0.80114362]
+ [0.47942554 0.99749499 0.59847214]
+
+=head1 DESCRIPTION
+
+Use the interface defined by L<PDL::Interpolate|PDL::Interpolate>
+to provide a simple way to use the SLATEC interpolation
+routines (e.g. see L<PDL::Slatec|PDL::Slatec>).
+Hence the name for this library - as returned by the C<library>
+method - is C<"Slatec">.
+
+Currently, only the
+L<piecewise cubic Hermite polynomial routines|PDL::Slatec/Piecewise_cubic_Hermite_interpol>
+are available (C<type == "pch">).
+
+=head2 Attributes
+
+The following changes are made to the attributes
+of L<PDL::Interpolate|PDL::Interpolate>:
+
+ Attribute Flag Description
+ bc sgr boundary conditions
+ g g estimated gradient at x positions
+
+ Attribute Default Allowed values
+ bc "simple" see Boundary conditions section
+ type "pch"
+
+Given the initial set of points C<(x,y)>, the C<"pch">
+library estimates the gradient at these points using the
+given boundary conditions (as specified by the
+C<bc> attribute).
+The estimated gradient can be obtained using
+
+ $gradient = $obj->get( 'g' );
+
+As described in the L<interpolate|/interpolate> method,
+the C<"pch"> routines can also estimate the gradient,
+as well as the function value, for a set of C<$xi>.
+
+=head2 Boundary conditions for the pch routines
+
+If your data is monotonic, and you are not too bothered about
+edge effects, then the default value of C<bc> of C<"simple"> is for you.
+Otherwise, take a look at the description of
+L<PDL::Slatec::chic|PDL::Slatec/chic> and use a hash reference
+for the C<bc> attribute, with the following keys:
+
+=over 3
+
+=item monotonic
+
+0 if the interpolant is to be monotonic in each interval (so
+the gradient will be 0 at each switch point),
+otherwise the gradient is calculated using a 3-point difference
+formula at switch points.
+If E<gt> 0 then the interpolant is forced to lie close to the
+data, if E<lt> 0 no such control is imposed.
+Default = B<0>.
+
+=item start
+
+A perl list of one or two elements. The first element defines how the
+boundary condition for the start of the array is to be calculated;
+it has a range of C<-5 .. 5>, as given for the C<ic> parameter
+of L<chic|PDL::Slatec/chic>.
+The second element, only used if options 2, 1, -1, or 2
+are chosen, contains the value of the C<vc> parameter.
+Default = B<[ 0 ]>.
+
+=item end
+
+As for C<start>, but for the end of the data.
+
+=back
+
+An example would be
+
+ $obj->set( bc => { start => [ 1, 0 ], end => [ 1, -1 ] }
+
+which sets the first derivative at the first point to 0,
+and at the last point to -1.
+
+=head2 Errors
+
+The C<status> method provides a simple mechanism to check if
+the previous method was successful. The C<err> attribute
+contains the C<$ierr> piddle returned by the Slatec
+routine if a more precise diagnostic is required.
+To find out which routine was called, use the
+C<routine> method.
+
+=cut
+
+package PDL::Interpolate::Slatec;
+
+use PDL::Interpolate;
+use PDL::Slatec;
+use Carp;
+
+use strict;
+use vars qw( @ISA );
+
+ at ISA = qw ( PDL::Interpolate );
+
+####################################################################
+#
+
+####################################################################
+#
+## Public routines:
+
+sub new {
+ my $this = shift;
+ my $class = ref($this) || $this;
+ my $self = $class->SUPER::new(); # note: do not send in values
+
+ # change from PDL::Interpolate to PDL::Interpolate::Slatec
+ bless ($self, $class);
+
+ # change class attributes
+ $self->_change_attr(
+ bc => { required => 1, settable => 1 }, # already gettable
+ );
+ $self->_set_value( bc => "simple", type => "pch" );
+ $self->_add_attr(
+ g => { gettable => 1 },
+ );
+
+ $self->{flags}->{library} = "Slatec";
+ $self->{flags}->{routine} = "none";
+
+ # set variables
+ $self->set( @_ );
+
+ return $self;
+
+} # sub: new
+
+####################################################################
+
+# set up the interpolation
+#
+sub _initialise {
+ my $self = shift;
+
+ # set up error flags
+ $self->{flags}->{status} = 0;
+ $self->{flags}->{routine} = "none";
+
+ # get values in one go
+ my ( $x, $y, $g, $bc ) = $self->_get_value( qw( x y g bc ) );
+
+ # check 1st dimention of x and y are the same
+ # ie allow the possibility of threading
+ my $xdim = $x->getdim( 0 );
+ my $ydim = $y->getdim( 0 );
+ croak "ERROR: x and y piddles must have the same first dimension.\n"
+ unless $xdim == $ydim;
+
+ # if a gradient has been specified, then we don't need to do anything
+ # - other than check the dimensions
+ if ( defined $g ) {
+ croak "ERROR: gradient piddle must have the same first dimension as x and y.\n"
+ unless $g->getdim( 0 ) == $xdim;
+ $self->{flags}->{status} = 1;
+ return;
+ }
+
+ my $ierr;
+ if ( ref($bc) eq "HASH" ) {
+ my $monotonic = $bc->{monotonic} || 0;
+ my $start = $bc->{start} || [ 0 ];
+ my $end = $bc->{end} || [ 0 ];
+
+ my $ic = $x->short( $start->[0], $end->[0] );
+ my $vc = $x->float( 0, 0 ); # it will get promoted if required
+
+ if ( $#$start == 1 ) { $vc->set( 0, $start->[1] ); }
+ if ( $#$end == 1 ) { $vc->set( 1, $end->[1] ); }
+
+ my $wk = $x->zeroes( $x->float, 2*$xdim );
+ ( $g, $ierr ) = chic( $ic, $vc, $monotonic, $x, $y, $wk );
+
+ $self->{flags}->{routine} = "chic";
+
+ } elsif ( $bc eq "simple" ) {
+ # chim
+ ( $g, $ierr ) = chim( $x, $y );
+
+ $self->{flags}->{routine} = "chim";
+
+ } else {
+ # Unknown boundary condition
+ croak "ERROR: unknown boundary condition <$bc>.\n";
+ # return;
+ }
+
+ $self->_set_value( g => $g, err => $ierr );
+
+ if ( all $ierr == 0 ) {
+ # everything okay
+ $self->{flags}->{status} = 1;
+ } elsif ( any $ierr < 0 ) {
+ # a problem
+ $self->{flags}->{status} = 0;
+ } else {
+ # there were switches in monotonicity
+ $self->{flags}->{status} = -1;
+ }
+
+} # sub: _initialise
+
+####################################################################
+
+=head2 interpolate
+
+=for usage
+
+ my $yi = $obj->interpolate( $xi );
+ my ( $yi, $gi ) = $obj->interpolate( $xi );
+
+=for ref
+
+Returns the interpolated function and derivative
+at a given set of points.
+
+If evaluated in scalar mode, it returns only
+the interpolated function values.
+
+=cut
+
+sub interpolate {
+ my $self = shift;
+ my $xi = shift;
+
+ croak 'Usage: $obj->interpolate( $xi )' . "\n"
+ unless defined $xi;
+
+ # check everything is fine
+ $self->_check_attr();
+
+ # get values in one go
+ my ( $x, $y, $g ) = $self->_get_value( qw( x y g ) );
+
+ my ( $yi, $gi, $ierr );
+
+ if ( wantarray ) {
+ ( $yi, $gi, $ierr ) = chfd( $x, $y, $g, 0, $xi );
+ $self->{flags}->{routine} = "chfd";
+ } else {
+ ( $yi, $ierr ) = chfe( $x, $y, $g, 0, $xi );
+ $self->{flags}->{routine} = "chfe";
+ }
+
+ # set err/status info
+ $self->_set_value( err => $ierr );
+
+ if ( all $ierr == 0 ) {
+ # everything okay
+ $self->{flags}->{status} = 1;
+ } elsif ( all $ierr > 0 ) {
+ # extrapolation was required
+ $self->{flags}->{status} = -1;
+ } else {
+ # a problem
+ $self->{flags}->{status} = 0;
+ }
+
+ return wantarray ? ( $yi, $gi ) : $yi;
+
+} # sub: interpolate
+
+=head2 integrate
+
+=for usage
+
+ my $ans = $obj->integrate( index => pdl( 2, 5 ) );
+ my $ans = $obj->integrate( x => pdl( 2.3, 4.5 ) );
+
+=for ref
+
+Integrate the function stored in the PDL::Interpolate::Slatec
+object.
+
+The integration can either be between points of
+the original C<x> array (C<index>), or arbitrary x values
+(C<x>). For both cases, a two element piddle
+should be given,
+to specify the start and end points of the integration.
+
+=over 7
+
+=item index
+
+The values given refer to the indices of the points
+in the C<x> array.
+
+=item x
+
+The array contains the actual values to integrate between.
+
+=back
+
+If the C<status> method returns a value of -1, then
+one or both of the integration limits did not
+lie inside the C<x> array. I<Caveat emptor> with the
+result in such a case.
+
+The reason for using piddles, rather than arrays, is that
+it allows for threading.
+
+=cut
+
+sub integrate {
+ my $self = shift;
+
+ croak 'Usage: $obj->integrate( $type => $limits )' . "\n"
+ unless $#_ == 1;
+
+ # check everything is fine
+ $self->_check_attr();
+
+ $self->{flags}->{status} = 0;
+ $self->{flags}->{routine} = "none";
+
+ my ( $type, $indices ) = ( @_ );
+
+ croak "Unknown type ($type) sent to integrate method.\n"
+ unless $type eq "x" or $type eq "index";
+
+ my $fdim = $indices->getdim(0);
+ croak "Indices must have a first dimension of 2, not $fdim.\n"
+ unless $fdim == 2;
+
+ my $lo = $indices->slice('(0)');
+ my $hi = $indices->slice('(1)');
+
+ my ( $x, $y, $g ) = $self->_get_value( qw( x y g ) );
+ my ( $ans, $ierr );
+
+ if ( $type eq "x" ) {
+ ( $ans, $ierr ) = chia( $x, $y, $g, 0, $lo, $hi );
+ $self->{flags}->{routine} = "chia";
+
+ if ( all $ierr == 0 ) {
+ # everything okay
+ $self->{flags}->{status} = 1;
+ } elsif ( any $ierr < 0 ) {
+ # a problem
+ $self->{flags}->{status} = 0;
+ } else {
+ # out of range
+ $self->{flags}->{status} = -1;
+ }
+
+ } else {
+ ( $ans, $ierr ) = chid( $x, $y, $g, 0, $lo, $hi );
+ $self->{flags}->{routine} = "chid";
+
+ if ( all $ierr == 0 ) {
+ # everything okay
+ $self->{flags}->{status} = 1;
+ } elsif ( all $ierr != -4 ) {
+ # a problem
+ $self->{flags}->{status} = 0;
+ } else {
+ # out of range (ierr == -4)
+ $self->{flags}->{status} = -1;
+ }
+
+ }
+
+ $self->_set_value( err => $ierr );
+ return $ans;
+}
+
+=head1 AUTHOR
+
+Copyright (C) 2000 Doug Burke (burke at ifa.hawaii.edu).
+All rights reserved. There is no warranty.
+You are allowed to redistribute this software / documentation as
+described in the file COPYING in the PDL distribution.
+
+=head1 SEE ALSO
+
+L<PDL::Interpolate>, L<PDL>, perltoot(1).
+
+=cut
+
+####################################################################
+# End with a true
+1;
diff --git a/Lib/Makefile.PL b/Lib/Makefile.PL
new file mode 100644
index 0000000..115799f
--- /dev/null
+++ b/Lib/Makefile.PL
@@ -0,0 +1,17 @@
+use ExtUtils::MakeMaker;
+
+# Note Slatec now handles f77 availability itself
+# Func contains the Interpolate code
+
+WriteMakefile(
+ 'NAME' => 'PDL::Lib',
+ VERSION_FROM => '../Basic/Core/Version.pm',
+ DIR => [ qw/Opt ImageRGB Fit FFT Filter Image2D ImageND
+ CallExt Slatec GSL GIS Transform Minuit Compression
+ / ],
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+# Interpolate
+);
+
+sub MY::postamble { '' }
+
diff --git a/Lib/Minuit/FCN.c b/Lib/Minuit/FCN.c
new file mode 100644
index 0000000..7a00aa9
--- /dev/null
+++ b/Lib/Minuit/FCN.c
@@ -0,0 +1,140 @@
+#ifdef NO_TRAILING_USCORE
+
+#define MNINIT mninit
+#define MNSETI mnseti
+#define MNPARM mnparm
+#define MNPARS mnpars
+#define MNEXCM mnexcm
+#define MNCOMD mncomd
+#define MNPOUT mnpout
+#define MNSTAT mnstat
+#define MNEMAT mnemat
+#define MNERRS mnerrs
+#define MNCONT mncont
+
+#define ABRE abre
+#define CIERRA cierra
+
+#else
+
+#define MNINIT mninit_
+#define MNSETI mnseti_
+#define MNPARM mnparm_
+#define MNPARS mnpars_
+#define MNEXCM mnexcm_
+#define MNCOMD mncomd_
+#define MNPOUT mnpout_
+#define MNSTAT mnstat_
+#define MNEMAT mnemat_
+#define MNERRS mnerrs_
+#define MNCONT mncont_
+
+#define ABRE abre_
+#define CIERRA cierra_
+
+#endif
+
+static SV* mnfunname;
+static int ene;
+
+void FCN(int* npar,double* grad,double* fval,double* xval,int* iflag,double* futil);
+
+void FCN(int* npar,double* grad,double* fval,double* xval,int* iflag,double* futil){
+
+ SV* funname;
+
+ int count,i;
+ double* x;
+
+ I32 ax ;
+
+ pdl* pgrad;
+ SV* pgradsv;
+
+ pdl* pxval;
+ SV* pxvalsv;
+
+ int ndims;
+ PDL_Indx *pdims;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ /* get name of function on the Perl side */
+ funname = mnfunname;
+
+ ndims = 1;
+ pdims = (PDL_Indx *) PDL->smalloc( (STRLEN) ((ndims) * sizeof(*pdims)) );
+
+ pdims[0] = (PDL_Indx) ene;
+
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv("PDL", 0)));
+ PUTBACK;
+ perl_call_method("initialize", G_SCALAR);
+ SPAGAIN;
+ pxvalsv = POPs;
+ PUTBACK;
+ pxval = PDL->SvPDLV(pxvalsv);
+
+ PDL->converttype( &pxval, PDL_D, PDL_PERM );
+ PDL->children_changesoon(pxval,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED);
+ PDL->setdims (pxval,pdims,ndims);
+ pxval->state &= ~PDL_NOMYDIMS;
+ pxval->state |= PDL_ALLOCATED | PDL_DONTTOUCHDATA;
+ PDL->changed(pxval,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED,0);
+
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv("PDL", 0)));
+ PUTBACK;
+ perl_call_method("initialize", G_SCALAR);
+ SPAGAIN;
+ pgradsv = POPs;
+ PUTBACK;
+ pgrad = PDL->SvPDLV(pgradsv);
+
+ PDL->converttype( &pgrad, PDL_D, PDL_PERM );
+ PDL->children_changesoon(pgrad,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED);
+ PDL->setdims (pgrad,pdims,ndims);
+ pgrad->state &= ~PDL_NOMYDIMS;
+ pgrad->state |= PDL_ALLOCATED | PDL_DONTTOUCHDATA;
+ PDL->changed(pgrad,PDL_PARENTDIMSCHANGED|PDL_PARENTDATACHANGED,0);
+
+ pxval->data = (void *) xval;
+ pgrad->data = (void *) grad;
+
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSViv(*npar)));
+ XPUSHs(pgradsv);
+ XPUSHs(sv_2mortal(newSVnv(*fval)));
+ XPUSHs(pxvalsv);
+ XPUSHs(sv_2mortal(newSViv(*iflag)));
+
+ PUTBACK;
+
+ count=call_sv(funname,G_ARRAY);
+
+ SPAGAIN;
+ SP -= count ;
+ ax = (SP - PL_stack_base) + 1 ;
+
+ if (count!=2)
+ croak("error calling perl function\n");
+
+ pgradsv = ST(1);
+ pgrad = PDL->SvPDLV(pgradsv);
+
+ x = (double *) pgrad->data;
+
+ for(i=0;i<ene;i++)
+ grad[i] = x[i];
+
+ *fval = SvNV(ST(0));
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+}
diff --git a/Lib/Minuit/Makefile.PL b/Lib/Minuit/Makefile.PL
new file mode 100644
index 0000000..35dcc44
--- /dev/null
+++ b/Lib/Minuit/Makefile.PL
@@ -0,0 +1,179 @@
+
+# Minuit module
+
+use ExtUtils::MakeMaker;
+use Config;
+PDL::Core::Dev->import();
+
+# This mess sorts out the Fortran availability
+# Modified from Makefile.PL from Slatec
+# Depends on ExtUtils::F77
+
+BEGIN {
+ $donot = 0;
+ $msg = "";
+ $forcebuild = 0;
+
+ if (defined $PDL::Config{WITH_MINUIT} && $PDL::Config{WITH_MINUIT}==0) {
+ $msg = "\n Will skip build of PDL::Minuit on this system \n";
+ goto skip;
+ }
+
+ if (defined $PDL::Config{WITH_MINUIT} && $PDL::Config{WITH_MINUIT}==1) {
+ print "\n Will forcibly try and build PDL::Minuit on this system \n\n";
+ $forcebuild = 1;
+ }
+
+ if (exists $PDL::Config{F77CONF} && -f $PDL::Config{F77CONF}) {
+ print "loading F77 configuration from $PDL::Config{F77CONF}...\n";
+ eval "require '$PDL::Config{F77CONF}'";
+ if ($@ ne "") {
+ $msg = "\n".$@.
+ "\n\tF77CONF file not loaded. Ought not build PDL::Minuit\n" ;
+ goto skip unless $forcebuild;
+ }
+ $f77 = 'F77Conf';
+ } else {
+ eval "use ExtUtils::F77"; # Might want "use ExtUtils::F77 qw(generic f2c)"
+ if ($@ ne "") {
+ $msg = "\n".$@.
+ "\n\tExtUtils::F77 module not found. Ought not build PDL::Minuit\n" ;
+ goto skip unless $forcebuild;
+ } else {
+ $f77 = 'ExtUtils::F77';
+ print "(ExtUtils Version $ExtUtils::F77::VERSION)\n";
+ if ($ExtUtils::F77::VERSION < 1.03 ) {
+ $msg = "\n\tneed a version of ExtUtils::F77 >= 1.03. Ought not build PDL::Minuit\n" ;
+ goto skip unless $forcebuild;
+ }
+ } # end if ($@ ne "")
+ } # if (exists $PDL::Config{F77CONF}...
+
+ $compiler_available = $f77->testcompiler;
+
+ if (!$compiler_available) {
+ $msg = "\n No f77 compiler found. Ought to skip PDL::Minuit on this system \n";
+ $PDL::Config{WITH_MINUIT} = 0;
+ } else {
+ $PDL::Config{WITH_MINUIT} = 1;
+ }
+
+ skip:
+
+ if ($msg ne "" && $forcebuild==0) {
+ warn $msg . "\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ $PDL::Config{WITH_MINUIT} = 0;
+ $donot = 1;
+ } else {
+ print "\n Building PDL::Minuit. Turn off WITH_MINUIT if there are any problems\n\n";
+ $PDL::Config{WITH_MINUIT} = 1;
+ }
+}
+
+return if $donot;
+
+
+ at pack = (["minuit.pd",Minuit,PDL::Minuit]);
+
+if (defined($PDL::Config{MINUIT_LIB})){
+ # If libraries are specified, just need to build futils
+ print "Using compiled CERN library: ".$PDL::Config{MINUIT_LIB}."...\n";
+ @minuitfiles = ("futils");
+}
+else{
+ # Otherwise, we need to build the Minuit library as well
+ print "Stand alone Minuit library will be built...\n";
+ @minuitfiles = ("futils", "minuit", "intracfalse");
+ }
+
+
+%hash = pdlpp_stdargs_int(@::pack);
+
+$hash{OBJECT} .= join '', map {" minuitlib/${_}$Config{obj_ext} "} @minuitfiles;
+
+if($Config{cc} eq 'cl') {
+# Link to MinGW's libg2c.a and libgcc.a, if appropriate
+# First check that ExtUtils::F77 is available
+ eval{require ExtUtils::F77};
+ unless($@) {
+ my @f = ();
+
+ my $drive = (split /:/, `gcc -v 2>&1`)[0];
+ $drive = substr($drive, -1, 1);
+
+ for(split ' ', ExtUtils::F77->runtime) {
+ if($_ =~ /^\-L/) {
+ $_ =~ s#^\-L##;
+ unless($_ =~ /:/) {$_ = $drive . ':' . $_}
+ if(-e $_ . '/libg2c.a') {push @f, $_ . '/libg2c.a'}
+ if(-e $_ . '/libgcc.a') {push @f, $_ . '/libgcc.a'}
+ }
+ }
+ $hash{LDFROM} = $hash{OBJECT};
+ for(@f) {$hash{LDFROM} .= ' ' . $_}
+ }
+}
+
+$hash{LIBS}[0] .= $f77->runtime ;
+$hash{clean}{FILES} .= join '', map {" minuitlib/$_.o "} @minuitfiles;
+
+# Handle multiple compilers
+
+$f2cbased = ($f77->runtime =~ /-lf2c/);
+$g2cbased = ($f77->runtime =~ /-lg2c/) unless $f2cbased;
+
+$hash{DEFINE} .= $f77->trail_ ? "" : "-DNO_TRAILING_USCORE";
+
+### unless($^O =~ /mswin32/i) {
+### if (defined($PDL::Config{MINUIT_LIB})){
+### $hash{MYEXTLIB} .= (" ".$PDL::Config{MINUIT_LIB}." ");
+### }
+### else{
+### $hash{MYEXTLIB} .= " ./minuitlib/libminuit$Config::Config{lib_ext} ";
+### $hash{clean}{FILES} .= " ./minuitlib/libminuit$Config::Config{lib_ext} ";
+### }
+### }
+
+
+WriteMakefile(
+ %hash,
+ VERSION => "0.1", # This is overridden by VERSION_FROM in %hash
+);
+
+sub MY::postamble {
+ $mycompiler = $f77->compiler();
+ $mycflags = $f77->cflags();
+ my $orig = pdlpp_postamble_int(@::pack);
+ $hack_64bit = ($Config{archname}=~m/x86_64/ ?" -fPIC " : "");
+ $orig =~ s/:\s*minuit\.pd/: minuit.pd/;
+ $orig .= join "\n",map {
+ ("
+
+minuitlib/$_\$(OBJ_EXT): minuitlib/$_.f
+ $mycompiler -c $hack_64bit -o minuitlib/$_\$(OBJ_EXT) $mycflags minuitlib/$_.f
+" )} @minuitfiles;
+
+ if (!defined($PDL::Config{MINUIT_LIB})){
+ my $libbuild;
+ if($Config::Config{cc} eq 'cl') {
+ $libbuild = "
+
+minuitlib/libminuit\$(LIB_EXT): minuitlib/minuit\$(OBJ_EXT) minuitlib/intracfalse\$(OBJ_EXT)
+ \$(AR) -out:minuitlib/libminuit\$(LIB_EXT) minuitlib/minuit\$(OBJ_EXT) minuitlib/intracfalse\$(OBJ_EXT)
+ \$(RANLIB) minuitlib/libminuit\$(LIB_EXT)
+";
+ }
+ else {
+ $libbuild = "
+
+minuitlib/libminuit\$(LIB_EXT): minuitlib/minuit\$(OBJ_EXT) minuitlib/intracfalse\$(OBJ_EXT)
+ \$(AR) rv minuitlib/libminuit\$(LIB_EXT) minuitlib/minuit\$(OBJ_EXT) minuitlib/intracfalse\$(OBJ_EXT)
+ \$(RANLIB) minuitlib/libminuit\$(LIB_EXT)
+";
+ }
+ $orig .= $libbuild;
+ }
+ return $orig;
+}
diff --git a/Lib/Minuit/minuit.pd b/Lib/Minuit/minuit.pd
new file mode 100644
index 0000000..92df63a
--- /dev/null
+++ b/Lib/Minuit/minuit.pd
@@ -0,0 +1,655 @@
+pp_bless('PDL::Minuit');
+
+pp_add_exported('','mn_init mn_def_pars mn_excm mn_pout mn_stat mn_err mn_contour mn_emat');
+
+pp_addhdr('
+#include<string.h>
+#include "FCN.c"
+
+extern void MNINIT(int*,int*,int*);
+extern void MNSETI(char*,int);
+extern void MNPARM(int*,char*,double*,double*,double*,double*,int*,int);
+extern void MNEXCM(void* f,char*,double*,int*,int*,double* futil,int);
+extern void MNPOUT(int*,char*,double*,double*,double*,double*,int*,int);
+extern void MNSTAT(double*,double*,double*,int*,int*,int*);
+extern void MNEMAT(double*,int*); /* Matrix here! */
+extern void MNERRS(int*,double*,double*,double*,double*);
+extern void MNCONT(void* f,int*,int*,int*,double*,double*,int*,double* futil);
+
+extern void ABRE(int*,char*,char*,int,int);
+extern void CIERRA(int*);
+');
+ # add C code to the section preceding
+ # the first MODULE keyword
+
+pp_addpm({At=>Top},<<'EOD'); # add perl code to the perl module that PP will create
+=head1 NAME
+
+PDL::Minuit -- a PDL interface to the Minuit library
+
+=head1 DESCRIPTION
+
+This package implements an interface to the Minuit minimization routines (part
+of the CERN Library)
+
+=head1 SYNOPSIS
+
+A basic fit with Minuit will call three functions in this package. First, a basic
+initialization is done with mn_init(). Then, the parameters are defined via
+the function mn_def_pars(), which allows to set upper and lower bounds. Then
+the function mn_excm() can be used to issue many Minuit commands, including simplex
+and migrad minimization algorithms (see Minuit manual for more details).
+
+See the test file minuit.t in the test (t/) directory for a basic example.
+
+=head1 FUNCTIONS
+
+=head2 mn_init()
+
+=for ref
+
+The function mn_init() does the basic initialization of the fit. The first argument
+has to be a reference to the function to be minimized. The function
+to be minimized has to receive five arguments
+($npar,$grad,$fval,$xval,$iflag). The first is the number
+of parameters currently variable. The second is the gradient
+of the function (which is not necessarily used, see
+the Minuit documentation). The third is the current value of the
+function. The fourth is a piddle with the values of the parameters.
+The fifth is an integer flag, which indicates what
+the function is supposed to calculate. The function has to
+return the values ($fval,$grad), the function value and
+the function gradient.
+
+There are three optional arguments to mn_init(). By default, the output of Minuit
+will come through STDOUT unless a filename $logfile is given
+in the Log option. Note that this will mercilessly erase $logfile
+if it already exists. Aditionally, a title can be given to the fit
+by the Title option, the default is 'Minuit Fit'. If the output is
+written to a logfile, this is assigned Fortran unit number 88. If for
+whatever reason you want to have control over the unit number
+that Fortran associates to the logfile, you can pass the number
+through the Unit option.
+
+=for usage
+
+Usage:
+
+ mn_init($function_ref,{Log=>$logfile,Title=>$title,Unit=>$unit})
+
+=for example
+
+Example:
+
+ mn_init(\&my_function);
+
+ #same as above but outputting to a file 'log.out'.
+ #title for fit is 'My fit'
+ mn_init(\&my_function,
+ {Log => 'log.out', Title => 'My fit'});
+
+
+ sub my_function{
+ # the five variables input to the function to be minimized
+ # xval is a piddle containing the current values of the parameters
+ my ($npar,$grad,$fval,$xval,$iflag) = @_;
+
+
+ # Here is code computing the value of the function
+ # and potentially also its gradient
+ # ......
+
+ # return the two variables. If no gradient is being computed
+ # just return the $grad that came as input
+ return ($fval, $grad);
+ }
+
+=head2 mn_def_pars()
+
+=for ref
+
+The function mn_def_pars() defines the initial values of the parameters of the function to
+be minimized and the value of the initial steps around these values that the
+minimizer will use for the first variations of the parameters in the search for the minimum.
+There are several optional arguments. One allows to assign names to these parameters which
+otherwise get names (Par_0, Par_1,....,Par_n) by default. Another two arguments can give
+lower and upper bounds for the parameters via two piddles. If the lower and upper bound for a
+given parameter are both equal to 0 then the parameter is unbound. By default these lower and
+upper bound piddles are set to zeroes(n), where n is the number of parameters, i.e. the
+parameters are unbound by default.
+
+The function needs two input variables: a piddle giving the initial values of the
+parameters and another piddle giving the initial steps. An optional reference to a
+perl array with the variable names can be passed, as well as piddles
+with upper and lower bounds for the parameters (see example below).
+
+It returns an integer variable which is 0 upon success.
+
+=for usage
+
+Usage:
+
+ $iflag = mn_def_pars($pars, $steps,{Names => \@names,
+ Lower_bounds => $lbounds,
+ Upper_bounds => $ubounds})
+
+
+=for example
+
+Example:
+
+ #initial parameter values
+ my $pars = pdl(2.5,3.0);
+
+ #steps
+ my $steps = pdl(0.3,0.5);
+
+ #parameter names
+ my @names = ('intercept','slope');
+
+ #use mn_def_pars with default parameter names (Par_0,Par_1,...)
+ my $iflag = mn_def_pars($pars,$steps);
+
+ #use of mn_def_pars explictly specify parameter names
+ $iflag = mn_def_pars($pars,$steps,{Names => \@names});
+
+ # specify lower and upper bounds for the parameters.
+ # The example below leaves parameter 1 (intercept) unconstrained
+ # and constrains parameter 2 (slope) to be betwen 0 and 100
+ my $lbounds = pdl(0, 0);
+ my $ubounds = pdl(0, 100);
+
+ $iflag = mn_def_pars($pars,$steps,{Names => \@names,
+ Lower_bounds => $lbounds,
+ Upper_bounds => $ubounds}});
+
+ #same as above because $lbounds is by default zeroes(n)
+ $iflag = mn_def_pars($pars,$steps,{Names => \@names,
+ Upper_bounds => $ubounds}});
+
+
+
+=head2 mn_excm()
+
+The function mn_excm() executes a Minuit command passed as
+a string. The first argument is the command string and an optional
+second argument is a piddle with arguments to the command.
+The available commands are listed in Chapter 4 of the Minuit
+manual (see url below).
+
+It returns an integer variable which is 0 upon success.
+
+=for usage
+
+Usage:
+
+ $iflag = mn_excm($command_string, {$arglis})
+
+=for example
+
+Example:
+
+ #start a simplex minimization
+ my $iflag = mn_excm('simplex');
+
+ #same as above but specify the maximum allowed numbers of
+ #function calls in the minimization
+ my $arglist = pdl(1000);
+ $iflag = mn_excm('simplex',$arglist);
+
+ #start a migrad minimization
+ $iflag = mn_excm('migrad')
+
+ #set Minuit strategy in order to get the most reliable results
+ $arglist = pdl(2)
+ $iflag = mn_excm('set strategy',$arglist);
+
+ # each command can be specified by a minimal string that uniquely
+ # identifies it (see Chapter 4 of Minuit manual). The comannd above
+ # is equivalent to:
+ $iflag = mn_excm('set stra',$arglis);
+
+
+=head2 mn_pout()
+
+The function mn_pout() gets the current value of a parameter. It
+takes as input the parameter number and returns an array with the
+parameter value, the current estimate of its uncertainty (0 if
+parameter is constant), lower bound on the parameter, if any
+(otherwise 0), upper bound on the parameter, if any (otherwise 0),
+integer flag (which is equal to the parameter number if variable,
+zero if the parameter is constant and negative if parameter is
+not defined) and the parameter name.
+
+=for usage
+
+Usage:
+
+ ($val,$err,$bnd1,$bnd2,$ivarbl,$par_name) = mn_pout($par_number);
+
+=head2 mn_stat()
+
+The function mn_stat() gets the current status of the minimization.
+It returns an array with the best function value found so far,
+the estimated vertical distance remaining to minimum, the value
+of UP defining parameter uncertainties (default is 1), the number
+of currently variable parameters, the highest parameter defined
+and an integer flag indicating how good the covariance matrix is
+(0=not calculated at all; 1=diagonal approximation, not accurate;
+2=full matrix, but forced positive definite; 3=full accurate matrix)
+
+=for usage
+
+Usage:
+
+ ($fmin,$fedm,$errdef,$npari,$nparx,$istat) = mn_stat();
+
+=head2 mn_emat()
+
+The function mn_emat returns the covariance matrix as a piddle.
+
+=for usage
+
+Usage:
+
+ $emat = mn_emat();
+
+=head2 mn_err()
+
+The function mn_err() returns the current existing values for
+the error in the fitted parameters. It returns an array
+with the positive error, the negative error, the "parabolic"
+parameter error from the error matrix and the global correlation
+coefficient, which is a number between 0 and 1 which gives
+the correlation between the requested parameter and that linear
+combination of all other parameters which is most strongly
+correlated with it. Unless the command 'MINOS' has been issued via
+the function mn_excm(), the first three values will be equal.
+
+=for usage
+
+Usage:
+
+ ($eplus,$eminus,$eparab,$globcc) = mn_err($par_number);
+
+=head2 mn_contour()
+
+The function mn_contour() finds contours of the function being minimized
+with respect to two chosen parameters. The contour level is given by
+F_min + UP, where F_min is the minimum of the function and UP is the ERRordef
+specfied by the user, or 1.0 by default (see Minuit manual). The contour
+calculated by this function is dynamic, in the sense that it represents the
+minimum of the funcion being minimized with respect to all the other NPAR-2 parameters
+(if any).
+
+The function takes as input the parameter numbers with respect to which the contour
+is to be determined (two) and the number of points $npt required on the contour (>4).
+It returns an array with piddles $xpt,$ypt containing the coordinates of the contour
+and a variable $nfound indicating the number of points actually found in the contour.
+If all goes well $nfound will be equal to $npt, but it can be negative if the input
+arguments are not valid, zero if less than four points have been found or <$npt if the
+program could not find $npt points.
+
+=for usage
+
+Usage:
+
+ ($xpt,$ypt,$nfound) = mn_contour($par_number_1,$par_number_2,$npt)
+
+=head1 SEE ALSO
+
+L<PDL>
+
+The Minuit documentation is online at
+
+ http://wwwasdoc.web.cern.ch/wwwasdoc/minuit/minmain.html
+
+
+=head1 AUTHOR
+
+This file copyright (C) 2007 Andres Jordan <ajordan at eso.org>.
+All rights reserved. There is no warranty. You are allowed to redistribute this
+software/documentation under certain conditions. For details, see the file
+COPYING in the PDL distribution. If this file is separated from the
+PDL distribution, the copyright notice should be included in the file.
+
+=cut
+
+EOD
+
+pp_addpm('
+
+# Package variable
+my $mn_options;
+
+');
+
+pp_addpm('
+sub mn_init{
+ my $fun_ref = shift;
+
+ $mn_options = { Log => undef,
+ Title => \'Minuit Fit\',
+ N => undef,
+ Unit => undef,
+ Function => $fun_ref,
+ };
+
+ if ( @_ ){
+ my $args = $_[0];
+ for my $key (qw/ Log Title Unit/){
+ $mn_options->{$key} = $args->{$key} if exists $args->{$key};
+ }
+ }
+
+ # Check if there was a valid F77 available and barf
+ # if there was not and the user is trying to pass Log
+
+ if (defined($mn_options->{Log})) {
+ $mn_options->{Unit} = 88 unless defined $mn_options->{Unit};
+ }
+ else { $mn_options->{Unit} = 6; }
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ if (-e $logfile) { unlink $logfile; }
+ PDL::Minuit::mn_abre($mn_options->{Unit},$logfile,\'new\');
+ print STDERR "# Opening file $logfile....\n";
+ }
+
+ PDL::Minuit::mninit(5,$mn_options->{Unit},$mn_options->{Unit});
+ PDL::Minuit::mnseti($mn_options->{Title});
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_cierra($mn_options->{Unit});
+ }
+
+}
+');
+
+pp_def('mninit',
+ Pars => 'int a();int b(); int c();',
+ Code => 'MNINIT($P(a),$P(b),$P(c));
+ ');
+pp_addxs('','
+void
+mnseti(str)
+ char* str;
+ CODE:
+ int largo;
+ largo = strlen(str);
+ MNSETI(str,largo);
+');
+
+# pp_def('mnseti',
+# Pars => '',
+# OtherPars => "char* str",
+# Code => 'int largo; largo = strlen($COMP(str));
+# MNSETI($COMP(str),largo);
+# ');
+
+pp_def('mn_abre',
+ Pars => 'int l();',
+ OtherPars => 'char* nombre; char* mode;',
+ Code => '
+ int l1,l2; l1 = strlen($COMP(nombre)); l2 = strlen($COMP(mode));
+ ABRE($P(l),$COMP(nombre),$COMP(mode),l1,l2);
+');
+pp_def('mn_cierra',
+ Pars => 'int l();',
+ Code => 'CIERRA($P(l));'
+);
+
+pp_addpm('
+sub mn_def_pars{
+ my $pars = shift;
+ my $steps = shift;
+
+ my $n = nelem($pars);
+ $mn_options->{N} = $n;
+
+ #print "Unit :".$mn_options->{Unit}."\n";
+
+ my @names = ();
+ for (my $i=0; $i < $n; $i++) { $names[$i] = "Par_$i"; }
+ my $lo_bounds = zeroes($n);
+ my $up_bounds = zeroes($n);
+
+ if ( @_ ) {
+ my $opts = $_[0];
+ $lo_bounds = $opts->{Lower_bounds} if defined $opts->{Lower_bounds};
+ $up_bounds = $opts->{Upper_bounds} if defined $opts->{Upper_bounds};
+ if (defined($opts->{Names})){
+ $names_t = $opts->{Names};
+ barf " Names has to be an array reference" unless ref($names_t) eq \'ARRAY\';
+ @names = @$names_t;
+ barf " Names has to have as many elements as there are parameters " unless ( @names == $n);
+ }
+ }
+
+ my $iflag = 0;
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_abre($mn_options->{Unit},$logfile,\'old\');
+ }
+
+ foreach my $i ( 0..(nelem($pars)-1) ){
+ my $ii = $i + 1;
+ $iflag = PDL::Minuit::mnparm($ii,$pars->slice("($i)"),
+ $steps->slice("($i)"),
+ $lo_bounds->slice("($i)"),
+ $up_bounds->slice("($i)"),
+ $names[$i]);
+ barf "Problem initializing parameter $i in Minuit " unless ($iflag == 0);
+ }
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_cierra($mn_options->{Unit});
+ }
+}
+');
+
+pp_def('mnparm',
+ Pars => 'int a(); double b(); double c(); double d(); double e(); int [o] ia()',
+ OtherPars => "char* str",
+ Code => ' int largo; largo=strlen($COMP(str));
+ MNPARM($P(a),$COMP(str),$P(b),$P(c),$P(d),$P(e),$P(ia),largo);
+ ');
+
+
+pp_addpm('
+sub mn_excm{
+ my $command = shift;
+
+ my $fun_ref = $mn_options->{Function};
+
+ my ($arglis,$narg);
+ if ( @_ ) { $arglis = shift; $narg = nelem($arglis);}
+ else { $arglis = pdl(0); $narg = 0; }
+
+ if ( @_ ) { barf "Usage : mn_excm($command, [$arglis]) \n"; }
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_abre($mn_options->{Unit},$logfile,\'old\');
+ }
+
+ my $iflag = pdl(0);
+
+
+ $iflag = PDL::Minuit::mnexcm($arglis, $narg, $command, $fun_ref,$mn_options->{N});
+ warn "Problem executing command \'$command\' " unless ($iflag == 0);
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_cierra($mn_options->{Unit});
+ }
+
+ return $iflag;
+}
+');
+
+pp_def('mnexcm',
+ Pars =>'double a(n); int ia(); int [o] ib();',
+ OtherPars => 'char* str; SV* funcion; int numelem;',
+ Code => 'double zero;
+ int largo; largo=strlen($COMP(str));
+ ene = $COMP(numelem);
+ zero = 0.0;
+ mnfunname = $COMP(funcion);
+ MNEXCM(FCN,$COMP(str),$P(a),$P(ia),$P(ib),&zero,largo);
+ ');
+
+pp_addpm('
+ sub mn_pout{
+ barf "Usage: mn_pout(par_number)" unless ($#_ == 0);
+ my $par_num = shift;
+ my $n = $mn_options->{N};
+ if (($par_num < 1) || ($par_num > $n)) { barf "Parameter numbers range from 1 to $n "; }
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_abre($mn_options->{Unit},$logfile,\'old\');
+ }
+
+ my $val = pdl(0);
+ my $err = pdl(0);
+ my $bnd1 = pdl(0);
+ my $bnd2 = pdl(0);
+ my $ivarbl = pdl(0);
+ my $par_name = " ";
+ PDL::Minuit::mnpout($par_num,$val,$err,$bnd1,$bnd2,$ivarbl,\$par_name);
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_cierra($mn_options->{Unit});
+ }
+
+ return ($val,$err,$bnd1,$bnd2,$ivarbl,$par_name);
+ }
+');
+
+pp_def('mnpout',
+ Pars => 'int ia(); double [o] a(); double [o] b(); double [o] c(); double [o] d();int [o] ib();',
+ OtherPars => 'SV* str;',
+ Code => 'STRLEN largo; SV* tempo; char* uuu;
+ tempo = SvRV($COMP(str));
+ uuu = SvPV(tempo,largo);
+ MNPOUT($P(ia),uuu,$P(a),$P(b),$P(c),$P(d),$P(ib),largo);
+ sv_setpv(tempo,uuu);
+ ');
+
+pp_addpm('
+ sub mn_stat{
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_abre($mn_options->{Unit},$logfile,\'old\');
+ }
+
+
+ my ($fmin,$fedm,$errdef,$npari,$nparx,$istat) = PDL::Minuit::mnstat();
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_cierra($mn_options->{Unit});
+ }
+
+ return ($fmin,$fedm,$errdef,$npari,$nparx,$istat);
+ }
+');
+pp_def('mnstat',
+ Pars => 'double [o] a(); double [o] b(); double [o] c(); int [o] ia(); int [o] ib(); int [o] ic();',
+ Code => 'MNSTAT($P(a),$P(b),$P(c),$P(ia),$P(ib),$P(ic));
+ ');
+
+#OK
+pp_addpm('
+ sub mn_emat{
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_abre($mn_options->{Unit},$logfile,\'old\');
+ }
+
+ my ($fmin,$fedm,$errdef,$npari,$nparx,$istat) = PDL::Minuit::mnstat();
+ my $n = $npari->sum;
+ my $mat = zeroes($n,$n);
+
+ PDL::Minuit::mnemat($mat);
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_cierra($mn_options->{Unit});
+ }
+
+ return $mat;
+
+ }
+');
+pp_def('mnemat',
+ Pars => 'double [o] mat(n,n);',
+ Code => 'int numrows; numrows = $SIZE(n);
+ MNEMAT($P(mat),&numrows);
+ ');
+
+
+pp_addpm('
+ sub mn_err{
+
+ barf "Usage: mn_err(par_number)" unless ($#_ == 0);
+ my $par_num = shift;
+
+ my $n = $mn_options->{N};
+ if (($par_num < 1) || ($par_num > $n)) { barf "Parameter numbers range from 1 to $n "; }
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_abre($mn_options->{Unit},$logfile,\'old\');
+ }
+
+ my ($eplus,$eminus,$eparab,$globcc) = PDL::Minuit::mnerrs($par_num);
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_cierra($mn_options->{Unit});
+ }
+
+ return ($eplus,$eminus,$eparab,$globcc);
+ }
+');
+pp_def('mnerrs',
+ Pars => 'int ia(); double [o] a(); double [o] b(); double [o] c(); double [o] d();',
+ Code => 'MNERRS($P(ia),$P(a),$P(b),$P(c),$P(d));
+ ');
+
+
+pp_addpm('
+ sub mn_contour{
+ barf "Usage: mn_contour(par_number_1,par_number_2,npt)" unless ($#_ == 2);
+ my $par_num_1 = shift;
+ my $par_num_2 = shift;
+ my $npt = shift;
+
+ my $fun_ref = $mn_options->{Function};
+
+ my $n = $mn_options->{N};
+ if (($par_num_1 < 1) || ($par_num_1 > $n)) { barf "Parameter numbers range from 1 to $n "; }
+ if (($par_num_2 < 1) || ($par_num_2 > $n)) { barf "Parameter numbers range from 1 to $n "; }
+ if ($npt < 5) { barf "Have to specify at least 5 points in routine contour "; }
+
+ my $xpt = zeroes($npt);
+ my $ypt = zeroes($npt);
+ my $nfound = pdl->new;
+
+ PDL::Minuit::mncont($par_num_1,$par_num_2,$npt,$xpt,$ypt,$nfound,$fun_ref,$n);
+
+ if (defined (my $logfile = $mn_options->{Log})){
+ PDL::Minuit::mn_cierra($mn_options->{Unit});
+ }
+
+ return ($xpt,$ypt,$nfound);
+ }
+');
+
+pp_def('mncont',
+ Pars => 'int ia(); int ib(); int ic(); double [o] a(n); double [o] b(n); int [o] id();',
+ OtherPars => 'SV* funcion; int numelem;',
+ Code => ' double zero;
+ zero = 0.0;
+ mnfunname = $COMP(funcion);
+ ene = $COMP(numelem);
+ MNCONT(FCN,$P(ia),$P(ib),$P(ic),$P(a),$P(b),$P(id),&zero);
+ ');
+
+pp_done(); # you will need this to finish pp processing
+
+
diff --git a/Lib/Minuit/minuitlib/futils.f b/Lib/Minuit/minuitlib/futils.f
new file mode 100644
index 0000000..5cb7ad5
--- /dev/null
+++ b/Lib/Minuit/minuitlib/futils.f
@@ -0,0 +1,17 @@
+ subroutine abre(n,nombre,mode)
+
+ integer n
+ character*(*) nombre
+ character*(*) mode
+
+ open(unit=n,file=nombre,status=mode)
+
+ end
+
+ subroutine cierra(n)
+
+ integer n
+
+ close(n)
+
+ end
diff --git a/Lib/Minuit/minuitlib/intracfalse.f b/Lib/Minuit/minuitlib/intracfalse.f
new file mode 100644
index 0000000..3604539
--- /dev/null
+++ b/Lib/Minuit/minuitlib/intracfalse.f
@@ -0,0 +1,7 @@
+ logical function intrac()
+
+c logical intrac
+ intrac = .false.
+
+ return
+ end
diff --git a/Lib/Minuit/minuitlib/minuit.f b/Lib/Minuit/minuitlib/minuit.f
new file mode 100644
index 0000000..15bcaed
--- /dev/null
+++ b/Lib/Minuit/minuitlib/minuit.f
@@ -0,0 +1,7842 @@
+cdeck id>, minuit.
+ subroutine minuit(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+c
+c cpnam parameter name (10 characters)
+c u external (visible to user in fcn) value of parameter
+c alim, blim lower and upper parameter limits. if both zero, no limits.
+c erp,ern positive and negative minos errors, if calculated.
+c werr external parameter error (standard deviation, defined by up)
+c globcc global correlation coefficient
+c nvarl =-1 if parameter undefined, =0 if constant,
+c = 1 if variable without limits, =4 if variable with limits
+c (note that if parameter has been fixed, nvarl=1 or =4, and niofex=0)
+c niofex internal parameter number, or zero if not currently variable
+c nexofi external parameter number for currently variable parameters
+c x, xt internal parameter values (x are sometimes saved in xt)
+c dirin (internal) step sizes for current step
+c variables with names ending in ..s are saved values for fixed params
+c vhmat (internal) error matrix stored as half matrix, since
+c it is symmetric
+c vthmat vhmat is sometimes saved in vthmat, especially in mnmnot
+c
+c isw definitions:
+c isw(1) =0 normally, =1 means call limit exceeded
+c isw(2) =0 means no error matrix
+c =1 means only approximate error matrix
+c =2 means full error matrix, but forced pos-def.
+c =3 means good normal full error matrix exists
+c isw(3) =0 if minuit is calculating the first derivatives
+c =1 if first derivatives calculated inside fcn
+c isw(4) =-1 if most recent minimization did not converge.
+c = 0 if problem redefined since most recent minimization.
+c =+1 if most recent minimization did converge.
+c isw(5) is the print level. see sho printlevel
+c isw(6) = 0 for batch mode, =1 for interactive mode
+c
+c lwarn is true if warning messges are to be put out (default=true)
+c set warn turns it on, set nowarn turns it off
+c lrepor is true if exceptional conditions are put out (default=false)
+c set debug turns it on, set nodebug turns it off
+c limset is true if a parameter is up against limits (for minos)
+c lnolim is true if there are no limits on any parameters (not yet used)
+c lnewmn is true if the previous process has unexpectedly improved fcn
+c lphead is true if a heading should be put out for the next parameter
+c definition, false if a parameter has just been defined
+c
+ external fcn,futil
+ character*40 cwhyxt
+ data cwhyxt/'for unknown reasons '/
+ data jsysrd,jsyswr,jsyssa/5,6,7/
+c . . . . . . . . . . initialize minuit
+ write (jsyswr,'(1x,75(1h*))')
+ call mninit (jsysrd,jsyswr,jsyssa)
+c . . . . initialize new data block
+ 100 continue
+ write (isyswr,'(1x,75(1h*))')
+ nblock = nblock + 1
+ write (isyswr,'(26x,a,i4)') 'minuit data block no.',nblock
+ write (isyswr,'(1x,75(1h*))')
+c . . . . . . . . . . . set parameter lists to undefined
+ call mncler
+c . . . . . . . . read title
+ call mnread(fcn,1,iflgut,futil)
+ if (iflgut .eq. 2) go to 500
+ if (iflgut .eq. 3) go to 600
+c . . . . . . . . read parameters
+ call mnread(fcn,2,iflgut,futil)
+ if (iflgut .eq. 2) go to 500
+ if (iflgut .eq. 3) go to 600
+ if (iflgut .eq. 4) go to 700
+c . . . . . . verify fcn not time-dependent
+ write (isyswr,'(/a,a)') ' minuit: first call to user function,',
+ + ' with iflag=1'
+ nparx = npar
+ call mninex(x)
+ fzero = undefi
+ call fcn(nparx,gin,fzero,u,1,futil)
+ first = undefi
+ call fcn(nparx,gin,first,u,4,futil)
+ nfcn = 2
+ if (fzero.eq.undefi .and. first.eq.undefi) then
+ cwhyxt = 'by error in user function. '
+ write (isyswr,'(/a,a/)') ' user has not calculated function',
+ + ' value when iflag=1 or 4'
+ go to 800
+ endif
+ amin = first
+ if (first .eq. undefi) amin=fzero
+ call mnprin(1,amin)
+ nfcn = 2
+ if (first .eq. fzero) go to 300
+ fnew = 0.0
+ call fcn(nparx,gin,fnew,u,4,futil)
+ if (fnew .ne. amin) write (isyswr,280) amin, fnew
+ 280 format (/' minuit warning: probable error in user function.'/
+ + ' for fixed values of parameters, fcn is time-dependent'/
+ + ' f =',e22.14,' for first call'/
+ + ' f =',e22.14,' for second call.'/)
+ nfcn = 3
+ 300 fval3 = 2.0*amin+1.0
+c . . . . . . . . . . . read commands
+ call mnread(fcn,3,iflgut,futil)
+ if (iflgut .eq. 2) go to 500
+ if (iflgut .eq. 3) go to 600
+ if (iflgut .eq. 4) go to 700
+ cwhyxt = 'by minuit command: '//cword
+ if (index(cword,'stop').gt. 0) go to 800
+ if (index(cword,'exi') .gt. 0) go to 800
+ if (index(cword,'ret') .eq. 0) go to 100
+ cwhyxt = 'and returns to user program. '
+ write (isyswr,'(a,a)') ' ..........minuit terminated ',cwhyxt
+ return
+c . . . . . . stop conditions
+ 500 continue
+ cwhyxt = 'by end-of-data on primary input file. '
+ go to 800
+ 600 continue
+ cwhyxt = 'by unrecoverable read error on input. '
+ go to 800
+ 700 continue
+ cwhyxt = ': fatal error in parameter definitions. '
+ 800 write (isyswr,'(a,a)') ' ..........minuit terminated ',cwhyxt
+ stop
+c
+c ......................entry to set unit numbers - - - - - - - - - -
+ entry mintio(i1,i2,i3)
+ jsysrd = i1
+ jsyswr = i2
+ jsyssa = i3
+ return
+ end
+cdeck id>, mnamin.
+ subroutine mnamin(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called from many places. initializes the value of amin by
+cc calling the user function. prints out the function value and
+cc parameter values if print flag value is high enough.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ nparx = npar
+ if (isw(5) .ge. 1) write (isyswr,'(/a,a)') ' first call to ',
+ + 'user function at new start point, with iflag=4.'
+ call mnexin(x)
+ call fcn(nparx,gin,fnew,u,4,futil)
+ nfcn = nfcn + 1
+ amin = fnew
+ edm = bigedm
+ return
+ end
+cdeck id>, mnbins.
+ subroutine mnbins(a1,a2,naa,bl,bh,nb,bwid)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+c subroutine to determine reasonable histogram intervals
+c given absolute upper and lower bounds a1 and a2
+c and desired maximum number of bins naa
+c program makes reasonable binning from bl to bh of width bwid
+c f. james, august, 1974 , stolen for minuit, 1988
+ parameter (zero=0.0)
+ al = min(a1,a2)
+ ah = max(a1,a2)
+ if (al.eq.ah) ah = al + 1.
+c if naa .eq. -1 , program uses bwid input from calling routine
+ if (naa .eq. -1) go to 150
+ 10 na = naa - 1
+ if (na .lt. 1) na = 1
+c get nominal bin width in expon form
+ 20 awid = (ah-al)/float(na)
+ log = int(log10(awid))
+ if (awid .le. 1.0) log=log-1
+ sigfig = awid * (10.00 **(-log))
+c round mantissa up to 2, 2.5, 5, or 10
+ if(sigfig .gt. 2.0) go to 40
+ sigrnd = 2.0
+ go to 100
+ 40 if (sigfig .gt. 2.5) go to 50
+ sigrnd = 2.5
+ go to 100
+ 50 if(sigfig .gt. 5.0) go to 60
+ sigrnd =5.0
+ go to 100
+ 60 sigrnd = 1.0
+ log = log + 1
+ 100 continue
+ bwid = sigrnd*10.0**log
+ go to 200
+c get new bounds from new width bwid
+ 150 if (bwid .le. zero) go to 10
+ 200 continue
+ alb = al/bwid
+ lwid=alb
+ if (alb .lt. zero) lwid=lwid-1
+ bl = bwid*float(lwid)
+ alb = ah/bwid + 1.0
+ kwid = alb
+ if (alb .lt. zero) kwid=kwid-1
+ bh = bwid*float(kwid)
+ nb = kwid-lwid
+ if (naa .gt. 5) go to 240
+ if (naa .eq. -1) return
+c request for one bin is difficult case
+ if (naa .gt. 1 .or. nb .eq. 1) return
+ bwid = bwid*2.0
+ nb = 1
+ return
+ 240 if (2*nb .ne. naa) return
+ na = na + 1
+ go to 20
+ end
+cdeck id>, mncalf.
+ subroutine mncalf(fcn,pvec,ycalf,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called only from mnimpr. transforms the function fcn
+cc by dividing out the quadratic part in order to find further
+cc minima. calculates ycalf = (f-fmin)/(x-xmin)*v*(x-xmin)
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ dimension pvec(15)
+ nparx = npar
+ call mninex(pvec)
+ call fcn(nparx,gin,f,u,4,futil)
+ nfcn = nfcn + 1
+ do 200 i= 1, npar
+ grd(i) = 0.
+ do 200 j= 1, npar
+ m = max(i,j)
+ n = min(i,j)
+ ndex = m*(m-1)/2 + n
+ 200 grd(i) = grd(i) + vthmat(ndex) * (xt(j)-pvec(j))
+ denom = 0.
+ do 210 i= 1, npar
+ 210 denom = denom + grd(i) * (xt(i)-pvec(i))
+ if (denom .le. zero) then
+ dcovar = 1.
+ isw(2) = 0
+ denom = 1.0
+ endif
+ ycalf = (f-apsi) / denom
+ return
+ end
+cdeck id>, mncler.
+ subroutine mncler
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called from minuit and by option from mnexcm
+cc resets the parameter list to undefined
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ npfix = 0
+ nu = 0
+ npar = 0
+ nfcn = 0
+ nwrmes(1) = 0
+ nwrmes(2) = 0
+ do 10 i= 1, maxext
+ u(i) = 0.0
+ cpnam(i) = cundef
+ nvarl(i) = -1
+ 10 niofex(i) = 0
+ call mnrset(1)
+ cfrom = 'clear '
+ nfcnfr = nfcn
+ cstatu ='undefined '
+ lnolim = .true.
+ lphead = .true.
+ return
+ end
+cdeck id>, mncntr.
+ subroutine mncntr(fcn,ke1,ke2,ierrf,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc to print function contours in two variables, on line printer
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ parameter (numbcs=20,nxmax=115)
+ dimension contur(numbcs), fcna(nxmax),fcnb(nxmax)
+ character clabel*(numbcs)
+ character chln*(nxmax),chmid*(nxmax),chzero*(nxmax)
+ data clabel/'0123456789abcdefghij'/
+c input arguments: parx, pary, devs, ngrid
+ if (ke1.le.0 .or. ke2.le.0) go to 1350
+ if (ke1.gt.nu .or. ke2.gt.nu) go to 1350
+ ki1 = niofex(ke1)
+ ki2 = niofex(ke2)
+ if (ki1.le.0 .or. ki2.le.0) go to 1350
+ if (ki1 .eq. ki2) go to 1350
+c
+ if (isw(2) .lt. 1) then
+ call mnhess(fcn,futil)
+ call mnwerr
+ endif
+ nparx = npar
+ xsav = u(ke1)
+ ysav = u(ke2)
+ devs = word7(3)
+ if (devs .le. zero) devs=2.
+ xlo = u(ke1) - devs*werr(ki1)
+ xup = u(ke1) + devs*werr(ki1)
+ ylo = u(ke2) - devs*werr(ki2)
+ yup = u(ke2) + devs*werr(ki2)
+ ngrid = word7(4)
+ if (ngrid .le. 0) then
+ ngrid=25
+ nx = min(npagwd-15,ngrid)
+ ny = min(npagln-7, ngrid)
+ else
+ nx = ngrid
+ ny = ngrid
+ endif
+ if (nx .lt. 11) nx=11
+ if (ny .lt. 11) ny=11
+ if (nx .ge. nxmax) nx=nxmax-1
+c ask if parameter outside limits
+ if (nvarl(ke1) .gt. 1) then
+ if (xlo .lt. alim(ke1)) xlo = alim(ke1)
+ if (xup .gt. blim(ke1)) xup = blim(ke1)
+ endif
+ if (nvarl(ke2) .gt. 1) then
+ if (ylo .lt. alim(ke2)) ylo = alim(ke2)
+ if (yup .gt. blim(ke2)) yup = blim(ke2)
+ endif
+ bwidx = (xup-xlo)/real(nx)
+ bwidy = (yup-ylo)/real(ny)
+ ixmid = int((xsav-xlo)*real(nx)/(xup-xlo)) + 1
+ if (amin .eq. undefi) call mnamin(fcn,futil)
+ do 185 i= 1, numbcs
+ contur(i) = amin + up*float(i-1)**2
+ 185 continue
+ contur(1) = contur(1) + 0.01*up
+c fill fcnb to prepare first row, and find column zero
+ u(ke2) = yup
+ ixzero = 0
+ xb4 = one
+ do 200 ix= 1, nx+1
+ u(ke1) = xlo + real(ix-1)*bwidx
+ call fcn(nparx,gin,ff,u,4,futil)
+ fcnb(ix) = ff
+ if (xb4.lt.zero .and. u(ke1).gt.zero) ixzero = ix-1
+ xb4 = u(ke1)
+ chmid(ix:ix) = '*'
+ chzero(ix:ix)= '-'
+ 200 continue
+ write (isyswr,'(a,i3,a,a)') ' y-axis: parameter ',
+ + ke2,': ',cpnam(ke2)
+ if (ixzero .gt. 0) then
+ chzero(ixzero:ixzero) = '+'
+ chln = ' '
+ write (isyswr,'(12x,a,a)') chln(1:ixzero),'x=0'
+ endif
+c loop over rows
+ do 280 iy= 1, ny
+ unext = u(ke2) - bwidy
+c prepare this line's background pattern for contour
+ chln = ' '
+ chln(ixmid:ixmid) = '*'
+ if (ixzero .ne. 0) chln(ixzero:ixzero) = ':'
+ if (u(ke2).gt.ysav .and. unext.lt.ysav) chln=chmid
+ if (u(ke2).gt.zero .and. unext.lt.zero) chln=chzero
+ u(ke2) = unext
+ ylabel = u(ke2) + 0.5*bwidy
+c move fcnb to fcna and fill fcnb with next row
+ do 220 ix= 1, nx+1
+ fcna(ix) = fcnb(ix)
+ u(ke1) = xlo + real(ix-1)*bwidx
+ call fcn(nparx,gin,ff,u,4,futil)
+ fcnb(ix) = ff
+ 220 continue
+c look for contours crossing the fcnxy squares
+ do 250 ix= 1, nx
+ fmx = max(fcna(ix),fcnb(ix),fcna(ix+1),fcnb(ix+1))
+ fmn = min(fcna(ix),fcnb(ix),fcna(ix+1),fcnb(ix+1))
+ do 230 ics= 1, numbcs
+ if (contur(ics) .gt. fmn) go to 240
+ 230 continue
+ go to 250
+ 240 if (contur(ics) .lt. fmx) chln(ix:ix)=clabel(ics:ics)
+ 250 continue
+c print a row of the contour plot
+ write (isyswr,'(1x,g12.4,1x,a)') ylabel,chln(1:nx)
+ 280 continue
+c contours printed, label x-axis
+ chln = ' '
+ chln( 1: 1) = 'i'
+ chln(ixmid:ixmid) = 'i'
+ chln(nx:nx) = 'i'
+ write (isyswr,'(14x,a)') chln(1:nx)
+c the hardest of all: print x-axis scale!
+ chln = ' '
+ if (nx .le. 26) then
+ nl = max(nx-12,2)
+ nl2 = nl/2
+ write (isyswr,'(8x,g12.4,a,g12.4)') xlo,chln(1:nl),xup
+ write (isyswr,'(14x,a,g12.4)') chln(1:nl2),xsav
+ else
+ nl = max(nx-24,2)/2
+ nl2 = nl
+ if (nl .gt. 10) nl2=nl-6
+ write (isyswr,'(8x,g12.4,a,g12.4,a,g12.4)') xlo,
+ + chln(1:nl),xsav,chln(1:nl2),xup
+ endif
+ write (isyswr,'(6x,a,i3,a,a,a,g12.4)') ' x-axis: parameter',
+ + ke1,': ',cpnam(ke1),' one column=',bwidx
+ write (isyswr,'(a,g12.4,a,g12.4,a)') ' function values: f(i)=',
+ + amin,' +',up,' *i**2'
+c finished. reset input values
+ u(ke1) = xsav
+ u(ke2) = ysav
+ ierrf = 0
+ return
+ 1350 write (isyswr,1351)
+ 1351 format (' invalid parameter number(s) requested. ignored.' /)
+ ierrf = 1
+ return
+ end
+cdeck id>, mncont.
+ subroutine mncont(fcn,ke1,ke2,nptu,xptu,yptu,ierrf,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc find nptu points along a contour where the function
+cc fmin (x(ke1),x(ke2)) = amin+up
+cc where fmin is the minimum of fcn with respect to all
+cc the other npar-2 variable parameters (if any).
+cc ierrf on return will be equal to the number of points found:
+cc nptu if normal termination with nptu points found
+cc -1 if errors in the calling sequence (ke1, ke2 not variable)
+cc 0 if less than four points can be found (using mnmnot)
+cc n>3 if only n points can be found (n < nptu)
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ dimension xptu(nptu), yptu(nptu), w(mni),gcc(mni)
+ character chere*10
+ parameter (chere='mncontour ')
+ logical ldebug
+ external fcn,futil
+c input arguments: parx, pary, devs, ngrid
+ ldebug = (idbg(6) .ge. 1)
+ if (ke1.le.0 .or. ke2.le.0) go to 1350
+ if (ke1.gt.nu .or. ke2.gt.nu) go to 1350
+ ki1 = niofex(ke1)
+ ki2 = niofex(ke2)
+ if (ki1.le.0 .or. ki2.le.0) go to 1350
+ if (ki1 .eq. ki2) go to 1350
+ if (nptu .lt. 4) go to 1400
+c
+ nfcnco = nfcn
+ nfcnmx = 100*(nptu+5)*(npar+1)
+c the minimum
+ call mncuve(fcn,futil)
+ u1min = u(ke1)
+ u2min = u(ke2)
+ ierrf = 0
+ cfrom = chere
+ nfcnfr = nfcnco
+ if (isw(5) .ge. 0) then
+ write (isyswr,'(1x,a,i4,a)')
+ + 'start mncontour calculation of',nptu,' points on contour.'
+ if (npar .gt. 2) then
+ if (npar .eq. 3) then
+ ki3 = 6 - ki1 - ki2
+ ke3 = nexofi(ki3)
+ write (isyswr,'(1x,a,i3,2x,a)')
+ + 'each point is a minimum with respect to parameter ',
+ + ke3, cpnam(ke3)
+ else
+ write (isyswr,'(1x,a,i3,a)')
+ + 'each point is a minimum with respect to the other',
+ + npar-2, ' variable parameters.'
+ endif
+ endif
+ endif
+c
+c find the first four points using mnmnot
+c ........................ first two points
+ call mnmnot(fcn,ke1,ke2,val2pl,val2mi,futil)
+ if (ern(ki1) .eq. undefi) then
+ xptu(1) = alim(ke1)
+ call mnwarn('w',chere,'contour squeezed by parameter limits.')
+ else
+ if (ern(ki1) .ge. zero) go to 1500
+ xptu(1) = u1min+ern(ki1)
+ endif
+ yptu(1) = val2mi
+c
+ if (erp(ki1) .eq. undefi) then
+ xptu(3) = blim(ke1)
+ call mnwarn('w',chere,'contour squeezed by parameter limits.')
+ else
+ if (erp(ki1) .le. zero) go to 1500
+ xptu(3) = u1min+erp(ki1)
+ endif
+ yptu(3) = val2pl
+ scalx = 1.0/(xptu(3) - xptu(1))
+c ........................... next two points
+ call mnmnot(fcn,ke2,ke1,val2pl,val2mi,futil)
+ if (ern(ki2) .eq. undefi) then
+ yptu(2) = alim(ke2)
+ call mnwarn('w',chere,'contour squeezed by parameter limits.')
+ else
+ if (ern(ki2) .ge. zero) go to 1500
+ yptu(2) = u2min+ern(ki2)
+ endif
+ xptu(2) = val2mi
+ if (erp(ki2) .eq. undefi) then
+ yptu(4) = blim(ke2)
+ call mnwarn('w',chere,'contour squeezed by parameter limits.')
+ else
+ if (erp(ki2) .le. zero) go to 1500
+ yptu(4) = u2min+erp(ki2)
+ endif
+ xptu(4) = val2pl
+ scaly = 1.0/(yptu(4) - yptu(2))
+ nowpts = 4
+ next = 5
+ if (ldebug) then
+ write (isyswr,'(a)') ' plot of four points found by minos'
+ xpt(1) = u1min
+ ypt(1) = u2min
+ chpt(1) = ' '
+ nall = min(nowpts+1,maxcpt)
+ do 85 i= 2, nall
+ xpt(i) = xptu(i-1)
+ ypt(i) = yptu(i-1)
+ 85 continue
+ chpt(2)= 'a'
+ chpt(3)= 'b'
+ chpt(4)= 'c'
+ chpt(5)= 'd'
+ call mnplot(xpt,ypt,chpt,nall,isyswr,npagwd,npagln)
+ endif
+c
+c ..................... save some values before fixing
+ isw2 = isw(2)
+ isw4 = isw(4)
+ sigsav = edm
+ istrav = istrat
+ dc = dcovar
+ apsi = epsi*0.5
+ abest=amin
+ mpar=npar
+ nfmxin = nfcnmx
+ do 125 i= 1, mpar
+ 125 xt(i) = x(i)
+ do 130 j= 1, mpar*(mpar+1)/2
+ 130 vthmat(j) = vhmat(j)
+ do 135 i= 1, mpar
+ gcc(i) = globcc(i)
+ 135 w(i) = werr(i)
+c fix the two parameters in question
+ kints = niofex(ke1)
+ call mnfixp (kints,ierr)
+ kints = niofex(ke2)
+ call mnfixp (kints,ierr)
+c ......................fill in the rest of the points
+ do 900 inew= next, nptu
+c find the two neighbouring points with largest separation
+ bigdis = 0.
+ do 200 iold = 1, inew-1
+ i2 = iold + 1
+ if (i2 .eq. inew) i2 = 1
+ dist = (scalx*(xptu(iold)-xptu(i2)))**2 +
+ + (scaly*(yptu(iold)-yptu(i2)))**2
+ if (dist .gt. bigdis) then
+ bigdis = dist
+ idist = iold
+ endif
+ 200 continue
+ i1 = idist
+ i2 = i1 + 1
+ if (i2 .eq. inew) i2 = 1
+c next point goes between i1 and i2
+ a1 = half
+ a2 = half
+ 300 xmidcr = a1*xptu(i1) + a2*xptu(i2)
+ ymidcr = a1*yptu(i1) + a2*yptu(i2)
+ xdir = yptu(i2) - yptu(i1)
+ ydir = xptu(i1) - xptu(i2)
+ sclfac = max(abs(xdir*scalx), abs(ydir*scaly))
+ xdircr = xdir/sclfac
+ ydircr = ydir/sclfac
+ ke1cr = ke1
+ ke2cr = ke2
+c find the contour crossing point along dir
+ amin = abest
+ call mncros(fcn,aopt,iercr,futil)
+ if (iercr .gt. 1) then
+c if cannot find mid-point, try closer to point 1
+ if (a1 .gt. half) then
+ write (isyswr,'(a,a,i3,a)') ' mncont cannot find next',
+ + ' point on contour. only ',nowpts,' points found.'
+ go to 950
+ endif
+ call mnwarn('w',chere,'cannot find midpoint, try closer.')
+ a1 = 0.75
+ a2 = 0.25
+ go to 300
+ endif
+c contour has been located, insert new point in list
+ do 830 move= nowpts,i1+1,-1
+ xptu(move+1) = xptu(move)
+ yptu(move+1) = yptu(move)
+ 830 continue
+ nowpts = nowpts + 1
+ xptu(i1+1) = xmidcr + xdircr*aopt
+ yptu(i1+1) = ymidcr + ydircr*aopt
+ 900 continue
+ 950 continue
+c ierrf = nowpts
+ cstatu = 'successful'
+ if (nowpts .lt. nptu) cstatu = 'incomplete'
+c make a lineprinter plot of the contour
+ if (isw(5) .ge. 0) then
+ xpt(1) = u1min
+ ypt(1) = u2min
+ chpt(1) = ' '
+ nall = min(nowpts+1,maxcpt)
+ do 1000 i= 2, nall
+ xpt(i) = xptu(i-1)
+ ypt(i) = yptu(i-1)
+ chpt(i)= 'x'
+ 1000 continue
+ write (isyswr,'(a,i3,2x,a)') ' y-axis: parameter ',ke2,
+ + cpnam(ke2)
+ call mnplot(xpt,ypt,chpt,nall,isyswr,npagwd,npagln)
+ write (isyswr,'(25x,a,i3,2x,a)') 'x-axis: parameter ',
+ + ke1,cpnam(ke1)
+ endif
+c print out the coordinates around the contour
+ if (isw(5) .ge. 1) then
+ npcol = (nowpts+1)/2
+ nfcol = nowpts/2
+ write (isyswr,'(/i5,a,g13.5,a,g11.3)') nowpts,
+ + ' points on contour. fmin=',abest,' errdef=',up
+ write (isyswr,'(9x,a,3x,a,18x,a,3x,a)')
+ + cpnam(ke1),cpnam(ke2),cpnam(ke1),cpnam(ke2)
+ do 1050 line = 1, nfcol
+ lr = line + npcol
+ write (isyswr,'(1x,i5,2g13.5,10x,i5,2g13.5)')
+ + line,xptu(line),yptu(line),lr,xptu(lr),yptu(lr)
+ 1050 continue
+ if (nfcol .lt. npcol) write (isyswr,'(1x,i5,2g13.5)')
+ + npcol,xptu(npcol),yptu(npcol)
+ endif
+c . . contour finished. reset v
+ itaur = 1
+ call mnfree(1)
+ call mnfree(1)
+ do 1100 j= 1, mpar*(mpar+1)/2
+ 1100 vhmat(j) = vthmat(j)
+ do 1120 i= 1, mpar
+ globcc(i) = gcc(i)
+ werr(i) = w(i)
+ 1120 x(i) = xt(i)
+ call mninex (x)
+ edm = sigsav
+ amin = abest
+ isw(2) = isw2
+ isw(4) = isw4
+ dcovar = dc
+ itaur = 0
+ nfcnmx = nfmxin
+ istrat = istrav
+ u(ke1) = u1min
+ u(ke2) = u2min
+ go to 2000
+c error returns
+ 1350 write (isyswr,'(a)') ' invalid parameter numbers.'
+ go to 1450
+ 1400 write (isyswr,'(a)') ' less than four points requested.'
+ 1450 ierrf = -1
+ cstatu = 'user error'
+ go to 2000
+ 1500 write (isyswr,'(a)') ' mncont unable to find four points.'
+ u(ke1) = u1min
+ u(ke2) = u2min
+ ierrf = 0
+ cstatu = 'failed'
+ 2000 continue
+ cfrom = chere
+ nfcnfr = nfcnco
+ return
+ end
+cdeck id>, mncrck.
+ subroutine mncrck(crdbuf,maxcwd,comand,lnc,
+ + mxp, plist, llist,ierr,isyswr)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc
+cc called from mnread.
+cc cracks the free-format input, expecting zero or more
+cc alphanumeric fields (which it joins into comand(1:lnc))
+cc followed by one or more numeric fields separated by
+cc blanks and/or one comma. the numeric fields are put into
+cc the llist (but at most mxp) elements of plist.
+cc ierr = 0 if no errors,
+cc = 1 if error(s).
+cc diagnostic messages are written to isyswr
+cc
+ parameter (maxelm=25, mxlnel=19)
+ character*(*) comand, crdbuf
+ character cnumer*13, celmnt(maxelm)*(mxlnel), cnull*15
+ dimension lelmnt(maxelm),plist(mxp)
+ data cnull /')null string '/
+ data cnumer/'123456789-.0+'/
+ ielmnt = 0
+ lend = len(crdbuf)
+ nextb = 1
+ ierr = 0
+c . . . . loop over words celmnt
+ 10 continue
+ do 100 ipos= nextb,lend
+ ibegin = ipos
+ if (crdbuf(ipos:ipos).eq.' ') go to 100
+ if (crdbuf(ipos:ipos).eq.',') go to 250
+ go to 150
+ 100 continue
+ go to 300
+ 150 continue
+c found beginning of word, look for end
+ do 180 ipos = ibegin+1,lend
+ if (crdbuf(ipos:ipos).eq.' ') go to 250
+ if (crdbuf(ipos:ipos).eq.',') go to 250
+ 180 continue
+ ipos = lend+1
+ 250 iend = ipos-1
+ ielmnt = ielmnt + 1
+ if (iend .ge. ibegin) then
+ celmnt(ielmnt) = crdbuf(ibegin:iend)
+ else
+ celmnt(ielmnt) = cnull
+ endif
+ lelmnt(ielmnt) = iend-ibegin+1
+ if (lelmnt(ielmnt) .gt. mxlnel) then
+ write (isyswr, 253) crdbuf(ibegin:iend),celmnt(ielmnt)
+ 253 format (' minuit warning: input data word too long.'
+ + /' original:',a
+ + /' truncated to:',a)
+ lelmnt(ielmnt) = mxlnel
+ endif
+ if (ipos .ge. lend) go to 300
+ if (ielmnt .ge. maxelm) go to 300
+c look for comma or beginning of next word
+ do 280 ipos= iend+1,lend
+ if (crdbuf(ipos:ipos) .eq. ' ') go to 280
+ nextb = ipos
+ if (crdbuf(ipos:ipos) .eq. ',') nextb = ipos+1
+ go to 10
+ 280 continue
+c all elements found, join the alphabetic ones to
+c form a command
+ 300 continue
+ nelmnt = ielmnt
+ comand = ' '
+ lnc = 1
+ plist(1) = 0.
+ llist = 0
+ if (ielmnt .eq. 0) go to 900
+ kcmnd = 0
+ do 400 ielmnt = 1, nelmnt
+ if (celmnt(ielmnt) .eq. cnull) go to 450
+ do 350 ic= 1, 13
+ if (celmnt(ielmnt)(1:1) .eq. cnumer(ic:ic)) go to 450
+ 350 continue
+ if (kcmnd .ge. maxcwd) go to 400
+ left = maxcwd-kcmnd
+ ltoadd = lelmnt(ielmnt)
+ if (ltoadd .gt. left) ltoadd=left
+ comand(kcmnd+1:kcmnd+ltoadd) = celmnt(ielmnt)(1:ltoadd)
+ kcmnd = kcmnd + ltoadd
+ if (kcmnd .eq. maxcwd) go to 400
+ kcmnd = kcmnd + 1
+ comand(kcmnd:kcmnd) = ' '
+ 400 continue
+ lnc = kcmnd
+ go to 900
+ 450 continue
+ lnc = kcmnd
+c . . . . we have come to a numeric field
+ llist = 0
+ do 600 ifld= ielmnt,nelmnt
+ llist = llist + 1
+ if (llist .gt. mxp) then
+ nreq = nelmnt-ielmnt+1
+ write (isyswr,511) nreq,mxp
+ 511 format (/' minuit warning in mncrck: '/ ' command has input',i5,
+ + ' numeric fields, but minuit can accept only',i3)
+ go to 900
+ endif
+ if (celmnt(ifld) .eq. cnull) then
+ plist(llist) = 0.
+ else
+ read (celmnt(ifld), '(bn,f19.0)',err=575) plist(llist)
+ endif
+ go to 600
+ 575 write (isyswr,'(a,a,a)') ' format error in numeric field: "',
+ + celmnt(ifld)(1:lelmnt(ifld)),'"'
+ ierr = 1
+ plist(llist) = 0.
+ 600 continue
+c end loop over numeric fields
+ 900 continue
+ if (lnc .le. 0) lnc=1
+ return
+ end
+cdeck id>, mncros.
+ subroutine mncros(fcn,aopt,iercr,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc find point where mneval=amin+up, along the line through
+cc xmid,ymid with direction xdir,ydir, where x and y are
+cc parameters ke1 and ke2. if ke2=0 (from minos), then
+cc only ke1 is varied. from mncont, both are varied.
+cc crossing point is at
+cc (u(ke1),u(ke2)) = (xmid,ymid) + aopt*(xdir,ydir)
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ character chere*10, charal*28, chsign*4
+ parameter (chere='mncontour ', mlsb=3, maxitr=15, tlr=0.01)
+ dimension flsb(mlsb),alsb(mlsb), coeff(3)
+ logical ldebug
+ external fcn,futil
+ data charal/' .abcdefghijklmnopqrstuvwxyz'/
+ ldebug = (idbg(6) .ge. 1)
+ aminsv = amin
+ aim = amin + up
+ tlf = tlr*up
+ tla = tlr*0.1
+ xpt(1) = 0.0
+ ypt(1) = aim
+ chpt(1) = ' '
+ xpt(2) = -1.0
+ ypt(2) = amin
+ chpt(2) = '.'
+ ipt = 2
+c find the largest allowed a
+ aulim = 100.
+ do 100 ik= 1, 2
+ if (ik .eq. 1) then
+ kex = ke1cr
+ zmid = xmidcr
+ zdir = xdircr
+ else
+ if (ke2cr .eq. 0) go to 100
+ kex = ke2cr
+ zmid = ymidcr
+ zdir = ydircr
+ endif
+ if (nvarl(kex) .le. 1) go to 100
+ if (zdir .eq. zero) go to 100
+ zlim = alim(kex)
+ if (zdir .gt. zero) zlim = blim(kex)
+ aulim = min(aulim,(zlim-zmid)/zdir)
+ 100 continue
+c lsb = line search buffer
+c first point
+ anext = 0.
+ aopt = anext
+ limset = .false.
+ if (aulim .lt. aopt+tla) limset = .true.
+ call mneval(fcn,anext,fnext,ierev,futil)
+c debug printout:
+ if (ldebug) write (isyswr,'(a,i8,a,f10.5,a,2f10.5)')
+ + ' mncros: calls=',nfcn,' aim=',aim,' f,a=',fnext,aopt
+ if (ierev .gt. 0) go to 900
+ if (limset .and. fnext .le. aim) go to 930
+ ipt = ipt + 1
+ xpt(ipt) = anext
+ ypt(ipt) = fnext
+ chpt(ipt)= charal(ipt:ipt)
+ alsb(1) = anext
+ flsb(1) = fnext
+ fnext = max(fnext,aminsv+0.1*up)
+ aopt = dsqrt((up)/(fnext-aminsv)) - 1.0
+ if (abs(fnext-aim) .lt. tlf) go to 800
+c
+ if (aopt .lt. -0.5) aopt = -0.5
+ limset = .false.
+ if (aopt .gt. aulim) then
+ aopt = aulim
+ limset = .true.
+ endif
+ call mneval(fcn,aopt,fnext,ierev,futil)
+c debug printout:
+ if (ldebug) write (isyswr,'(a,i8,a,f10.5,a,2f10.5)')
+ + ' mncros: calls=',nfcn,' aim=',aim,' f,a=',fnext,aopt
+ if (ierev .gt. 0) go to 900
+ if (limset .and. fnext .le. aim) go to 930
+ alsb(2) = aopt
+ ipt = ipt + 1
+ xpt(ipt) = alsb(2)
+ ypt(ipt) = fnext
+ chpt(ipt)= charal(ipt:ipt)
+ flsb(2) = fnext
+ dfda = (flsb(2)-flsb(1))/ (alsb(2)-alsb(1))
+ ilsb = 2
+c dfda must be positive on the contour
+ if (dfda .gt. zero) go to 460
+ 300 call mnwarn('d',chere,'looking for slope of the right sign')
+ maxlk = maxitr - ipt
+ do 400 it= 1, maxlk
+ alsb(1) = alsb(2)
+ flsb(1) = flsb(2)
+ aopt = alsb(1) + 0.2*real(it)
+ limset = .false.
+ if (aopt .gt. aulim) then
+ aopt = aulim
+ limset = .true.
+ endif
+ call mneval(fcn,aopt,fnext,ierev,futil)
+c debug printout:
+ if (ldebug) write (isyswr,'(a,i8,a,f10.5,a,2f10.5)')
+ + ' mncros: calls=',nfcn,' aim=',aim,' f,a=',fnext,aopt
+ if (ierev .gt. 0) go to 900
+ if (limset .and. fnext .le. aim) go to 930
+ alsb(2) = aopt
+ ipt = ipt + 1
+ xpt(ipt) = alsb(2)
+ ypt(ipt) = fnext
+ chpt(ipt)= charal(ipt:ipt)
+ flsb(2) = fnext
+ dfda = (flsb(2)-flsb(1))/ (alsb(2)-alsb(1))
+ if (dfda .gt. zero) go to 450
+ 400 continue
+ call mnwarn('w',chere,'cannot find slope of the right sign')
+ go to 950
+ 450 continue
+c we have two points with the right slope
+ 460 aopt = alsb(2) + (aim-flsb(2))/dfda
+ if (min(abs(aopt-alsb(1)),abs(aopt-alsb(2))).lt. tla) go to 800
+ if (ipt .ge. maxitr) go to 950
+ bmin = min(alsb(1),alsb(2)) - 1.0
+ if (aopt .lt. bmin) aopt = bmin
+ bmax = max(alsb(1),alsb(2)) + 1.0
+ if (aopt .gt. bmax) aopt = bmax
+c try a third point
+ call mneval(fcn,aopt,fnext,ierev,futil)
+c debug printout:
+ if (ldebug) write (isyswr,'(a,i8,a,f10.5,a,2f10.5)')
+ + ' mncros: calls=',nfcn,' aim=',aim,' f,a=',fnext,aopt
+ if (ierev .gt. 0) go to 900
+ alsb(3) = aopt
+ ipt = ipt + 1
+ xpt(ipt) = alsb(3)
+ ypt(ipt) = fnext
+ chpt(ipt)= charal(ipt:ipt)
+ flsb(3) = fnext
+ inew = 3
+c now we have three points, ask how many <aim
+ ecarmn = abs(fnext-aim)
+ ibest = 3
+ ecarmx = 0.
+ noless = 0
+ do 480 i= 1, 3
+ ecart = abs(flsb(i) - aim)
+ if (ecart .gt. ecarmx) then
+ ecarmx = ecart
+ iworst = i
+ endif
+ if (ecart .lt. ecarmn) then
+ ecarmn = ecart
+ ibest = i
+ endif
+ if (flsb(i) .lt. aim) noless = noless + 1
+ 480 continue
+c if at least one on each side of aim, fit a parabola
+ if (noless.eq.1 .or. noless.eq.2) go to 500
+c if all three are above aim, third must be closest to aim
+ if (noless .eq. 0 .and. ibest .ne. 3) go to 950
+c if all three below, and third is not best, then slope
+c has again gone negative, look for positive slope.
+ if (noless .eq. 3 .and. ibest .ne. 3) then
+ alsb(2) = alsb(3)
+ flsb(2) = flsb(3)
+ go to 300
+ endif
+c in other cases, new straight line thru last two points
+ alsb(iworst) = alsb(3)
+ flsb(iworst) = flsb(3)
+ dfda = (flsb(2)-flsb(1))/ (alsb(2)-alsb(1))
+ go to 460
+c parabola fit
+ 500 call mnpfit(alsb,flsb,3,coeff,sdev)
+ if (coeff(3) .le. zero) call mnwarn ('d',chere,
+ + 'curvature is negative near contour line.')
+ determ = coeff(2)**2 - 4.*coeff(3)*(coeff(1)-aim)
+ if (determ .le. zero) then
+ call mnwarn('d',chere,'problem 2, impossible determinant')
+ go to 950
+ endif
+c find which root is the right one
+ rt = dsqrt(determ)
+ x1 = (-coeff(2) + rt)/(2.*coeff(3))
+ x2 = (-coeff(2) - rt)/(2.*coeff(3))
+ s1 = coeff(2) + 2.*x1*coeff(3)
+ s2 = coeff(2) + 2.*x2*coeff(3)
+ if (s1*s2 .gt. zero) write (isyswr,'(a)') ' mncontour problem 1'
+ aopt = x1
+ if (s2 .gt. zero) aopt = x2
+ if (abs(aopt-alsb(inew)) .lt. tla) go to 800
+c evaluate function at parabolic optimum
+ if (ipt .ge. maxitr) go to 950
+ limset = .false.
+ if (aopt .gt. aulim) then
+ aopt = aulim
+ limset = .true.
+ endif
+ call mneval(fcn,aopt,fnext,ierev,futil)
+c debug printout:
+ if (ldebug) write (isyswr,'(a,i8,a,f10.5,a,2f10.5)')
+ + ' mncros: calls=',nfcn,' aim=',aim,' f,a=',fnext,aopt
+ if (ierev .gt. 0) go to 900
+ if (limset .and. fnext .le. aim) go to 930
+ ipt = ipt + 1
+ xpt(ipt) = aopt
+ ypt(ipt) = fnext
+ chpt(ipt)= charal(ipt:ipt)
+c replace unneeded point by new one
+c find nearest, farthest, (and hence middle) points,
+ inear = 1
+ anear = alsb(1)
+ ifar = 1
+ afar = alsb(1)
+ do 620 i= 1, 3
+ if (alsb(i) .lt. anear) then
+ anear = alsb(i)
+ inear = i
+ endif
+ if (alsb(i) .gt. afar) then
+ afar = alsb(i)
+ ifar = i
+ endif
+ 620 continue
+ imid = 6 - inear - ifar
+ fdist = flsb(imid)-aim
+ if (fdist*(flsb(inear)-aim) .gt. zero) then
+ inew = inear
+ else
+ inew = ifar
+ endif
+ alsb(inew) = aopt
+ flsb(inew) = fnext
+ go to 500
+c contour has been located, return point to mncont or minos
+ 800 continue
+ iercr = 0
+ go to 1000
+c error in the minimization
+ 900 if (ierev .eq. 1) go to 940
+ go to 950
+c parameter up against limit
+ 930 iercr = 1
+ go to 1000
+c too many calls to fcn
+ 940 iercr = 2
+ go to 1000
+c cannot find next point
+ 950 iercr = 3
+c in any case
+ 1000 continue
+ if (ldebug) then
+ itoohi = 0
+ do 1100 i= 1, ipt
+ if (ypt(i) .gt. aim+up) then
+ ypt(i) = aim+up
+ chpt(i) = '+'
+ itoohi = 1
+ endif
+ 1100 continue
+ chsign = 'posi'
+ if (xdircr .lt. zero) chsign = 'nega'
+ if (ke2cr .eq. 0) write (isyswr, '(2x,a,a,i3)')
+ + chsign,'tive minos error, parameter ',ke1cr
+ if (itoohi .eq. 1) write (isyswr, '(10x,a)')
+ + 'points labelled "+" were too high to plot.'
+ if (iercr .eq. 1) write (isyswr,'(10x,a)')
+ + 'rightmost point is up against limit.'
+ call mnplot(xpt,ypt,chpt,ipt,isyswr,npagwd,npagln)
+ endif
+ return
+ end
+cdeck id>, mncuve.
+ subroutine mncuve(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc makes sure that the current point is a local
+cc minimum and that the error matrix exists,
+cc or at least something good enough for minos and mncont
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ if (isw(4) .lt. 1) then
+ write (isyswr,'(/a,a)')
+ + ' function must be minimized before calling ',cfrom
+ apsi = epsi
+ call mnmigr(fcn,futil)
+ endif
+ if (isw(2) .lt. 3) then
+ call mnhess(fcn,futil)
+ if (isw(2) .lt. 1) then
+ call mnwarn('w',cfrom,'no error matrix. will improvise.')
+ do 555 i=1,npar
+ ndex = i*(i-1)/2
+ do 554 j=1,i-1
+ ndex = ndex + 1
+ 554 vhmat(ndex) = 0.
+ ndex = ndex + 1
+ if (g2(i) .le. zero) then
+ wint = werr(i)
+ iext = nexofi(i)
+ if (nvarl(iext) .gt. 1) then
+ call mndxdi(x(i),i,dxdi)
+ if (abs(dxdi) .lt. .001) then
+ wint = .01
+ else
+ wint = wint/abs(dxdi)
+ endif
+ endif
+ g2(i) = up/wint**2
+ endif
+ vhmat(ndex) = 2./g2(i)
+ 555 continue
+ isw(2) = 1
+ dcovar = 1.
+ else
+ call mnwerr
+ endif
+ endif
+ return
+ end
+cdeck id>, mnderi.
+ subroutine mnderi(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc calculates the first derivatives of fcn (grd),
+cc either by finite differences or by transforming the user-
+cc supplied derivatives to internal coordinates,
+cc according to whether isw(3) is zero or one.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ logical ldebug
+ character cbf1*22
+ nparx = npar
+ ldebug = (idbg(2) .ge. 1)
+ if (amin .eq. undefi) call mnamin(fcn,futil)
+ if (isw(3) .eq. 1) go to 100
+ if (ldebug) then
+c make sure starting at the right place
+ call mninex(x)
+ nparx = npar
+ call fcn(nparx,gin,fs1,u,4,futil)
+ nfcn = nfcn + 1
+ if (fs1 .ne. amin) then
+ df = amin - fs1
+ write (cbf1(1:12),'(g12.3)') df
+ call mnwarn('d','mnderi',
+ + 'function value differs from amin by '//cbf1(1:12) )
+ amin = fs1
+ endif
+ write
+ + (isyswr,'(/'' first derivative debug printout. mnderi''/
+ + '' par deriv step minstep optstep '',
+ + '' d1-d2 2nd drv'')')
+ endif
+ dfmin = 8. * epsma2*(abs(amin)+up)
+ if (istrat .le. 0) then
+ ncyc = 2
+ tlrstp = 0.5
+ tlrgrd = 0.1
+ else if (istrat .eq. 1) then
+ ncyc = 3
+ tlrstp = 0.3
+ tlrgrd = 0.05
+ else
+ ncyc = 5
+ tlrstp = 0.1
+ tlrgrd = 0.02
+ endif
+c loop over variable parameters
+ do 60 i=1,npar
+ epspri = epsma2 + abs(grd(i)*epsma2)
+c two-point derivatives always assumed necessary
+c maximum number of cycles over step size depends on strategy
+ xtf = x(i)
+ stepb4 = 0.
+c loop as little as possible here!
+ do 45 icyc= 1, ncyc
+c ........ theoretically best step
+ optstp = dsqrt(dfmin/(abs(g2(i))+epspri))
+c step cannot decrease by more than a factor of ten
+ step = max(optstp, abs(0.1*gstep(i)))
+c but if parameter has limits, max step size = 0.5
+ if (gstep(i).lt.zero .and. step.gt.0.5) step=0.5
+c and not more than ten times the previous step
+ stpmax = 10.*abs(gstep(i))
+ if (step .gt. stpmax) step = stpmax
+c minimum step size allowed by machine precision
+ stpmin = 8. * abs(epsma2*x(i))
+ if (step .lt. stpmin) step = stpmin
+c end of iterations if step change less than factor 2
+ if (abs((step-stepb4)/step) .lt. tlrstp) go to 50
+c take step positive
+ gstep(i) = sign(step, gstep(i))
+ stepb4 = step
+ x(i) = xtf + step
+ call mninex(x)
+ call fcn(nparx,gin,fs1,u,4,futil)
+ nfcn=nfcn+1
+c take step negative
+ x(i) = xtf - step
+ call mninex(x)
+ call fcn(nparx,gin,fs2,u,4,futil)
+ nfcn=nfcn+1
+ grbfor = grd(i)
+ grd(i) = (fs1-fs2)/(2.0*step)
+ g2(i) = (fs1+fs2-2.0*amin)/(step**2)
+ x(i) = xtf
+ if (ldebug) then
+ d1d2 = (fs1+fs2-2.0*amin)/step
+ write (isyswr,41) i,grd(i),step,stpmin,optstp,d1d2,g2(i)
+ 41 format (i4,2g11.3,5g10.2)
+ endif
+c see if another iteration is necessary
+ if (abs(grbfor-grd(i))/(abs(grd(i))+dfmin/step) .lt. tlrgrd)
+ + go to 50
+ 45 continue
+c end of icyc loop. too many iterations
+ if (ncyc .eq. 1) go to 50
+ write (cbf1,'(2e11.3)') grd(i),grbfor
+ call mnwarn('d','mnderi',
+ + 'first derivative not converged. '//cbf1)
+ 50 continue
+c
+ 60 continue
+ call mninex(x)
+ return
+c . derivatives calc by fcn
+ 100 do 150 iint= 1, npar
+ iext = nexofi(iint)
+ if (nvarl(iext) .gt. 1) go to 120
+ grd(iint) = gin(iext)
+ go to 150
+ 120 dd = (blim(iext)-alim(iext))*0.5 *dcos(x(iint))
+ grd(iint) = gin(iext)*dd
+ 150 continue
+ 200 return
+ end
+cdeck id>, mndxdi.
+ subroutine mndxdi(pint,ipar,dxdi)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc calculates the transformation factor between external and
+cc internal parameter values. this factor is one for
+cc parameters which are not limited. called from mnemat.
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ i = nexofi(ipar)
+ dxdi = 1.0
+ if (nvarl(i) .gt. 1)
+ + dxdi = 0.5 *abs((blim(i)-alim(i)) * dcos(pint))
+ return
+ end
+cdeck id>, mneig.
+ subroutine mneig(a,ndima,n,mits,work,precis,ifault)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+c
+ dimension a(ndima,*),work(*)
+ data zero,one,two/0.0,1.0,2.0/
+ data tol/1.0e-35/
+c precis is the machine precision epsmac
+ ifault = 1
+c
+ i = n
+ do 70 i1 = 2,n
+ l = i-2
+ f = a(i,i-1)
+ gl = zero
+c
+ if(l .lt. 1) go to 25
+c
+ do 20 k = 1,l
+ 20 gl = gl+a(i,k)**2
+ 25 h = gl + f**2
+c
+ if(gl .gt. tol) go to 30
+c
+ work(i) = zero
+ work(n+i) = f
+ go to 65
+ 30 l = l+1
+c
+ gl = dsqrt(h)
+c
+ if(f .ge. zero) gl = -gl
+c
+ work(n+i) = gl
+ h = h-f*gl
+ a(i,i-1) = f-gl
+ f = zero
+ do 50 j = 1,l
+ a(j,i) = a(i,j)/h
+ gl = zero
+ do 40 k = 1,j
+ 40 gl = gl+a(j,k)*a(i,k)
+c
+ if(j .ge. l) go to 47
+c
+ j1 = j+1
+ do 45 k = j1,l
+ 45 gl = gl+a(k,j)*a(i,k)
+ 47 work(n+j) = gl/h
+ f = f+gl*a(j,i)
+ 50 continue
+ hh = f/(h+h)
+ do 60 j = 1,l
+ f = a(i,j)
+ gl = work(n+j)-hh*f
+ work(n+j) = gl
+ do 60 k = 1,j
+ a(j,k) = a(j,k)-f*work(n+k)-gl*a(i,k)
+ 60 continue
+ work(i) = h
+ 65 i = i-1
+ 70 continue
+ work(1) = zero
+ work(n+1) = zero
+ do 110 i = 1,n
+ l = i-1
+c
+ if(work(i) .eq. zero .or. l .eq. 0) go to 100
+c
+ do 90 j = 1,l
+ gl = zero
+ do 80 k = 1,l
+ 80 gl = gl+a(i,k)*a(k,j)
+ do 90 k = 1,l
+ a(k,j) = a(k,j)-gl*a(k,i)
+ 90 continue
+ 100 work(i) = a(i,i)
+ a(i,i) = one
+c
+ if(l .eq. 0) go to 110
+c
+ do 105 j = 1,l
+ a(i,j) = zero
+ a(j,i) = zero
+ 105 continue
+ 110 continue
+c
+c
+ n1 = n-1
+ do 130 i = 2,n
+ i0 = n+i-1
+ 130 work(i0) = work(i0+1)
+ work(n+n) = zero
+ b = zero
+ f = zero
+ do 210 l = 1,n
+ j = 0
+ h = precis*(abs(work(l))+abs(work(n+l)))
+c
+ if(b .lt. h) b = h
+c
+ do 140 m1 = l,n
+ m = m1
+c
+ if(abs(work(n+m)) .le. b) go to 150
+c
+ 140 continue
+c
+ 150 if(m .eq. l) go to 205
+c
+ 160 if(j .eq. mits) return
+c
+ j = j+1
+ pt = (work(l+1)-work(l))/(two*work(n+l))
+ r = dsqrt(pt*pt+one)
+ pr = pt+r
+c
+ if(pt .lt. zero) pr=pt-r
+c
+ h = work(l)-work(n+l)/pr
+ do 170 i=l,n
+ 170 work(i) = work(i)-h
+ f = f+h
+ pt = work(m)
+ c = one
+ s = zero
+ m1 = m-1
+ i = m
+ do 200 i1 = l,m1
+ j = i
+ i = i-1
+ gl = c*work(n+i)
+ h = c*pt
+c
+ if(abs(pt) .ge. abs(work(n+i))) go to 180
+c
+ c = pt/work(n+i)
+ r = dsqrt(c*c+one)
+ work(n+j) = s*work(n+i)*r
+ s = one/r
+ c = c/r
+ go to 190
+ 180 c = work(n+i)/pt
+ r = dsqrt(c*c+one)
+ work(n+j) = s*pt*r
+ s = c/r
+ c = one/r
+ 190 pt = c*work(i)-s*gl
+ work(j) = h+s*(c*gl+s*work(i))
+ do 200 k = 1,n
+ h = a(k,j)
+ a(k,j) = s*a(k,i)+c*h
+ a(k,i) = c*a(k,i)-s*h
+ 200 continue
+ work(n+l) = s*pt
+ work(l) = c*pt
+c
+ if(abs(work(n+l)) .gt. b) go to 160
+c
+ 205 work(l) = work(l)+f
+ 210 continue
+ do 240 i=1,n1
+ k = i
+ pt = work(i)
+ i1 = i+1
+ do 220 j = i1,n
+c
+ if(work(j) .ge. pt) go to 220
+c
+ k = j
+ pt = work(j)
+ 220 continue
+c
+ if(k .eq. i) go to 240
+c
+ work(k) = work(i)
+ work(i) = pt
+ do 230 j=1,n
+ pt = a(j,i)
+ a(j,i) = a(j,k)
+ a(j,k) = pt
+ 230 continue
+ 240 continue
+ ifault = 0
+c
+ return
+ end
+cdeck id>, mnemat.
+ subroutine mnemat(emat,ndim)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+ dimension emat(ndim,ndim)
+cc calculates the external error matrix from the internal
+cc to be called by user, who must dimension emat at (ndim,ndim)
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ if (isw(2) .lt. 1) return
+ if (isw(5) .ge. 2) write (isyswr,'(/a,i4,a,i3,a,g10.2)')
+ + ' external error matrix. ndim=',ndim,' npar=',npar,
+ + ' err def=',up
+c size of matrix to be printed
+ npard = npar
+ if (ndim .lt. npar) then
+ npard = ndim
+ if (isw(5) .ge. 0) write (isyswr,'(a,a)') ' user-dimensioned ',
+ + ' array emat not big enough. reduced matrix calculated.'
+ endif
+c nperln is the number of elements that fit on one line
+ nperln = (npagwd-5)/10
+ nperln = min(nperln,13)
+ if (isw(5).ge. 1 .and. npard.gt.nperln) write (isyswr,'(a)')
+ + ' elements above diagonal are not printed.'
+c i counts the rows of the matrix
+ do 110 i= 1, npard
+ call mndxdi(x(i),i,dxdi)
+ kga = i*(i-1)/2
+ do 100 j= 1, i
+ call mndxdi(x(j),j,dxdj)
+ kgb = kga + j
+ emat(i,j) = dxdi * vhmat(kgb) * dxdj * up
+ emat(j,i) = emat(i,j)
+ 100 continue
+ 110 continue
+c iz is number of columns to be printed in row i
+ if (isw(5) .ge. 2) then
+ do 160 i= 1, npard
+ iz = npard
+ if (npard .ge. nperln) iz = i
+ do 150 k= 1, iz, nperln
+ k2 = k + nperln - 1
+ if (k2 .gt. iz) k2=iz
+ write (isyswr,'(1x,13e10.3)') (emat(i,kk),kk=k,k2)
+ 150 continue
+ 160 continue
+ endif
+ return
+ end
+cdeck id>, mnerrs.
+ subroutine mnerrs(number,eplus,eminus,eparab,gcc)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called by user, utility routine to get minos errors
+cc if number is positive, then it is external parameter number,
+cc if negative, it is -internal number.
+cc values returned by mnerrs:
+cc eplus, eminus are minos errors of parameter number,
+cc eparab is 'parabolic' error (from error matrix).
+cc (errors not calculated are set = 0.)
+cc gcc is global correlation coefficient from error matrix
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+c
+ iex = number
+ if (number .lt. 0) then
+ iin = -number
+ if (iin .gt. npar) go to 900
+ iex = nexofi(iin)
+ endif
+ if (iex .gt. nu .or. iex .le. 0) go to 900
+ iin = niofex(iex)
+ if (iin .le. 0) go to 900
+c iex is external number, iin is internal number
+ eplus = erp(iin)
+ if (eplus.eq.undefi) eplus=0.
+ eminus= ern(iin)
+ if (eminus.eq.undefi) eminus=0.
+ call mndxdi(x(iin),iin,dxdi)
+ ndiag = iin*(iin+1)/2
+ eparab = abs(dxdi*dsqrt(abs(up*vhmat(ndiag))))
+c global correlation coefficient
+ gcc = 0.
+ if (isw(2) .lt. 2) go to 990
+ gcc = globcc(iin)
+ go to 990
+c error. parameter number not valid
+ 900 eplus = 0.
+ eminus = 0.
+ eparab = 0.
+ gcc = 0.
+ 990 return
+ end
+cdeck id>, mneval.
+ subroutine mneval(fcn,anext,fnext,ierev,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc evaluates the function being analyzed by mncros, which is
+cc generally the minimum of fcn with respect to all remaining
+cc variable parameters. common block /mn7xcr/ contains the
+cc data necessary to know the values of u(ke1cr) and u(ke2cr)
+cc to be used, namely u(ke1cr) = xmidcr + anext*xdircr
+cc and (if ke2cr .ne. 0) u(ke2cr) = ymidcr + anext*ydircr
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+cc
+ external fcn,futil
+ u(ke1cr) = xmidcr + anext*xdircr
+ if ( ke2cr .ne. 0) u(ke2cr) = ymidcr + anext*ydircr
+ call mninex(x)
+ nparx = npar
+ call fcn(nparx,gin,fnext,u,4,futil)
+ nfcn = nfcn + 1
+ ierev = 0
+ if (npar .gt. 0) then
+ itaur = 1
+ amin = fnext
+ isw(1) = 0
+ call mnmigr(fcn,futil)
+ itaur = 0
+ fnext = amin
+ if (isw(1) .ge. 1) ierev = 1
+ if (isw(4) .lt. 1) ierev = 2
+ endif
+ return
+ end
+cdeck id>, mnexcm.
+ subroutine mnexcm(fcn,comand,plist,llist,ierflg,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc interprets a command and takes appropriate action,
+cc either directly by skipping to the corresponding code in
+cc mnexcm, or by setting up a call to a subroutine
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ character*(*) comand
+c cannot say dimension plist(llist) since llist can be =0.
+ dimension plist(*)
+ parameter (mxpt=101)
+ dimension xptu(mxpt), yptu(mxpt)
+c alphabetical order of command names!
+ dimension isort(40)
+ character*10 cname(40), cneway, chwhy*18, c26*30, cvblnk*2
+ logical ltofix, lfixed, lfreed
+c recognized minuit commands:
+ data cname( 1) / 'minimize ' /
+ data cname( 2) / 'seek ' /
+ data cname( 3) / 'simplex ' /
+ data cname( 4) / 'migrad ' /
+ data cname( 5) / 'minos ' /
+ data cname( 6) / 'set xxx ' /
+ data cname( 7) / 'show xxx ' /
+ data cname( 8) / 'top of pag' /
+ data cname( 9) / 'fix ' /
+ data cname(10) / 'restore ' /
+ data cname(11) / 'release ' /
+ data cname(12) / 'scan ' /
+ data cname(13) / 'contour ' /
+ data cname(14) / 'hesse ' /
+ data cname(15) / 'save ' /
+ data cname(16) / 'improve ' /
+ data cname(17) / 'call fcn ' /
+ data cname(18) / 'standard ' /
+ data cname(19) / 'end ' /
+ data cname(20) / 'exit ' /
+ data cname(21) / 'return ' /
+ data cname(22) / 'clear ' /
+ data cname(23) / 'help ' /
+ data cname(24) / 'mncontour ' /
+ data cname(25) / 'stop ' /
+ data cname(26) / 'jump ' /
+ data nname/26/
+ data cname(27) / ' ' /
+ data cname(28) / ' ' /
+ data cname(29) / ' ' /
+ data cname(30) / ' ' /
+ data cname(31) / ' ' /
+ data cname(32) / ' ' /
+ data cname(33) / ' ' /
+c obsolete commands:
+ data cname(34) / 'covariance' /
+ data cname(35) / 'printout ' /
+ data cname(36) / 'gradient ' /
+ data cname(37) / 'matout ' /
+ data cname(38) / 'error def ' /
+ data cname(39) / 'limits ' /
+ data cname(40) / 'punch ' /
+ data nntot/40/
+c 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ data isort/ 17,22,13,19,20, 9,23,14,16,26, 4, 1, 5,24,11,
+ + 10,21,15,12, 2, 6, 3, 7,18,25, 8, 1, 1, 1, 1,
+ + 1,1,1,1,1,1,1,1,1,1/
+c
+ lk = len(comand)
+ if (lk .gt. maxcwd) lk=maxcwd
+ cword = comand(1:lk)
+c copy the first maxp arguments into common (word7), making
+c sure that word7(1)=0. if llist=0
+ do 20 iw= 1, maxp
+ word7(iw) = zero
+ if (iw .le. llist) word7(iw) = plist(iw)
+ 20 continue
+ icomnd = icomnd + 1
+ nfcnlc = nfcn
+ if (cword(1:7).ne.'set pri' .or. word7(1).ge.0.) then
+ if (isw(5) .ge. 0) then
+ lnow = llist
+ if (lnow .gt. 4) lnow=4
+ write (isyswr,25) icomnd,cword(1:lk),(plist(i),i=1,lnow)
+ 25 format (1h ,10(1h*)/' **',i5,' **',a,4g12.4)
+ if (llist .gt. lnow) then
+ write (cvblnk,'(i2)') lk
+ c26 = '(11h **********,'//cvblnk//'x,4g12.4)'
+ write (isyswr,c26) (plist(i),i=lnow+1,llist)
+ endif
+ write (isyswr, '(1h ,10(1h*))' )
+ endif
+ endif
+ nfcnmx = word7(1)
+ if (nfcnmx .le. 0) nfcnmx = 200 + 100*npar + 5*npar**2
+ epsi = word7(2)
+ if (epsi .le. zero) epsi = 0.1 * up
+ lnewmn = .false.
+ lphead = .true.
+ isw(1) = 0
+ ierflg = 0
+c look for command in list cname . . . . . . . . . .
+ do 80 i= 1, nntot
+ if (cword(1:3) .eq. cname(i)(1:3)) go to 90
+ 80 continue
+ write (isyswr,'(11x,''unknown command ignored:'',a)') comand
+ ierflg = 2
+ go to 5000
+c normal case: recognized minuit command . . . . . . .
+ 90 continue
+ if (cword(1:4) .eq. 'mino') i = 5
+ if (i.ne.6 .and. i.ne.7 .and. i.ne.8 .and. i.ne.23) then
+ cfrom = cname(i)
+ nfcnfr = nfcn
+ endif
+c 1 2 3 4 5 6 7 8 9 10
+ go to ( 400, 200, 300, 400, 500, 700, 700, 800, 900,1000,
+ 1 1100,1200,1300,1400,1500,1600,1700,1800,1900,1900,
+ 2 1900,2200,2300,2400,1900,2600,3300,3300,3300,3300,
+ 3 3300,3300,3300,3400,3500,3600,3700,3800,3900,4000) , i
+c . . . . . . . . . . seek
+ 200 call mnseek(fcn,futil)
+ go to 5000
+c . . . . . . . . . . simplex
+ 300 call mnsimp(fcn,futil)
+ go to 5000
+c . . . . . . migrad, minimize
+ 400 continue
+ nf = nfcn
+ apsi = epsi
+ call mnmigr(fcn,futil)
+ call mnwerr
+ if (isw(4) .ge. 1) go to 5000
+ if (isw(1) .eq. 1) go to 5000
+ if (cword(1:3) .eq. 'mig') go to 5000
+ nfcnmx = nfcnmx + nf - nfcn
+ nf = nfcn
+ call mnsimp(fcn,futil)
+ if (isw(1) .eq. 1) go to 5000
+ nfcnmx = nfcnmx + nf - nfcn
+ call mnmigr(fcn,futil)
+ call mnwerr
+ go to 5000
+c . . . . . . . . . . minos
+ 500 continue
+ nsuper = nfcn + 2*(npar+1)*nfcnmx
+c possible loop over new minima
+ epsi = 0.1 * up
+ 510 continue
+ call mncuve(fcn,futil)
+ call mnmnos(fcn,futil)
+ if (.not. lnewmn) go to 5000
+ call mnrset(0)
+ call mnmigr(fcn,futil)
+ call mnwerr
+ if (nfcn .lt. nsuper) go to 510
+ write (isyswr,'(/'' too many function calls. minos gives up''/)')
+ ierflg = 1
+ go to 5000
+c . . . . . . . . . .set, show
+ 700 call mnset(fcn,futil)
+ go to 5000
+c . . . . . . . . . . top of page
+ 800 continue
+ write (isyswr,'(1h1)')
+ go to 5000
+c . . . . . . . . . . fix
+ 900 ltofix = .true.
+c . . (also release) ....
+ 901 continue
+ lfreed = .false.
+ lfixed = .false.
+ if (llist .eq. 0) then
+ write (isyswr,'(a,a)') cword,': no parameters requested '
+ go to 5000
+ endif
+ do 950 ilist= 1, llist
+ iext = plist(ilist)
+ chwhy = ' is undefined.'
+ if (iext .le. 0) go to 930
+ if (iext .gt. nu) go to 930
+ if (nvarl(iext) .lt. 0) go to 930
+ chwhy = ' is constant. '
+ if (nvarl(iext) .eq. 0) go to 930
+ iint = niofex(iext)
+ if (ltofix) then
+ chwhy = ' already fixed.'
+ if (iint .eq. 0) go to 930
+ call mnfixp(iint,ierr)
+ if (ierr .eq. 0) then
+ lfixed = .true.
+ else
+ ierflg = 1
+ endif
+ else
+ chwhy = ' already variable.'
+ if (iint .gt. 0) go to 930
+ krl = -iabs(iext)
+ call mnfree(krl)
+ lfreed = .true.
+ endif
+ go to 950
+ 930 write (isyswr,'(a,i4,a,a)') ' parameter',iext,chwhy,' ignored.'
+ 950 continue
+ if (lfreed .or. lfixed) call mnrset(0)
+ if (lfreed) then
+ isw(2) = 0
+ dcovar = 1.
+ edm = bigedm
+ isw(4) = 0
+ endif
+ call mnwerr
+ if (isw(5) .gt. 1) call mnprin(5,amin)
+ go to 5000
+c . . . . . . . . . . restore
+ 1000 it = word7(1)
+ if (it.gt.1 .or. it.lt.0) go to 1005
+ lfreed = (npfix .gt. 0)
+ call mnfree(it)
+ if (lfreed) then
+ call mnrset(0)
+ isw(2) = 0
+ dcovar = 1.
+ edm = bigedm
+ endif
+ go to 5000
+ 1005 write (isyswr,'(a,i4)') ' ignored. unknown argument:',it
+ go to 5000
+c . . . . . . . . . . release
+ 1100 ltofix = .false.
+ go to 901
+c . . . . . . . . . . scan . . .
+ 1200 continue
+ iext = word7(1)
+ if (iext .le. 0) go to 1210
+ it2 = 0
+ if (iext .le. nu) it2 = niofex(iext)
+ if (it2 .le. 0) go to 1250
+ 1210 call mnscan(fcn,futil)
+ go to 5000
+ 1250 write (isyswr,'(a,i4,a)') ' parameter',iext,' not variable.'
+ go to 5000
+c . . . . . . . . . . contour
+ 1300 continue
+ ke1 = word7(1)
+ ke2 = word7(2)
+ if (ke1 .eq. 0) then
+ if (npar .eq. 2) then
+ ke1 = nexofi(1)
+ ke2 = nexofi(2)
+ else
+ write (isyswr,'(a,a)') cword,': no parameters requested '
+ go to 5000
+ endif
+ endif
+ nfcnmx = 1000
+ call mncntr(fcn,ke1,ke2,ierrf,futil)
+ ierflg = ierrf
+ go to 5000
+c . . . . . . . . . . hesse
+ 1400 continue
+ call mnhess(fcn,futil)
+ call mnwerr
+ if (isw(5) .ge. 0) call mnprin(2, amin)
+ if (isw(5) .ge. 1) call mnmatu(1)
+ go to 5000
+c . . . . . . . . . . save
+ 1500 continue
+ call mnsave
+ go to 5000
+c . . . . . . . . . . improve
+ 1600 continue
+ call mncuve(fcn,futil)
+ call mnimpr(fcn,futil)
+ if (lnewmn) go to 400
+ go to 5000
+c . . . . . . . . . . call fcn
+ 1700 iflag = word7(1)
+ nparx = npar
+ f = undefi
+ call fcn(nparx,gin,f,u,iflag,futil)
+ nfcn = nfcn + 1
+ nowprt = 0
+ if (f .ne. undefi) then
+ if (amin .eq. undefi) then
+ amin = f
+ nowprt = 1
+ else if (f .lt. amin) then
+ amin = f
+ nowprt = 1
+ endif
+ if (isw(5).ge.0 .and. iflag.le.5 .and. nowprt.eq.1)
+ + call mnprin(5,amin)
+ if (iflag .eq. 3) fval3=f
+ endif
+ if (iflag .gt. 5) call mnrset(1)
+ go to 5000
+c . . . . . . . . . . standard
+ 1800 call stand
+ go to 5000
+c . . . . . . . stop, end, exit
+ 1900 it = plist(1)
+ if (fval3 .eq. amin .or. it .gt. 0) go to 5000
+ iflag = 3
+ write (isyswr,'(/a/)') ' call to user function with iflag = 3'
+ nparx = npar
+ call fcn(nparx,gin,f,u,iflag,futil)
+ nfcn = nfcn + 1
+ go to 5000
+c . . . . . . . . . . clear
+ 2200 continue
+ call mncler
+ if (isw(5) .ge. 1) write (isyswr,'(a)')
+ + ' minuit memory cleared. no parameters now defined.'
+ go to 5000
+c . . . . . . . . . . help
+ 2300 continue
+ if (index(cword,'sho') .gt. 0) go to 700
+ if (index(cword,'set') .gt. 0) go to 700
+ write (isyswr,2301) (cname(isort(i)),i=1,nname),'parameters'
+ 2301 format (' the commands recognized by minuit are:'/6(2x,a10))
+ write (isyswr,'(a)') ' see also: help set and help show'
+ go to 5000
+c . . . . . . . . . . mncontour
+ 2400 continue
+ epsi = 0.05 * up
+ ke1 = word7(1)
+ ke2 = word7(2)
+ if (ke1.eq.0 .and. npar.eq.2) then
+ ke1 = nexofi(1)
+ ke2 = nexofi(2)
+ endif
+ nptu = word7(3)
+ if (nptu .le. 0) nptu=20
+ if (nptu .gt. mxpt) nptu = mxpt
+ nfcnmx = 100*(nptu+5)*(npar+1)
+ call mncont(fcn,ke1,ke2,nptu,xptu,yptu,ierrf,futil)
+ go to 5000
+c . . . . . . . . . . jump
+ 2600 continue
+ step = word7(1)
+ if (step .le. zero) step = 2.
+ rno = 0.
+ izero = 0
+ do 2620 i= 1, npar
+ call mnrn15(rno,izero)
+ rno = 2.0*rno - 1.0
+ 2620 x(i) = x(i) + rno*step*werr(i)
+ call mninex(x)
+ call mnamin(fcn,futil)
+ call mnrset(0)
+ go to 5000
+c . . . . . . . . . . blank line
+ 3300 continue
+ write (isyswr,'(10x,a)') ' blank command ignored.'
+ go to 5000
+c . . . . . . . . obsolete commands . . . . . . . . . . . . . .
+c . . . . . . . . . . covariance
+ 3400 continue
+ write (isyswr, '(a)') ' the "covariance" command is osbsolete.',
+ + ' the covariance matrix is now saved in a different format',
+ + ' with the "save" command and read in with:"set covariance"'
+ go to 5000
+c . . . . . . . . . . printout
+ 3500 continue
+ cneway = 'set print '
+ go to 3100
+c . . . . . . . . . . gradient
+ 3600 continue
+ cneway = 'set grad '
+ go to 3100
+c . . . . . . . . . . matout
+ 3700 continue
+ cneway = 'show covar'
+ go to 3100
+c . . . . . . . . . error def
+ 3800 continue
+ cneway = 'set errdef'
+ go to 3100
+c . . . . . . . . . . limits
+ 3900 continue
+ cneway = 'set limits'
+ go to 3100
+c . . . . . . . . . . punch
+ 4000 continue
+ cneway = 'save '
+c ....... come from obsolete commands
+ 3100 write (isyswr, 3101) cword,cneway
+ 3101 format (' obsolete command:',1x,a10,5x,'please use:',1x,a10)
+ cword = cneway
+ if (cword .eq. 'save ') go to 1500
+ go to 700
+c . . . . . . . . . . . . . . . . . .
+ 5000 return
+ end
+cdeck id>, mnexin.
+ subroutine mnexin(pint)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc transforms the external parameter values u to internal
+cc values in the dense array pint. subroutine mnpint is used.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ dimension pint(*)
+ limset = .false.
+ do 100 iint= 1, npar
+ iext = nexofi(iint)
+ call mnpint(u(iext),iext,pinti)
+ pint(iint) = pinti
+ 100 continue
+ return
+ end
+cdeck id>, mnfixp.
+ subroutine mnfixp(iint,ierr)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc removes parameter iint from the internal (variable) parameter
+cc list, and arranges the rest of the list to fill the hole.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ dimension yy(mni)
+c first see if it can be done
+ ierr = 0
+ if (iint.gt.npar .or. iint.le.0) then
+ ierr = 1
+ write (isyswr,'(a,i4)')
+ + ' minuit error. argument to mnfixp=',iint
+ go to 300
+ endif
+ iext = nexofi(iint)
+ if (npfix .ge. mni) then
+ ierr = 1
+ write (isyswr,'(a,i4,a,i4)') ' minuit cannot fix parameter',
+ + iext,' maximum number that can be fixed is',mni
+ go to 300
+ endif
+c reduce number of variable parameters by one
+ niofex(iext) = 0
+ nold = npar
+ npar = npar - 1
+c save values in case parameter is later restored
+ npfix = npfix + 1
+ ipfix(npfix) = iext
+ lc = iint
+ xs(npfix) = x(lc)
+ xts(npfix) = xt(lc)
+ dirins(npfix) = werr(lc)
+ grds(npfix) = grd(lc)
+ g2s(npfix) = g2(lc)
+ gsteps(npfix) = gstep(lc)
+c shift values for other parameters to fill hole
+ do 100 ik= iext+1, nu
+ if (niofex(ik) .gt. 0) then
+ lc = niofex(ik) - 1
+ niofex(ik) = lc
+ nexofi(lc) = ik
+ x(lc) = x(lc+1)
+ xt(lc) = xt(lc+1)
+ dirin(lc) = dirin(lc+1)
+ werr(lc) = werr(lc+1)
+ grd(lc) = grd(lc+1)
+ g2(lc) = g2(lc+1)
+ gstep(lc) = gstep(lc+1)
+ endif
+ 100 continue
+ if (isw(2) .le. 0) go to 300
+c remove one row and one column from variance matrix
+ if (npar .le. 0) go to 300
+ do 260 i= 1, nold
+ m = max(i,iint)
+ n = min(i,iint)
+ ndex = m*(m-1)/2 + n
+ 260 yy(i)=vhmat(ndex)
+ yyover = 1.0/yy(iint)
+ knew = 0
+ kold = 0
+ do 294 i= 1, nold
+ do 292 j= 1, i
+ kold = kold + 1
+ if (j.eq.iint .or. i.eq.iint) go to 292
+ knew = knew + 1
+ vhmat(knew) = vhmat(kold) - yy(j)*yy(i)*yyover
+ 292 continue
+ 294 continue
+ 300 return
+ end
+cdeck id>, mnfree.
+ subroutine mnfree(k)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc restores one or more fixed parameter(s) to variable status
+cc by inserting it into the internal parameter list at the
+cc appropriate place.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+c-- k = 0 means restore all parameters
+c-- k = 1 means restore the last parameter fixed
+c-- k = -i means restore external parameter i (if possible)
+c-- iq = fix-location where internal parameters were stored
+c-- ir = external number of parameter being restored
+c-- is = internal number of parameter being restored
+ if (k .gt. 1) write (isyswr,510)
+ if (npfix .lt. 1) write (isyswr,500)
+ if (k.eq.1 .or. k.eq.0) go to 40
+c release parameter with specified external number
+ ka = iabs(k)
+ if (niofex(ka) .eq. 0) go to 15
+ write (isyswr,540)
+ 540 format (' ignored. parameter specified is already variable.')
+ return
+ 15 if (npfix .lt. 1) go to 21
+ do 20 ik= 1, npfix
+ if (ipfix(ik) .eq. ka) go to 24
+ 20 continue
+ 21 write (isyswr,530) ka
+ 530 format (' parameter',i4,' not fixed. cannot be released.')
+ return
+ 24 if (ik .eq. npfix) go to 40
+c move specified parameter to end of list
+ ipsav = ka
+ xv = xs(ik)
+ xtv = xts(ik)
+ dirinv = dirins(ik)
+ grdv = grds(ik)
+ g2v = g2s(ik)
+ gstepv = gsteps(ik)
+ do 30 i= ik+1,npfix
+ ipfix(i-1) = ipfix(i)
+ xs(i-1) = xs(i)
+ xts(i-1) = xts(i)
+ dirins(i-1) = dirins(i)
+ grds(i-1) = grds(i)
+ g2s(i-1) = g2s(i)
+ gsteps(i-1) = gsteps(i)
+ 30 continue
+ ipfix(npfix) = ipsav
+ xs(npfix) = xv
+ xts(npfix) = xtv
+ dirins(npfix) = dirinv
+ grds(npfix) = grdv
+ g2s(npfix) = g2v
+ gsteps(npfix) = gstepv
+c restore last parameter in fixed list -- ipfix(npfix)
+ 40 continue
+ if (npfix .lt. 1) go to 300
+ ir = ipfix(npfix)
+ is = 0
+ do 100 ik= nu, ir, -1
+ if (niofex(ik) .gt. 0) then
+ lc = niofex(ik) + 1
+ is = lc - 1
+ niofex(ik) = lc
+ nexofi(lc) = ik
+ x(lc) = x(lc-1)
+ xt(lc) = xt(lc-1)
+ dirin(lc) = dirin(lc-1)
+ werr(lc) = werr(lc-1)
+ grd(lc) = grd(lc-1)
+ g2(lc) = g2(lc-1)
+ gstep(lc) = gstep(lc-1)
+ endif
+ 100 continue
+ npar = npar + 1
+ if (is .eq. 0) is = npar
+ niofex(ir) = is
+ nexofi(is) = ir
+ iq = npfix
+ x(is) = xs(iq)
+ xt(is) = xts(iq)
+ dirin(is) = dirins(iq)
+ werr(is) = dirins(iq)
+ grd(is) = grds(iq)
+ g2(is) = g2s(iq)
+ gstep(is) = gsteps(iq)
+ npfix = npfix - 1
+ isw(2) = 0
+ dcovar = 1.
+ if (itaur .lt. 1) write(isyswr,520) ir,cpnam(ir)
+ if (k.eq.0) go to 40
+ 300 continue
+c if different from internal, external values are taken
+ call mnexin(x)
+ 400 return
+ 500 format (' call to mnfree ignored. there are no fixed pa',
+ + 'rameters'/)
+ 510 format (' call to mnfree ignored. argument greater than one'/)
+ 520 format (20x, 9hparameter,i4,2h, ,a10,' restored to variable.')
+ end
+cdeck id>, mngrad.
+ subroutine mngrad(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called from mnset
+cc interprets the set grad command, which informs minuit whether
+cc the first derivatives of fcn will be calculated by the user
+cc inside fcn. it can check the user's derivative calculation
+cc by comparing it with a finite difference approximation.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+c
+ external fcn,futil
+ character*4 cgood,cbad,cnone,cwd
+ logical lnone
+ dimension gf(mni)
+ parameter (cgood='good',cbad=' bad',cnone='none')
+c
+ isw(3) = 1
+ nparx = npar
+ if (word7(1) .gt. zero) go to 2000
+c get user-calculated first derivatives from fcn
+ do 30 i= 1, nu
+ 30 gin(i) = undefi
+ call mninex(x)
+ call fcn(nparx,gin,fzero,u,2,futil)
+ nfcn = nfcn + 1
+ call mnderi(fcn,futil)
+ do 40 i= 1, npar
+ 40 gf(i) = grd(i)
+c get minuit-calculated first derivatives
+ isw(3) = 0
+ istsav = istrat
+ istrat = 2
+ call mnhes1(fcn,futil)
+ istrat = istsav
+ write (isyswr,51)
+ 51 format(/' check of gradient calculation in fcn'/12x,'parameter',
+ + 6x,9hg(in fcn) ,3x,9hg(minuit) ,2x,'dg(minuit)',3x,9hagreement)
+ isw(3) = 1
+ lnone = .false.
+ do 100 lc = 1, npar
+ i = nexofi(lc)
+ cwd = cgood
+ err = dgrd(lc)
+ if (abs(gf(lc)-grd(lc)) .gt. err) cwd = cbad
+ if (gin(i) .eq. undefi) then
+ cwd = cnone
+ lnone = .true.
+ gf(lc) = 0.
+ endif
+ if (cwd .ne. cgood) isw(3) = 0
+ write (isyswr,99) i,cpnam(i),gf(lc),grd(lc),err,cwd
+ 99 format (7x,i5,2x ,a10,3e12.4,4x ,a4)
+ 100 continue
+ if (lnone) write (isyswr,'(a)')
+ + ' agreement=none means fcn did not calculate the derivative'
+ if (isw(3) .eq. 0) write (isyswr,1003)
+ 1003 format(/' minuit does not accept derivative calculations by fcn'/
+ + ' to force acceptance, enter "set grad 1"'/)
+c
+ 2000 continue
+ return
+ end
+cdeck id>, mnhess.
+ subroutine mnhess(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc calculates the full second-derivative matrix of fcn
+cc by taking finite differences. when calculating diagonal
+cc elements, it may iterate so that step size is nearly that
+cc which gives function change= up/10. the first derivatives
+cc of course come as a free side effect, but with a smaller
+cc step size in order to obtain a known accuracy.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ dimension yy(mni)
+ logical ldebug
+ character cbf1*22
+c
+ ldebug = (idbg(3) .ge. 1)
+ if (amin .eq. undefi) call mnamin(fcn,futil)
+ if (istrat .le. 0) then
+ ncyc = 3
+ tlrstp = 0.5
+ tlrg2 = 0.1
+ else if (istrat .eq. 1) then
+ ncyc = 5
+ tlrstp = 0.3
+ tlrg2 = 0.05
+ else
+ ncyc = 7
+ tlrstp = 0.1
+ tlrg2 = 0.02
+ endif
+ if (isw(5).ge.2 .or. ldebug) write (isyswr,'(a)')
+ + ' start covariance matrix calculation.'
+ cfrom = 'hesse '
+ nfcnfr = nfcn
+ cstatu= 'ok '
+ npard = npar
+c make sure starting at the right place
+ call mninex(x)
+ nparx = npar
+ call fcn(nparx,gin,fs1,u,4,futil)
+ nfcn = nfcn + 1
+ if (fs1 .ne. amin) then
+ df = amin - fs1
+ write (cbf1(1:12),'(g12.3)') df
+ call mnwarn('d','mnhess',
+ + 'function value differs from amin by '//cbf1(1:12) )
+ endif
+ amin = fs1
+ if (ldebug) write (isyswr,'(a,a)') ' par d gstep ',
+ +' d g2 grd sag '
+c . . . . . . diagonal elements .
+c isw(2) = 1 if approx, 2 if not posdef, 3 if ok
+c aimsag is the sagitta we are aiming for in second deriv calc.
+ aimsag = dsqrt(epsma2)*(abs(amin)+up)
+c zero the second derivative matrix
+ npar2 = npar*(npar+1)/2
+ do 10 i= 1,npar2
+ 10 vhmat(i) = 0.
+c
+c loop over variable parameters for second derivatives
+ idrv = 2
+ do 100 id= 1, npard
+ i = id + npar - npard
+ if (g2(i) .eq. zero) then
+ call mnwarn('d','mnhess',
+ + 'a second derivative is zero on entering.')
+ wint = werr(i)
+ iext = nexofi(i)
+ if (nvarl(iext) .gt. 1) then
+ call mndxdi(x(i),i,dxdi)
+ if (abs(dxdi) .lt. .001) then
+ wint = .01
+ else
+ wint = wint/abs(dxdi)
+ endif
+ endif
+ g2(i) = up/wint**2
+ endif
+ xtf = x(i)
+ dmin = 8.*epsma2*abs(xtf)
+c
+c find step which gives sagitta = aimsag
+ d = abs(gstep(i))
+ do 40 icyc= 1, ncyc
+c loop here only if sag=0.
+ do 25 multpy= 1, 5
+c take two steps
+ x(i) = xtf + d
+ call mninex(x)
+ nparx = npar
+ call fcn(nparx,gin,fs1,u,4,futil)
+ nfcn = nfcn + 1
+ x(i) = xtf - d
+ call mninex(x)
+ call fcn(nparx,gin,fs2,u,4,futil)
+ nfcn = nfcn + 1
+ x(i) = xtf
+ sag = 0.5*(fs1+fs2-2.0*amin)
+ if (sag .ne. zero) go to 30
+ if (gstep(i) .lt. zero) then
+ if (d .ge. .5) go to 26
+ d = 10.*d
+ if (d .gt. 0.5) d = 0.51
+ go to 25
+ endif
+ d = 10.*d
+ 25 continue
+ 26 write (cbf1(1:4),'(i4)') iext
+ call mnwarn('w','hesse',
+ + 'second derivative zero for parameter'//cbf1(1:4) )
+ go to 390
+c sag is not zero
+ 30 g2bfor = g2(i)
+ g2(i) = 2.*sag/d**2
+ grd(i) = (fs1-fs2)/(2.*d)
+ if (ldebug) write (isyswr,31) i,idrv,gstep(i),d,g2(i),grd(i),sag
+ 31 format (i4,i2,6g12.5)
+ gstep(i) = sign(d,gstep(i))
+ dirin(i) = d
+ yy(i) = fs1
+ dlast = d
+ d = dsqrt(2.0*aimsag/abs(g2(i)))
+c if parameter has limits, max int step size = 0.5
+ stpinm = 0.5
+ if (gstep(i) .lt. zero) d = min(d,stpinm)
+ if (d .lt. dmin) d = dmin
+c see if converged
+ if (abs((d-dlast)/d) .lt. tlrstp) go to 50
+ if (abs((g2(i)-g2bfor)/g2(i)) .lt. tlrg2 ) go to 50
+ d = min(d, 10.*dlast)
+ d = max(d, 0.1*dlast)
+ 40 continue
+c end of step size loop
+ write (cbf1,'(i2,2e10.2)') iext,sag,aimsag
+ call mnwarn('d','mnhess','second deriv. sag,aim= '//cbf1)
+c
+ 50 continue
+ ndex = i*(i+1)/2
+ vhmat(ndex) = g2(i)
+ 100 continue
+c end of diagonal second derivative loop
+ call mninex(x)
+c refine the first derivatives
+ if (istrat .gt. 0) call mnhes1(fcn,futil)
+ isw(2) = 3
+ dcovar = 0.
+c . . . . off-diagonal elements
+ if (npar .eq. 1) go to 214
+ do 200 i= 1, npar
+ do 180 j= 1, i-1
+ xti = x(i)
+ xtj = x(j)
+ x(i) = xti + dirin(i)
+ x(j) = xtj + dirin(j)
+ call mninex(x)
+ call fcn(nparx,gin,fs1,u,4,futil)
+ nfcn = nfcn + 1
+ x(i) = xti
+ x(j) = xtj
+ elem = (fs1+amin-yy(i)-yy(j)) / (dirin(i)*dirin(j))
+ ndex = i*(i-1)/2 + j
+ vhmat(ndex) = elem
+ 180 continue
+ 200 continue
+ 214 call mninex(x)
+c verify matrix positive-definite
+ call mnpsdf
+ do 220 i= 1, npar
+ do 219 j= 1, i
+ ndex = i*(i-1)/2 + j
+ p(i,j) = vhmat(ndex)
+ 219 p(j,i) = p(i,j)
+ 220 continue
+ call mnvert(p,maxint,maxint,npar,ifail)
+ if (ifail .gt. 0) then
+ call mnwarn('w','hesse', 'matrix inversion fails.')
+ go to 390
+ endif
+c . . . . . . . calculate e d m
+ edm = 0.
+ do 230 i= 1, npar
+c off-diagonal elements
+ ndex = i*(i-1)/2
+ do 225 j= 1, i-1
+ ndex = ndex + 1
+ ztemp = 2.0 * p(i,j)
+ edm = edm + grd(i)*ztemp*grd(j)
+ 225 vhmat(ndex) = ztemp
+c diagonal elements
+ ndex = ndex + 1
+ vhmat(ndex) = 2.0 * p(i,i)
+ edm = edm + p(i,i) * grd(i)**2
+ 230 continue
+ if (isw(5).ge.1 .and. isw(2).eq.3 .and. itaur.eq.0)
+ + write(isyswr,'(a)')' covariance matrix calculated successfully'
+ go to 900
+c failure to invert 2nd deriv matrix
+ 390 isw(2) = 1
+ dcovar = 1.
+ cstatu = 'failed '
+ if (isw(5) .ge. 0) write (isyswr,'(a)')
+ + ' mnhess fails and will return diagonal matrix. '
+ do 395 i= 1, npar
+ ndex = i*(i-1)/2
+ do 394 j= 1, i-1
+ ndex = ndex + 1
+ 394 vhmat(ndex) = 0.0
+ ndex = ndex +1
+ g2i = g2(i)
+ if (g2i .le. zero) g2i = 1.0
+ 395 vhmat(ndex) = 2.0/g2i
+ 900 return
+ end
+cdeck id>, mnhes1.
+ subroutine mnhes1(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called from mnhess and mngrad
+cc calculate first derivatives (grd) and uncertainties (dgrd)
+cc and appropriate step sizes gstep
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ logical ldebug
+ character cbf1*22
+ ldebug = (idbg(5) .ge. 1)
+ if (istrat .le. 0) ncyc = 1
+ if (istrat .eq. 1) ncyc = 2
+ if (istrat .gt. 1) ncyc = 6
+ idrv = 1
+ nparx = npar
+ dfmin = 4.*epsma2*(abs(amin)+up)
+c main loop over parameters
+ do 100 i= 1, npar
+ xtf = x(i)
+ dmin = 4.*epsma2*abs(xtf)
+ epspri = epsma2 + abs(grd(i)*epsma2)
+ optstp = dsqrt(dfmin/(abs(g2(i))+epspri))
+ d = 0.2 * abs(gstep(i))
+ if (d .gt. optstp) d = optstp
+ if (d .lt. dmin) d = dmin
+ chgold = 10000.
+c iterate reducing step size
+ do 50 icyc= 1, ncyc
+ x(i) = xtf + d
+ call mninex(x)
+ call fcn(nparx,gin,fs1,u,4,futil)
+ nfcn = nfcn + 1
+ x(i) = xtf - d
+ call mninex(x)
+ call fcn(nparx,gin,fs2,u,4,futil)
+ nfcn = nfcn + 1
+ x(i) = xtf
+c check if step sizes appropriate
+ sag = 0.5*(fs1+fs2-2.0*amin)
+ grdold = grd(i)
+ grdnew = (fs1-fs2)/(2.0*d)
+ dgmin = epsmac*(abs(fs1)+abs(fs2))/d
+ if (ldebug) write (isyswr,11) i,idrv,gstep(i),d,g2(i),grdnew,sag
+ 11 format (i4,i2,6g12.5)
+ if (grdnew .eq. zero) go to 60
+ change = abs((grdold-grdnew)/grdnew)
+ if (change.gt.chgold .and. icyc.gt.1) go to 60
+ chgold = change
+ grd(i) = grdnew
+ gstep(i) = sign(d,gstep(i))
+c decrease step until first derivative changes by <5%
+ if (change .lt. 0.05) go to 60
+ if (abs(grdold-grdnew) .lt. dgmin) go to 60
+ if (d .lt. dmin) then
+ call mnwarn('d','mnhes1','step size too small for 1st drv.')
+ go to 60
+ endif
+ d = 0.2*d
+ 50 continue
+c loop satisfied = too many iter
+ write (cbf1,'(2g11.3)') grdold,grdnew
+ call mnwarn('d','mnhes1','too many iterations on d1.'//cbf1)
+ 60 continue
+ dgrd(i) = max(dgmin,abs(grdold-grdnew))
+ 100 continue
+c end of first deriv. loop
+ call mninex(x)
+ return
+ end
+cdeck id>, mnimpr.
+ subroutine mnimpr(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc attempts to improve on a good local minimum by finding a
+cc better one. the quadratic part of fcn is removed by mncalf
+cc and this transformed function is minimized using the simplex
+cc method from several random starting points.
+cc ref. -- goldstein and price, math.comp. 25, 569 (1971)
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ dimension dsav(mni), y(mni+1)
+ parameter (alpha=1.,beta=0.5,gamma=2.0)
+ data rnum/0./
+ if (npar .le. 0) return
+ if (amin .eq. undefi) call mnamin(fcn,futil)
+ cstatu = 'unchanged '
+ itaur = 1
+ epsi = 0.1*up
+ npfn=nfcn
+ nloop = word7(2)
+ if (nloop .le. 0) nloop = npar + 4
+ nparx = npar
+ nparp1=npar+1
+ wg = 1.0/float(npar)
+ sigsav = edm
+ apsi = amin
+ do 2 i= 1, npar
+ xt(i) = x(i)
+ dsav(i) = werr(i)
+ do 2 j = 1, i
+ ndex = i*(i-1)/2 + j
+ p(i,j) = vhmat(ndex)
+ 2 p(j,i) = p(i,j)
+ call mnvert(p,maxint,maxint,npar,ifail)
+ if (ifail .ge. 1) go to 280
+c save inverted matrix in vt
+ do 12 i= 1, npar
+ ndex = i*(i-1)/2
+ do 12 j= 1, i
+ ndex = ndex + 1
+ 12 vthmat(ndex) = p(i,j)
+ loop = 0
+c
+ 20 continue
+ do 25 i= 1, npar
+ dirin(i) = 2.0*dsav(i)
+ call mnrn15(rnum,iseed)
+ 25 x(i) = xt(i) + 2.0*dirin(i)*(rnum-0.5)
+ loop = loop + 1
+ reg = 2.0
+ if (isw(5) .ge. 0) write (isyswr, 1040) loop
+ 30 call mncalf(fcn,x,ycalf,futil)
+ amin = ycalf
+c . . . . set up random simplex
+ jl = nparp1
+ jh = nparp1
+ y(nparp1) = amin
+ amax = amin
+ do 45 i= 1, npar
+ xi = x(i)
+ call mnrn15(rnum,iseed)
+ x(i) = xi - dirin(i) *(rnum-0.5)
+ call mncalf(fcn,x,ycalf,futil)
+ y(i) = ycalf
+ if (y(i) .lt. amin) then
+ amin = y(i)
+ jl = i
+ else if (y(i) .gt. amax) then
+ amax = y(i)
+ jh = i
+ endif
+ do 40 j= 1, npar
+ 40 p(j,i) = x(j)
+ p(i,nparp1) = xi
+ x(i) = xi
+ 45 continue
+c
+ edm = amin
+ sig2 = edm
+c . . . . . . . start main loop
+ 50 continue
+ if (amin .lt. zero) go to 95
+ if (isw(2) .le. 2) go to 280
+ ep = 0.1*amin
+ if (sig2 .lt. ep .and. edm.lt.ep ) go to 100
+ sig2 = edm
+ if ((nfcn-npfn) .gt. nfcnmx) go to 300
+c calculate new point * by reflection
+ do 60 i= 1, npar
+ pb = 0.
+ do 59 j= 1, nparp1
+ 59 pb = pb + wg * p(i,j)
+ pbar(i) = pb - wg * p(i,jh)
+ 60 pstar(i)=(1.+alpha)*pbar(i)-alpha*p(i,jh)
+ call mncalf(fcn,pstar,ycalf,futil)
+ ystar = ycalf
+ if(ystar.ge.amin) go to 70
+c point * better than jl, calculate new point **
+ do 61 i=1,npar
+ 61 pstst(i)=gamma*pstar(i)+(1.-gamma)*pbar(i)
+ call mncalf(fcn,pstst,ycalf,futil)
+ ystst = ycalf
+ 66 if (ystst .lt. y(jl)) go to 67
+ call mnrazz(ystar,pstar,y,jh,jl)
+ go to 50
+ 67 call mnrazz(ystst,pstst,y,jh,jl)
+ go to 50
+c point * is not as good as jl
+ 70 if (ystar .ge. y(jh)) go to 73
+ jhold = jh
+ call mnrazz(ystar,pstar,y,jh,jl)
+ if (jhold .ne. jh) go to 50
+c calculate new point **
+ 73 do 74 i=1,npar
+ 74 pstst(i)=beta*p(i,jh)+(1.-beta)*pbar(i)
+ call mncalf(fcn,pstst,ycalf,futil)
+ ystst = ycalf
+ if(ystst.gt.y(jh)) go to 30
+c point ** is better than jh
+ if (ystst .lt. amin) go to 67
+ call mnrazz(ystst,pstst,y,jh,jl)
+ go to 50
+c . . . . . . end main loop
+ 95 if (isw(5) .ge. 0) write (isyswr,1000)
+ reg = 0.1
+c . . . . . ask if point is new
+ 100 call mninex(x)
+ call fcn(nparx,gin,amin,u,4,futil)
+ nfcn = nfcn + 1
+ do 120 i= 1, npar
+ dirin(i) = reg*dsav(i)
+ if (abs(x(i)-xt(i)) .gt. dirin(i)) go to 150
+ 120 continue
+ go to 230
+ 150 nfcnmx = nfcnmx + npfn - nfcn
+ npfn = nfcn
+ call mnsimp(fcn,futil)
+ if (amin .ge. apsi) go to 325
+ do 220 i= 1, npar
+ dirin(i) = 0.1 *dsav(i)
+ if (abs(x(i)-xt(i)) .gt. dirin(i)) go to 250
+ 220 continue
+ 230 if (amin .lt. apsi) go to 350
+ go to 325
+c . . . . . . truly new minimum
+ 250 lnewmn = .true.
+ if (isw(2) .ge. 1) then
+ isw(2) = 1
+ dcovar = max(dcovar,half)
+ else
+ dcovar = 1.
+ endif
+ itaur = 0
+ nfcnmx = nfcnmx + npfn - nfcn
+ cstatu = 'new minimu'
+ if (isw(5) .ge. 0) write (isyswr,1030)
+ return
+c . . . return to previous region
+ 280 if (isw(5) .gt. 0) write (isyswr,1020)
+ go to 325
+ 300 isw(1) = 1
+ 325 do 330 i= 1, npar
+ dirin(i) = 0.01*dsav(i)
+ 330 x(i) = xt(i)
+ amin = apsi
+ edm = sigsav
+ 350 call mninex(x)
+ if (isw(5) .gt. 0) write (isyswr,1010)
+ cstatu= 'unchanged '
+ call mnrset(0)
+ if (isw(2) .lt. 2) go to 380
+ if (loop .lt. nloop .and. isw(1) .lt. 1) go to 20
+ 380 call mnprin (5,amin)
+ itaur = 0
+ return
+ 1000 format (54h an improvement on the previous minimum has been found)
+ 1010 format (51h improve has returned to region of original minimum)
+ 1020 format (/44h covariance matrix was not positive-definite)
+ 1030 format (/38h improve has found a truly new minimum/1h ,37(1h*)/)
+ 1040 format (/18h start attempt no.,i2, 20h to find new minimum)
+ end
+cdeck id>, mninex.
+ subroutine mninex(pint)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc transforms from internal coordinates (pint) to external
+cc parameters (u). the minimizing routines which work in
+cc internal coordinates call this routine before calling fcn.
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ dimension pint(*)
+ do 100 j= 1, npar
+ i = nexofi(j)
+ if (nvarl(i) .eq. 1) then
+ u(i) = pint(j)
+ else
+ u(i) = alim(i) + 0.5*(dsin(pint(j)) +1.0) * (blim(i)-alim(i))
+ endif
+ 100 continue
+ return
+ end
+cdeck id>, mninit.
+ subroutine mninit (i1,i2,i3)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc this is the main initialization subroutine for minuit
+cc it initializes some constants in common
+cc (including the logical i/o unit nos.),
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+c
+ external intrac
+ logical intrac
+c i/o unit numbers
+ isysrd = i1
+ isyswr = i2
+ istkwr(1) = isyswr
+ nstkwr = 1
+ isyssa = i3
+ nstkrd = 0
+c version identifier
+ cvrsn = '90.10 '
+c some constant constants in common
+ maxint=mni
+ maxext=mne
+ undefi = -54321.
+ bigedm = 123456.
+ cundef = ')undefined'
+ covmes(0) = 'no error matrix '
+ covmes(1) = 'err matrix approximate'
+ covmes(2) = 'err matrix not pos-def'
+ covmes(3) = 'error matrix accurate '
+c some starting values in common
+ nblock = 0
+ icomnd = 0
+ ctitl = cundef
+ cfrom = 'input '
+ nfcnfr = nfcn
+ cstatu= 'initialize'
+ isw(3) = 0
+ isw(4) = 0
+ isw(5) = 1
+c isw(6)=0 for batch jobs, =1 for interactive jobs
+ isw(6) = 0
+ if (intrac(dummy)) isw(6) = 1
+c debug options set to default values
+ do 10 idb= 0, maxdbg
+ 10 idbg(idb) = 0
+ lrepor = .false.
+ lwarn = .true.
+ limset = .false.
+ lnewmn = .false.
+ istrat = 1
+ itaur = 0
+c default page dimensions and 'new page' carriage control integer
+ npagwd = 120
+ npagln = 56
+ newpag = 1
+ if (isw(6) .gt. 0) then
+ npagwd = 80
+ npagln = 30
+ newpag = 0
+ endif
+ up = 1.0
+ updflt = up
+c determine machine accuracy epsmac
+ epstry = 0.5
+ do 33 i= 1, 100
+ epstry = epstry * 0.5
+ epsp1 = one + epstry
+ call mntiny(epsp1, epsbak)
+ if (epsbak .lt. epstry) go to 35
+ 33 continue
+ epstry = 1.0e-7
+ epsmac = 4.0*epstry
+ write (isyswr,'(a,a,e10.2)') ' mninit unable to determine',
+ + ' arithmetic precision. will assume:',epsmac
+ 35 epsmac = 8.0 * epstry
+ epsma2 = 2.0 * dsqrt(epsmac)
+c the vlims are a non-negligible distance from pi/2
+c used by mnpint to set variables "near" the physical limits
+ piby2 = 2.0*atan(1.0)
+ distnn = 8.0*dsqrt(epsma2)
+ vlimhi = piby2 - distnn
+ vlimlo = -piby2 + distnn
+ call mncler
+ write (isyswr,'(3a,i3,a,i3,a,e10.2)') ' minuit release ',cvrsn,
+ +' initialized. dimensions ',mne,'/',mni,' epsmac=',epsmac
+ return
+ end
+cdeck id>, mnintr.
+ subroutine mnintr(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called by user. interfaces to mnread to allow user to change
+cc easily from fortran-callable to interactive mode.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ iflgin = 3
+ call mnread(fcn,iflgin,iflgut,futil)
+ write (isyswr,'(2a/)') ' end of minuit command input. ',
+ + ' return to user program.'
+ return
+ end
+cdeck id>, mnlims.
+ subroutine mnlims(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called from mnset
+cc interprets the set lim command, to reset the parameter limits
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+c
+ cfrom = 'set lim '
+ nfcnfr = nfcn
+ cstatu= 'no change '
+ i2 = word7(1)
+ if (i2 .gt. maxext .or. i2 .lt. 0) go to 900
+ if (i2 .gt. 0) go to 30
+c set limits on all parameters
+ newcod = 4
+ if (word7(2) .eq. word7(3)) newcod = 1
+ do 20 inu= 1, nu
+ if (nvarl(inu) .le. 0) go to 20
+ if (nvarl(inu).eq.1 .and. newcod.eq.1) go to 20
+ kint = niofex(inu)
+c see if parameter has been fixed
+ if (kint .le. 0) then
+ if (isw(5) .ge. 0) write (isyswr,'(11x,a,i3)')
+ + ' limits not changed for fixed parameter:',inu
+ go to 20
+ endif
+ if (newcod .eq. 1) then
+c remove limits from parameter
+ if (isw(5) .gt. 0) write (isyswr,134) inu
+ cstatu = 'new limits'
+ call mndxdi(x(kint),kint,dxdi)
+ snew = gstep(kint)*dxdi
+ gstep(kint) = abs(snew)
+ nvarl(inu) = 1
+ else
+c put limits on parameter
+ alim(inu) = min(word7(2),word7(3))
+ blim(inu) = max(word7(2),word7(3))
+ if (isw(5) .gt. 0) write (isyswr,237) inu,alim(inu),blim(inu)
+ nvarl(inu) = 4
+ cstatu = 'new limits'
+ gstep(kint) = -0.1
+ endif
+ 20 continue
+ go to 900
+c set limits on one parameter
+ 30 if (nvarl(i2) .le. 0) then
+ write (isyswr,'(a,i3,a)') ' parameter ',i2,' is not variable.'
+ go to 900
+ endif
+ kint = niofex(i2)
+c see if parameter was fixed
+ if (kint .eq. 0) then
+ write (isyswr,'(a,i3)')
+ + ' request to change limits on fixed parameter:',i2
+ do 82 ifx= 1, npfix
+ if (i2 .eq. ipfix(ifx)) go to 92
+ 82 continue
+ write (isyswr,'(a)') ' minuit bug in mnlims. see f. james'
+ 92 continue
+ endif
+ if (word7(2) .ne. word7(3)) go to 235
+c remove limits
+ if (nvarl(i2) .ne. 1) then
+ if (isw(5) .gt. 0) write (isyswr,134) i2
+ 134 format (30h limits removed from parameter ,i4)
+ cstatu = 'new limits'
+ if (kint .le. 0) then
+ gsteps(ifx) = abs(gsteps(ifx))
+ else
+ call mndxdi(x(kint),kint,dxdi)
+ if (abs(dxdi) .lt. 0.01) dxdi=0.01
+ gstep(kint) = abs(gstep(kint)*dxdi)
+ grd(kint) = grd(kint)*dxdi
+ endif
+ nvarl(i2) = 1
+ else
+ write (isyswr,'(a,i3)') ' no limits specified. parameter ',
+ + i2,' is already unlimited. no change.'
+ endif
+ go to 900
+c put on limits
+ 235 alim(i2) = min(word7(2),word7(3))
+ blim(i2) = max(word7(2),word7(3))
+ nvarl(i2) = 4
+ if (isw(5) .gt. 0) write (isyswr,237) i2,alim(i2),blim(i2)
+ 237 format (10h parameter ,i3, 14h limits set to ,2g15.5)
+ cstatu = 'new limits'
+ if (kint .le. 0) then
+ gsteps(ifx) = -0.1
+ else
+ gstep(kint) = -0.1
+ endif
+c
+ 900 continue
+ if (cstatu .ne. 'no change ') then
+ call mnexin(x)
+ call mnrset(1)
+ endif
+ return
+ end
+cdeck id>, mnline.
+ subroutine mnline(fcn,start,fstart,step,slope,toler,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc perform a line search from position start
+cc along direction step, where the length of vector step
+cc gives the expected position of minimum.
+cc fstart is value of function at start
+cc slope (if non-zero) is df/dx along step at start
+cc toler is initial tolerance of minimum in direction step
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ dimension start(*), step(*)
+ parameter (maxpt=12)
+ dimension xpq(maxpt),ypq(maxpt)
+ character*1 chpq(maxpt)
+ dimension xvals(3),fvals(3),coeff(3)
+ character*26 charal
+ character*60 cmess
+ parameter (slambg=5.,alpha=2.)
+c slambg and alpha control the maximum individual steps allowed.
+c the first step is always =1. the max length of second step is slambg.
+c the max size of subsequent steps is the maximum previous successful
+c step multiplied by alpha + the size of most recent successful step,
+c but cannot be smaller than slambg.
+ logical ldebug
+ data charal / 'abcdefghijklmnopqrstuvwxyz' /
+ ldebug = (idbg(1).ge.1)
+c starting values for overall limits on total step slam
+ overal = 1000.
+ undral = -100.
+c debug check if start is ok
+ if (ldebug) then
+ call mninex(start)
+ call fcn(nparx,gin,f1,u,4,futil)
+ nfcn=nfcn+1
+ if (f1 .ne. fstart) then
+ write (isyswr,'(a/2e14.5/2x,10f10.5)')
+ + ' mnline start point not consistent, f values, parameters=',
+ + (x(kk),kk=1,npar)
+ endif
+ endif
+c . set up linear search along step
+
+ fvmin = fstart
+ xvmin = 0.
+ nxypt = 1
+ chpq(1) = charal(1:1)
+ xpq(1) = 0.
+ ypq(1) = fstart
+c slamin = smallest possible value of abs(slam)
+ slamin = 0.
+ do 20 i= 1, npar
+ if (step(i) .eq. zero) go to 20
+ ratio = abs(start(i)/step(i))
+ if (slamin .eq. zero) slamin = ratio
+ if (ratio .lt. slamin) slamin = ratio
+ 20 x(i) = start(i) + step(i)
+ if (slamin .eq. zero) slamin = epsmac
+ slamin = slamin*epsma2
+ nparx = npar
+c
+ call mninex(x)
+ call fcn(nparx,gin,f1,u,4,futil)
+ nfcn=nfcn+1
+ nxypt = nxypt + 1
+ chpq(nxypt) = charal(nxypt:nxypt)
+ xpq(nxypt) = 1.
+ ypq(nxypt) = f1
+ if (f1 .lt. fstart) then
+ fvmin = f1
+ xvmin = 1.0
+ endif
+c . quadr interp using slope gdel and two points
+ slam = 1.
+ toler8 = toler
+ slamax = slambg
+ flast = f1
+c can iterate on two-points (cut) if no imprvmnt
+ 25 continue
+ denom = 2.0*(flast-fstart-slope*slam)/slam**2
+c if (denom .eq. zero) denom = -0.1*slope
+ slam = 1.
+ if (denom .ne. zero) slam = -slope/denom
+ if (slam .lt. zero) slam = slamax
+ if (slam .gt. slamax) slam = slamax
+ if (slam .lt. toler8) slam = toler8
+ if (slam .lt. slamin) go to 80
+ if (abs(slam-1.0).lt.toler8 .and. f1.lt.fstart) go to 70
+ if (abs(slam-1.0).lt.toler8) slam = 1.0+toler8
+ if (nxypt .ge. maxpt) go to 65
+ do 30 i= 1, npar
+ 30 x(i) = start(i) + slam*step(i)
+ call mninex(x)
+ call fcn(npar,gin,f2,u,4,futil)
+ nfcn = nfcn + 1
+ nxypt = nxypt + 1
+ chpq(nxypt) = charal(nxypt:nxypt)
+ xpq(nxypt) = slam
+ ypq(nxypt) = f2
+ if (f2 .lt. fvmin) then
+ fvmin = f2
+ xvmin = slam
+ endif
+ if (fstart .eq. fvmin) then
+ flast = f2
+ toler8 = toler*slam
+ overal = slam-toler8
+ slamax = overal
+ go to 25
+ endif
+c . quadr interp using 3 points
+ xvals(1) = xpq(1)
+ fvals(1) = ypq(1)
+ xvals(2) = xpq(nxypt-1)
+ fvals(2) = ypq(nxypt-1)
+ xvals(3) = xpq(nxypt)
+ fvals(3) = ypq(nxypt)
+c begin iteration, calculate desired step
+ 50 continue
+ slamax = max(slamax,alpha*abs(xvmin))
+ call mnpfit(xvals,fvals,3,coeff,sdev)
+ if (coeff(3) .le. zero) then
+ slopem = 2.0*coeff(3)*xvmin + coeff(2)
+ if (slopem .le. zero) then
+ slam = xvmin + slamax
+ else
+ slam = xvmin - slamax
+ endif
+ else
+ slam = -coeff(2)/(2.0*coeff(3))
+ if (slam .gt. xvmin+slamax) slam = xvmin+slamax
+ if (slam .lt. xvmin-slamax) slam = xvmin-slamax
+ endif
+ if (slam .gt. zero) then
+ if (slam .gt. overal) slam = overal
+ else
+ if (slam .lt. undral) slam = undral
+ endif
+c come here if step was cut below
+ 52 continue
+ toler9 = max(toler8,abs(toler8*slam))
+ do 55 ipt= 1, 3
+ if (abs(slam-xvals(ipt)) .lt. toler9) go to 70
+ 55 continue
+c take the step
+ do 60 i= 1, npar
+ 60 x(i) = start(i)+slam*step(i)
+ call mninex(x)
+ call fcn(nparx,gin,f3,u,4,futil)
+ nfcn = nfcn + 1
+ nxypt = nxypt + 1
+ chpq(nxypt) = charal(nxypt:nxypt)
+ xpq(nxypt) = slam
+ ypq(nxypt) = f3
+c find worst previous point out of three
+ fvmax = fvals(1)
+ nvmax = 1
+ if (fvals(2) .gt. fvmax) then
+ fvmax = fvals(2)
+ nvmax = 2
+ endif
+ if (fvals(3) .gt. fvmax) then
+ fvmax = fvals(3)
+ nvmax = 3
+ endif
+c if latest point worse than all three previous, cut step
+ if (f3 .ge. fvmax) then
+ if (nxypt .ge. maxpt) go to 65
+ if (slam .gt. xvmin) overal = min(overal,slam-toler8)
+ if (slam .lt. xvmin) undral = max(undral,slam+toler8)
+ slam = 0.5*(slam+xvmin)
+ go to 52
+ endif
+c prepare another iteration, replace worst previous point
+ xvals(nvmax) = slam
+ fvals(nvmax) = f3
+ if (f3 .lt. fvmin) then
+ fvmin = f3
+ xvmin = slam
+ else
+ if (slam .gt. xvmin) overal = min(overal,slam-toler8)
+ if (slam .lt. xvmin) undral = max(undral,slam+toler8)
+ endif
+ if (nxypt .lt. maxpt) go to 50
+c . . end of iteration . . .
+c stop because too many iterations
+ 65 cmess = ' line search has exhausted the limit of function calls '
+ if (ldebug) then
+ write (isyswr,'(a/(2x,6g12.4))') ' mnline debug: steps=',
+ + (step(kk),kk=1,npar)
+ endif
+ go to 100
+c stop because within tolerance
+ 70 continue
+ cmess = ' line search has attained tolerance '
+ go to 100
+ 80 continue
+ cmess = ' step size at arithmetically allowed minimum'
+ 100 continue
+ amin = fvmin
+ do 120 i= 1, npar
+ dirin(i) = step(i)*xvmin
+ 120 x(i) = start(i) + dirin(i)
+ call mninex(x)
+ if (xvmin .lt. 0.) call mnwarn('d','mnline',
+ + ' line minimum in backwards direction')
+ if (fvmin .eq. fstart) call mnwarn('d','mnline',
+ + ' line search finds no improvement ')
+ if (ldebug) then
+ write (isyswr,'('' after'',i3,'' points,'',a)') nxypt,cmess
+ call mnplot(xpq,ypq,chpq,nxypt,isyswr,npagwd,npagln)
+ endif
+ return
+ end
+cdeck id>, mnmatu.
+ subroutine mnmatu(kode)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc prints the covariance matrix v when kode=1.
+cc always prints the global correlations, and
+cc calculates and prints the individual correlation coefficients
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ dimension vline(mni)
+ isw2 = isw(2)
+ if (isw2 .lt. 1) then
+ write (isyswr,'(1x,a)') covmes(isw2)
+ go to 500
+ endif
+ if (npar .eq. 0) then
+ write (isyswr,'('' mnmatu: npar=0'')')
+ go to 500
+ endif
+c . . . . .external error matrix
+ if (kode .eq. 1) then
+ isw5 = isw(5)
+ isw(5) = 2
+ call mnemat(p,maxint)
+ if (isw2.lt.3) write (isyswr,'(1x,a)') covmes(isw2)
+ isw(5) = isw5
+ endif
+c . . . . . correlation coeffs. .
+ if (npar .le. 1) go to 500
+ call mnwerr
+c ncoef is number of coeff. that fit on one line, not to exceed 20
+ ncoef = (npagwd-19)/6
+ ncoef = min(ncoef,20)
+ nparm = min(npar,ncoef)
+ write (isyswr, 150) (nexofi(id),id=1,nparm)
+ 150 format (/36h parameter correlation coefficients /
+ + 18h no. global ,20i6)
+ do 200 i= 1, npar
+ ix = nexofi(i)
+ ndi = i*(i+1)/2
+ do 170 j= 1, npar
+ m = max(i,j)
+ n = min(i,j)
+ ndex = m*(m-1)/2 + n
+ ndj = j*(j+1)/2
+ 170 vline(j) = vhmat(ndex)/dsqrt(abs(vhmat(ndi)*vhmat(ndj)))
+ nparm = min(npar,ncoef)
+ write (isyswr,171) ix, globcc(i), (vline(it),it=1,nparm)
+ 171 format (6x,i3,2x,f7.5,1x,20f6.3)
+ if (i.le.nparm) go to 200
+ do 190 iso= 1, 10
+ nsofar = nparm
+ nparm = min(npar,nsofar+ncoef)
+ write (isyswr,181) (vline(it),it=nsofar+1,nparm)
+ 181 format (19x,20f6.3)
+ if (i .le. nparm) go to 192
+ 190 continue
+ 192 continue
+ 200 continue
+ if (isw2.lt.3) write (isyswr,'(1x,a)') covmes(isw2)
+ 500 return
+ end
+cdeck id>, mnmigr.
+ subroutine mnmigr(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc performs a local function minimization using basically the
+cc method of davidon-fletcher-powell as modified by fletcher
+cc ref. -- fletcher, comp.j. 13,317 (1970) "switching method"
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ dimension gs(mni), step(mni), xxs(mni), flnu(mni), vg(mni)
+ logical ldebug
+ parameter (toler=0.05)
+ if (npar .le. 0) return
+ if (amin .eq. undefi) call mnamin(fcn,futil)
+ ldebug = (idbg(4) .ge. 1)
+ cfrom = 'migrad '
+ nfcnfr = nfcn
+ nfcnmg = nfcn
+ cstatu= 'initiate '
+ iswtr = isw(5) - 2*itaur
+ npfn = nfcn
+ nparx = npar
+ vlen = npar*(npar+1)/2
+ nrstrt = 0
+ npsdf = 0
+ lined2 = 0
+ isw(4) = -1
+ rhotol = 1.0e-3*apsi
+ if (iswtr .ge. 1) write (isyswr,470) istrat,rhotol
+ 470 format (' start migrad minimization. strategy',i2,
+ +'. convergence when edm .lt.',e9.2)
+c initialization strategy
+ if (istrat.lt.2 .or. isw(2).ge.3) go to 2
+c come (back) here to restart completely
+ 1 continue
+ if (nrstrt .gt. istrat) then
+ cstatu= 'failed '
+ isw(4) = -1
+ go to 230
+ endif
+c . get full covariance and gradient
+ call mnhess(fcn,futil)
+ call mnwerr
+ npsdf = 0
+ if (isw(2) .ge. 1) go to 10
+c . get gradient at start point
+ 2 continue
+ call mninex(x)
+ if (isw(3) .eq. 1) then
+ call fcn(nparx,gin,fzero,u,2,futil)
+ nfcn = nfcn + 1
+ endif
+ call mnderi(fcn,futil)
+ if (isw(2) .ge. 1) go to 10
+c sometimes start with diagonal matrix
+ do 3 i= 1, npar
+ xxs(i) = x(i)
+ step(i) = zero
+ 3 continue
+c do line search if second derivative negative
+ lined2 = lined2 + 1
+ if (lined2 .lt. 2*npar) then
+ do 5 i= 1, npar
+ if (g2(i) .gt. 0.) go to 5
+ step(i) = -sign(gstep(i),grd(i))
+ gdel = step(i)*grd(i)
+ fs = amin
+ call mnline(fcn,xxs,fs,step,gdel,toler,futil)
+ call mnwarn('d','mnmigr','negative g2 line search')
+ iext = nexofi(i)
+ if (ldebug) write (isyswr,'(a,i3,2g13.3)')
+ + ' negative g2 line search, param ',iext,fs,amin
+ go to 2
+ 5 continue
+ endif
+c make diagonal error matrix
+ do 8 i=1,npar
+ ndex = i*(i-1)/2
+ do 7 j=1,i-1
+ ndex = ndex + 1
+ 7 vhmat(ndex) = 0.
+ ndex = ndex + 1
+ if (g2(i) .le. zero) g2(i) = 1.
+ vhmat(ndex) = 2./g2(i)
+ 8 continue
+ dcovar = 1.
+ if (ldebug) write (isyswr,'(a,a/(1x,10g10.2))') ' debug mnmigr,',
+ + ' starting matrix diagonal, vhmat=', (vhmat(kk),kk=1,int(vlen))
+c ready to start first iteration
+ 10 continue
+ impruv = 0
+ nrstrt = nrstrt + 1
+ if (nrstrt .gt. istrat+1) then
+ cstatu= 'failed '
+ go to 230
+ endif
+ fs = amin
+c . . . get edm and set up loop
+ edm = 0.
+ do 18 i= 1, npar
+ gs(i) = grd(i)
+ xxs(i) = x(i)
+ ndex = i*(i-1)/2
+ do 17 j= 1, i-1
+ ndex = ndex + 1
+ 17 edm = edm + gs(i)*vhmat(ndex)*gs(j)
+ ndex = ndex + 1
+ 18 edm = edm + 0.5 * gs(i)**2 *vhmat(ndex)
+ edm = edm * 0.5 * (1.0+3.0*dcovar)
+ if (edm .lt. zero) then
+ call mnwarn('w','migrad','starting matrix not pos-definite.')
+ isw(2) = 0
+ dcovar = 1.
+ go to 2
+ endif
+ if (isw(2) .eq. 0) edm=bigedm
+ iter = 0
+ call mninex(x)
+ call mnwerr
+ if (iswtr .ge. 1) call mnprin(3,amin)
+ if (iswtr .ge. 2) call mnmatu(0)
+c . . . . . start main loop
+ 24 continue
+ if (nfcn-npfn .ge. nfcnmx) go to 190
+ gdel = 0.
+ gssq = 0.
+ do 30 i=1,npar
+ ri = 0.
+ gssq = gssq + gs(i)**2
+ do 25 j=1,npar
+ m = max(i,j)
+ n = min(i,j)
+ ndex = m*(m-1)/2 + n
+ 25 ri = ri + vhmat(ndex) *gs(j)
+ step(i) = -0.5*ri
+ 30 gdel = gdel + step(i)*gs(i)
+ if (gssq .eq. zero) then
+ call mnwarn('d','migrad',
+ + ' first derivatives of fcn are all zero')
+ go to 300
+ endif
+c if gdel positive, v not posdef
+ if (gdel .ge. zero) then
+ call mnwarn('d','migrad',' newton step not descent.')
+ if (npsdf .eq. 1) go to 1
+ call mnpsdf
+ npsdf = 1
+ go to 24
+ endif
+c . . . . do line search
+ call mnline(fcn,xxs,fs,step,gdel,toler,futil)
+ if (amin .eq. fs) go to 200
+ cfrom = 'migrad '
+ nfcnfr = nfcnmg
+ cstatu= 'progress '
+c . get gradient at new point
+ call mninex(x)
+ if (isw(3) .eq. 1) then
+ call fcn(nparx,gin,fzero,u,2,futil)
+ nfcn = nfcn + 1
+ endif
+ call mnderi(fcn,futil)
+c . calculate new edm
+ npsdf = 0
+ 81 edm = 0.
+ gvg = 0.
+ delgam = 0.
+ gdgssq = 0.
+ do 100 i= 1, npar
+ ri = 0.
+ vgi = 0.
+ do 90 j= 1, npar
+ m = max(i,j)
+ n = min(i,j)
+ ndex = m*(m-1)/2 + n
+ vgi = vgi + vhmat(ndex)*(grd(j)-gs(j))
+ 90 ri = ri + vhmat(ndex)* grd(j)
+ vg(i) = vgi*0.5
+ gami = grd(i) - gs(i)
+ gdgssq = gdgssq + gami**2
+ gvg = gvg + gami*vg(i)
+ delgam = delgam + dirin(i)*gami
+ 100 edm = edm + grd(i)*ri*0.5
+ edm = edm * 0.5 * (1.0 + 3.0*dcovar)
+c . if edm negative, not positive-definite
+ if (edm .lt. zero .or. gvg .le. zero) then
+ call mnwarn('d','migrad','not pos-def. edm or gvg negative.')
+ cstatu = 'not posdef'
+ if (npsdf .eq. 1) go to 230
+ call mnpsdf
+ npsdf = 1
+ go to 81
+ endif
+c print information about this iteration
+ iter = iter + 1
+ if (iswtr.ge.3 .or. (iswtr.eq.2.and.mod(iter,10).eq.1)) then
+ call mnwerr
+ call mnprin(3,amin)
+ endif
+ if (gdgssq .eq. zero) call mnwarn('d','migrad',
+ + 'no change in first derivatives over last step')
+ if (delgam .lt. zero) call mnwarn('d','migrad',
+ + 'first derivatives increasing along search line')
+c . update covariance matrix
+ cstatu = 'improvemnt'
+ if (ldebug) write (isyswr,'(a,(1x,10g10.3))') ' vhmat 1 =',
+ + (vhmat(kk),kk=1,10)
+ dsum = 0.
+ vsum = 0.
+ do 120 i=1, npar
+ do 120 j=1, i
+ d = dirin(i)*dirin(j)/delgam - vg(i)*vg(j)/gvg
+ dsum = dsum + abs(d)
+ ndex = i*(i-1)/2 + j
+ vhmat(ndex) = vhmat(ndex) + 2.0*d
+ vsum = vsum + abs(vhmat(ndex))
+ 120 continue
+c smooth local fluctuations by averaging dcovar
+ dcovar = 0.5*(dcovar + dsum/vsum)
+ if (iswtr.ge.3 .or. ldebug) write (isyswr,'(a,f5.1,a)')
+ + ' relative change in cov. matrix=',dcovar*100.,'%'
+ if (ldebug) write (isyswr,'(a,(1x,10g10.3))') ' vhmat 2 =',
+ + (vhmat(kk),kk=1,10)
+ if (delgam .le. gvg) go to 135
+ do 125 i= 1, npar
+ 125 flnu(i) = dirin(i)/delgam - vg(i)/gvg
+ do 130 i= 1, npar
+ do 130 j= 1, i
+ ndex = i*(i-1)/2 + j
+ 130 vhmat(ndex) = vhmat(ndex) + 2.0*gvg*flnu(i)*flnu(j)
+ 135 continue
+c and see if converged
+ if (edm .lt. 0.1*rhotol) go to 300
+c if not, prepare next iteration
+ do 140 i= 1, npar
+ xxs(i) = x(i)
+ gs(i) = grd(i)
+ 140 continue
+ fs = amin
+ impruv = impruv + 1
+ if (isw(2) .eq. 0 .and. dcovar.lt. 0.5 ) isw(2) = 1
+ if (isw(2) .eq. 3 .and. dcovar.gt. 0.1 ) isw(2) = 1
+ if (isw(2) .eq. 1 .and. dcovar.lt. 0.05) isw(2) = 3
+ go to 24
+c . . . . . end main loop
+c . . call limit in mnmigr
+ 190 isw(1) = 1
+ if (isw(5) .ge. 0)
+ + write (isyswr,'(a)') ' call limit exceeded in migrad.'
+ cstatu = 'call limit'
+ go to 230
+c . . fails to improve . .
+ 200 if (iswtr .ge. 1) write (isyswr,'(a)')
+ + ' migrad fails to find improvement'
+ do 210 i= 1, npar
+ 210 x(i) = xxs(i)
+ if (edm .lt. rhotol) go to 300
+ if (edm .lt. abs(epsma2*amin)) then
+ if (iswtr .ge. 0) write (isyswr, '(a)')
+ + ' machine accuracy limits further improvement.'
+ go to 300
+ endif
+ if (istrat .lt. 1) then
+ if (isw(5) .ge. 0) write (isyswr, '(a)')
+ + ' migrad fails with strategy=0. will try with strategy=1.'
+ istrat = 1
+ endif
+ go to 1
+c . . fails to converge
+ 230 if (iswtr .ge. 0) write (isyswr,'(a)')
+ + ' migrad terminated without convergence.'
+ if (isw(2) .eq. 3) isw(2) = 1
+ isw(4) = -1
+ go to 400
+c . . apparent convergence
+ 300 if (iswtr .ge. 0) write(isyswr,'(/a)')
+ + ' migrad minimization has converged.'
+ if (itaur .eq. 0) then
+ if (istrat .ge. 2 .or. (istrat.eq.1.and.isw(2).lt.3)) then
+ if (isw(5) .ge. 0) write (isyswr, '(/a)')
+ + ' migrad will verify convergence and error matrix.'
+ call mnhess(fcn,futil)
+ call mnwerr
+ npsdf = 0
+ if (edm .gt. rhotol) go to 10
+ endif
+ endif
+ cstatu='converged '
+ isw(4) = 1
+c come here in any case
+ 400 continue
+ cfrom = 'migrad '
+ nfcnfr = nfcnmg
+ call mninex(x)
+ call mnwerr
+ if (iswtr .ge. 0) call mnprin (3,amin)
+ if (iswtr .ge. 1) call mnmatu(1)
+ return
+ end
+cdeck id>, mnmnos.
+ subroutine mnmnos(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc performs a minos error analysis on those parameters for
+cc which it is requested on the minos command.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ if (npar .le. 0) go to 700
+ ngood = 0
+ nbad = 0
+ nfcnmi = nfcn
+c . loop over parameters requested
+ do 570 knt= 1, npar
+ if (int(word7(2)) .eq. 0) then
+ ilax = nexofi(knt)
+ else
+ if (knt .ge. 7) go to 580
+ ilax = int(word7(knt+1))
+ if (ilax .eq. 0) go to 580
+ if (ilax .gt. 0 .and. ilax .le. nu) then
+ if (niofex(ilax) .gt. 0) go to 565
+ endif
+ write (isyswr,564) ilax
+ 564 format (' parameter number ',i5,' not variable. ignored.')
+ go to 570
+ endif
+ 565 continue
+c calculate one pair of m e's
+ ilax2 = 0
+ call mnmnot(fcn,ilax,ilax2,val2pl,val2mi,futil)
+ if (lnewmn) go to 650
+c update ngood and nbad
+ iin = niofex(ilax)
+ if (erp(iin) .gt. zero) then
+ ngood=ngood+1
+ else
+ nbad=nbad+1
+ endif
+ if (ern(iin) .lt. zero) then
+ ngood=ngood+1
+ else
+ nbad=nbad+1
+ endif
+ 570 continue
+c end of loop . . . . . . .
+ 580 continue
+c . . . . printout final values .
+ cfrom = 'minos '
+ nfcnfr = nfcnmi
+ cstatu= 'unchanged '
+ if (ngood.eq.0.and.nbad.eq.0) go to 700
+ if (ngood.gt.0.and.nbad.eq.0) cstatu='successful'
+ if (ngood.eq.0.and.nbad.gt.0) cstatu='failure '
+ if (ngood.gt.0.and.nbad.gt.0) cstatu='problems '
+ if (isw(5) .ge. 0) call mnprin(4,amin)
+ if (isw(5) .ge. 2) call mnmatu(0)
+ go to 900
+c . . . new minimum found . . . .
+ 650 continue
+ cfrom = 'minos '
+ nfcnfr = nfcnmi
+ cstatu= 'new minimu'
+ if (isw(5) .ge. 0) call mnprin(4,amin)
+ write (isyswr,675)
+ 675 format(/50h new minimum found. go back to minimization step./1h ,
+ +60(1h=)/60x,1hv/60x,1hv/60x,1hv/57x,7hvvvvvvv/58x,5hvvvvv/59x,
+ +3hvvv/60x,1hv//)
+ go to 900
+ 700 write (isyswr,'(a)') ' there are no minos errors to calculate.'
+ 900 return
+ end
+cdeck id>, mnmnot.
+ subroutine mnmnot(fcn,ilax,ilax2,val2pl,val2mi,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc performs a minos error analysis on one parameter.
+cc the parameter ilax is varied, and the minimum of the
+cc function with respect to the other parameters is followed
+cc until it crosses the value fmin+up.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ dimension xdev(mni),w(mni),gcc(mni)
+ character*4 cpos,cneg,csig
+ character*1 cdot,cstar,cblank
+ parameter (cpos='posi',cneg='nega',cdot='.',cstar='*',cblank=' ')
+ logical lovflo, lright, lleft
+c . . save and prepare start vals
+ isw2 = isw(2)
+ isw4 = isw(4)
+ sigsav = edm
+ istrav = istrat
+ dc = dcovar
+ lovflo = .false.
+ lnewmn = .false.
+ toler = epsi*0.5
+ apsi = epsi*0.5
+ abest=amin
+ aim = amin + up
+ mpar=npar
+ nfmxin = nfcnmx
+ do 125 i= 1, mpar
+ 125 xt(i) = x(i)
+ do 130 j= 1, mpar*(mpar+1)/2
+ 130 vthmat(j) = vhmat(j)
+ do 135 i= 1, mpar
+ gcc(i) = globcc(i)
+ 135 w(i) = werr(i)
+ it = niofex(ilax)
+ erp(it) = 0.
+ ern(it) = 0.
+ call mninex(xt)
+ ut = u(ilax)
+ if (nvarl(ilax) .eq. 1) then
+ alim(ilax) = ut -100.*w(it)
+ blim(ilax) = ut +100.*w(it)
+ endif
+ ndex = it*(it+1)/2
+ xunit = dsqrt(up/vthmat(ndex))
+ marc = 0
+ do 162 i= 1, mpar
+ if (i .eq. it) go to 162
+ marc = marc + 1
+ imax = max(it,i)
+ indx = imax*(imax-1)/2 + min(it,i)
+ xdev(marc) = xunit*vthmat(indx)
+ 162 continue
+c fix the parameter in question
+ call mnfixp (it,ierr)
+ if (ierr .gt. 0) then
+ write (isyswr,'(a,i5,a,i5)')
+ + ' minuit error. cannot fix parameter',ilax,' internal',it
+ go to 700
+ endif
+c . . . . . nota bene: from here on, npar=mpar-1
+c remember: mnfixp squeezes it out of x, xt, werr, and vhmat,
+c not w, vthmat
+ do 500 isig= 1,2
+ if (isig .eq. 1) then
+ sig = 1.0
+ csig = cpos
+ else
+ sig = -1.0
+ csig = cneg
+ endif
+c . sig=sign of error being calcd
+ if (isw(5) .gt. 1) write (isyswr,806) csig,ilax,cpnam(ilax)
+ 806 format (/' determination of ',a4,'tive minos error for parameter',
+ + i3, 2x ,a)
+ if (isw(2).le.0) call mnwarn('d','minos','no covariance matrix.')
+ nlimit = nfcn + nfmxin
+ istrat = max(istrav-1,0)
+ du1 = w(it)
+ u(ilax) = ut + sig*du1
+ fac = sig*du1/w(it)
+ do 185 i= 1, npar
+ 185 x(i) = xt(i) + fac*xdev(i)
+ if (isw(5) .gt. 1) write (isyswr,801) ilax,ut,sig*du1,u(ilax)
+ 801 format (/' parameter',i4,' set to',e11.3,' + ',e10.3,' = ',e12.3)
+c loop to hit aim
+ ke1cr = ilax
+ ke2cr = 0
+ xmidcr = ut + sig*du1
+ xdircr = sig*du1
+c
+ amin = abest
+ nfcnmx = nlimit - nfcn
+ call mncros(fcn,aopt,iercr,futil)
+ if (abest-amin .gt. 0.01*up) go to 650
+ if (iercr .eq. 1) go to 440
+ if (iercr .eq. 2) go to 450
+ if (iercr .eq. 3) go to 460
+c . error successfully calculated
+ eros = sig*du1 + aopt*xdircr
+ if (isw(5) .gt. 1) write (isyswr,808) csig,ilax,cpnam(ilax),eros
+ 808 format (/9x,4hthe ,a4, 29htive minos error of parameter,i3, 2h
+ +, ,a10, 4h, is ,e12.4)
+ go to 480
+c . . . . . . . . failure returns
+ 440 if (isw(5) .ge. 1) write(isyswr,807) csig,ilax,cpnam(ilax)
+ 807 format (5x,'the ',a4,'tive minos error of parameter',i3,', ',a,
+ +', exceeds its limit.'/)
+ eros = undefi
+ go to 480
+ 450 if (isw(5) .ge. 1) write (isyswr, 802) csig,ilax,nfmxin
+ 802 format (9x,'the ',a,'tive minos error',i4,' requires more than',
+ + i5,' function calls.'/)
+ eros = 0.
+ go to 480
+ 460 if (isw(5) .ge. 1) write (isyswr, 805) csig,ilax
+ 805 format (25x,a,'tive minos error not calculated for parameter',i4/)
+ eros = 0.
+c
+ 480 if (isw(5) .gt. 1) write (isyswr,'(5x, 74(1h*))')
+ if (sig .lt. zero) then
+ ern(it) = eros
+ if (ilax2.gt.0 .and. ilax2.le.nu) val2mi = u(ilax2)
+ else
+ erp(it) = eros
+ if (ilax2.gt.0 .and. ilax2.le.nu) val2pl = u(ilax2)
+ endif
+ 500 continue
+c . . parameter finished. reset v
+c normal termination
+ itaur = 1
+ call mnfree(1)
+ do 550 j= 1, mpar*(mpar+1)/2
+ 550 vhmat(j) = vthmat(j)
+ do 595 i= 1, mpar
+ werr(i) = w(i)
+ globcc(i) = gcc(i)
+ 595 x(i) = xt(i)
+ call mninex (x)
+ edm = sigsav
+ amin = abest
+ isw(2) = isw2
+ isw(4) = isw4
+ dcovar = dc
+ go to 700
+c new minimum
+ 650 lnewmn = .true.
+ isw(2) = 0
+ dcovar = 1.
+ isw(4) = 0
+ sav = u(ilax)
+ itaur = 1
+ call mnfree(1)
+ u(ilax) = sav
+ call mnexin(x)
+ edm = bigedm
+c in any case
+ 700 continue
+ itaur = 0
+ nfcnmx = nfmxin
+ istrat = istrav
+ return
+ end
+cdeck id>, mnparm.
+ subroutine mnparm(k,cnamj,uk,wk,a,b,ierflg)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called from mnread and user-callable
+cc implements one parameter definition, that is:
+cc k (external) parameter number
+cc cnamk parameter name
+cc uk starting value
+cc wk starting step size or uncertainty
+cc a, b lower and upper physical parameter limits
+cc and sets up (updates) the parameter lists.
+cc output: ierflg=0 if no problems
+cc >0 if mnparm unable to implement definition
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ character*(*) cnamj
+ character cnamk*10, chbufi*4
+c
+ cnamk = cnamj
+ kint = npar
+ if (k.lt.1 .or. k.gt.maxext) then
+c parameter number exceeds allowed maximum value
+ write (isyswr,9) k,maxext
+ 9 format (/' minuit user error. parameter number is',i11/
+ + ', allowed range is one to',i4/)
+ go to 800
+ endif
+c normal parameter request
+ ktofix = 0
+ if (nvarl(k) .lt. 0) go to 50
+c previously defined parameter is being redefined
+c find if parameter was fixed
+ do 40 ix= 1, npfix
+ if (ipfix(ix) .eq. k) ktofix = k
+ 40 continue
+ if (ktofix .gt. 0) then
+ call mnwarn('w','param def','redefining a fixed parameter.')
+ if (kint .ge. maxint) then
+ write (isyswr,'(a)') ' cannot release. max npar exceeded.'
+ go to 800
+ endif
+ call mnfree(-k)
+ endif
+c if redefining previously variable parameter
+ if(niofex(k) .gt. 0) kint = npar-1
+ 50 continue
+c
+c . . .print heading
+ if (lphead .and. isw(5).ge.0) then
+ write (isyswr,61)
+ lphead = .false.
+ endif
+ 61 format(/' parameter definitions:'/
+ + ' no. name value step size limits')
+ if (wk .gt. zero) go to 122
+c . . .constant parameter . . . .
+ if (isw(5) .ge. 0) write (isyswr, 82) k,cnamk,uk
+ 82 format (1x,i5,1x,1h',a10,1h',1x,g13.5, ' constant')
+ nvl = 0
+ go to 200
+ 122 if (a.eq.zero .and. b.eq.zero) then
+c variable parameter without limits
+ nvl = 1
+ if (isw(5) .ge. 0) write (isyswr, 127) k,cnamk,uk,wk
+ 127 format (1x,i5,1x,1h',a10,1h',1x,2g13.5, ' no limits')
+ else
+c variable parameter with limits
+ nvl = 4
+ lnolim = .false.
+ if (isw(5) .ge. 0) write (isyswr, 132) k,cnamk,uk,wk,a,b
+ 132 format(1x,i5,1x,1h',a10,1h',1x,2g13.5,2x,2g13.5)
+ endif
+c . . request for another variable parameter
+ kint = kint + 1
+ if (kint .gt. maxint) then
+ write (isyswr,135) maxint
+ 135 format (/' minuit user error. too many variable parameters.'/
+ + ' this version of minuit dimensioned for',i4//)
+ go to 800
+ endif
+ if (nvl .eq. 1) go to 200
+ if (a .eq. b) then
+ write (isyswr,'(/a,a/a/)') ' user error in minuit parameter',
+ + ' definition',' upper and lower limits equal.'
+ go to 800
+ endif
+ if (b .lt. a) then
+ sav = b
+ b = a
+ a = sav
+ call mnwarn('w','param def','parameter limits were reversed.')
+ if (lwarn) lphead=.true.
+ endif
+ if ((b-a) .gt. 1.0e7) then
+ write (chbufi,'(i4)') k
+ call mnwarn('w','param def',
+ + 'limits on param'//chbufi//' too far apart.')
+ if (lwarn) lphead=.true.
+ endif
+ danger = (b-uk)*(uk-a)
+ if (danger .lt. 0.)
+ + call mnwarn('w','param def','starting value outside limits.')
+ if (danger .eq. 0.)
+ + call mnwarn('w','param def','starting value is at limit.')
+ 200 continue
+c . . . input ok, set values, arrange lists,
+c calculate step sizes gstep, dirin
+ cfrom = 'parametr'
+ nfcnfr = nfcn
+ cstatu= 'new values'
+ nu = max(nu,k)
+ cpnam(k) = cnamk
+ u(k) = uk
+ alim(k) = a
+ blim(k) = b
+ nvarl(k) = nvl
+ call mnrset(1)
+c k is external number of new parameter
+c lastin is the number of var. params with ext. param. no.< k
+ lastin = 0
+ do 240 ix= 1, k-1
+ if (niofex(ix) .gt. 0) lastin=lastin+1
+ 240 continue
+c kint is new number of variable params, npar is old
+ if (kint .eq. npar) go to 280
+ if (kint .gt. npar) then
+c insert new variable parameter in list
+ do 260 in= npar,lastin+1,-1
+ ix = nexofi(in)
+ niofex(ix) = in+1
+ nexofi(in+1)= ix
+ x (in+1) = x (in)
+ xt (in+1) = xt (in)
+ dirin(in+1) = dirin(in)
+ g2 (in+1) = g2 (in)
+ gstep(in+1) = gstep(in)
+ 260 continue
+ else
+c remove variable parameter from list
+ do 270 in= lastin+1,kint
+ ix = nexofi(in+1)
+ niofex(ix) = in
+ nexofi(in)= ix
+ x (in)= x (in+1)
+ xt (in)= xt (in+1)
+ dirin (in)= dirin(in+1)
+ g2 (in)= g2 (in+1)
+ gstep (in)= gstep(in+1)
+ 270 continue
+ endif
+ 280 continue
+ ix = k
+ niofex(ix) = 0
+ npar = kint
+c lists are now arranged . . . .
+ if (nvl .gt. 0) then
+ in = lastin+1
+ nexofi(in) = ix
+ niofex(ix) = in
+ sav = u(ix)
+ call mnpint(sav,ix,pinti)
+ x(in) = pinti
+ xt(in) = x(in)
+ werr(in) = wk
+ sav2 = sav + wk
+ call mnpint(sav2,ix,pinti)
+ vplu = pinti - x(in)
+ sav2 = sav - wk
+ call mnpint(sav2,ix,pinti)
+ vminu = pinti - x(in)
+ dirin(in) = 0.5 * (abs(vplu) +abs(vminu))
+ g2(in) = 2.0*up / dirin(in)**2
+ gsmin = 8.*epsma2*abs(x(in))
+ gstep(in) = max (gsmin, 0.1*dirin(in))
+ if (amin .ne. undefi) then
+ small = dsqrt(epsma2*(amin+up)/up)
+ gstep(in) = max(gsmin, small*dirin(in))
+ endif
+ grd (in) = g2(in)*dirin(in)
+c if parameter has limits
+ if (nvarl(k) .gt. 1) then
+ if (gstep(in).gt. 0.5) gstep(in)=0.5
+ gstep(in) = -gstep(in)
+ endif
+ endif
+ if (ktofix .gt. 0) then
+ kinfix = niofex(ktofix)
+ if (kinfix .gt. 0) call mnfixp(kinfix,ierr)
+ if (ierr .gt. 0) go to 800
+ endif
+ ierflg = 0
+ return
+c error on input, unable to implement request . . . .
+ 800 continue
+ ierflg = 1
+ return
+ end
+cdeck id>, mnpfit.
+ subroutine mnpfit(parx2p,pary2p,npar2p,coef2p,sdev2p)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+c
+c to fit a parabola to npar2p points
+c
+c npar2p no. of points
+c parx2p(i) x value of point i
+c pary2p(i) y value of point i
+c
+c coef2p(1...3) coefficients of the fitted parabola
+c y=coef2p(1) + coef2p(2)*x + coef2p(3)*x**2
+c sdev2p= variance
+c method : chi**2 = min equation solved explicitly
+ dimension parx2p(npar2p),pary2p(npar2p),coef2p(npar2p)
+ dimension cz(3)
+c
+ do 3 i=1,3
+ 3 cz(i)=0.
+ sdev2p=0.
+ if(npar2p.lt.3) go to 10
+ f=npar2p
+c--- center x values for reasons of machine precision
+ xm=0.
+ do 2 i=1,npar2p
+ 2 xm=xm+parx2p(i)
+ xm=xm/f
+ x2=0.
+ x3=0.
+ x4=0.
+ y=0.
+ y2=0.
+ xy=0.
+ x2y=0.
+ do 1 i=1,npar2p
+ s=parx2p(i)-xm
+ t=pary2p(i)
+ s2=s*s
+ x2=x2+s2
+ x3=x3+s*s2
+ x4=x4+s2*s2
+ y=y+t
+ y2=y2+t*t
+ xy=xy+s*t
+ x2y=x2y+s2*t
+ 1 continue
+ a=(f*x4-x2**2)*x2-f*x3**2
+ if(a.eq.0.) goto 10
+ cz(3)=(x2*(f*x2y-x2*y)-f*x3*xy)/a
+ cz(2)=(xy-x3*cz(3))/x2
+ cz(1)=(y-x2*cz(3))/f
+ if(npar2p.eq.3) goto 6
+ sdev2p=y2-(cz(1)*y+cz(2)*xy+cz(3)*x2y)
+ if(sdev2p.lt.0.) sdev2p=0.
+ sdev2p=sdev2p/(f-3.)
+ 6 cz(1)=cz(1)+xm*(xm*cz(3)-cz(2))
+ cz(2)=cz(2)-2.*xm*cz(3)
+ 10 continue
+ do 11 i=1,3
+ 11 coef2p(i)=cz(i)
+ return
+ end
+cdeck id>, mnpint.
+ subroutine mnpint(pexti,i,pinti)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc calculates the internal parameter value pinti corresponding
+cc to the external value pexti for parameter i.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ logical limloc
+ character chbufi*4, chbuf2*30
+ limloc = .false.
+ pinti = pexti
+ igo = nvarl(i)
+ if (igo .eq. 4) then
+c-- there are two limits
+ alimi = alim(i)
+ blimi = blim(i)
+ yy=2.0*(pexti-alimi)/(blimi-alimi) - 1.0
+ yy2 = yy**2
+ if (yy2 .ge. (1.0- epsma2)) then
+ if (yy .lt. 0.) then
+ a = vlimlo
+ chbuf2 = ' is at its lower allowed limit.'
+ else
+ a = vlimhi
+ chbuf2 = ' is at its upper allowed limit.'
+ endif
+ pinti = a
+ pexti = alimi + 0.5* (blimi-alimi) *(dsin(a) +1.0)
+ limset = .true.
+ write (chbufi,'(i4)') i
+ if (yy2 .gt. 1.0) chbuf2 = ' brought back inside limits.'
+ call mnwarn('w',cfrom,'variable'//chbufi//chbuf2)
+ else
+ pinti = dasin(yy)
+ endif
+ endif
+ return
+ end
+cdeck id>, mnplot.
+ subroutine mnplot(xpt,ypt,chpt,nxypt,nunit,npagwd,npagln)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc plots points in array xypt onto one page with labelled axes
+cc nxypt is the number of points to be plotted
+cc xpt(i) = x-coord. of ith point
+cc ypt(i) = y-coord. of ith point
+cc chpt(i) = character to be plotted at this position
+cc the input point arrays xpt, ypt, chpt are destroyed.
+cc
+ dimension xpt(*), ypt(*), sav(2)
+ character*1 chpt(*) , chsav, chbest, cdot, cslash, cblank
+ parameter (maxwid=100)
+ character cline*100, chmess*30
+ dimension xvalus(12)
+ logical overpr
+ data cdot,cslash,cblank/ '.' , '/' , ' '/
+ maxnx = min(npagwd-20,maxwid)
+ if (maxnx .lt. 10) maxnx = 10
+ maxny = npagln
+ if (maxny .lt. 10) maxny = 10
+ if (nxypt .le. 1) return
+ xbest = xpt(1)
+ ybest = ypt(1)
+ chbest = chpt(1)
+c order the points by decreasing y
+ km1 = nxypt - 1
+ do 150 i= 1, km1
+ iquit = 0
+ ni = nxypt - i
+ do 140 j= 1, ni
+ if (ypt(j) .gt. ypt(j+1)) go to 140
+ savx = xpt(j)
+ xpt(j) = xpt(j+1)
+ xpt(j+1) = savx
+ savy = ypt(j)
+ ypt(j) = ypt(j+1)
+ ypt(j+1) = savy
+ chsav = chpt(j)
+ chpt(j) = chpt(j+1)
+ chpt(j+1) = chsav
+ iquit = 1
+ 140 continue
+ if (iquit .eq. 0) go to 160
+ 150 continue
+ 160 continue
+c find extreme values
+ xmax = xpt(1)
+ xmin = xmax
+ do 200 i= 1, nxypt
+ if (xpt(i) .gt. xmax) xmax = xpt(i)
+ if (xpt(i) .lt. xmin) xmin = xpt(i)
+ 200 continue
+ dxx = 0.001*(xmax-xmin)
+ xmax = xmax + dxx
+ xmin = xmin - dxx
+ call mnbins(xmin,xmax,maxnx,xmin,xmax,nx,bwidx)
+ ymax = ypt(1)
+ ymin = ypt(nxypt)
+ if (ymax .eq. ymin) ymax=ymin+1.0
+ dyy = 0.001*(ymax-ymin)
+ ymax = ymax + dyy
+ ymin = ymin - dyy
+ call mnbins(ymin,ymax,maxny,ymin,ymax,ny,bwidy)
+ any = ny
+c if first point is blank, it is an 'origin'
+ if (chbest .eq. cblank) go to 50
+ xbest = 0.5 * (xmax+xmin)
+ ybest = 0.5 * (ymax+ymin)
+ 50 continue
+c find scale constants
+ ax = 1.0/bwidx
+ ay = 1.0/bwidy
+ bx = -ax*xmin + 2.0
+ by = -ay*ymin - 2.0
+c convert points to grid positions
+ do 300 i= 1, nxypt
+ xpt(i) = ax*xpt(i) + bx
+ 300 ypt(i) = any-ay*ypt(i) - by
+ nxbest = ax*xbest + bx
+ nybest = any - ay*ybest - by
+c print the points
+ ny = ny + 2
+ nx = nx + 2
+ isp1 = 1
+ linodd = 1
+ overpr=.false.
+ do 400 i= 1, ny
+ do 310 ibk= 1, nx
+ 310 cline (ibk:ibk) = cblank
+ cline(1:1) = cdot
+ cline(nx:nx) = cdot
+ cline(nxbest:nxbest) = cdot
+ if (i.ne.1 .and. i.ne.nybest .and. i.ne.ny) go to 320
+ do 315 j= 1, nx
+ 315 cline(j:j) = cdot
+ 320 continue
+ yprt = ymax - float(i-1)*bwidy
+ if (isp1 .gt. nxypt) go to 350
+c find the points to be plotted on this line
+ do 341 k= isp1,nxypt
+ ks = ypt(k)
+ if (ks .gt. i) go to 345
+ ix = xpt(k)
+ if (cline(ix:ix) .eq. cdot) go to 340
+ if (cline(ix:ix) .eq. cblank) go to 340
+ if (cline(ix:ix) .eq.chpt(k)) go to 341
+ overpr = .true.
+c overpr is true if one or more positions contains more than
+c one point
+ cline(ix:ix) = '&'
+ go to 341
+ 340 cline(ix:ix) = chpt(k)
+ 341 continue
+ isp1 = nxypt + 1
+ go to 350
+ 345 isp1 = k
+ 350 continue
+ if (linodd .eq. 1 .or. i .eq. ny) go to 380
+ linodd = 1
+ write (nunit, '(18x,a)') cline(:nx)
+ go to 400
+ 380 write (nunit,'(1x,g14.7,a,a)') yprt, ' ..', cline(:nx)
+ linodd = 0
+ 400 continue
+c print labels on x-axis every ten columns
+ do 410 ibk= 1, nx
+ cline(ibk:ibk) = cblank
+ if (mod(ibk,10) .eq. 1) cline(ibk:ibk) = cslash
+ 410 continue
+ write (nunit, '(18x,a)') cline(:nx)
+c
+ do 430 ibk= 1, 12
+ 430 xvalus(ibk) = xmin + float(ibk-1)*10.*bwidx
+ iten = (nx+9) / 10
+ write (nunit,'(12x,12g10.4)') (xvalus(ibk), ibk=1,iten)
+ chmess = ' '
+ if (overpr) chmess=' overprint character is &'
+ write (nunit,'(25x,a,g13.7,a)') 'one column=',bwidx, chmess
+ 500 return
+ end
+cdeck id>, mnpout.
+ subroutine mnpout(iuext,chnam,val,err,xlolim,xuplim,iuint)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc user-called
+cc provides the user with information concerning the current status
+cc of parameter number iuext. namely, it returns:
+cc chnam: the name of the parameter
+cc val: the current (external) value of the parameter
+cc err: the current estimate of the parameter uncertainty
+cc xlolim: the lower bound (or zero if no limits)
+cc xuplim: the upper bound (or zero if no limits)
+cc iuint: the internal parameter number (or zero if not variable,
+cc or negative if undefined).
+cc note also: if iuext is negative, then it is -internal parameter
+cc number, and iuint is returned as the external number.
+cc except for iuint, this is exactly the inverse of mnparm
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ character*(*) chnam
+ xlolim = 0.
+ xuplim = 0.
+ err = 0.
+ if (iuext .eq. 0) go to 100
+ if (iuext .lt. 0) then
+c internal parameter number specified
+ iint = -iuext
+ if (iint .gt. npar) go to 100
+ iext = nexofi(iint)
+ iuint = iext
+ else
+c external parameter number specified
+ iext = iuext
+ if (iext .eq. 0) go to 100
+ if (iext .gt. nu) go to 100
+ iint = niofex(iext)
+ iuint = iint
+ endif
+c in both cases
+ nvl = nvarl(iext)
+ if (nvl .lt. 0) go to 100
+ chnam = cpnam(iext)
+ val = u(iext)
+ if (iint .gt. 0) err = werr(iint)
+ if (nvl .eq. 4) then
+ xlolim = alim(iext)
+ xuplim = blim(iext)
+ endif
+ return
+c parameter is undefined
+ 100 iuint = -1
+ chnam = 'undefined'
+ val = 0.
+ return
+ end
+cdeck id>, mnprin.
+ subroutine mnprin (inkode,fval)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc prints the values of the parameters at the time of the call.
+cc also prints other relevant information such as function value,
+cc estimated distance to minimum, parameter errors, step sizes.
+cc
+c according to the value of ikode, the printout is:
+c ikode=inkode= 0 only info about function value
+c 1 parameter values, errors, limits
+c 2 values, errors, step sizes, internal values
+c 3 values, errors, step sizes, first derivs.
+c 4 values, parabolic errors, minos errors
+c when inkode=5, mnprin chooses ikode=1,2, or 3, according to isw(2)
+c
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+c
+ character*14 colhdu(6),colhdl(6), cx2,cx3,cgetx
+ character*11 cnambf, cblank
+ character chedm*10, cheval*15
+ parameter (cgetx='please get x..')
+ data cblank/' '/
+c
+ if (nu .eq. 0) then
+ write (isyswr,'(a)') ' there are currently no parameters defined'
+ go to 700
+ endif
+c get value of ikode based in inkode, isw(2)
+ ikode = inkode
+ if (inkode .eq. 5) then
+ ikode = isw(2)+1
+ if (ikode .gt. 3) ikode=3
+ endif
+c set 'default' column headings
+ do 5 k= 1, 6
+ colhdu(k) = 'undefined'
+ 5 colhdl(k) = 'column head'
+c print title if minos errors, and title exists.
+ if (ikode.eq.4 .and. ctitl.ne.cundef)
+ + write (isyswr,'(/a,a)') ' minuit task: ',ctitl
+c report function value and status
+ if (fval .eq. undefi) then
+ cheval = ' unknown '
+ else
+ write (cheval,'(g15.7)') fval
+ endif
+ if (edm .eq. bigedm) then
+ chedm = ' unknown '
+ else
+ write (chedm, '(e10.2)') edm
+ endif
+ nc = nfcn-nfcnfr
+ write (isyswr,905) cheval,cfrom,cstatu,nc,nfcn
+ 905 format (/' fcn=',a,' from ',a8,' status=',a10,i6,' calls',
+ + i9,' total')
+ m = isw(2)
+ if (m.eq.0 .or. m.eq.2 .or. dcovar.eq.zero) then
+ write (isyswr,907) chedm,istrat,covmes(m)
+ 907 format (21x,'edm=',a,' strategy=',i2,6x,a)
+ else
+ dcmax = 1.
+ dc = min(dcovar,dcmax) * 100.
+ write (isyswr,908) chedm,istrat,dc
+ 908 format (21x,'edm=',a,' strategy=',i1,' error matrix',
+ + ' uncertainty=',f5.1,'%')
+ endif
+c
+ if (ikode .eq. 0) go to 700
+c find longest name (for rene!)
+ ntrail = 10
+ do 20 i= 1, nu
+ if (nvarl(i) .lt. 0) go to 20
+ do 15 ic= 10,1,-1
+ if (cpnam(i)(ic:ic) .ne. ' ') go to 16
+ 15 continue
+ ic = 1
+ 16 lbl = 10-ic
+ if (lbl .lt. ntrail) ntrail=lbl
+ 20 continue
+ nadd = ntrail/2 + 1
+ if (ikode .eq. 1) then
+ colhdu(1) = ' '
+ colhdl(1) = ' error '
+ colhdu(2) = ' physical'
+ colhdu(3) = ' limits '
+ colhdl(2) = ' negative '
+ colhdl(3) = ' positive '
+ endif
+ if (ikode .eq. 2) then
+ colhdu(1) = ' '
+ colhdl(1) = ' error '
+ colhdu(2) = ' internal '
+ colhdl(2) = ' step size '
+ colhdu(3) = ' internal '
+ colhdl(3) = ' value '
+ endif
+ if (ikode .eq. 3) then
+ colhdu(1) = ' '
+ colhdl(1) = ' error '
+ colhdu(2) = ' step '
+ colhdl(2) = ' size '
+ colhdu(3) = ' first '
+ colhdl(3) = ' derivative '
+ endif
+ if (ikode .eq. 4) then
+ colhdu(1) = ' parabolic '
+ colhdl(1) = ' error '
+ colhdu(2) = ' minos '
+ colhdu(3) = 'errors '
+ colhdl(2) = ' negative '
+ colhdl(3) = ' positive '
+ endif
+c
+ if (ikode .ne. 4) then
+ if (isw(2) .lt. 3) colhdu(1)=' approximate '
+ if (isw(2) .lt. 1) colhdu(1)=' current guess'
+ endif
+ ncol = 3
+ write (isyswr, 910) (colhdu(kk),kk=1,ncol)
+ write (isyswr, 911) (colhdl(kk),kk=1,ncol)
+ 910 format (/' ext parameter ', 13x ,6a14)
+ 911 format ( ' no. name ',' value ',6a14)
+c
+c . . . loop over parameters . .
+ do 200 i= 1, nu
+ if (nvarl(i) .lt. 0) go to 200
+ l = niofex(i)
+ cnambf = cblank(1:nadd)//cpnam(i)
+ if (l .eq. 0) go to 55
+c variable parameter.
+ x1 = werr(l)
+ cx2 = cgetx
+ cx3 = cgetx
+ if (ikode .eq. 1) then
+ if (nvarl(i) .le. 1) then
+ write (isyswr, 952) i,cnambf,u(i),x1
+ go to 200
+ else
+ x2 = alim(i)
+ x3 = blim(i)
+ endif
+ endif
+ if (ikode .eq. 2) then
+ x2 = dirin(l)
+ x3 = x(l)
+ endif
+ if (ikode .eq. 3) then
+ x2 = dirin(l)
+ x3 = grd(l)
+ if (nvarl(i).gt.1 .and. abs(dcos(x(l))) .lt. 0.001)
+ + cx3 = '** at limit **'
+ endif
+ if (ikode .eq. 4) then
+ x2 = ern(l)
+ if (x2.eq.zero) cx2=' '
+ if (x2.eq.undefi) cx2=' at limit '
+ x3 = erp(l)
+ if (x3.eq.zero) cx3=' '
+ if (x3.eq.undefi) cx3=' at limit '
+ endif
+ if (cx2.eq.cgetx) write (cx2,'(g14.5)') x2
+ if (cx3.eq.cgetx) write (cx3,'(g14.5)') x3
+ write (isyswr,952) i,cnambf,u(i),x1,cx2,cx3
+ 952 format (i4,1x,a11,2g14.5,2a)
+c check if parameter is at limit
+ if (nvarl(i) .le. 1 .or. ikode .eq. 3) go to 200
+ if (abs(dcos(x(l))) .lt. 0.001) write (isyswr,1004)
+ 1004 format (1h ,32x,42hwarning - - above parameter is at limit.)
+ go to 200
+c
+c print constant or fixed parameter.
+ 55 continue
+ colhdu(1) = ' constant '
+ if (nvarl(i).gt.0) colhdu(1) = ' fixed '
+ if (nvarl(i).eq.4 .and. ikode.eq.1) then
+ write (isyswr,'(i4,1x,a11,g14.5,a,2g14.5)')
+ + i,cnambf,u(i),colhdu(1),alim(i),blim(i)
+ else
+ write (isyswr,'(i4,1x,a11,g14.5,a)') i,cnambf,u(i),colhdu(1)
+ endif
+ 200 continue
+c
+ if (up.ne.updflt) write (isyswr,'(31x,a,g10.2)') 'err def=',up
+ 700 continue
+ return
+ end
+cdeck id>, mnpsdf.
+ subroutine mnpsdf
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc calculates the eigenvalues of v to see if positive-def.
+cc if not, adds constant along diagonal to make positive.
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ character chbuff*12
+ dimension s(mni)
+ epsmin = 1.0e-6
+ epspdf = max(epsmin, epsma2)
+ dgmin = vhmat(1)
+c check if negative or zero on diagonal
+ do 200 i= 1, npar
+ ndex = i*(i+1)/2
+ if (vhmat(ndex) .le. zero) then
+ write (chbuff(1:3),'(i3)') i
+ call mnwarn('w',cfrom,
+ +'negative diagonal element'//chbuff(1:3)//' in error matrix')
+ endif
+ if (vhmat(ndex) .lt. dgmin) dgmin = vhmat(ndex)
+ 200 continue
+ if (dgmin .le. 0.) then
+ dg = 1.0 - dgmin
+ write (chbuff,'(e12.2)') dg
+ call mnwarn('w',cfrom,
+ + chbuff//' added to diagonal of error matrix')
+ else
+ dg = 0.
+ endif
+c store vhmat in p, make sure diagonal pos.
+ do 213 i= 1, npar
+ ndex = i*(i-1)/2
+ ndexd = ndex + i
+ vhmat(ndexd) = vhmat(ndexd) + dg
+ s(i) = 1.0/dsqrt(vhmat(ndexd))
+ do 213 j= 1, i
+ ndex = ndex + 1
+ 213 p(i,j) = vhmat(ndex) * s(i)*s(j)
+c call eigen (p,p,maxint,npar,pstar,-npar)
+ call mneig(p,maxint,npar,maxint,pstar,epspdf,ifault)
+ pmin = pstar(1)
+ pmax = pstar(1)
+ do 215 ip= 2, npar
+ if (pstar(ip) .lt. pmin) pmin = pstar(ip)
+ if (pstar(ip) .gt. pmax) pmax = pstar(ip)
+ 215 continue
+ pmax = max(abs(pmax), one)
+ if ((pmin .le. zero .and. lwarn) .or. isw(5) .ge. 2) then
+ write (isyswr,550)
+ write (isyswr,551) (pstar(ip),ip=1,npar)
+ endif
+ if (pmin .gt. epspdf*pmax) go to 217
+ if (isw(2) .eq. 3) isw(2)=2
+ padd = 1.0e-3*pmax - pmin
+ do 216 ip= 1, npar
+ ndex = ip*(ip+1)/2
+ 216 vhmat(ndex) = vhmat(ndex) *(1.0 + padd)
+ cstatu= 'not posdef'
+ write (chbuff,'(g12.5)') padd
+ call mnwarn('w',cfrom,
+ + 'matrix forced pos-def by adding '//chbuff//' to diagonal.')
+ 217 continue
+c
+ 550 format (' eigenvalues of second-derivative matrix:' )
+ 551 format (7x,6e12.4)
+ return
+ end
+cdeck id>, mnrazz.
+ subroutine mnrazz(ynew,pnew,y,jh,jl)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called only by mnsimp (and mnimpr) to add a new point
+cc and remove an old one from the current simplex, and get the
+cc estimated distance to minimum.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ dimension pnew(*), y(*)
+ do 10 i=1,npar
+ 10 p(i,jh) = pnew(i)
+ y(jh)=ynew
+ if(ynew .lt. amin) then
+ do 15 i=1,npar
+ 15 x(i) = pnew(i)
+ call mninex(x)
+ amin = ynew
+ cstatu = 'progress '
+ jl=jh
+ endif
+ jh = 1
+ nparp1 = npar+1
+ 20 do 25 j=2,nparp1
+ if (y(j) .gt. y(jh)) jh = j
+ 25 continue
+ edm = y(jh) - y(jl)
+ if (edm .le. zero) go to 45
+ us = 1.0/edm
+ do 35 i= 1, npar
+ pbig = p(i,1)
+ plit = pbig
+ do 30 j= 2, nparp1
+ if (p(i,j) .gt. pbig) pbig = p(i,j)
+ if (p(i,j) .lt. plit) plit = p(i,j)
+ 30 continue
+ dirin(i) = pbig - plit
+ 35 continue
+ 40 return
+ 45 write (isyswr, 1000) npar
+ go to 40
+ 1000 format (' function value does not seem to depend on any of the',
+ + i3,' variable parameters.' /10x,'verify that step sizes are',
+ + ' big enough and check fcn logic.'/1x,79(1h*)/1x,79(1h*)/)
+ end
+cdeck id>, mnread.
+ subroutine mnread(fcn,iflgin,iflgut,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called from minuit. reads all user input to minuit.
+cc this routine is highly unstructured and defies normal logic.
+cc
+cc iflgin indicates the function originally requested:
+cc = 1: read one-line title
+cc 2: read parameter definitions
+cc 3: read minuit commands
+cc
+cc iflgut= 1: reading terminated normally
+cc 2: end-of-data on input
+cc 3: unrecoverable read error
+cc 4: unable to process parameter requests
+cc internally,
+cc iflgdo indicates the subfunction to be performed on the next
+cc input record: 1: read a one-line title
+cc 2: read a parameter definition
+cc 3: read a command
+cc 4: read in covariance matrix
+cc for example, when iflgin=3, but iflgdo=1, then it should read
+cc a title, but this was requested by a command, not by minuit.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ dimension plist(maxp)
+ character cnamk*10, crdbuf*80, celmnt*20
+ character comand*(maxcwd)
+ character cpromt(3)*40, clower*26, cupper*26
+ logical leof
+ data cpromt/' enter minuit title, or "set input n" : ',
+ + ' enter minuit parameter definition: ',
+ + ' enter minuit command: '/
+c
+ data clower/'abcdefghijklmnopqrstuvwxyz'/
+ data cupper/'abcdefghijklmnopqrstuvwxyz'/
+c
+ iflgut = 1
+ iflgdo = iflgin
+ ifatal = 0
+ leof = .false.
+c . . . . read next record
+ 10 continue
+ if (isw(6) .eq. 1) write (isyswr,'(a)') cpromt(iflgdo)
+ crdbuf = ' '
+ read (isysrd,'(a)',err=500,end=45) crdbuf
+c . . preemptive commands
+ leof = .false.
+ if (index(crdbuf,'*eof') .eq. 1 .or.
+ + index(crdbuf,'*eof') .eq. 1) then
+ write (isyswr,'(a,i3)') ' *eof encountered on unit no.',isysrd
+ lphead = .true.
+ go to 50
+ endif
+ if (index(crdbuf,'set inp') .eq. 1 .or.
+ + index(crdbuf,'set inp') .eq. 1) then
+ icomnd = icomnd + 1
+ write (isyswr, 21) icomnd,crdbuf(1:50)
+ 21 format (' **********'/' **',i5,' **',a/' **********')
+ lphead = .true.
+ go to 50
+ endif
+ go to 80
+c . . hardware eof on current isysrd
+ 45 crdbuf = '*eof '
+ write (isyswr,'(a,i3)') ' end of data on unit no.',isysrd
+c or set input command
+ 50 continue
+ call mnstin(crdbuf,ierr)
+ if (ierr .eq. 0) go to 10
+ if (ierr .eq. 2) then
+ if (.not. leof) then
+ write (isyswr,'(a,a/)') ' two consecutive eofs on ',
+ + 'primary input file will terminate execution.'
+ leof = .true.
+ go to 10
+ endif
+ endif
+ iflgut = ierr
+ go to 900
+ 80 if (iflgdo .gt. 1) go to 100
+c read title . . . . . iflgdo = 1
+c if title is 'set title', skip and read again
+ if (index(crdbuf,'set tit') .eq. 1) go to 10
+ if (index(crdbuf,'set tit') .eq. 1) go to 10
+ ctitl = crdbuf(1:50)
+ write (isyswr,'(1x,a50)') ctitl
+ write (isyswr,'(1x,78(1h*))')
+ lphead = .true.
+ if (iflgin .eq. iflgdo) go to 900
+ iflgdo = iflgin
+ go to 10
+c data record is not a title. get upper case
+ 100 continue
+ do 110 i= 1, maxcwd
+ if (crdbuf(i:i) .eq. '''') go to 111
+ do 108 ic= 1, 26
+ if (crdbuf(i:i) .eq. clower(ic:ic)) crdbuf(i:i)=cupper(ic:ic)
+ 108 continue
+
+
+ 110 continue
+ 111 continue
+c read parameter definitions. iflgdo = 2
+ if (iflgdo .gt. 2) go to 300
+c if parameter def is 'parameter', skip and read again
+ if (index(crdbuf,'par') .eq. 1) go to 10
+c if line starts with set title, read a title first
+ if (index(crdbuf,'set tit') .eq. 1) then
+ iflgdo = 1
+ go to 10
+ endif
+c find out whether fixed or free-field format
+ kapo1 = index(crdbuf,'''')
+ if (kapo1 .eq. 0) go to 150
+ kapo2 = index(crdbuf(kapo1+1:),'''')
+ if (kapo2 .eq. 0) go to 150
+c new (free-field) format
+ kapo2 = kapo2 + kapo1
+c skip leading blanks if any
+ do 115 istart=1, kapo1-1
+ if (crdbuf(istart:istart) .ne. ' ') go to 120
+ 115 continue
+ istart = kapo1-1
+ 120 continue
+c parameter number integer
+ if (istart .lt. 1) go to 210
+ celmnt = crdbuf(istart:kapo1-1)
+ read (celmnt,'(bn,f20.0)',err=180) fk
+ k = fk
+ if (k .eq. 0) go to 210
+ cnamk = 'param '//celmnt
+ if (kapo2-kapo1 .gt. 1) cnamk = crdbuf(kapo1+1:kapo2-1)
+ call mncrck(crdbuf(kapo2+1:),maxcwd,comand,lnc,
+ + maxp,plist,llist, ierr,isyswr)
+ if (ierr .gt. 0) go to 180
+ uk = plist(1)
+ wk = 0.
+ if (llist .ge. 2) wk = plist(2)
+ a = 0.
+ if (llist .ge. 3) a = plist(3)
+ b = 0.
+ if (llist .ge. 4) b = plist(4)
+ go to 170
+c old (fixed-field) format
+ 150 continue
+ read (crdbuf, 158,err=180) xk,cnamk,uk,wk,a,b
+ 158 format (bn,f10.0, a10, 4f10.0)
+ k = xk
+ if (k .eq. 0) go to 210
+c parameter format cracked, implement parameter definition
+ 170 call mnparm(k,cnamk,uk,wk,a,b,ierr)
+ if (ierr .eq. 0) go to 10
+c format error
+ 180 continue
+ if (isw(6) .eq. 1) then
+ write (isyswr,'(a)') ' format error. ignored. enter again.'
+ else
+ write (isyswr,'(a)') ' error in parameter definition'
+ ifatal = ifatal + 1
+ endif
+ go to 10
+c . . . end parameter requests
+ 210 write (isyswr,'(4x,75(1h*))')
+ if (ifatal.gt.0 .and. isw(6).ne.1) then
+ iflgut = 4
+ go to 900
+ endif
+ if (iflgin .eq. iflgdo) go to 900
+ iflgdo = iflgin
+ go to 10
+c . . . . . iflgdo = 3
+c read commands
+ 300 continue
+c crack the next command . . . . . . . . . . . . . . . .
+ do 350 ipos= 1, 80
+ if (crdbuf(ipos:ipos) .ne. ' ') go to 355
+ 350 continue
+ write (isyswr,'(a)') ' blank command ignored.'
+ go to 10
+ 355 ibegin = ipos
+ call mncrck(crdbuf(ibegin:),maxcwd,comand,lnc,
+ + maxp, plist, llist, ierr,isyswr)
+ if (ierr .gt. 0) then
+ if (isw(6) .eq. 1) then
+ write (isyswr,'(a)') ' command ignored '
+ go to 10
+ else
+ write (isyswr,'(a)') ' command cannot be interpreted'
+ go to 500
+ endif
+ endif
+c certain commands are trapped here already
+ lphead = .true.
+ if (index(comand,'par' ) .eq. 1) go to 440
+ if (index(comand,'set') .ne. 1) go to 370
+ if (index(comand,'cov') .eq. 5) go to 400
+ if (index(comand,'tit') .eq. 5) go to 460
+ 370 continue
+ call mnexcm(fcn,comand(1:lnc),plist,llist,ierr,futil)
+ if (comand(1:3).eq.'end') go to 900
+ if (comand(1:3).eq.'exi') go to 900
+ if (comand(1:3).eq.'ret') go to 900
+ if (comand(1:3).eq.'sto') go to 900
+ go to 10
+c . . . . . . . . . . set covar
+ 400 nrape = plist(1)
+ icomnd = icomnd + 1
+ write (isyswr,405) icomnd,comand(1:lnc),(plist(i),i=1,llist)
+ 405 format (1h ,10(1h*)/' **',i5,' **',a,4g12.4/20x,5g12.4)
+ write (isyswr, '(1h ,10(1h*))' )
+ if (nrape .ne. npar) go to 425
+ npar2 = npar*(npar+1)/2
+ read (isysrd,420,err=500,end=45) (vhmat(i),i=1,npar2)
+ 420 format (bn,7e11.4,3x)
+ isw(2) = 3
+ dcovar = 0.0
+ if (isw(5) .ge. 0) call mnmatu(1)
+ if (isw(5) .ge. 1) call mnprin(2,amin)
+ go to 10
+ 425 continue
+ write (isyswr,428)
+ 428 format(' size of covariance matrix to be read does not',
+ + ' correspond to'/' number of currently variable parameters.',
+ + ' command ignored.'/)
+ read (isysrd,420,err=500,end=45) ((dummy,i=1,j),j=1,nrape)
+ go to 10
+c . . . . . parameter command
+ 440 continue
+ iflgdo = 2
+ ifatal = 0
+c go and read parameter definitions
+ go to 10
+c . . . . set title
+ 460 continue
+ iflgdo = 1
+ go to 10
+c . . . . error conditions
+ 500 iflgut = 3
+ 900 return
+ end
+cdeck id>, mnrn15.
+ subroutine mnrn15(val,inseed)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+c this is a super-portable random number generator.
+c it should not overflow on any 32-bit machine.
+c the cycle is only ~10**9, so use with care!
+c note especially that val must not be undefined on input.
+c set default starting seed
+ parameter (three=3.0)
+ data iseed/12345/
+ if (val .eq. three) go to 100
+c
+ inseed = iseed
+ k = iseed/53668
+ iseed = 40014*(iseed-k*53668) - k*12211
+ if (iseed .lt. 0) iseed = iseed + 2147483563
+ val = real(iseed) * 4.656613e-10
+ return
+c "entry" to set seed, flag is val=3.
+ 100 iseed = inseed
+ return
+ end
+cdeck id>, mnrset.
+ subroutine mnrset(iopt)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called from mncler and whenever problem changes, for example
+cc after set limits, set param, call fcn 6
+cc if iopt=1,
+cc resets function value and errors to undefined
+cc if iopt=0, sets only minos errors to undefined
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ cstatu = 'reset '
+ if (iopt .ge. 1) then
+ amin = undefi
+ fval3 = 2.0*abs(amin) + 1.
+ edm = bigedm
+ isw(4) = 0
+ isw(2) = 0
+ dcovar = 1.
+ isw(1) = 0
+ endif
+ lnolim = .true.
+ do 10 i= 1, npar
+ iext = nexofi(i)
+ if (nvarl(iext) .ge. 4) lnolim=.false.
+ erp(i) = zero
+ ern(i) = zero
+ globcc(i) = zero
+ 10 continue
+ if (isw(2) .ge. 1) then
+ isw(2) = 1
+ dcovar = max(dcovar,half)
+ endif
+ return
+ end
+cdeck id>, mnsave.
+ subroutine mnsave
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc writes current parameter values and step sizes onto file isyssa
+cc in format which can be reread by minuit for restarting.
+cc the covariance matrix is also output if it exists.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ dimension vc(7)
+ logical lopen,lname
+ character cgname*64, cfname*64, canswr*1
+c
+ inquire(unit=isyssa,opened=lopen,named=lname,name=cgname)
+ if (lopen) then
+ if (.not.lname) cgname='unnamed file'
+ write (isyswr,32) isyssa,cgname
+ 32 format (' current values will be saved on unit',i3,': ',a/)
+ else
+c new file, open it
+ write (isyswr,35) isyssa
+ 35 format (' unit',i3,' is not opened.')
+ if (isw(6) .eq. 1) then
+ write (isyswr,'(a)') ' please give file name:'
+ read (isysrd,'(a)') cfname
+ open (unit=isyssa,file=cfname,status='new',err=600)
+ cgname = cfname
+ else
+ go to 650
+ endif
+ endif
+c file is now correctly opened
+ if (isw(6) .eq. 1) then
+ write (isyswr,37) isyssa
+ 37 format (' should unit',i3,' be rewound before writing to it?' )
+ read (isysrd,'(a)') canswr
+ if (canswr.eq.'y' .or. canswr.eq.'y') rewind isyssa
+ endif
+c and rewound if requested
+ write (isyssa,'(10hset title )',err=700)
+ write (isyssa,'(a)') ctitl
+ write (isyssa,'(10hparameters)')
+ nlines = 3
+c write out parameter values
+ do 200 i= 1, nu
+ if (nvarl(i) .lt. 0) go to 200
+ nlines = nlines + 1
+ iint = niofex(i)
+ if (nvarl(i) .gt. 1) go to 100
+c parameter without limits
+ write (isyssa,1001) i,cpnam(i),u(i),werr(iint)
+ go to 200
+c parameter with limits
+ 100 continue
+ write (isyssa,1001) i,cpnam(i),u(i),werr(iint),alim(i),blim(i)
+ 1001 format (1x,i5,1h',a10,1h',4e13.5)
+ 200 continue
+ write (isyssa,'(a)') ' '
+ nlines = nlines + 1
+c write out covariance matrix, if any
+ if (isw(2) .lt. 1) go to 750
+ write (isyssa,1003,err=700) npar
+ 1003 format ('set covariance',i6)
+ npar2 = npar*(npar+1)/2
+ write (isyssa,1004) (vhmat(i),i=1,npar2)
+ 1004 format (bn,7e11.4,3x)
+ ncovar = npar2/7 + 1
+ if (mod(npar2,7) .gt. 0) ncovar = ncovar + 1
+ nlines = nlines + ncovar
+ write (isyswr, 501) nlines,isyssa,cgname(1:45)
+ 501 format (1x,i5,' records written to unit',i4,':',a)
+ if (ncovar .gt. 0) write (isyswr, 502) ncovar
+ 502 format (' including',i5,' records for the covariance matrix.'/)
+ go to 900
+c some error conditions
+ 600 write (isyswr,'(a,i4)') ' i/o error: unable to open unit',isyssa
+ go to 900
+ 650 write (isyswr,'(a,i4,a)') ' unit',isyssa,' is not opened.'
+ go to 900
+ 700 write (isyswr,'(a,i4)') ' error: unable to write to unit',isyssa
+ go to 900
+ 750 write (isyswr,'(a)') ' there is no covariance matrix to save.'
+c
+ 900 return
+ end
+cdeck id>, mnscan.
+ subroutine mnscan(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc scans the values of fcn as a function of one parameter
+cc and plots the resulting values as a curve using mnplot.
+cc it may be called to scan one parameter or all parameters.
+cc retains the best function and parameter values found.
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ xlreq = min(word7(3),word7(4))
+ xhreq = max(word7(3),word7(4))
+ ncall = word7(2) + 0.01
+ if (ncall .le. 1) ncall = 41
+ if (ncall .gt. maxcpt) ncall = maxcpt
+ nccall = ncall
+ if (amin .eq. undefi) call mnamin(fcn,futil)
+ iparwd = word7(1) + 0.1
+ ipar = max(iparwd, 0)
+ iint = niofex(ipar)
+ cstatu = 'no change'
+ if (iparwd .gt. 0) go to 200
+c
+c equivalent to a loop over parameters requested
+ 100 ipar = ipar + 1
+ if (ipar .gt. nu) go to 900
+ iint = niofex(ipar)
+ if (iint .le. 0) go to 100
+c set up range for parameter ipar
+ 200 continue
+ ubest = u(ipar)
+ xpt(1) = ubest
+ ypt(1) = amin
+ chpt(1)= ' '
+ xpt(2) = ubest
+ ypt(2) = amin
+ chpt(2)= 'x'
+ nxypt = 2
+ if (nvarl(ipar) .gt. 1) go to 300
+c no limits on parameter
+ if (xlreq .eq. xhreq) go to 250
+ unext = xlreq
+ step = (xhreq-xlreq)/float(ncall-1)
+ go to 500
+ 250 continue
+ xl = ubest - werr(iint)
+ xh = ubest+ werr(iint)
+ call mnbins(xl,xh,ncall, unext,uhigh,nbins,step)
+ nccall = nbins + 1
+ go to 500
+c limits on parameter
+ 300 continue
+ if (xlreq .eq. xhreq) go to 350
+ xl = max(xlreq,alim(ipar))
+ xh = min(xhreq,blim(ipar))
+ if (xl .ge. xh) go to 700
+ unext = xl
+ step = (xh-xl)/float(ncall-1)
+ go to 500
+ 350 continue
+ unext = alim(ipar)
+ step = (blim(ipar)-alim(ipar))/float(ncall-1)
+c main scanning loop over parameter ipar
+ 500 continue
+ do 600 icall = 1, nccall
+ u(ipar) = unext
+ nparx = npar
+ call fcn(nparx,gin,fnext,u,4,futil)
+ nfcn = nfcn + 1
+ nxypt = nxypt + 1
+ xpt(nxypt) = unext
+ ypt(nxypt) = fnext
+ chpt(nxypt) = '*'
+ if (fnext .lt. amin) then
+ amin = fnext
+ ubest = unext
+ cstatu= 'improved '
+ endif
+ 530 continue
+ unext = unext + step
+ 600 continue
+c finished with scan of parameter ipar
+ u(ipar) = ubest
+ call mnexin(x)
+ write (isyswr,1001) newpag,ipar,cpnam(ipar)
+ nunit = isyswr
+ call mnplot(xpt,ypt,chpt,nxypt,nunit,npagwd,npagln)
+ go to 800
+ 700 continue
+ write (isyswr,1000) ipar
+ 800 continue
+ if (iparwd .le. 0) go to 100
+c finished with all parameters
+ 900 continue
+ call mnprin(5,amin)
+ return
+ 1000 format (46h requested range outside limits for parameter ,i3/)
+ 1001 format (i1,'scan of parameter no.',i3,3h, ,a10)
+ end
+cdeck id>, mnseek.
+ subroutine mnseek(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc performs a rough (but global) minimization by monte carlo search.
+cc each time a new minimum is found, the search area is shifted
+cc to be centered at the best value. random points are chosen
+cc uniformly over a hypercube determined by current step sizes.
+cc the metropolis algorithm accepts a worse point with probability
+cc exp(-d/up), where d is the degradation. improved points
+cc are of course always accepted. actual steps are random
+cc multiples of the nominal steps (dirin).
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ parameter (twopi=2.0*3.141593)
+ dimension step(mni), xbest(mni), xmid(mni)
+ mxfail = word7(1)
+ if (mxfail .le. 0) mxfail=100+20*npar
+ mxstep = 10*mxfail
+ if (amin .eq. undefi) call mnamin(fcn,futil)
+ alpha = word7(2)
+ if (alpha .le. zero) alpha=3.
+ if (isw(5) .ge. 1) write (isyswr, 3) mxfail,mxstep,alpha
+ 3 format (' mnseek: monte carlo minimization using metropolis',
+ + ' algorithm'/' to stop after',i6,' successive failures, or',
+ + i7,' steps'/' maximum step size is',f9.3,' error bars.')
+ cstatu= 'initial '
+ if (isw(5) .ge. 2) call mnprin(2,amin)
+ cstatu = 'unchanged '
+ ifail = 0
+ rnum = zero
+ rnum1 = zero
+ rnum2 = zero
+ nparx = npar
+ flast = amin
+c set up step sizes, starting values
+ do 10 ipar = 1, npar
+ iext = nexofi(ipar)
+ dirin(ipar) = 2.0*alpha*werr(ipar)
+ if (nvarl(iext) .gt. 1) then
+c parameter with limits
+ call mndxdi(x(ipar),ipar,dxdi)
+ if (dxdi .eq. zero) dxdi=1.
+ dirin(ipar) = 2.0*alpha*werr(ipar)/dxdi
+ if (abs(dirin(ipar)).gt.twopi) dirin(ipar)=twopi
+ endif
+ xmid(ipar) = x(ipar)
+ 10 xbest(ipar) = x(ipar)
+c search loop
+ do 500 istep= 1, mxstep
+ if (ifail .ge. mxfail) go to 600
+ do 100 ipar= 1, npar
+ call mnrn15(rnum1,iseed)
+ call mnrn15(rnum2,iseed)
+ 100 x(ipar) = xmid(ipar) + 0.5*(rnum1+rnum2-1.)*dirin(ipar)
+ call mninex(x)
+ call fcn(nparx,gin,ftry,u,4,futil)
+ nfcn = nfcn + 1
+ if (ftry .lt. flast) then
+ if (ftry .lt. amin) then
+ cstatu = 'improvemnt'
+ amin = ftry
+ do 200 ib= 1, npar
+ 200 xbest(ib) = x(ib)
+ ifail = 0
+ if (isw(5) .ge. 2) call mnprin(2,amin)
+ endif
+ go to 300
+ else
+ ifail = ifail + 1
+c metropolis algorithm
+ bar = exp((amin-ftry)/up)
+ call mnrn15(rnum,iseed)
+ if (bar .lt. rnum) go to 500
+ endif
+c accept new point, move there
+ 300 continue
+ do 350 j= 1, npar
+ xmid(j) = x(j)
+ 350 continue
+ flast = ftry
+ 500 continue
+c end search loop
+ 600 continue
+ if (isw(5) .gt. 1) write (isyswr,601) ifail
+ 601 format(' mnseek:',i5,' successive unsuccessful trials.')
+ do 700 ib= 1, npar
+ 700 x(ib) = xbest(ib)
+ call mninex(x)
+ if (isw(5) .ge. 1) call mnprin(2,amin)
+ if (isw(5) .eq. 0) call mnprin(0,amin)
+ return
+ end
+cdeck id>, mnset.
+ subroutine mnset(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called from mnexcm
+cc interprets the commands that start with set and show
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+c
+ external fcn,futil
+c file characteristics for set input
+ logical lopen,lname
+ character*1 canswr
+ character cfname*64, cmode*16
+c 'set ' or 'show', 'on ' or 'off', 'suppressed' or 'reported '
+ character ckind*4, copt*3, cwarn*10
+c explanation of print level numbers -1:3 and strategies 0:2
+ character cprlev(-1:3)*34 ,cstrat(0:2)*44
+c identification of debug options
+ parameter (numdbg = 6)
+ character*40 cdbopt(0:numdbg)
+c things that can be set or shown
+ character*10 cname(30)
+ data cname( 1)/'fcn value '/
+ data cname( 2)/'parameters'/
+ data cname( 3)/'limits '/
+ data cname( 4)/'covariance'/
+ data cname( 5)/'correlatio'/
+ data cname( 6)/'print levl'/
+ data cname( 7)/'nogradient'/
+ data cname( 8)/'gradient '/
+ data cname( 9)/'error def '/
+ data cname(10)/'input file'/
+ data cname(11)/'width page'/
+ data cname(12)/'lines page'/
+ data cname(13)/'nowarnings'/
+ data cname(14)/'warnings '/
+ data cname(15)/'random gen'/
+ data cname(16)/'title '/
+ data cname(17)/'strategy '/
+ data cname(18)/'eigenvalue'/
+ data cname(19)/'page throw'/
+ data cname(20)/'minos errs'/
+ data cname(21)/'epsmachine'/
+ data cname(22)/'outputfile'/
+ data cname(23)/'batch '/
+ data cname(24)/'interactiv'/
+ data nname/24/
+c options not intended for normal users
+ data cname(25)/'reserve '/
+ data cname(26)/'reserve '/
+ data cname(27)/'nodebug '/
+ data cname(28)/'debug '/
+ data cname(29)/'show '/
+ data cname(30)/'set '/
+ data nntot/30/
+c
+ data cprlev(-1)/'-1: no output except from "show" '/
+ data cprlev( 0)/' 0: reduced output '/
+ data cprlev( 1)/' 1: normal output '/
+ data cprlev( 2)/' 2: extra output for problem cases'/
+ data cprlev( 3)/' 3: maximum output '/
+c
+ data cstrat( 0)/' 0: minimize the number of calls to function'/
+ data cstrat( 1)/' 1: try to balance speed against reliability'/
+ data cstrat( 2)/' 2: make sure minimum true, errors correct '/
+c
+ data cdbopt(0)/'report all exceptional conditions '/
+ data cdbopt(1)/'mnline: line search minimization '/
+ data cdbopt(2)/'mnderi: first derivative calculations '/
+ data cdbopt(3)/'mnhess: second derivative calculations '/
+ data cdbopt(4)/'mnmigr: covariance matrix updates '/
+ data cdbopt(5)/'mnhes1: first derivative uncertainties '/
+ data cdbopt(6)/'mncont: mncontour plot (mncros search) '/
+c
+c
+ do 2 i= 1, nntot
+ if (index(cword(4:10),cname(i)(1:3)) .gt. 0) go to 5
+ 2 continue
+ i = 0
+ 5 kname = i
+c
+c command could be set xxx, show xxx, help set or help show
+ if (index(cword(1:4),'hel') .gt. 0) go to 2000
+ if (index(cword(1:4),'sho') .gt. 0) go to 1000
+ if (index(cword(1:4),'set') .eq. 0) go to 1900
+c ---
+ ckind = 'set '
+c . . . . . . . . . . set unknown
+ if (kname .le. 0) go to 1900
+c . . . . . . . . . . set known
+ go to(3000, 20, 30, 40,3000, 60, 70, 80, 90, 100,
+ + 110, 120, 130, 140, 150, 160, 170,3000, 190,3000,
+ + 210, 220, 230, 240,1900,1900, 270, 280, 290, 300) , kname
+c
+c . . . . . . . . . . set param
+ 20 continue
+ iprm = word7(1)
+ if (iprm .gt. nu) go to 25
+ if (iprm .le. 0) go to 25
+ if (nvarl(iprm) .lt. 0) go to 25
+ u(iprm) = word7(2)
+ call mnexin(x)
+ isw2 = isw(2)
+ call mnrset(1)
+c keep approximate covariance matrix, even if new param value
+ isw(2) = min(isw2,1)
+ cfrom = 'set parm'
+ nfcnfr = nfcn
+ cstatu = 'new values'
+ go to 4000
+ 25 write (isyswr,'(a/)') ' undefined parameter number. ignored.'
+ go to 4000
+c . . . . . . . . . . set limits
+ 30 call mnlims(fcn,futil)
+ go to 4000
+c . . . . . . . . . . set covar
+ 40 continue
+c this command must be handled by mnread, and is not fortran-callable
+ go to 3000
+c . . . . . . . . . . set print
+ 60 isw(5) = word7(1)
+ go to 4000
+c . . . . . . . . . . set nograd
+ 70 isw(3) = 0
+ go to 4000
+c . . . . . . . . . . set grad
+ 80 call mngrad(fcn,futil)
+ go to 4000
+c . . . . . . . . . . set errdef
+ 90 if (word7(1) .eq. up) go to 4000
+ if (word7(1) .le. zero) then
+ if (up .eq. updflt) go to 4000
+ up = updflt
+ else
+ up = word7(1)
+ endif
+ do 95 i= 1, npar
+ ern(i) = 0.
+ 95 erp(i) = 0.
+ call mnwerr
+ go to 4000
+c . . . . . . . . . . set input
+c this command must be handled by mnread. if it gets this far,
+c it is illegal.
+ 100 continue
+ go to 3000
+c . . . . . . . . . . set width
+ 110 npagwd = word7(1)
+ npagwd = max(npagwd,50)
+ go to 4000
+c . . . . . . . . . . set lines
+ 120 npagln = word7(1)
+ go to 4000
+c . . . . . . . . . . set nowarn
+ 130 lwarn = .false.
+ go to 4000
+c . . . . . . . . . . set warn
+ 140 lwarn = .true.
+ call mnwarn('w','sho','sho')
+ go to 4000
+c . . . . . . . . . . set random
+ 150 jseed = int(word7(1))
+ val = 3.
+ call mnrn15(val, jseed)
+ if (isw(5) .gt. 0) write (isyswr, 151) jseed
+ 151 format (' minuit random number seed set to ',i10)
+ go to 4000
+c . . . . . . . . . . set title
+ 160 continue
+c this command must be handled by mnread, and is not fortran-callable
+ go to 3000
+c . . . . . . . . . set strategy
+ 170 istrat = word7(1)
+ istrat = max(istrat,0)
+ istrat = min(istrat,2)
+ if (isw(5) .gt. 0) go to 1172
+ go to 4000
+c . . . . . . . . . set page throw
+ 190 newpag = word7(1)
+ go to 1190
+c . . . . . . . . . . set epsmac
+ 210 if (word7(1).gt.zero .and. word7(1).lt.0.1) epsmac = word7(1)
+ epsma2 = dsqrt(epsmac)
+ go to 1210
+c . . . . . . . . . . set outputfile
+ 220 continue
+ iunit = word7(1)
+ isyswr = iunit
+ istkwr(1) = iunit
+ if (isw(5) .ge. 0) go to 1220
+ go to 4000
+c . . . . . . . . . . set batch
+ 230 isw(6) = 0
+ if (isw(5) .ge. 0) go to 1100
+ go to 4000
+c . . . . . . . . . . set interactive
+ 240 isw(6) = 1
+ if (isw(5) .ge. 0) go to 1100
+ go to 4000
+c . . . . . . . . . . set nodebug
+ 270 iset = 0
+ go to 281
+c . . . . . . . . . . set debug
+ 280 iset = 1
+ 281 continue
+ idbopt = word7(1)
+ if (idbopt .gt. numdbg) go to 288
+ if (idbopt .ge. 0) then
+ idbg(idbopt) = iset
+ if (iset .eq. 1) idbg(0) = 1
+ else
+c set debug -1 sets all debug options
+ do 285 id= 0, numdbg
+ 285 idbg(id) = iset
+ endif
+ lrepor = (idbg(0) .ge. 1)
+ call mnwarn('d','sho','sho')
+ go to 4000
+ 288 write (isyswr,289) idbopt
+ 289 format (' unknown debug option',i6,' requested. ignored')
+ go to 4000
+c . . . . . . . . . . set show
+ 290 continue
+c . . . . . . . . . . set set
+ 300 continue
+ go to 3000
+c -----------------------------------------------------
+ 1000 continue
+c at this point, cword must be 'show'
+ ckind = 'show'
+ if (kname .le. 0) go to 1900
+ go to (1010,1020,1030,1040,1050,1060,1070,1070,1090,1100,
+ + 1110,1120,1130,1130,1150,1160,1170,1180,1190,1200,
+ + 1210,1220,1100,1100,1900,1900,1270,1270,1290,1300),kname
+c
+c . . . . . . . . . . show fcn
+ 1010 continue
+ if (amin .eq. undefi) call mnamin(fcn,futil)
+ call mnprin (0,amin)
+ go to 4000
+c . . . . . . . . . . show param
+ 1020 continue
+ if (amin .eq. undefi) call mnamin(fcn,futil)
+ call mnprin (5,amin)
+ go to 4000
+c . . . . . . . . . . show limits
+ 1030 continue
+ if (amin .eq. undefi) call mnamin(fcn,futil)
+ call mnprin (1,amin)
+ go to 4000
+c . . . . . . . . . . show covar
+ 1040 call mnmatu(1)
+ go to 4000
+c . . . . . . . . . . show corre
+ 1050 call mnmatu(0)
+ go to 4000
+c . . . . . . . . . . show print
+ 1060 continue
+ if (isw(5) .lt.-1) isw(5) = -1
+ if (isw(5) .gt. 3) isw(5) = 3
+ write (isyswr,'(a)') ' allowed print levels are:'
+ write (isyswr,'(27x,a)') cprlev
+ write (isyswr,1061) cprlev(isw(5))
+ 1061 format (/' current printout level is ',a)
+ go to 4000
+c . . . . . . . show nograd, grad
+ 1070 continue
+ if (isw(3) .le. 0) then
+ write (isyswr, 1081)
+ 1081 format(' nograd is set. derivatives not computed in fcn.')
+ else
+ write (isyswr, 1082)
+ 1082 format(' grad is set. user computes derivatives in fcn.')
+ endif
+ go to 4000
+c . . . . . . . . . . show errdef
+ 1090 write (isyswr, 1091) up
+ 1091 format (' errors correspond to function change of',g13.5)
+ go to 4000
+c . . . . . . . . . . show input,
+c batch, or interactive
+ 1100 continue
+ inquire(unit=isysrd,opened=lopen,named=lname,name=cfname)
+ cmode = 'batch mode '
+ if (isw(6) .eq. 1) cmode = 'interactive mode'
+ if (.not. lname) cfname='unknown'
+ write (isyswr,1002) cmode,isysrd,cfname
+ 1002 format (' input now being read in ',a,' from unit no.',i3/
+ + ' filename: ',a)
+ go to 4000
+c . . . . . . . . . . show width
+ 1110 write (isyswr,1111) npagwd
+ 1111 format (10x,'page width is set to',i4,' columns')
+ go to 4000
+c . . . . . . . . . . show lines
+ 1120 write (isyswr,1121) npagln
+ 1121 format (10x,'page length is set to',i4,' lines')
+ go to 4000
+c . . . . . . .show nowarn, warn
+ 1130 continue
+ cwarn = 'suppressed'
+ if (lwarn) cwarn = 'reported '
+ write (isyswr,1141) cwarn
+ 1141 format (' minuit warning messages are ',a)
+ if (.not. lwarn) call mnwarn('w','sho','sho')
+ go to 4000
+c . . . . . . . . . . show random
+ 1150 val = 0.
+ call mnrn15(val,igrain)
+ ikseed = igrain
+ write (isyswr, 1151) ikseed
+ 1151 format (' minuit rndm seed is currently=',i10/)
+ val = 3.0
+ iseed = ikseed
+ call mnrn15(val,iseed)
+ go to 4000
+c . . . . . . . . . show title
+ 1160 write (isyswr,'(a,a)') ' title of current task is:',ctitl
+ go to 4000
+c . . . . . . . show strategy
+ 1170 write (isyswr, '(a)') ' allowed strategies are:'
+ write (isyswr, '(20x,a)') cstrat
+ 1172 write (isyswr, 1175) cstrat(istrat)
+ 1175 format (/' now using strategy ',a/)
+ go to 4000
+c . . . . . show eigenvalues
+ 1180 continue
+ iswsav = isw(5)
+ isw(5) = 3
+ if (isw(2) .lt. 1) then
+ write (isyswr,'(1x,a)') covmes(0)
+ else
+ call mnpsdf
+ endif
+ isw(5) = iswsav
+ go to 4000
+c . . . . . show page throw
+ 1190 write (isyswr,'(a,i3)') ' page throw carriage control =',newpag
+ if (newpag .eq. 0)
+ + write (isyswr,'(a)') ' no page throws in minuit output'
+ go to 4000
+c . . . . . . show minos errors
+ 1200 continue
+ do 1202 ii= 1, npar
+ if (erp(ii).gt.zero .or. ern(ii).lt.zero) go to 1204
+ 1202 continue
+ write (isyswr,'(a)')
+ + ' there are no minos errors currently valid.'
+ go to 4000
+ 1204 continue
+ call mnprin(4,amin)
+ go to 4000
+c . . . . . . . . . show epsmac
+ 1210 write (isyswr,'(a,e12.3)')
+ + ' floating-point numbers assumed accurate to',epsmac
+ go to 4000
+c . . . . . . show outputfiles
+ 1220 continue
+ write (isyswr,'(a,i4)') ' minuit primary output to unit',isyswr
+ go to 4000
+c . . . . . . show nodebug, debug
+ 1270 continue
+ do 1285 id= 0, numdbg
+ copt = 'off'
+ if (idbg(id) .ge. 1) copt = 'on '
+ 1285 write (isyswr,1286) id, copt, cdbopt(id)
+ 1286 format (10x,'debug option',i3,' is ',a3,' :',a)
+ if (.not. lrepor) call mnwarn('d','sho','sho')
+ go to 4000
+c . . . . . . . . . . show show
+ 1290 ckind = 'show'
+ go to 2100
+c . . . . . . . . . . show set
+ 1300 ckind = 'set '
+ go to 2100
+
+c -----------------------------------------------------
+c unknown command
+ 1900 write (isyswr, 1901) cword
+ 1901 format (' the command:',a10,' is unknown.'/)
+ go to 2100
+c -----------------------------------------------------
+c help show, help set, show set, or show show
+ 2000 ckind = 'set '
+ if (index(cword(4:10),'sho') .gt. 0) ckind = 'show'
+ 2100 write (isyswr, 2101) ckind,ckind, (cname(kk),kk=1,nname)
+ 2101 format (' the format of the ',a4,' command is:'//
+ + 1x,a4,' xxx [numerical arguments if any]'//
+ + ' where xxx may be one of the following:'/
+ + (7x,6a12))
+ go to 4000
+c -----------------------------------------------------
+c illegal command
+ 3000 write (isyswr,'('' above command is illegal. ignored'')')
+ 4000 return
+ end
+cdeck id>, mnseti.
+ subroutine mnseti(tit)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called by user to set or change title of current task.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ character*(*) tit
+ ctitl = tit
+ return
+ end
+cdeck id>, mnsimp.
+ subroutine mnsimp(fcn,futil)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc performs a minimization using the simplex method of nelder
+cc and mead (ref. -- comp. j. 7,308 (1965)).
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ external fcn,futil
+ dimension y(mni+1)
+ data alpha,beta,gamma,rhomin,rhomax / 1.0, 0.5, 2.0, 4.0, 8.0/
+ if (npar .le. 0) return
+ if (amin .eq. undefi) call mnamin(fcn,futil)
+ cfrom = 'simplex '
+ nfcnfr = nfcn
+ cstatu= 'unchanged '
+ npfn=nfcn
+ nparp1=npar+1
+ nparx = npar
+ rho1 = 1.0 + alpha
+ rho2 = rho1 + alpha*gamma
+ wg = 1.0/float(npar)
+ if (isw(5) .ge. 0) write(isyswr,100) epsi
+ 100 format(' start simplex minimization. convergence when edm .lt.'
+ +,e10.2 )
+ do 2 i= 1, npar
+ dirin(i) = werr(i)
+ call mndxdi(x(i),i,dxdi)
+ if (dxdi .ne. zero) dirin(i)=werr(i)/dxdi
+ dmin = epsma2*abs(x(i))
+ if (dirin(i) .lt. dmin) dirin(i)=dmin
+ 2 continue
+c** choose the initial simplex using single-parameter searches
+ 1 continue
+ ynpp1 = amin
+ jl = nparp1
+ y(nparp1) = amin
+ absmin = amin
+ do 10 i= 1, npar
+ aming = amin
+ pbar(i) = x(i)
+ bestx = x(i)
+ kg = 0
+ ns = 0
+ nf = 0
+ 4 x(i) = bestx + dirin(i)
+ call mninex(x)
+ call fcn(nparx,gin, f, u, 4, futil)
+ nfcn = nfcn + 1
+ if (f .le. aming) go to 6
+c failure
+ if (kg .eq. 1) go to 8
+ kg = -1
+ nf = nf + 1
+ dirin(i) = dirin(i) * (-0.4)
+ if (nf .lt. 3) go to 4
+ ns = 6
+c success
+ 6 bestx = x(i)
+ dirin(i) = dirin(i) * 3.0
+ aming = f
+ cstatu= 'progress '
+ kg = 1
+ ns = ns + 1
+ if (ns .lt. 6) go to 4
+c local minimum found in ith direction
+ 8 y(i) = aming
+ if (aming .lt. absmin) jl = i
+ if (aming .lt. absmin) absmin = aming
+ x(i) = bestx
+ do 9 k= 1, npar
+ 9 p(k,i) = x(k)
+ 10 continue
+ jh = nparp1
+ amin=y(jl)
+ call mnrazz(ynpp1,pbar,y,jh,jl)
+ do 20 i= 1, npar
+ 20 x(i) = p(i,jl)
+ call mninex(x)
+ cstatu = 'progress '
+ if (isw(5) .ge. 1) call mnprin(5,amin)
+ edm = bigedm
+ sig2 = edm
+ ncycl=0
+c . . . . . start main loop
+ 50 continue
+ if (sig2 .lt. epsi .and. edm.lt.epsi) go to 76
+ sig2 = edm
+ if ((nfcn-npfn) .gt. nfcnmx) go to 78
+c calculate new point * by reflection
+ do 60 i= 1, npar
+ pb = 0.
+ do 59 j= 1, nparp1
+ 59 pb = pb + wg * p(i,j)
+ pbar(i) = pb - wg * p(i,jh)
+ 60 pstar(i)=(1.+alpha)*pbar(i)-alpha*p(i,jh)
+ call mninex(pstar)
+ call fcn(nparx,gin,ystar,u,4,futil)
+ nfcn=nfcn+1
+ if(ystar.ge.amin) go to 70
+c point * better than jl, calculate new point **
+ do 61 i=1,npar
+ 61 pstst(i)=gamma*pstar(i)+(1.-gamma)*pbar(i)
+ call mninex(pstst)
+ call fcn(nparx,gin,ystst,u,4,futil)
+ nfcn=nfcn+1
+c try a parabola through ph, pstar, pstst. min = prho
+ y1 = (ystar-y(jh)) * rho2
+ y2 = (ystst-y(jh)) * rho1
+ rho = 0.5 * (rho2*y1 -rho1*y2) / (y1 -y2)
+ if (rho .lt. rhomin) go to 66
+ if (rho .gt. rhomax) rho = rhomax
+ do 64 i= 1, npar
+ 64 prho(i) = rho*pbar(i) + (1.0-rho)*p(i,jh)
+ call mninex(prho)
+ call fcn(nparx,gin,yrho, u,4,futil)
+ nfcn = nfcn + 1
+ if (yrho .lt. y(jl) .and. yrho .lt. ystst) go to 65
+ if (ystst .lt. y(jl)) go to 67
+ if (yrho .gt. y(jl)) go to 66
+c accept minimum point of parabola, prho
+ 65 call mnrazz (yrho,prho,y,jh,jl)
+ go to 68
+ 66 if (ystst .lt. y(jl)) go to 67
+ call mnrazz(ystar,pstar,y,jh,jl)
+ go to 68
+ 67 call mnrazz(ystst,pstst,y,jh,jl)
+ 68 ncycl=ncycl+1
+ if (isw(5) .lt. 2) go to 50
+ if (isw(5) .ge. 3 .or. mod(ncycl, 10) .eq. 0) call mnprin(5,amin)
+ go to 50
+c point * is not as good as jl
+ 70 if (ystar .ge. y(jh)) go to 73
+ jhold = jh
+ call mnrazz(ystar,pstar,y,jh,jl)
+ if (jhold .ne. jh) go to 50
+c calculate new point **
+ 73 do 74 i=1,npar
+ 74 pstst(i)=beta*p(i,jh)+(1.-beta)*pbar(i)
+ call mninex (pstst)
+ call fcn(nparx,gin,ystst,u,4,futil)
+ nfcn=nfcn+1
+ if(ystst.gt.y(jh)) go to 1
+c point ** is better than jh
+ if (ystst .lt. amin) go to 67
+ call mnrazz(ystst,pstst,y,jh,jl)
+ go to 50
+c . . . . . . end main loop
+ 76 if (isw(5) .ge. 0) write(isyswr,'(a)')
+ + ' simplex minimization has converged.'
+ isw(4) = 1
+ go to 80
+ 78 if (isw(5) .ge. 0) write(isyswr,'(a)')
+ + ' simplex terminates without convergence.'
+ cstatu= 'call limit'
+ isw(4) = -1
+ isw(1) = 1
+ 80 do 82 i=1,npar
+ pb = 0.
+ do 81 j=1,nparp1
+ 81 pb = pb + wg * p(i,j)
+ 82 pbar(i) = pb - wg * p(i,jh)
+ call mninex(pbar)
+ call fcn(nparx,gin,ypbar,u,4,futil)
+ nfcn=nfcn+1
+ if (ypbar .lt. amin) call mnrazz(ypbar,pbar,y,jh,jl)
+ call mninex(x)
+ if (nfcnmx+npfn-nfcn .lt. 3*npar) go to 90
+ if (edm .gt. 2.0*epsi) go to 1
+ 90 if (isw(5) .ge. 0) call mnprin(5, amin)
+ return
+ end
+cdeck id>, mnstat.
+ subroutine mnstat(fmin,fedm,errdef,npari,nparx,istat)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc user-called
+cc provides the user with information concerning the current status
+cc of the current minimization. namely, it returns:
+cc fmin: the best function value found so far
+cc fedm: the estimated vertical distance remaining to minimum
+cc errdef: the value of up defining parameter uncertainties
+cc npari: the number of currently variable parameters
+cc nparx: the highest (external) parameter number defined by user
+cc istat: a status integer indicating how good is the covariance
+cc matrix: 0= not calculated at all
+cc 1= approximation only, not accurate
+cc 2= full matrix, but forced positive-definite
+cc 3= full accurate covariance matrix
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ fmin = amin
+ fedm = edm
+ errdef = up
+ npari = npar
+ nparx = nu
+ istat = isw(2)
+ if (edm .eq. bigedm) then
+ fedm = up
+ endif
+ if (amin .eq. undefi) then
+ fmin = 0.0
+ fedm = up
+ istat= 0
+ endif
+ return
+ end
+cdeck id>, mnstin.
+ subroutine mnstin(crdbuf,ierr)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc called from mnread.
+cc implements the set input command to change input units.
+cc if command is: 'set input' 'set input 0' or '*eof',
+cc or 'set input , , ',
+cc reverts to previous input unit number,if any.
+cc
+cc if it is: 'set input n' or 'set input n filename',
+cc changes to new input file, added to stack
+cc
+cc ierr = 0: reading terminated normally
+cc 2: end-of-data on primary input file
+cc 3: unrecoverable read error
+cc 4: unable to process request
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ character crdbuf*(*),cunit*10,cfname*64,cgname*64,canswr*1
+ character cmode*16
+ logical lopen,lrewin,noname,lname,mnunpt
+ noname = .true.
+ ierr = 0
+ if (index(crdbuf,'*eof') .eq. 1) go to 190
+ if (index(crdbuf,'*eof') .eq. 1) go to 190
+ lend = len(crdbuf)
+c look for end of set input command
+ do 20 ic= 8,lend
+ if (crdbuf(ic:ic) .eq. ' ') go to 25
+ if (crdbuf(ic:ic) .eq. ',') go to 53
+ 20 continue
+ go to 200
+ 25 continue
+c look for end of separator between command and first argument
+ icol = ic+1
+ do 50 ic= icol,lend
+ if (crdbuf(ic:ic) .eq. ' ') go to 50
+ if (crdbuf(ic:ic) .eq. ',') go to 53
+ go to 55
+ 50 continue
+ go to 200
+ 53 ic = ic + 1
+ 55 ic1 = ic
+c see if "rewind" was requested in command
+ lrewin = .false.
+ if (index(crdbuf(1:ic1),'rew') .gt. 5) lrewin=.true.
+ if (index(crdbuf(1:ic1),'rew') .gt. 5) lrewin=.true.
+c first argument begins in or after col ic1
+ do 75 ic= ic1,lend
+ if (crdbuf(ic:ic) .eq. ' ') go to 75
+ if (crdbuf(ic:ic) .eq. ',') go to 200
+ go to 80
+ 75 continue
+ go to 200
+ 80 ic1 = ic
+c first argument really begins in col ic1
+ do 100 ic= ic1+1,lend
+ if (crdbuf(ic:ic) .eq. ' ') go to 108
+ if (crdbuf(ic:ic) .eq. ',') go to 108
+ 100 continue
+ ic = lend + 1
+ 108 ic2 = ic-1
+c end of first argument is in col ic2
+ 110 continue
+ cunit = crdbuf(ic1:ic2)
+ write (isyswr,'(a,a)') ' unit no. :',cunit
+ read (cunit,'(bn,f10.0)',err=500) funit
+ iunit = funit
+ if (iunit .eq. 0) go to 200
+c skip blanks and commas, find file name
+ do 120 ic= ic2+1,lend
+ if (crdbuf(ic:ic) .eq. ' ') go to 120
+ if (crdbuf(ic:ic) .eq. ',') go to 120
+ go to 130
+ 120 continue
+ go to 131
+ 130 continue
+ cfname = crdbuf(ic:lend)
+ noname = .false.
+ write (isyswr, '(a,a)') ' file name is:',cfname
+c ask if file exists, if not ask for name and open it
+ 131 continue
+ inquire(unit=iunit,opened=lopen,named=lname,name=cgname)
+ if (lopen) then
+ if (noname) then
+ go to 136
+ else
+ if (.not.lname) cgname='unknown'
+ write (isyswr,132) iunit,cgname,cfname
+ 132 format (' unit',i3,' already opened with name:',a/
+ + ' new name ignored:',a)
+ endif
+ else
+c new file, open it
+ write (isyswr,135) iunit
+ 135 format (' unit',i3,' is not opened.')
+ if (noname) then
+ write (isyswr,'(a)') ' no file name given in command.'
+ if (isw(6) .ne. 1) go to 800
+ write (isyswr,'(a)') ' please give file name:'
+ read (isysrd,'(a)') cfname
+ endif
+ open (unit=iunit,file=cfname,status='old',err=600)
+ write (isyswr,'(a)') ' file opened successfully.'
+ endif
+c . . file is correctly opened
+ 136 if (lrewin) go to 150
+ if (isw(6) .ne. 1) go to 300
+ write (isyswr,137) iunit
+ 137 format (' should unit',i3,' be rewound?' )
+ read (isysrd,'(a)') canswr
+ if (canswr.ne.'y' .and. canswr.ne.'y') go to 300
+ 150 rewind iunit
+ go to 300
+c *eof
+ 190 continue
+ if (nstkrd .eq. 0) then
+ ierr = 2
+ go to 900
+ endif
+c revert to previous input file
+ 200 continue
+ if (nstkrd .eq. 0) then
+ write (isyswr, '(a,a)') ' command ignored:',crdbuf
+ write (isyswr, '(a)') ' already reading from primary input'
+ else
+ isysrd = istkrd(nstkrd)
+ nstkrd = nstkrd - 1
+ if (nstkrd .eq. 0) isw(6) = iabs(isw(6))
+ if (isw(5) .ge. 0) then
+ inquire(unit=isysrd,named=lname,name=cfname)
+ cmode = 'batch mode '
+ if (isw(6) .eq. 1) cmode = 'interactive mode'
+ if (.not.lname) cfname='unknown'
+ if (mnunpt(cfname)) cfname='unprintable'
+ write (isyswr,290) cmode,isysrd,cfname
+ 290 format (' input will now be read in ',a,' from unit no.',i3/
+ + ' filename: ',a)
+ endif
+ endif
+ go to 900
+c switch to new input file, add to stack
+ 300 continue
+ if (nstkrd .ge. maxstk) then
+ write (isyswr, '(a)') ' input file stack size exceeded.'
+ go to 800
+ endif
+ nstkrd = nstkrd + 1
+ istkrd(nstkrd) = isysrd
+ isysrd = iunit
+c isw(6) = 0 for batch, =1 for interactive, and
+c =-1 for originally interactive temporarily batch
+ if (isw(6) .eq. 1) isw(6) = -1
+ go to 900
+c format error
+ 500 continue
+ write (isyswr,'(a,a)') ' cannot read following as integer:',cunit
+ go to 800
+ 600 continue
+ write (isyswr, 601) cfname
+ 601 format (' system is unable to open file:',a)
+c serious error
+ 800 continue
+ ierr = 3
+ 900 continue
+ return
+ end
+cdeck id>, mntiny.
+ subroutine mntiny(epsp1,epsbak)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc compares its argument with the value 1.0, and returns
+cc the value .true. if they are equal. to find epsmac
+cc safely by foiling the fortran optimizer
+cc
+ parameter (one=1.0)
+ epsbak = epsp1 - one
+ return
+ end
+cdeck id>, mnunpt.
+ logical function mnunpt(cfname)
+c is .true. if cfname contains unprintable characters.
+ character cfname*(*)
+ character cpt*80, cp1*40,cp2*40
+ parameter (cp1=' abcdefghijklmnopqrstuvwxyzabcdefghijklm')
+ parameter (cp2='nopqrstuvwxyz1234567890./;:[]$%*_!@#&+()')
+ cpt=cp1//cp2
+ mnunpt = .false.
+ l = len(cfname)
+ do 100 i= 1, l
+ do 50 ic= 1, 80
+ if (cfname(i:i) .eq. cpt(ic:ic)) go to 100
+ 50 continue
+ mnunpt = .true.
+ go to 150
+ 100 continue
+ 150 continue
+ return
+ end
+cdeck id>, mnvert.
+ subroutine mnvert(a,l,m,n,ifail)
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc inverts a symmetric matrix. matrix is first scaled to
+cc have all ones on the diagonal (equivalent to change of units)
+cc but no pivoting is done since matrix is positive-definite.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ dimension a(l,m) ,pp(mni), q(mni), s(mni)
+ ifail=0
+ if (n .lt. 1) go to 100
+ if (n .gt. maxint) go to 100
+c scale matrix by dsqrt of diag elements
+ do 8 i=1,n
+ si = a(i,i)
+ if (si) 100,100,8
+ 8 s(i) = 1.0/dsqrt(si)
+ do 20 i= 1, n
+ do 20 j= 1, n
+ 20 a(i,j) = a(i,j) *s(i)*s(j)
+c . . . start main loop . . . .
+ do 65 i=1,n
+ k = i
+c preparation for elimination step1
+ q(k)=1./a(k,k)
+ pp(k) = 1.0
+ a(k,k)=0.0
+ kp1=k+1
+ km1=k-1
+ if(km1)100,50,40
+ 40 do 49 j=1,km1
+ pp(j)=a(j,k)
+ q(j)=a(j,k)*q(k)
+ 49 a(j,k)=0.
+ 50 if(k-n)51,60,100
+ 51 do 59 j=kp1,n
+ pp(j)=a(k,j)
+ q(j)=-a(k,j)*q(k)
+ 59 a(k,j)=0.0
+c elimination proper
+ 60 do 65 j=1,n
+ do 65 k=j,n
+ 65 a(j,k)=a(j,k)+pp(j)*q(k)
+c elements of left diagonal and unscaling
+ do 70 j= 1, n
+ do 70 k= 1, j
+ a(k,j) = a(k,j) *s(k)*s(j)
+ 70 a(j,k) = a(k,j)
+ return
+c failure return
+ 100 ifail=1
+ return
+ end
+cdeck id>, mnwarn.
+ subroutine mnwarn(copt,corg,cmes)
+c if copt='w', cmes is a warning message from corg.
+c if copt='d', cmes is a debug message from corg.
+c if set warnings is in effect (the default), this routine
+c prints the warning message cmes coming from corg.
+c if set nowarnings is in effect, the warning message is
+c stored in a circular buffer of length maxmes.
+c if called with corg=cmes='sho', it prints the messages in
+c the circular buffer, fifo, and empties the buffer.
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+ character copt*1, corg*(*), cmes*(*), ctyp*7
+ parameter (maxmes=10)
+ character origin(maxmes,2)*10, warmes(maxmes,2)*60
+ common/mn7wrc/origin, warmes
+ common/mn7wri/nfcwar(maxmes,2),icirc(2)
+ character englsh*20
+c
+ if (corg(1:3).eq.'sho' .and. cmes(1:3).eq.'sho') go to 200
+c either print warning or put in buffer
+ if (copt .eq. 'w') then
+ ityp = 1
+ if (lwarn) then
+ write (isyswr,'(a,a/a,a)') ' minuit warning in ',corg,
+ + ' ============== ',cmes
+ return
+ endif
+ else
+ ityp = 2
+ if (lrepor) then
+ write (isyswr,'(a,a/a,a)') ' minuit debug for ',corg,
+ + ' ============== ',cmes
+ return
+ endif
+ endif
+c if appropriate flag is off, fill circular buffer
+ if (nwrmes(ityp) .eq. 0) icirc(ityp) = 0
+ nwrmes(ityp) = nwrmes(ityp) + 1
+ icirc(ityp) = icirc(ityp) + 1
+ if (icirc(ityp) .gt. maxmes) icirc(ityp) = 1
+ ic = icirc(ityp)
+ origin(ic,ityp) = corg
+ warmes(ic,ityp) = cmes
+ nfcwar(ic,ityp) = nfcn
+ return
+c
+c 'sho warnings', ask if any suppressed mess in buffer
+ 200 continue
+ if (copt .eq. 'w') then
+ ityp = 1
+ ctyp = 'warning'
+ else
+ ityp = 2
+ ctyp = '*debug*'
+ endif
+ if (nwrmes(ityp) .gt. 0) then
+ englsh = ' was suppressed. '
+ if (nwrmes(ityp) .gt. 1) englsh = 's were suppressed.'
+ write (isyswr,'(/1x,i5,a,a,a,a/)') nwrmes(ityp),
+ + ' minuit ',ctyp,' message', englsh
+ nm = nwrmes(ityp)
+ ic = 0
+ if (nm .gt. maxmes) then
+ write (isyswr,'(a,i2,a)') ' only the most recent ',
+ + maxmes,' will be listed below.'
+ nm = maxmes
+ ic = icirc(ityp)
+ endif
+ write (isyswr,'(a)') ' calls origin message'
+ do 300 i= 1, nm
+ ic = ic + 1
+ if (ic .gt. maxmes) ic = 1
+ write (isyswr,'(1x,i6,1x,a,1x,a)')
+ + nfcwar(ic,ityp),origin(ic,ityp),warmes(ic,ityp)
+ 300 continue
+ nwrmes(ityp) = 0
+ write (isyswr,'(1h )')
+ endif
+ return
+ end
+cdeck id>, mnwerr.
+ subroutine mnwerr
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc calculates the werr, external parameter errors,
+cc and the global correlation coefficients, to be called
+cc whenever a new covariance matrix is available.
+cc
+ parameter (mne=100 , mni=50)
+ parameter (mnihl=mni*(mni+1)/2)
+ character*10 cpnam
+ common
+ 1/mn7nam/ cpnam(mne)
+ 2/mn7ext/ u(mne) ,alim(mne) ,blim(mne)
+ 3/mn7err/ erp(mni) ,ern(mni) ,werr(mni) ,globcc(mni)
+ 4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
+ 5/mn7int/ x(mni) ,xt(mni) ,dirin(mni)
+ 6/mn7fx2/ xs(mni) ,xts(mni) ,dirins(mni)
+ 7/mn7der/ grd(mni) ,g2(mni) ,gstep(mni) ,gin(mne) ,dgrd(mni)
+ 8/mn7fx3/ grds(mni) ,g2s(mni) ,gsteps(mni)
+ 9/mn7fx1/ ipfix(mni) ,npfix
+ a/mn7var/ vhmat(mnihl)
+ b/mn7vat/ vthmat(mnihl)
+ c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
+c
+ parameter (maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
+ parameter (zero=0.0, one=1.0, half=0.5)
+ common
+ d/mn7npr/ maxint ,npar ,maxext ,nu
+ e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
+ e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
+ f/mn7tit/ cfrom ,cstatu ,ctitl ,cword ,cundef ,cvrsn ,covmes
+ g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
+ h/mn7min/ amin ,up ,edm ,fval3 ,epsi ,apsi ,dcovar
+ i/mn7cnv/ nfcn ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
+ j/mn7arg/ word7(maxp)
+ k/mn7log/ lwarn ,lrepor ,limset ,lnolim ,lnewmn ,lphead
+ l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
+ m/mn7rpt/ xpt(maxcpt) ,ypt(maxcpt)
+ n/mn7cpt/ chpt(maxcpt)
+ o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr ,ke2cr
+ character ctitl*50, cword*(maxcwd), cundef*10, cfrom*8,
+ + cvrsn*6, covmes(0:3)*22, cstatu*10, chpt*1
+ logical lwarn, lrepor, limset, lnolim, lnewmn, lphead
+c calculate external error if v exists
+ if (isw(2) .ge. 1) then
+ do 100 l= 1, npar
+ ndex = l*(l+1)/2
+ dx = dsqrt(abs(vhmat(ndex)*up))
+ i = nexofi(l)
+ if (nvarl(i) .gt. 1) then
+ al = alim(i)
+ ba = blim(i) - al
+ du1 = al + 0.5 *(dsin(x(l)+dx) +1.0) * ba - u(i)
+ du2 = al + 0.5 *(dsin(x(l)-dx) +1.0) * ba - u(i)
+ if (dx .gt. 1.0) du1 = ba
+ dx = 0.5 * (abs(du1) + abs(du2))
+ endif
+ werr(l) = dx
+ 100 continue
+ endif
+c global correlation coefficients
+ if (isw(2) .ge. 1) then
+ do 130 i= 1, npar
+ globcc(i) = 0.
+ k1 = i*(i-1)/2
+ do 130 j= 1, i
+ k = k1 + j
+ p(i,j) = vhmat(k)
+ 130 p(j,i) = p(i,j)
+ call mnvert(p,maxint,maxint,npar,ierr)
+ if (ierr .eq. 0) then
+ do 150 iin= 1, npar
+ ndiag = iin*(iin+1)/2
+ denom = p(iin,iin)*vhmat(ndiag)
+ if (denom.le.one .and. denom.ge.zero) then
+ globcc(iin) = 0.
+ else
+ globcc(iin) = dsqrt(1.0-1.0/denom)
+ endif
+ 150 continue
+ endif
+ endif
+ return
+ end
+cdeck id>, stand.
+ subroutine stand
+c ************ double precision version *************
+ implicit double precision (a-h,o-z)
+cc optional user-supplied subroutine is called whenever the
+cc command "standard" appears.
+cc
+ return
+ end
diff --git a/Lib/Opt/Makefile.PL b/Lib/Opt/Makefile.PL
new file mode 100644
index 0000000..316614b
--- /dev/null
+++ b/Lib/Opt/Makefile.PL
@@ -0,0 +1,15 @@
+use ExtUtils::MakeMaker;
+
+my @dirs =
+ (
+ 'Simplex',
+# 'Golden' # what is this?
+ );
+
+WriteMakefile(
+ 'NAME' => 'PDL::Opt',
+ VERSION_FROM => '../../Basic/Core/Version.pm',
+ DIR => [ @dirs ],
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
diff --git a/Lib/Opt/Simplex/Makefile.PL b/Lib/Opt/Simplex/Makefile.PL
new file mode 100644
index 0000000..6666002
--- /dev/null
+++ b/Lib/Opt/Simplex/Makefile.PL
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(NAME => "PDL::Opt::Simplex",
+ PM => {
+ map {($_ => '$(INST_LIBDIR)/'.$_)} <*.pm>
+ },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
diff --git a/Lib/Opt/Simplex/Simplex.pm b/Lib/Opt/Simplex/Simplex.pm
new file mode 100644
index 0000000..fdde547
--- /dev/null
+++ b/Lib/Opt/Simplex/Simplex.pm
@@ -0,0 +1,229 @@
+
+=head1 NAME
+
+PDL::Opt::Simplex -- Simplex optimization routines
+
+=head1 SYNOPSIS
+
+ use PDL::Opt::Simplex;
+
+ ($optimum,$ssize,$optval) = simplex($init,$initsize,$minsize,
+ $maxiter,
+ sub {evaluate_func_at($_[0])},
+ sub {display_simplex($_[0])}
+ );
+
+=head1 DESCRIPTION
+
+This package implements the commonly used simplex optimization
+algorithm. The basic idea of the algorithm is to move
+a "simplex" of N+1 points in the N-dimensional search space
+according to certain rules. The main
+benefit of the algorithm is that you do not need to calculate
+the derivatives of your function.
+
+$init is a 1D vector holding the initial values of the N fitted
+parameters, $optimum is a vector holding the final solution.
+$optval is the evaluation of the final solution.
+
+$initsize is the size of $init (more...)
+
+$minsize is some sort of convergence criterion (more...)
+- e.g. $minsize = 1e-6
+
+The sub is assumed to understand more than 1 dimensions and threading.
+Its signature is 'inp(nparams); [ret]out()'. An example would be
+
+ sub evaluate_func_at {
+ my($xv) = @_;
+ my $x1 = $xv->slice("(0)");
+ my $x2 = $xv->slice("(1)");
+ return $x1**4 + ($x2-5)**4 + $x1*$x2;
+ }
+
+Here $xv is a vector holding the current values of the parameters
+being fitted which are then sliced out explicitly as $x1 and $x2.
+
+$ssize gives a very very approximate estimate of how close we might
+be - it might be miles wrong. It is the euclidean distance between
+the best and the worst vertices. If it is not very small, the algorithm
+has not converged.
+
+=head1 FUNCTIONS
+
+=head2 simplex
+
+=for ref
+
+Simplex optimization routine
+
+=for usage
+
+ ($optimum,$ssize,$optval) = simplex($init,$initsize,$minsize,
+ $maxiter,
+ sub {evaluate_func_at($_[0])},
+ sub {display_simplex($_[0])}
+ );
+
+See module C<PDL::Opt::Simplex> for more information.
+
+=head1 CAVEATS
+
+Do not use the simplex method if your function has local minima.
+It will not work. Use genetic algorithms or simulated annealing
+or conjugate gradient or momentum gradient descent.
+
+They will not really work either but they are not guaranteed not to work ;)
+(if you have infinite time, simulated annealing is guaranteed to work
+but only after it has visited every point in your space).
+
+=head1 SEE ALSO
+
+Ron Shaffer's chemometrics web page and references therein:
+C<http://chem1.nrl.navy.mil/~shaffer/chemoweb.html>.
+
+Numerical Recipes (bla bla bla XXX ref).
+
+The demonstration (Examples/Simplex/tsimp.pl and tsimp2.pl).
+
+=head1 AUTHOR
+
+Copyright(C) 1997 Tuomas J. Lukka.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+
+
+=cut
+
+package PDL::Opt::Simplex;
+use PDL;
+use PDL::Primitive;
+use strict;
+use PDL::Exporter;
+
+# use AutoLoader;
+
+ at PDL::Opt::Simplex::ISA = qw/PDL::Exporter/;
+
+ at PDL::Opt::Simplex::EXPORT_OK = qw/simplex/;
+%PDL::Opt::Simplex::EXPORT_TAGS = ( Func => [@PDL::Opt::Simplex::EXPORT_OK] );
+
+*simplex = \&PDL::simplex;
+
+sub PDL::simplex {
+ my ( $init, $initsize, $minsize, $maxiter, $sub, $logsub, $t ) = @_;
+ if ( !defined $t ) { $t = 0 }
+ my ( $i, $j );
+ my ( $nd, $nd2 ) = ( dims($init), 1 );
+ my $simp;
+ if ( $nd2 == 1 ) {
+ $simp = PDL->zeroes( $nd, $nd + 1 );
+ $simp .= $init;
+
+ # Constructing a tetrahedron:
+ # At step n (starting from zero)
+ # take vertices 0..n and move them 1/(n+1) to negative dir on axis n.
+ # Take vertex n+1 and move it n/(n+1) to positive dir on axis n
+ if ( !ref $initsize ) {
+ $initsize = PDL->pdl($initsize)->dummy( 0, $nd );
+ }
+ for ( $i = 0 ; $i < $nd ; $i++ ) {
+ my $pj = $i / ( $i + 1 );
+ ( my $stoopid = $simp->slice("$i,0:$i") ) -=
+ $initsize->at($i) * $pj;
+ ( my $stoopid1 = $simp->slice( "$i," . ( $i + 1 ) ) ) +=
+ $initsize->at($i) * ( 1 - $pj );
+ }
+ }
+ elsif ( $nd2 == $nd + 1 ) {
+ $simp = $init;
+ }
+ else {
+ return;
+ }
+ my $maxind = PDL->zeroes(2);
+ my $minind = PDL->null;
+ my $ssum = PDL->null;
+ my $worst;
+ my $new;
+ my $vals = &{$sub}($simp);
+ my $ss1 = ( $simp - $simp->slice(":,0") )**2;
+ sumover( $ss1, ( my $ss2 = PDL->null ) );
+ my $ssize = PDL::max( sqrt($ss2) );
+ &{$logsub}( $simp, $vals, $ssize )
+ if $logsub;
+
+ while ( $maxiter-- and max( PDL->topdl($ssize) ) > $minsize ) {
+ my $valsn = $vals;
+ if ($t) {
+ my $noise = $vals->random();
+ $noise->random;
+ $valsn = $vals + $t * ( -log( $noise + 0.00001 ) );
+ }
+ maximum_n_ind( $valsn, $maxind );
+ minimum_ind( $valsn, $minind );
+ my @worstvals = map { $valsn->at( $maxind->at($_) ) } 0 .. 1;
+ my $bestval = $valsn->at($minind);
+
+ sumover( $simp->xchg( 0, 1 ), $ssum );
+ $ssum -= ( $worst = $simp->slice( ":,(" . $maxind->at(0) . ")" ) );
+ $ssum /= $nd;
+ $new = 2 * $ssum - $worst;
+ my $val = ( &{$sub}($new) )->at(0);
+ if ($t) {
+ $val = $val - $t * ( -log( rand() + 0.00001 ) );
+ }
+ my $removetop = 0;
+ if ( $val < $bestval ) {
+ my $newnew = $new + $ssum - $worst;
+ my $val2 = &{$sub}($newnew);
+ if ( $val2->at(0) < $val ) {
+# print "CASE1 Reflection and Expansion\n";
+ $worst .= $newnew;
+ $val = $val2;
+ }
+ else {
+# print "CASE2 Reflection, $newnew, $val, $val2\n";
+ $worst .= $new;
+ }
+ $removetop = 1;
+ }
+ elsif ( $val < $worstvals[1] ) {
+# print "CASE3 Reflection\n";
+ $worst .= $new;
+ $removetop = 1;
+ }
+ else {
+ my $newnew = 0.5 * $ssum + 0.5 * $worst;
+ my $val2 = &{$sub}($newnew);
+ if ( $val2->at(0) < $worstvals[0] ) {
+# print "CASE4 Contraction, $newnew, $val, $val2\n";
+ $worst .= $newnew;
+ $val = $val2;
+ $removetop = 1;
+ }
+ }
+ if ($removetop) {
+ ( my $stoopid = $vals->slice( "(" . $maxind->at(0) . ")" ) ) .= $val;
+ }
+ else {
+# print "CASE5 Multiple Contraction\n";
+ $simp = 0.5 * $simp->slice(":,$minind") + 0.5 * $simp;
+ my $idx = which( sequence($nd+1) != $minind );
+ ( my $stoopid = $vals->index($idx) ) .= &{$sub}($simp->dice_axis(1,$idx));
+ }
+ my $ss1 = ( $simp - $simp->slice(":,0") )**2;
+ sumover( $ss1, ( $ss2 = PDL->null ) );
+ $ssize = PDL::max( sqrt($ss2) );
+ &{$logsub}( $simp, $vals, $ssize )
+ if $logsub;
+ }
+ minimum_ind( $vals, ( my $mmind = PDL->null ) );
+ return ( $simp->slice(":,$mmind"), $ssize, $vals->index($mmind) );
+}
+
+1;
diff --git a/Lib/Slatec/Makefile.PL b/Lib/Slatec/Makefile.PL
new file mode 100644
index 0000000..86ad3be
--- /dev/null
+++ b/Lib/Slatec/Makefile.PL
@@ -0,0 +1,148 @@
+
+# Slatec module
+
+use ExtUtils::MakeMaker;
+use Config;
+PDL::Core::Dev->import();
+
+# This mess sorts out the Fortran availability - KGB.
+# Depends on ExtUtils::F77
+
+BEGIN {
+ $donot = 0;
+ $msg = ""; $forcebuild=0;
+
+ if (defined $PDL::Config{WITH_SLATEC} && $PDL::Config{WITH_SLATEC}==0) {
+ $msg = "\n Will skip build of PDL::Slatec on this system \n";
+ goto skip;
+ }
+
+ if (defined $PDL::Config{WITH_SLATEC} && $PDL::Config{WITH_SLATEC}==1) {
+ print "\n Will forcibly try and build PDL::Slatec on this system \n\n";
+ $forcebuild=1;
+ }
+
+ if (exists $PDL::Config{F77CONF} && -f $PDL::Config{F77CONF}) {
+ print "loading F77 configuration from $PDL::Config{F77CONF}...\n";
+ eval "require '$PDL::Config{F77CONF}'";
+ if ($@ ne "") {
+ $msg = "\n".$@.
+ "\n\tF77CONF file not loaded. Ought not build PDL::Slatec\n" ;
+ goto skip unless $forcebuild;
+ }
+ $f77 = 'F77Conf';
+ } else {
+ eval "use ExtUtils::F77"; # Might want "use ExtUtils::F77 qw(generic f2c)"
+ if ($@ ne "") {
+ $msg = "\n".$@.
+ "\n\tExtUtils::F77 module not found. Ought not build PDL::Slatec\n" ;
+ goto skip unless $forcebuild;
+ } else {
+ $f77 = 'ExtUtils::F77';
+ print "(ExtUtils Version $ExtUtils::F77::VERSION)\n";
+ if ($ExtUtils::F77::VERSION < 1.03 ) {
+ $msg = "\n\tneed a version of ExtUtils::F77 >= 1.03. Ought not build PDL::Slatec\n" ;
+ goto skip unless $forcebuild;
+ }
+ } # end if ($@ ne "")
+ } # if (exists $PDL::Config{F77CONF}...
+
+ $compiler_available = $f77->testcompiler;
+
+ if (!$compiler_available) {
+ $msg = "\n No f77 compiler found. Ought to skip PDL::Slatec on this system \n";
+ $PDL::Config{WITH_SLATEC} = 0;
+ } else {
+ $PDL::Config{WITH_SLATEC} = 1;
+ }
+
+ skip:
+
+ if ($msg ne "" && $forcebuild==0) {
+ warn $msg . "\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ $PDL::Config{WITH_SLATEC} = 0;
+ $donot = 1;
+ } else {
+ print "\n Building PDL::Slatec. Turn off WITH_SLATEC if there are any problems\n\n";
+ $PDL::Config{WITH_SLATEC} = 1;
+ }
+}
+
+return if $donot;
+
+
+ at pack = (["slatec.pd",Slatec,PDL::Slatec]);
+ at slatecfiles = map {s/^slatec\///; s/\.f$//; $_} glob("slatec/*.f");
+
+%hash = pdlpp_stdargs_int(@::pack);
+
+$hash{OBJECT} .= join '', map {" slatec/${_}$Config{obj_ext} "} @slatecfiles;
+
+if($Config{cc} eq 'cl') {
+# Link to MinGW's libg2c.a and libgcc.a, if appropriate
+# First check that ExtUtils::F77 is available
+ eval{require ExtUtils::F77};
+ unless($@) {
+ my @f = ();
+
+ my $drive = (split /:/, `gcc -v 2>&1`)[0];
+ $drive = substr($drive, -1, 1);
+
+ for(split ' ', ExtUtils::F77->runtime) {
+ if($_ =~ /^\-L/) {
+ $_ =~ s#^\-L##;
+ unless($_ =~ /:/) {$_ = $drive . ':' . $_}
+ if(-e $_ . '/libg2c.a') {push @f, $_ . '/libg2c.a'}
+ if(-e $_ . '/libgcc.a') {push @f, $_ . '/libgcc.a'}
+ }
+ }
+ $hash{LDFROM} = $hash{OBJECT};
+ for(@f) {$hash{LDFROM} .= ' ' . $_}
+ }
+}
+
+$hash{LIBS}[0] .= $f77->runtime ;
+$hash{clean}{FILES} .= " SlatecProtos.h f77_underscore" .
+ join '', map {" slatec/$_.o "} @slatecfiles;
+
+# Handle multiple compilers
+
+$f2cbased = ($f77->runtime =~ /-lf2c/);
+$g2cbased = ($f77->runtime =~ /-lg2c/) unless $f2cbased;
+$trail = $f77->trail_;
+
+# no longer create the prototypes here - this is now handled
+# by slatec.pd. In fact, with the current method, we no
+# longer need the .P files
+#
+
+# Create flag file according to whether or not to use
+# underscores (pretty hacky)
+
+unlink("f77_underscore") if -e "f77_underscore";
+if ($trail) {
+ open OUT, ">f77_underscore" or die "unable to write scratch file";
+ close OUT;
+}
+
+WriteMakefile(
+ %hash,
+ VERSION => "0.12", # This is overridden by VERSION_FROM in %hash
+);
+
+sub MY::postamble {
+ $mycompiler = $f77->compiler();
+ $mycflags = $f77->cflags();
+ my $orig = pdlpp_postamble_int(@::pack);
+ $hack_64bit = ($Config{archname}=~m/x86_64/ ?" -fPIC " : "");
+ $orig =~ s/:\s*slatec\.pd/: slatec.pd/;
+ $orig .join "\n",map {
+("
+
+slatec/$_\$(OBJ_EXT): slatec/$_.f
+ $mycompiler -c $hack_64bit -o slatec/$_\$(OBJ_EXT) $mycflags slatec/$_.f
+" )} @slatecfiles;
+
+}
diff --git a/Lib/Slatec/slatec.pd b/Lib/Slatec/slatec.pd
new file mode 100644
index 0000000..a2d4003
--- /dev/null
+++ b/Lib/Slatec/slatec.pd
@@ -0,0 +1,1691 @@
+pp_addpm({At=>Top},<<'EOD');
+
+=head1 NAME
+
+PDL::Slatec - PDL interface to the slatec numerical programming library
+
+=head1 SYNOPSIS
+
+ use PDL::Slatec;
+
+ ($ndeg, $r, $ierr, $a) = polyfit($x, $y, $w, $maxdeg, $eps);
+
+=head1 DESCRIPTION
+
+This module serves the dual purpose of providing an interface to
+parts of the slatec library and showing how to interface PDL
+to an external library.
+Using this library requires a fortran compiler; the source for the routines
+is provided for convenience.
+
+Currently available are routines to:
+manipulate matrices; calculate FFT's;
+fit data using polynomials;
+and interpolate/integrate data using piecewise cubic Hermite interpolation.
+
+=head2 Piecewise cubic Hermite interpolation (PCHIP)
+
+PCHIP is the slatec package of routines to perform piecewise cubic
+Hermite interpolation of data.
+It features software to produce a monotone and "visually pleasing"
+interpolant to monotone data.
+According to Fritsch & Carlson ("Monotone piecewise
+cubic interpolation", SIAM Journal on Numerical Analysis
+17, 2 (April 1980), pp. 238-246),
+such an interpolant may be more reasonable than a cubic spline if
+the data contains both "steep" and "flat" sections.
+Interpolation of cumulative probability distribution functions is
+another application.
+These routines are cryptically named (blame FORTRAN),
+beginning with 'ch', and accept either float or double piddles.
+
+Most of the routines require an integer parameter called C<check>;
+if set to 0, then no checks on the validity of the input data are
+made, otherwise these checks are made.
+The value of C<check> can be set to 0 if a routine
+such as L<chim|/chim> has already been successfully called.
+
+=over 4
+
+=item *
+
+If not known, estimate derivative values for the points
+using the L<chim|/chim>, L<chic|/chic>, or L<chsp|/chsp> routines
+(the following routines require both the function (C<f>)
+and derivative (C<d>) values at a set of points (C<x>)).
+
+=item *
+
+Evaluate, integrate, or differentiate the resulting PCH
+function using the routines:
+L<chfd|/chfd>; L<chfe|/chfe>; L<chia|/chia>; L<chid|/chid>.
+
+=item *
+
+If desired, you can check the monotonicity of your
+data using L<chcm|/chcm>.
+
+=back
+
+=cut
+
+EOD
+# ' un-confuse emacs
+
+# if define chbs, then add something like the following to point 3:
+#
+# or use L<chbs|/chbs> to convert a PCH function into B-representation
+# for use with the B-spline routines of slatec
+# (although no interface to them currently exist).
+#
+
+# add function definitions after finishing the first pp_addpm(), since this
+# adds a '=head1 FUNCTIONS' line at the end of the text
+
+pp_addpm(<<'END');
+=head2 eigsys
+
+=for ref
+
+Eigenvalues and eigenvectors of a real positive definite symmetric matrix.
+
+=for usage
+
+ ($eigvals,$eigvecs) = eigsys($mat)
+
+Note: this function should be extended to calculate only eigenvalues if called
+in scalar context!
+
+=head2 matinv
+
+=for ref
+
+Inverse of a square matrix
+
+=for usage
+
+ ($inv) = matinv($mat)
+
+=head2 polyfit
+
+Convenience wrapper routine about the C<polfit> C<slatec> function.
+Separates supplied arguments and return values.
+
+=for ref
+
+Fit discrete data in a least squares sense by polynomials
+in one variable. Handles threading correctly--one can pass in a 2D PDL (as C<$y>)
+and it will pass back a 2D PDL, the rows of which are the polynomial regression
+results (in C<$r> corresponding to the rows of $y.
+
+=for usage
+
+ ($ndeg, $r, $ierr, $a, $coeffs, $rms) = polyfit($x, $y, $w, $maxdeg, [$eps]);
+
+ $coeffs = polyfit($x,$y,$w,$maxdeg,[$eps]);
+
+where on input:
+
+C<$x> and C<$y> are the values to fit to a polynomial.
+C<$w> are weighting factors
+C<$maxdeg> is the maximum degree of polynomial to use and
+C<$eps> is the required degree of fit.
+
+and the output switches on list/scalar context.
+
+In list context:
+
+C<$ndeg> is the degree of polynomial actually used
+C<$r> is the values of the fitted polynomial
+C<$ierr> is a return status code, and
+C<$a> is some working array or other (preserved for historical purposes)
+C<$coeffs> is the polynomial coefficients of the best fit polynomial.
+C<$rms> is the rms error of the fit.
+
+In scalar context, only $coeffs is returned.
+
+Historically, C<$eps> was modified in-place to be a return value of the
+rms error. This usage is deprecated, and C<$eps> is an optional parameter now.
+It is still modified if present.
+
+C<$a> is a working array accessible to Slatec - you can feed it to several
+other Slatec routines to get nice things out. It does not thread
+correctly and should probably be fixed by someone. If you are
+reading this, that someone might be you.
+
+=for bad
+
+This version of polyfit handles bad values correctly. Bad values in
+$y are ignored for the fit and give computed values on the fitted
+curve in the return. Bad values in $x or $w are ignored for the fit and
+result in bad elements in the output.
+
+=head2 polycoef
+
+Convenience wrapper routine around the C<pcoef> C<slatec> function.
+Separates supplied arguments and return values.
+
+=for ref
+
+Convert the C<polyfit>/C<polfit> coefficients to Taylor series form.
+
+=for usage
+
+ $tc = polycoef($l, $c, $a);
+
+=head2 polyvalue
+
+Convenience wrapper routine around the C<pvalue> C<slatec> function.
+Separates supplied arguments and return values.
+
+For multiple input x positions, a corresponding y position is calculated.
+
+The derivatives PDL is one dimensional (of size C<nder>) if a single x
+position is supplied, two dimensional if more than one x position is
+supplied.
+
+=for ref
+
+Use the coefficients generated by C<polyfit> (or C<polfit>) to evaluate
+the polynomial fit of degree C<l>, along with the first C<nder> of its
+derivatives, at a specified point.
+
+=for usage
+
+ ($yfit, $yp) = polyvalue($l, $nder, $x, $a);
+
+=head2 detslatec
+
+=for ref
+
+compute the determinant of an invertible matrix
+
+=for example
+
+ $mat = zeroes(5,5); $mat->diagonal(0,1) .= 1; # unity matrix
+ $det = detslatec $mat;
+
+Usage:
+
+=for usage
+
+ $determinant = detslatec $matrix;
+
+=for sig
+
+ Signature: detslatec(mat(n,m); [o] det())
+
+C<detslatec> computes the determinant of an invertible matrix and barfs if
+the matrix argument provided is non-invertible. The matrix threads as usual.
+
+This routine was previously known as C<det> which clashes now with
+L<det|PDL::MatrixOps/det> which is provided by
+L<PDL::MatrixOps|PDL::MatrixOps>. For the moment
+L<PDL::Slatec|PDL::Slatec> will also load
+L<PDL::MatrixOps|PDL::MatrixOps> thereby making sure that older
+scripts work.
+
+=head2 PDL::Slatec::fft
+
+=for ref
+
+Fast Fourier Transform
+
+=for example
+
+ $v_in = pdl(1,0,1,0);
+ ($azero,$a,$b) = PDL::Slatec::fft($v_in);
+
+C<PDL::Slatec::fft> is a convenience wrapper for L<ezfftf|ezfftf>, and
+performs a Fast Fourier Transform on an input vector C<$v_in>. The
+return values are the same as for L<ezfftf|ezfftf>.
+
+=head2 PDL::Slatec::rfft
+
+=for ref
+
+reverse Fast Fourier Transform
+
+=for example
+
+ $v_out = PDL::Slatec::rfft($azero,$a,$b);
+ print $v_in, $vout
+ [1 0 1 0] [1 0 1 0]
+
+C<PDL::Slatec::rfft> is a convenience wrapper for L<ezfftb|ezfftb>,
+and performs a reverse Fast Fourier Transform. The input is the same
+as the output of L<PDL::Slatec::fft|/PDL::Slatec::fft>, and the output
+of C<rfft> is a data vector, similar to what is input into
+L<PDL::Slatec::fft|/PDL::Slatec::fft>.
+
+=cut
+
+END
+
+use PDL::MatrixOps;
+use strict;
+
+# for MDim, ld[str] is interpreted as "leading dimension of ..."
+
+# Making the BAD BAD BAD assumption that PDL_Long == int
+# in fortran. BAD BAD BAD XXX (I'm going to regret this)
+
+my %ftypes = (S => 'F', D => 'D');
+
+sub firstpar {
+ $_[0] =~ /^\(([^),]+)[),]/ or die "Can't find first par from $_[0]";
+ $1
+}
+
+# whether or not to append undercores
+
+my $uscore = (-e "f77_underscore" ? "_" : "");
+
+# used in defslatec()
+#my %ignore_ppar = ( Incfd => 1, CheckFlag => 1 );
+my %ignore_ppar = ( Incfd => 1 );
+my %prototype = ( F => "float", D => "double" );
+
+# an alternative is to declare the function in the Code section
+# of pp_def(), using something like:
+#
+# my $codeproto = "\$T".(join '',map {$_->[0]} @talts)."(".
+# (join ',',map {$_->[1].$uscore} @talts).") ();";
+# if ( defined $fpar ) {
+# $codeproto = "\$T".(join '',map {$_->[0]} @talts)."(float,double) $codeproto";
+# }
+# $codeproto = "extern $codeproto";
+#
+# and then add `$codeproto . "\n" .' to the beginning of the Code
+# section.
+#
+# this then gets rid of the need of the prototype file.
+#
+open( PROTOS, "> SlatecProtos.h" );
+
+# defslatec( $pdlname, $funcnames, $argstr, $docstring, $funcref )
+#
+# $pdlname is the name of the PDL function to be created
+# $funcnames is a reference to a hash array, whose keys define
+# the single (S), and double precision (D) names of the
+# SLATEC routines to be linked to.
+#
+# $argstr is a list of arguments expected by the SLATEC routine
+# - some of the allowed type names are:
+# FuncRet
+# - specifies that this is a function, not a subroutine, and
+# that the output of the function should be stored in this
+# variable
+# Incfd
+# - used in the PCHIP functions to specify the INCFD argument
+# that we force to be 1, so the user never has to specify it
+# (this allows the PCHIP routines to use 2D data, but as it's
+# done in FORTRAN array order, and PDL has a much richer way
+# of accessing parts of an array we force the data to be 1D).
+# CheckFlag
+# - the PCHIP routined may change the value from 0 to 1 if an
+# error occurs but the checks were successful. As this complicates
+# things we copy the user value to a temporary variable,
+# so that the sent in value is not changed.
+# FortranIndex
+# - pchid()/dpchid() require FORTRAN array indices, so
+# this type flags that we should add 1 onto the input values
+# before sending to the slatec function
+#
+# $docstring gives the text to be used as the function dicumentation
+#
+# $funcref gets placed within a '=for ref' pod statement at the
+# start of the documentation - ie it is placed before the
+# text within $docstring. This string gets printed out
+# in the perldl or pdl2 shell after a '?? string' command
+#
+sub defslatec {
+
+ my $debug = 0; # print out calls to pp_def
+
+ my($pname,$fnames,$argstr,$docstring,$funcref) = @_;
+ my @args = map {/^\s*$/ ? () : $_} split ';', $argstr;
+ my @args2 = map {
+ /^\s*([a-zA-Z]+)\s+ # "Type name"
+ ((?:\[[^]]*\])?)\s* # Options
+ ([a-zA-Z]+)\s* # Par name
+ ((?:\([^)]*\))?)\s*$ # Dims
+ /x or die("Invalid slatec par $_");
+ [$1,$2,$3,$4]} @args;
+
+ # is this for a function (Type name eq "FuncRet")
+ # or a subroutine?
+ my $fpar;
+ foreach ( @args2 ) {
+ next unless $_->[0] eq "FuncRet";
+ die "Only one FuncRet allowed in pars list.\n" if defined $fpar;
+ $fpar = "\$$_->[2]()";
+ }
+
+ my @ppars = map {
+ if($_->[0] =~ /^M?Dim$/ or defined $ignore_ppar{$_->[0]} ) {
+ ()
+ } else {
+ (($_->[0] eq "Mat" or $_->[0] eq "FuncRet")
+ and join '',@{$_}[1,2,3]) or
+ (($_->[0] eq "IntFlag" or $_->[0] eq "FortranIndex" or $_->[0] eq "CheckFlag")
+ and "int ".join '',@{$_}[1,2,3]) or
+ die "Invalid ppars ",(join ',',@$_),"\n";
+ }
+ } @args2;
+
+ # uncomment the following line to see what perl thinks the input pars are
+ ##print "Pars: ",(join ';', at ppars),"\n";
+
+ my @talts = map {
+ defined $ftypes{$_} or die "FTYPE $_ NOT THERE\n";
+ [$ftypes{$_},$fnames->{$_}]
+ } keys %$fnames;
+
+ my $func = "\$T".(join '',map {$_->[0]} @talts) . "(" .
+ (join ',',map {$_->[1].$uscore} @talts).")";
+ if ( defined $fpar ) { $func = "$fpar = $func"; }
+
+ my %lds = map {
+ ($_->[0] eq "Mat" and $_->[3] ne "()") ?
+ ("ld".$_->[2] => "&\$PRIV(__".firstpar($_->[3])."_size)")
+ : ()
+ } @args2;
+
+ my @funcpars;
+ foreach ( @args2 ) {
+ next if $_->[0] eq "FuncRet";
+ if ( $_->[0] eq "Mat" or $_->[0] eq "IntFlag" ) {
+ push @funcpars, "\$P($_->[2])";
+ } elsif ( $_->[0] eq "Dim" ) {
+ push @funcpars, "&\$PRIV(__$_->[2]_size)";
+ } elsif ( $_->[0] eq "MDim" ) {
+ push @funcpars, $lds{$_->[2]};
+ } elsif ( $_->[0] eq "Incfd" or $_->[0] eq "CheckFlag" ) {
+ push @funcpars, "&_" . lc($_->[0]);
+ } elsif ( $_->[0] eq "FortranIndex" ) {
+ push @funcpars, "&_$_->[2]";
+ } else {
+ die "Invalid args2";
+ }
+ }
+
+ # _incfd = 1 makes sure PCHIP code treats piddle as 1D
+ # _checkflag - copy input data to a temporary variable, in case
+ # the PCHIP routine decides to change it
+ #
+ my @ifincode;
+ foreach ( @args2 ) {
+ if ( $_->[0] eq "Incfd" ) {
+ push @ifincode, "int _" . lc($_->[0]) . " = 1;";
+ } elsif ( $_->[0] eq "CheckFlag" ) {
+ push @ifincode, "int _" . lc($_->[0]) . " = \$$_->[2]();";
+ } elsif ( $_->[0] eq "FortranIndex" ) {
+ # convert from C to F77 index
+ push @ifincode, "int _$_->[2] = \$$_->[2]() + 1;"
+ }
+ }
+
+ foreach ( @talts ) {
+ my $codeproto = "extern ";
+ if ( defined $fpar ) { $codeproto .= "$prototype{$_->[0]} "; }
+ $codeproto .= "$_->[1]$uscore ();";
+ print PROTOS $codeproto . "\n";
+ }
+
+ # add on the function reference, if supplied, to the start of
+ # the doc string
+ if ( defined $docstring ) {
+ $docstring = "\n=for ref\n\n$funcref\n\n$docstring" if defined $funcref;
+ } else {
+ $docstring = '';
+ }
+
+ # If debug flag set, then print out pp_def call for each call to defslatec
+ if ($debug) {
+ my $pars = (join ';', at ppars);
+ my $code = (join '', at ifincode) . "\n " . $func . " (". (join ',', at funcpars) . ");\n";
+ my $generictypes = "[" . join (", ", map {$_->[0]} @talts) . "],\n";
+ print <<"ENDDBG";
+pp_def($pname,
+ Pars => $pars,
+ OtherPars => '',
+ Code => $code,
+ GenericTypes => $generictypes,
+ Doc => $docstring
+);
+ENDDBG
+}
+
+ pp_def($pname,
+ Pars => (join ';', at ppars),
+ OtherPars => '',
+ Code => (join '', at ifincode) . "\n " .
+ $func . " (". (join ',', at funcpars) . ");\n",
+# . (join '', at ifoutcode),
+ GenericTypes => [map {$_->[0]} @talts],
+ Doc => $docstring
+# %$opts,
+ );
+} # sub: defslatec()
+
+pp_addhdr(qq|
+#include "SlatecProtos.h"
+
+void MAIN__ () {
+ /* Cheat to define MAIN__ symbol */
+ croak("This should never happen");
+}
+
+void slatecbarf$uscore() {
+ croak("slatec called halt");
+}
+
+|);
+
+pp_add_exported('',"eigsys matinv polyfit polycoef polyvalue");
+
+pp_addpm(<<'END');
+
+use PDL::Core;
+use PDL::Basic;
+use PDL::Primitive;
+use PDL::Ufunc;
+use strict;
+
+# Note: handles only real symmetric positive-definite.
+
+*eigsys = \&PDL::eigsys;
+
+sub PDL::eigsys {
+ my($h) = @_;
+ $h = float($h);
+ rs($h,
+ (my $eigval=PDL->null),
+ (long (pdl (1))),(my $eigmat=PDL->null),
+ (my $fvone = PDL->null),(my $fvtwo = PDL->null),
+ (my $errflag=PDL->null)
+ );
+# print $covar,$eigval,$eigmat,$fvone,$fvtwo,$errflag;
+ if(sum($errflag) > 0) {
+ barf("Non-positive-definite matrix given to eigsys: $h\n");
+ }
+ return ($eigval,$eigmat);
+}
+
+*matinv = \&PDL::matinv;
+
+sub PDL::matinv {
+ my($m) = @_;
+ my(@dims) = $m->dims;
+
+ # Keep from dumping core (FORTRAN does no error checking)
+ barf("matinv requires a 2-D square matrix")
+ unless( @dims >= 2 && $dims[0] == $dims[1] );
+
+ $m = $m->copy(); # Make sure we don't overwrite :(
+ gefa($m,(my $ipvt=null),(my $info=null));
+ if(sum($info) > 0) {
+ barf("Uninvertible matrix given to inv: $m\n");
+ }
+ gedi($m,$ipvt,(pdl 0,0),(null),(long( pdl (1))));
+ $m;
+}
+
+*detslatec = \&PDL::detslatec;
+sub PDL::detslatec {
+ my($m) = @_;
+ $m = $m->copy(); # Make sure we don't overwrite :(
+ gefa($m,(my $ipvt=null),(my $info=null));
+ if(sum($info) > 0) {
+ barf("Uninvertible matrix given to inv: $m\n");
+ }
+ gedi($m,$ipvt,(my $det=null),(null),(long( pdl (10))));
+ return $det->slice('(0)')*10**$det->slice('(1)');
+}
+
+
+sub prepfft {
+ my($n) = @_;
+ my $tmp = PDL->zeroes(float(),$n*3+15);
+ $n = pdl $n;
+ ezffti($n,$tmp);
+ return $tmp;
+}
+
+sub fft (;@) {
+ my($v) = @_;
+ my $ws = prepfft($v->getdim(0));
+ ezfftf($v,(my $az = PDL->null), (my $a = PDL->null),
+ (my $b = PDL->null), $ws);
+ return ($az,$a,$b);
+}
+
+sub rfft {
+ my($az,$a,$b) = @_;
+ my $ws = prepfft($a->getdim(0));
+ my $v = $a->copy();
+ ezfftb($v,$az,$a,$b,$ws);
+ return $v;
+}
+
+# polynomial fitting routines
+# simple wrappers around the SLATEC implementations
+
+*polyfit = \&PDL::polyfit;
+sub PDL::polyfit {
+ barf 'Usage: polyfit($x, $y, $w, $maxdeg, [$eps]);'
+ unless (@_ == 5 || @_==4 );
+
+ my ($x_in, $y_in, $w_in, $maxdeg_in, $eps_in) = @_;
+
+ # Create the output arrays
+ my $r = PDL->null;
+
+ # A array needs some work space
+ my $sz = ((3 * $x_in->getdim(0)) + (3*$maxdeg_in) + 3); # Buffer size called for by Slatec
+ my @otherdims = $_[0]->dims; shift @otherdims; # Thread dims
+ my $a = PDL::new_from_specification('PDL',$x_in->type,$sz, at otherdims);
+ my $coeffs = PDL::new_from_specification('PDL',$x_in->type, $maxdeg_in + 1, @otherdims);
+
+ my $ierr = PDL->null;
+ my $ndeg = PDL->null;
+
+ # Now call polfit
+ my $rms = pdl($eps_in);
+ polfit($x_in, $y_in, $w_in, $maxdeg_in, $ndeg, $rms, $r, $ierr, $a, $coeffs);
+ # Preserve historic compatibility by flowing rms error back into the argument
+ if( UNIVERSAL::isa($eps_in,'PDL') ){
+ $eps_in .= $rms;
+ }
+
+ # Return the arrays
+ if(wantarray) {
+ return ($ndeg, $r, $ierr, $a, $coeffs, $rms );
+ } else {
+ return $coeffs;
+ }
+}
+
+
+*polycoef = \&PDL::polycoef;
+sub PDL::polycoef {
+ barf 'Usage: polycoef($l, $c, $a);'
+ unless @_ == 3;
+
+ # Allocate memory for return PDL
+ # Simply l + 1 but cant see how to get PP to do this - TJ
+ # Not sure the return type since I do not know
+ # where PP will get the information from
+ my $tc = PDL->zeroes( abs($_[0]) + 1 );
+
+ # Run the slatec routine
+ pcoef($_[0], $_[1], $tc, $_[2]);
+
+ # Return results
+ return $tc;
+
+}
+
+*polyvalue = \&PDL::polyvalue;
+sub PDL::polyvalue {
+ barf 'Usage: polyvalue($l, $nder, $x, $a);'
+ unless @_ == 4;
+
+ # Two output arrays
+ my $yfit = PDL->null;
+
+ # This one must be preallocated and must take into account
+ # the size of $x if greater than 1
+ my $yp;
+ if ($_[2]->getdim(0) == 1) {
+ $yp = $_[2]->zeroes($_[1]);
+ } else {
+ $yp = $_[2]->zeroes($_[1], $_[2]->getdim(0));
+ }
+
+ # Run the slatec function
+ pvalue($_[0], $_[2], $yfit, $yp, $_[3]);
+
+ # Returns
+ return ($yfit, $yp);
+
+}
+
+END
+
+defslatec(
+ 'svdc',{S => 'ssvdc'},
+ 'Mat x (n,p);
+ MDim ldx;
+ Dim n;
+ Dim p;
+ Mat [o] s (p);
+ Mat [o] e (p);
+ Mat [o] u (n,p);
+ MDim ldu;
+ Mat [o] v (p,p);
+ MDim ldv;
+ Mat [o] work (n);
+ IntFlag job ();
+ IntFlag [o] info ();
+ ',
+'singular value decomposition of a matrix'
+);
+
+defslatec(
+ 'poco',{S => 'spoco', D => 'dpoco'},
+ 'Mat a (n,n);
+ MDim lda;
+ Dim n;
+ Mat rcond ();
+ Mat [o] z (n);
+ IntFlag [o] info ();
+ ',
+'Factor a real symmetric positive definite matrix
+and estimate the condition number of the matrix.'
+);
+
+defslatec(
+ 'geco',{S => 'sgeco', D => 'dgeco'},
+ 'Mat a (n,n);
+ MDim lda;
+ Dim n;
+ IntFlag [o] ipvt (n);
+ Mat [o] rcond ();
+ Mat [o] z (n);
+ ',
+'Factor a matrix using Gaussian elimination and estimate
+the condition number of the matrix.'
+);
+
+defslatec(
+ 'gefa',{S => 'sgefa', D => 'dgefa'},
+ 'Mat a (n,n);
+ MDim lda;
+ Dim n;
+ IntFlag [o] ipvt (n);
+ IntFlag [o] info ();
+ ',
+'Factor a matrix using Gaussian elimination.'
+);
+
+# XXX Ensure two == 2!!
+#
+# pofa and sqrdc aren't (yet?) implemented
+#
+defslatec(
+ 'podi',{S => 'spodi', D => 'dpodi'},
+ 'Mat a (n,n);
+ MDim lda;
+ Dim n;
+ Mat [o] det (two=2);
+ IntFlag job ();
+ ',
+'Compute the determinant and inverse of a certain real
+symmetric positive definite matrix using the factors
+computed by L<poco|/poco>.'
+);
+
+defslatec(
+ 'gedi',{S => 'sgedi', D => 'dgedi'},
+ 'Mat a (n,n);
+ MDim lda;
+ Dim n;
+ IntFlag [o] ipvt (n);
+ Mat [o] det (two=2);
+ Mat [o] work (n);
+ IntFlag job ();
+ ',
+'Compute the determinant and inverse of a matrix using the
+factors computed by L<geco|/geco> or L<gefa|/gefa>.'
+);
+
+
+defslatec(
+ 'gesl',{S => 'sgesl', D => 'dgesl'},
+ 'Mat a (lda,n);
+ MDim lda;
+ Dim n;
+ IntFlag ipvt (n);
+ Mat b (n);
+ IntFlag job ();
+ ',
+'Solve the real system C<A*X=B> or C<TRANS(A)*X=B> using the
+factors computed by L<geco|/geco> or L<gefa|/gefa>.'
+);
+
+defslatec(
+ 'rs', {S => 'rsfoo'},
+ 'MDim lda;
+ Dim n;
+ Mat a (n,n);
+ Mat [o] w (n);
+ IntFlag matz ();
+ Mat [o] z (n,n);
+ Mat [t] fvone (n);
+ Mat [t] fvtwo (n);
+ IntFlag [o] ierr ();
+ ',
+'This subroutine calls the recommended sequence of
+subroutines from the eigensystem subroutine package (EISPACK)
+to find the eigenvalues and eigenvectors (if desired)
+of a REAL SYMMETRIC matrix.'
+
+);
+
+# XXX wsave : at least 3n+15
+defslatec(
+ 'ezffti', {S => 'ezffti'},
+ 'IntFlag n ();
+ Mat [o] wsave(foo);
+ ',
+'Subroutine ezffti initializes the work array C<wsave()>
+which is used in both L<ezfftf|/ezfftf> and
+L<ezfftb|/ezfftb>.
+The prime factorization
+of C<n> together with a tabulation of the trigonometric functions
+are computed and stored in C<wsave()>.'
+
+);
+
+# XXX Correct for azero, a and b
+defslatec(
+ 'ezfftf', {S => 'ezfftf'},
+ 'Dim n;
+ Mat r(n);
+ Mat [o] azero();
+ Mat [o] a(n);
+ Mat [o] b(n);
+ Mat wsave(foo);
+ '
+);
+
+defslatec(
+ 'ezfftb', {S => 'ezfftb'},
+ 'Dim n;
+ Mat [o] r(n);
+ Mat azero();
+ Mat a(n);
+ Mat b(n);
+ Mat wsave(foo);
+ '
+);
+
+##################################################################
+##################################################################
+
+defslatec(
+ 'pcoef', {S => 'pcoef', D => 'dpcoef'},
+ '
+ IntFlag l ();
+ Mat c ();
+ Mat [o] tc (bar);
+ Mat a (foo);
+ ',
+'Convert the C<polfit> coefficients to Taylor series form.
+C<c> and C<a()> must be of the same type.'
+);
+
+defslatec(
+ 'pvalue', {S => 'pvalue', D => 'dp1vlu'},
+ '
+ IntFlag l ();
+ Dim nder;
+ Mat x ();
+ Mat [o] yfit ();
+ Mat [o] yp (nder);
+ Mat a (foo);
+ ',
+'Use the coefficients generated by C<polfit> to evaluate the
+polynomial fit of degree C<l>, along with the first C<nder> of
+its derivatives, at a specified point. C<x> and C<a> must be of the
+same type.'
+);
+
+##################################################################
+##################################################################
+#
+# PCHIP library
+#
+defslatec(
+ 'chim', {S => 'pchim', D => 'dpchim'},
+ 'Dim n;
+ Mat x (n);
+ Mat f (n);
+ Mat [o] d (n);
+ Incfd dummy;
+ IntFlag [o] ierr ();
+ ',
+'Calculate the derivatives at the given set of points (C<$x,$f>,
+where C<$x> is strictly increasing).
+The resulting set of points - C<$x,$f,$d>, referred to
+as the cubic Hermite representation - can then be used in
+other functions, such as L<chfe|/chfe>, L<chfd|/chfd>,
+and L<chia|/chia>.
+
+The boundary conditions are compatible with monotonicity,
+and if the data are only piecewise monotonic, the interpolant
+will have an extremum at the switch points; for more control
+over these issues use L<chic|/chic>.
+
+Error status returned by C<$ierr>:
+
+=over 4
+
+=item *
+
+0 if successful.
+
+=item *
+
+E<gt> 0 if there were C<ierr> switches in the direction of
+monotonicity (data still valid).
+
+=item *
+
+-1 if C<nelem($x) E<lt> 2>.
+
+=item *
+
+-3 if C<$x> is not strictly increasing.
+
+=back
+
+=cut
+
+',
+'Calculate the derivatives of (x,f(x)) using cubic Hermite interpolation.'
+);
+
+# switch has become mflag, since `switch' is a reserved word in
+# C.
+#
+# can not say (nwk=2*n) --- the rhs has to equal a number
+# -> could Basic/Gen/PP/Dims.pm be hacked to allow this?
+#
+# I didn't have much success with preceeding wk by [t]
+#
+defslatec(
+ 'chic', {S => 'pchic', D => 'dpchic'},
+ 'IntFlag ic (two=2);
+ Mat vc (two=2);
+ Mat mflag ();
+ Dim n;
+ Mat x (n);
+ Mat f (n);
+ Mat [o] d (n);
+ Incfd dummy;
+ Mat wk (nwk);
+ Dim nwk;
+ IntFlag [o] ierr ();
+ ',
+'Calculate the derivatives at the given points (C<$x,$f>,
+where C<$x> is strictly increasing).
+Control over the boundary conditions is given by the
+C<$ic> and C<$vc> piddles, and the value of C<$mflag> determines
+the treatment of points where monotoncity switches
+direction. A simpler, more restricted, interface is available
+using L<chim|/chim>.
+
+The first and second elements of C<$ic> determine the boundary
+conditions at the start and end of the data respectively.
+If the value is 0, then the default condition, as used by
+L<chim|/chim>, is adopted.
+If greater than zero, no adjustment for monotonicity is made,
+otherwise if less than zero the derivative will be adjusted.
+The allowed magnitudes for C<ic(0)> are:
+
+=over 4
+
+=item *
+
+1 if first derivative at C<x(0)> is given in C<vc(0)>.
+
+=item *
+
+2 if second derivative at C<x(0)> is given in C<vc(0)>.
+
+=item *
+
+3 to use the 3-point difference formula for C<d(0)>.
+(Reverts to the default b.c. if C<n E<lt> 3>)
+
+=item *
+
+4 to use the 4-point difference formula for C<d(0)>.
+(Reverts to the default b.c. if C<n E<lt> 4>)
+
+=item *
+
+5 to set C<d(0)> so that the second derivative is
+continuous at C<x(1)>.
+(Reverts to the default b.c. if C<n E<lt> 4>)
+
+=back
+
+The values for C<ic(1)> are the same as above, except that
+the first-derivative value is stored in C<vc(1)> for cases 1 and 2.
+The values of C<$vc> need only be set if options 1 or 2 are chosen
+for C<$ic>.
+
+Set C<$mflag = 0> if interpolant is required to be monotonic in
+each interval, regardless of the data. This causes C<$d> to be
+set to 0 at all switch points. Set C<$mflag> to be non-zero to
+use a formula based on the 3-point difference formula at switch
+points. If C<$mflag E<gt> 0>, then the interpolant at swich points
+is forced to not deviate from the data by more than C<$mflag*dfloc>,
+where C<dfloc> is the maximum of the change of C<$f> on this interval
+and its two immediate neighbours.
+If C<$mflag E<lt> 0>, no such control is to be imposed.
+
+The piddle C<$wk> is only needed for work space. However, I could
+not get it to work as a temporary variable, so you must supply
+it; it is a 1D piddle with C<2*n> elements.
+
+Error status returned by C<$ierr>:
+
+=over 4
+
+=item *
+
+0 if successful.
+
+=item *
+
+1 if C<ic(0) E<lt> 0> and C<d(0)> had to be adjusted for
+monotonicity.
+
+=item *
+
+2 if C<ic(1) E<lt> 0> and C<d(n-1)> had to be adjusted
+for monotonicity.
+
+=item *
+
+3 if both 1 and 2 are true.
+
+=item *
+
+-1 if C<n E<lt> 2>.
+
+=item *
+
+-3 if C<$x> is not strictly increasing.
+
+=item *
+
+-4 if C<abs(ic(0)) E<gt> 5>.
+
+=item *
+
+-5 if C<abs(ic(1)) E<gt> 5>.
+
+=item *
+
+-6 if both -4 and -5 are true.
+
+=item *
+
+-7 if C<nwk E<lt> 2*(n-1)>.
+
+=back
+
+=cut
+
+',
+'Calculate the derivatives of (x,f(x)) using cubic Hermite interpolation.'
+);
+
+# as above, have made wk an actual piddle, rather than a [t]
+defslatec(
+ 'chsp', {S => 'pchsp', D => 'dpchsp'},
+ 'IntFlag ic (two=2);
+ Mat vc (two=2);
+ Dim n;
+ Mat x (n);
+ Mat f (n);
+ Mat [o] d (n);
+ Incfd dummy;
+ Mat wk (nwk);
+ Dim nwk;
+ IntFlag [o] ierr ();
+ ',
+'Calculate the derivatives, using cubic spline interpolation,
+at the given points (C<$x,$f>), with the specified
+boundary conditions.
+Control over the boundary conditions is given by the
+C<$ic> and C<$vc> piddles.
+The resulting values - C<$x,$f,$d> - can
+be used in all the functions which expect a cubic
+Hermite function.
+
+The first and second elements of C<$ic> determine the boundary
+conditions at the start and end of the data respectively.
+The allowed values for C<ic(0)> are:
+
+=over 4
+
+=item *
+
+0 to set C<d(0)> so that the third derivative is
+continuous at C<x(1)>.
+
+=item *
+
+1 if first derivative at C<x(0)> is given in C<vc(0>).
+
+=item *
+
+2 if second derivative at C<x(0>) is given in C<vc(0)>.
+
+=item *
+
+3 to use the 3-point difference formula for C<d(0)>.
+(Reverts to the default b.c. if C<n E<lt> 3>.)
+
+=item *
+
+4 to use the 4-point difference formula for C<d(0)>.
+(Reverts to the default b.c. if C<n E<lt> 4>.)
+
+=back
+
+The values for C<ic(1)> are the same as above, except that
+the first-derivative value is stored in C<vc(1)> for cases 1 and 2.
+The values of C<$vc> need only be set if options 1 or 2 are chosen
+for C<$ic>.
+
+The piddle C<$wk> is only needed for work space. However, I could
+not get it to work as a temporary variable, so you must supply
+it; it is a 1D piddle with C<2*n> elements.
+
+Error status returned by C<$ierr>:
+
+=over 4
+
+=item *
+
+0 if successful.
+
+=item *
+
+-1 if C<nelem($x) E<lt> 2>.
+
+=item *
+
+-3 if C<$x> is not strictly increasing.
+
+=item *
+
+-4 if C<ic(0) E<lt> 0> or C<ic(0) E<gt> 4>.
+
+=item *
+
+-5 if C<ic(1) E<lt> 0> or C<ic(1) E<gt> 4>.
+
+=item *
+
+-6 if both of the above are true.
+
+=item *
+
+-7 if C<nwk E<lt> 2*n>.
+
+=item *
+
+-8 in case of trouble solving the linear system
+for the interior derivative values.
+
+=back
+
+=cut
+
+',
+'Calculate the derivatives of (x,f(x)) using cubic spline interpolation.'
+);
+
+defslatec(
+ 'chfd', {S => 'pchfd', D => 'dpchfd'},
+ 'Dim n;
+ Mat x (n);
+ Mat f (n);
+ Mat d (n);
+ Incfd dummy;
+ CheckFlag check ();
+ Dim ne;
+ Mat xe (ne);
+ Mat [o] fe (ne);
+ Mat [o] de (ne);
+ IntFlag [o] ierr ();
+ ',
+'Given a piecewise cubic Hermite function - such as from
+L<chim|/chim> - evaluate the function (C<$fe>) and
+derivative (C<$de>) at a set of points (C<$xe>).
+If function values alone are required, use L<chfe|/chfe>.
+Set C<check> to 0 to skip checks on the input data.
+
+Error status returned by C<$ierr>:
+
+=over 4
+
+=item *
+
+0 if successful.
+
+=item *
+
+E<gt>0 if extrapolation was performed at C<ierr> points
+(data still valid).
+
+=item *
+
+-1 if C<nelem($x) E<lt> 2>
+
+=item *
+
+-3 if C<$x> is not strictly increasing.
+
+=item *
+
+-4 if C<nelem($xe) E<lt> 1>.
+
+=item *
+
+-5 if an error has occurred in a lower-level routine,
+which should never happen.
+
+=back
+
+=cut
+
+',
+'Interpolate function and derivative values.'
+);
+
+defslatec(
+ 'chfe', {S => 'pchfe', D => 'dpchfe'},
+ 'Dim n;
+ Mat x (n);
+ Mat f (n);
+ Mat d (n);
+ Incfd dummy;
+ CheckFlag check ();
+ Dim ne;
+ Mat xe (ne);
+ Mat [o] fe (ne);
+ IntFlag [o] ierr ();
+ ',
+'Given a piecewise cubic Hermite function - such as from
+L<chim|/chim> - evaluate the function (C<$fe>) at
+a set of points (C<$xe>).
+If derivative values are also required, use L<chfd|/chfd>.
+Set C<check> to 0 to skip checks on the input data.
+
+Error status returned by C<$ierr>:
+
+=over 4
+
+=item *
+
+0 if successful.
+
+=item *
+
+E<gt>0 if extrapolation was performed at C<ierr> points
+(data still valid).
+
+=item *
+
+-1 if C<nelem($x) E<lt> 2>
+
+=item *
+
+-3 if C<$x> is not strictly increasing.
+
+=item *
+
+-4 if C<nelem($xe) E<lt> 1>.
+
+=back
+
+=cut
+
+',
+'Interpolate function values.'
+);
+
+defslatec(
+ 'chia', {S => 'pchia', D => 'dpchia'},
+ 'Dim n;
+ Mat x (n);
+ Mat f (n);
+ Mat d (n);
+ Incfd dummy;
+ CheckFlag check ();
+ Mat a ();
+ Mat b ();
+ FuncRet [o] ans ();
+ IntFlag [o] ierr ();
+ ',
+'Evaluate the definite integral of a a piecewise
+cubic Hermite function over an arbitrary interval,
+given by C<[$a,$b]>.
+See L<chid|/chid> if the integration limits are
+data points.
+Set C<check> to 0 to skip checks on the input data.
+
+The values of C<$a> and C<$b> do not have
+to lie within C<$x>, although the resulting integral
+value will be highly suspect if they are not.
+
+Error status returned by C<$ierr>:
+
+=over 4
+
+=item *
+
+0 if successful.
+
+=item *
+
+1 if C<$a> lies outside C<$x>.
+
+=item *
+
+2 if C<$b> lies outside C<$x>.
+
+=item *
+
+3 if both 1 and 2 are true.
+
+=item *
+
+-1 if C<nelem($x) E<lt> 2>
+
+=item *
+
+-3 if C<$x> is not strictly increasing.
+
+=item *
+
+-4 if an error has occurred in a lower-level routine,
+which should never happen.
+
+=back
+
+=cut
+
+',
+'Integrate (x,f(x)) over arbitrary limits.'
+);
+
+defslatec(
+ 'chid', {S => 'pchid', D => 'dpchid'},
+ 'Dim n;
+ Mat x (n);
+ Mat f (n);
+ Mat d (n);
+ Incfd dummy;
+ CheckFlag check ();
+ FortranIndex ia ();
+ FortranIndex ib ();
+ FuncRet [o] ans ();
+ IntFlag [o] ierr ();
+ ',
+'Evaluate the definite integral of a a piecewise
+cubic Hermite function between C<x($ia)> and
+C<x($ib)>.
+
+See L<chia|/chia> for integration between arbitrary
+limits.
+
+Although using a fortran routine, the values of
+C<$ia> and C<$ib> are zero offset.
+Set C<check> to 0 to skip checks on the input data.
+
+Error status returned by C<$ierr>:
+
+=over 4
+
+=item *
+
+0 if successful.
+
+=item *
+
+-1 if C<nelem($x) E<lt> 2>.
+
+=item *
+
+-3 if C<$x> is not strictly increasing.
+
+=item *
+
+-4 if C<$ia> or C<$ib> is out of range.
+
+=back
+
+=cut
+
+',
+'Integrate (x,f(x)) between data points.'
+);
+
+defslatec(
+ 'chcm', {S => 'pchcm', D => 'dpchcm'},
+ 'Dim n;
+ Mat x (n);
+ Mat f (n);
+ Mat d (n);
+ Incfd dummy;
+ CheckFlag check ();
+ IntFlag [o] ismon (n);
+ IntFlag [o] ierr ();
+ ',
+'The outout piddle C<$ismon> indicates over
+which intervals the function is monotonic.
+Set C<check> to 0 to skip checks on the input data.
+
+For the data interval C<[x(i),x(i+1)]>, the
+values of C<ismon(i)> can be:
+
+=over 4
+
+=item *
+
+-3 if function is probably decreasing
+
+=item *
+
+-1 if function is strictly decreasing
+
+=item *
+
+0 if function is constant
+
+=item *
+
+1 if function is strictly increasing
+
+=item *
+
+2 if function is non-monotonic
+
+=item *
+
+3 if function is probably increasing
+
+=back
+
+If C<abs(ismon(i)) == 3>, the derivative values are
+near the boundary of the monotonicity region. A small
+increase produces non-monotonicity, whereas a decrease
+produces strict monotonicity.
+
+The above applies to C<i = 0 .. nelem($x)-1>. The last element of
+C<$ismon> indicates whether
+the entire function is monotonic over $x.
+
+Error status returned by C<$ierr>:
+
+=over 4
+
+=item *
+
+0 if successful.
+
+=item *
+
+-1 if C<n E<lt> 2>.
+
+=item *
+
+-3 if C<$x> is not strictly increasing.
+
+=back
+
+=cut
+
+',
+'Check the given piecewise cubic Hermite function for monotonicity.'
+);
+
+=pod
+
+ignore function for now although code is in slatec/ directory
+
+=cut
+
+# XXX tsize = 2*n+4
+# bsize = 2*n
+#
+# ndim gets set to 2*n
+#
+# Changed by routine:
+# nknots
+# t
+defslatec(
+ 'chbs', {S => 'pchbs', D => 'dpchbs'},
+ 'Dim n;
+ Mat x (n);
+ Mat f (n);
+ Mat d (n);
+ Incfd dummy;
+ IntFlag knotyp ();
+ IntFlag nknots ();
+ Mat t (tsize);
+ Mat [o] bcoef (bsize);
+ IntFlag [o] ndim ();
+ IntFlag [o] kord ();
+ IntFlag [o] ierr ();
+ ',
+'The resulting B-spline representation of the data
+(i.e. C<nknots>, C<t>, C<bcoeff>, C<ndim>, and
+C<kord>) can be evaluated by C<bvalu> (which is
+currently not available).
+
+Array sizes: C<tsize = 2*n + 4>, C<bsize = 2*n>,
+and C<ndim = 2*n>.
+
+C<knotyp> is a flag which controls the knot sequence.
+The knot sequence C<t> is normally computed from C<$x>
+by putting a double knot at each C<x> and setting the end knot pairs
+according to the value of C<knotyp> (where C<m = ndim = 2*n>):
+
+=over
+
+=item *
+
+0 - Quadruple knots at the first and last points.
+
+=item *
+
+1 - Replicate lengths of extreme subintervals:
+C<t( 0 ) = t( 1 ) = x(0) - (x(1)-x(0))> and
+C<t(m+3) = t(m+2) = x(n-1) + (x(n-1)-x(n-2))>
+
+=item *
+
+2 - Periodic placement of boundary knots:
+C<t( 0 ) = t( 1 ) = x(0) - (x(n-1)-x(n-2))> and
+C<t(m+3) = t(m+2) = x(n) + (x(1)-x(0))>
+
+=item *
+
+E<lt>0 - Assume the C<nknots> and C<t> were set in a previous call.
+
+=back
+
+C<nknots> is the number of knots and may be changed by the routine.
+If C<knotyp E<gt>= 0>, C<nknots> will be set to C<ndim+4>,
+otherwise it is an input variable, and an error will occur if its
+value is not equal to C<ndim+4>.
+
+C<t> is the array of C<2*n+4> knots for the B-representation
+and may be changed by the routine.
+If C<knotyp E<gt>= 0>, C<t> will be changed so that the
+interior double knots are equal to the x-values and the
+boundary knots set as indicated above,
+otherwise it is assumed that C<t> was set by a
+previous call (no check is made to verify that the data
+forms a legitimate knot sequence).
+
+Error status returned by C<$ierr>:
+
+=over 4
+
+=item *
+
+0 if successful.
+
+=item *
+
+-4 if C<knotyp E<gt> 2>.
+
+=item *
+
+-5 if C<knotyp E<lt> 0> and C<nknots != 2*n + 4>.
+
+=back
+
+=cut
+
+',
+'Piecewise Cubic Hermite function to B-Spline converter.'
+);
+
+##################################################################
+##################################################################
+
+#
+# This version of polfit accepts bad values and also allows threading
+#
+
+#
+# indices:
+# n runs across input points;
+# foo runs across wacky Slatec buffer size;
+# bar runs across polynomial coefficients.
+#
+pp_def('polfit',
+ Pars => 'x(n); y(n); w(n); int maxdeg(); int [o]ndeg(); [o]eps(); [o]r(n); int [o]ierr(); [o]a(foo); [o]coeffs(bar);[t]xtmp(n);[t]ytmp(n);[t]wtmp(n);[t]rtmp(n)',
+ OtherPars => '',
+ Code => '
+ int maxord;
+ int ord;
+ int k;
+ $GENERIC() zero = 0;
+
+ $TFD(polfit'.$uscore.',dpolft'.$uscore.') (&$PRIV(__n_size),$P(x),$P(y),$P(w),$P(maxdeg),$P(ndeg),$P(eps),$P(r),$P(ierr),$P(a));
+ maxord = ($P(a))[0]+0.5;
+ ord = ($P(a))[maxord * 3 + 2];
+ if(ord >= $maxdeg()) {
+ ord = $maxdeg();
+ }
+ $TFD(pcoef'.$uscore.',dpcoef'.$uscore.') ( &(ord), &(zero), $P(coeffs), $P(a));
+ for(k=ord+1; k<=$maxdeg(); k++)
+ ($P(coeffs))[k] = 0;
+',
+ GenericTypes => ['F','D'],
+ HandleBad => 1,
+ NoBadifNaN => 1,
+ BadCode => 'int ns = $SIZE(n);
+ int i;
+ int j = 0;
+ if($SIZE(n)<$maxdeg()) {
+ barf("polfit: Must have at least <n> points to fit <n> coefficients");
+ }
+
+ for (i=0;i<ns;i++) { /* get rid of bad values. Call polfit with [xyw]tmp instead of [xyz]. */
+ if ($ISGOOD(y(n=>i)) && $ISGOOD(x(n=>i)) && $ISGOOD(w(n=>i))) {
+ $xtmp(n=>j) = $x(n=>i);
+ $ytmp(n=>j) = $y(n=>i);
+ $wtmp(n=>j) = $w(n=>i);
+ j++;
+ }
+ }
+ if (j <= $maxdeg()) {
+ /* Not enough good datapoints -- set this whole row to BAD. */
+ for (i=0;i<ns;i++) {
+ $SETBAD(r(n=>i));
+ }
+ $ierr() = 2;
+ } else {
+ /* Found enough good datapoints for a fit -- do the fit */
+ int k;
+ int ord;
+ int maxord;
+ $GENERIC() zero = 0;
+
+ /* Do the fit */
+ $TFD(polfit'.$uscore.',dpolft'.$uscore.')
+ (&j,$P(xtmp),$P(ytmp),$P(wtmp),$P(maxdeg),$P(ndeg),$P(eps),$P(rtmp),$P(ierr),$P(a));
+
+ maxord = ($P(a))[0]+0.5;
+ ord = ($P(a))[maxord * 3 + 2];
+ if(ord >= $maxdeg()) {
+ ord = $maxdeg();
+ }
+ /* Extract the polynomial coefficients into coeffs -- used for bad values */
+ $TFD(pcoef'.$uscore.',dpcoef'.$uscore.') ( &(ord), &(zero), $P(coeffs), $P(a));
+ for(k=ord+1; k<=$maxdeg(); k++)
+ ($P(coeffs))[k] = 0;
+ j=0;
+ for (i=0;i<ns;i++) { /* replace bad values */
+ if ($ISGOOD(y(n=>i))) {
+ $r(n=>i) = $rtmp(n=>j);
+ j++;
+ } else if($ISGOOD(x(n=>i))) {
+ /* Bad values are omitted from the call to polfit, so we must reconstitute them on return */
+ /* (just because a value is bad in y, does not mean the fit itself is bad there) */
+ /* */
+ /* The number in ord is not the number of coefficients in the polynomial, it is the highest */
+ /* order coefficient -- so 3 for a cubic, which has 4 coefficients. */
+ /* --CED */
+ int ii;
+ $GENERIC() acc = 0;
+ for( ii=ord; ii>0; ii-- ) {
+ acc += $coeffs(bar=>ii);
+ acc *= $x(n=>i);
+ }
+
+ acc += $coeffs(bar=>0);
+ $r(n=>i) = acc;
+ } else {
+ /* x and y are bad here... */
+ $SETBAD(r(n=>i));
+ }
+ }
+ }',
+
+ Doc => 'Fit discrete data in a least squares sense by polynomials
+ in one variable. C<x()>, C<y()> and C<w()> must be of the same type.
+ This version handles bad values appropriately',
+);
+
+close( PROTOS );
+
+##################################################################
+##################################################################
+
+pp_addpm(<<'EOD');
+
+=head1 AUTHOR
+
+Copyright (C) 1997 Tuomas J. Lukka.
+Copyright (C) 2000 Tim Jenness, Doug Burke.
+All rights reserved. There is no warranty. You are allowed
+to redistribute this software / documentation under certain
+conditions. For details, see the file COPYING in the PDL
+distribution. If this file is separated from the PDL distribution,
+the copyright notice should be included in the file.
+
+=cut
+
+
+EOD
+
+pp_done();
+
+
diff --git a/Lib/Slatec/slatec/chfcm.f b/Lib/Slatec/slatec/chfcm.f
new file mode 100644
index 0000000..f39028c
--- /dev/null
+++ b/Lib/Slatec/slatec/chfcm.f
@@ -0,0 +1,151 @@
+*DECK CHFCM
+ INTEGER FUNCTION CHFCM (D1, D2, DELTA)
+C***BEGIN PROLOGUE CHFCM
+C***SUBSIDIARY
+C***PURPOSE Check a single cubic for monotonicity.
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE SINGLE PRECISION (CHFCM-S, DCHFCM-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C *Usage:
+C
+C REAL D1, D2, DELTA
+C INTEGER ISMON, CHFCM
+C
+C ISMON = CHFCM (D1, D2, DELTA)
+C
+C *Arguments:
+C
+C D1,D2:IN are the derivative values at the ends of an interval.
+C
+C DELTA:IN is the data slope over that interval.
+C
+C *Function Return Values:
+C ISMON : indicates the monotonicity of the cubic segment:
+C ISMON = -3 if function is probably decreasing;
+C ISMON = -1 if function is strictly decreasing;
+C ISMON = 0 if function is constant;
+C ISMON = 1 if function is strictly increasing;
+C ISMON = 2 if function is non-monotonic;
+C ISMON = 3 if function is probably increasing.
+C If ABS(ISMON)=3, the derivative values are too close to the
+C boundary of the monotonicity region to declare monotonicity
+C in the presence of roundoff error.
+C
+C *Description:
+C
+C CHFCM: Cubic Hermite Function -- Check Monotonicity.
+C
+C Called by PCHCM to determine the monotonicity properties of the
+C cubic with boundary derivative values D1,D2 and chord slope DELTA.
+C
+C *Cautions:
+C This is essentially the same as old CHFMC, except that a
+C new output value, -3, was added February 1989. (Formerly, -3
+C and +3 were lumped together in the single value 3.) Codes that
+C flag nonmonotonicity by "IF (ISMON.EQ.2)" need not be changed.
+C Codes that check via "IF (ISMON.GE.3)" should change the test to
+C "IF (IABS(ISMON).GE.3)". Codes that declare monotonicity via
+C "IF (ISMON.LE.1)" should change to "IF (IABS(ISMON).LE.1)".
+C
+C REFER TO PCHCM
+C
+C***ROUTINES CALLED R1MACH
+C***REVISION HISTORY (YYMMDD)
+C 820518 DATE WRITTEN
+C 820805 Converted to SLATEC library version.
+C 831201 Changed from ISIGN to SIGN to correct bug that
+C produced wrong sign when -1 .LT. DELTA .LT. 0 .
+C 890206 Added SAVE statements.
+C 890207 Added sign to returned value ISMON=3 and corrected
+C argument description accordingly.
+C 890306 Added caution about changed output.
+C 890407 Changed name from CHFMC to CHFCM, as requested at the
+C March 1989 SLATEC CML meeting, and made a few other
+C minor modifications necessitated by this change.
+C 890407 Converted to new SLATEC format.
+C 890407 Modified DESCRIPTION to LDOC format.
+C 891214 Moved SAVE statements. (WRB)
+C***END PROLOGUE CHFCM
+C
+C Fortran intrinsics used: SIGN.
+C Other routines used: R1MACH.
+C
+C ----------------------------------------------------------------------
+C
+C Programming notes:
+C
+C TEN is actually a tuning parameter, which determines the width of
+C the fuzz around the elliptical boundary.
+C
+C To produce a double precision version, simply:
+C a. Change CHFCM to DCHFCM wherever it occurs,
+C b. Change the real declarations to double precision, and
+C c. Change the constants ZERO, ONE, ... to double precision.
+C
+C DECLARE ARGUMENTS.
+C
+ REAL D1, D2, DELTA
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER ISMON, ITRUE
+ REAL A, B, EPS, FOUR, ONE, PHI, TEN, THREE, TWO, ZERO
+ SAVE ZERO, ONE, TWO, THREE, FOUR
+ SAVE TEN
+C
+C INITIALIZE.
+C
+ DATA ZERO /0./, ONE /1.0/, TWO /2./, THREE /3./, FOUR /4./,
+ 1 TEN /10./
+C
+C MACHINE-DEPENDENT PARAMETER -- SHOULD BE ABOUT 10*UROUND.
+C***FIRST EXECUTABLE STATEMENT CHFCM
+ EPS = TEN*R1MACH(4)
+C
+C MAKE THE CHECK.
+C
+ IF (DELTA .EQ. ZERO) THEN
+C CASE OF CONSTANT DATA.
+ IF ((D1.EQ.ZERO) .AND. (D2.EQ.ZERO)) THEN
+ ISMON = 0
+ ELSE
+ ISMON = 2
+ ENDIF
+ ELSE
+C DATA IS NOT CONSTANT -- PICK UP SIGN.
+ ITRUE = SIGN (ONE, DELTA)
+ A = D1/DELTA
+ B = D2/DELTA
+ IF ((A.LT.ZERO) .OR. (B.LT.ZERO)) THEN
+ ISMON = 2
+ ELSE IF ((A.LE.THREE-EPS) .AND. (B.LE.THREE-EPS)) THEN
+C INSIDE SQUARE (0,3)X(0,3) IMPLIES OK.
+ ISMON = ITRUE
+ ELSE IF ((A.GT.FOUR+EPS) .AND. (B.GT.FOUR+EPS)) THEN
+C OUTSIDE SQUARE (0,4)X(0,4) IMPLIES NONMONOTONIC.
+ ISMON = 2
+ ELSE
+C MUST CHECK AGAINST BOUNDARY OF ELLIPSE.
+ A = A - TWO
+ B = B - TWO
+ PHI = ((A*A + B*B) + A*B) - THREE
+ IF (PHI .LT. -EPS) THEN
+ ISMON = ITRUE
+ ELSE IF (PHI .GT. EPS) THEN
+ ISMON = 2
+ ELSE
+C TO CLOSE TO BOUNDARY TO TELL,
+C IN THE PRESENCE OF ROUND-OFF ERRORS.
+ ISMON = 3*ITRUE
+ ENDIF
+ ENDIF
+ ENDIF
+C
+C RETURN VALUE.
+C
+ CHFCM = ISMON
+ RETURN
+C------------- LAST LINE OF CHFCM FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/chfdv.f b/Lib/Slatec/slatec/chfdv.f
new file mode 100644
index 0000000..8355e90
--- /dev/null
+++ b/Lib/Slatec/slatec/chfdv.f
@@ -0,0 +1,165 @@
+*DECK CHFDV
+ SUBROUTINE CHFDV (X1, X2, F1, F2, D1, D2, NE, XE, FE, DE, NEXT,
+ + IERR)
+C***BEGIN PROLOGUE CHFDV
+C***PURPOSE Evaluate a cubic polynomial given in Hermite form and its
+C first derivative at an array of points. While designed for
+C use by PCHFD, it may be useful directly as an evaluator
+C for a piecewise cubic Hermite function in applications,
+C such as graphing, where the interval is known in advance.
+C If only function values are required, use CHFEV instead.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3, H1
+C***TYPE SINGLE PRECISION (CHFDV-S, DCHFDV-D)
+C***KEYWORDS CUBIC HERMITE DIFFERENTIATION, CUBIC HERMITE EVALUATION,
+C CUBIC POLYNOMIAL EVALUATION, PCHIP
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C CHFDV: Cubic Hermite Function and Derivative Evaluator
+C
+C Evaluates the cubic polynomial determined by function values
+C F1,F2 and derivatives D1,D2 on interval (X1,X2), together with
+C its first derivative, at the points XE(J), J=1(1)NE.
+C
+C If only function values are required, use CHFEV, instead.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C INTEGER NE, NEXT(2), IERR
+C REAL X1, X2, F1, F2, D1, D2, XE(NE), FE(NE), DE(NE)
+C
+C CALL CHFDV (X1,X2, F1,F2, D1,D2, NE, XE, FE, DE, NEXT, IERR)
+C
+C Parameters:
+C
+C X1,X2 -- (input) endpoints of interval of definition of cubic.
+C (Error return if X1.EQ.X2 .)
+C
+C F1,F2 -- (input) values of function at X1 and X2, respectively.
+C
+C D1,D2 -- (input) values of derivative at X1 and X2, respectively.
+C
+C NE -- (input) number of evaluation points. (Error return if
+C NE.LT.1 .)
+C
+C XE -- (input) real array of points at which the functions are to
+C be evaluated. If any of the XE are outside the interval
+C [X1,X2], a warning error is returned in NEXT.
+C
+C FE -- (output) real array of values of the cubic function defined
+C by X1,X2, F1,F2, D1,D2 at the points XE.
+C
+C DE -- (output) real array of values of the first derivative of
+C the same function at the points XE.
+C
+C NEXT -- (output) integer array indicating number of extrapolation
+C points:
+C NEXT(1) = number of evaluation points to left of interval.
+C NEXT(2) = number of evaluation points to right of interval.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C "Recoverable" errors:
+C IERR = -1 if NE.LT.1 .
+C IERR = -2 if X1.EQ.X2 .
+C (Output arrays have not been changed in either case.)
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 811019 DATE WRITTEN
+C 820803 Minor cosmetic changes for release 1.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C***END PROLOGUE CHFDV
+C Programming notes:
+C
+C To produce a double precision version, simply:
+C a. Change CHFDV to DCHFDV wherever it occurs,
+C b. Change the real declaration to double precision, and
+C c. Change the constant ZERO to double precision.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER NE, NEXT(2), IERR
+ REAL X1, X2, F1, F2, D1, D2, XE(*), FE(*), DE(*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I
+ REAL C2, C2T2, C3, C3T3, DEL1, DEL2, DELTA, H, X, XMI, XMA, ZERO
+ SAVE ZERO
+ DATA ZERO /0./
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT CHFDV
+ IF (NE .LT. 1) GO TO 5001
+ H = X2 - X1
+ IF (H .EQ. ZERO) GO TO 5002
+C
+C INITIALIZE.
+C
+ IERR = 0
+ NEXT(1) = 0
+ NEXT(2) = 0
+ XMI = MIN(ZERO, H)
+ XMA = MAX(ZERO, H)
+C
+C COMPUTE CUBIC COEFFICIENTS (EXPANDED ABOUT X1).
+C
+ DELTA = (F2 - F1)/H
+ DEL1 = (D1 - DELTA)/H
+ DEL2 = (D2 - DELTA)/H
+C (DELTA IS NO LONGER NEEDED.)
+ C2 = -(DEL1+DEL1 + DEL2)
+ C2T2 = C2 + C2
+ C3 = (DEL1 + DEL2)/H
+C (H, DEL1 AND DEL2 ARE NO LONGER NEEDED.)
+ C3T3 = C3+C3+C3
+C
+C EVALUATION LOOP.
+C
+ DO 500 I = 1, NE
+ X = XE(I) - X1
+ FE(I) = F1 + X*(D1 + X*(C2 + X*C3))
+ DE(I) = D1 + X*(C2T2 + X*C3T3)
+C COUNT EXTRAPOLATION POINTS.
+ IF ( X.LT.XMI ) NEXT(1) = NEXT(1) + 1
+ IF ( X.GT.XMA ) NEXT(2) = NEXT(2) + 1
+C (NOTE REDUNDANCY--IF EITHER CONDITION IS TRUE, OTHER IS FALSE.)
+ 500 CONTINUE
+C
+C NORMAL RETURN.
+C
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C NE.LT.1 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'CHFDV',
+ + 'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C X1.EQ.X2 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'CHFDV', 'INTERVAL ENDPOINTS EQUAL', IERR,
+ + 1)
+ RETURN
+C------------- LAST LINE OF CHFDV FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/chfev.f b/Lib/Slatec/slatec/chfev.f
new file mode 100644
index 0000000..1e97820
--- /dev/null
+++ b/Lib/Slatec/slatec/chfev.f
@@ -0,0 +1,155 @@
+*DECK CHFEV
+ SUBROUTINE CHFEV (X1, X2, F1, F2, D1, D2, NE, XE, FE, NEXT, IERR)
+C***BEGIN PROLOGUE CHFEV
+C***PURPOSE Evaluate a cubic polynomial given in Hermite form at an
+C array of points. While designed for use by PCHFE, it may
+C be useful directly as an evaluator for a piecewise cubic
+C Hermite function in applications, such as graphing, where
+C the interval is known in advance.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3
+C***TYPE SINGLE PRECISION (CHFEV-S, DCHFEV-D)
+C***KEYWORDS CUBIC HERMITE EVALUATION, CUBIC POLYNOMIAL EVALUATION,
+C PCHIP
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C CHFEV: Cubic Hermite Function EValuator
+C
+C Evaluates the cubic polynomial determined by function values
+C F1,F2 and derivatives D1,D2 on interval (X1,X2) at the points
+C XE(J), J=1(1)NE.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C INTEGER NE, NEXT(2), IERR
+C REAL X1, X2, F1, F2, D1, D2, XE(NE), FE(NE)
+C
+C CALL CHFEV (X1,X2, F1,F2, D1,D2, NE, XE, FE, NEXT, IERR)
+C
+C Parameters:
+C
+C X1,X2 -- (input) endpoints of interval of definition of cubic.
+C (Error return if X1.EQ.X2 .)
+C
+C F1,F2 -- (input) values of function at X1 and X2, respectively.
+C
+C D1,D2 -- (input) values of derivative at X1 and X2, respectively.
+C
+C NE -- (input) number of evaluation points. (Error return if
+C NE.LT.1 .)
+C
+C XE -- (input) real array of points at which the function is to be
+C evaluated. If any of the XE are outside the interval
+C [X1,X2], a warning error is returned in NEXT.
+C
+C FE -- (output) real array of values of the cubic function defined
+C by X1,X2, F1,F2, D1,D2 at the points XE.
+C
+C NEXT -- (output) integer array indicating number of extrapolation
+C points:
+C NEXT(1) = number of evaluation points to left of interval.
+C NEXT(2) = number of evaluation points to right of interval.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C "Recoverable" errors:
+C IERR = -1 if NE.LT.1 .
+C IERR = -2 if X1.EQ.X2 .
+C (The FE-array has not been changed in either case.)
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 811019 DATE WRITTEN
+C 820803 Minor cosmetic changes for release 1.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890703 Corrected category record. (WRB)
+C 890703 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C***END PROLOGUE CHFEV
+C Programming notes:
+C
+C To produce a double precision version, simply:
+C a. Change CHFEV to DCHFEV wherever it occurs,
+C b. Change the real declaration to double precision, and
+C c. Change the constant ZERO to double precision.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER NE, NEXT(2), IERR
+ REAL X1, X2, F1, F2, D1, D2, XE(*), FE(*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I
+ REAL C2, C3, DEL1, DEL2, DELTA, H, X, XMI, XMA, ZERO
+ SAVE ZERO
+ DATA ZERO /0./
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT CHFEV
+ IF (NE .LT. 1) GO TO 5001
+ H = X2 - X1
+ IF (H .EQ. ZERO) GO TO 5002
+C
+C INITIALIZE.
+C
+ IERR = 0
+ NEXT(1) = 0
+ NEXT(2) = 0
+ XMI = MIN(ZERO, H)
+ XMA = MAX(ZERO, H)
+C
+C COMPUTE CUBIC COEFFICIENTS (EXPANDED ABOUT X1).
+C
+ DELTA = (F2 - F1)/H
+ DEL1 = (D1 - DELTA)/H
+ DEL2 = (D2 - DELTA)/H
+C (DELTA IS NO LONGER NEEDED.)
+ C2 = -(DEL1+DEL1 + DEL2)
+ C3 = (DEL1 + DEL2)/H
+C (H, DEL1 AND DEL2 ARE NO LONGER NEEDED.)
+C
+C EVALUATION LOOP.
+C
+ DO 500 I = 1, NE
+ X = XE(I) - X1
+ FE(I) = F1 + X*(D1 + X*(C2 + X*C3))
+C COUNT EXTRAPOLATION POINTS.
+ IF ( X.LT.XMI ) NEXT(1) = NEXT(1) + 1
+ IF ( X.GT.XMA ) NEXT(2) = NEXT(2) + 1
+C (NOTE REDUNDANCY--IF EITHER CONDITION IS TRUE, OTHER IS FALSE.)
+ 500 CONTINUE
+C
+C NORMAL RETURN.
+C
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C NE.LT.1 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'CHFEV',
+ + 'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C X1.EQ.X2 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'CHFEV', 'INTERVAL ENDPOINTS EQUAL', IERR,
+ + 1)
+ RETURN
+C------------- LAST LINE OF CHFEV FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/chfie.f b/Lib/Slatec/slatec/chfie.f
new file mode 100644
index 0000000..e673f81
--- /dev/null
+++ b/Lib/Slatec/slatec/chfie.f
@@ -0,0 +1,108 @@
+*DECK CHFIE
+ REAL FUNCTION CHFIE (X1, X2, F1, F2, D1, D2, A, B)
+C***BEGIN PROLOGUE CHFIE
+C***SUBSIDIARY
+C***PURPOSE Evaluates integral of a single cubic for PCHIA
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE SINGLE PRECISION (CHFIE-S, DCHFIE-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C CHFIE: Cubic Hermite Function Integral Evaluator.
+C
+C Called by PCHIA to evaluate the integral of a single cubic (in
+C Hermite form) over an arbitrary interval (A,B).
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C REAL X1, X2, F1, F2, D1, D2, A, B
+C REAL VALUE, CHFIE
+C
+C VALUE = CHFIE (X1, X2, F1, F2, D1, D2, A, B)
+C
+C Parameters:
+C
+C VALUE -- (output) value of the requested integral.
+C
+C X1,X2 -- (input) endpoints if interval of definition of cubic.
+C
+C F1,F2 -- (input) function values at the ends of the interval.
+C
+C D1,D2 -- (input) derivative values at the ends of the interval.
+C
+C A,B -- (input) endpoints of interval of integration.
+C
+C***SEE ALSO PCHIA
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 820730 DATE WRITTEN
+C 820805 Converted to SLATEC library version.
+C 870813 Minor cosmetic changes.
+C 890411 1. Added SAVE statements (Vers. 3.2).
+C 2. Added SIX to REAL declaration.
+C 890411 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR section in prologue. (WRB)
+C 930503 Corrected to set VALUE=0 when IERR.ne.0. (FNF)
+C 930504 Eliminated IERR and changed name from CHFIV to CHFIE. (FNF)
+C***END PROLOGUE CHFIE
+C
+C Programming notes:
+C 1. There is no error return from this routine because zero is
+C indeed the mathematically correct answer when X1.EQ.X2 .
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ REAL X1, X2, F1, F2, D1, D2, A, B
+C
+C DECLARE LOCAL VARIABLES.
+C
+ REAL DTERM, FOUR, FTERM, H, HALF, PHIA1, PHIA2, PHIB1, PHIB2,
+ * PSIA1, PSIA2, PSIB1, PSIB2, SIX, TA1, TA2, TB1, TB2, THREE,
+ * TWO, UA1, UA2, UB1, UB2
+ SAVE HALF, TWO, THREE, FOUR, SIX
+C
+C INITIALIZE.
+C
+ DATA HALF /0.5/, TWO /2./, THREE /3./, FOUR /4./, SIX /6./
+C
+C VALIDITY CHECK INPUT.
+C
+C***FIRST EXECUTABLE STATEMENT CHFIE
+ IF (X1 .EQ. X2) THEN
+ CHFIE = 0
+ ELSE
+ H = X2 - X1
+ TA1 = (A - X1) / H
+ TA2 = (X2 - A) / H
+ TB1 = (B - X1) / H
+ TB2 = (X2 - B) / H
+C
+ UA1 = TA1**3
+ PHIA1 = UA1 * (TWO - TA1)
+ PSIA1 = UA1 * (THREE*TA1 - FOUR)
+ UA2 = TA2**3
+ PHIA2 = UA2 * (TWO - TA2)
+ PSIA2 = -UA2 * (THREE*TA2 - FOUR)
+C
+ UB1 = TB1**3
+ PHIB1 = UB1 * (TWO - TB1)
+ PSIB1 = UB1 * (THREE*TB1 - FOUR)
+ UB2 = TB2**3
+ PHIB2 = UB2 * (TWO - TB2)
+ PSIB2 = -UB2 * (THREE*TB2 - FOUR)
+C
+ FTERM = F1*(PHIA2 - PHIB2) + F2*(PHIB1 - PHIA1)
+ DTERM = ( D1*(PSIA2 - PSIB2) + D2*(PSIB1 - PSIA1) )*(H/SIX)
+C
+ CHFIE = (HALF*H) * (FTERM + DTERM)
+ ENDIF
+C
+ RETURN
+C------------- LAST LINE OF CHFIE FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/d1mach.f b/Lib/Slatec/slatec/d1mach.f
new file mode 100644
index 0000000..6f10f70
--- /dev/null
+++ b/Lib/Slatec/slatec/d1mach.f
@@ -0,0 +1,502 @@
+*DECK D1MACH
+ DOUBLE PRECISION FUNCTION D1MACH (I)
+C***BEGIN PROLOGUE D1MACH
+C***PURPOSE Return floating point machine dependent constants.
+C***LIBRARY SLATEC
+C***CATEGORY R1
+C***TYPE DOUBLE PRECISION (R1MACH-S, D1MACH-D)
+C***KEYWORDS MACHINE CONSTANTS
+C***AUTHOR Fox, P. A., (Bell Labs)
+C Hall, A. D., (Bell Labs)
+C Schryer, N. L., (Bell Labs)
+C***DESCRIPTION
+C
+C D1MACH can be used to obtain machine-dependent parameters for the
+C local machine environment. It is a function subprogram with one
+C (input) argument, and can be referenced as follows:
+C
+C D = D1MACH(I)
+C
+C where I=1,...,5. The (output) value of D above is determined by
+C the (input) value of I. The results for various values of I are
+C discussed below.
+C
+C D1MACH( 1) = B**(EMIN-1), the smallest positive magnitude.
+C D1MACH( 2) = B**EMAX*(1 - B**(-T)), the largest magnitude.
+C D1MACH( 3) = B**(-T), the smallest relative spacing.
+C D1MACH( 4) = B**(1-T), the largest relative spacing.
+C D1MACH( 5) = LOG10(B)
+C
+C Assume double precision numbers are represented in the T-digit,
+C base-B form
+C
+C sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
+C
+C where 0 .LE. X(I) .LT. B for I=1,...,T, 0 .LT. X(1), and
+C EMIN .LE. E .LE. EMAX.
+C
+C The values of B, T, EMIN and EMAX are provided in I1MACH as
+C follows:
+C I1MACH(10) = B, the base.
+C I1MACH(14) = T, the number of base-B digits.
+C I1MACH(15) = EMIN, the smallest exponent E.
+C I1MACH(16) = EMAX, the largest exponent E.
+C
+C To alter this function for a particular environment, the desired
+C set of DATA statements should be activated by removing the C from
+C column 1. Also, the values of D1MACH(1) - D1MACH(4) should be
+C checked for consistency with the local operating system.
+C
+C***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for
+C a portable library, ACM Transactions on Mathematical
+C Software 4, 2 (June 1978), pp. 177-188.
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 750101 DATE WRITTEN
+C 890213 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900618 Added DEC RISC constants. (WRB)
+C 900723 Added IBM RS 6000 constants. (WRB)
+C 900911 Added SUN 386i constants. (WRB)
+C 910710 Added HP 730 constants. (SMR)
+C 911114 Added Convex IEEE constants. (WRB)
+C 920121 Added SUN -r8 compiler option constants. (WRB)
+C 920229 Added Touchstone Delta i860 constants. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C 920625 Added CONVEX -p8 and -pd8 compiler option constants.
+C (BKS, WRB)
+C 930201 Added DEC Alpha and SGI constants. (RWC and WRB)
+C***END PROLOGUE D1MACH
+C
+ INTEGER SMALL(4)
+ INTEGER LARGE(4)
+ INTEGER RIGHT(4)
+ INTEGER DIVER(4)
+ INTEGER LOG10(4)
+C
+ DOUBLE PRECISION DMACH(5)
+ SAVE DMACH
+C
+ EQUIVALENCE (DMACH(1),SMALL(1))
+ EQUIVALENCE (DMACH(2),LARGE(1))
+ EQUIVALENCE (DMACH(3),RIGHT(1))
+ EQUIVALENCE (DMACH(4),DIVER(1))
+ EQUIVALENCE (DMACH(5),LOG10(1))
+C
+C MACHINE CONSTANTS FOR THE AMIGA
+C ABSOFT FORTRAN COMPILER USING THE 68020/68881 COMPILER OPTION
+C
+C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' /
+C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' /
+C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' /
+C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' /
+C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' /
+C
+C MACHINE CONSTANTS FOR THE AMIGA
+C ABSOFT FORTRAN COMPILER USING SOFTWARE FLOATING POINT
+C
+C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' /
+C DATA LARGE(1), LARGE(2) / Z'7FDFFFFF', Z'FFFFFFFF' /
+C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' /
+C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' /
+C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' /
+C
+C MACHINE CONSTANTS FOR THE APOLLO
+C
+C DATA SMALL(1), SMALL(2) / 16#00100000, 16#00000000 /
+C DATA LARGE(1), LARGE(2) / 16#7FFFFFFF, 16#FFFFFFFF /
+C DATA RIGHT(1), RIGHT(2) / 16#3CA00000, 16#00000000 /
+C DATA DIVER(1), DIVER(2) / 16#3CB00000, 16#00000000 /
+C DATA LOG10(1), LOG10(2) / 16#3FD34413, 16#509F79FF /
+C
+C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM
+C
+C DATA SMALL(1) / ZC00800000 /
+C DATA SMALL(2) / Z000000000 /
+C DATA LARGE(1) / ZDFFFFFFFF /
+C DATA LARGE(2) / ZFFFFFFFFF /
+C DATA RIGHT(1) / ZCC5800000 /
+C DATA RIGHT(2) / Z000000000 /
+C DATA DIVER(1) / ZCC6800000 /
+C DATA DIVER(2) / Z000000000 /
+C DATA LOG10(1) / ZD00E730E7 /
+C DATA LOG10(2) / ZC77800DC0 /
+C
+C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM
+C
+C DATA SMALL(1) / O1771000000000000 /
+C DATA SMALL(2) / O0000000000000000 /
+C DATA LARGE(1) / O0777777777777777 /
+C DATA LARGE(2) / O0007777777777777 /
+C DATA RIGHT(1) / O1461000000000000 /
+C DATA RIGHT(2) / O0000000000000000 /
+C DATA DIVER(1) / O1451000000000000 /
+C DATA DIVER(2) / O0000000000000000 /
+C DATA LOG10(1) / O1157163034761674 /
+C DATA LOG10(2) / O0006677466732724 /
+C
+C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS
+C
+C DATA SMALL(1) / O1771000000000000 /
+C DATA SMALL(2) / O7770000000000000 /
+C DATA LARGE(1) / O0777777777777777 /
+C DATA LARGE(2) / O7777777777777777 /
+C DATA RIGHT(1) / O1461000000000000 /
+C DATA RIGHT(2) / O0000000000000000 /
+C DATA DIVER(1) / O1451000000000000 /
+C DATA DIVER(2) / O0000000000000000 /
+C DATA LOG10(1) / O1157163034761674 /
+C DATA LOG10(2) / O0006677466732724 /
+C
+C MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE
+C
+C DATA SMALL(1) / Z"3001800000000000" /
+C DATA SMALL(2) / Z"3001000000000000" /
+C DATA LARGE(1) / Z"4FFEFFFFFFFFFFFE" /
+C DATA LARGE(2) / Z"4FFE000000000000" /
+C DATA RIGHT(1) / Z"3FD2800000000000" /
+C DATA RIGHT(2) / Z"3FD2000000000000" /
+C DATA DIVER(1) / Z"3FD3800000000000" /
+C DATA DIVER(2) / Z"3FD3000000000000" /
+C DATA LOG10(1) / Z"3FFF9A209A84FBCF" /
+C DATA LOG10(2) / Z"3FFFF7988F8959AC" /
+C
+C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES
+C
+C DATA SMALL(1) / 00564000000000000000B /
+C DATA SMALL(2) / 00000000000000000000B /
+C DATA LARGE(1) / 37757777777777777777B /
+C DATA LARGE(2) / 37157777777777777777B /
+C DATA RIGHT(1) / 15624000000000000000B /
+C DATA RIGHT(2) / 00000000000000000000B /
+C DATA DIVER(1) / 15634000000000000000B /
+C DATA DIVER(2) / 00000000000000000000B /
+C DATA LOG10(1) / 17164642023241175717B /
+C DATA LOG10(2) / 16367571421742254654B /
+C
+C MACHINE CONSTANTS FOR THE CELERITY C1260
+C
+C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' /
+C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' /
+C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' /
+C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' /
+C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' /
+C
+C MACHINE CONSTANTS FOR THE CONVEX
+C USING THE -fn OR -pd8 COMPILER OPTION
+C
+C DATA DMACH(1) / Z'0010000000000000' /
+C DATA DMACH(2) / Z'7FFFFFFFFFFFFFFF' /
+C DATA DMACH(3) / Z'3CC0000000000000' /
+C DATA DMACH(4) / Z'3CD0000000000000' /
+C DATA DMACH(5) / Z'3FF34413509F79FF' /
+C
+C MACHINE CONSTANTS FOR THE CONVEX
+C USING THE -fi COMPILER OPTION
+C
+C DATA DMACH(1) / Z'0010000000000000' /
+C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' /
+C DATA DMACH(3) / Z'3CA0000000000000' /
+C DATA DMACH(4) / Z'3CB0000000000000' /
+C DATA DMACH(5) / Z'3FD34413509F79FF' /
+C
+C MACHINE CONSTANTS FOR THE CONVEX
+C USING THE -p8 COMPILER OPTION
+C
+C DATA DMACH(1) / Z'00010000000000000000000000000000' /
+C DATA DMACH(2) / Z'7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' /
+C DATA DMACH(3) / Z'3F900000000000000000000000000000' /
+C DATA DMACH(4) / Z'3F910000000000000000000000000000' /
+C DATA DMACH(5) / Z'3FFF34413509F79FEF311F12B35816F9' /
+C
+C MACHINE CONSTANTS FOR THE CRAY
+C
+C DATA SMALL(1) / 201354000000000000000B /
+C DATA SMALL(2) / 000000000000000000000B /
+C DATA LARGE(1) / 577767777777777777777B /
+C DATA LARGE(2) / 000007777777777777774B /
+C DATA RIGHT(1) / 376434000000000000000B /
+C DATA RIGHT(2) / 000000000000000000000B /
+C DATA DIVER(1) / 376444000000000000000B /
+C DATA DIVER(2) / 000000000000000000000B /
+C DATA LOG10(1) / 377774642023241175717B /
+C DATA LOG10(2) / 000007571421742254654B /
+C
+C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200
+C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD -
+C STATIC DMACH(5)
+C
+C DATA SMALL / 20K, 3*0 /
+C DATA LARGE / 77777K, 3*177777K /
+C DATA RIGHT / 31420K, 3*0 /
+C DATA DIVER / 32020K, 3*0 /
+C DATA LOG10 / 40423K, 42023K, 50237K, 74776K /
+C
+C MACHINE CONSTANTS FOR THE DEC ALPHA
+C USING G_FLOAT
+C
+C DATA DMACH(1) / '0000000000000010'X /
+C DATA DMACH(2) / 'FFFFFFFFFFFF7FFF'X /
+C DATA DMACH(3) / '0000000000003CC0'X /
+C DATA DMACH(4) / '0000000000003CD0'X /
+C DATA DMACH(5) / '79FF509F44133FF3'X /
+C
+C MACHINE CONSTANTS FOR THE DEC ALPHA
+C USING IEEE_FORMAT
+C
+C DATA DMACH(1) / '0010000000000000'X /
+C DATA DMACH(2) / '7FEFFFFFFFFFFFFF'X /
+C DATA DMACH(3) / '3CA0000000000000'X /
+C DATA DMACH(4) / '3CB0000000000000'X /
+C DATA DMACH(5) / '3FD34413509F79FF'X /
+C
+C MACHINE CONSTANTS FOR THE DEC RISC
+C
+C DATA SMALL(1), SMALL(2) / Z'00000000', Z'00100000'/
+C DATA LARGE(1), LARGE(2) / Z'FFFFFFFF', Z'7FEFFFFF'/
+C DATA RIGHT(1), RIGHT(2) / Z'00000000', Z'3CA00000'/
+C DATA DIVER(1), DIVER(2) / Z'00000000', Z'3CB00000'/
+C DATA LOG10(1), LOG10(2) / Z'509F79FF', Z'3FD34413'/
+C
+C MACHINE CONSTANTS FOR THE DEC VAX
+C USING D_FLOATING
+C (EXPRESSED IN INTEGER AND HEXADECIMAL)
+C THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSTEMS
+C THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS
+C
+C DATA SMALL(1), SMALL(2) / 128, 0 /
+C DATA LARGE(1), LARGE(2) / -32769, -1 /
+C DATA RIGHT(1), RIGHT(2) / 9344, 0 /
+C DATA DIVER(1), DIVER(2) / 9472, 0 /
+C DATA LOG10(1), LOG10(2) / 546979738, -805796613 /
+C
+C DATA SMALL(1), SMALL(2) / Z00000080, Z00000000 /
+C DATA LARGE(1), LARGE(2) / ZFFFF7FFF, ZFFFFFFFF /
+C DATA RIGHT(1), RIGHT(2) / Z00002480, Z00000000 /
+C DATA DIVER(1), DIVER(2) / Z00002500, Z00000000 /
+C DATA LOG10(1), LOG10(2) / Z209A3F9A, ZCFF884FB /
+C
+C MACHINE CONSTANTS FOR THE DEC VAX
+C USING G_FLOATING
+C (EXPRESSED IN INTEGER AND HEXADECIMAL)
+C THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSTEMS
+C THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS
+C
+C DATA SMALL(1), SMALL(2) / 16, 0 /
+C DATA LARGE(1), LARGE(2) / -32769, -1 /
+C DATA RIGHT(1), RIGHT(2) / 15552, 0 /
+C DATA DIVER(1), DIVER(2) / 15568, 0 /
+C DATA LOG10(1), LOG10(2) / 1142112243, 2046775455 /
+C
+C DATA SMALL(1), SMALL(2) / Z00000010, Z00000000 /
+C DATA LARGE(1), LARGE(2) / ZFFFF7FFF, ZFFFFFFFF /
+C DATA RIGHT(1), RIGHT(2) / Z00003CC0, Z00000000 /
+C DATA DIVER(1), DIVER(2) / Z00003CD0, Z00000000 /
+C DATA LOG10(1), LOG10(2) / Z44133FF3, Z79FF509F /
+C
+C MACHINE CONSTANTS FOR THE ELXSI 6400
+C (ASSUMING REAL*8 IS THE DEFAULT DOUBLE PRECISION)
+C
+C DATA SMALL(1), SMALL(2) / '00100000'X,'00000000'X /
+C DATA LARGE(1), LARGE(2) / '7FEFFFFF'X,'FFFFFFFF'X /
+C DATA RIGHT(1), RIGHT(2) / '3CB00000'X,'00000000'X /
+C DATA DIVER(1), DIVER(2) / '3CC00000'X,'00000000'X /
+C DATA LOG10(1), LOG10(2) / '3FD34413'X,'509F79FF'X /
+C
+C MACHINE CONSTANTS FOR THE HARRIS 220
+C
+C DATA SMALL(1), SMALL(2) / '20000000, '00000201 /
+C DATA LARGE(1), LARGE(2) / '37777777, '37777577 /
+C DATA RIGHT(1), RIGHT(2) / '20000000, '00000333 /
+C DATA DIVER(1), DIVER(2) / '20000000, '00000334 /
+C DATA LOG10(1), LOG10(2) / '23210115, '10237777 /
+C
+C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES
+C
+C DATA SMALL(1), SMALL(2) / O402400000000, O000000000000 /
+C DATA LARGE(1), LARGE(2) / O376777777777, O777777777777 /
+C DATA RIGHT(1), RIGHT(2) / O604400000000, O000000000000 /
+C DATA DIVER(1), DIVER(2) / O606400000000, O000000000000 /
+C DATA LOG10(1), LOG10(2) / O776464202324, O117571775714 /
+C
+C MACHINE CONSTANTS FOR THE HP 730
+C
+C DATA DMACH(1) / Z'0010000000000000' /
+C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' /
+C DATA DMACH(3) / Z'3CA0000000000000' /
+C DATA DMACH(4) / Z'3CB0000000000000' /
+C DATA DMACH(5) / Z'3FD34413509F79FF' /
+C
+C MACHINE CONSTANTS FOR THE HP 2100
+C THREE WORD DOUBLE PRECISION OPTION WITH FTN4
+C
+C DATA SMALL(1), SMALL(2), SMALL(3) / 40000B, 0, 1 /
+C DATA LARGE(1), LARGE(2), LARGE(3) / 77777B, 177777B, 177776B /
+C DATA RIGHT(1), RIGHT(2), RIGHT(3) / 40000B, 0, 265B /
+C DATA DIVER(1), DIVER(2), DIVER(3) / 40000B, 0, 276B /
+C DATA LOG10(1), LOG10(2), LOG10(3) / 46420B, 46502B, 77777B /
+C
+C MACHINE CONSTANTS FOR THE HP 2100
+C FOUR WORD DOUBLE PRECISION OPTION WITH FTN4
+C
+C DATA SMALL(1), SMALL(2) / 40000B, 0 /
+C DATA SMALL(3), SMALL(4) / 0, 1 /
+C DATA LARGE(1), LARGE(2) / 77777B, 177777B /
+C DATA LARGE(3), LARGE(4) / 177777B, 177776B /
+C DATA RIGHT(1), RIGHT(2) / 40000B, 0 /
+C DATA RIGHT(3), RIGHT(4) / 0, 225B /
+C DATA DIVER(1), DIVER(2) / 40000B, 0 /
+C DATA DIVER(3), DIVER(4) / 0, 227B /
+C DATA LOG10(1), LOG10(2) / 46420B, 46502B /
+C DATA LOG10(3), LOG10(4) / 76747B, 176377B /
+C
+C MACHINE CONSTANTS FOR THE HP 9000
+C
+C DATA SMALL(1), SMALL(2) / 00040000000B, 00000000000B /
+C DATA LARGE(1), LARGE(2) / 17737777777B, 37777777777B /
+C DATA RIGHT(1), RIGHT(2) / 07454000000B, 00000000000B /
+C DATA DIVER(1), DIVER(2) / 07460000000B, 00000000000B /
+C DATA LOG10(1), LOG10(2) / 07764642023B, 12047674777B /
+C
+C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES,
+C THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86, AND
+C THE PERKIN ELMER (INTERDATA) 7/32.
+C
+C DATA SMALL(1), SMALL(2) / Z00100000, Z00000000 /
+C DATA LARGE(1), LARGE(2) / Z7FFFFFFF, ZFFFFFFFF /
+C DATA RIGHT(1), RIGHT(2) / Z33100000, Z00000000 /
+C DATA DIVER(1), DIVER(2) / Z34100000, Z00000000 /
+C DATA LOG10(1), LOG10(2) / Z41134413, Z509F79FF /
+C
+C MACHINE CONSTANTS FOR THE IBM PC
+C ASSUMES THAT ALL ARITHMETIC IS DONE IN DOUBLE PRECISION
+C ON 8088, I.E., NOT IN 80 BIT FORM FOR THE 8087.
+C
+C DATA SMALL(1) / 2.23D-308 /
+C DATA LARGE(1) / 1.79D+308 /
+C DATA RIGHT(1) / 1.11D-16 /
+C DATA DIVER(1) / 2.22D-16 /
+C DATA LOG10(1) / 0.301029995663981195D0 /
+C
+C MACHINE CONSTANTS FOR THE IBM RS 6000
+C
+C DATA DMACH(1) / Z'0010000000000000' /
+C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' /
+C DATA DMACH(3) / Z'3CA0000000000000' /
+C DATA DMACH(4) / Z'3CB0000000000000' /
+C DATA DMACH(5) / Z'3FD34413509F79FF' /
+C
+C MACHINE CONSTANTS FOR THE INTEL i860
+C
+C DATA DMACH(1) / Z'0010000000000000' /
+C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' /
+C DATA DMACH(3) / Z'3CA0000000000000' /
+C DATA DMACH(4) / Z'3CB0000000000000' /
+C DATA DMACH(5) / Z'3FD34413509F79FF' /
+C
+C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR)
+C
+C DATA SMALL(1), SMALL(2) / "033400000000, "000000000000 /
+C DATA LARGE(1), LARGE(2) / "377777777777, "344777777777 /
+C DATA RIGHT(1), RIGHT(2) / "113400000000, "000000000000 /
+C DATA DIVER(1), DIVER(2) / "114400000000, "000000000000 /
+C DATA LOG10(1), LOG10(2) / "177464202324, "144117571776 /
+C
+C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR)
+C
+C DATA SMALL(1), SMALL(2) / "000400000000, "000000000000 /
+C DATA LARGE(1), LARGE(2) / "377777777777, "377777777777 /
+C DATA RIGHT(1), RIGHT(2) / "103400000000, "000000000000 /
+C DATA DIVER(1), DIVER(2) / "104400000000, "000000000000 /
+C DATA LOG10(1), LOG10(2) / "177464202324, "476747767461 /
+C
+C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING
+C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL).
+C
+C DATA SMALL(1), SMALL(2) / 8388608, 0 /
+C DATA LARGE(1), LARGE(2) / 2147483647, -1 /
+C DATA RIGHT(1), RIGHT(2) / 612368384, 0 /
+C DATA DIVER(1), DIVER(2) / 620756992, 0 /
+C DATA LOG10(1), LOG10(2) / 1067065498, -2063872008 /
+C
+C DATA SMALL(1), SMALL(2) / O00040000000, O00000000000 /
+C DATA LARGE(1), LARGE(2) / O17777777777, O37777777777 /
+C DATA RIGHT(1), RIGHT(2) / O04440000000, O00000000000 /
+C DATA DIVER(1), DIVER(2) / O04500000000, O00000000000 /
+C DATA LOG10(1), LOG10(2) / O07746420232, O20476747770 /
+C
+C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING
+C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL).
+C
+C DATA SMALL(1), SMALL(2) / 128, 0 /
+C DATA SMALL(3), SMALL(4) / 0, 0 /
+C DATA LARGE(1), LARGE(2) / 32767, -1 /
+C DATA LARGE(3), LARGE(4) / -1, -1 /
+C DATA RIGHT(1), RIGHT(2) / 9344, 0 /
+C DATA RIGHT(3), RIGHT(4) / 0, 0 /
+C DATA DIVER(1), DIVER(2) / 9472, 0 /
+C DATA DIVER(3), DIVER(4) / 0, 0 /
+C DATA LOG10(1), LOG10(2) / 16282, 8346 /
+C DATA LOG10(3), LOG10(4) / -31493, -12296 /
+C
+C DATA SMALL(1), SMALL(2) / O000200, O000000 /
+C DATA SMALL(3), SMALL(4) / O000000, O000000 /
+C DATA LARGE(1), LARGE(2) / O077777, O177777 /
+C DATA LARGE(3), LARGE(4) / O177777, O177777 /
+C DATA RIGHT(1), RIGHT(2) / O022200, O000000 /
+C DATA RIGHT(3), RIGHT(4) / O000000, O000000 /
+C DATA DIVER(1), DIVER(2) / O022400, O000000 /
+C DATA DIVER(3), DIVER(4) / O000000, O000000 /
+C DATA LOG10(1), LOG10(2) / O037632, O020232 /
+C DATA LOG10(3), LOG10(4) / O102373, O147770 /
+C
+C MACHINE CONSTANTS FOR THE SILICON GRAPHICS
+C
+C DATA SMALL(1), SMALL(2) / Z'00100000', Z'00000000' /
+C DATA LARGE(1), LARGE(2) / Z'7FEFFFFF', Z'FFFFFFFF' /
+C DATA RIGHT(1), RIGHT(2) / Z'3CA00000', Z'00000000' /
+C DATA DIVER(1), DIVER(2) / Z'3CB00000', Z'00000000' /
+C DATA LOG10(1), LOG10(2) / Z'3FD34413', Z'509F79FF' /
+C
+C MACHINE CONSTANTS FOR THE SUN
+C
+C DATA DMACH(1) / Z'0010000000000000' /
+C DATA DMACH(2) / Z'7FEFFFFFFFFFFFFF' /
+C DATA DMACH(3) / Z'3CA0000000000000' /
+C DATA DMACH(4) / Z'3CB0000000000000' /
+C DATA DMACH(5) / Z'3FD34413509F79FF' /
+C
+C MACHINE CONSTANTS FOR THE SUN
+C USING THE -r8 COMPILER OPTION
+C
+C DATA DMACH(1) / Z'00010000000000000000000000000000' /
+C DATA DMACH(2) / Z'7FFEFFFFFFFFFFFFFFFFFFFFFFFFFFFF' /
+C DATA DMACH(3) / Z'3F8E0000000000000000000000000000' /
+C DATA DMACH(4) / Z'3F8F0000000000000000000000000000' /
+C DATA DMACH(5) / Z'3FFD34413509F79FEF311F12B35816F9' /
+C
+C MACHINE CONSTANTS FOR THE SUN 386i
+C
+C DATA SMALL(1), SMALL(2) / Z'FFFFFFFD', Z'000FFFFF' /
+C DATA LARGE(1), LARGE(2) / Z'FFFFFFB0', Z'7FEFFFFF' /
+C DATA RIGHT(1), RIGHT(2) / Z'000000B0', Z'3CA00000' /
+C DATA DIVER(1), DIVER(2) / Z'FFFFFFCB', Z'3CAFFFFF'
+C DATA LOG10(1), LOG10(2) / Z'509F79E9', Z'3FD34413' /
+C
+C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES FTN COMPILER
+C
+C DATA SMALL(1), SMALL(2) / O000040000000, O000000000000 /
+C DATA LARGE(1), LARGE(2) / O377777777777, O777777777777 /
+C DATA RIGHT(1), RIGHT(2) / O170540000000, O000000000000 /
+C DATA DIVER(1), DIVER(2) / O170640000000, O000000000000 /
+C DATA LOG10(1), LOG10(2) / O177746420232, O411757177572 /
+C
+C***FIRST EXECUTABLE STATEMENT D1MACH
+ IF (I .LT. 1 .OR. I .GT. 5) CALL XERMSG ('SLATEC', 'D1MACH',
+ + 'I OUT OF BOUNDS', 1, 2)
+C
+ D1MACH = DMACH(I)
+ RETURN
+C
+ END
diff --git a/Lib/Slatec/slatec/dasum.f b/Lib/Slatec/slatec/dasum.f
new file mode 100644
index 0000000..6165e55
--- /dev/null
+++ b/Lib/Slatec/slatec/dasum.f
@@ -0,0 +1,80 @@
+*DECK DASUM
+ DOUBLE PRECISION FUNCTION DASUM (N, DX, INCX)
+C***BEGIN PROLOGUE DASUM
+C***PURPOSE Compute the sum of the magnitudes of the elements of a
+C vector.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A3A
+C***TYPE DOUBLE PRECISION (SASUM-S, DASUM-D, SCASUM-C)
+C***KEYWORDS BLAS, LINEAR ALGEBRA, SUM OF MAGNITUDES OF A VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C DX double precision vector with N elements
+C INCX storage spacing between elements of DX
+C
+C --Output--
+C DASUM double precision result (zero if N .LE. 0)
+C
+C Returns sum of magnitudes of double precision DX.
+C DASUM = sum from 0 to N-1 of ABS(DX(IX+I*INCX)),
+C where IX = 1 if INCX .GE. 0, else IX = 1+(1-N)*INCX.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900821 Modified to correct problem with a negative increment.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DASUM
+ DOUBLE PRECISION DX(*)
+ INTEGER I, INCX, IX, M, MP1, N
+C***FIRST EXECUTABLE STATEMENT DASUM
+ DASUM = 0.0D0
+ IF (N .LE. 0) RETURN
+C
+ IF (INCX .EQ. 1) GOTO 20
+C
+C Code for increment not equal to 1.
+C
+ IX = 1
+ IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
+ DO 10 I = 1,N
+ DASUM = DASUM + ABS(DX(IX))
+ IX = IX + INCX
+ 10 CONTINUE
+ RETURN
+C
+C Code for increment equal to 1.
+C
+C Clean-up loop so remaining vector length is a multiple of 6.
+C
+ 20 M = MOD(N,6)
+ IF (M .EQ. 0) GOTO 40
+ DO 30 I = 1,M
+ DASUM = DASUM + ABS(DX(I))
+ 30 CONTINUE
+ IF (N .LT. 6) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,6
+ DASUM = DASUM + ABS(DX(I)) + ABS(DX(I+1)) + ABS(DX(I+2)) +
+ 1 ABS(DX(I+3)) + ABS(DX(I+4)) + ABS(DX(I+5))
+ 50 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/daxpy.f b/Lib/Slatec/slatec/daxpy.f
new file mode 100644
index 0000000..d1a0ff6
--- /dev/null
+++ b/Lib/Slatec/slatec/daxpy.f
@@ -0,0 +1,92 @@
+*DECK DAXPY
+ SUBROUTINE DAXPY (N, DA, DX, INCX, DY, INCY)
+C***BEGIN PROLOGUE DAXPY
+C***PURPOSE Compute a constant times a vector plus a vector.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A7
+C***TYPE DOUBLE PRECISION (SAXPY-S, DAXPY-D, CAXPY-C)
+C***KEYWORDS BLAS, LINEAR ALGEBRA, TRIAD, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C DA double precision scalar multiplier
+C DX double precision vector with N elements
+C INCX storage spacing between elements of DX
+C DY double precision vector with N elements
+C INCY storage spacing between elements of DY
+C
+C --Output--
+C DY double precision result (unchanged if N .LE. 0)
+C
+C Overwrite double precision DY with double precision DA*DX + DY.
+C For I = 0 to N-1, replace DY(LY+I*INCY) with DA*DX(LX+I*INCX) +
+C DY(LY+I*INCY),
+C where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
+C defined in a similar way using INCY.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920310 Corrected definition of LX in DESCRIPTION. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DAXPY
+ DOUBLE PRECISION DX(*), DY(*), DA
+C***FIRST EXECUTABLE STATEMENT DAXPY
+ IF (N.LE.0 .OR. DA.EQ.0.0D0) RETURN
+ IF (INCX .EQ. INCY) IF (INCX-1) 5,20,60
+C
+C Code for unequal or nonpositive increments.
+C
+ 5 IX = 1
+ IY = 1
+ IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
+ IF (INCY .LT. 0) IY = (-N+1)*INCY + 1
+ DO 10 I = 1,N
+ DY(IY) = DY(IY) + DA*DX(IX)
+ IX = IX + INCX
+ IY = IY + INCY
+ 10 CONTINUE
+ RETURN
+C
+C Code for both increments equal to 1.
+C
+C Clean-up loop so remaining vector length is a multiple of 4.
+C
+ 20 M = MOD(N,4)
+ IF (M .EQ. 0) GO TO 40
+ DO 30 I = 1,M
+ DY(I) = DY(I) + DA*DX(I)
+ 30 CONTINUE
+ IF (N .LT. 4) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,4
+ DY(I) = DY(I) + DA*DX(I)
+ DY(I+1) = DY(I+1) + DA*DX(I+1)
+ DY(I+2) = DY(I+2) + DA*DX(I+2)
+ DY(I+3) = DY(I+3) + DA*DX(I+3)
+ 50 CONTINUE
+ RETURN
+C
+C Code for equal, positive, non-unit increments.
+C
+ 60 NS = N*INCX
+ DO 70 I = 1,NS,INCX
+ DY(I) = DA*DX(I) + DY(I)
+ 70 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/dchfcm.f b/Lib/Slatec/slatec/dchfcm.f
new file mode 100644
index 0000000..4dfbe07
--- /dev/null
+++ b/Lib/Slatec/slatec/dchfcm.f
@@ -0,0 +1,152 @@
+*DECK DCHFCM
+ INTEGER FUNCTION DCHFCM (D1, D2, DELTA)
+C***BEGIN PROLOGUE DCHFCM
+C***SUBSIDIARY
+C***PURPOSE Check a single cubic for monotonicity.
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE DOUBLE PRECISION (CHFCM-S, DCHFCM-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C *Usage:
+C
+C DOUBLE PRECISION D1, D2, DELTA
+C INTEGER ISMON, DCHFCM
+C
+C ISMON = DCHFCM (D1, D2, DELTA)
+C
+C *Arguments:
+C
+C D1,D2:IN are the derivative values at the ends of an interval.
+C
+C DELTA:IN is the data slope over that interval.
+C
+C *Function Return Values:
+C ISMON : indicates the monotonicity of the cubic segment:
+C ISMON = -3 if function is probably decreasing;
+C ISMON = -1 if function is strictly decreasing;
+C ISMON = 0 if function is constant;
+C ISMON = 1 if function is strictly increasing;
+C ISMON = 2 if function is non-monotonic;
+C ISMON = 3 if function is probably increasing.
+C If ABS(ISMON)=3, the derivative values are too close to the
+C boundary of the monotonicity region to declare monotonicity
+C in the presence of roundoff error.
+C
+C *Description:
+C
+C DCHFCM: Cubic Hermite Function -- Check Monotonicity.
+C
+C Called by DPCHCM to determine the monotonicity properties of the
+C cubic with boundary derivative values D1,D2 and chord slope DELTA.
+C
+C *Cautions:
+C This is essentially the same as old DCHFMC, except that a
+C new output value, -3, was added February 1989. (Formerly, -3
+C and +3 were lumped together in the single value 3.) Codes that
+C flag nonmonotonicity by "IF (ISMON.EQ.2)" need not be changed.
+C Codes that check via "IF (ISMON.GE.3)" should change the test to
+C "IF (IABS(ISMON).GE.3)". Codes that declare monotonicity via
+C "IF (ISMON.LE.1)" should change to "IF (IABS(ISMON).LE.1)".
+C
+C REFER TO DPCHCM
+C
+C***ROUTINES CALLED D1MACH
+C***REVISION HISTORY (YYMMDD)
+C 820518 DATE WRITTEN
+C 820805 Converted to SLATEC library version.
+C 831201 Changed from ISIGN to SIGN to correct bug that
+C produced wrong sign when -1 .LT. DELTA .LT. 0 .
+C 890206 Added SAVE statements.
+C 890209 Added sign to returned value ISMON=3 and corrected
+C argument description accordingly.
+C 890306 Added caution about changed output.
+C 890407 Changed name from DCHFMC to DCHFCM, as requested at the
+C March 1989 SLATEC CML meeting, and made a few other
+C minor modifications necessitated by this change.
+C 890407 Converted to new SLATEC format.
+C 890407 Modified DESCRIPTION to LDOC format.
+C 891214 Moved SAVE statements. (WRB)
+C***END PROLOGUE DCHFCM
+C
+C Fortran intrinsics used: DSIGN.
+C Other routines used: D1MACH.
+C
+C ----------------------------------------------------------------------
+C
+C Programming notes:
+C
+C TEN is actually a tuning parameter, which determines the width of
+C the fuzz around the elliptical boundary.
+C
+C To produce a single precision version, simply:
+C a. Change DCHFCM to CHFCM wherever it occurs,
+C b. Change the double precision declarations to real, and
+C c. Change the constants ZERO, ONE, ... to single precision.
+C
+C DECLARE ARGUMENTS.
+C
+ DOUBLE PRECISION D1, D2, DELTA, D1MACH
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER ISMON, ITRUE
+ DOUBLE PRECISION A, B, EPS, FOUR, ONE, PHI, TEN, THREE, TWO,
+ * ZERO
+ SAVE ZERO, ONE, TWO, THREE, FOUR
+ SAVE TEN
+C
+C INITIALIZE.
+C
+ DATA ZERO /0.D0/, ONE/1.D0/, TWO/2.D0/, THREE/3.D0/, FOUR/4.D0/,
+ 1 TEN /10.D0/
+C
+C MACHINE-DEPENDENT PARAMETER -- SHOULD BE ABOUT 10*UROUND.
+C***FIRST EXECUTABLE STATEMENT DCHFCM
+ EPS = TEN*D1MACH(4)
+C
+C MAKE THE CHECK.
+C
+ IF (DELTA .EQ. ZERO) THEN
+C CASE OF CONSTANT DATA.
+ IF ((D1.EQ.ZERO) .AND. (D2.EQ.ZERO)) THEN
+ ISMON = 0
+ ELSE
+ ISMON = 2
+ ENDIF
+ ELSE
+C DATA IS NOT CONSTANT -- PICK UP SIGN.
+ ITRUE = DSIGN (ONE, DELTA)
+ A = D1/DELTA
+ B = D2/DELTA
+ IF ((A.LT.ZERO) .OR. (B.LT.ZERO)) THEN
+ ISMON = 2
+ ELSE IF ((A.LE.THREE-EPS) .AND. (B.LE.THREE-EPS)) THEN
+C INSIDE SQUARE (0,3)X(0,3) IMPLIES OK.
+ ISMON = ITRUE
+ ELSE IF ((A.GT.FOUR+EPS) .AND. (B.GT.FOUR+EPS)) THEN
+C OUTSIDE SQUARE (0,4)X(0,4) IMPLIES NONMONOTONIC.
+ ISMON = 2
+ ELSE
+C MUST CHECK AGAINST BOUNDARY OF ELLIPSE.
+ A = A - TWO
+ B = B - TWO
+ PHI = ((A*A + B*B) + A*B) - THREE
+ IF (PHI .LT. -EPS) THEN
+ ISMON = ITRUE
+ ELSE IF (PHI .GT. EPS) THEN
+ ISMON = 2
+ ELSE
+C TO CLOSE TO BOUNDARY TO TELL,
+C IN THE PRESENCE OF ROUND-OFF ERRORS.
+ ISMON = 3*ITRUE
+ ENDIF
+ ENDIF
+ ENDIF
+C
+C RETURN VALUE.
+C
+ DCHFCM = ISMON
+ RETURN
+C------------- LAST LINE OF DCHFCM FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dchfdv.f b/Lib/Slatec/slatec/dchfdv.f
new file mode 100644
index 0000000..b68bb95
--- /dev/null
+++ b/Lib/Slatec/slatec/dchfdv.f
@@ -0,0 +1,170 @@
+*DECK DCHFDV
+ SUBROUTINE DCHFDV (X1, X2, F1, F2, D1, D2, NE, XE, FE, DE, NEXT,
+ + IERR)
+C***BEGIN PROLOGUE DCHFDV
+C***PURPOSE Evaluate a cubic polynomial given in Hermite form and its
+C first derivative at an array of points. While designed for
+C use by DPCHFD, it may be useful directly as an evaluator
+C for a piecewise cubic Hermite function in applications,
+C such as graphing, where the interval is known in advance.
+C If only function values are required, use DCHFEV instead.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3, H1
+C***TYPE DOUBLE PRECISION (CHFDV-S, DCHFDV-D)
+C***KEYWORDS CUBIC HERMITE DIFFERENTIATION, CUBIC HERMITE EVALUATION,
+C CUBIC POLYNOMIAL EVALUATION, PCHIP
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C DCHFDV: Cubic Hermite Function and Derivative Evaluator
+C
+C Evaluates the cubic polynomial determined by function values
+C F1,F2 and derivatives D1,D2 on interval (X1,X2), together with
+C its first derivative, at the points XE(J), J=1(1)NE.
+C
+C If only function values are required, use DCHFEV, instead.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C INTEGER NE, NEXT(2), IERR
+C DOUBLE PRECISION X1, X2, F1, F2, D1, D2, XE(NE), FE(NE),
+C DE(NE)
+C
+C CALL DCHFDV (X1,X2, F1,F2, D1,D2, NE, XE, FE, DE, NEXT, IERR)
+C
+C Parameters:
+C
+C X1,X2 -- (input) endpoints of interval of definition of cubic.
+C (Error return if X1.EQ.X2 .)
+C
+C F1,F2 -- (input) values of function at X1 and X2, respectively.
+C
+C D1,D2 -- (input) values of derivative at X1 and X2, respectively.
+C
+C NE -- (input) number of evaluation points. (Error return if
+C NE.LT.1 .)
+C
+C XE -- (input) real*8 array of points at which the functions are to
+C be evaluated. If any of the XE are outside the interval
+C [X1,X2], a warning error is returned in NEXT.
+C
+C FE -- (output) real*8 array of values of the cubic function
+C defined by X1,X2, F1,F2, D1,D2 at the points XE.
+C
+C DE -- (output) real*8 array of values of the first derivative of
+C the same function at the points XE.
+C
+C NEXT -- (output) integer array indicating number of extrapolation
+C points:
+C NEXT(1) = number of evaluation points to left of interval.
+C NEXT(2) = number of evaluation points to right of interval.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C "Recoverable" errors:
+C IERR = -1 if NE.LT.1 .
+C IERR = -2 if X1.EQ.X2 .
+C (Output arrays have not been changed in either case.)
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 811019 DATE WRITTEN
+C 820803 Minor cosmetic changes for release 1.
+C 870707 Corrected XERROR calls for d.p. names(s).
+C 870813 Minor cosmetic changes.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 891006 Cosmetic changes to prologue. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C***END PROLOGUE DCHFDV
+C Programming notes:
+C
+C To produce a single precision version, simply:
+C a. Change DCHFDV to CHFDV wherever it occurs,
+C b. Change the double precision declaration to real, and
+C c. Change the constant ZERO to single precision.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER NE, NEXT(2), IERR
+ DOUBLE PRECISION X1, X2, F1, F2, D1, D2, XE(*), FE(*), DE(*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I
+ DOUBLE PRECISION C2, C2T2, C3, C3T3, DEL1, DEL2, DELTA, H, X,
+ * XMI, XMA, ZERO
+ SAVE ZERO
+ DATA ZERO /0.D0/
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT DCHFDV
+ IF (NE .LT. 1) GO TO 5001
+ H = X2 - X1
+ IF (H .EQ. ZERO) GO TO 5002
+C
+C INITIALIZE.
+C
+ IERR = 0
+ NEXT(1) = 0
+ NEXT(2) = 0
+ XMI = MIN(ZERO, H)
+ XMA = MAX(ZERO, H)
+C
+C COMPUTE CUBIC COEFFICIENTS (EXPANDED ABOUT X1).
+C
+ DELTA = (F2 - F1)/H
+ DEL1 = (D1 - DELTA)/H
+ DEL2 = (D2 - DELTA)/H
+C (DELTA IS NO LONGER NEEDED.)
+ C2 = -(DEL1+DEL1 + DEL2)
+ C2T2 = C2 + C2
+ C3 = (DEL1 + DEL2)/H
+C (H, DEL1 AND DEL2 ARE NO LONGER NEEDED.)
+ C3T3 = C3+C3+C3
+C
+C EVALUATION LOOP.
+C
+ DO 500 I = 1, NE
+ X = XE(I) - X1
+ FE(I) = F1 + X*(D1 + X*(C2 + X*C3))
+ DE(I) = D1 + X*(C2T2 + X*C3T3)
+C COUNT EXTRAPOLATION POINTS.
+ IF ( X.LT.XMI ) NEXT(1) = NEXT(1) + 1
+ IF ( X.GT.XMA ) NEXT(2) = NEXT(2) + 1
+C (NOTE REDUNDANCY--IF EITHER CONDITION IS TRUE, OTHER IS FALSE.)
+ 500 CONTINUE
+C
+C NORMAL RETURN.
+C
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C NE.LT.1 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DCHFDV',
+ + 'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C X1.EQ.X2 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'DCHFDV', 'INTERVAL ENDPOINTS EQUAL',
+ + IERR, 1)
+ RETURN
+C------------- LAST LINE OF DCHFDV FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dchfev.f b/Lib/Slatec/slatec/dchfev.f
new file mode 100644
index 0000000..476d952
--- /dev/null
+++ b/Lib/Slatec/slatec/dchfev.f
@@ -0,0 +1,160 @@
+*DECK DCHFEV
+ SUBROUTINE DCHFEV (X1, X2, F1, F2, D1, D2, NE, XE, FE, NEXT, IERR)
+C***BEGIN PROLOGUE DCHFEV
+C***PURPOSE Evaluate a cubic polynomial given in Hermite form at an
+C array of points. While designed for use by DPCHFE, it may
+C be useful directly as an evaluator for a piecewise cubic
+C Hermite function in applications, such as graphing, where
+C the interval is known in advance.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3
+C***TYPE DOUBLE PRECISION (CHFEV-S, DCHFEV-D)
+C***KEYWORDS CUBIC HERMITE EVALUATION, CUBIC POLYNOMIAL EVALUATION,
+C PCHIP
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C DCHFEV: Cubic Hermite Function EValuator
+C
+C Evaluates the cubic polynomial determined by function values
+C F1,F2 and derivatives D1,D2 on interval (X1,X2) at the points
+C XE(J), J=1(1)NE.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C INTEGER NE, NEXT(2), IERR
+C DOUBLE PRECISION X1, X2, F1, F2, D1, D2, XE(NE), FE(NE)
+C
+C CALL DCHFEV (X1,X2, F1,F2, D1,D2, NE, XE, FE, NEXT, IERR)
+C
+C Parameters:
+C
+C X1,X2 -- (input) endpoints of interval of definition of cubic.
+C (Error return if X1.EQ.X2 .)
+C
+C F1,F2 -- (input) values of function at X1 and X2, respectively.
+C
+C D1,D2 -- (input) values of derivative at X1 and X2, respectively.
+C
+C NE -- (input) number of evaluation points. (Error return if
+C NE.LT.1 .)
+C
+C XE -- (input) real*8 array of points at which the function is to
+C be evaluated. If any of the XE are outside the interval
+C [X1,X2], a warning error is returned in NEXT.
+C
+C FE -- (output) real*8 array of values of the cubic function
+C defined by X1,X2, F1,F2, D1,D2 at the points XE.
+C
+C NEXT -- (output) integer array indicating number of extrapolation
+C points:
+C NEXT(1) = number of evaluation points to left of interval.
+C NEXT(2) = number of evaluation points to right of interval.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C "Recoverable" errors:
+C IERR = -1 if NE.LT.1 .
+C IERR = -2 if X1.EQ.X2 .
+C (The FE-array has not been changed in either case.)
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 811019 DATE WRITTEN
+C 820803 Minor cosmetic changes for release 1.
+C 870813 Corrected XERROR calls for d.p. names(s).
+C 890206 Corrected XERROR calls.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890703 Corrected category record. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 891006 Cosmetic changes to prologue. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C***END PROLOGUE DCHFEV
+C Programming notes:
+C
+C To produce a single precision version, simply:
+C a. Change DCHFEV to CHFEV wherever it occurs,
+C b. Change the double precision declaration to real, and
+C c. Change the constant ZERO to single precision.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER NE, NEXT(2), IERR
+ DOUBLE PRECISION X1, X2, F1, F2, D1, D2, XE(*), FE(*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I
+ DOUBLE PRECISION C2, C3, DEL1, DEL2, DELTA, H, X, XMI, XMA,
+ * ZERO
+ SAVE ZERO
+ DATA ZERO /0.D0/
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT DCHFEV
+ IF (NE .LT. 1) GO TO 5001
+ H = X2 - X1
+ IF (H .EQ. ZERO) GO TO 5002
+C
+C INITIALIZE.
+C
+ IERR = 0
+ NEXT(1) = 0
+ NEXT(2) = 0
+ XMI = MIN(ZERO, H)
+ XMA = MAX(ZERO, H)
+C
+C COMPUTE CUBIC COEFFICIENTS (EXPANDED ABOUT X1).
+C
+ DELTA = (F2 - F1)/H
+ DEL1 = (D1 - DELTA)/H
+ DEL2 = (D2 - DELTA)/H
+C (DELTA IS NO LONGER NEEDED.)
+ C2 = -(DEL1+DEL1 + DEL2)
+ C3 = (DEL1 + DEL2)/H
+C (H, DEL1 AND DEL2 ARE NO LONGER NEEDED.)
+C
+C EVALUATION LOOP.
+C
+ DO 500 I = 1, NE
+ X = XE(I) - X1
+ FE(I) = F1 + X*(D1 + X*(C2 + X*C3))
+C COUNT EXTRAPOLATION POINTS.
+ IF ( X.LT.XMI ) NEXT(1) = NEXT(1) + 1
+ IF ( X.GT.XMA ) NEXT(2) = NEXT(2) + 1
+C (NOTE REDUNDANCY--IF EITHER CONDITION IS TRUE, OTHER IS FALSE.)
+ 500 CONTINUE
+C
+C NORMAL RETURN.
+C
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C NE.LT.1 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DCHFEV',
+ + 'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C X1.EQ.X2 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'DCHFEV', 'INTERVAL ENDPOINTS EQUAL',
+ + IERR, 1)
+ RETURN
+C------------- LAST LINE OF DCHFEV FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dchfie.f b/Lib/Slatec/slatec/dchfie.f
new file mode 100644
index 0000000..8d141b4
--- /dev/null
+++ b/Lib/Slatec/slatec/dchfie.f
@@ -0,0 +1,109 @@
+*DECK DCHFIE
+ DOUBLE PRECISION FUNCTION DCHFIE (X1, X2, F1, F2, D1, D2, A, B)
+C***BEGIN PROLOGUE DCHFIE
+C***SUBSIDIARY
+C***PURPOSE Evaluates integral of a single cubic for DPCHIA
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE DOUBLE PRECISION (CHFIE-S, DCHFIE-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C DCHFIE: Cubic Hermite Function Integral Evaluator.
+C
+C Called by DPCHIA to evaluate the integral of a single cubic (in
+C Hermite form) over an arbitrary interval (A,B).
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C DOUBLE PRECISION X1, X2, F1, F2, D1, D2, A, B
+C DOUBLE PRECISION VALUE, DCHFIE
+C
+C VALUE = DCHFIE (X1, X2, F1, F2, D1, D2, A, B)
+C
+C Parameters:
+C
+C VALUE -- (output) value of the requested integral.
+C
+C X1,X2 -- (input) endpoints if interval of definition of cubic.
+C
+C F1,F2 -- (input) function values at the ends of the interval.
+C
+C D1,D2 -- (input) derivative values at the ends of the interval.
+C
+C A,B -- (input) endpoints of interval of integration.
+C
+C***SEE ALSO DPCHIA
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 820730 DATE WRITTEN
+C 820805 Converted to SLATEC library version.
+C 870707 Corrected subroutine name from DCHIV to DCHFIV.
+C 870813 Minor cosmetic changes.
+C 890411 1. Added SAVE statements (Vers. 3.2).
+C 2. Added SIX to DOUBLE PRECISION declaration.
+C 890411 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR section in prologue. (WRB)
+C 930503 Corrected to set VALUE=0 when IERR.ne.0. (FNF)
+C 930504 Eliminated IERR and changed name DCHFIV to DCHFIE. (FNF)
+C***END PROLOGUE DCHFIE
+C
+C Programming notes:
+C 1. There is no error return from this routine because zero is
+C indeed the mathematically correct answer when X1.EQ.X2 .
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ DOUBLE PRECISION X1, X2, F1, F2, D1, D2, A, B
+C
+C DECLARE LOCAL VARIABLES.
+C
+ DOUBLE PRECISION DTERM, FOUR, FTERM, H, HALF, PHIA1, PHIA2,
+ * PHIB1, PHIB2, PSIA1, PSIA2, PSIB1, PSIB2, SIX, TA1, TA2,
+ * TB1, TB2, THREE, TWO, UA1, UA2, UB1, UB2
+ SAVE HALF, TWO, THREE, FOUR, SIX
+C
+C INITIALIZE.
+C
+ DATA HALF/.5D0/, TWO/2.D0/, THREE/3.D0/, FOUR/4.D0/, SIX/6.D0/
+C
+C VALIDITY CHECK INPUT.
+C
+C***FIRST EXECUTABLE STATEMENT DCHFIE
+ IF (X1 .EQ. X2) THEN
+ DCHFIE = 0
+ ELSE
+ H = X2 - X1
+ TA1 = (A - X1) / H
+ TA2 = (X2 - A) / H
+ TB1 = (B - X1) / H
+ TB2 = (X2 - B) / H
+C
+ UA1 = TA1**3
+ PHIA1 = UA1 * (TWO - TA1)
+ PSIA1 = UA1 * (THREE*TA1 - FOUR)
+ UA2 = TA2**3
+ PHIA2 = UA2 * (TWO - TA2)
+ PSIA2 = -UA2 * (THREE*TA2 - FOUR)
+C
+ UB1 = TB1**3
+ PHIB1 = UB1 * (TWO - TB1)
+ PSIB1 = UB1 * (THREE*TB1 - FOUR)
+ UB2 = TB2**3
+ PHIB2 = UB2 * (TWO - TB2)
+ PSIB2 = -UB2 * (THREE*TB2 - FOUR)
+C
+ FTERM = F1*(PHIA2 - PHIB2) + F2*(PHIB1 - PHIA1)
+ DTERM = ( D1*(PSIA2 - PSIB2) + D2*(PSIB1 - PSIA1) )*(H/SIX)
+C
+ DCHFIE = (HALF*H) * (FTERM + DTERM)
+ ENDIF
+C
+ RETURN
+C------------- LAST LINE OF DCHFIE FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/ddot.f b/Lib/Slatec/slatec/ddot.f
new file mode 100644
index 0000000..1fe83eb
--- /dev/null
+++ b/Lib/Slatec/slatec/ddot.f
@@ -0,0 +1,89 @@
+*DECK DDOT
+ DOUBLE PRECISION FUNCTION DDOT (N, DX, INCX, DY, INCY)
+C***BEGIN PROLOGUE DDOT
+C***PURPOSE Compute the inner product of two vectors.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A4
+C***TYPE DOUBLE PRECISION (SDOT-S, DDOT-D, CDOTU-C)
+C***KEYWORDS BLAS, INNER PRODUCT, LINEAR ALGEBRA, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C DX double precision vector with N elements
+C INCX storage spacing between elements of DX
+C DY double precision vector with N elements
+C INCY storage spacing between elements of DY
+C
+C --Output--
+C DDOT double precision dot product (zero if N .LE. 0)
+C
+C Returns the dot product of double precision DX and DY.
+C DDOT = sum for I = 0 to N-1 of DX(LX+I*INCX) * DY(LY+I*INCY),
+C where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
+C defined in a similar way using INCY.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920310 Corrected definition of LX in DESCRIPTION. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DDOT
+ DOUBLE PRECISION DX(*), DY(*)
+C***FIRST EXECUTABLE STATEMENT DDOT
+ DDOT = 0.0D0
+ IF (N .LE. 0) RETURN
+ IF (INCX .EQ. INCY) IF (INCX-1) 5,20,60
+C
+C Code for unequal or nonpositive increments.
+C
+ 5 IX = 1
+ IY = 1
+ IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
+ IF (INCY .LT. 0) IY = (-N+1)*INCY + 1
+ DO 10 I = 1,N
+ DDOT = DDOT + DX(IX)*DY(IY)
+ IX = IX + INCX
+ IY = IY + INCY
+ 10 CONTINUE
+ RETURN
+C
+C Code for both increments equal to 1.
+C
+C Clean-up loop so remaining vector length is a multiple of 5.
+C
+ 20 M = MOD(N,5)
+ IF (M .EQ. 0) GO TO 40
+ DO 30 I = 1,M
+ DDOT = DDOT + DX(I)*DY(I)
+ 30 CONTINUE
+ IF (N .LT. 5) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,5
+ DDOT = DDOT + DX(I)*DY(I) + DX(I+1)*DY(I+1) + DX(I+2)*DY(I+2) +
+ 1 DX(I+3)*DY(I+3) + DX(I+4)*DY(I+4)
+ 50 CONTINUE
+ RETURN
+C
+C Code for equal, positive, non-unit increments.
+C
+ 60 NS = N*INCX
+ DO 70 I = 1,NS,INCX
+ DDOT = DDOT + DX(I)*DY(I)
+ 70 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/dgeco.f b/Lib/Slatec/slatec/dgeco.f
new file mode 100644
index 0000000..3f56183
--- /dev/null
+++ b/Lib/Slatec/slatec/dgeco.f
@@ -0,0 +1,207 @@
+*DECK DGECO
+ SUBROUTINE DGECO (A, LDA, N, IPVT, RCOND, Z)
+C***BEGIN PROLOGUE DGECO
+C***PURPOSE Factor a matrix using Gaussian elimination and estimate
+C the condition number of the matrix.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2A1
+C***TYPE DOUBLE PRECISION (SGECO-S, DGECO-D, CGECO-C)
+C***KEYWORDS CONDITION NUMBER, GENERAL MATRIX, LINEAR ALGEBRA, LINPACK,
+C MATRIX FACTORIZATION
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C DGECO factors a double precision matrix by Gaussian elimination
+C and estimates the condition of the matrix.
+C
+C If RCOND is not needed, DGEFA is slightly faster.
+C To solve A*X = B , follow DGECO by DGESL.
+C To compute INVERSE(A)*C , follow DGECO by DGESL.
+C To compute DETERMINANT(A) , follow DGECO by DGEDI.
+C To compute INVERSE(A) , follow DGECO by DGEDI.
+C
+C On Entry
+C
+C A DOUBLE PRECISION(LDA, N)
+C the matrix to be factored.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C On Return
+C
+C A an upper triangular matrix and the multipliers
+C which were used to obtain it.
+C The factorization can be written A = L*U where
+C L is a product of permutation and unit lower
+C triangular matrices and U is upper triangular.
+C
+C IPVT INTEGER(N)
+C an INTEGER vector of pivot indices.
+C
+C RCOND DOUBLE PRECISION
+C an estimate of the reciprocal condition of A .
+C For the system A*X = B , relative perturbations
+C in A and B of size EPSILON may cause
+C relative perturbations in X of size EPSILON/RCOND .
+C If RCOND is so small that the logical expression
+C 1.0 + RCOND .EQ. 1.0
+C is true, then A may be singular to working
+C precision. In particular, RCOND is zero if
+C exact singularity is detected or the estimate
+C underflows.
+C
+C Z DOUBLE PRECISION(N)
+C a work vector whose contents are usually unimportant.
+C If A is close to a singular matrix, then Z is
+C an approximate null vector in the sense that
+C NORM(A*Z) = RCOND*NORM(A)*NORM(Z) .
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED DASUM, DAXPY, DDOT, DGEFA, DSCAL
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DGECO
+ INTEGER LDA,N,IPVT(*)
+ DOUBLE PRECISION A(LDA,*),Z(*)
+ DOUBLE PRECISION RCOND
+C
+ DOUBLE PRECISION DDOT,EK,T,WK,WKM
+ DOUBLE PRECISION ANORM,S,DASUM,SM,YNORM
+ INTEGER INFO,J,K,KB,KP1,L
+C
+C COMPUTE 1-NORM OF A
+C
+C***FIRST EXECUTABLE STATEMENT DGECO
+ ANORM = 0.0D0
+ DO 10 J = 1, N
+ ANORM = MAX(ANORM,DASUM(N,A(1,J),1))
+ 10 CONTINUE
+C
+C FACTOR
+C
+ CALL DGEFA(A,LDA,N,IPVT,INFO)
+C
+C RCOND = 1/(NORM(A)*(ESTIMATE OF NORM(INVERSE(A)))) .
+C ESTIMATE = NORM(Z)/NORM(Y) WHERE A*Z = Y AND TRANS(A)*Y = E .
+C TRANS(A) IS THE TRANSPOSE OF A . THE COMPONENTS OF E ARE
+C CHOSEN TO CAUSE MAXIMUM LOCAL GROWTH IN THE ELEMENTS OF W WHERE
+C TRANS(U)*W = E . THE VECTORS ARE FREQUENTLY RESCALED TO AVOID
+C OVERFLOW.
+C
+C SOLVE TRANS(U)*W = E
+C
+ EK = 1.0D0
+ DO 20 J = 1, N
+ Z(J) = 0.0D0
+ 20 CONTINUE
+ DO 100 K = 1, N
+ IF (Z(K) .NE. 0.0D0) EK = SIGN(EK,-Z(K))
+ IF (ABS(EK-Z(K)) .LE. ABS(A(K,K))) GO TO 30
+ S = ABS(A(K,K))/ABS(EK-Z(K))
+ CALL DSCAL(N,S,Z,1)
+ EK = S*EK
+ 30 CONTINUE
+ WK = EK - Z(K)
+ WKM = -EK - Z(K)
+ S = ABS(WK)
+ SM = ABS(WKM)
+ IF (A(K,K) .EQ. 0.0D0) GO TO 40
+ WK = WK/A(K,K)
+ WKM = WKM/A(K,K)
+ GO TO 50
+ 40 CONTINUE
+ WK = 1.0D0
+ WKM = 1.0D0
+ 50 CONTINUE
+ KP1 = K + 1
+ IF (KP1 .GT. N) GO TO 90
+ DO 60 J = KP1, N
+ SM = SM + ABS(Z(J)+WKM*A(K,J))
+ Z(J) = Z(J) + WK*A(K,J)
+ S = S + ABS(Z(J))
+ 60 CONTINUE
+ IF (S .GE. SM) GO TO 80
+ T = WKM - WK
+ WK = WKM
+ DO 70 J = KP1, N
+ Z(J) = Z(J) + T*A(K,J)
+ 70 CONTINUE
+ 80 CONTINUE
+ 90 CONTINUE
+ Z(K) = WK
+ 100 CONTINUE
+ S = 1.0D0/DASUM(N,Z,1)
+ CALL DSCAL(N,S,Z,1)
+C
+C SOLVE TRANS(L)*Y = W
+C
+ DO 120 KB = 1, N
+ K = N + 1 - KB
+ IF (K .LT. N) Z(K) = Z(K) + DDOT(N-K,A(K+1,K),1,Z(K+1),1)
+ IF (ABS(Z(K)) .LE. 1.0D0) GO TO 110
+ S = 1.0D0/ABS(Z(K))
+ CALL DSCAL(N,S,Z,1)
+ 110 CONTINUE
+ L = IPVT(K)
+ T = Z(L)
+ Z(L) = Z(K)
+ Z(K) = T
+ 120 CONTINUE
+ S = 1.0D0/DASUM(N,Z,1)
+ CALL DSCAL(N,S,Z,1)
+C
+ YNORM = 1.0D0
+C
+C SOLVE L*V = Y
+C
+ DO 140 K = 1, N
+ L = IPVT(K)
+ T = Z(L)
+ Z(L) = Z(K)
+ Z(K) = T
+ IF (K .LT. N) CALL DAXPY(N-K,T,A(K+1,K),1,Z(K+1),1)
+ IF (ABS(Z(K)) .LE. 1.0D0) GO TO 130
+ S = 1.0D0/ABS(Z(K))
+ CALL DSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+ 130 CONTINUE
+ 140 CONTINUE
+ S = 1.0D0/DASUM(N,Z,1)
+ CALL DSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+C
+C SOLVE U*Z = V
+C
+ DO 160 KB = 1, N
+ K = N + 1 - KB
+ IF (ABS(Z(K)) .LE. ABS(A(K,K))) GO TO 150
+ S = ABS(A(K,K))/ABS(Z(K))
+ CALL DSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+ 150 CONTINUE
+ IF (A(K,K) .NE. 0.0D0) Z(K) = Z(K)/A(K,K)
+ IF (A(K,K) .EQ. 0.0D0) Z(K) = 1.0D0
+ T = -Z(K)
+ CALL DAXPY(K-1,T,A(1,K),1,Z(1),1)
+ 160 CONTINUE
+C MAKE ZNORM = 1.0
+ S = 1.0D0/DASUM(N,Z,1)
+ CALL DSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+C
+ IF (ANORM .NE. 0.0D0) RCOND = YNORM/ANORM
+ IF (ANORM .EQ. 0.0D0) RCOND = 0.0D0
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/dgedi.f b/Lib/Slatec/slatec/dgedi.f
new file mode 100644
index 0000000..d91693b
--- /dev/null
+++ b/Lib/Slatec/slatec/dgedi.f
@@ -0,0 +1,141 @@
+*DECK DGEDI
+ SUBROUTINE DGEDI (A, LDA, N, IPVT, DET, WORK, JOB)
+C***BEGIN PROLOGUE DGEDI
+C***PURPOSE Compute the determinant and inverse of a matrix using the
+C factors computed by DGECO or DGEFA.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D3A1, D2A1
+C***TYPE DOUBLE PRECISION (SGEDI-S, DGEDI-D, CGEDI-C)
+C***KEYWORDS DETERMINANT, INVERSE, LINEAR ALGEBRA, LINPACK, MATRIX
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C DGEDI computes the determinant and inverse of a matrix
+C using the factors computed by DGECO or DGEFA.
+C
+C On Entry
+C
+C A DOUBLE PRECISION(LDA, N)
+C the output from DGECO or DGEFA.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C IPVT INTEGER(N)
+C the pivot vector from DGECO or DGEFA.
+C
+C WORK DOUBLE PRECISION(N)
+C work vector. Contents destroyed.
+C
+C JOB INTEGER
+C = 11 both determinant and inverse.
+C = 01 inverse only.
+C = 10 determinant only.
+C
+C On Return
+C
+C A inverse of original matrix if requested.
+C Otherwise unchanged.
+C
+C DET DOUBLE PRECISION(2)
+C determinant of original matrix if requested.
+C Otherwise not referenced.
+C Determinant = DET(1) * 10.0**DET(2)
+C with 1.0 .LE. ABS(DET(1)) .LT. 10.0
+C or DET(1) .EQ. 0.0 .
+C
+C Error Condition
+C
+C A division by zero will occur if the input factor contains
+C a zero on the diagonal and the inverse is requested.
+C It will not occur if the subroutines are called correctly
+C and if DGECO has set RCOND .GT. 0.0 or DGEFA has set
+C INFO .EQ. 0 .
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED DAXPY, DSCAL, DSWAP
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DGEDI
+ INTEGER LDA,N,IPVT(*),JOB
+ DOUBLE PRECISION A(LDA,*),DET(2),WORK(*)
+C
+ DOUBLE PRECISION T
+ DOUBLE PRECISION TEN
+ INTEGER I,J,K,KB,KP1,L,NM1
+C***FIRST EXECUTABLE STATEMENT DGEDI
+C
+C COMPUTE DETERMINANT
+C
+ IF (JOB/10 .EQ. 0) GO TO 70
+ DET(1) = 1.0D0
+ DET(2) = 0.0D0
+ TEN = 10.0D0
+ DO 50 I = 1, N
+ IF (IPVT(I) .NE. I) DET(1) = -DET(1)
+ DET(1) = A(I,I)*DET(1)
+ IF (DET(1) .EQ. 0.0D0) GO TO 60
+ 10 IF (ABS(DET(1)) .GE. 1.0D0) GO TO 20
+ DET(1) = TEN*DET(1)
+ DET(2) = DET(2) - 1.0D0
+ GO TO 10
+ 20 CONTINUE
+ 30 IF (ABS(DET(1)) .LT. TEN) GO TO 40
+ DET(1) = DET(1)/TEN
+ DET(2) = DET(2) + 1.0D0
+ GO TO 30
+ 40 CONTINUE
+ 50 CONTINUE
+ 60 CONTINUE
+ 70 CONTINUE
+C
+C COMPUTE INVERSE(U)
+C
+ IF (MOD(JOB,10) .EQ. 0) GO TO 150
+ DO 100 K = 1, N
+ A(K,K) = 1.0D0/A(K,K)
+ T = -A(K,K)
+ CALL DSCAL(K-1,T,A(1,K),1)
+ KP1 = K + 1
+ IF (N .LT. KP1) GO TO 90
+ DO 80 J = KP1, N
+ T = A(K,J)
+ A(K,J) = 0.0D0
+ CALL DAXPY(K,T,A(1,K),1,A(1,J),1)
+ 80 CONTINUE
+ 90 CONTINUE
+ 100 CONTINUE
+C
+C FORM INVERSE(U)*INVERSE(L)
+C
+ NM1 = N - 1
+ IF (NM1 .LT. 1) GO TO 140
+ DO 130 KB = 1, NM1
+ K = N - KB
+ KP1 = K + 1
+ DO 110 I = KP1, N
+ WORK(I) = A(I,K)
+ A(I,K) = 0.0D0
+ 110 CONTINUE
+ DO 120 J = KP1, N
+ T = WORK(J)
+ CALL DAXPY(N,T,A(1,J),1,A(1,K),1)
+ 120 CONTINUE
+ L = IPVT(K)
+ IF (L .NE. K) CALL DSWAP(N,A(1,K),1,A(1,L),1)
+ 130 CONTINUE
+ 140 CONTINUE
+ 150 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/dgefa.f b/Lib/Slatec/slatec/dgefa.f
new file mode 100644
index 0000000..57d9105
--- /dev/null
+++ b/Lib/Slatec/slatec/dgefa.f
@@ -0,0 +1,117 @@
+*DECK DGEFA
+ SUBROUTINE DGEFA (A, LDA, N, IPVT, INFO)
+C***BEGIN PROLOGUE DGEFA
+C***PURPOSE Factor a matrix using Gaussian elimination.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2A1
+C***TYPE DOUBLE PRECISION (SGEFA-S, DGEFA-D, CGEFA-C)
+C***KEYWORDS GENERAL MATRIX, LINEAR ALGEBRA, LINPACK,
+C MATRIX FACTORIZATION
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C DGEFA factors a double precision matrix by Gaussian elimination.
+C
+C DGEFA is usually called by DGECO, but it can be called
+C directly with a saving in time if RCOND is not needed.
+C (Time for DGECO) = (1 + 9/N)*(Time for DGEFA) .
+C
+C On Entry
+C
+C A DOUBLE PRECISION(LDA, N)
+C the matrix to be factored.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C On Return
+C
+C A an upper triangular matrix and the multipliers
+C which were used to obtain it.
+C The factorization can be written A = L*U where
+C L is a product of permutation and unit lower
+C triangular matrices and U is upper triangular.
+C
+C IPVT INTEGER(N)
+C an integer vector of pivot indices.
+C
+C INFO INTEGER
+C = 0 normal value.
+C = K if U(K,K) .EQ. 0.0 . This is not an error
+C condition for this subroutine, but it does
+C indicate that DGESL or DGEDI will divide by zero
+C if called. Use RCOND in DGECO for a reliable
+C indication of singularity.
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED DAXPY, DSCAL, IDAMAX
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DGEFA
+ INTEGER LDA,N,IPVT(*),INFO
+ DOUBLE PRECISION A(LDA,*)
+C
+ DOUBLE PRECISION T
+ INTEGER IDAMAX,J,K,KP1,L,NM1
+C
+C GAUSSIAN ELIMINATION WITH PARTIAL PIVOTING
+C
+C***FIRST EXECUTABLE STATEMENT DGEFA
+ INFO = 0
+ NM1 = N - 1
+ IF (NM1 .LT. 1) GO TO 70
+ DO 60 K = 1, NM1
+ KP1 = K + 1
+C
+C FIND L = PIVOT INDEX
+C
+ L = IDAMAX(N-K+1,A(K,K),1) + K - 1
+ IPVT(K) = L
+C
+C ZERO PIVOT IMPLIES THIS COLUMN ALREADY TRIANGULARIZED
+C
+ IF (A(L,K) .EQ. 0.0D0) GO TO 40
+C
+C INTERCHANGE IF NECESSARY
+C
+ IF (L .EQ. K) GO TO 10
+ T = A(L,K)
+ A(L,K) = A(K,K)
+ A(K,K) = T
+ 10 CONTINUE
+C
+C COMPUTE MULTIPLIERS
+C
+ T = -1.0D0/A(K,K)
+ CALL DSCAL(N-K,T,A(K+1,K),1)
+C
+C ROW ELIMINATION WITH COLUMN INDEXING
+C
+ DO 30 J = KP1, N
+ T = A(L,J)
+ IF (L .EQ. K) GO TO 20
+ A(L,J) = A(K,J)
+ A(K,J) = T
+ 20 CONTINUE
+ CALL DAXPY(N-K,T,A(K+1,K),1,A(K+1,J),1)
+ 30 CONTINUE
+ GO TO 50
+ 40 CONTINUE
+ INFO = K
+ 50 CONTINUE
+ 60 CONTINUE
+ 70 CONTINUE
+ IPVT(N) = N
+ IF (A(N,N) .EQ. 0.0D0) INFO = N
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/dgesl.f b/Lib/Slatec/slatec/dgesl.f
new file mode 100644
index 0000000..5336506
--- /dev/null
+++ b/Lib/Slatec/slatec/dgesl.f
@@ -0,0 +1,136 @@
+* ======================================================================
+* NIST Guide to Available Math Software.
+* Source for module DGESL from package SLATEC.
+* Retrieved from CAMSUN on Sat Sep 25 04:27:36 1999.
+* ======================================================================
+*DECK DGESL
+ SUBROUTINE DGESL (A, LDA, N, IPVT, B, JOB)
+C***BEGIN PROLOGUE DGESL
+C***PURPOSE Solve the real system A*X=B or TRANS(A)*X=B using the
+C factors computed by DGECO or DGEFA.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2A1
+C***TYPE DOUBLE PRECISION (SGESL-S, DGESL-D, CGESL-C)
+C***KEYWORDS LINEAR ALGEBRA, LINPACK, MATRIX, SOLVE
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C DGESL solves the double precision system
+C A * X = B or TRANS(A) * X = B
+C using the factors computed by DGECO or DGEFA.
+C
+C On Entry
+C
+C A DOUBLE PRECISION(LDA, N)
+C the output from DGECO or DGEFA.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C IPVT INTEGER(N)
+C the pivot vector from DGECO or DGEFA.
+C
+C B DOUBLE PRECISION(N)
+C the right hand side vector.
+C
+C JOB INTEGER
+C = 0 to solve A*X = B ,
+C = nonzero to solve TRANS(A)*X = B where
+C TRANS(A) is the transpose.
+C
+C On Return
+C
+C B the solution vector X .
+C
+C Error Condition
+C
+C A division by zero will occur if the input factor contains a
+C zero on the diagonal. Technically this indicates singularity
+C but it is often caused by improper arguments or improper
+C setting of LDA . It will not occur if the subroutines are
+C called correctly and if DGECO has set RCOND .GT. 0.0
+C or DGEFA has set INFO .EQ. 0 .
+C
+C To compute INVERSE(A) * C where C is a matrix
+C with P columns
+C CALL DGECO(A,LDA,N,IPVT,RCOND,Z)
+C IF (RCOND is too small) GO TO ...
+C DO 10 J = 1, P
+C CALL DGESL(A,LDA,N,IPVT,C(1,J),0)
+C 10 CONTINUE
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED DAXPY, DDOT
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DGESL
+ INTEGER LDA,N,IPVT(*),JOB
+ DOUBLE PRECISION A(LDA,*),B(*)
+C
+ DOUBLE PRECISION DDOT,T
+ INTEGER K,KB,L,NM1
+C***FIRST EXECUTABLE STATEMENT DGESL
+ NM1 = N - 1
+ IF (JOB .NE. 0) GO TO 50
+C
+C JOB = 0 , SOLVE A * X = B
+C FIRST SOLVE L*Y = B
+C
+ IF (NM1 .LT. 1) GO TO 30
+ DO 20 K = 1, NM1
+ L = IPVT(K)
+ T = B(L)
+ IF (L .EQ. K) GO TO 10
+ B(L) = B(K)
+ B(K) = T
+ 10 CONTINUE
+ CALL DAXPY(N-K,T,A(K+1,K),1,B(K+1),1)
+ 20 CONTINUE
+ 30 CONTINUE
+C
+C NOW SOLVE U*X = Y
+C
+ DO 40 KB = 1, N
+ K = N + 1 - KB
+ B(K) = B(K)/A(K,K)
+ T = -B(K)
+ CALL DAXPY(K-1,T,A(1,K),1,B(1),1)
+ 40 CONTINUE
+ GO TO 100
+ 50 CONTINUE
+C
+C JOB = NONZERO, SOLVE TRANS(A) * X = B
+C FIRST SOLVE TRANS(U)*Y = B
+C
+ DO 60 K = 1, N
+ T = DDOT(K-1,A(1,K),1,B(1),1)
+ B(K) = (B(K) - T)/A(K,K)
+ 60 CONTINUE
+C
+C NOW SOLVE TRANS(L)*X = Y
+C
+ IF (NM1 .LT. 1) GO TO 90
+ DO 80 KB = 1, NM1
+ K = N - KB
+ B(K) = B(K) + DDOT(N-K,A(K+1,K),1,B(K+1),1)
+ L = IPVT(K)
+ IF (L .EQ. K) GO TO 70
+ T = B(L)
+ B(L) = B(K)
+ B(K) = T
+ 70 CONTINUE
+ 80 CONTINUE
+ 90 CONTINUE
+ 100 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/dp1vlu.f b/Lib/Slatec/slatec/dp1vlu.f
new file mode 100644
index 0000000..1af92d2
--- /dev/null
+++ b/Lib/Slatec/slatec/dp1vlu.f
@@ -0,0 +1,151 @@
+*DECK DP1VLU
+ SUBROUTINE DP1VLU (L, NDER, X, YFIT, YP, A)
+C***BEGIN PROLOGUE DP1VLU
+C***PURPOSE Use the coefficients generated by DPOLFT to evaluate the
+C polynomial fit of degree L, along with the first NDER of
+C its derivatives, at a specified point.
+C***LIBRARY SLATEC
+C***CATEGORY K6
+C***TYPE DOUBLE PRECISION (PVALUE-S, DP1VLU-D)
+C***KEYWORDS CURVE FITTING, LEAST SQUARES, POLYNOMIAL APPROXIMATION
+C***AUTHOR Shampine, L. F., (SNLA)
+C Davenport, S. M., (SNLA)
+C***DESCRIPTION
+C
+C Abstract
+C
+C The subroutine DP1VLU uses the coefficients generated by DPOLFT
+C to evaluate the polynomial fit of degree L , along with the first
+C NDER of its derivatives, at a specified point. Computationally
+C stable recurrence relations are used to perform this task.
+C
+C The parameters for DP1VLU are
+C
+C Input -- ALL TYPE REAL variables are DOUBLE PRECISION
+C L - the degree of polynomial to be evaluated. L may be
+C any non-negative integer which is less than or equal
+C to NDEG , the highest degree polynomial provided
+C by DPOLFT .
+C NDER - the number of derivatives to be evaluated. NDER
+C may be 0 or any positive value. If NDER is less
+C than 0, it will be treated as 0.
+C X - the argument at which the polynomial and its
+C derivatives are to be evaluated.
+C A - work and output array containing values from last
+C call to DPOLFT .
+C
+C Output -- ALL TYPE REAL variables are DOUBLE PRECISION
+C YFIT - value of the fitting polynomial of degree L at X
+C YP - array containing the first through NDER derivatives
+C of the polynomial of degree L . YP must be
+C dimensioned at least NDER in the calling program.
+C
+C***REFERENCES L. F. Shampine, S. M. Davenport and R. E. Huddleston,
+C Curve fitting by polynomials in one variable, Report
+C SLA-74-0270, Sandia Laboratories, June 1974.
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 740601 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890911 Removed unnecessary intrinsics. (WRB)
+C 891006 Cosmetic changes to prologue. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900510 Convert XERRWV calls to XERMSG calls. (RWC)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DP1VLU
+ IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+ INTEGER I,IC,ILO,IN,INP1,IUP,K1,K1I,K2,K3,K3P1,K3PN,K4,K4P1,K4PN,
+ * KC,L,LM1,LP1,MAXORD,N,NDER,NDO,NDP1,NORD
+ DOUBLE PRECISION A(*),CC,DIF,VAL,X,YFIT,YP(*)
+ CHARACTER*8 XERN1, XERN2
+C***FIRST EXECUTABLE STATEMENT DP1VLU
+ IF (L .LT. 0) GO TO 12
+ NDO = MAX(NDER,0)
+ NDO = MIN(NDO,L)
+ MAXORD = A(1) + 0.5D0
+ K1 = MAXORD + 1
+ K2 = K1 + MAXORD
+ K3 = K2 + MAXORD + 2
+ NORD = A(K3) + 0.5D0
+ IF (L .GT. NORD) GO TO 11
+ K4 = K3 + L + 1
+ IF (NDER .LT. 1) GO TO 2
+ DO 1 I = 1,NDER
+ 1 YP(I) = 0.0D0
+ 2 IF (L .GE. 2) GO TO 4
+ IF (L .EQ. 1) GO TO 3
+C
+C L IS 0
+C
+ VAL = A(K2+1)
+ GO TO 10
+C
+C L IS 1
+C
+ 3 CC = A(K2+2)
+ VAL = A(K2+1) + (X-A(2))*CC
+ IF (NDER .GE. 1) YP(1) = CC
+ GO TO 10
+C
+C L IS GREATER THAN 1
+C
+ 4 NDP1 = NDO + 1
+ K3P1 = K3 + 1
+ K4P1 = K4 + 1
+ LP1 = L + 1
+ LM1 = L - 1
+ ILO = K3 + 3
+ IUP = K4 + NDP1
+ DO 5 I = ILO,IUP
+ 5 A(I) = 0.0D0
+ DIF = X - A(LP1)
+ KC = K2 + LP1
+ A(K4P1) = A(KC)
+ A(K3P1) = A(KC-1) + DIF*A(K4P1)
+ A(K3+2) = A(K4P1)
+C
+C EVALUATE RECURRENCE RELATIONS FOR FUNCTION VALUE AND DERIVATIVES
+C
+ DO 9 I = 1,LM1
+ IN = L - I
+ INP1 = IN + 1
+ K1I = K1 + INP1
+ IC = K2 + IN
+ DIF = X - A(INP1)
+ VAL = A(IC) + DIF*A(K3P1) - A(K1I)*A(K4P1)
+ IF (NDO .LE. 0) GO TO 8
+ DO 6 N = 1,NDO
+ K3PN = K3P1 + N
+ K4PN = K4P1 + N
+ 6 YP(N) = DIF*A(K3PN) + N*A(K3PN-1) - A(K1I)*A(K4PN)
+C
+C SAVE VALUES NEEDED FOR NEXT EVALUATION OF RECURRENCE RELATIONS
+C
+ DO 7 N = 1,NDO
+ K3PN = K3P1 + N
+ K4PN = K4P1 + N
+ A(K4PN) = A(K3PN)
+ 7 A(K3PN) = YP(N)
+ 8 A(K4P1) = A(K3P1)
+ 9 A(K3P1) = VAL
+C
+C NORMAL RETURN OR ABORT DUE TO ERROR
+C
+ 10 YFIT = VAL
+ RETURN
+C
+ 11 WRITE (XERN1, '(I8)') L
+ WRITE (XERN2, '(I8)') NORD
+ CALL XERMSG ('SLATEC', 'DP1VLU',
+ * 'THE ORDER OF POLYNOMIAL EVALUATION, L = ' // XERN1 //
+ * ' REQUESTED EXCEEDS THE HIGHEST ORDER FIT, NORD = ' // XERN2 //
+ * ', COMPUTED BY DPOLFT -- EXECUTION TERMINATED.', 8, 2)
+ RETURN
+C
+ 12 CALL XERMSG ('SLATEC', 'DP1VLU',
+ + 'INVALID INPUT PARAMETER. ORDER OF POLYNOMIAL EVALUATION ' //
+ + 'REQUESTED IS NEGATIVE.', 2, 2)
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/dpchbs.f b/Lib/Slatec/slatec/dpchbs.f
new file mode 100644
index 0000000..4313392
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchbs.f
@@ -0,0 +1,217 @@
+*DECK DPCHBS
+ SUBROUTINE DPCHBS (N, X, F, D, INCFD, KNOTYP, NKNOTS, T, BCOEF,
+ + NDIM, KORD, IERR)
+C***BEGIN PROLOGUE DPCHBS
+C***PURPOSE Piecewise Cubic Hermite to B-Spline converter.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3
+C***TYPE DOUBLE PRECISION (PCHBS-S, DPCHBS-D)
+C***KEYWORDS B-SPLINES, CONVERSION, CUBIC HERMITE INTERPOLATION,
+C PIECEWISE CUBIC INTERPOLATION
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Computing and Mathematics Research Division
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C *Usage:
+C
+C INTEGER N, INCFD, KNOTYP, NKNOTS, NDIM, KORD, IERR
+C PARAMETER (INCFD = ...)
+C DOUBLE PRECISION X(nmax), F(INCFD,nmax), D(INCFD,nmax),
+C * T(2*nmax+4), BCOEF(2*nmax)
+C
+C CALL DPCHBS (N, X, F, D, INCFD, KNOTYP, NKNOTS, T, BCOEF,
+C * NDIM, KORD, IERR)
+C
+C *Arguments:
+C
+C N:IN is the number of data points, N.ge.2 . (not checked)
+C
+C X:IN is the real array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N. (not checked)
+C nmax, the dimension of X, must be .ge.N.
+C
+C F:IN is the real array of dependent variable values.
+C F(1+(I-1)*INCFD) is the value corresponding to X(I).
+C nmax, the second dimension of F, must be .ge.N.
+C
+C D:IN is the real array of derivative values at the data points.
+C D(1+(I-1)*INCFD) is the value corresponding to X(I).
+C nmax, the second dimension of D, must be .ge.N.
+C
+C INCFD:IN is the increment between successive values in F and D.
+C This argument is provided primarily for 2-D applications.
+C It may have the value 1 for one-dimensional applications,
+C in which case F and D may be singly-subscripted arrays.
+C
+C KNOTYP:IN is a flag to control the knot sequence.
+C The knot sequence T is normally computed from X by putting
+C a double knot at each X and setting the end knot pairs
+C according to the value of KNOTYP:
+C KNOTYP = 0: Quadruple knots at X(1) and X(N). (default)
+C KNOTYP = 1: Replicate lengths of extreme subintervals:
+C T( 1 ) = T( 2 ) = X(1) - (X(2)-X(1)) ;
+C T(M+4) = T(M+3) = X(N) + (X(N)-X(N-1)).
+C KNOTYP = 2: Periodic placement of boundary knots:
+C T( 1 ) = T( 2 ) = X(1) - (X(N)-X(N-1));
+C T(M+4) = T(M+3) = X(N) + (X(2)-X(1)) .
+C Here M=NDIM=2*N.
+C If the input value of KNOTYP is negative, however, it is
+C assumed that NKNOTS and T were set in a previous call.
+C This option is provided for improved efficiency when used
+C in a parametric setting.
+C
+C NKNOTS:INOUT is the number of knots.
+C If KNOTYP.GE.0, then NKNOTS will be set to NDIM+4.
+C If KNOTYP.LT.0, then NKNOTS is an input variable, and an
+C error return will be taken if it is not equal to NDIM+4.
+C
+C T:INOUT is the array of 2*N+4 knots for the B-representation.
+C If KNOTYP.GE.0, T will be returned by DPCHBS with the
+C interior double knots equal to the X-values and the
+C boundary knots set as indicated above.
+C If KNOTYP.LT.0, it is assumed that T was set by a
+C previous call to DPCHBS. (This routine does **not**
+C verify that T forms a legitimate knot sequence.)
+C
+C BCOEF:OUT is the array of 2*N B-spline coefficients.
+C
+C NDIM:OUT is the dimension of the B-spline space. (Set to 2*N.)
+C
+C KORD:OUT is the order of the B-spline. (Set to 4.)
+C
+C IERR:OUT is an error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C "Recoverable" errors:
+C IERR = -4 if KNOTYP.GT.2 .
+C IERR = -5 if KNOTYP.LT.0 and NKNOTS.NE.(2*N+4).
+C
+C *Description:
+C DPCHBS computes the B-spline representation of the PCH function
+C determined by N,X,F,D. To be compatible with the rest of PCHIP,
+C DPCHBS includes INCFD, the increment between successive values of
+C the F- and D-arrays.
+C
+C The output is the B-representation for the function: NKNOTS, T,
+C BCOEF, NDIM, KORD.
+C
+C *Caution:
+C Since it is assumed that the input PCH function has been
+C computed by one of the other routines in the package PCHIP,
+C input arguments N, X, INCFD are **not** checked for validity.
+C
+C *Restrictions/assumptions:
+C 1. N.GE.2 . (not checked)
+C 2. X(i).LT.X(i+1), i=1,...,N . (not checked)
+C 3. INCFD.GT.0 . (not checked)
+C 4. KNOTYP.LE.2 . (error return if not)
+C *5. NKNOTS = NDIM+4 = 2*N+4 . (error return if not)
+C *6. T(2*k+1) = T(2*k) = X(k), k=1,...,N . (not checked)
+C
+C * Indicates this applies only if KNOTYP.LT.0 .
+C
+C *Portability:
+C Argument INCFD is used only to cause the compiler to generate
+C efficient code for the subscript expressions (1+(I-1)*INCFD) .
+C The normal usage, in which DPCHBS is called with one-dimensional
+C arrays F and D, is probably non-Fortran 77, in the strict sense,
+C but it works on all systems on which DPCHBS has been tested.
+C
+C *See Also:
+C PCHIC, PCHIM, or PCHSP can be used to determine an interpolating
+C PCH function from a set of data.
+C The B-spline routine DBVALU can be used to evaluate the
+C B-representation that is output by DPCHBS.
+C (See BSPDOC for more information.)
+C
+C***REFERENCES F. N. Fritsch, "Representations for parametric cubic
+C splines," Computer Aided Geometric Design 6 (1989),
+C pp.79-82.
+C***ROUTINES CALLED DPCHKT, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 870701 DATE WRITTEN
+C 900405 Converted Fortran to upper case.
+C 900405 Removed requirement that X be dimensioned N+1.
+C 900406 Modified to make PCHKT a subsidiary routine to simplify
+C usage. In the process, added argument INCFD to be com-
+C patible with the rest of PCHIP.
+C 900410 Converted prologue to SLATEC 4.0 format.
+C 900410 Added calls to XERMSG and changed constant 3. to 3 to
+C reduce single/double differences.
+C 900411 Added reference.
+C 900430 Produced double precision version.
+C 900501 Corrected declarations.
+C 930317 Minor cosmetic changes. (FNF)
+C 930514 Corrected problems with dimensioning of arguments and
+C clarified DESCRIPTION. (FNF)
+C 930604 Removed NKNOTS from DPCHKT call list. (FNF)
+C***END PROLOGUE DPCHBS
+C
+C*Internal Notes:
+C
+C**End
+C
+C Declare arguments.
+C
+ INTEGER N, INCFD, KNOTYP, NKNOTS, NDIM, KORD, IERR
+ DOUBLE PRECISION X(*), F(INCFD,*), D(INCFD,*), T(*), BCOEF(*)
+C
+C Declare local variables.
+C
+ INTEGER K, KK
+ DOUBLE PRECISION DOV3, HNEW, HOLD
+ CHARACTER*8 LIBNAM, SUBNAM
+C***FIRST EXECUTABLE STATEMENT DPCHBS
+C
+C Initialize.
+C
+ NDIM = 2*N
+ KORD = 4
+ IERR = 0
+ LIBNAM = 'SLATEC'
+ SUBNAM = 'DPCHBS'
+C
+C Check argument validity. Set up knot sequence if OK.
+C
+ IF ( KNOTYP.GT.2 ) THEN
+ IERR = -1
+ CALL XERMSG (LIBNAM, SUBNAM, 'KNOTYP GREATER THAN 2', IERR, 1)
+ RETURN
+ ENDIF
+ IF ( KNOTYP.LT.0 ) THEN
+ IF ( NKNOTS.NE.NDIM+4 ) THEN
+ IERR = -2
+ CALL XERMSG (LIBNAM, SUBNAM,
+ * 'KNOTYP.LT.0 AND NKNOTS.NE.(2*N+4)', IERR, 1)
+ RETURN
+ ENDIF
+ ELSE
+C Set up knot sequence.
+ NKNOTS = NDIM + 4
+ CALL DPCHKT (N, X, KNOTYP, T)
+ ENDIF
+C
+C Compute B-spline coefficients.
+C
+ HNEW = T(3) - T(1)
+ DO 40 K = 1, N
+ KK = 2*K
+ HOLD = HNEW
+C The following requires mixed mode arithmetic.
+ DOV3 = D(1,K)/3
+ BCOEF(KK-1) = F(1,K) - HOLD*DOV3
+C The following assumes T(2*K+1) = X(K).
+ HNEW = T(KK+3) - T(KK+1)
+ BCOEF(KK) = F(1,K) + HNEW*DOV3
+ 40 CONTINUE
+C
+C Terminate.
+C
+ RETURN
+C------------- LAST LINE OF DPCHBS FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchce.f b/Lib/Slatec/slatec/dpchce.f
new file mode 100644
index 0000000..3f55f94
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchce.f
@@ -0,0 +1,247 @@
+*DECK DPCHCE
+ SUBROUTINE DPCHCE (IC, VC, N, X, H, SLOPE, D, INCFD, IERR)
+C***BEGIN PROLOGUE DPCHCE
+C***SUBSIDIARY
+C***PURPOSE Set boundary conditions for DPCHIC
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE DOUBLE PRECISION (PCHCE-S, DPCHCE-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C DPCHCE: DPCHIC End Derivative Setter.
+C
+C Called by DPCHIC to set end derivatives as requested by the user.
+C It must be called after interior derivative values have been set.
+C -----
+C
+C To facilitate two-dimensional applications, includes an increment
+C between successive values of the D-array.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER IC(2), N, IERR
+C DOUBLE PRECISION VC(2), X(N), H(N), SLOPE(N), D(INCFD,N)
+C
+C CALL DPCHCE (IC, VC, N, X, H, SLOPE, D, INCFD, IERR)
+C
+C Parameters:
+C
+C IC -- (input) integer array of length 2 specifying desired
+C boundary conditions:
+C IC(1) = IBEG, desired condition at beginning of data.
+C IC(2) = IEND, desired condition at end of data.
+C ( see prologue to DPCHIC for details. )
+C
+C VC -- (input) real*8 array of length 2 specifying desired boundary
+C values. VC(1) need be set only if IC(1) = 2 or 3 .
+C VC(2) need be set only if IC(2) = 2 or 3 .
+C
+C N -- (input) number of data points. (assumes N.GE.2)
+C
+C X -- (input) real*8 array of independent variable values. (the
+C elements of X are assumed to be strictly increasing.)
+C
+C H -- (input) real*8 array of interval lengths.
+C SLOPE -- (input) real*8 array of data slopes.
+C If the data are (X(I),Y(I)), I=1(1)N, then these inputs are:
+C H(I) = X(I+1)-X(I),
+C SLOPE(I) = (Y(I+1)-Y(I))/H(I), I=1(1)N-1.
+C
+C D -- (input) real*8 array of derivative values at the data points.
+C The value corresponding to X(I) must be stored in
+C D(1+(I-1)*INCFD), I=1(1)N.
+C (output) the value of D at X(1) and/or X(N) is changed, if
+C necessary, to produce the requested boundary conditions.
+C no other entries in D are changed.
+C
+C INCFD -- (input) increment between successive values in D.
+C This argument is provided primarily for 2-D applications.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C Warning errors:
+C IERR = 1 if IBEG.LT.0 and D(1) had to be adjusted for
+C monotonicity.
+C IERR = 2 if IEND.LT.0 and D(1+(N-1)*INCFD) had to be
+C adjusted for monotonicity.
+C IERR = 3 if both of the above are true.
+C
+C -------
+C WARNING: This routine does no validity-checking of arguments.
+C -------
+C
+C Fortran intrinsics used: ABS.
+C
+C***SEE ALSO DPCHIC
+C***ROUTINES CALLED DPCHDF, DPCHST, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820218 DATE WRITTEN
+C 820805 Converted to SLATEC library version.
+C 870707 Corrected XERROR calls for d.p. name(s).
+C 890206 Corrected XERROR calls.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR section in prologue. (WRB)
+C 930503 Improved purpose. (FNF)
+C***END PROLOGUE DPCHCE
+C
+C Programming notes:
+C 1. The function DPCHST(ARG1,ARG2) is assumed to return zero if
+C either argument is zero, +1 if they are of the same sign, and
+C -1 if they are of opposite sign.
+C 2. One could reduce the number of arguments and amount of local
+C storage, at the expense of reduced code clarity, by passing in
+C the array WK (rather than splitting it into H and SLOPE) and
+C increasing its length enough to incorporate STEMP and XTEMP.
+C 3. The two monotonicity checks only use the sufficient conditions.
+C Thus, it is possible (but unlikely) for a boundary condition to
+C be changed, even though the original interpolant was monotonic.
+C (At least the result is a continuous function of the data.)
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER IC(2), N, INCFD, IERR
+ DOUBLE PRECISION VC(2), X(*), H(*), SLOPE(*), D(INCFD,*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER IBEG, IEND, IERF, INDEX, J, K
+ DOUBLE PRECISION HALF, STEMP(3), THREE, TWO, XTEMP(4), ZERO
+ SAVE ZERO, HALF, TWO, THREE
+ DOUBLE PRECISION DPCHDF, DPCHST
+C
+C INITIALIZE.
+C
+ DATA ZERO /0.D0/, HALF/.5D0/, TWO/2.D0/, THREE/3.D0/
+C
+C***FIRST EXECUTABLE STATEMENT DPCHCE
+ IBEG = IC(1)
+ IEND = IC(2)
+ IERR = 0
+C
+C SET TO DEFAULT BOUNDARY CONDITIONS IF N IS TOO SMALL.
+C
+ IF ( ABS(IBEG).GT.N ) IBEG = 0
+ IF ( ABS(IEND).GT.N ) IEND = 0
+C
+C TREAT BEGINNING BOUNDARY CONDITION.
+C
+ IF (IBEG .EQ. 0) GO TO 2000
+ K = ABS(IBEG)
+ IF (K .EQ. 1) THEN
+C BOUNDARY VALUE PROVIDED.
+ D(1,1) = VC(1)
+ ELSE IF (K .EQ. 2) THEN
+C BOUNDARY SECOND DERIVATIVE PROVIDED.
+ D(1,1) = HALF*( (THREE*SLOPE(1) - D(1,2)) - HALF*VC(1)*H(1) )
+ ELSE IF (K .LT. 5) THEN
+C USE K-POINT DERIVATIVE FORMULA.
+C PICK UP FIRST K POINTS, IN REVERSE ORDER.
+ DO 10 J = 1, K
+ INDEX = K-J+1
+C INDEX RUNS FROM K DOWN TO 1.
+ XTEMP(J) = X(INDEX)
+ IF (J .LT. K) STEMP(J) = SLOPE(INDEX-1)
+ 10 CONTINUE
+C -----------------------------
+ D(1,1) = DPCHDF (K, XTEMP, STEMP, IERF)
+C -----------------------------
+ IF (IERF .NE. 0) GO TO 5001
+ ELSE
+C USE 'NOT A KNOT' CONDITION.
+ D(1,1) = ( THREE*(H(1)*SLOPE(2) + H(2)*SLOPE(1))
+ * - TWO*(H(1)+H(2))*D(1,2) - H(1)*D(1,3) ) / H(2)
+ ENDIF
+C
+ IF (IBEG .GT. 0) GO TO 2000
+C
+C CHECK D(1,1) FOR COMPATIBILITY WITH MONOTONICITY.
+C
+ IF (SLOPE(1) .EQ. ZERO) THEN
+ IF (D(1,1) .NE. ZERO) THEN
+ D(1,1) = ZERO
+ IERR = IERR + 1
+ ENDIF
+ ELSE IF ( DPCHST(D(1,1),SLOPE(1)) .LT. ZERO) THEN
+ D(1,1) = ZERO
+ IERR = IERR + 1
+ ELSE IF ( ABS(D(1,1)) .GT. THREE*ABS(SLOPE(1)) ) THEN
+ D(1,1) = THREE*SLOPE(1)
+ IERR = IERR + 1
+ ENDIF
+C
+C TREAT END BOUNDARY CONDITION.
+C
+ 2000 CONTINUE
+ IF (IEND .EQ. 0) GO TO 5000
+ K = ABS(IEND)
+ IF (K .EQ. 1) THEN
+C BOUNDARY VALUE PROVIDED.
+ D(1,N) = VC(2)
+ ELSE IF (K .EQ. 2) THEN
+C BOUNDARY SECOND DERIVATIVE PROVIDED.
+ D(1,N) = HALF*( (THREE*SLOPE(N-1) - D(1,N-1)) +
+ * HALF*VC(2)*H(N-1) )
+ ELSE IF (K .LT. 5) THEN
+C USE K-POINT DERIVATIVE FORMULA.
+C PICK UP LAST K POINTS.
+ DO 2010 J = 1, K
+ INDEX = N-K+J
+C INDEX RUNS FROM N+1-K UP TO N.
+ XTEMP(J) = X(INDEX)
+ IF (J .LT. K) STEMP(J) = SLOPE(INDEX)
+ 2010 CONTINUE
+C -----------------------------
+ D(1,N) = DPCHDF (K, XTEMP, STEMP, IERF)
+C -----------------------------
+ IF (IERF .NE. 0) GO TO 5001
+ ELSE
+C USE 'NOT A KNOT' CONDITION.
+ D(1,N) = ( THREE*(H(N-1)*SLOPE(N-2) + H(N-2)*SLOPE(N-1))
+ * - TWO*(H(N-1)+H(N-2))*D(1,N-1) - H(N-1)*D(1,N-2) )
+ * / H(N-2)
+ ENDIF
+C
+ IF (IEND .GT. 0) GO TO 5000
+C
+C CHECK D(1,N) FOR COMPATIBILITY WITH MONOTONICITY.
+C
+ IF (SLOPE(N-1) .EQ. ZERO) THEN
+ IF (D(1,N) .NE. ZERO) THEN
+ D(1,N) = ZERO
+ IERR = IERR + 2
+ ENDIF
+ ELSE IF ( DPCHST(D(1,N),SLOPE(N-1)) .LT. ZERO) THEN
+ D(1,N) = ZERO
+ IERR = IERR + 2
+ ELSE IF ( ABS(D(1,N)) .GT. THREE*ABS(SLOPE(N-1)) ) THEN
+ D(1,N) = THREE*SLOPE(N-1)
+ IERR = IERR + 2
+ ENDIF
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ RETURN
+C
+C ERROR RETURN.
+C
+ 5001 CONTINUE
+C ERROR RETURN FROM DPCHDF.
+C *** THIS CASE SHOULD NEVER OCCUR ***
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DPCHCE', 'ERROR RETURN FROM DPCHDF',
+ + IERR, 1)
+ RETURN
+C------------- LAST LINE OF DPCHCE FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchci.f b/Lib/Slatec/slatec/dpchci.f
new file mode 100644
index 0000000..fcf03c4
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchci.f
@@ -0,0 +1,185 @@
+*DECK DPCHCI
+ SUBROUTINE DPCHCI (N, H, SLOPE, D, INCFD)
+C***BEGIN PROLOGUE DPCHCI
+C***SUBSIDIARY
+C***PURPOSE Set interior derivatives for DPCHIC
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE DOUBLE PRECISION (PCHCI-S, DPCHCI-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C DPCHCI: DPCHIC Initial Derivative Setter.
+C
+C Called by DPCHIC to set derivatives needed to determine a monotone
+C piecewise cubic Hermite interpolant to the data.
+C
+C Default boundary conditions are provided which are compatible
+C with monotonicity. If the data are only piecewise monotonic, the
+C interpolant will have an extremum at each point where monotonicity
+C switches direction.
+C
+C To facilitate two-dimensional applications, includes an increment
+C between successive values of the D-array.
+C
+C The resulting piecewise cubic Hermite function should be identical
+C (within roundoff error) to that produced by DPCHIM.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N
+C DOUBLE PRECISION H(N), SLOPE(N), D(INCFD,N)
+C
+C CALL DPCHCI (N, H, SLOPE, D, INCFD)
+C
+C Parameters:
+C
+C N -- (input) number of data points.
+C If N=2, simply does linear interpolation.
+C
+C H -- (input) real*8 array of interval lengths.
+C SLOPE -- (input) real*8 array of data slopes.
+C If the data are (X(I),Y(I)), I=1(1)N, then these inputs are:
+C H(I) = X(I+1)-X(I),
+C SLOPE(I) = (Y(I+1)-Y(I))/H(I), I=1(1)N-1.
+C
+C D -- (output) real*8 array of derivative values at data points.
+C If the data are monotonic, these values will determine a
+C a monotone cubic Hermite function.
+C The value corresponding to X(I) is stored in
+C D(1+(I-1)*INCFD), I=1(1)N.
+C No other entries in D are changed.
+C
+C INCFD -- (input) increment between successive values in D.
+C This argument is provided primarily for 2-D applications.
+C
+C -------
+C WARNING: This routine does no validity-checking of arguments.
+C -------
+C
+C Fortran intrinsics used: ABS, MAX, MIN.
+C
+C***SEE ALSO DPCHIC
+C***ROUTINES CALLED DPCHST
+C***REVISION HISTORY (YYMMDD)
+C 820218 DATE WRITTEN
+C 820601 Modified end conditions to be continuous functions of
+C data when monotonicity switches in next interval.
+C 820602 1. Modified formulas so end conditions are less prone
+C to over/underflow problems.
+C 2. Minor modification to HSUM calculation.
+C 820805 Converted to SLATEC library version.
+C 870813 Minor cosmetic changes.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR section in prologue. (WRB)
+C 930503 Improved purpose. (FNF)
+C***END PROLOGUE DPCHCI
+C
+C Programming notes:
+C 1. The function DPCHST(ARG1,ARG2) is assumed to return zero if
+C either argument is zero, +1 if they are of the same sign, and
+C -1 if they are of opposite sign.
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD
+ DOUBLE PRECISION H(*), SLOPE(*), D(INCFD,*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, NLESS1
+ DOUBLE PRECISION DEL1, DEL2, DMAX, DMIN, DRAT1, DRAT2, HSUM,
+ * HSUMT3, THREE, W1, W2, ZERO
+ SAVE ZERO, THREE
+ DOUBLE PRECISION DPCHST
+C
+C INITIALIZE.
+C
+ DATA ZERO /0.D0/, THREE/3.D0/
+C***FIRST EXECUTABLE STATEMENT DPCHCI
+ NLESS1 = N - 1
+ DEL1 = SLOPE(1)
+C
+C SPECIAL CASE N=2 -- USE LINEAR INTERPOLATION.
+C
+ IF (NLESS1 .GT. 1) GO TO 10
+ D(1,1) = DEL1
+ D(1,N) = DEL1
+ GO TO 5000
+C
+C NORMAL CASE (N .GE. 3).
+C
+ 10 CONTINUE
+ DEL2 = SLOPE(2)
+C
+C SET D(1) VIA NON-CENTERED THREE-POINT FORMULA, ADJUSTED TO BE
+C SHAPE-PRESERVING.
+C
+ HSUM = H(1) + H(2)
+ W1 = (H(1) + HSUM)/HSUM
+ W2 = -H(1)/HSUM
+ D(1,1) = W1*DEL1 + W2*DEL2
+ IF ( DPCHST(D(1,1),DEL1) .LE. ZERO) THEN
+ D(1,1) = ZERO
+ ELSE IF ( DPCHST(DEL1,DEL2) .LT. ZERO) THEN
+C NEED DO THIS CHECK ONLY IF MONOTONICITY SWITCHES.
+ DMAX = THREE*DEL1
+ IF (ABS(D(1,1)) .GT. ABS(DMAX)) D(1,1) = DMAX
+ ENDIF
+C
+C LOOP THROUGH INTERIOR POINTS.
+C
+ DO 50 I = 2, NLESS1
+ IF (I .EQ. 2) GO TO 40
+C
+ HSUM = H(I-1) + H(I)
+ DEL1 = DEL2
+ DEL2 = SLOPE(I)
+ 40 CONTINUE
+C
+C SET D(I)=0 UNLESS DATA ARE STRICTLY MONOTONIC.
+C
+ D(1,I) = ZERO
+ IF ( DPCHST(DEL1,DEL2) .LE. ZERO) GO TO 50
+C
+C USE BRODLIE MODIFICATION OF BUTLAND FORMULA.
+C
+ HSUMT3 = HSUM+HSUM+HSUM
+ W1 = (HSUM + H(I-1))/HSUMT3
+ W2 = (HSUM + H(I) )/HSUMT3
+ DMAX = MAX( ABS(DEL1), ABS(DEL2) )
+ DMIN = MIN( ABS(DEL1), ABS(DEL2) )
+ DRAT1 = DEL1/DMAX
+ DRAT2 = DEL2/DMAX
+ D(1,I) = DMIN/(W1*DRAT1 + W2*DRAT2)
+C
+ 50 CONTINUE
+C
+C SET D(N) VIA NON-CENTERED THREE-POINT FORMULA, ADJUSTED TO BE
+C SHAPE-PRESERVING.
+C
+ W1 = -H(N-1)/HSUM
+ W2 = (H(N-1) + HSUM)/HSUM
+ D(1,N) = W1*DEL1 + W2*DEL2
+ IF ( DPCHST(D(1,N),DEL2) .LE. ZERO) THEN
+ D(1,N) = ZERO
+ ELSE IF ( DPCHST(DEL1,DEL2) .LT. ZERO) THEN
+C NEED DO THIS CHECK ONLY IF MONOTONICITY SWITCHES.
+ DMAX = THREE*DEL2
+ IF (ABS(D(1,N)) .GT. ABS(DMAX)) D(1,N) = DMAX
+ ENDIF
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ RETURN
+C------------- LAST LINE OF DPCHCI FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchcm.f b/Lib/Slatec/slatec/dpchcm.f
new file mode 100644
index 0000000..1dbcbcb
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchcm.f
@@ -0,0 +1,237 @@
+*DECK DPCHCM
+ SUBROUTINE DPCHCM (N, X, F, D, INCFD, SKIP, ISMON, IERR)
+C***BEGIN PROLOGUE DPCHCM
+C***PURPOSE Check a cubic Hermite function for monotonicity.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3
+C***TYPE DOUBLE PRECISION (PCHCM-S, DPCHCM-D)
+C***KEYWORDS CUBIC HERMITE INTERPOLATION, MONOTONE INTERPOLATION,
+C PCHIP, PIECEWISE CUBIC INTERPOLATION, UTILITY ROUTINE
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Computing & Mathematics Research Division
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C *Usage:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, ISMON(N), IERR
+C DOUBLE PRECISION X(N), F(INCFD,N), D(INCFD,N)
+C LOGICAL SKIP
+C
+C CALL DPCHCM (N, X, F, D, INCFD, SKIP, ISMON, IERR)
+C
+C *Arguments:
+C
+C N:IN is the number of data points. (Error return if N.LT.2 .)
+C
+C X:IN is a real*8 array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F:IN is a real*8 array of function values. F(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C D:IN is a real*8 array of derivative values. D(1+(I-1)*INCFD) is
+C is the value corresponding to X(I).
+C
+C INCFD:IN is the increment between successive values in F and D.
+C (Error return if INCFD.LT.1 .)
+C
+C SKIP:INOUT is a logical variable which should be set to
+C .TRUE. if the user wishes to skip checks for validity of
+C preceding parameters, or to .FALSE. otherwise.
+C This will save time in case these checks have already
+C been performed.
+C SKIP will be set to .TRUE. on normal return.
+C
+C ISMON:OUT is an integer array indicating on which intervals the
+C PCH function defined by N, X, F, D is monotonic.
+C For data interval [X(I),X(I+1)],
+C ISMON(I) = -3 if function is probably decreasing;
+C ISMON(I) = -1 if function is strictly decreasing;
+C ISMON(I) = 0 if function is constant;
+C ISMON(I) = 1 if function is strictly increasing;
+C ISMON(I) = 2 if function is non-monotonic;
+C ISMON(I) = 3 if function is probably increasing.
+C If ABS(ISMON)=3, this means that the D-values are near
+C the boundary of the monotonicity region. A small
+C increase produces non-monotonicity; decrease, strict
+C monotonicity.
+C The above applies to I=1(1)N-1. ISMON(N) indicates whether
+C the entire function is monotonic on [X(1),X(N)].
+C
+C IERR:OUT is an error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C (The ISMON-array has not been changed in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C
+C *Description:
+C
+C DPCHCM: Piecewise Cubic Hermite -- Check Monotonicity.
+C
+C Checks the piecewise cubic Hermite function defined by N,X,F,D
+C for monotonicity.
+C
+C To provide compatibility with DPCHIM and DPCHIC, includes an
+C increment between successive values of the F- and D-arrays.
+C
+C *Cautions:
+C This provides the same capability as old DPCHMC, except that a
+C new output value, -3, was added February 1989. (Formerly, -3
+C and +3 were lumped together in the single value 3.) Codes that
+C flag nonmonotonicity by "IF (ISMON.EQ.2)" need not be changed.
+C Codes that check via "IF (ISMON.GE.3)" should change the test to
+C "IF (IABS(ISMON).GE.3)". Codes that declare monotonicity via
+C "IF (ISMON.LE.1)" should change to "IF (IABS(ISMON).LE.1)".
+C
+C***REFERENCES F. N. Fritsch and R. E. Carlson, Monotone piecewise
+C cubic interpolation, SIAM Journal on Numerical Ana-
+C lysis 17, 2 (April 1980), pp. 238-246.
+C***ROUTINES CALLED DCHFCM, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820518 DATE WRITTEN
+C 820804 Converted to SLATEC library version.
+C 831201 Reversed order of subscripts of F and D, so that the
+C routine will work properly when INCFD.GT.1 . (Bug!)
+C 870707 Corrected XERROR calls for d.p. name(s).
+C 890206 Corrected XERROR calls.
+C 890209 Added possible ISMON value of -3 and modified code so
+C that 1,3,-1 produces ISMON(N)=2, rather than 3.
+C 890306 Added caution about changed output.
+C 890407 Changed name from DPCHMC to DPCHCM, as requested at the
+C March 1989 SLATEC CML meeting, and made a few other
+C minor modifications necessitated by this change.
+C 890407 Converted to new SLATEC format.
+C 890407 Modified DESCRIPTION to LDOC format.
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 920429 Revised format and order of references. (WRB,FNF)
+C***END PROLOGUE DPCHCM
+C
+C Fortran intrinsics used: ISIGN.
+C Other routines used: CHFCM, XERMSG.
+C
+C ----------------------------------------------------------------------
+C
+C Programming notes:
+C
+C An alternate organization would have separate loops for computing
+C ISMON(i), i=1,...,NSEG, and for the computation of ISMON(N). The
+C first loop can be readily parallelized, since the NSEG calls to
+C CHFCM are independent. The second loop can be cut short if
+C ISMON(N) is ever equal to 2, for it cannot be changed further.
+C
+C To produce a single precision version, simply:
+C a. Change DPCHCM to PCHCM wherever it occurs,
+C b. Change DCHFCM to CHFCM wherever it occurs, and
+C c. Change the double precision declarations to real.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, ISMON(N), IERR
+ DOUBLE PRECISION X(N), F(INCFD,N), D(INCFD,N)
+ LOGICAL SKIP
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, NSEG
+ DOUBLE PRECISION DELTA
+ INTEGER DCHFCM
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT DPCHCM
+ IF (SKIP) GO TO 5
+C
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+ SKIP = .TRUE.
+C
+C FUNCTION DEFINITION IS OK -- GO ON.
+C
+ 5 CONTINUE
+ NSEG = N - 1
+ DO 90 I = 1, NSEG
+ DELTA = (F(1,I+1)-F(1,I))/(X(I+1)-X(I))
+C -------------------------------
+ ISMON(I) = DCHFCM (D(1,I), D(1,I+1), DELTA)
+C -------------------------------
+ IF (I .EQ. 1) THEN
+ ISMON(N) = ISMON(1)
+ ELSE
+C Need to figure out cumulative monotonicity from following
+C "multiplication table":
+C
+C + I S M O N (I)
+C + -3 -1 0 1 3 2
+C +------------------------+
+C I -3 I -3 -3 -3 2 2 2 I
+C S -1 I -3 -1 -1 2 2 2 I
+C M 0 I -3 -1 0 1 3 2 I
+C O 1 I 2 2 1 1 3 2 I
+C N 3 I 2 2 3 3 3 2 I
+C (N) 2 I 2 2 2 2 2 2 I
+C +------------------------+
+C Note that the 2 row and column are out of order so as not
+C to obscure the symmetry in the rest of the table.
+C
+C No change needed if equal or constant on this interval or
+C already declared nonmonotonic.
+ IF ( (ISMON(I).NE.ISMON(N)) .AND. (ISMON(I).NE.0)
+ . .AND. (ISMON(N).NE.2) ) THEN
+ IF ( (ISMON(I).EQ.2) .OR. (ISMON(N).EQ.0) ) THEN
+ ISMON(N) = ISMON(I)
+ ELSE IF (ISMON(I)*ISMON(N) .LT. 0) THEN
+C This interval has opposite sense from curve so far.
+ ISMON(N) = 2
+ ELSE
+C At this point, both are nonzero with same sign, and
+C we have already eliminated case both +-1.
+ ISMON(N) = ISIGN (3, ISMON(N))
+ ENDIF
+ ENDIF
+ ENDIF
+ 90 CONTINUE
+C
+C NORMAL RETURN.
+C
+ IERR = 0
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DPCHCM',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'DPCHCM', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ RETURN
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'DPCHCM',
+ + 'X-ARRAY NOT STRICTLY INCREASING', IERR, 1)
+ RETURN
+C------------- LAST LINE OF DPCHCM FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchcs.f b/Lib/Slatec/slatec/dpchcs.f
new file mode 100644
index 0000000..5375e2b
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchcs.f
@@ -0,0 +1,237 @@
+*DECK DPCHCS
+ SUBROUTINE DPCHCS (SWITCH, N, H, SLOPE, D, INCFD, IERR)
+C***BEGIN PROLOGUE DPCHCS
+C***SUBSIDIARY
+C***PURPOSE Adjusts derivative values for DPCHIC
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE DOUBLE PRECISION (PCHCS-S, DPCHCS-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C DPCHCS: DPCHIC Monotonicity Switch Derivative Setter.
+C
+C Called by DPCHIC to adjust the values of D in the vicinity of a
+C switch in direction of monotonicity, to produce a more "visually
+C pleasing" curve than that given by DPCHIM .
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, IERR
+C DOUBLE PRECISION SWITCH, H(N), SLOPE(N), D(INCFD,N)
+C
+C CALL DPCHCS (SWITCH, N, H, SLOPE, D, INCFD, IERR)
+C
+C Parameters:
+C
+C SWITCH -- (input) indicates the amount of control desired over
+C local excursions from data.
+C
+C N -- (input) number of data points. (assumes N.GT.2 .)
+C
+C H -- (input) real*8 array of interval lengths.
+C SLOPE -- (input) real*8 array of data slopes.
+C If the data are (X(I),Y(I)), I=1(1)N, then these inputs are:
+C H(I) = X(I+1)-X(I),
+C SLOPE(I) = (Y(I+1)-Y(I))/H(I), I=1(1)N-1.
+C
+C D -- (input) real*8 array of derivative values at the data points,
+C as determined by DPCHCI.
+C (output) derivatives in the vicinity of switches in direction
+C of monotonicity may be adjusted to produce a more "visually
+C pleasing" curve.
+C The value corresponding to X(I) is stored in
+C D(1+(I-1)*INCFD), I=1(1)N.
+C No other entries in D are changed.
+C
+C INCFD -- (input) increment between successive values in D.
+C This argument is provided primarily for 2-D applications.
+C
+C IERR -- (output) error flag. should be zero.
+C If negative, trouble in DPCHSW. (should never happen.)
+C
+C -------
+C WARNING: This routine does no validity-checking of arguments.
+C -------
+C
+C Fortran intrinsics used: ABS, MAX, MIN.
+C
+C***SEE ALSO DPCHIC
+C***ROUTINES CALLED DPCHST, DPCHSW
+C***REVISION HISTORY (YYMMDD)
+C 820218 DATE WRITTEN
+C 820617 Redesigned to (1) fix problem with lack of continuity
+C approaching a flat-topped peak (2) be cleaner and
+C easier to verify.
+C Eliminated subroutines PCHSA and PCHSX in the process.
+C 820622 1. Limited fact to not exceed one, so computed D is a
+C convex combination of DPCHCI value and DPCHSD value.
+C 2. Changed fudge from 1 to 4 (based on experiments).
+C 820623 Moved PCHSD to an inline function (eliminating MSWTYP).
+C 820805 Converted to SLATEC library version.
+C 870707 Corrected conversion to double precision.
+C 870813 Minor cosmetic changes.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 891006 Modified spacing in computation of DFLOC. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR section in prologue. (WRB)
+C 930503 Improved purpose. (FNF)
+C***END PROLOGUE DPCHCS
+C
+C Programming notes:
+C 1. The function DPCHST(ARG1,ARG2) is assumed to return zero if
+C either argument is zero, +1 if they are of the same sign, and
+C -1 if they are of opposite sign.
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, IERR
+ DOUBLE PRECISION SWITCH, H(*), SLOPE(*), D(INCFD,*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, INDX, K, NLESS1
+ DOUBLE PRECISION DEL(3), DEXT, DFLOC, DFMX, FACT, FUDGE, ONE,
+ * SLMAX, WTAVE(2), ZERO
+ SAVE ZERO, ONE, FUDGE
+ DOUBLE PRECISION DPCHST
+C
+C DEFINE INLINE FUNCTION FOR WEIGHTED AVERAGE OF SLOPES.
+C
+ DOUBLE PRECISION DPCHSD, S1, S2, H1, H2
+ DPCHSD(S1,S2,H1,H2) = (H2/(H1+H2))*S1 + (H1/(H1+H2))*S2
+C
+C INITIALIZE.
+C
+ DATA ZERO /0.D0/, ONE/1.D0/
+ DATA FUDGE /4.D0/
+C***FIRST EXECUTABLE STATEMENT DPCHCS
+ IERR = 0
+ NLESS1 = N - 1
+C
+C LOOP OVER SEGMENTS.
+C
+ DO 900 I = 2, NLESS1
+ IF ( DPCHST(SLOPE(I-1),SLOPE(I)) ) 100, 300, 900
+C --------------------------
+C
+ 100 CONTINUE
+C
+C....... SLOPE SWITCHES MONOTONICITY AT I-TH POINT .....................
+C
+C DO NOT CHANGE D IF 'UP-DOWN-UP'.
+ IF (I .GT. 2) THEN
+ IF ( DPCHST(SLOPE(I-2),SLOPE(I)) .GT. ZERO) GO TO 900
+C --------------------------
+ ENDIF
+ IF (I .LT. NLESS1) THEN
+ IF ( DPCHST(SLOPE(I+1),SLOPE(I-1)) .GT. ZERO) GO TO 900
+C ----------------------------
+ ENDIF
+C
+C ....... COMPUTE PROVISIONAL VALUE FOR D(1,I).
+C
+ DEXT = DPCHSD (SLOPE(I-1), SLOPE(I), H(I-1), H(I))
+C
+C ....... DETERMINE WHICH INTERVAL CONTAINS THE EXTREMUM.
+C
+ IF ( DPCHST(DEXT, SLOPE(I-1)) ) 200, 900, 250
+C -----------------------
+C
+ 200 CONTINUE
+C DEXT AND SLOPE(I-1) HAVE OPPOSITE SIGNS --
+C EXTREMUM IS IN (X(I-1),X(I)).
+ K = I-1
+C SET UP TO COMPUTE NEW VALUES FOR D(1,I-1) AND D(1,I).
+ WTAVE(2) = DEXT
+ IF (K .GT. 1)
+ * WTAVE(1) = DPCHSD (SLOPE(K-1), SLOPE(K), H(K-1), H(K))
+ GO TO 400
+C
+ 250 CONTINUE
+C DEXT AND SLOPE(I) HAVE OPPOSITE SIGNS --
+C EXTREMUM IS IN (X(I),X(I+1)).
+ K = I
+C SET UP TO COMPUTE NEW VALUES FOR D(1,I) AND D(1,I+1).
+ WTAVE(1) = DEXT
+ IF (K .LT. NLESS1)
+ * WTAVE(2) = DPCHSD (SLOPE(K), SLOPE(K+1), H(K), H(K+1))
+ GO TO 400
+C
+ 300 CONTINUE
+C
+C....... AT LEAST ONE OF SLOPE(I-1) AND SLOPE(I) IS ZERO --
+C CHECK FOR FLAT-TOPPED PEAK .......................
+C
+ IF (I .EQ. NLESS1) GO TO 900
+ IF ( DPCHST(SLOPE(I-1), SLOPE(I+1)) .GE. ZERO) GO TO 900
+C -----------------------------
+C
+C WE HAVE FLAT-TOPPED PEAK ON (X(I),X(I+1)).
+ K = I
+C SET UP TO COMPUTE NEW VALUES FOR D(1,I) AND D(1,I+1).
+ WTAVE(1) = DPCHSD (SLOPE(K-1), SLOPE(K), H(K-1), H(K))
+ WTAVE(2) = DPCHSD (SLOPE(K), SLOPE(K+1), H(K), H(K+1))
+C
+ 400 CONTINUE
+C
+C....... AT THIS POINT WE HAVE DETERMINED THAT THERE WILL BE AN EXTREMUM
+C ON (X(K),X(K+1)), WHERE K=I OR I-1, AND HAVE SET ARRAY WTAVE--
+C WTAVE(1) IS A WEIGHTED AVERAGE OF SLOPE(K-1) AND SLOPE(K),
+C IF K.GT.1
+C WTAVE(2) IS A WEIGHTED AVERAGE OF SLOPE(K) AND SLOPE(K+1),
+C IF K.LT.N-1
+C
+ SLMAX = ABS(SLOPE(K))
+ IF (K .GT. 1) SLMAX = MAX( SLMAX, ABS(SLOPE(K-1)) )
+ IF (K.LT.NLESS1) SLMAX = MAX( SLMAX, ABS(SLOPE(K+1)) )
+C
+ IF (K .GT. 1) DEL(1) = SLOPE(K-1) / SLMAX
+ DEL(2) = SLOPE(K) / SLMAX
+ IF (K.LT.NLESS1) DEL(3) = SLOPE(K+1) / SLMAX
+C
+ IF ((K.GT.1) .AND. (K.LT.NLESS1)) THEN
+C NORMAL CASE -- EXTREMUM IS NOT IN A BOUNDARY INTERVAL.
+ FACT = FUDGE* ABS(DEL(3)*(DEL(1)-DEL(2))*(WTAVE(2)/SLMAX))
+ D(1,K) = D(1,K) + MIN(FACT,ONE)*(WTAVE(1) - D(1,K))
+ FACT = FUDGE* ABS(DEL(1)*(DEL(3)-DEL(2))*(WTAVE(1)/SLMAX))
+ D(1,K+1) = D(1,K+1) + MIN(FACT,ONE)*(WTAVE(2) - D(1,K+1))
+ ELSE
+C SPECIAL CASE K=1 (WHICH CAN OCCUR ONLY IF I=2) OR
+C K=NLESS1 (WHICH CAN OCCUR ONLY IF I=NLESS1).
+ FACT = FUDGE* ABS(DEL(2))
+ D(1,I) = MIN(FACT,ONE) * WTAVE(I-K+1)
+C NOTE THAT I-K+1 = 1 IF K=I (=NLESS1),
+C I-K+1 = 2 IF K=I-1(=1).
+ ENDIF
+C
+C
+C....... ADJUST IF NECESSARY TO LIMIT EXCURSIONS FROM DATA.
+C
+ IF (SWITCH .LE. ZERO) GO TO 900
+C
+ DFLOC = H(K)*ABS(SLOPE(K))
+ IF (K .GT. 1) DFLOC = MAX( DFLOC, H(K-1)*ABS(SLOPE(K-1)) )
+ IF (K.LT.NLESS1) DFLOC = MAX( DFLOC, H(K+1)*ABS(SLOPE(K+1)) )
+ DFMX = SWITCH*DFLOC
+ INDX = I-K+1
+C INDX = 1 IF K=I, 2 IF K=I-1.
+C ---------------------------------------------------------------
+ CALL DPCHSW(DFMX, INDX, D(1,K), D(1,K+1), H(K), SLOPE(K), IERR)
+C ---------------------------------------------------------------
+ IF (IERR .NE. 0) RETURN
+C
+C....... END OF SEGMENT LOOP.
+C
+ 900 CONTINUE
+C
+ RETURN
+C------------- LAST LINE OF DPCHCS FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchdf.f b/Lib/Slatec/slatec/dpchdf.f
new file mode 100644
index 0000000..53994fb
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchdf.f
@@ -0,0 +1,108 @@
+*DECK DPCHDF
+ DOUBLE PRECISION FUNCTION DPCHDF (K, X, S, IERR)
+C***BEGIN PROLOGUE DPCHDF
+C***SUBSIDIARY
+C***PURPOSE Computes divided differences for DPCHCE and DPCHSP
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE DOUBLE PRECISION (PCHDF-S, DPCHDF-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C DPCHDF: DPCHIP Finite Difference Formula
+C
+C Uses a divided difference formulation to compute a K-point approx-
+C imation to the derivative at X(K) based on the data in X and S.
+C
+C Called by DPCHCE and DPCHSP to compute 3- and 4-point boundary
+C derivative approximations.
+C
+C ----------------------------------------------------------------------
+C
+C On input:
+C K is the order of the desired derivative approximation.
+C K must be at least 3 (error return if not).
+C X contains the K values of the independent variable.
+C X need not be ordered, but the values **MUST** be
+C distinct. (Not checked here.)
+C S contains the associated slope values:
+C S(I) = (F(I+1)-F(I))/(X(I+1)-X(I)), I=1(1)K-1.
+C (Note that S need only be of length K-1.)
+C
+C On return:
+C S will be destroyed.
+C IERR will be set to -1 if K.LT.2 .
+C DPCHDF will be set to the desired derivative approximation if
+C IERR=0 or to zero if IERR=-1.
+C
+C ----------------------------------------------------------------------
+C
+C***SEE ALSO DPCHCE, DPCHSP
+C***REFERENCES Carl de Boor, A Practical Guide to Splines, Springer-
+C Verlag, New York, 1978, pp. 10-16.
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820503 DATE WRITTEN
+C 820805 Converted to SLATEC library version.
+C 870707 Corrected XERROR calls for d.p. name(s).
+C 870813 Minor cosmetic changes.
+C 890206 Corrected XERROR calls.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890411 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR and DATE WRITTEN sections in prologue. (WRB)
+C 920429 Revised format and order of references. (WRB,FNF)
+C 930503 Improved purpose. (FNF)
+C***END PROLOGUE DPCHDF
+C
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER K, IERR
+ DOUBLE PRECISION X(K), S(K)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, J
+ DOUBLE PRECISION VALUE, ZERO
+ SAVE ZERO
+ DATA ZERO /0.D0/
+C
+C CHECK FOR LEGAL VALUE OF K.
+C
+C***FIRST EXECUTABLE STATEMENT DPCHDF
+ IF (K .LT. 3) GO TO 5001
+C
+C COMPUTE COEFFICIENTS OF INTERPOLATING POLYNOMIAL.
+C
+ DO 10 J = 2, K-1
+ DO 9 I = 1, K-J
+ S(I) = (S(I+1)-S(I))/(X(I+J)-X(I))
+ 9 CONTINUE
+ 10 CONTINUE
+C
+C EVALUATE DERIVATIVE AT X(K).
+C
+ VALUE = S(1)
+ DO 20 I = 2, K-1
+ VALUE = S(I) + VALUE*(X(K)-X(I))
+ 20 CONTINUE
+C
+C NORMAL RETURN.
+C
+ IERR = 0
+ DPCHDF = VALUE
+ RETURN
+C
+C ERROR RETURN.
+C
+ 5001 CONTINUE
+C K.LT.3 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DPCHDF', 'K LESS THAN THREE', IERR, 1)
+ DPCHDF = ZERO
+ RETURN
+C------------- LAST LINE OF DPCHDF FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchfd.f b/Lib/Slatec/slatec/dpchfd.f
new file mode 100644
index 0000000..f3e7f3d
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchfd.f
@@ -0,0 +1,324 @@
+*DECK DPCHFD
+ SUBROUTINE DPCHFD (N, X, F, D, INCFD, SKIP, NE, XE, FE, DE, IERR)
+C***BEGIN PROLOGUE DPCHFD
+C***PURPOSE Evaluate a piecewise cubic Hermite function and its first
+C derivative at an array of points. May be used by itself
+C for Hermite interpolation, or as an evaluator for DPCHIM
+C or DPCHIC. If only function values are required, use
+C DPCHFE instead.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3, H1
+C***TYPE DOUBLE PRECISION (PCHFD-S, DPCHFD-D)
+C***KEYWORDS CUBIC HERMITE DIFFERENTIATION, CUBIC HERMITE EVALUATION,
+C HERMITE INTERPOLATION, PCHIP, PIECEWISE CUBIC EVALUATION
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C DPCHFD: Piecewise Cubic Hermite Function and Derivative
+C evaluator
+C
+C Evaluates the cubic Hermite function defined by N, X, F, D, to-
+C gether with its first derivative, at the points XE(J), J=1(1)NE.
+C
+C If only function values are required, use DPCHFE, instead.
+C
+C To provide compatibility with DPCHIM and DPCHIC, includes an
+C increment between successive values of the F- and D-arrays.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, NE, IERR
+C DOUBLE PRECISION X(N), F(INCFD,N), D(INCFD,N), XE(NE), FE(NE),
+C DE(NE)
+C LOGICAL SKIP
+C
+C CALL DPCHFD (N, X, F, D, INCFD, SKIP, NE, XE, FE, DE, IERR)
+C
+C Parameters:
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C
+C X -- (input) real*8 array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real*8 array of function values. F(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C D -- (input) real*8 array of derivative values. D(1+(I-1)*INCFD)
+C is the value corresponding to X(I).
+C
+C INCFD -- (input) increment between successive values in F and D.
+C (Error return if INCFD.LT.1 .)
+C
+C SKIP -- (input/output) logical variable which should be set to
+C .TRUE. if the user wishes to skip checks for validity of
+C preceding parameters, or to .FALSE. otherwise.
+C This will save time in case these checks have already
+C been performed (say, in DPCHIM or DPCHIC).
+C SKIP will be set to .TRUE. on normal return.
+C
+C NE -- (input) number of evaluation points. (Error return if
+C NE.LT.1 .)
+C
+C XE -- (input) real*8 array of points at which the functions are to
+C be evaluated.
+C
+C
+C NOTES:
+C 1. The evaluation will be most efficient if the elements
+C of XE are increasing relative to X;
+C that is, XE(J) .GE. X(I)
+C implies XE(K) .GE. X(I), all K.GE.J .
+C 2. If any of the XE are outside the interval [X(1),X(N)],
+C values are extrapolated from the nearest extreme cubic,
+C and a warning error is returned.
+C
+C FE -- (output) real*8 array of values of the cubic Hermite
+C function defined by N, X, F, D at the points XE.
+C
+C DE -- (output) real*8 array of values of the first derivative of
+C the same function at the points XE.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C Warning error:
+C IERR.GT.0 means that extrapolation was performed at
+C IERR points.
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C IERR = -4 if NE.LT.1 .
+C (Output arrays have not been changed in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C IERR = -5 if an error has occurred in the lower-level
+C routine DCHFDV. NB: this should never happen.
+C Notify the author **IMMEDIATELY** if it does.
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED DCHFDV, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 811020 DATE WRITTEN
+C 820803 Minor cosmetic changes for release 1.
+C 870707 Corrected XERROR calls for d.p. name(s).
+C 890206 Corrected XERROR calls.
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 891006 Cosmetic changes to prologue. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C***END PROLOGUE DPCHFD
+C Programming notes:
+C
+C 1. To produce a single precision version, simply:
+C a. Change DPCHFD to PCHFD, and DCHFDV to CHFDV, wherever they
+C occur,
+C b. Change the double precision declaration to real,
+C
+C 2. Most of the coding between the call to DCHFDV and the end of
+C the IR-loop could be eliminated if it were permissible to
+C assume that XE is ordered relative to X.
+C
+C 3. DCHFDV does not assume that X1 is less than X2. thus, it would
+C be possible to write a version of DPCHFD that assumes a strict-
+C ly decreasing X-array by simply running the IR-loop backwards
+C (and reversing the order of appropriate tests).
+C
+C 4. The present code has a minor bug, which I have decided is not
+C worth the effort that would be required to fix it.
+C If XE contains points in [X(N-1),X(N)], followed by points .LT.
+C X(N-1), followed by points .GT.X(N), the extrapolation points
+C will be counted (at least) twice in the total returned in IERR.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, NE, IERR
+ DOUBLE PRECISION X(*), F(INCFD,*), D(INCFD,*), XE(*), FE(*),
+ * DE(*)
+ LOGICAL SKIP
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, IERC, IR, J, JFIRST, NEXT(2), NJ
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT DPCHFD
+ IF (SKIP) GO TO 5
+C
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+C
+C FUNCTION DEFINITION IS OK, GO ON.
+C
+ 5 CONTINUE
+ IF ( NE.LT.1 ) GO TO 5004
+ IERR = 0
+ SKIP = .TRUE.
+C
+C LOOP OVER INTERVALS. ( INTERVAL INDEX IS IL = IR-1 . )
+C ( INTERVAL IS X(IL).LE.X.LT.X(IR) . )
+ JFIRST = 1
+ IR = 2
+ 10 CONTINUE
+C
+C SKIP OUT OF LOOP IF HAVE PROCESSED ALL EVALUATION POINTS.
+C
+ IF (JFIRST .GT. NE) GO TO 5000
+C
+C LOCATE ALL POINTS IN INTERVAL.
+C
+ DO 20 J = JFIRST, NE
+ IF (XE(J) .GE. X(IR)) GO TO 30
+ 20 CONTINUE
+ J = NE + 1
+ GO TO 40
+C
+C HAVE LOCATED FIRST POINT BEYOND INTERVAL.
+C
+ 30 CONTINUE
+ IF (IR .EQ. N) J = NE + 1
+C
+ 40 CONTINUE
+ NJ = J - JFIRST
+C
+C SKIP EVALUATION IF NO POINTS IN INTERVAL.
+C
+ IF (NJ .EQ. 0) GO TO 50
+C
+C EVALUATE CUBIC AT XE(I), I = JFIRST (1) J-1 .
+C
+C ----------------------------------------------------------------
+ CALL DCHFDV (X(IR-1),X(IR), F(1,IR-1),F(1,IR), D(1,IR-1),D(1,IR)
+ * ,NJ, XE(JFIRST), FE(JFIRST), DE(JFIRST), NEXT, IERC)
+C ----------------------------------------------------------------
+ IF (IERC .LT. 0) GO TO 5005
+C
+ IF (NEXT(2) .EQ. 0) GO TO 42
+C IF (NEXT(2) .GT. 0) THEN
+C IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(2) TO THE
+C RIGHT OF X(IR).
+C
+ IF (IR .LT. N) GO TO 41
+C IF (IR .EQ. N) THEN
+C THESE ARE ACTUALLY EXTRAPOLATION POINTS.
+ IERR = IERR + NEXT(2)
+ GO TO 42
+ 41 CONTINUE
+C ELSE
+C WE SHOULD NEVER HAVE GOTTEN HERE.
+ GO TO 5005
+C ENDIF
+C ENDIF
+ 42 CONTINUE
+C
+ IF (NEXT(1) .EQ. 0) GO TO 49
+C IF (NEXT(1) .GT. 0) THEN
+C IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(1) TO THE
+C LEFT OF X(IR-1).
+C
+ IF (IR .GT. 2) GO TO 43
+C IF (IR .EQ. 2) THEN
+C THESE ARE ACTUALLY EXTRAPOLATION POINTS.
+ IERR = IERR + NEXT(1)
+ GO TO 49
+ 43 CONTINUE
+C ELSE
+C XE IS NOT ORDERED RELATIVE TO X, SO MUST ADJUST
+C EVALUATION INTERVAL.
+C
+C FIRST, LOCATE FIRST POINT TO LEFT OF X(IR-1).
+ DO 44 I = JFIRST, J-1
+ IF (XE(I) .LT. X(IR-1)) GO TO 45
+ 44 CONTINUE
+C NOTE-- CANNOT DROP THROUGH HERE UNLESS THERE IS AN ERROR
+C IN DCHFDV.
+ GO TO 5005
+C
+ 45 CONTINUE
+C RESET J. (THIS WILL BE THE NEW JFIRST.)
+ J = I
+C
+C NOW FIND OUT HOW FAR TO BACK UP IN THE X-ARRAY.
+ DO 46 I = 1, IR-1
+ IF (XE(J) .LT. X(I)) GO TO 47
+ 46 CONTINUE
+C NB-- CAN NEVER DROP THROUGH HERE, SINCE XE(J).LT.X(IR-1).
+C
+ 47 CONTINUE
+C AT THIS POINT, EITHER XE(J) .LT. X(1)
+C OR X(I-1) .LE. XE(J) .LT. X(I) .
+C RESET IR, RECOGNIZING THAT IT WILL BE INCREMENTED BEFORE
+C CYCLING.
+ IR = MAX(1, I-1)
+C ENDIF
+C ENDIF
+ 49 CONTINUE
+C
+ JFIRST = J
+C
+C END OF IR-LOOP.
+C
+ 50 CONTINUE
+ IR = IR + 1
+ IF (IR .LE. N) GO TO 10
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DPCHFD',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'DPCHFD', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ RETURN
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'DPCHFD',
+ + 'X-ARRAY NOT STRICTLY INCREASING', IERR, 1)
+ RETURN
+C
+ 5004 CONTINUE
+C NE.LT.1 RETURN.
+ IERR = -4
+ CALL XERMSG ('SLATEC', 'DPCHFD',
+ + 'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)
+ RETURN
+C
+ 5005 CONTINUE
+C ERROR RETURN FROM DCHFDV.
+C *** THIS CASE SHOULD NEVER OCCUR ***
+ IERR = -5
+ CALL XERMSG ('SLATEC', 'DPCHFD',
+ + 'ERROR RETURN FROM DCHFDV -- FATAL', IERR, 2)
+ RETURN
+C------------- LAST LINE OF DPCHFD FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchfe.f b/Lib/Slatec/slatec/dpchfe.f
new file mode 100644
index 0000000..7ce9108
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchfe.f
@@ -0,0 +1,310 @@
+*DECK DPCHFE
+ SUBROUTINE DPCHFE (N, X, F, D, INCFD, SKIP, NE, XE, FE, IERR)
+C***BEGIN PROLOGUE DPCHFE
+C***PURPOSE Evaluate a piecewise cubic Hermite function at an array of
+C points. May be used by itself for Hermite interpolation,
+C or as an evaluator for DPCHIM or DPCHIC.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3
+C***TYPE DOUBLE PRECISION (PCHFE-S, DPCHFE-D)
+C***KEYWORDS CUBIC HERMITE EVALUATION, HERMITE INTERPOLATION, PCHIP,
+C PIECEWISE CUBIC EVALUATION
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C DPCHFE: Piecewise Cubic Hermite Function Evaluator
+C
+C Evaluates the cubic Hermite function defined by N, X, F, D at
+C the points XE(J), J=1(1)NE.
+C
+C To provide compatibility with DPCHIM and DPCHIC, includes an
+C increment between successive values of the F- and D-arrays.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, NE, IERR
+C DOUBLE PRECISION X(N), F(INCFD,N), D(INCFD,N), XE(NE), FE(NE)
+C LOGICAL SKIP
+C
+C CALL DPCHFE (N, X, F, D, INCFD, SKIP, NE, XE, FE, IERR)
+C
+C Parameters:
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C
+C X -- (input) real*8 array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real*8 array of function values. F(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C D -- (input) real*8 array of derivative values. D(1+(I-1)*INCFD)
+C is the value corresponding to X(I).
+C
+C INCFD -- (input) increment between successive values in F and D.
+C (Error return if INCFD.LT.1 .)
+C
+C SKIP -- (input/output) logical variable which should be set to
+C .TRUE. if the user wishes to skip checks for validity of
+C preceding parameters, or to .FALSE. otherwise.
+C This will save time in case these checks have already
+C been performed (say, in DPCHIM or DPCHIC).
+C SKIP will be set to .TRUE. on normal return.
+C
+C NE -- (input) number of evaluation points. (Error return if
+C NE.LT.1 .)
+C
+C XE -- (input) real*8 array of points at which the function is to
+C be evaluated.
+C
+C NOTES:
+C 1. The evaluation will be most efficient if the elements
+C of XE are increasing relative to X;
+C that is, XE(J) .GE. X(I)
+C implies XE(K) .GE. X(I), all K.GE.J .
+C 2. If any of the XE are outside the interval [X(1),X(N)],
+C values are extrapolated from the nearest extreme cubic,
+C and a warning error is returned.
+C
+C FE -- (output) real*8 array of values of the cubic Hermite
+C function defined by N, X, F, D at the points XE.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C Warning error:
+C IERR.GT.0 means that extrapolation was performed at
+C IERR points.
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C IERR = -4 if NE.LT.1 .
+C (The FE-array has not been changed in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED DCHFEV, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 811020 DATE WRITTEN
+C 820803 Minor cosmetic changes for release 1.
+C 870707 Corrected XERROR calls for d.p. name(s).
+C 890206 Corrected XERROR calls.
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 891006 Cosmetic changes to prologue. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C***END PROLOGUE DPCHFE
+C Programming notes:
+C
+C 1. To produce a single precision version, simply:
+C a. Change DPCHFE to PCHFE, and DCHFEV to CHFEV, wherever they
+C occur,
+C b. Change the double precision declaration to real,
+C
+C 2. Most of the coding between the call to DCHFEV and the end of
+C the IR-loop could be eliminated if it were permissible to
+C assume that XE is ordered relative to X.
+C
+C 3. DCHFEV does not assume that X1 is less than X2. thus, it would
+C be possible to write a version of DPCHFE that assumes a
+C decreasing X-array by simply running the IR-loop backwards
+C (and reversing the order of appropriate tests).
+C
+C 4. The present code has a minor bug, which I have decided is not
+C worth the effort that would be required to fix it.
+C If XE contains points in [X(N-1),X(N)], followed by points .LT.
+C X(N-1), followed by points .GT.X(N), the extrapolation points
+C will be counted (at least) twice in the total returned in IERR.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, NE, IERR
+ DOUBLE PRECISION X(*), F(INCFD,*), D(INCFD,*), XE(*), FE(*)
+ LOGICAL SKIP
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, IERC, IR, J, JFIRST, NEXT(2), NJ
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT DPCHFE
+ IF (SKIP) GO TO 5
+C
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+C
+C FUNCTION DEFINITION IS OK, GO ON.
+C
+ 5 CONTINUE
+ IF ( NE.LT.1 ) GO TO 5004
+ IERR = 0
+ SKIP = .TRUE.
+C
+C LOOP OVER INTERVALS. ( INTERVAL INDEX IS IL = IR-1 . )
+C ( INTERVAL IS X(IL).LE.X.LT.X(IR) . )
+ JFIRST = 1
+ IR = 2
+ 10 CONTINUE
+C
+C SKIP OUT OF LOOP IF HAVE PROCESSED ALL EVALUATION POINTS.
+C
+ IF (JFIRST .GT. NE) GO TO 5000
+C
+C LOCATE ALL POINTS IN INTERVAL.
+C
+ DO 20 J = JFIRST, NE
+ IF (XE(J) .GE. X(IR)) GO TO 30
+ 20 CONTINUE
+ J = NE + 1
+ GO TO 40
+C
+C HAVE LOCATED FIRST POINT BEYOND INTERVAL.
+C
+ 30 CONTINUE
+ IF (IR .EQ. N) J = NE + 1
+C
+ 40 CONTINUE
+ NJ = J - JFIRST
+C
+C SKIP EVALUATION IF NO POINTS IN INTERVAL.
+C
+ IF (NJ .EQ. 0) GO TO 50
+C
+C EVALUATE CUBIC AT XE(I), I = JFIRST (1) J-1 .
+C
+C ----------------------------------------------------------------
+ CALL DCHFEV (X(IR-1),X(IR), F(1,IR-1),F(1,IR), D(1,IR-1),D(1,IR)
+ * ,NJ, XE(JFIRST), FE(JFIRST), NEXT, IERC)
+C ----------------------------------------------------------------
+ IF (IERC .LT. 0) GO TO 5005
+C
+ IF (NEXT(2) .EQ. 0) GO TO 42
+C IF (NEXT(2) .GT. 0) THEN
+C IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(2) TO THE
+C RIGHT OF X(IR).
+C
+ IF (IR .LT. N) GO TO 41
+C IF (IR .EQ. N) THEN
+C THESE ARE ACTUALLY EXTRAPOLATION POINTS.
+ IERR = IERR + NEXT(2)
+ GO TO 42
+ 41 CONTINUE
+C ELSE
+C WE SHOULD NEVER HAVE GOTTEN HERE.
+ GO TO 5005
+C ENDIF
+C ENDIF
+ 42 CONTINUE
+C
+ IF (NEXT(1) .EQ. 0) GO TO 49
+C IF (NEXT(1) .GT. 0) THEN
+C IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(1) TO THE
+C LEFT OF X(IR-1).
+C
+ IF (IR .GT. 2) GO TO 43
+C IF (IR .EQ. 2) THEN
+C THESE ARE ACTUALLY EXTRAPOLATION POINTS.
+ IERR = IERR + NEXT(1)
+ GO TO 49
+ 43 CONTINUE
+C ELSE
+C XE IS NOT ORDERED RELATIVE TO X, SO MUST ADJUST
+C EVALUATION INTERVAL.
+C
+C FIRST, LOCATE FIRST POINT TO LEFT OF X(IR-1).
+ DO 44 I = JFIRST, J-1
+ IF (XE(I) .LT. X(IR-1)) GO TO 45
+ 44 CONTINUE
+C NOTE-- CANNOT DROP THROUGH HERE UNLESS THERE IS AN ERROR
+C IN DCHFEV.
+ GO TO 5005
+C
+ 45 CONTINUE
+C RESET J. (THIS WILL BE THE NEW JFIRST.)
+ J = I
+C
+C NOW FIND OUT HOW FAR TO BACK UP IN THE X-ARRAY.
+ DO 46 I = 1, IR-1
+ IF (XE(J) .LT. X(I)) GO TO 47
+ 46 CONTINUE
+C NB-- CAN NEVER DROP THROUGH HERE, SINCE XE(J).LT.X(IR-1).
+C
+ 47 CONTINUE
+C AT THIS POINT, EITHER XE(J) .LT. X(1)
+C OR X(I-1) .LE. XE(J) .LT. X(I) .
+C RESET IR, RECOGNIZING THAT IT WILL BE INCREMENTED BEFORE
+C CYCLING.
+ IR = MAX(1, I-1)
+C ENDIF
+C ENDIF
+ 49 CONTINUE
+C
+ JFIRST = J
+C
+C END OF IR-LOOP.
+C
+ 50 CONTINUE
+ IR = IR + 1
+ IF (IR .LE. N) GO TO 10
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DPCHFE',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'DPCHFE', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ RETURN
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'DPCHFE',
+ + 'X-ARRAY NOT STRICTLY INCREASING', IERR, 1)
+ RETURN
+C
+ 5004 CONTINUE
+C NE.LT.1 RETURN.
+ IERR = -4
+ CALL XERMSG ('SLATEC', 'DPCHFE',
+ + 'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)
+ RETURN
+C
+ 5005 CONTINUE
+C ERROR RETURN FROM DCHFEV.
+C *** THIS CASE SHOULD NEVER OCCUR ***
+ IERR = -5
+ CALL XERMSG ('SLATEC', 'DPCHFE',
+ + 'ERROR RETURN FROM DCHFEV -- FATAL', IERR, 2)
+ RETURN
+C------------- LAST LINE OF DPCHFE FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchia.f b/Lib/Slatec/slatec/dpchia.f
new file mode 100644
index 0000000..7607d52
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchia.f
@@ -0,0 +1,269 @@
+*DECK DPCHIA
+ DOUBLE PRECISION FUNCTION DPCHIA (N, X, F, D, INCFD, SKIP, A, B,
+ + IERR)
+C***BEGIN PROLOGUE DPCHIA
+C***PURPOSE Evaluate the definite integral of a piecewise cubic
+C Hermite function over an arbitrary interval.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3, H2A1B2
+C***TYPE DOUBLE PRECISION (PCHIA-S, DPCHIA-D)
+C***KEYWORDS CUBIC HERMITE INTERPOLATION, NUMERICAL INTEGRATION, PCHIP,
+C QUADRATURE
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C DPCHIA: Piecewise Cubic Hermite Integrator, Arbitrary limits
+C
+C Evaluates the definite integral of the cubic Hermite function
+C defined by N, X, F, D over the interval [A, B].
+C
+C To provide compatibility with DPCHIM and DPCHIC, includes an
+C increment between successive values of the F- and D-arrays.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, IERR
+C DOUBLE PRECISION X(N), F(INCFD,N), D(INCFD,N), A, B
+C DOUBLE PRECISION VALUE, DPCHIA
+C LOGICAL SKIP
+C
+C VALUE = DPCHIA (N, X, F, D, INCFD, SKIP, A, B, IERR)
+C
+C Parameters:
+C
+C VALUE -- (output) value of the requested integral.
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C
+C X -- (input) real*8 array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real*8 array of function values. F(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C D -- (input) real*8 array of derivative values. D(1+(I-1)*INCFD)
+C is the value corresponding to X(I).
+C
+C INCFD -- (input) increment between successive values in F and D.
+C (Error return if INCFD.LT.1 .)
+C
+C SKIP -- (input/output) logical variable which should be set to
+C .TRUE. if the user wishes to skip checks for validity of
+C preceding parameters, or to .FALSE. otherwise.
+C This will save time in case these checks have already
+C been performed (say, in DPCHIM or DPCHIC).
+C SKIP will be set to .TRUE. on return with IERR.GE.0 .
+C
+C A,B -- (input) the limits of integration.
+C NOTE: There is no requirement that [A,B] be contained in
+C [X(1),X(N)]. However, the resulting integral value
+C will be highly suspect, if not.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C Warning errors:
+C IERR = 1 if A is outside the interval [X(1),X(N)].
+C IERR = 2 if B is outside the interval [X(1),X(N)].
+C IERR = 3 if both of the above are true. (Note that this
+C means that either [A,B] contains data interval
+C or the intervals do not intersect at all.)
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C (VALUE will be zero in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C IERR = -4 in case of an error return from DPCHID (which
+C should never occur).
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED DCHFIE, DPCHID, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820730 DATE WRITTEN
+C 820804 Converted to SLATEC library version.
+C 870707 Corrected XERROR calls for d.p. name(s).
+C 870707 Corrected conversion to double precision.
+C 870813 Minor cosmetic changes.
+C 890206 Corrected XERROR calls.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890703 Corrected category record. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 891006 Cosmetic changes to prologue. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 930503 Corrected to set VALUE=0 when IERR.lt.0. (FNF)
+C 930504 Changed DCHFIV to DCHFIE. (FNF)
+C***END PROLOGUE DPCHIA
+C
+C Programming notes:
+C 1. The error flag from DPCHID is tested, because a logic flaw
+C could conceivably result in IERD=-4, which should be reported.
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, IERR
+ DOUBLE PRECISION X(*), F(INCFD,*), D(INCFD,*), A, B
+ LOGICAL SKIP
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, IA, IB, IERD, IL, IR
+ DOUBLE PRECISION VALUE, XA, XB, ZERO
+ SAVE ZERO
+ DOUBLE PRECISION DCHFIE, DPCHID
+C
+C INITIALIZE.
+C
+ DATA ZERO /0.D0/
+C***FIRST EXECUTABLE STATEMENT DPCHIA
+ VALUE = ZERO
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+ IF (SKIP) GO TO 5
+C
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+C
+C FUNCTION DEFINITION IS OK, GO ON.
+C
+ 5 CONTINUE
+ SKIP = .TRUE.
+ IERR = 0
+ IF ( (A.LT.X(1)) .OR. (A.GT.X(N)) ) IERR = IERR + 1
+ IF ( (B.LT.X(1)) .OR. (B.GT.X(N)) ) IERR = IERR + 2
+C
+C COMPUTE INTEGRAL VALUE.
+C
+ IF (A .NE. B) THEN
+ XA = MIN (A, B)
+ XB = MAX (A, B)
+ IF (XB .LE. X(2)) THEN
+C INTERVAL IS TO LEFT OF X(2), SO USE FIRST CUBIC.
+C ---------------------------------------
+ VALUE = DCHFIE (X(1),X(2), F(1,1),F(1,2),
+ + D(1,1),D(1,2), A, B)
+C ---------------------------------------
+ ELSE IF (XA .GE. X(N-1)) THEN
+C INTERVAL IS TO RIGHT OF X(N-1), SO USE LAST CUBIC.
+C ------------------------------------------
+ VALUE = DCHFIE(X(N-1),X(N), F(1,N-1),F(1,N),
+ + D(1,N-1),D(1,N), A, B)
+C ------------------------------------------
+ ELSE
+C 'NORMAL' CASE -- XA.LT.XB, XA.LT.X(N-1), XB.GT.X(2).
+C ......LOCATE IA AND IB SUCH THAT
+C X(IA-1).LT.XA.LE.X(IA).LE.X(IB).LE.XB.LE.X(IB+1)
+ IA = 1
+ DO 10 I = 1, N-1
+ IF (XA .GT. X(I)) IA = I + 1
+ 10 CONTINUE
+C IA = 1 IMPLIES XA.LT.X(1) . OTHERWISE,
+C IA IS LARGEST INDEX SUCH THAT X(IA-1).LT.XA,.
+C
+ IB = N
+ DO 20 I = N, IA, -1
+ IF (XB .LT. X(I)) IB = I - 1
+ 20 CONTINUE
+C IB = N IMPLIES XB.GT.X(N) . OTHERWISE,
+C IB IS SMALLEST INDEX SUCH THAT XB.LT.X(IB+1) .
+C
+C ......COMPUTE THE INTEGRAL.
+ IF (IB .LT. IA) THEN
+C THIS MEANS IB = IA-1 AND
+C (A,B) IS A SUBSET OF (X(IB),X(IA)).
+C -------------------------------------------
+ VALUE = DCHFIE (X(IB),X(IA), F(1,IB),F(1,IA),
+ + D(1,IB),D(1,IA), A, B)
+C -------------------------------------------
+ ELSE
+C
+C FIRST COMPUTE INTEGRAL OVER (X(IA),X(IB)).
+C (Case (IB .EQ. IA) is taken care of by initialization
+C of VALUE to ZERO.)
+ IF (IB .GT. IA) THEN
+C ---------------------------------------------
+ VALUE = DPCHID (N, X, F, D, INCFD, SKIP, IA, IB, IERD)
+C ---------------------------------------------
+ IF (IERD .LT. 0) GO TO 5004
+ ENDIF
+C
+C THEN ADD ON INTEGRAL OVER (XA,X(IA)).
+ IF (XA .LT. X(IA)) THEN
+ IL = MAX(1, IA-1)
+ IR = IL + 1
+C -------------------------------------
+ VALUE = VALUE + DCHFIE (X(IL),X(IR), F(1,IL),F(1,IR),
+ + D(1,IL),D(1,IR), XA, X(IA))
+C -------------------------------------
+ ENDIF
+C
+C THEN ADD ON INTEGRAL OVER (X(IB),XB).
+ IF (XB .GT. X(IB)) THEN
+ IR = MIN (IB+1, N)
+ IL = IR - 1
+C -------------------------------------
+ VALUE = VALUE + DCHFIE (X(IL),X(IR), F(1,IL),F(1,IR),
+ + D(1,IL),D(1,IR), X(IB), XB)
+C -------------------------------------
+ ENDIF
+C
+C FINALLY, ADJUST SIGN IF NECESSARY.
+ IF (A .GT. B) VALUE = -VALUE
+ ENDIF
+ ENDIF
+ ENDIF
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ DPCHIA = VALUE
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DPCHIA',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ GO TO 5000
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'DPCHIA', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ GO TO 5000
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'DPCHIA',
+ + 'X-ARRAY NOT STRICTLY INCREASING', IERR, 1)
+ GO TO 5000
+C
+ 5004 CONTINUE
+C TROUBLE IN DPCHID. (SHOULD NEVER OCCUR.)
+ IERR = -4
+ CALL XERMSG ('SLATEC', 'DPCHIA', 'TROUBLE IN DPCHID', IERR, 1)
+ GO TO 5000
+C------------- LAST LINE OF DPCHIA FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchic.f b/Lib/Slatec/slatec/dpchic.f
new file mode 100644
index 0000000..49367ee
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchic.f
@@ -0,0 +1,347 @@
+*DECK DPCHIC
+ SUBROUTINE DPCHIC (IC, VC, SWITCH, N, X, F, D, INCFD, WK, NWK,
+ + IERR)
+C***BEGIN PROLOGUE DPCHIC
+C***PURPOSE Set derivatives needed to determine a piecewise monotone
+C piecewise cubic Hermite interpolant to given data.
+C User control is available over boundary conditions and/or
+C treatment of points where monotonicity switches direction.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E1A
+C***TYPE DOUBLE PRECISION (PCHIC-S, DPCHIC-D)
+C***KEYWORDS CUBIC HERMITE INTERPOLATION, MONOTONE INTERPOLATION,
+C PCHIP, PIECEWISE CUBIC INTERPOLATION,
+C SHAPE-PRESERVING INTERPOLATION
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C DPCHIC: Piecewise Cubic Hermite Interpolation Coefficients.
+C
+C Sets derivatives needed to determine a piecewise monotone piece-
+C wise cubic interpolant to the data given in X and F satisfying the
+C boundary conditions specified by IC and VC.
+C
+C The treatment of points where monotonicity switches direction is
+C controlled by argument SWITCH.
+C
+C To facilitate two-dimensional applications, includes an increment
+C between successive values of the F- and D-arrays.
+C
+C The resulting piecewise cubic Hermite function may be evaluated
+C by DPCHFE or DPCHFD.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER IC(2), N, NWK, IERR
+C DOUBLE PRECISION VC(2), SWITCH, X(N), F(INCFD,N), D(INCFD,N),
+C WK(NWK)
+C
+C CALL DPCHIC (IC, VC, SWITCH, N, X, F, D, INCFD, WK, NWK, IERR)
+C
+C Parameters:
+C
+C IC -- (input) integer array of length 2 specifying desired
+C boundary conditions:
+C IC(1) = IBEG, desired condition at beginning of data.
+C IC(2) = IEND, desired condition at end of data.
+C
+C IBEG = 0 for the default boundary condition (the same as
+C used by DPCHIM).
+C If IBEG.NE.0, then its sign indicates whether the boundary
+C derivative is to be adjusted, if necessary, to be
+C compatible with monotonicity:
+C IBEG.GT.0 if no adjustment is to be performed.
+C IBEG.LT.0 if the derivative is to be adjusted for
+C monotonicity.
+C
+C Allowable values for the magnitude of IBEG are:
+C IBEG = 1 if first derivative at X(1) is given in VC(1).
+C IBEG = 2 if second derivative at X(1) is given in VC(1).
+C IBEG = 3 to use the 3-point difference formula for D(1).
+C (Reverts to the default b.c. if N.LT.3 .)
+C IBEG = 4 to use the 4-point difference formula for D(1).
+C (Reverts to the default b.c. if N.LT.4 .)
+C IBEG = 5 to set D(1) so that the second derivative is con-
+C tinuous at X(2). (Reverts to the default b.c. if N.LT.4.)
+C This option is somewhat analogous to the "not a knot"
+C boundary condition provided by DPCHSP.
+C
+C NOTES (IBEG):
+C 1. An error return is taken if ABS(IBEG).GT.5 .
+C 2. Only in case IBEG.LE.0 is it guaranteed that the
+C interpolant will be monotonic in the first interval.
+C If the returned value of D(1) lies between zero and
+C 3*SLOPE(1), the interpolant will be monotonic. This
+C is **NOT** checked if IBEG.GT.0 .
+C 3. If IBEG.LT.0 and D(1) had to be changed to achieve mono-
+C tonicity, a warning error is returned.
+C
+C IEND may take on the same values as IBEG, but applied to
+C derivative at X(N). In case IEND = 1 or 2, the value is
+C given in VC(2).
+C
+C NOTES (IEND):
+C 1. An error return is taken if ABS(IEND).GT.5 .
+C 2. Only in case IEND.LE.0 is it guaranteed that the
+C interpolant will be monotonic in the last interval.
+C If the returned value of D(1+(N-1)*INCFD) lies between
+C zero and 3*SLOPE(N-1), the interpolant will be monotonic.
+C This is **NOT** checked if IEND.GT.0 .
+C 3. If IEND.LT.0 and D(1+(N-1)*INCFD) had to be changed to
+C achieve monotonicity, a warning error is returned.
+C
+C VC -- (input) real*8 array of length 2 specifying desired boundary
+C values, as indicated above.
+C VC(1) need be set only if IC(1) = 1 or 2 .
+C VC(2) need be set only if IC(2) = 1 or 2 .
+C
+C SWITCH -- (input) indicates desired treatment of points where
+C direction of monotonicity switches:
+C Set SWITCH to zero if interpolant is required to be mono-
+C tonic in each interval, regardless of monotonicity of data.
+C NOTES:
+C 1. This will cause D to be set to zero at all switch
+C points, thus forcing extrema there.
+C 2. The result of using this option with the default boun-
+C dary conditions will be identical to using DPCHIM, but
+C will generally cost more compute time.
+C This option is provided only to facilitate comparison
+C of different switch and/or boundary conditions.
+C Set SWITCH nonzero to use a formula based on the 3-point
+C difference formula in the vicinity of switch points.
+C If SWITCH is positive, the interpolant on each interval
+C containing an extremum is controlled to not deviate from
+C the data by more than SWITCH*DFLOC, where DFLOC is the
+C maximum of the change of F on this interval and its two
+C immediate neighbors.
+C If SWITCH is negative, no such control is to be imposed.
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C
+C X -- (input) real*8 array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real*8 array of dependent variable values to be
+C interpolated. F(1+(I-1)*INCFD) is value corresponding to
+C X(I).
+C
+C D -- (output) real*8 array of derivative values at the data
+C points. These values will determine a monotone cubic
+C Hermite function on each subinterval on which the data
+C are monotonic, except possibly adjacent to switches in
+C monotonicity. The value corresponding to X(I) is stored in
+C D(1+(I-1)*INCFD), I=1(1)N.
+C No other entries in D are changed.
+C
+C INCFD -- (input) increment between successive values in F and D.
+C This argument is provided primarily for 2-D applications.
+C (Error return if INCFD.LT.1 .)
+C
+C WK -- (scratch) real*8 array of working storage. The user may
+C wish to know that the returned values are:
+C WK(I) = H(I) = X(I+1) - X(I) ;
+C WK(N-1+I) = SLOPE(I) = (F(1,I+1) - F(1,I)) / H(I)
+C for I = 1(1)N-1.
+C
+C NWK -- (input) length of work array.
+C (Error return if NWK.LT.2*(N-1) .)
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C Warning errors:
+C IERR = 1 if IBEG.LT.0 and D(1) had to be adjusted for
+C monotonicity.
+C IERR = 2 if IEND.LT.0 and D(1+(N-1)*INCFD) had to be
+C adjusted for monotonicity.
+C IERR = 3 if both of the above are true.
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C IERR = -4 if ABS(IBEG).GT.5 .
+C IERR = -5 if ABS(IEND).GT.5 .
+C IERR = -6 if both of the above are true.
+C IERR = -7 if NWK.LT.2*(N-1) .
+C (The D-array has not been changed in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C
+C***REFERENCES 1. F. N. Fritsch, Piecewise Cubic Hermite Interpolation
+C Package, Report UCRL-87285, Lawrence Livermore Natio-
+C nal Laboratory, July 1982. [Poster presented at the
+C SIAM 30th Anniversary Meeting, 19-23 July 1982.]
+C 2. F. N. Fritsch and J. Butland, A method for construc-
+C ting local monotone piecewise cubic interpolants, SIAM
+C Journal on Scientific and Statistical Computing 5, 2
+C (June 1984), pp. 300-304.
+C 3. F. N. Fritsch and R. E. Carlson, Monotone piecewise
+C cubic interpolation, SIAM Journal on Numerical Ana-
+C lysis 17, 2 (April 1980), pp. 238-246.
+C***ROUTINES CALLED DPCHCE, DPCHCI, DPCHCS, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820218 DATE WRITTEN
+C 820804 Converted to SLATEC library version.
+C 870707 Corrected XERROR calls for d.p. name(s).
+C 870813 Updated Reference 2.
+C 890206 Corrected XERROR calls.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890703 Corrected category record. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 891006 Cosmetic changes to prologue. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 920429 Revised format and order of references. (WRB,FNF)
+C***END PROLOGUE DPCHIC
+C Programming notes:
+C
+C To produce a single precision version, simply:
+C a. Change DPCHIC to PCHIC wherever it occurs,
+C b. Change DPCHCE to PCHCE wherever it occurs,
+C c. Change DPCHCI to PCHCI wherever it occurs,
+C d. Change DPCHCS to PCHCS wherever it occurs,
+C e. Change the double precision declarations to real, and
+C f. Change the constant ZERO to single precision.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER IC(2), N, INCFD, NWK, IERR
+ DOUBLE PRECISION VC(2), SWITCH, X(*), F(INCFD,*), D(INCFD,*),
+ * WK(NWK)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, IBEG, IEND, NLESS1
+ DOUBLE PRECISION ZERO
+ SAVE ZERO
+ DATA ZERO /0.D0/
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT DPCHIC
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+C
+ IBEG = IC(1)
+ IEND = IC(2)
+ IERR = 0
+ IF (ABS(IBEG) .GT. 5) IERR = IERR - 1
+ IF (ABS(IEND) .GT. 5) IERR = IERR - 2
+ IF (IERR .LT. 0) GO TO 5004
+C
+C FUNCTION DEFINITION IS OK -- GO ON.
+C
+ NLESS1 = N - 1
+ IF ( NWK .LT. 2*NLESS1 ) GO TO 5007
+C
+C SET UP H AND SLOPE ARRAYS.
+C
+ DO 20 I = 1, NLESS1
+ WK(I) = X(I+1) - X(I)
+ WK(NLESS1+I) = (F(1,I+1) - F(1,I)) / WK(I)
+ 20 CONTINUE
+C
+C SPECIAL CASE N=2 -- USE LINEAR INTERPOLATION.
+C
+ IF (NLESS1 .GT. 1) GO TO 1000
+ D(1,1) = WK(2)
+ D(1,N) = WK(2)
+ GO TO 3000
+C
+C NORMAL CASE (N .GE. 3) .
+C
+ 1000 CONTINUE
+C
+C SET INTERIOR DERIVATIVES AND DEFAULT END CONDITIONS.
+C
+C --------------------------------------
+ CALL DPCHCI (N, WK(1), WK(N), D, INCFD)
+C --------------------------------------
+C
+C SET DERIVATIVES AT POINTS WHERE MONOTONICITY SWITCHES DIRECTION.
+C
+ IF (SWITCH .EQ. ZERO) GO TO 3000
+C ----------------------------------------------------
+ CALL DPCHCS (SWITCH, N, WK(1), WK(N), D, INCFD, IERR)
+C ----------------------------------------------------
+ IF (IERR .NE. 0) GO TO 5008
+C
+C SET END CONDITIONS.
+C
+ 3000 CONTINUE
+ IF ( (IBEG.EQ.0) .AND. (IEND.EQ.0) ) GO TO 5000
+C -------------------------------------------------------
+ CALL DPCHCE (IC, VC, N, X, WK(1), WK(N), D, INCFD, IERR)
+C -------------------------------------------------------
+ IF (IERR .LT. 0) GO TO 5009
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DPCHIC',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'DPCHIC', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ RETURN
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'DPCHIC',
+ + 'X-ARRAY NOT STRICTLY INCREASING', IERR, 1)
+ RETURN
+C
+ 5004 CONTINUE
+C IC OUT OF RANGE RETURN.
+ IERR = IERR - 3
+ CALL XERMSG ('SLATEC', 'DPCHIC', 'IC OUT OF RANGE', IERR, 1)
+ RETURN
+C
+ 5007 CONTINUE
+C NWK .LT. 2*(N-1) RETURN.
+ IERR = -7
+ CALL XERMSG ('SLATEC', 'DPCHIC', 'WORK ARRAY TOO SMALL', IERR, 1)
+ RETURN
+C
+ 5008 CONTINUE
+C ERROR RETURN FROM DPCHCS.
+ IERR = -8
+ CALL XERMSG ('SLATEC', 'DPCHIC', 'ERROR RETURN FROM DPCHCS',
+ + IERR, 1)
+ RETURN
+C
+ 5009 CONTINUE
+C ERROR RETURN FROM DPCHCE.
+C *** THIS CASE SHOULD NEVER OCCUR ***
+ IERR = -9
+ CALL XERMSG ('SLATEC', 'DPCHIC', 'ERROR RETURN FROM DPCHCE',
+ + IERR, 1)
+ RETURN
+C------------- LAST LINE OF DPCHIC FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchid.f b/Lib/Slatec/slatec/dpchid.f
new file mode 100644
index 0000000..47e231c
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchid.f
@@ -0,0 +1,195 @@
+*DECK DPCHID
+ DOUBLE PRECISION FUNCTION DPCHID (N, X, F, D, INCFD, SKIP, IA, IB,
+ + IERR)
+C***BEGIN PROLOGUE DPCHID
+C***PURPOSE Evaluate the definite integral of a piecewise cubic
+C Hermite function over an interval whose endpoints are data
+C points.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3, H2A1B2
+C***TYPE DOUBLE PRECISION (PCHID-S, DPCHID-D)
+C***KEYWORDS CUBIC HERMITE INTERPOLATION, NUMERICAL INTEGRATION, PCHIP,
+C QUADRATURE
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C DPCHID: Piecewise Cubic Hermite Integrator, Data limits
+C
+C Evaluates the definite integral of the cubic Hermite function
+C defined by N, X, F, D over the interval [X(IA), X(IB)].
+C
+C To provide compatibility with DPCHIM and DPCHIC, includes an
+C increment between successive values of the F- and D-arrays.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, IA, IB, IERR
+C DOUBLE PRECISION X(N), F(INCFD,N), D(INCFD,N)
+C LOGICAL SKIP
+C
+C VALUE = DPCHID (N, X, F, D, INCFD, SKIP, IA, IB, IERR)
+C
+C Parameters:
+C
+C VALUE -- (output) value of the requested integral.
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C
+C X -- (input) real*8 array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real*8 array of function values. F(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C D -- (input) real*8 array of derivative values. D(1+(I-1)*INCFD)
+C is the value corresponding to X(I).
+C
+C INCFD -- (input) increment between successive values in F and D.
+C (Error return if INCFD.LT.1 .)
+C
+C SKIP -- (input/output) logical variable which should be set to
+C .TRUE. if the user wishes to skip checks for validity of
+C preceding parameters, or to .FALSE. otherwise.
+C This will save time in case these checks have already
+C been performed (say, in DPCHIM or DPCHIC).
+C SKIP will be set to .TRUE. on return with IERR = 0 or -4.
+C
+C IA,IB -- (input) indices in X-array for the limits of integration.
+C both must be in the range [1,N]. (Error return if not.)
+C No restrictions on their relative values.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C IERR = -4 if IA or IB is out of range.
+C (VALUE will be zero in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820723 DATE WRITTEN
+C 820804 Converted to SLATEC library version.
+C 870707 Corrected XERROR calls for d.p. name(s).
+C 870813 Minor cosmetic changes.
+C 890206 Corrected XERROR calls.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890703 Corrected category record. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 891006 Cosmetic changes to prologue. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 930504 Corrected to set VALUE=0 when IERR.ne.0. (FNF)
+C***END PROLOGUE DPCHID
+C
+C Programming notes:
+C 1. This routine uses a special formula that is valid only for
+C integrals whose limits coincide with data values. This is
+C mathematically equivalent to, but much more efficient than,
+C calls to DCHFIE.
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, IA, IB, IERR
+ DOUBLE PRECISION X(*), F(INCFD,*), D(INCFD,*)
+ LOGICAL SKIP
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, IUP, LOW
+ DOUBLE PRECISION H, HALF, SIX, SUM, VALUE, ZERO
+ SAVE ZERO, HALF, SIX
+C
+C INITIALIZE.
+C
+ DATA ZERO /0.D0/, HALF/.5D0/, SIX/6.D0/
+C***FIRST EXECUTABLE STATEMENT DPCHID
+ VALUE = ZERO
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+ IF (SKIP) GO TO 5
+C
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+C
+C FUNCTION DEFINITION IS OK, GO ON.
+C
+ 5 CONTINUE
+ SKIP = .TRUE.
+ IF ((IA.LT.1) .OR. (IA.GT.N)) GO TO 5004
+ IF ((IB.LT.1) .OR. (IB.GT.N)) GO TO 5004
+ IERR = 0
+C
+C COMPUTE INTEGRAL VALUE.
+C
+ IF (IA .NE. IB) THEN
+ LOW = MIN(IA, IB)
+ IUP = MAX(IA, IB) - 1
+ SUM = ZERO
+ DO 10 I = LOW, IUP
+ H = X(I+1) - X(I)
+ SUM = SUM + H*( (F(1,I) + F(1,I+1)) +
+ * (D(1,I) - D(1,I+1))*(H/SIX) )
+ 10 CONTINUE
+ VALUE = HALF * SUM
+ IF (IA .GT. IB) VALUE = -VALUE
+ ENDIF
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ DPCHID = VALUE
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DPCHID',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ GO TO 5000
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'DPCHID', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ GO TO 5000
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'DPCHID',
+ + 'X-ARRAY NOT STRICTLY INCREASING', IERR, 1)
+ GO TO 5000
+C
+ 5004 CONTINUE
+C IA OR IB OUT OF RANGE RETURN.
+ IERR = -4
+ CALL XERMSG ('SLATEC', 'DPCHID', 'IA OR IB OUT OF RANGE', IERR,
+ + 1)
+ GO TO 5000
+C------------- LAST LINE OF DPCHID FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchim.f b/Lib/Slatec/slatec/dpchim.f
new file mode 100644
index 0000000..a391b21
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchim.f
@@ -0,0 +1,283 @@
+*DECK DPCHIM
+ SUBROUTINE DPCHIM (N, X, F, D, INCFD, IERR)
+C***BEGIN PROLOGUE DPCHIM
+C***PURPOSE Set derivatives needed to determine a monotone piecewise
+C cubic Hermite interpolant to given data. Boundary values
+C are provided which are compatible with monotonicity. The
+C interpolant will have an extremum at each point where mono-
+C tonicity switches direction. (See DPCHIC if user control
+C is desired over boundary or switch conditions.)
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E1A
+C***TYPE DOUBLE PRECISION (PCHIM-S, DPCHIM-D)
+C***KEYWORDS CUBIC HERMITE INTERPOLATION, MONOTONE INTERPOLATION,
+C PCHIP, PIECEWISE CUBIC INTERPOLATION
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C DPCHIM: Piecewise Cubic Hermite Interpolation to
+C Monotone data.
+C
+C Sets derivatives needed to determine a monotone piecewise cubic
+C Hermite interpolant to the data given in X and F.
+C
+C Default boundary conditions are provided which are compatible
+C with monotonicity. (See DPCHIC if user control of boundary con-
+C ditions is desired.)
+C
+C If the data are only piecewise monotonic, the interpolant will
+C have an extremum at each point where monotonicity switches direc-
+C tion. (See DPCHIC if user control is desired in such cases.)
+C
+C To facilitate two-dimensional applications, includes an increment
+C between successive values of the F- and D-arrays.
+C
+C The resulting piecewise cubic Hermite function may be evaluated
+C by DPCHFE or DPCHFD.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, IERR
+C DOUBLE PRECISION X(N), F(INCFD,N), D(INCFD,N)
+C
+C CALL DPCHIM (N, X, F, D, INCFD, IERR)
+C
+C Parameters:
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C If N=2, simply does linear interpolation.
+C
+C X -- (input) real*8 array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real*8 array of dependent variable values to be
+C interpolated. F(1+(I-1)*INCFD) is value corresponding to
+C X(I). DPCHIM is designed for monotonic data, but it will
+C work for any F-array. It will force extrema at points where
+C monotonicity switches direction. If some other treatment of
+C switch points is desired, DPCHIC should be used instead.
+C -----
+C D -- (output) real*8 array of derivative values at the data
+C points. If the data are monotonic, these values will
+C determine a monotone cubic Hermite function.
+C The value corresponding to X(I) is stored in
+C D(1+(I-1)*INCFD), I=1(1)N.
+C No other entries in D are changed.
+C
+C INCFD -- (input) increment between successive values in F and D.
+C This argument is provided primarily for 2-D applications.
+C (Error return if INCFD.LT.1 .)
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C Warning error:
+C IERR.GT.0 means that IERR switches in the direction
+C of monotonicity were detected.
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C (The D-array has not been changed in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C
+C***REFERENCES 1. F. N. Fritsch and J. Butland, A method for construc-
+C ting local monotone piecewise cubic interpolants, SIAM
+C Journal on Scientific and Statistical Computing 5, 2
+C (June 1984), pp. 300-304.
+C 2. F. N. Fritsch and R. E. Carlson, Monotone piecewise
+C cubic interpolation, SIAM Journal on Numerical Ana-
+C lysis 17, 2 (April 1980), pp. 238-246.
+C***ROUTINES CALLED DPCHST, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 811103 DATE WRITTEN
+C 820201 1. Introduced DPCHST to reduce possible over/under-
+C flow problems.
+C 2. Rearranged derivative formula for same reason.
+C 820602 1. Modified end conditions to be continuous functions
+C of data when monotonicity switches in next interval.
+C 2. Modified formulas so end conditions are less prone
+C of over/underflow problems.
+C 820803 Minor cosmetic changes for release 1.
+C 870707 Corrected XERROR calls for d.p. name(s).
+C 870813 Updated Reference 1.
+C 890206 Corrected XERROR calls.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890703 Corrected category record. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 891006 Cosmetic changes to prologue. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 920429 Revised format and order of references. (WRB,FNF)
+C***END PROLOGUE DPCHIM
+C Programming notes:
+C
+C 1. The function DPCHST(ARG1,ARG2) is assumed to return zero if
+C either argument is zero, +1 if they are of the same sign, and
+C -1 if they are of opposite sign.
+C 2. To produce a single precision version, simply:
+C a. Change DPCHIM to PCHIM wherever it occurs,
+C b. Change DPCHST to PCHST wherever it occurs,
+C c. Change all references to the Fortran intrinsics to their
+C single precision equivalents,
+C d. Change the double precision declarations to real, and
+C e. Change the constants ZERO and THREE to single precision.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, IERR
+ DOUBLE PRECISION X(*), F(INCFD,*), D(INCFD,*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, NLESS1
+ DOUBLE PRECISION DEL1, DEL2, DMAX, DMIN, DRAT1, DRAT2, DSAVE,
+ * H1, H2, HSUM, HSUMT3, THREE, W1, W2, ZERO
+ SAVE ZERO, THREE
+ DOUBLE PRECISION DPCHST
+ DATA ZERO /0.D0/, THREE/3.D0/
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT DPCHIM
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+C
+C FUNCTION DEFINITION IS OK, GO ON.
+C
+ IERR = 0
+ NLESS1 = N - 1
+ H1 = X(2) - X(1)
+ DEL1 = (F(1,2) - F(1,1))/H1
+ DSAVE = DEL1
+C
+C SPECIAL CASE N=2 -- USE LINEAR INTERPOLATION.
+C
+ IF (NLESS1 .GT. 1) GO TO 10
+ D(1,1) = DEL1
+ D(1,N) = DEL1
+ GO TO 5000
+C
+C NORMAL CASE (N .GE. 3).
+C
+ 10 CONTINUE
+ H2 = X(3) - X(2)
+ DEL2 = (F(1,3) - F(1,2))/H2
+C
+C SET D(1) VIA NON-CENTERED THREE-POINT FORMULA, ADJUSTED TO BE
+C SHAPE-PRESERVING.
+C
+ HSUM = H1 + H2
+ W1 = (H1 + HSUM)/HSUM
+ W2 = -H1/HSUM
+ D(1,1) = W1*DEL1 + W2*DEL2
+ IF ( DPCHST(D(1,1),DEL1) .LE. ZERO) THEN
+ D(1,1) = ZERO
+ ELSE IF ( DPCHST(DEL1,DEL2) .LT. ZERO) THEN
+C NEED DO THIS CHECK ONLY IF MONOTONICITY SWITCHES.
+ DMAX = THREE*DEL1
+ IF (ABS(D(1,1)) .GT. ABS(DMAX)) D(1,1) = DMAX
+ ENDIF
+C
+C LOOP THROUGH INTERIOR POINTS.
+C
+ DO 50 I = 2, NLESS1
+ IF (I .EQ. 2) GO TO 40
+C
+ H1 = H2
+ H2 = X(I+1) - X(I)
+ HSUM = H1 + H2
+ DEL1 = DEL2
+ DEL2 = (F(1,I+1) - F(1,I))/H2
+ 40 CONTINUE
+C
+C SET D(I)=0 UNLESS DATA ARE STRICTLY MONOTONIC.
+C
+ D(1,I) = ZERO
+ IF ( DPCHST(DEL1,DEL2) ) 42, 41, 45
+C
+C COUNT NUMBER OF CHANGES IN DIRECTION OF MONOTONICITY.
+C
+ 41 CONTINUE
+ IF (DEL2 .EQ. ZERO) GO TO 50
+ IF ( DPCHST(DSAVE,DEL2) .LT. ZERO) IERR = IERR + 1
+ DSAVE = DEL2
+ GO TO 50
+C
+ 42 CONTINUE
+ IERR = IERR + 1
+ DSAVE = DEL2
+ GO TO 50
+C
+C USE BRODLIE MODIFICATION OF BUTLAND FORMULA.
+C
+ 45 CONTINUE
+ HSUMT3 = HSUM+HSUM+HSUM
+ W1 = (HSUM + H1)/HSUMT3
+ W2 = (HSUM + H2)/HSUMT3
+ DMAX = MAX( ABS(DEL1), ABS(DEL2) )
+ DMIN = MIN( ABS(DEL1), ABS(DEL2) )
+ DRAT1 = DEL1/DMAX
+ DRAT2 = DEL2/DMAX
+ D(1,I) = DMIN/(W1*DRAT1 + W2*DRAT2)
+C
+ 50 CONTINUE
+C
+C SET D(N) VIA NON-CENTERED THREE-POINT FORMULA, ADJUSTED TO BE
+C SHAPE-PRESERVING.
+C
+ W1 = -H2/HSUM
+ W2 = (H2 + HSUM)/HSUM
+ D(1,N) = W1*DEL1 + W2*DEL2
+ IF ( DPCHST(D(1,N),DEL2) .LE. ZERO) THEN
+ D(1,N) = ZERO
+ ELSE IF ( DPCHST(DEL1,DEL2) .LT. ZERO) THEN
+C NEED DO THIS CHECK ONLY IF MONOTONICITY SWITCHES.
+ DMAX = THREE*DEL2
+ IF (ABS(D(1,N)) .GT. ABS(DMAX)) D(1,N) = DMAX
+ ENDIF
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DPCHIM',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'DPCHIM', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ RETURN
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'DPCHIM',
+ + 'X-ARRAY NOT STRICTLY INCREASING', IERR, 1)
+ RETURN
+C------------- LAST LINE OF DPCHIM FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchkt.f b/Lib/Slatec/slatec/dpchkt.f
new file mode 100644
index 0000000..634609b
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchkt.f
@@ -0,0 +1,96 @@
+*DECK DPCHKT
+ SUBROUTINE DPCHKT (N, X, KNOTYP, T)
+C***BEGIN PROLOGUE DPCHKT
+C***SUBSIDIARY
+C***PURPOSE Compute B-spline knot sequence for DPCHBS.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3
+C***TYPE DOUBLE PRECISION (PCHKT-S, DPCHKT-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C Set a knot sequence for the B-spline representation of a PCH
+C function with breakpoints X. All knots will be at least double.
+C Endknots are set as:
+C (1) quadruple knots at endpoints if KNOTYP=0;
+C (2) extrapolate the length of end interval if KNOTYP=1;
+C (3) periodic if KNOTYP=2.
+C
+C Input arguments: N, X, KNOTYP.
+C Output arguments: T.
+C
+C Restrictions/assumptions:
+C 1. N.GE.2 . (not checked)
+C 2. X(i).LT.X(i+1), i=1,...,N . (not checked)
+C 3. 0.LE.KNOTYP.LE.2 . (Acts like KNOTYP=0 for any other value.)
+C
+C***SEE ALSO DPCHBS
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 870701 DATE WRITTEN
+C 900405 Converted Fortran to upper case.
+C 900410 Converted prologue to SLATEC 4.0 format.
+C 900410 Minor cosmetic changes.
+C 900430 Produced double precision version.
+C 930514 Changed NKNOTS from an output to an input variable. (FNF)
+C 930604 Removed unused variable NKNOTS from argument list. (FNF)
+C***END PROLOGUE DPCHKT
+C
+C*Internal Notes:
+C
+C Since this is subsidiary to DPCHBS, which validates its input before
+C calling, it is unnecessary for such validation to be done here.
+C
+C**End
+C
+C Declare arguments.
+C
+ INTEGER N, KNOTYP
+ DOUBLE PRECISION X(*), T(*)
+C
+C Declare local variables.
+C
+ INTEGER J, K, NDIM
+ DOUBLE PRECISION HBEG, HEND
+C***FIRST EXECUTABLE STATEMENT DPCHKT
+C
+C Initialize.
+C
+ NDIM = 2*N
+C
+C Set interior knots.
+C
+ J = 1
+ DO 20 K = 1, N
+ J = J + 2
+ T(J) = X(K)
+ T(J+1) = T(J)
+ 20 CONTINUE
+C Assertion: At this point T(3),...,T(NDIM+2) have been set and
+C J=NDIM+1.
+C
+C Set end knots according to KNOTYP.
+C
+ HBEG = X(2) - X(1)
+ HEND = X(N) - X(N-1)
+ IF (KNOTYP.EQ.1 ) THEN
+C Extrapolate.
+ T(2) = X(1) - HBEG
+ T(NDIM+3) = X(N) + HEND
+ ELSE IF ( KNOTYP.EQ.2 ) THEN
+C Periodic.
+ T(2) = X(1) - HEND
+ T(NDIM+3) = X(N) + HBEG
+ ELSE
+C Quadruple end knots.
+ T(2) = X(1)
+ T(NDIM+3) = X(N)
+ ENDIF
+ T(1) = T(2)
+ T(NDIM+4) = T(NDIM+3)
+C
+C Terminate.
+C
+ RETURN
+C------------- LAST LINE OF DPCHKT FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchsp.f b/Lib/Slatec/slatec/dpchsp.f
new file mode 100644
index 0000000..244d152
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchsp.f
@@ -0,0 +1,392 @@
+*DECK DPCHSP
+ SUBROUTINE DPCHSP (IC, VC, N, X, F, D, INCFD, WK, NWK, IERR)
+C***BEGIN PROLOGUE DPCHSP
+C***PURPOSE Set derivatives needed to determine the Hermite represen-
+C tation of the cubic spline interpolant to given data, with
+C specified boundary conditions.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E1A
+C***TYPE DOUBLE PRECISION (PCHSP-S, DPCHSP-D)
+C***KEYWORDS CUBIC HERMITE INTERPOLATION, PCHIP,
+C PIECEWISE CUBIC INTERPOLATION, SPLINE INTERPOLATION
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C DPCHSP: Piecewise Cubic Hermite Spline
+C
+C Computes the Hermite representation of the cubic spline inter-
+C polant to the data given in X and F satisfying the boundary
+C conditions specified by IC and VC.
+C
+C To facilitate two-dimensional applications, includes an increment
+C between successive values of the F- and D-arrays.
+C
+C The resulting piecewise cubic Hermite function may be evaluated
+C by DPCHFE or DPCHFD.
+C
+C NOTE: This is a modified version of C. de Boor's cubic spline
+C routine CUBSPL.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER IC(2), N, NWK, IERR
+C DOUBLE PRECISION VC(2), X(N), F(INCFD,N), D(INCFD,N), WK(NWK)
+C
+C CALL DPCHSP (IC, VC, N, X, F, D, INCFD, WK, NWK, IERR)
+C
+C Parameters:
+C
+C IC -- (input) integer array of length 2 specifying desired
+C boundary conditions:
+C IC(1) = IBEG, desired condition at beginning of data.
+C IC(2) = IEND, desired condition at end of data.
+C
+C IBEG = 0 to set D(1) so that the third derivative is con-
+C tinuous at X(2). This is the "not a knot" condition
+C provided by de Boor's cubic spline routine CUBSPL.
+C < This is the default boundary condition. >
+C IBEG = 1 if first derivative at X(1) is given in VC(1).
+C IBEG = 2 if second derivative at X(1) is given in VC(1).
+C IBEG = 3 to use the 3-point difference formula for D(1).
+C (Reverts to the default b.c. if N.LT.3 .)
+C IBEG = 4 to use the 4-point difference formula for D(1).
+C (Reverts to the default b.c. if N.LT.4 .)
+C NOTES:
+C 1. An error return is taken if IBEG is out of range.
+C 2. For the "natural" boundary condition, use IBEG=2 and
+C VC(1)=0.
+C
+C IEND may take on the same values as IBEG, but applied to
+C derivative at X(N). In case IEND = 1 or 2, the value is
+C given in VC(2).
+C
+C NOTES:
+C 1. An error return is taken if IEND is out of range.
+C 2. For the "natural" boundary condition, use IEND=2 and
+C VC(2)=0.
+C
+C VC -- (input) real*8 array of length 2 specifying desired boundary
+C values, as indicated above.
+C VC(1) need be set only if IC(1) = 1 or 2 .
+C VC(2) need be set only if IC(2) = 1 or 2 .
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C
+C X -- (input) real*8 array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real*8 array of dependent variable values to be
+C interpolated. F(1+(I-1)*INCFD) is value corresponding to
+C X(I).
+C
+C D -- (output) real*8 array of derivative values at the data
+C points. These values will determine the cubic spline
+C interpolant with the requested boundary conditions.
+C The value corresponding to X(I) is stored in
+C D(1+(I-1)*INCFD), I=1(1)N.
+C No other entries in D are changed.
+C
+C INCFD -- (input) increment between successive values in F and D.
+C This argument is provided primarily for 2-D applications.
+C (Error return if INCFD.LT.1 .)
+C
+C WK -- (scratch) real*8 array of working storage.
+C
+C NWK -- (input) length of work array.
+C (Error return if NWK.LT.2*N .)
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C IERR = -4 if IBEG.LT.0 or IBEG.GT.4 .
+C IERR = -5 if IEND.LT.0 of IEND.GT.4 .
+C IERR = -6 if both of the above are true.
+C IERR = -7 if NWK is too small.
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C (The D-array has not been changed in any of these cases.)
+C IERR = -8 in case of trouble solving the linear system
+C for the interior derivative values.
+C (The D-array may have been changed in this case.)
+C ( Do **NOT** use it! )
+C
+C***REFERENCES Carl de Boor, A Practical Guide to Splines, Springer-
+C Verlag, New York, 1978, pp. 53-59.
+C***ROUTINES CALLED DPCHDF, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820503 DATE WRITTEN
+C 820804 Converted to SLATEC library version.
+C 870707 Corrected XERROR calls for d.p. name(s).
+C 890206 Corrected XERROR calls.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890703 Corrected category record. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 891006 Cosmetic changes to prologue. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 920429 Revised format and order of references. (WRB,FNF)
+C***END PROLOGUE DPCHSP
+C Programming notes:
+C
+C To produce a single precision version, simply:
+C a. Change DPCHSP to PCHSP wherever it occurs,
+C b. Change the double precision declarations to real, and
+C c. Change the constants ZERO, HALF, ... to single precision.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER IC(2), N, INCFD, NWK, IERR
+ DOUBLE PRECISION VC(2), X(*), F(INCFD,*), D(INCFD,*), WK(2,*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER IBEG, IEND, INDEX, J, NM1
+ DOUBLE PRECISION G, HALF, ONE, STEMP(3), THREE, TWO, XTEMP(4),
+ * ZERO
+ SAVE ZERO, HALF, ONE, TWO, THREE
+ DOUBLE PRECISION DPCHDF
+C
+ DATA ZERO /0.D0/, HALF/.5D0/, ONE/1.D0/, TWO/2.D0/, THREE/3.D0/
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT DPCHSP
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 J = 2, N
+ IF ( X(J).LE.X(J-1) ) GO TO 5003
+ 1 CONTINUE
+C
+ IBEG = IC(1)
+ IEND = IC(2)
+ IERR = 0
+ IF ( (IBEG.LT.0).OR.(IBEG.GT.4) ) IERR = IERR - 1
+ IF ( (IEND.LT.0).OR.(IEND.GT.4) ) IERR = IERR - 2
+ IF ( IERR.LT.0 ) GO TO 5004
+C
+C FUNCTION DEFINITION IS OK -- GO ON.
+C
+ IF ( NWK .LT. 2*N ) GO TO 5007
+C
+C COMPUTE FIRST DIFFERENCES OF X SEQUENCE AND STORE IN WK(1,.). ALSO,
+C COMPUTE FIRST DIVIDED DIFFERENCE OF DATA AND STORE IN WK(2,.).
+ DO 5 J=2,N
+ WK(1,J) = X(J) - X(J-1)
+ WK(2,J) = (F(1,J) - F(1,J-1))/WK(1,J)
+ 5 CONTINUE
+C
+C SET TO DEFAULT BOUNDARY CONDITIONS IF N IS TOO SMALL.
+C
+ IF ( IBEG.GT.N ) IBEG = 0
+ IF ( IEND.GT.N ) IEND = 0
+C
+C SET UP FOR BOUNDARY CONDITIONS.
+C
+ IF ( (IBEG.EQ.1).OR.(IBEG.EQ.2) ) THEN
+ D(1,1) = VC(1)
+ ELSE IF (IBEG .GT. 2) THEN
+C PICK UP FIRST IBEG POINTS, IN REVERSE ORDER.
+ DO 10 J = 1, IBEG
+ INDEX = IBEG-J+1
+C INDEX RUNS FROM IBEG DOWN TO 1.
+ XTEMP(J) = X(INDEX)
+ IF (J .LT. IBEG) STEMP(J) = WK(2,INDEX)
+ 10 CONTINUE
+C --------------------------------
+ D(1,1) = DPCHDF (IBEG, XTEMP, STEMP, IERR)
+C --------------------------------
+ IF (IERR .NE. 0) GO TO 5009
+ IBEG = 1
+ ENDIF
+C
+ IF ( (IEND.EQ.1).OR.(IEND.EQ.2) ) THEN
+ D(1,N) = VC(2)
+ ELSE IF (IEND .GT. 2) THEN
+C PICK UP LAST IEND POINTS.
+ DO 15 J = 1, IEND
+ INDEX = N-IEND+J
+C INDEX RUNS FROM N+1-IEND UP TO N.
+ XTEMP(J) = X(INDEX)
+ IF (J .LT. IEND) STEMP(J) = WK(2,INDEX+1)
+ 15 CONTINUE
+C --------------------------------
+ D(1,N) = DPCHDF (IEND, XTEMP, STEMP, IERR)
+C --------------------------------
+ IF (IERR .NE. 0) GO TO 5009
+ IEND = 1
+ ENDIF
+C
+C --------------------( BEGIN CODING FROM CUBSPL )--------------------
+C
+C **** A TRIDIAGONAL LINEAR SYSTEM FOR THE UNKNOWN SLOPES S(J) OF
+C F AT X(J), J=1,...,N, IS GENERATED AND THEN SOLVED BY GAUSS ELIM-
+C INATION, WITH S(J) ENDING UP IN D(1,J), ALL J.
+C WK(1,.) AND WK(2,.) ARE USED FOR TEMPORARY STORAGE.
+C
+C CONSTRUCT FIRST EQUATION FROM FIRST BOUNDARY CONDITION, OF THE FORM
+C WK(2,1)*S(1) + WK(1,1)*S(2) = D(1,1)
+C
+ IF (IBEG .EQ. 0) THEN
+ IF (N .EQ. 2) THEN
+C NO CONDITION AT LEFT END AND N = 2.
+ WK(2,1) = ONE
+ WK(1,1) = ONE
+ D(1,1) = TWO*WK(2,2)
+ ELSE
+C NOT-A-KNOT CONDITION AT LEFT END AND N .GT. 2.
+ WK(2,1) = WK(1,3)
+ WK(1,1) = WK(1,2) + WK(1,3)
+ D(1,1) =((WK(1,2) + TWO*WK(1,1))*WK(2,2)*WK(1,3)
+ * + WK(1,2)**2*WK(2,3)) / WK(1,1)
+ ENDIF
+ ELSE IF (IBEG .EQ. 1) THEN
+C SLOPE PRESCRIBED AT LEFT END.
+ WK(2,1) = ONE
+ WK(1,1) = ZERO
+ ELSE
+C SECOND DERIVATIVE PRESCRIBED AT LEFT END.
+ WK(2,1) = TWO
+ WK(1,1) = ONE
+ D(1,1) = THREE*WK(2,2) - HALF*WK(1,2)*D(1,1)
+ ENDIF
+C
+C IF THERE ARE INTERIOR KNOTS, GENERATE THE CORRESPONDING EQUATIONS AND
+C CARRY OUT THE FORWARD PASS OF GAUSS ELIMINATION, AFTER WHICH THE J-TH
+C EQUATION READS WK(2,J)*S(J) + WK(1,J)*S(J+1) = D(1,J).
+C
+ NM1 = N-1
+ IF (NM1 .GT. 1) THEN
+ DO 20 J=2,NM1
+ IF (WK(2,J-1) .EQ. ZERO) GO TO 5008
+ G = -WK(1,J+1)/WK(2,J-1)
+ D(1,J) = G*D(1,J-1)
+ * + THREE*(WK(1,J)*WK(2,J+1) + WK(1,J+1)*WK(2,J))
+ WK(2,J) = G*WK(1,J-1) + TWO*(WK(1,J) + WK(1,J+1))
+ 20 CONTINUE
+ ENDIF
+C
+C CONSTRUCT LAST EQUATION FROM SECOND BOUNDARY CONDITION, OF THE FORM
+C (-G*WK(2,N-1))*S(N-1) + WK(2,N)*S(N) = D(1,N)
+C
+C IF SLOPE IS PRESCRIBED AT RIGHT END, ONE CAN GO DIRECTLY TO BACK-
+C SUBSTITUTION, SINCE ARRAYS HAPPEN TO BE SET UP JUST RIGHT FOR IT
+C AT THIS POINT.
+ IF (IEND .EQ. 1) GO TO 30
+C
+ IF (IEND .EQ. 0) THEN
+ IF (N.EQ.2 .AND. IBEG.EQ.0) THEN
+C NOT-A-KNOT AT RIGHT ENDPOINT AND AT LEFT ENDPOINT AND N = 2.
+ D(1,2) = WK(2,2)
+ GO TO 30
+ ELSE IF ((N.EQ.2) .OR. (N.EQ.3 .AND. IBEG.EQ.0)) THEN
+C EITHER (N=3 AND NOT-A-KNOT ALSO AT LEFT) OR (N=2 AND *NOT*
+C NOT-A-KNOT AT LEFT END POINT).
+ D(1,N) = TWO*WK(2,N)
+ WK(2,N) = ONE
+ IF (WK(2,N-1) .EQ. ZERO) GO TO 5008
+ G = -ONE/WK(2,N-1)
+ ELSE
+C NOT-A-KNOT AND N .GE. 3, AND EITHER N.GT.3 OR ALSO NOT-A-
+C KNOT AT LEFT END POINT.
+ G = WK(1,N-1) + WK(1,N)
+C DO NOT NEED TO CHECK FOLLOWING DENOMINATORS (X-DIFFERENCES).
+ D(1,N) = ((WK(1,N)+TWO*G)*WK(2,N)*WK(1,N-1)
+ * + WK(1,N)**2*(F(1,N-1)-F(1,N-2))/WK(1,N-1))/G
+ IF (WK(2,N-1) .EQ. ZERO) GO TO 5008
+ G = -G/WK(2,N-1)
+ WK(2,N) = WK(1,N-1)
+ ENDIF
+ ELSE
+C SECOND DERIVATIVE PRESCRIBED AT RIGHT ENDPOINT.
+ D(1,N) = THREE*WK(2,N) + HALF*WK(1,N)*D(1,N)
+ WK(2,N) = TWO
+ IF (WK(2,N-1) .EQ. ZERO) GO TO 5008
+ G = -ONE/WK(2,N-1)
+ ENDIF
+C
+C COMPLETE FORWARD PASS OF GAUSS ELIMINATION.
+C
+ WK(2,N) = G*WK(1,N-1) + WK(2,N)
+ IF (WK(2,N) .EQ. ZERO) GO TO 5008
+ D(1,N) = (G*D(1,N-1) + D(1,N))/WK(2,N)
+C
+C CARRY OUT BACK SUBSTITUTION
+C
+ 30 CONTINUE
+ DO 40 J=NM1,1,-1
+ IF (WK(2,J) .EQ. ZERO) GO TO 5008
+ D(1,J) = (D(1,J) - WK(1,J)*D(1,J+1))/WK(2,J)
+ 40 CONTINUE
+C --------------------( END CODING FROM CUBSPL )--------------------
+C
+C NORMAL RETURN.
+C
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DPCHSP',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'DPCHSP', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ RETURN
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'DPCHSP',
+ + 'X-ARRAY NOT STRICTLY INCREASING', IERR, 1)
+ RETURN
+C
+ 5004 CONTINUE
+C IC OUT OF RANGE RETURN.
+ IERR = IERR - 3
+ CALL XERMSG ('SLATEC', 'DPCHSP', 'IC OUT OF RANGE', IERR, 1)
+ RETURN
+C
+ 5007 CONTINUE
+C NWK TOO SMALL RETURN.
+ IERR = -7
+ CALL XERMSG ('SLATEC', 'DPCHSP', 'WORK ARRAY TOO SMALL', IERR, 1)
+ RETURN
+C
+ 5008 CONTINUE
+C SINGULAR SYSTEM.
+C *** THEORETICALLY, THIS CAN ONLY OCCUR IF SUCCESSIVE X-VALUES ***
+C *** ARE EQUAL, WHICH SHOULD ALREADY HAVE BEEN CAUGHT (IERR=-3). ***
+ IERR = -8
+ CALL XERMSG ('SLATEC', 'DPCHSP', 'SINGULAR LINEAR SYSTEM', IERR,
+ + 1)
+ RETURN
+C
+ 5009 CONTINUE
+C ERROR RETURN FROM DPCHDF.
+C *** THIS CASE SHOULD NEVER OCCUR ***
+ IERR = -9
+ CALL XERMSG ('SLATEC', 'DPCHSP', 'ERROR RETURN FROM DPCHDF',
+ + IERR, 1)
+ RETURN
+C------------- LAST LINE OF DPCHSP FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchst.f b/Lib/Slatec/slatec/dpchst.f
new file mode 100644
index 0000000..9fc3894
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchst.f
@@ -0,0 +1,59 @@
+*DECK DPCHST
+ DOUBLE PRECISION FUNCTION DPCHST (ARG1, ARG2)
+C***BEGIN PROLOGUE DPCHST
+C***SUBSIDIARY
+C***PURPOSE DPCHIP Sign-Testing Routine
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE DOUBLE PRECISION (PCHST-S, DPCHST-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C DPCHST: DPCHIP Sign-Testing Routine.
+C
+C
+C Returns:
+C -1. if ARG1 and ARG2 are of opposite sign.
+C 0. if either argument is zero.
+C +1. if ARG1 and ARG2 are of the same sign.
+C
+C The object is to do this without multiplying ARG1*ARG2, to avoid
+C possible over/underflow problems.
+C
+C Fortran intrinsics used: SIGN.
+C
+C***SEE ALSO DPCHCE, DPCHCI, DPCHCS, DPCHIM
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 811103 DATE WRITTEN
+C 820805 Converted to SLATEC library version.
+C 870813 Minor cosmetic changes.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890531 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR and DATE WRITTEN sections in prologue. (WRB)
+C 930503 Improved purpose. (FNF)
+C***END PROLOGUE DPCHST
+C
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ DOUBLE PRECISION ARG1, ARG2
+C
+C DECLARE LOCAL VARIABLES.
+C
+ DOUBLE PRECISION ONE, ZERO
+ SAVE ZERO, ONE
+ DATA ZERO /0.D0/, ONE/1.D0/
+C
+C PERFORM THE TEST.
+C
+C***FIRST EXECUTABLE STATEMENT DPCHST
+ DPCHST = SIGN(ONE,ARG1) * SIGN(ONE,ARG2)
+ IF ((ARG1.EQ.ZERO) .OR. (ARG2.EQ.ZERO)) DPCHST = ZERO
+C
+ RETURN
+C------------- LAST LINE OF DPCHST FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpchsw.f b/Lib/Slatec/slatec/dpchsw.f
new file mode 100644
index 0000000..1960f93
--- /dev/null
+++ b/Lib/Slatec/slatec/dpchsw.f
@@ -0,0 +1,197 @@
+*DECK DPCHSW
+ SUBROUTINE DPCHSW (DFMAX, IEXTRM, D1, D2, H, SLOPE, IERR)
+C***BEGIN PROLOGUE DPCHSW
+C***SUBSIDIARY
+C***PURPOSE Limits excursion from data for DPCHCS
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE DOUBLE PRECISION (PCHSW-S, DPCHSW-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C DPCHSW: DPCHCS Switch Excursion Limiter.
+C
+C Called by DPCHCS to adjust D1 and D2 if necessary to insure that
+C the extremum on this interval is not further than DFMAX from the
+C extreme data value.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C INTEGER IEXTRM, IERR
+C DOUBLE PRECISION DFMAX, D1, D2, H, SLOPE
+C
+C CALL DPCHSW (DFMAX, IEXTRM, D1, D2, H, SLOPE, IERR)
+C
+C Parameters:
+C
+C DFMAX -- (input) maximum allowed difference between F(IEXTRM) and
+C the cubic determined by derivative values D1,D2. (assumes
+C DFMAX.GT.0.)
+C
+C IEXTRM -- (input) index of the extreme data value. (assumes
+C IEXTRM = 1 or 2 . Any value .NE.1 is treated as 2.)
+C
+C D1,D2 -- (input) derivative values at the ends of the interval.
+C (Assumes D1*D2 .LE. 0.)
+C (output) may be modified if necessary to meet the restriction
+C imposed by DFMAX.
+C
+C H -- (input) interval length. (Assumes H.GT.0.)
+C
+C SLOPE -- (input) data slope on the interval.
+C
+C IERR -- (output) error flag. should be zero.
+C If IERR=-1, assumption on D1 and D2 is not satisfied.
+C If IERR=-2, quadratic equation locating extremum has
+C negative discriminant (should never occur).
+C
+C -------
+C WARNING: This routine does no validity-checking of arguments.
+C -------
+C
+C Fortran intrinsics used: ABS, SIGN, SQRT.
+C
+C***SEE ALSO DPCHCS
+C***ROUTINES CALLED D1MACH, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820218 DATE WRITTEN
+C 820805 Converted to SLATEC library version.
+C 870707 Corrected XERROR calls for d.p. name(s).
+C 870707 Replaced DATA statement for SMALL with a use of D1MACH.
+C 870813 Minor cosmetic changes.
+C 890206 Corrected XERROR calls.
+C 890411 1. Added SAVE statements (Vers. 3.2).
+C 2. Added DOUBLE PRECISION declaration for D1MACH.
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890531 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR and DATE WRITTEN sections in prologue. (WRB)
+C 920526 Eliminated possible divide by zero problem. (FNF)
+C 930503 Improved purpose. (FNF)
+C***END PROLOGUE DPCHSW
+C
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER IEXTRM, IERR
+ DOUBLE PRECISION DFMAX, D1, D2, H, SLOPE
+C
+C DECLARE LOCAL VARIABLES.
+C
+ DOUBLE PRECISION CP, FACT, HPHI, LAMBDA, NU, ONE, PHI, RADCAL,
+ * RHO, SIGMA, SMALL, THAT, THIRD, THREE, TWO, ZERO
+ SAVE ZERO, ONE, TWO, THREE, FACT
+ SAVE THIRD
+ DOUBLE PRECISION D1MACH
+C
+ DATA ZERO /0.D0/, ONE /1.D0/, TWO /2.D0/, THREE /3.D0/,
+ * FACT /100.D0/
+C THIRD SHOULD BE SLIGHTLY LESS THAN 1/3.
+ DATA THIRD /0.33333D0/
+C
+C NOTATION AND GENERAL REMARKS.
+C
+C RHO IS THE RATIO OF THE DATA SLOPE TO THE DERIVATIVE BEING TESTED.
+C LAMBDA IS THE RATIO OF D2 TO D1.
+C THAT = T-HAT(RHO) IS THE NORMALIZED LOCATION OF THE EXTREMUM.
+C PHI IS THE NORMALIZED VALUE OF P(X)-F1 AT X = XHAT = X-HAT(RHO),
+C WHERE THAT = (XHAT - X1)/H .
+C THAT IS, P(XHAT)-F1 = D*H*PHI, WHERE D=D1 OR D2.
+C SIMILARLY, P(XHAT)-F2 = D*H*(PHI-RHO) .
+C
+C SMALL SHOULD BE A FEW ORDERS OF MAGNITUDE GREATER THAN MACHEPS.
+C***FIRST EXECUTABLE STATEMENT DPCHSW
+ SMALL = FACT*D1MACH(4)
+C
+C DO MAIN CALCULATION.
+C
+ IF (D1 .EQ. ZERO) THEN
+C
+C SPECIAL CASE -- D1.EQ.ZERO .
+C
+C IF D2 IS ALSO ZERO, THIS ROUTINE SHOULD NOT HAVE BEEN CALLED.
+ IF (D2 .EQ. ZERO) GO TO 5001
+C
+ RHO = SLOPE/D2
+C EXTREMUM IS OUTSIDE INTERVAL WHEN RHO .GE. 1/3 .
+ IF (RHO .GE. THIRD) GO TO 5000
+ THAT = (TWO*(THREE*RHO-ONE)) / (THREE*(TWO*RHO-ONE))
+ PHI = THAT**2 * ((THREE*RHO-ONE)/THREE)
+C
+C CONVERT TO DISTANCE FROM F2 IF IEXTRM.NE.1 .
+ IF (IEXTRM .NE. 1) PHI = PHI - RHO
+C
+C TEST FOR EXCEEDING LIMIT, AND ADJUST ACCORDINGLY.
+ HPHI = H * ABS(PHI)
+ IF (HPHI*ABS(D2) .GT. DFMAX) THEN
+C AT THIS POINT, HPHI.GT.0, SO DIVIDE IS OK.
+ D2 = SIGN (DFMAX/HPHI, D2)
+ ENDIF
+ ELSE
+C
+ RHO = SLOPE/D1
+ LAMBDA = -D2/D1
+ IF (D2 .EQ. ZERO) THEN
+C
+C SPECIAL CASE -- D2.EQ.ZERO .
+C
+C EXTREMUM IS OUTSIDE INTERVAL WHEN RHO .GE. 1/3 .
+ IF (RHO .GE. THIRD) GO TO 5000
+ CP = TWO - THREE*RHO
+ NU = ONE - TWO*RHO
+ THAT = ONE / (THREE*NU)
+ ELSE
+ IF (LAMBDA .LE. ZERO) GO TO 5001
+C
+C NORMAL CASE -- D1 AND D2 BOTH NONZERO, OPPOSITE SIGNS.
+C
+ NU = ONE - LAMBDA - TWO*RHO
+ SIGMA = ONE - RHO
+ CP = NU + SIGMA
+ IF (ABS(NU) .GT. SMALL) THEN
+ RADCAL = (NU - (TWO*RHO+ONE))*NU + SIGMA**2
+ IF (RADCAL .LT. ZERO) GO TO 5002
+ THAT = (CP - SQRT(RADCAL)) / (THREE*NU)
+ ELSE
+ THAT = ONE/(TWO*SIGMA)
+ ENDIF
+ ENDIF
+ PHI = THAT*((NU*THAT - CP)*THAT + ONE)
+C
+C CONVERT TO DISTANCE FROM F2 IF IEXTRM.NE.1 .
+ IF (IEXTRM .NE. 1) PHI = PHI - RHO
+C
+C TEST FOR EXCEEDING LIMIT, AND ADJUST ACCORDINGLY.
+ HPHI = H * ABS(PHI)
+ IF (HPHI*ABS(D1) .GT. DFMAX) THEN
+C AT THIS POINT, HPHI.GT.0, SO DIVIDE IS OK.
+ D1 = SIGN (DFMAX/HPHI, D1)
+ D2 = -LAMBDA*D1
+ ENDIF
+ ENDIF
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ IERR = 0
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C D1 AND D2 BOTH ZERO, OR BOTH NONZERO AND SAME SIGN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'DPCHSW', 'D1 AND/OR D2 INVALID', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C NEGATIVE VALUE OF RADICAL (SHOULD NEVER OCCUR).
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'DPCHSW', 'NEGATIVE RADICAL', IERR, 1)
+ RETURN
+C------------- LAST LINE OF DPCHSW FOLLOWS -----------------------------
+ END
diff --git a/Lib/Slatec/slatec/dpcoef.f b/Lib/Slatec/slatec/dpcoef.f
new file mode 100644
index 0000000..074a342
--- /dev/null
+++ b/Lib/Slatec/slatec/dpcoef.f
@@ -0,0 +1,78 @@
+*DECK DPCOEF
+ SUBROUTINE DPCOEF (L, C, TC, A)
+C***BEGIN PROLOGUE DPCOEF
+C***PURPOSE Convert the DPOLFT coefficients to Taylor series form.
+C***LIBRARY SLATEC
+C***CATEGORY K1A1A2
+C***TYPE DOUBLE PRECISION (PCOEF-S, DPCOEF-D)
+C***KEYWORDS CURVE FITTING, DATA FITTING, LEAST SQUARES, POLYNOMIAL FIT
+C***AUTHOR Shampine, L. F., (SNLA)
+C Davenport, S. M., (SNLA)
+C***DESCRIPTION
+C
+C Abstract
+C
+C DPOLFT computes the least squares polynomial fit of degree L as
+C a sum of orthogonal polynomials. DPCOEF changes this fit to its
+C Taylor expansion about any point C , i.e. writes the polynomial
+C as a sum of powers of (X-C). Taking C=0. gives the polynomial
+C in powers of X, but a suitable non-zero C often leads to
+C polynomials which are better scaled and more accurately evaluated.
+C
+C The parameters for DPCOEF are
+C
+C INPUT -- All TYPE REAL variables are DOUBLE PRECISION
+C L - Indicates the degree of polynomial to be changed to
+C its Taylor expansion. To obtain the Taylor
+C coefficients in reverse order, input L as the
+C negative of the degree desired. The absolute value
+C of L must be less than or equal to NDEG, the highest
+C degree polynomial fitted by DPOLFT .
+C C - The point about which the Taylor expansion is to be
+C made.
+C A - Work and output array containing values from last
+C call to DPOLFT .
+C
+C OUTPUT -- All TYPE REAL variables are DOUBLE PRECISION
+C TC - Vector containing the first LL+1 Taylor coefficients
+C where LL=ABS(L). If L.GT.0 , the coefficients are
+C in the usual Taylor series order, i.e.
+C P(X) = TC(1) + TC(2)*(X-C) + ... + TC(N+1)*(X-C)**N
+C If L .LT. 0, the coefficients are in reverse order,
+C i.e.
+C P(X) = TC(1)*(X-C)**N + ... + TC(N)*(X-C) + TC(N+1)
+C
+C***REFERENCES L. F. Shampine, S. M. Davenport and R. E. Huddleston,
+C Curve fitting by polynomials in one variable, Report
+C SLA-74-0270, Sandia Laboratories, June 1974.
+C***ROUTINES CALLED DP1VLU
+C***REVISION HISTORY (YYMMDD)
+C 740601 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 891006 Cosmetic changes to prologue. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DPCOEF
+C
+ INTEGER I,L,LL,LLP1,LLP2,NEW,NR
+ DOUBLE PRECISION A(*),C,FAC,SAVE,TC(*)
+C***FIRST EXECUTABLE STATEMENT DPCOEF
+ LL = ABS(L)
+ LLP1 = LL + 1
+ CALL DP1VLU (LL,LL,C,TC(1),TC(2),A)
+ IF (LL .LT. 2) GO TO 2
+ FAC = 1.0D0
+ DO 1 I = 3,LLP1
+ FAC = FAC*(I-1)
+ 1 TC(I) = TC(I)/FAC
+ 2 IF (L .GE. 0) GO TO 4
+ NR = LLP1/2
+ LLP2 = LL + 2
+ DO 3 I = 1,NR
+ SAVE = TC(I)
+ NEW = LLP2 - I
+ TC(I) = TC(NEW)
+ 3 TC(NEW) = SAVE
+ 4 RETURN
+ END
diff --git a/Lib/Slatec/slatec/dpoco.f b/Lib/Slatec/slatec/dpoco.f
new file mode 100644
index 0000000..ebde804
--- /dev/null
+++ b/Lib/Slatec/slatec/dpoco.f
@@ -0,0 +1,208 @@
+*DECK DPOCO
+ SUBROUTINE DPOCO (A, LDA, N, RCOND, Z, INFO)
+C***BEGIN PROLOGUE DPOCO
+C***PURPOSE Factor a real symmetric positive definite matrix
+C and estimate the condition of the matrix.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2B1B
+C***TYPE DOUBLE PRECISION (SPOCO-S, DPOCO-D, CPOCO-C)
+C***KEYWORDS CONDITION NUMBER, LINEAR ALGEBRA, LINPACK,
+C MATRIX FACTORIZATION, POSITIVE DEFINITE
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C DPOCO factors a double precision symmetric positive definite
+C matrix and estimates the condition of the matrix.
+C
+C If RCOND is not needed, DPOFA is slightly faster.
+C To solve A*X = B , follow DPOCO by DPOSL.
+C To compute INVERSE(A)*C , follow DPOCO by DPOSL.
+C To compute DETERMINANT(A) , follow DPOCO by DPODI.
+C To compute INVERSE(A) , follow DPOCO by DPODI.
+C
+C On Entry
+C
+C A DOUBLE PRECISION(LDA, N)
+C the symmetric matrix to be factored. Only the
+C diagonal and upper triangle are used.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C On Return
+C
+C A an upper triangular matrix R so that A = TRANS(R)*R
+C where TRANS(R) is the transpose.
+C The strict lower triangle is unaltered.
+C If INFO .NE. 0 , the factorization is not complete.
+C
+C RCOND DOUBLE PRECISION
+C an estimate of the reciprocal condition of A .
+C For the system A*X = B , relative perturbations
+C in A and B of size EPSILON may cause
+C relative perturbations in X of size EPSILON/RCOND .
+C If RCOND is so small that the logical expression
+C 1.0 + RCOND .EQ. 1.0
+C is true, then A may be singular to working
+C precision. In particular, RCOND is zero if
+C exact singularity is detected or the estimate
+C underflows. If INFO .NE. 0 , RCOND is unchanged.
+C
+C Z DOUBLE PRECISION(N)
+C a work vector whose contents are usually unimportant.
+C If A is close to a singular matrix, then Z is
+C an approximate null vector in the sense that
+C NORM(A*Z) = RCOND*NORM(A)*NORM(Z) .
+C If INFO .NE. 0 , Z is unchanged.
+C
+C INFO INTEGER
+C = 0 for normal return.
+C = K signals an error condition. The leading minor
+C of order K is not positive definite.
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED DASUM, DAXPY, DDOT, DPOFA, DSCAL
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DPOCO
+ INTEGER LDA,N,INFO
+ DOUBLE PRECISION A(LDA,*),Z(*)
+ DOUBLE PRECISION RCOND
+C
+ DOUBLE PRECISION DDOT,EK,T,WK,WKM
+ DOUBLE PRECISION ANORM,S,DASUM,SM,YNORM
+ INTEGER I,J,JM1,K,KB,KP1
+C
+C FIND NORM OF A USING ONLY UPPER HALF
+C
+C***FIRST EXECUTABLE STATEMENT DPOCO
+ DO 30 J = 1, N
+ Z(J) = DASUM(J,A(1,J),1)
+ JM1 = J - 1
+ IF (JM1 .LT. 1) GO TO 20
+ DO 10 I = 1, JM1
+ Z(I) = Z(I) + ABS(A(I,J))
+ 10 CONTINUE
+ 20 CONTINUE
+ 30 CONTINUE
+ ANORM = 0.0D0
+ DO 40 J = 1, N
+ ANORM = MAX(ANORM,Z(J))
+ 40 CONTINUE
+C
+C FACTOR
+C
+ CALL DPOFA(A,LDA,N,INFO)
+ IF (INFO .NE. 0) GO TO 180
+C
+C RCOND = 1/(NORM(A)*(ESTIMATE OF NORM(INVERSE(A)))) .
+C ESTIMATE = NORM(Z)/NORM(Y) WHERE A*Z = Y AND A*Y = E .
+C THE COMPONENTS OF E ARE CHOSEN TO CAUSE MAXIMUM LOCAL
+C GROWTH IN THE ELEMENTS OF W WHERE TRANS(R)*W = E .
+C THE VECTORS ARE FREQUENTLY RESCALED TO AVOID OVERFLOW.
+C
+C SOLVE TRANS(R)*W = E
+C
+ EK = 1.0D0
+ DO 50 J = 1, N
+ Z(J) = 0.0D0
+ 50 CONTINUE
+ DO 110 K = 1, N
+ IF (Z(K) .NE. 0.0D0) EK = SIGN(EK,-Z(K))
+ IF (ABS(EK-Z(K)) .LE. A(K,K)) GO TO 60
+ S = A(K,K)/ABS(EK-Z(K))
+ CALL DSCAL(N,S,Z,1)
+ EK = S*EK
+ 60 CONTINUE
+ WK = EK - Z(K)
+ WKM = -EK - Z(K)
+ S = ABS(WK)
+ SM = ABS(WKM)
+ WK = WK/A(K,K)
+ WKM = WKM/A(K,K)
+ KP1 = K + 1
+ IF (KP1 .GT. N) GO TO 100
+ DO 70 J = KP1, N
+ SM = SM + ABS(Z(J)+WKM*A(K,J))
+ Z(J) = Z(J) + WK*A(K,J)
+ S = S + ABS(Z(J))
+ 70 CONTINUE
+ IF (S .GE. SM) GO TO 90
+ T = WKM - WK
+ WK = WKM
+ DO 80 J = KP1, N
+ Z(J) = Z(J) + T*A(K,J)
+ 80 CONTINUE
+ 90 CONTINUE
+ 100 CONTINUE
+ Z(K) = WK
+ 110 CONTINUE
+ S = 1.0D0/DASUM(N,Z,1)
+ CALL DSCAL(N,S,Z,1)
+C
+C SOLVE R*Y = W
+C
+ DO 130 KB = 1, N
+ K = N + 1 - KB
+ IF (ABS(Z(K)) .LE. A(K,K)) GO TO 120
+ S = A(K,K)/ABS(Z(K))
+ CALL DSCAL(N,S,Z,1)
+ 120 CONTINUE
+ Z(K) = Z(K)/A(K,K)
+ T = -Z(K)
+ CALL DAXPY(K-1,T,A(1,K),1,Z(1),1)
+ 130 CONTINUE
+ S = 1.0D0/DASUM(N,Z,1)
+ CALL DSCAL(N,S,Z,1)
+C
+ YNORM = 1.0D0
+C
+C SOLVE TRANS(R)*V = Y
+C
+ DO 150 K = 1, N
+ Z(K) = Z(K) - DDOT(K-1,A(1,K),1,Z(1),1)
+ IF (ABS(Z(K)) .LE. A(K,K)) GO TO 140
+ S = A(K,K)/ABS(Z(K))
+ CALL DSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+ 140 CONTINUE
+ Z(K) = Z(K)/A(K,K)
+ 150 CONTINUE
+ S = 1.0D0/DASUM(N,Z,1)
+ CALL DSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+C
+C SOLVE R*Z = V
+C
+ DO 170 KB = 1, N
+ K = N + 1 - KB
+ IF (ABS(Z(K)) .LE. A(K,K)) GO TO 160
+ S = A(K,K)/ABS(Z(K))
+ CALL DSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+ 160 CONTINUE
+ Z(K) = Z(K)/A(K,K)
+ T = -Z(K)
+ CALL DAXPY(K-1,T,A(1,K),1,Z(1),1)
+ 170 CONTINUE
+C MAKE ZNORM = 1.0
+ S = 1.0D0/DASUM(N,Z,1)
+ CALL DSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+C
+ IF (ANORM .NE. 0.0D0) RCOND = YNORM/ANORM
+ IF (ANORM .EQ. 0.0D0) RCOND = 0.0D0
+ 180 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/dpodi.f b/Lib/Slatec/slatec/dpodi.f
new file mode 100644
index 0000000..ce2a745
--- /dev/null
+++ b/Lib/Slatec/slatec/dpodi.f
@@ -0,0 +1,136 @@
+*DECK DPODI
+ SUBROUTINE DPODI (A, LDA, N, DET, JOB)
+C***BEGIN PROLOGUE DPODI
+C***PURPOSE Compute the determinant and inverse of a certain real
+C symmetric positive definite matrix using the factors
+C computed by DPOCO, DPOFA or DQRDC.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2B1B, D3B1B
+C***TYPE DOUBLE PRECISION (SPODI-S, DPODI-D, CPODI-C)
+C***KEYWORDS DETERMINANT, INVERSE, LINEAR ALGEBRA, LINPACK, MATRIX,
+C POSITIVE DEFINITE
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C DPODI computes the determinant and inverse of a certain
+C double precision symmetric positive definite matrix (see below)
+C using the factors computed by DPOCO, DPOFA or DQRDC.
+C
+C On Entry
+C
+C A DOUBLE PRECISION(LDA, N)
+C the output A from DPOCO or DPOFA
+C or the output X from DQRDC.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C JOB INTEGER
+C = 11 both determinant and inverse.
+C = 01 inverse only.
+C = 10 determinant only.
+C
+C On Return
+C
+C A If DPOCO or DPOFA was used to factor A , then
+C DPODI produces the upper half of INVERSE(A) .
+C If DQRDC was used to decompose X , then
+C DPODI produces the upper half of inverse(TRANS(X)*X)
+C where TRANS(X) is the transpose.
+C Elements of A below the diagonal are unchanged.
+C If the units digit of JOB is zero, A is unchanged.
+C
+C DET DOUBLE PRECISION(2)
+C determinant of A or of TRANS(X)*X if requested.
+C Otherwise not referenced.
+C Determinant = DET(1) * 10.0**DET(2)
+C with 1.0 .LE. DET(1) .LT. 10.0
+C or DET(1) .EQ. 0.0 .
+C
+C Error Condition
+C
+C A division by zero will occur if the input factor contains
+C a zero on the diagonal and the inverse is requested.
+C It will not occur if the subroutines are called correctly
+C and if DPOCO or DPOFA has set INFO .EQ. 0 .
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED DAXPY, DSCAL
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DPODI
+ INTEGER LDA,N,JOB
+ DOUBLE PRECISION A(LDA,*)
+ DOUBLE PRECISION DET(2)
+C
+ DOUBLE PRECISION T
+ DOUBLE PRECISION S
+ INTEGER I,J,JM1,K,KP1
+C***FIRST EXECUTABLE STATEMENT DPODI
+C
+C COMPUTE DETERMINANT
+C
+ IF (JOB/10 .EQ. 0) GO TO 70
+ DET(1) = 1.0D0
+ DET(2) = 0.0D0
+ S = 10.0D0
+ DO 50 I = 1, N
+ DET(1) = A(I,I)**2*DET(1)
+ IF (DET(1) .EQ. 0.0D0) GO TO 60
+ 10 IF (DET(1) .GE. 1.0D0) GO TO 20
+ DET(1) = S*DET(1)
+ DET(2) = DET(2) - 1.0D0
+ GO TO 10
+ 20 CONTINUE
+ 30 IF (DET(1) .LT. S) GO TO 40
+ DET(1) = DET(1)/S
+ DET(2) = DET(2) + 1.0D0
+ GO TO 30
+ 40 CONTINUE
+ 50 CONTINUE
+ 60 CONTINUE
+ 70 CONTINUE
+C
+C COMPUTE INVERSE(R)
+C
+ IF (MOD(JOB,10) .EQ. 0) GO TO 140
+ DO 100 K = 1, N
+ A(K,K) = 1.0D0/A(K,K)
+ T = -A(K,K)
+ CALL DSCAL(K-1,T,A(1,K),1)
+ KP1 = K + 1
+ IF (N .LT. KP1) GO TO 90
+ DO 80 J = KP1, N
+ T = A(K,J)
+ A(K,J) = 0.0D0
+ CALL DAXPY(K,T,A(1,K),1,A(1,J),1)
+ 80 CONTINUE
+ 90 CONTINUE
+ 100 CONTINUE
+C
+C FORM INVERSE(R) * TRANS(INVERSE(R))
+C
+ DO 130 J = 1, N
+ JM1 = J - 1
+ IF (JM1 .LT. 1) GO TO 120
+ DO 110 K = 1, JM1
+ T = A(K,J)
+ CALL DAXPY(K,T,A(1,J),1,A(1,K),1)
+ 110 CONTINUE
+ 120 CONTINUE
+ T = A(J,J)
+ CALL DSCAL(J,T,A(1,J),1)
+ 130 CONTINUE
+ 140 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/dpofa.f b/Lib/Slatec/slatec/dpofa.f
new file mode 100644
index 0000000..d8c9996
--- /dev/null
+++ b/Lib/Slatec/slatec/dpofa.f
@@ -0,0 +1,83 @@
+*DECK DPOFA
+ SUBROUTINE DPOFA (A, LDA, N, INFO)
+C***BEGIN PROLOGUE DPOFA
+C***PURPOSE Factor a real symmetric positive definite matrix.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2B1B
+C***TYPE DOUBLE PRECISION (SPOFA-S, DPOFA-D, CPOFA-C)
+C***KEYWORDS LINEAR ALGEBRA, LINPACK, MATRIX FACTORIZATION,
+C POSITIVE DEFINITE
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C DPOFA factors a double precision symmetric positive definite
+C matrix.
+C
+C DPOFA is usually called by DPOCO, but it can be called
+C directly with a saving in time if RCOND is not needed.
+C (time for DPOCO) = (1 + 18/N)*(time for DPOFA) .
+C
+C On Entry
+C
+C A DOUBLE PRECISION(LDA, N)
+C the symmetric matrix to be factored. Only the
+C diagonal and upper triangle are used.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C On Return
+C
+C A an upper triangular matrix R so that A = TRANS(R)*R
+C where TRANS(R) is the transpose.
+C The strict lower triangle is unaltered.
+C If INFO .NE. 0 , the factorization is not complete.
+C
+C INFO INTEGER
+C = 0 for normal return.
+C = K signals an error condition. The leading minor
+C of order K is not positive definite.
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED DDOT
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DPOFA
+ INTEGER LDA,N,INFO
+ DOUBLE PRECISION A(LDA,*)
+C
+ DOUBLE PRECISION DDOT,T
+ DOUBLE PRECISION S
+ INTEGER J,JM1,K
+C***FIRST EXECUTABLE STATEMENT DPOFA
+ DO 30 J = 1, N
+ INFO = J
+ S = 0.0D0
+ JM1 = J - 1
+ IF (JM1 .LT. 1) GO TO 20
+ DO 10 K = 1, JM1
+ T = A(K,J) - DDOT(K-1,A(1,K),1,A(1,J),1)
+ T = T/A(K,K)
+ A(K,J) = T
+ S = S + T*T
+ 10 CONTINUE
+ 20 CONTINUE
+ S = A(J,J) - S
+ IF (S .LE. 0.0D0) GO TO 40
+ A(J,J) = SQRT(S)
+ 30 CONTINUE
+ INFO = 0
+ 40 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/dpolft.f b/Lib/Slatec/slatec/dpolft.f
new file mode 100644
index 0000000..f51b59c
--- /dev/null
+++ b/Lib/Slatec/slatec/dpolft.f
@@ -0,0 +1,357 @@
+*DECK DPOLFT
+ SUBROUTINE DPOLFT (N, X, Y, W, MAXDEG, NDEG, EPS, R, IERR, A)
+C***BEGIN PROLOGUE DPOLFT
+C***PURPOSE Fit discrete data in a least squares sense by polynomials
+C in one variable.
+C***LIBRARY SLATEC
+C***CATEGORY K1A1A2
+C***TYPE DOUBLE PRECISION (POLFIT-S, DPOLFT-D)
+C***KEYWORDS CURVE FITTING, DATA FITTING, LEAST SQUARES, POLYNOMIAL FIT
+C***AUTHOR Shampine, L. F., (SNLA)
+C Davenport, S. M., (SNLA)
+C Huddleston, R. E., (SNLL)
+C***DESCRIPTION
+C
+C Abstract
+C
+C Given a collection of points X(I) and a set of values Y(I) which
+C correspond to some function or measurement at each of the X(I),
+C subroutine DPOLFT computes the weighted least-squares polynomial
+C fits of all degrees up to some degree either specified by the user
+C or determined by the routine. The fits thus obtained are in
+C orthogonal polynomial form. Subroutine DP1VLU may then be
+C called to evaluate the fitted polynomials and any of their
+C derivatives at any point. The subroutine DPCOEF may be used to
+C express the polynomial fits as powers of (X-C) for any specified
+C point C.
+C
+C The parameters for DPOLFT are
+C
+C Input -- All TYPE REAL variables are DOUBLE PRECISION
+C N - the number of data points. The arrays X, Y and W
+C must be dimensioned at least N (N .GE. 1).
+C X - array of values of the independent variable. These
+C values may appear in any order and need not all be
+C distinct.
+C Y - array of corresponding function values.
+C W - array of positive values to be used as weights. If
+C W(1) is negative, DPOLFT will set all the weights
+C to 1.0, which means unweighted least squares error
+C will be minimized. To minimize relative error, the
+C user should set the weights to: W(I) = 1.0/Y(I)**2,
+C I = 1,...,N .
+C MAXDEG - maximum degree to be allowed for polynomial fit.
+C MAXDEG may be any non-negative integer less than N.
+C Note -- MAXDEG cannot be equal to N-1 when a
+C statistical test is to be used for degree selection,
+C i.e., when input value of EPS is negative.
+C EPS - specifies the criterion to be used in determining
+C the degree of fit to be computed.
+C (1) If EPS is input negative, DPOLFT chooses the
+C degree based on a statistical F test of
+C significance. One of three possible
+C significance levels will be used: .01, .05 or
+C .10. If EPS=-1.0 , the routine will
+C automatically select one of these levels based
+C on the number of data points and the maximum
+C degree to be considered. If EPS is input as
+C -.01, -.05, or -.10, a significance level of
+C .01, .05, or .10, respectively, will be used.
+C (2) If EPS is set to 0., DPOLFT computes the
+C polynomials of degrees 0 through MAXDEG .
+C (3) If EPS is input positive, EPS is the RMS
+C error tolerance which must be satisfied by the
+C fitted polynomial. DPOLFT will increase the
+C degree of fit until this criterion is met or
+C until the maximum degree is reached.
+C
+C Output -- All TYPE REAL variables are DOUBLE PRECISION
+C NDEG - degree of the highest degree fit computed.
+C EPS - RMS error of the polynomial of degree NDEG .
+C R - vector of dimension at least NDEG containing values
+C of the fit of degree NDEG at each of the X(I) .
+C Except when the statistical test is used, these
+C values are more accurate than results from subroutine
+C DP1VLU normally are.
+C IERR - error flag with the following possible values.
+C 1 -- indicates normal execution, i.e., either
+C (1) the input value of EPS was negative, and the
+C computed polynomial fit of degree NDEG
+C satisfies the specified F test, or
+C (2) the input value of EPS was 0., and the fits of
+C all degrees up to MAXDEG are complete, or
+C (3) the input value of EPS was positive, and the
+C polynomial of degree NDEG satisfies the RMS
+C error requirement.
+C 2 -- invalid input parameter. At least one of the input
+C parameters has an illegal value and must be corrected
+C before DPOLFT can proceed. Valid input results
+C when the following restrictions are observed
+C N .GE. 1
+C 0 .LE. MAXDEG .LE. N-1 for EPS .GE. 0.
+C 0 .LE. MAXDEG .LE. N-2 for EPS .LT. 0.
+C W(1)=-1.0 or W(I) .GT. 0., I=1,...,N .
+C 3 -- cannot satisfy the RMS error requirement with a
+C polynomial of degree no greater than MAXDEG . Best
+C fit found is of degree MAXDEG .
+C 4 -- cannot satisfy the test for significance using
+C current value of MAXDEG . Statistically, the
+C best fit found is of order NORD . (In this case,
+C NDEG will have one of the values: MAXDEG-2,
+C MAXDEG-1, or MAXDEG). Using a higher value of
+C MAXDEG may result in passing the test.
+C A - work and output array having at least 3N+3MAXDEG+3
+C locations
+C
+C Note - DPOLFT calculates all fits of degrees up to and including
+C NDEG . Any or all of these fits can be evaluated or
+C expressed as powers of (X-C) using DP1VLU and DPCOEF
+C after just one call to DPOLFT .
+C
+C***REFERENCES L. F. Shampine, S. M. Davenport and R. E. Huddleston,
+C Curve fitting by polynomials in one variable, Report
+C SLA-74-0270, Sandia Laboratories, June 1974.
+C***ROUTINES CALLED DP1VLU, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 740601 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 891006 Cosmetic changes to prologue. (WRB)
+C 891006 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900911 Added variable YP to DOUBLE PRECISION declaration. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C 920527 Corrected erroneous statements in DESCRIPTION. (WRB)
+C***END PROLOGUE DPOLFT
+ INTEGER I,IDEGF,IERR,J,JP1,JPAS,K1,K1PJ,K2,K2PJ,K3,K3PI,K4,
+ * K4PI,K5,K5PI,KSIG,M,MAXDEG,MOP1,NDEG,NDER,NFAIL
+ DOUBLE PRECISION TEMD1,TEMD2
+ DOUBLE PRECISION A(*),DEGF,DEN,EPS,ETST,F,FCRIT,R(*),SIG,SIGJ,
+ * SIGJM1,SIGPAS,TEMP,X(*),XM,Y(*),YP,W(*),W1,W11
+ DOUBLE PRECISION CO(4,3)
+ SAVE CO
+ DATA CO(1,1), CO(2,1), CO(3,1), CO(4,1), CO(1,2), CO(2,2),
+ 1 CO(3,2), CO(4,2), CO(1,3), CO(2,3), CO(3,3),
+ 2 CO(4,3)/-13.086850D0,-2.4648165D0,-3.3846535D0,-1.2973162D0,
+ 3 -3.3381146D0,-1.7812271D0,-3.2578406D0,-1.6589279D0,
+ 4 -1.6282703D0,-1.3152745D0,-3.2640179D0,-1.9829776D0/
+C***FIRST EXECUTABLE STATEMENT DPOLFT
+ M = ABS(N)
+ IF (M .EQ. 0) GO TO 30
+ IF (MAXDEG .LT. 0) GO TO 30
+ A(1) = MAXDEG
+ MOP1 = MAXDEG + 1
+ IF (M .LT. MOP1) GO TO 30
+ IF (EPS .LT. 0.0D0 .AND. M .EQ. MOP1) GO TO 30
+ XM = M
+ ETST = EPS*EPS*XM
+ IF (W(1) .LT. 0.0D0) GO TO 2
+ DO 1 I = 1,M
+ IF (W(I) .LE. 0.0D0) GO TO 30
+ 1 CONTINUE
+ GO TO 4
+ 2 DO 3 I = 1,M
+ 3 W(I) = 1.0D0
+ 4 IF (EPS .GE. 0.0D0) GO TO 8
+C
+C DETERMINE SIGNIFICANCE LEVEL INDEX TO BE USED IN STATISTICAL TEST FOR
+C CHOOSING DEGREE OF POLYNOMIAL FIT
+C
+ IF (EPS .GT. (-.55D0)) GO TO 5
+ IDEGF = M - MAXDEG - 1
+ KSIG = 1
+ IF (IDEGF .LT. 10) KSIG = 2
+ IF (IDEGF .LT. 5) KSIG = 3
+ GO TO 8
+ 5 KSIG = 1
+ IF (EPS .LT. (-.03D0)) KSIG = 2
+ IF (EPS .LT. (-.07D0)) KSIG = 3
+C
+C INITIALIZE INDEXES AND COEFFICIENTS FOR FITTING
+C
+ 8 K1 = MAXDEG + 1
+ K2 = K1 + MAXDEG
+ K3 = K2 + MAXDEG + 2
+ K4 = K3 + M
+ K5 = K4 + M
+ DO 9 I = 2,K4
+ 9 A(I) = 0.0D0
+ W11 = 0.0D0
+ IF (N .LT. 0) GO TO 11
+C
+C UNCONSTRAINED CASE
+C
+ DO 10 I = 1,M
+ K4PI = K4 + I
+ A(K4PI) = 1.0D0
+ 10 W11 = W11 + W(I)
+ GO TO 13
+C
+C CONSTRAINED CASE
+C
+ 11 DO 12 I = 1,M
+ K4PI = K4 + I
+ 12 W11 = W11 + W(I)*A(K4PI)**2
+C
+C COMPUTE FIT OF DEGREE ZERO
+C
+ 13 TEMD1 = 0.0D0
+ DO 14 I = 1,M
+ K4PI = K4 + I
+ TEMD1 = TEMD1 + W(I)*Y(I)*A(K4PI)
+ 14 CONTINUE
+ TEMD1 = TEMD1/W11
+ A(K2+1) = TEMD1
+ SIGJ = 0.0D0
+ DO 15 I = 1,M
+ K4PI = K4 + I
+ K5PI = K5 + I
+ TEMD2 = TEMD1*A(K4PI)
+ R(I) = TEMD2
+ A(K5PI) = TEMD2 - R(I)
+ 15 SIGJ = SIGJ + W(I)*((Y(I)-R(I)) - A(K5PI))**2
+ J = 0
+C
+C SEE IF POLYNOMIAL OF DEGREE 0 SATISFIES THE DEGREE SELECTION CRITERION
+C
+ IF (EPS) 24,26,27
+C
+C INCREMENT DEGREE
+C
+ 16 J = J + 1
+ JP1 = J + 1
+ K1PJ = K1 + J
+ K2PJ = K2 + J
+ SIGJM1 = SIGJ
+C
+C COMPUTE NEW B COEFFICIENT EXCEPT WHEN J = 1
+C
+ IF (J .GT. 1) A(K1PJ) = W11/W1
+C
+C COMPUTE NEW A COEFFICIENT
+C
+ TEMD1 = 0.0D0
+ DO 18 I = 1,M
+ K4PI = K4 + I
+ TEMD2 = A(K4PI)
+ TEMD1 = TEMD1 + X(I)*W(I)*TEMD2*TEMD2
+ 18 CONTINUE
+ A(JP1) = TEMD1/W11
+C
+C EVALUATE ORTHOGONAL POLYNOMIAL AT DATA POINTS
+C
+ W1 = W11
+ W11 = 0.0D0
+ DO 19 I = 1,M
+ K3PI = K3 + I
+ K4PI = K4 + I
+ TEMP = A(K3PI)
+ A(K3PI) = A(K4PI)
+ A(K4PI) = (X(I)-A(JP1))*A(K3PI) - A(K1PJ)*TEMP
+ 19 W11 = W11 + W(I)*A(K4PI)**2
+C
+C GET NEW ORTHOGONAL POLYNOMIAL COEFFICIENT USING PARTIAL DOUBLE
+C PRECISION
+C
+ TEMD1 = 0.0D0
+ DO 20 I = 1,M
+ K4PI = K4 + I
+ K5PI = K5 + I
+ TEMD2 = W(I)*((Y(I)-R(I))-A(K5PI))*A(K4PI)
+ 20 TEMD1 = TEMD1 + TEMD2
+ TEMD1 = TEMD1/W11
+ A(K2PJ+1) = TEMD1
+C
+C UPDATE POLYNOMIAL EVALUATIONS AT EACH OF THE DATA POINTS, AND
+C ACCUMULATE SUM OF SQUARES OF ERRORS. THE POLYNOMIAL EVALUATIONS ARE
+C COMPUTED AND STORED IN EXTENDED PRECISION. FOR THE I-TH DATA POINT,
+C THE MOST SIGNIFICANT BITS ARE STORED IN R(I) , AND THE LEAST
+C SIGNIFICANT BITS ARE IN A(K5PI) .
+C
+ SIGJ = 0.0D0
+ DO 21 I = 1,M
+ K4PI = K4 + I
+ K5PI = K5 + I
+ TEMD2 = R(I) + A(K5PI) + TEMD1*A(K4PI)
+ R(I) = TEMD2
+ A(K5PI) = TEMD2 - R(I)
+ 21 SIGJ = SIGJ + W(I)*((Y(I)-R(I)) - A(K5PI))**2
+C
+C SEE IF DEGREE SELECTION CRITERION HAS BEEN SATISFIED OR IF DEGREE
+C MAXDEG HAS BEEN REACHED
+C
+ IF (EPS) 23,26,27
+C
+C COMPUTE F STATISTICS (INPUT EPS .LT. 0.)
+C
+ 23 IF (SIGJ .EQ. 0.0D0) GO TO 29
+ DEGF = M - J - 1
+ DEN = (CO(4,KSIG)*DEGF + 1.0D0)*DEGF
+ FCRIT = (((CO(3,KSIG)*DEGF) + CO(2,KSIG))*DEGF + CO(1,KSIG))/DEN
+ FCRIT = FCRIT*FCRIT
+ F = (SIGJM1 - SIGJ)*DEGF/SIGJ
+ IF (F .LT. FCRIT) GO TO 25
+C
+C POLYNOMIAL OF DEGREE J SATISFIES F TEST
+C
+ 24 SIGPAS = SIGJ
+ JPAS = J
+ NFAIL = 0
+ IF (MAXDEG .EQ. J) GO TO 32
+ GO TO 16
+C
+C POLYNOMIAL OF DEGREE J FAILS F TEST. IF THERE HAVE BEEN THREE
+C SUCCESSIVE FAILURES, A STATISTICALLY BEST DEGREE HAS BEEN FOUND.
+C
+ 25 NFAIL = NFAIL + 1
+ IF (NFAIL .GE. 3) GO TO 29
+ IF (MAXDEG .EQ. J) GO TO 32
+ GO TO 16
+C
+C RAISE THE DEGREE IF DEGREE MAXDEG HAS NOT YET BEEN REACHED (INPUT
+C EPS = 0.)
+C
+ 26 IF (MAXDEG .EQ. J) GO TO 28
+ GO TO 16
+C
+C SEE IF RMS ERROR CRITERION IS SATISFIED (INPUT EPS .GT. 0.)
+C
+ 27 IF (SIGJ .LE. ETST) GO TO 28
+ IF (MAXDEG .EQ. J) GO TO 31
+ GO TO 16
+C
+C RETURNS
+C
+ 28 IERR = 1
+ NDEG = J
+ SIG = SIGJ
+ GO TO 33
+ 29 IERR = 1
+ NDEG = JPAS
+ SIG = SIGPAS
+ GO TO 33
+ 30 IERR = 2
+ CALL XERMSG ('SLATEC', 'DPOLFT', 'INVALID INPUT PARAMETER.', 2,
+ + 1)
+ GO TO 37
+ 31 IERR = 3
+ NDEG = MAXDEG
+ SIG = SIGJ
+ GO TO 33
+ 32 IERR = 4
+ NDEG = JPAS
+ SIG = SIGPAS
+C
+ 33 A(K3) = NDEG
+C
+C WHEN STATISTICAL TEST HAS BEEN USED, EVALUATE THE BEST POLYNOMIAL AT
+C ALL THE DATA POINTS IF R DOES NOT ALREADY CONTAIN THESE VALUES
+C
+ IF(EPS .GE. 0.0 .OR. NDEG .EQ. MAXDEG) GO TO 36
+ NDER = 0
+ DO 35 I = 1,M
+ CALL DP1VLU (NDEG,NDER,X(I),R(I),YP,A)
+ 35 CONTINUE
+ 36 EPS = SQRT(SIG/XM)
+ 37 RETURN
+ END
diff --git a/Lib/Slatec/slatec/dscal.f b/Lib/Slatec/slatec/dscal.f
new file mode 100644
index 0000000..0c204c9
--- /dev/null
+++ b/Lib/Slatec/slatec/dscal.f
@@ -0,0 +1,80 @@
+*DECK DSCAL
+ SUBROUTINE DSCAL (N, DA, DX, INCX)
+C***BEGIN PROLOGUE DSCAL
+C***PURPOSE Multiply a vector by a constant.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A6
+C***TYPE DOUBLE PRECISION (SSCAL-S, DSCAL-D, CSCAL-C)
+C***KEYWORDS BLAS, LINEAR ALGEBRA, SCALE, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C DA double precision scale factor
+C DX double precision vector with N elements
+C INCX storage spacing between elements of DX
+C
+C --Output--
+C DX double precision result (unchanged if N.LE.0)
+C
+C Replace double precision DX by double precision DA*DX.
+C For I = 0 to N-1, replace DX(IX+I*INCX) with DA * DX(IX+I*INCX),
+C where IX = 1 if INCX .GE. 0, else IX = 1+(1-N)*INCX.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900821 Modified to correct problem with a negative increment.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DSCAL
+ DOUBLE PRECISION DA, DX(*)
+ INTEGER I, INCX, IX, M, MP1, N
+C***FIRST EXECUTABLE STATEMENT DSCAL
+ IF (N .LE. 0) RETURN
+ IF (INCX .EQ. 1) GOTO 20
+C
+C Code for increment not equal to 1.
+C
+ IX = 1
+ IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
+ DO 10 I = 1,N
+ DX(IX) = DA*DX(IX)
+ IX = IX + INCX
+ 10 CONTINUE
+ RETURN
+C
+C Code for increment equal to 1.
+C
+C Clean-up loop so remaining vector length is a multiple of 5.
+C
+ 20 M = MOD(N,5)
+ IF (M .EQ. 0) GOTO 40
+ DO 30 I = 1,M
+ DX(I) = DA*DX(I)
+ 30 CONTINUE
+ IF (N .LT. 5) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,5
+ DX(I) = DA*DX(I)
+ DX(I+1) = DA*DX(I+1)
+ DX(I+2) = DA*DX(I+2)
+ DX(I+3) = DA*DX(I+3)
+ DX(I+4) = DA*DX(I+4)
+ 50 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/dswap.f b/Lib/Slatec/slatec/dswap.f
new file mode 100644
index 0000000..441e601
--- /dev/null
+++ b/Lib/Slatec/slatec/dswap.f
@@ -0,0 +1,102 @@
+*DECK DSWAP
+ SUBROUTINE DSWAP (N, DX, INCX, DY, INCY)
+C***BEGIN PROLOGUE DSWAP
+C***PURPOSE Interchange two vectors.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A5
+C***TYPE DOUBLE PRECISION (SSWAP-S, DSWAP-D, CSWAP-C, ISWAP-I)
+C***KEYWORDS BLAS, INTERCHANGE, LINEAR ALGEBRA, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C DX double precision vector with N elements
+C INCX storage spacing between elements of DX
+C DY double precision vector with N elements
+C INCY storage spacing between elements of DY
+C
+C --Output--
+C DX input vector DY (unchanged if N .LE. 0)
+C DY input vector DX (unchanged if N .LE. 0)
+C
+C Interchange double precision DX and double precision DY.
+C For I = 0 to N-1, interchange DX(LX+I*INCX) and DY(LY+I*INCY),
+C where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
+C defined in a similar way using INCY.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920310 Corrected definition of LX in DESCRIPTION. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE DSWAP
+ DOUBLE PRECISION DX(*), DY(*), DTEMP1, DTEMP2, DTEMP3
+C***FIRST EXECUTABLE STATEMENT DSWAP
+ IF (N .LE. 0) RETURN
+ IF (INCX .EQ. INCY) IF (INCX-1) 5,20,60
+C
+C Code for unequal or nonpositive increments.
+C
+ 5 IX = 1
+ IY = 1
+ IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
+ IF (INCY .LT. 0) IY = (-N+1)*INCY + 1
+ DO 10 I = 1,N
+ DTEMP1 = DX(IX)
+ DX(IX) = DY(IY)
+ DY(IY) = DTEMP1
+ IX = IX + INCX
+ IY = IY + INCY
+ 10 CONTINUE
+ RETURN
+C
+C Code for both increments equal to 1.
+C
+C Clean-up loop so remaining vector length is a multiple of 3.
+C
+ 20 M = MOD(N,3)
+ IF (M .EQ. 0) GO TO 40
+ DO 30 I = 1,M
+ DTEMP1 = DX(I)
+ DX(I) = DY(I)
+ DY(I) = DTEMP1
+ 30 CONTINUE
+ IF (N .LT. 3) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,3
+ DTEMP1 = DX(I)
+ DTEMP2 = DX(I+1)
+ DTEMP3 = DX(I+2)
+ DX(I) = DY(I)
+ DX(I+1) = DY(I+1)
+ DX(I+2) = DY(I+2)
+ DY(I) = DTEMP1
+ DY(I+1) = DTEMP2
+ DY(I+2) = DTEMP3
+ 50 CONTINUE
+ RETURN
+C
+C Code for equal, positive, non-unit increments.
+C
+ 60 NS = N*INCX
+ DO 70 I = 1,NS,INCX
+ DTEMP1 = DX(I)
+ DX(I) = DY(I)
+ DY(I) = DTEMP1
+ 70 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/ezfft1.f b/Lib/Slatec/slatec/ezfft1.f
new file mode 100644
index 0000000..2d22dfa
--- /dev/null
+++ b/Lib/Slatec/slatec/ezfft1.f
@@ -0,0 +1,89 @@
+*DECK EZFFT1
+ SUBROUTINE EZFFT1 (N, WA, IFAC)
+C***BEGIN PROLOGUE EZFFT1
+C***SUBSIDIARY
+C***PURPOSE EZFFTI calls EZFFT1 with appropriate work array
+C partitioning.
+C***LIBRARY SLATEC (FFTPACK)
+C***TYPE SINGLE PRECISION (EZFFT1-S)
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C (a) changing dummy array size declarations (1) to (*),
+C (b) changing references to intrinsic function FLOAT
+C to REAL, and
+C (c) changing definition of variable TPI by using
+C FORTRAN intrinsic function ATAN instead of a DATA
+C statement.
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890531 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900402 Added TYPE section. (WRB)
+C***END PROLOGUE EZFFT1
+ DIMENSION WA(*), IFAC(*), NTRYH(4)
+ SAVE NTRYH
+ DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/4,2,3,5/
+C***FIRST EXECUTABLE STATEMENT EZFFT1
+ TPI = 8.*ATAN(1.)
+ NL = N
+ NF = 0
+ J = 0
+ 101 J = J+1
+ IF (J-4) 102,102,103
+ 102 NTRY = NTRYH(J)
+ GO TO 104
+ 103 NTRY = NTRY+2
+ 104 NQ = NL/NTRY
+ NR = NL-NTRY*NQ
+ IF (NR) 101,105,101
+ 105 NF = NF+1
+ IFAC(NF+2) = NTRY
+ NL = NQ
+ IF (NTRY .NE. 2) GO TO 107
+ IF (NF .EQ. 1) GO TO 107
+ DO 106 I=2,NF
+ IB = NF-I+2
+ IFAC(IB+2) = IFAC(IB+1)
+ 106 CONTINUE
+ IFAC(3) = 2
+ 107 IF (NL .NE. 1) GO TO 104
+ IFAC(1) = N
+ IFAC(2) = NF
+ ARGH = TPI/N
+ IS = 0
+ NFM1 = NF-1
+ L1 = 1
+ IF (NFM1 .EQ. 0) RETURN
+ DO 111 K1=1,NFM1
+ IP = IFAC(K1+2)
+ L2 = L1*IP
+ IDO = N/L2
+ IPM = IP-1
+ ARG1 = L1*ARGH
+ CH1 = 1.
+ SH1 = 0.
+ DCH1 = COS(ARG1)
+ DSH1 = SIN(ARG1)
+ DO 110 J=1,IPM
+ CH1H = DCH1*CH1-DSH1*SH1
+ SH1 = DCH1*SH1+DSH1*CH1
+ CH1 = CH1H
+ I = IS+2
+ WA(I-1) = CH1
+ WA(I) = SH1
+ IF (IDO .LT. 5) GO TO 109
+ DO 108 II=5,IDO,2
+ I = I+2
+ WA(I-1) = CH1*WA(I-3)-SH1*WA(I-2)
+ WA(I) = CH1*WA(I-2)+SH1*WA(I-3)
+ 108 CONTINUE
+ 109 IS = IS+IDO
+ 110 CONTINUE
+ L1 = L2
+ 111 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/ezfftb.f b/Lib/Slatec/slatec/ezfftb.f
new file mode 100644
index 0000000..a6a1a78
--- /dev/null
+++ b/Lib/Slatec/slatec/ezfftb.f
@@ -0,0 +1,119 @@
+*DECK EZFFTB
+ SUBROUTINE EZFFTB (N, R, AZERO, A, B, WSAVE)
+C***BEGIN PROLOGUE EZFFTB
+C***PURPOSE A simplified real, periodic, backward fast Fourier
+C transform.
+C***LIBRARY SLATEC (FFTPACK)
+C***CATEGORY J1A1
+C***TYPE SINGLE PRECISION (EZFFTB-S)
+C***KEYWORDS FFTPACK, FOURIER TRANSFORM
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***DESCRIPTION
+C
+C Subroutine EZFFTB computes a real periodic sequence from its
+C Fourier coefficients (Fourier synthesis). The transform is
+C defined below at Output Parameter R. EZFFTB is a simplified
+C but slower version of RFFTB.
+C
+C Input Parameters
+C
+C N the length of the output array R. The method is most
+C efficient when N is the product of small primes.
+C
+C AZERO the constant Fourier coefficient
+C
+C A,B arrays which contain the remaining Fourier coefficients.
+C These arrays are not destroyed.
+C
+C The length of these arrays depends on whether N is even or
+C odd.
+C
+C If N is even, N/2 locations are required.
+C If N is odd, (N-1)/2 locations are required
+C
+C WSAVE a work array which must be dimensioned at least 3*N+15
+C in the program that calls EZFFTB. The WSAVE array must be
+C initialized by calling subroutine EZFFTI(N,WSAVE), and a
+C different WSAVE array must be used for each different
+C value of N. This initialization does not have to be
+C repeated so long as N remains unchanged. Thus subsequent
+C transforms can be obtained faster than the first.
+C The same WSAVE array can be used by EZFFTF and EZFFTB.
+C
+C Output Parameters
+C
+C R if N is even, define KMAX=N/2
+C if N is odd, define KMAX=(N-1)/2
+C
+C Then for I=1,...,N
+C
+C R(I)=AZERO plus the sum from K=1 to K=KMAX of
+C
+C A(K)*COS(K*(I-1)*2*PI/N)+B(K)*SIN(K*(I-1)*2*PI/N)
+C
+C ********************* Complex Notation **************************
+C
+C For J=1,...,N
+C
+C R(J) equals the sum from K=-KMAX to K=KMAX of
+C
+C C(K)*EXP(I*K*(J-1)*2*PI/N)
+C
+C where
+C
+C C(K) = .5*CMPLX(A(K),-B(K)) for K=1,...,KMAX
+C
+C C(-K) = CONJG(C(K))
+C
+C C(0) = AZERO
+C
+C and I=SQRT(-1)
+C
+C *************** Amplitude - Phase Notation ***********************
+C
+C For I=1,...,N
+C
+C R(I) equals AZERO plus the sum from K=1 to K=KMAX of
+C
+C ALPHA(K)*COS(K*(I-1)*2*PI/N+BETA(K))
+C
+C where
+C
+C ALPHA(K) = SQRT(A(K)*A(K)+B(K)*B(K))
+C
+C COS(BETA(K))=A(K)/ALPHA(K)
+C
+C SIN(BETA(K))=-B(K)/ALPHA(K)
+C
+C***REFERENCES P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
+C Computations (G. Rodrigue, ed.), Academic Press,
+C 1982, pp. 51-83.
+C***ROUTINES CALLED RFFTB
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C changing dummy array size declarations (1) to (*)
+C 861211 REVISION DATE from Version 3.2
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE EZFFTB
+ DIMENSION R(*), A(*), B(*), WSAVE(*)
+C***FIRST EXECUTABLE STATEMENT EZFFTB
+ IF (N-2) 101,102,103
+ 101 R(1) = AZERO
+ RETURN
+ 102 R(1) = AZERO+A(1)
+ R(2) = AZERO-A(1)
+ RETURN
+ 103 NS2 = (N-1)/2
+ DO 104 I=1,NS2
+ R(2*I) = .5*A(I)
+ R(2*I+1) = -.5*B(I)
+ 104 CONTINUE
+ R(1) = AZERO
+ IF (MOD(N,2) .EQ. 0) R(N) = A(NS2+1)
+ CALL RFFTB (N,R,WSAVE(N+1))
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/ezfftf.f b/Lib/Slatec/slatec/ezfftf.f
new file mode 100644
index 0000000..01f6b7c
--- /dev/null
+++ b/Lib/Slatec/slatec/ezfftf.f
@@ -0,0 +1,96 @@
+*DECK EZFFTF
+ SUBROUTINE EZFFTF (N, R, AZERO, A, B, WSAVE)
+C***BEGIN PROLOGUE EZFFTF
+C***PURPOSE Compute a simplified real, periodic, fast Fourier forward
+C transform.
+C***LIBRARY SLATEC (FFTPACK)
+C***CATEGORY J1A1
+C***TYPE SINGLE PRECISION (EZFFTF-S)
+C***KEYWORDS FFTPACK, FOURIER TRANSFORM
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***DESCRIPTION
+C
+C Subroutine EZFFTF computes the Fourier coefficients of a real
+C periodic sequence (Fourier analysis). The transform is defined
+C below at Output Parameters AZERO, A and B. EZFFTF is a simplified
+C but slower version of RFFTF.
+C
+C Input Parameters
+C
+C N the length of the array R to be transformed. The method
+C is most efficient when N is the product of small primes.
+C
+C R a real array of length N which contains the sequence
+C to be transformed. R is not destroyed.
+C
+C
+C WSAVE a work array which must be dimensioned at least 3*N+15
+C in the program that calls EZFFTF. The WSAVE array must be
+C initialized by calling subroutine EZFFTI(N,WSAVE), and a
+C different WSAVE array must be used for each different
+C value of N. This initialization does not have to be
+C repeated so long as N remains unchanged. Thus subsequent
+C transforms can be obtained faster than the first.
+C The same WSAVE array can be used by EZFFTF and EZFFTB.
+C
+C Output Parameters
+C
+C AZERO the sum from I=1 to I=N of R(I)/N
+C
+C A,B for N even B(N/2)=0. and A(N/2) is the sum from I=1 to
+C I=N of (-1)**(I-1)*R(I)/N
+C
+C for N even define KMAX=N/2-1
+C for N odd define KMAX=(N-1)/2
+C
+C then for K=1,...,KMAX
+C
+C A(K) equals the sum from I=1 to I=N of
+C
+C 2./N*R(I)*COS(K*(I-1)*2*PI/N)
+C
+C B(K) equals the sum from I=1 to I=N of
+C
+C 2./N*R(I)*SIN(K*(I-1)*2*PI/N)
+C
+C***REFERENCES P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
+C Computations (G. Rodrigue, ed.), Academic Press,
+C 1982, pp. 51-83.
+C***ROUTINES CALLED RFFTF
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C (a) changing dummy array size declarations (1) to (*),
+C (b) changing references to intrinsic function FLOAT
+C to REAL.
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890531 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE EZFFTF
+ DIMENSION R(*), A(*), B(*), WSAVE(*)
+C***FIRST EXECUTABLE STATEMENT EZFFTF
+ IF (N-2) 101,102,103
+ 101 AZERO = R(1)
+ RETURN
+ 102 AZERO = .5*(R(1)+R(2))
+ A(1) = .5*(R(1)-R(2))
+ RETURN
+ 103 DO 104 I=1,N
+ WSAVE(I) = R(I)
+ 104 CONTINUE
+ CALL RFFTF (N,WSAVE,WSAVE(N+1))
+ CF = 2./N
+ CFM = -CF
+ AZERO = .5*CF*WSAVE(1)
+ NS2 = (N+1)/2
+ NS2M = NS2-1
+ DO 105 I=1,NS2M
+ A(I) = CF*WSAVE(2*I)
+ B(I) = CFM*WSAVE(2*I+1)
+ 105 CONTINUE
+ IF (MOD(N,2) .EQ. 0) A(NS2) = .5*CF*WSAVE(N)
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/ezffti.f b/Lib/Slatec/slatec/ezffti.f
new file mode 100644
index 0000000..099ba3e
--- /dev/null
+++ b/Lib/Slatec/slatec/ezffti.f
@@ -0,0 +1,47 @@
+*DECK EZFFTI
+ SUBROUTINE EZFFTI (N, WSAVE)
+C***BEGIN PROLOGUE EZFFTI
+C***PURPOSE Initialize a work array for EZFFTF and EZFFTB.
+C***LIBRARY SLATEC (FFTPACK)
+C***CATEGORY J1A1
+C***TYPE SINGLE PRECISION (EZFFTI-S)
+C***KEYWORDS FFTPACK, FOURIER TRANSFORM
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***DESCRIPTION
+C
+C Subroutine EZFFTI initializes the work array WSAVE which is used in
+C both EZFFTF and EZFFTB. The prime factorization of N together with
+C a tabulation of the trigonometric functions are computed and
+C stored in WSAVE.
+C
+C Input Parameter
+C
+C N the length of the sequence to be transformed.
+C
+C Output Parameter
+C
+C WSAVE a work array which must be dimensioned at least 3*N+15.
+C The same work array can be used for both EZFFTF and EZFFTB
+C as long as N remains unchanged. Different WSAVE arrays
+C are required for different values of N.
+C
+C***REFERENCES P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
+C Computations (G. Rodrigue, ed.), Academic Press,
+C 1982, pp. 51-83.
+C***ROUTINES CALLED EZFFT1
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C changing dummy array size declarations (1) to (*).
+C 861211 REVISION DATE from Version 3.2
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE EZFFTI
+ DIMENSION WSAVE(*)
+C***FIRST EXECUTABLE STATEMENT EZFFTI
+ IF (N .EQ. 1) RETURN
+ CALL EZFFT1 (N,WSAVE(2*N+1),WSAVE(3*N+1))
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/fdump.f b/Lib/Slatec/slatec/fdump.f
new file mode 100644
index 0000000..1f44a57
--- /dev/null
+++ b/Lib/Slatec/slatec/fdump.f
@@ -0,0 +1,31 @@
+*DECK FDUMP
+ SUBROUTINE FDUMP
+C***BEGIN PROLOGUE FDUMP
+C***PURPOSE Symbolic dump (should be locally written).
+C***LIBRARY SLATEC (XERROR)
+C***CATEGORY R3
+C***TYPE ALL (FDUMP-A)
+C***KEYWORDS ERROR, XERMSG
+C***AUTHOR Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C ***Note*** Machine Dependent Routine
+C FDUMP is intended to be replaced by a locally written
+C version which produces a symbolic dump. Failing this,
+C it should be replaced by a version which prints the
+C subprogram nesting list. Note that this dump must be
+C printed on each of up to five files, as indicated by the
+C XGETUA routine. See XSETUA and XGETUA for details.
+C
+C Written by Ron Jones, with SLATEC Common Math Library Subcommittee
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790801 DATE WRITTEN
+C 861211 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C***END PROLOGUE FDUMP
+C***FIRST EXECUTABLE STATEMENT FDUMP
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/i1mach.f b/Lib/Slatec/slatec/i1mach.f
new file mode 100644
index 0000000..ad04e7b
--- /dev/null
+++ b/Lib/Slatec/slatec/i1mach.f
@@ -0,0 +1,888 @@
+*DECK I1MACH
+ INTEGER FUNCTION I1MACH (I)
+C***BEGIN PROLOGUE I1MACH
+C***PURPOSE Return integer machine dependent constants.
+C***LIBRARY SLATEC
+C***CATEGORY R1
+C***TYPE INTEGER (I1MACH-I)
+C***KEYWORDS MACHINE CONSTANTS
+C***AUTHOR Fox, P. A., (Bell Labs)
+C Hall, A. D., (Bell Labs)
+C Schryer, N. L., (Bell Labs)
+C***DESCRIPTION
+C
+C I1MACH can be used to obtain machine-dependent parameters for the
+C local machine environment. It is a function subprogram with one
+C (input) argument and can be referenced as follows:
+C
+C K = I1MACH(I)
+C
+C where I=1,...,16. The (output) value of K above is determined by
+C the (input) value of I. The results for various values of I are
+C discussed below.
+C
+C I/O unit numbers:
+C I1MACH( 1) = the standard input unit.
+C I1MACH( 2) = the standard output unit.
+C I1MACH( 3) = the standard punch unit.
+C I1MACH( 4) = the standard error message unit.
+C
+C Words:
+C I1MACH( 5) = the number of bits per integer storage unit.
+C I1MACH( 6) = the number of characters per integer storage unit.
+C
+C Integers:
+C assume integers are represented in the S-digit, base-A form
+C
+C sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
+C
+C where 0 .LE. X(I) .LT. A for I=0,...,S-1.
+C I1MACH( 7) = A, the base.
+C I1MACH( 8) = S, the number of base-A digits.
+C I1MACH( 9) = A**S - 1, the largest magnitude.
+C
+C Floating-Point Numbers:
+C Assume floating-point numbers are represented in the T-digit,
+C base-B form
+C sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
+C
+C where 0 .LE. X(I) .LT. B for I=1,...,T,
+C 0 .LT. X(1), and EMIN .LE. E .LE. EMAX.
+C I1MACH(10) = B, the base.
+C
+C Single-Precision:
+C I1MACH(11) = T, the number of base-B digits.
+C I1MACH(12) = EMIN, the smallest exponent E.
+C I1MACH(13) = EMAX, the largest exponent E.
+C
+C Double-Precision:
+C I1MACH(14) = T, the number of base-B digits.
+C I1MACH(15) = EMIN, the smallest exponent E.
+C I1MACH(16) = EMAX, the largest exponent E.
+C
+C To alter this function for a particular environment, the desired
+C set of DATA statements should be activated by removing the C from
+C column 1. Also, the values of I1MACH(1) - I1MACH(4) should be
+C checked for consistency with the local operating system.
+C
+C***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for
+C a portable library, ACM Transactions on Mathematical
+C Software 4, 2 (June 1978), pp. 177-188.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 750101 DATE WRITTEN
+C 891012 Added VAX G-floating constants. (WRB)
+C 891012 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900618 Added DEC RISC constants. (WRB)
+C 900723 Added IBM RS 6000 constants. (WRB)
+C 901009 Correct I1MACH(7) for IBM Mainframes. Should be 2 not 16.
+C (RWC)
+C 910710 Added HP 730 constants. (SMR)
+C 911114 Added Convex IEEE constants. (WRB)
+C 920121 Added SUN -r8 compiler option constants. (WRB)
+C 920229 Added Touchstone Delta i860 constants. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C 920625 Added Convex -p8 and -pd8 compiler option constants.
+C (BKS, WRB)
+C 930201 Added DEC Alpha and SGI constants. (RWC and WRB)
+C 930618 Corrected I1MACH(5) for Convex -p8 and -pd8 compiler
+C options. (DWL, RWC and WRB).
+C***END PROLOGUE I1MACH
+C
+ INTEGER IMACH(16),OUTPUT
+ SAVE IMACH
+ EQUIVALENCE (IMACH(4),OUTPUT)
+C
+C MACHINE CONSTANTS FOR THE AMIGA
+C ABSOFT COMPILER
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 5 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -126 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1022 /
+C DATA IMACH(16) / 1023 /
+C
+C MACHINE CONSTANTS FOR THE APOLLO
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 6 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -125 /
+C DATA IMACH(13) / 129 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1021 /
+C DATA IMACH(16) / 1025 /
+C
+C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM
+C
+C DATA IMACH( 1) / 7 /
+C DATA IMACH( 2) / 2 /
+C DATA IMACH( 3) / 2 /
+C DATA IMACH( 4) / 2 /
+C DATA IMACH( 5) / 36 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 33 /
+C DATA IMACH( 9) / Z1FFFFFFFF /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -256 /
+C DATA IMACH(13) / 255 /
+C DATA IMACH(14) / 60 /
+C DATA IMACH(15) / -256 /
+C DATA IMACH(16) / 255 /
+C
+C MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 7 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 48 /
+C DATA IMACH( 6) / 6 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 39 /
+C DATA IMACH( 9) / O0007777777777777 /
+C DATA IMACH(10) / 8 /
+C DATA IMACH(11) / 13 /
+C DATA IMACH(12) / -50 /
+C DATA IMACH(13) / 76 /
+C DATA IMACH(14) / 26 /
+C DATA IMACH(15) / -50 /
+C DATA IMACH(16) / 76 /
+C
+C MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 7 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 48 /
+C DATA IMACH( 6) / 6 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 39 /
+C DATA IMACH( 9) / O0007777777777777 /
+C DATA IMACH(10) / 8 /
+C DATA IMACH(11) / 13 /
+C DATA IMACH(12) / -50 /
+C DATA IMACH(13) / 76 /
+C DATA IMACH(14) / 26 /
+C DATA IMACH(15) / -32754 /
+C DATA IMACH(16) / 32780 /
+C
+C MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 7 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 64 /
+C DATA IMACH( 6) / 8 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 63 /
+C DATA IMACH( 9) / 9223372036854775807 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 47 /
+C DATA IMACH(12) / -4095 /
+C DATA IMACH(13) / 4094 /
+C DATA IMACH(14) / 94 /
+C DATA IMACH(15) / -4095 /
+C DATA IMACH(16) / 4094 /
+C
+C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 7 /
+C DATA IMACH( 4) / 6LOUTPUT/
+C DATA IMACH( 5) / 60 /
+C DATA IMACH( 6) / 10 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 48 /
+C DATA IMACH( 9) / 00007777777777777777B /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 47 /
+C DATA IMACH(12) / -929 /
+C DATA IMACH(13) / 1070 /
+C DATA IMACH(14) / 94 /
+C DATA IMACH(15) / -929 /
+C DATA IMACH(16) / 1069 /
+C
+C MACHINE CONSTANTS FOR THE CELERITY C1260
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 6 /
+C DATA IMACH( 4) / 0 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / Z'7FFFFFFF' /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -126 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1022 /
+C DATA IMACH(16) / 1023 /
+C
+C MACHINE CONSTANTS FOR THE CONVEX
+C USING THE -fn COMPILER OPTION
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 7 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -127 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1023 /
+C DATA IMACH(16) / 1023 /
+C
+C MACHINE CONSTANTS FOR THE CONVEX
+C USING THE -fi COMPILER OPTION
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 7 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -125 /
+C DATA IMACH(13) / 128 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1021 /
+C DATA IMACH(16) / 1024 /
+C
+C MACHINE CONSTANTS FOR THE CONVEX
+C USING THE -p8 COMPILER OPTION
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 7 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 64 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 63 /
+C DATA IMACH( 9) / 9223372036854775807 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 53 /
+C DATA IMACH(12) / -1023 /
+C DATA IMACH(13) / 1023 /
+C DATA IMACH(14) / 113 /
+C DATA IMACH(15) / -16383 /
+C DATA IMACH(16) / 16383 /
+C
+C MACHINE CONSTANTS FOR THE CONVEX
+C USING THE -pd8 COMPILER OPTION
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 7 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 64 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 63 /
+C DATA IMACH( 9) / 9223372036854775807 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 53 /
+C DATA IMACH(12) / -1023 /
+C DATA IMACH(13) / 1023 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1023 /
+C DATA IMACH(16) / 1023 /
+C
+C MACHINE CONSTANTS FOR THE CRAY
+C USING THE 46 BIT INTEGER COMPILER OPTION
+C
+C DATA IMACH( 1) / 100 /
+C DATA IMACH( 2) / 101 /
+C DATA IMACH( 3) / 102 /
+C DATA IMACH( 4) / 101 /
+C DATA IMACH( 5) / 64 /
+C DATA IMACH( 6) / 8 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 46 /
+C DATA IMACH( 9) / 1777777777777777B /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 47 /
+C DATA IMACH(12) / -8189 /
+C DATA IMACH(13) / 8190 /
+C DATA IMACH(14) / 94 /
+C DATA IMACH(15) / -8099 /
+C DATA IMACH(16) / 8190 /
+C
+C MACHINE CONSTANTS FOR THE CRAY
+C USING THE 64 BIT INTEGER COMPILER OPTION
+C
+C DATA IMACH( 1) / 100 /
+C DATA IMACH( 2) / 101 /
+C DATA IMACH( 3) / 102 /
+C DATA IMACH( 4) / 101 /
+C DATA IMACH( 5) / 64 /
+C DATA IMACH( 6) / 8 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 63 /
+C DATA IMACH( 9) / 777777777777777777777B /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 47 /
+C DATA IMACH(12) / -8189 /
+C DATA IMACH(13) / 8190 /
+C DATA IMACH(14) / 94 /
+C DATA IMACH(15) / -8099 /
+C DATA IMACH(16) / 8190 /
+C
+C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200
+C
+C DATA IMACH( 1) / 11 /
+C DATA IMACH( 2) / 12 /
+C DATA IMACH( 3) / 8 /
+C DATA IMACH( 4) / 10 /
+C DATA IMACH( 5) / 16 /
+C DATA IMACH( 6) / 2 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 15 /
+C DATA IMACH( 9) / 32767 /
+C DATA IMACH(10) / 16 /
+C DATA IMACH(11) / 6 /
+C DATA IMACH(12) / -64 /
+C DATA IMACH(13) / 63 /
+C DATA IMACH(14) / 14 /
+C DATA IMACH(15) / -64 /
+C DATA IMACH(16) / 63 /
+C
+C MACHINE CONSTANTS FOR THE DEC ALPHA
+C USING G_FLOAT
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 5 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -127 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1023 /
+C DATA IMACH(16) / 1023 /
+C
+C MACHINE CONSTANTS FOR THE DEC ALPHA
+C USING IEEE_FLOAT
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 6 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -125 /
+C DATA IMACH(13) / 128 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1021 /
+C DATA IMACH(16) / 1024 /
+C
+C MACHINE CONSTANTS FOR THE DEC RISC
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 6 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -125 /
+C DATA IMACH(13) / 128 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1021 /
+C DATA IMACH(16) / 1024 /
+C
+C MACHINE CONSTANTS FOR THE DEC VAX
+C USING D_FLOATING
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 5 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -127 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 56 /
+C DATA IMACH(15) / -127 /
+C DATA IMACH(16) / 127 /
+C
+C MACHINE CONSTANTS FOR THE DEC VAX
+C USING G_FLOATING
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 5 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -127 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1023 /
+C DATA IMACH(16) / 1023 /
+C
+C MACHINE CONSTANTS FOR THE ELXSI 6400
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 6 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 32 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -126 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1022 /
+C DATA IMACH(16) / 1023 /
+C
+C MACHINE CONSTANTS FOR THE HARRIS 220
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 0 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 24 /
+C DATA IMACH( 6) / 3 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 23 /
+C DATA IMACH( 9) / 8388607 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 23 /
+C DATA IMACH(12) / -127 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 38 /
+C DATA IMACH(15) / -127 /
+C DATA IMACH(16) / 127 /
+C
+C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 43 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 36 /
+C DATA IMACH( 6) / 6 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 35 /
+C DATA IMACH( 9) / O377777777777 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 27 /
+C DATA IMACH(12) / -127 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 63 /
+C DATA IMACH(15) / -127 /
+C DATA IMACH(16) / 127 /
+C
+C MACHINE CONSTANTS FOR THE HP 730
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 6 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -125 /
+C DATA IMACH(13) / 128 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1021 /
+C DATA IMACH(16) / 1024 /
+C
+C MACHINE CONSTANTS FOR THE HP 2100
+C 3 WORD DOUBLE PRECISION OPTION WITH FTN4
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 4 /
+C DATA IMACH( 4) / 1 /
+C DATA IMACH( 5) / 16 /
+C DATA IMACH( 6) / 2 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 15 /
+C DATA IMACH( 9) / 32767 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 23 /
+C DATA IMACH(12) / -128 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 39 /
+C DATA IMACH(15) / -128 /
+C DATA IMACH(16) / 127 /
+C
+C MACHINE CONSTANTS FOR THE HP 2100
+C 4 WORD DOUBLE PRECISION OPTION WITH FTN4
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 4 /
+C DATA IMACH( 4) / 1 /
+C DATA IMACH( 5) / 16 /
+C DATA IMACH( 6) / 2 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 15 /
+C DATA IMACH( 9) / 32767 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 23 /
+C DATA IMACH(12) / -128 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 55 /
+C DATA IMACH(15) / -128 /
+C DATA IMACH(16) / 127 /
+C
+C MACHINE CONSTANTS FOR THE HP 9000
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 6 /
+C DATA IMACH( 4) / 7 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 32 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -126 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1015 /
+C DATA IMACH(16) / 1017 /
+C
+C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES,
+C THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86, AND
+C THE PERKIN ELMER (INTERDATA) 7/32.
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 7 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / Z7FFFFFFF /
+C DATA IMACH(10) / 16 /
+C DATA IMACH(11) / 6 /
+C DATA IMACH(12) / -64 /
+C DATA IMACH(13) / 63 /
+C DATA IMACH(14) / 14 /
+C DATA IMACH(15) / -64 /
+C DATA IMACH(16) / 63 /
+C
+C MACHINE CONSTANTS FOR THE IBM PC
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 0 /
+C DATA IMACH( 4) / 0 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -125 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1021 /
+C DATA IMACH(16) / 1023 /
+C
+C MACHINE CONSTANTS FOR THE IBM RS 6000
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 6 /
+C DATA IMACH( 4) / 0 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -125 /
+C DATA IMACH(13) / 128 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1021 /
+C DATA IMACH(16) / 1024 /
+C
+C MACHINE CONSTANTS FOR THE INTEL i860
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 6 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -125 /
+C DATA IMACH(13) / 128 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1021 /
+C DATA IMACH(16) / 1024 /
+C
+C MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR)
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 5 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 36 /
+C DATA IMACH( 6) / 5 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 35 /
+C DATA IMACH( 9) / "377777777777 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 27 /
+C DATA IMACH(12) / -128 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 54 /
+C DATA IMACH(15) / -101 /
+C DATA IMACH(16) / 127 /
+C
+C MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR)
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 5 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 36 /
+C DATA IMACH( 6) / 5 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 35 /
+C DATA IMACH( 9) / "377777777777 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 27 /
+C DATA IMACH(12) / -128 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 62 /
+C DATA IMACH(15) / -128 /
+C DATA IMACH(16) / 127 /
+C
+C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING
+C 32-BIT INTEGER ARITHMETIC.
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 5 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -127 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 56 /
+C DATA IMACH(15) / -127 /
+C DATA IMACH(16) / 127 /
+C
+C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING
+C 16-BIT INTEGER ARITHMETIC.
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 5 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 16 /
+C DATA IMACH( 6) / 2 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 15 /
+C DATA IMACH( 9) / 32767 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -127 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 56 /
+C DATA IMACH(15) / -127 /
+C DATA IMACH(16) / 127 /
+C
+C MACHINE CONSTANTS FOR THE SILICON GRAPHICS
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 6 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -125 /
+C DATA IMACH(13) / 128 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1021 /
+C DATA IMACH(16) / 1024 /
+C
+C MACHINE CONSTANTS FOR THE SUN
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 6 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -125 /
+C DATA IMACH(13) / 128 /
+C DATA IMACH(14) / 53 /
+C DATA IMACH(15) / -1021 /
+C DATA IMACH(16) / 1024 /
+C
+C MACHINE CONSTANTS FOR THE SUN
+C USING THE -r8 COMPILER OPTION
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 6 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 32 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 31 /
+C DATA IMACH( 9) / 2147483647 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 53 /
+C DATA IMACH(12) / -1021 /
+C DATA IMACH(13) / 1024 /
+C DATA IMACH(14) / 113 /
+C DATA IMACH(15) / -16381 /
+C DATA IMACH(16) / 16384 /
+C
+C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES FTN COMPILER
+C
+C DATA IMACH( 1) / 5 /
+C DATA IMACH( 2) / 6 /
+C DATA IMACH( 3) / 1 /
+C DATA IMACH( 4) / 6 /
+C DATA IMACH( 5) / 36 /
+C DATA IMACH( 6) / 4 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 35 /
+C DATA IMACH( 9) / O377777777777 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 27 /
+C DATA IMACH(12) / -128 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 60 /
+C DATA IMACH(15) / -1024 /
+C DATA IMACH(16) / 1023 /
+C
+C MACHINE CONSTANTS FOR THE Z80 MICROPROCESSOR
+C
+C DATA IMACH( 1) / 1 /
+C DATA IMACH( 2) / 1 /
+C DATA IMACH( 3) / 0 /
+C DATA IMACH( 4) / 1 /
+C DATA IMACH( 5) / 16 /
+C DATA IMACH( 6) / 2 /
+C DATA IMACH( 7) / 2 /
+C DATA IMACH( 8) / 15 /
+C DATA IMACH( 9) / 32767 /
+C DATA IMACH(10) / 2 /
+C DATA IMACH(11) / 24 /
+C DATA IMACH(12) / -127 /
+C DATA IMACH(13) / 127 /
+C DATA IMACH(14) / 56 /
+C DATA IMACH(15) / -127 /
+C DATA IMACH(16) / 127 /
+C
+C***FIRST EXECUTABLE STATEMENT I1MACH
+ IF (I .LT. 1 .OR. I .GT. 16) GO TO 10
+C
+ I1MACH = IMACH(I)
+ RETURN
+C
+ 10 CONTINUE
+ WRITE (UNIT = OUTPUT, FMT = 9000)
+ 9000 FORMAT ('1ERROR 1 IN I1MACH - I OUT OF BOUNDS')
+C
+C CALL FDUMP
+C
+ STOP
+ END
diff --git a/Lib/Slatec/slatec/idamax.f b/Lib/Slatec/slatec/idamax.f
new file mode 100644
index 0000000..f6e6afa
--- /dev/null
+++ b/Lib/Slatec/slatec/idamax.f
@@ -0,0 +1,82 @@
+*DECK IDAMAX
+ INTEGER FUNCTION IDAMAX (N, DX, INCX)
+C***BEGIN PROLOGUE IDAMAX
+C***PURPOSE Find the smallest index of that component of a vector
+C having the maximum magnitude.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A2
+C***TYPE DOUBLE PRECISION (ISAMAX-S, IDAMAX-D, ICAMAX-C)
+C***KEYWORDS BLAS, LINEAR ALGEBRA, MAXIMUM COMPONENT, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C DX double precision vector with N elements
+C INCX storage spacing between elements of DX
+C
+C --Output--
+C IDAMAX smallest index (zero if N .LE. 0)
+C
+C Find smallest index of maximum magnitude of double precision DX.
+C IDAMAX = first I, I = 1 to N, to maximize ABS(DX(IX+(I-1)*INCX)),
+C where IX = 1 if INCX .GE. 0, else IX = 1+(1-N)*INCX.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890531 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900821 Modified to correct problem with a negative increment.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE IDAMAX
+ DOUBLE PRECISION DX(*), DMAX, XMAG
+ INTEGER I, INCX, IX, N
+C***FIRST EXECUTABLE STATEMENT IDAMAX
+ IDAMAX = 0
+ IF (N .LE. 0) RETURN
+ IDAMAX = 1
+ IF (N .EQ. 1) RETURN
+C
+ IF (INCX .EQ. 1) GOTO 20
+C
+C Code for increments not equal to 1.
+C
+ IX = 1
+ IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
+ DMAX = ABS(DX(IX))
+ IX = IX + INCX
+ DO 10 I = 2,N
+ XMAG = ABS(DX(IX))
+ IF (XMAG .GT. DMAX) THEN
+ IDAMAX = I
+ DMAX = XMAG
+ ENDIF
+ IX = IX + INCX
+ 10 CONTINUE
+ RETURN
+C
+C Code for increments equal to 1.
+C
+ 20 DMAX = ABS(DX(1))
+ DO 30 I = 2,N
+ XMAG = ABS(DX(I))
+ IF (XMAG .GT. DMAX) THEN
+ IDAMAX = I
+ DMAX = XMAG
+ ENDIF
+ 30 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/isamax.f b/Lib/Slatec/slatec/isamax.f
new file mode 100644
index 0000000..80d9f3b
--- /dev/null
+++ b/Lib/Slatec/slatec/isamax.f
@@ -0,0 +1,82 @@
+*DECK ISAMAX
+ INTEGER FUNCTION ISAMAX (N, SX, INCX)
+C***BEGIN PROLOGUE ISAMAX
+C***PURPOSE Find the smallest index of that component of a vector
+C having the maximum magnitude.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A2
+C***TYPE SINGLE PRECISION (ISAMAX-S, IDAMAX-D, ICAMAX-C)
+C***KEYWORDS BLAS, LINEAR ALGEBRA, MAXIMUM COMPONENT, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C SX single precision vector with N elements
+C INCX storage spacing between elements of SX
+C
+C --Output--
+C ISAMAX smallest index (zero if N .LE. 0)
+C
+C Find smallest index of maximum magnitude of single precision SX.
+C ISAMAX = first I, I = 1 to N, to maximize ABS(SX(IX+(I-1)*INCX)),
+C where IX = 1 if INCX .GE. 0, else IX = 1+(1-N)*INCX.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 861211 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900821 Modified to correct problem with a negative increment.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C 920618 Slight restructuring of code. (RWC, WRB)
+C***END PROLOGUE ISAMAX
+ REAL SX(*), SMAX, XMAG
+ INTEGER I, INCX, IX, N
+C***FIRST EXECUTABLE STATEMENT ISAMAX
+ ISAMAX = 0
+ IF (N .LE. 0) RETURN
+ ISAMAX = 1
+ IF (N .EQ. 1) RETURN
+C
+ IF (INCX .EQ. 1) GOTO 20
+C
+C Code for increment not equal to 1.
+C
+ IX = 1
+ IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
+ SMAX = ABS(SX(IX))
+ IX = IX + INCX
+ DO 10 I = 2,N
+ XMAG = ABS(SX(IX))
+ IF (XMAG .GT. SMAX) THEN
+ ISAMAX = I
+ SMAX = XMAG
+ ENDIF
+ IX = IX + INCX
+ 10 CONTINUE
+ RETURN
+C
+C Code for increments equal to 1.
+C
+ 20 SMAX = ABS(SX(1))
+ DO 30 I = 2,N
+ XMAG = ABS(SX(I))
+ IF (XMAG .GT. SMAX) THEN
+ ISAMAX = I
+ SMAX = XMAG
+ ENDIF
+ 30 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/j4save.f b/Lib/Slatec/slatec/j4save.f
new file mode 100644
index 0000000..6ec799b
--- /dev/null
+++ b/Lib/Slatec/slatec/j4save.f
@@ -0,0 +1,65 @@
+*DECK J4SAVE
+ FUNCTION J4SAVE (IWHICH, IVALUE, ISET)
+C***BEGIN PROLOGUE J4SAVE
+C***SUBSIDIARY
+C***PURPOSE Save or recall global variables needed by error
+C handling routines.
+C***LIBRARY SLATEC (XERROR)
+C***TYPE INTEGER (J4SAVE-I)
+C***KEYWORDS ERROR MESSAGES, ERROR NUMBER, RECALL, SAVE, XERROR
+C***AUTHOR Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C Abstract
+C J4SAVE saves and recalls several global variables needed
+C by the library error handling routines.
+C
+C Description of Parameters
+C --Input--
+C IWHICH - Index of item desired.
+C = 1 Refers to current error number.
+C = 2 Refers to current error control flag.
+C = 3 Refers to current unit number to which error
+C messages are to be sent. (0 means use standard.)
+C = 4 Refers to the maximum number of times any
+C message is to be printed (as set by XERMAX).
+C = 5 Refers to the total number of units to which
+C each error message is to be written.
+C = 6 Refers to the 2nd unit for error messages
+C = 7 Refers to the 3rd unit for error messages
+C = 8 Refers to the 4th unit for error messages
+C = 9 Refers to the 5th unit for error messages
+C IVALUE - The value to be set for the IWHICH-th parameter,
+C if ISET is .TRUE. .
+C ISET - If ISET=.TRUE., the IWHICH-th parameter will BE
+C given the value, IVALUE. If ISET=.FALSE., the
+C IWHICH-th parameter will be unchanged, and IVALUE
+C is a dummy parameter.
+C --Output--
+C The (old) value of the IWHICH-th parameter will be returned
+C in the function value, J4SAVE.
+C
+C***SEE ALSO XERMSG
+C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C Error-handling Package, SAND82-0800, Sandia
+C Laboratories, 1982.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790801 DATE WRITTEN
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900205 Minor modifications to prologue. (WRB)
+C 900402 Added TYPE section. (WRB)
+C 910411 Added KEYWORDS section. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE J4SAVE
+ LOGICAL ISET
+ INTEGER IPARAM(9)
+ SAVE IPARAM
+ DATA IPARAM(1),IPARAM(2),IPARAM(3),IPARAM(4)/0,2,0,10/
+ DATA IPARAM(5)/1/
+ DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/
+C***FIRST EXECUTABLE STATEMENT J4SAVE
+ J4SAVE = IPARAM(IWHICH)
+ IF (ISET) IPARAM(IWHICH) = IVALUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/pchbs.f b/Lib/Slatec/slatec/pchbs.f
new file mode 100644
index 0000000..2738ca1
--- /dev/null
+++ b/Lib/Slatec/slatec/pchbs.f
@@ -0,0 +1,216 @@
+*DECK PCHBS
+ SUBROUTINE PCHBS (N, X, F, D, INCFD, KNOTYP, NKNOTS, T, BCOEF,
+ + NDIM, KORD, IERR)
+C***BEGIN PROLOGUE PCHBS
+C***PURPOSE Piecewise Cubic Hermite to B-Spline converter.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3
+C***TYPE SINGLE PRECISION (PCHBS-S, DPCHBS-D)
+C***KEYWORDS B-SPLINES, CONVERSION, CUBIC HERMITE INTERPOLATION,
+C PIECEWISE CUBIC INTERPOLATION
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Computing and Mathematics Research Division
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C *Usage:
+C
+C INTEGER N, INCFD, KNOTYP, NKNOTS, NDIM, KORD, IERR
+C PARAMETER (INCFD = ...)
+C REAL X(nmax), F(INCFD,nmax), D(INCFD,nmax), T(2*nmax+4),
+C * BCOEF(2*nmax)
+C
+C CALL PCHBS (N, X, F, D, INCFD, KNOTYP, NKNOTS, T, BCOEF,
+C * NDIM, KORD, IERR)
+C
+C *Arguments:
+C
+C N:IN is the number of data points, N.ge.2 . (not checked)
+C
+C X:IN is the real array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N. (not checked)
+C nmax, the dimension of X, must be .ge.N.
+C
+C F:IN is the real array of dependent variable values.
+C F(1+(I-1)*INCFD) is the value corresponding to X(I).
+C nmax, the second dimension of F, must be .ge.N.
+C
+C D:IN is the real array of derivative values at the data points.
+C D(1+(I-1)*INCFD) is the value corresponding to X(I).
+C nmax, the second dimension of D, must be .ge.N.
+C
+C INCFD:IN is the increment between successive values in F and D.
+C This argument is provided primarily for 2-D applications.
+C It may have the value 1 for one-dimensional applications,
+C in which case F and D may be singly-subscripted arrays.
+C
+C KNOTYP:IN is a flag to control the knot sequence.
+C The knot sequence T is normally computed from X by putting
+C a double knot at each X and setting the end knot pairs
+C according to the value of KNOTYP:
+C KNOTYP = 0: Quadruple knots at X(1) and X(N). (default)
+C KNOTYP = 1: Replicate lengths of extreme subintervals:
+C T( 1 ) = T( 2 ) = X(1) - (X(2)-X(1)) ;
+C T(M+4) = T(M+3) = X(N) + (X(N)-X(N-1)).
+C KNOTYP = 2: Periodic placement of boundary knots:
+C T( 1 ) = T( 2 ) = X(1) - (X(N)-X(N-1));
+C T(M+4) = T(M+3) = X(N) + (X(2)-X(1)) .
+C Here M=NDIM=2*N.
+C If the input value of KNOTYP is negative, however, it is
+C assumed that NKNOTS and T were set in a previous call.
+C This option is provided for improved efficiency when used
+C in a parametric setting.
+C
+C NKNOTS:INOUT is the number of knots.
+C If KNOTYP.GE.0, then NKNOTS will be set to NDIM+4.
+C If KNOTYP.LT.0, then NKNOTS is an input variable, and an
+C error return will be taken if it is not equal to NDIM+4.
+C
+C T:INOUT is the array of 2*N+4 knots for the B-representation.
+C If KNOTYP.GE.0, T will be returned by PCHBS with the
+C interior double knots equal to the X-values and the
+C boundary knots set as indicated above.
+C If KNOTYP.LT.0, it is assumed that T was set by a
+C previous call to PCHBS. (This routine does **not**
+C verify that T forms a legitimate knot sequence.)
+C
+C BCOEF:OUT is the array of 2*N B-spline coefficients.
+C
+C NDIM:OUT is the dimension of the B-spline space. (Set to 2*N.)
+C
+C KORD:OUT is the order of the B-spline. (Set to 4.)
+C
+C IERR:OUT is an error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C "Recoverable" errors:
+C IERR = -4 if KNOTYP.GT.2 .
+C IERR = -5 if KNOTYP.LT.0 and NKNOTS.NE.(2*N+4).
+C
+C *Description:
+C PCHBS computes the B-spline representation of the PCH function
+C determined by N,X,F,D. To be compatible with the rest of PCHIP,
+C PCHBS includes INCFD, the increment between successive values of
+C the F- and D-arrays.
+C
+C The output is the B-representation for the function: NKNOTS, T,
+C BCOEF, NDIM, KORD.
+C
+C *Caution:
+C Since it is assumed that the input PCH function has been
+C computed by one of the other routines in the package PCHIP,
+C input arguments N, X, INCFD are **not** checked for validity.
+C
+C *Restrictions/assumptions:
+C 1. N.GE.2 . (not checked)
+C 2. X(i).LT.X(i+1), i=1,...,N . (not checked)
+C 3. INCFD.GT.0 . (not checked)
+C 4. KNOTYP.LE.2 . (error return if not)
+C *5. NKNOTS = NDIM+4 = 2*N+4 . (error return if not)
+C *6. T(2*k+1) = T(2*k) = X(k), k=1,...,N . (not checked)
+C
+C * Indicates this applies only if KNOTYP.LT.0 .
+C
+C *Portability:
+C Argument INCFD is used only to cause the compiler to generate
+C efficient code for the subscript expressions (1+(I-1)*INCFD) .
+C The normal usage, in which PCHBS is called with one-dimensional
+C arrays F and D, is probably non-Fortran 77, in the strict sense,
+C but it works on all systems on which PCHBS has been tested.
+C
+C *See Also:
+C PCHIC, PCHIM, or PCHSP can be used to determine an interpolating
+C PCH function from a set of data.
+C The B-spline routine BVALU can be used to evaluate the
+C B-representation that is output by PCHBS.
+C (See BSPDOC for more information.)
+C
+C***REFERENCES F. N. Fritsch, "Representations for parametric cubic
+C splines," Computer Aided Geometric Design 6 (1989),
+C pp.79-82.
+C***ROUTINES CALLED PCHKT, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 870701 DATE WRITTEN
+C 900405 Converted Fortran to upper case.
+C 900405 Removed requirement that X be dimensioned N+1.
+C 900406 Modified to make PCHKT a subsidiary routine to simplify
+C usage. In the process, added argument INCFD to be com-
+C patible with the rest of PCHIP.
+C 900410 Converted prologue to SLATEC 4.0 format.
+C 900410 Added calls to XERMSG and changed constant 3. to 3 to
+C reduce single/double differences.
+C 900411 Added reference.
+C 900501 Corrected declarations.
+C 930317 Minor cosmetic changes. (FNF)
+C 930514 Corrected problems with dimensioning of arguments and
+C clarified DESCRIPTION. (FNF)
+C 930604 Removed NKNOTS from PCHKT call list. (FNF)
+C***END PROLOGUE PCHBS
+C
+C*Internal Notes:
+C
+C**End
+C
+C Declare arguments.
+C
+ INTEGER N, INCFD, KNOTYP, NKNOTS, NDIM, KORD, IERR
+ REAL X(*), F(INCFD,*), D(INCFD,*), T(*), BCOEF(*)
+C
+C Declare local variables.
+C
+ INTEGER K, KK
+ REAL DOV3, HNEW, HOLD
+ CHARACTER*8 LIBNAM, SUBNAM
+C***FIRST EXECUTABLE STATEMENT PCHBS
+C
+C Initialize.
+C
+ NDIM = 2*N
+ KORD = 4
+ IERR = 0
+ LIBNAM = 'SLATEC'
+ SUBNAM = 'PCHBS'
+C
+C Check argument validity. Set up knot sequence if OK.
+C
+ IF ( KNOTYP.GT.2 ) THEN
+ IERR = -1
+ CALL XERMSG (LIBNAM, SUBNAM, 'KNOTYP GREATER THAN 2', IERR, 1)
+ RETURN
+ ENDIF
+ IF ( KNOTYP.LT.0 ) THEN
+ IF ( NKNOTS.NE.NDIM+4 ) THEN
+ IERR = -2
+ CALL XERMSG (LIBNAM, SUBNAM,
+ * 'KNOTYP.LT.0 AND NKNOTS.NE.(2*N+4)', IERR, 1)
+ RETURN
+ ENDIF
+ ELSE
+C Set up knot sequence.
+ NKNOTS = NDIM + 4
+ CALL PCHKT (N, X, KNOTYP, T)
+ ENDIF
+C
+C Compute B-spline coefficients.
+C
+ HNEW = T(3) - T(1)
+ DO 40 K = 1, N
+ KK = 2*K
+ HOLD = HNEW
+C The following requires mixed mode arithmetic.
+ DOV3 = D(1,K)/3
+ BCOEF(KK-1) = F(1,K) - HOLD*DOV3
+C The following assumes T(2*K+1) = X(K).
+ HNEW = T(KK+3) - T(KK+1)
+ BCOEF(KK) = F(1,K) + HNEW*DOV3
+ 40 CONTINUE
+C
+C Terminate.
+C
+ RETURN
+C------------- LAST LINE OF PCHBS FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchce.f b/Lib/Slatec/slatec/pchce.f
new file mode 100644
index 0000000..8ec390a
--- /dev/null
+++ b/Lib/Slatec/slatec/pchce.f
@@ -0,0 +1,246 @@
+*DECK PCHCE
+ SUBROUTINE PCHCE (IC, VC, N, X, H, SLOPE, D, INCFD, IERR)
+C***BEGIN PROLOGUE PCHCE
+C***SUBSIDIARY
+C***PURPOSE Set boundary conditions for PCHIC
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE SINGLE PRECISION (PCHCE-S, DPCHCE-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C PCHCE: PCHIC End Derivative Setter.
+C
+C Called by PCHIC to set end derivatives as requested by the user.
+C It must be called after interior derivative values have been set.
+C -----
+C
+C To facilitate two-dimensional applications, includes an increment
+C between successive values of the D-array.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER IC(2), N, IERR
+C REAL VC(2), X(N), H(N), SLOPE(N), D(INCFD,N)
+C
+C CALL PCHCE (IC, VC, N, X, H, SLOPE, D, INCFD, IERR)
+C
+C Parameters:
+C
+C IC -- (input) integer array of length 2 specifying desired
+C boundary conditions:
+C IC(1) = IBEG, desired condition at beginning of data.
+C IC(2) = IEND, desired condition at end of data.
+C ( see prologue to PCHIC for details. )
+C
+C VC -- (input) real array of length 2 specifying desired boundary
+C values. VC(1) need be set only if IC(1) = 2 or 3 .
+C VC(2) need be set only if IC(2) = 2 or 3 .
+C
+C N -- (input) number of data points. (assumes N.GE.2)
+C
+C X -- (input) real array of independent variable values. (the
+C elements of X are assumed to be strictly increasing.)
+C
+C H -- (input) real array of interval lengths.
+C SLOPE -- (input) real array of data slopes.
+C If the data are (X(I),Y(I)), I=1(1)N, then these inputs are:
+C H(I) = X(I+1)-X(I),
+C SLOPE(I) = (Y(I+1)-Y(I))/H(I), I=1(1)N-1.
+C
+C D -- (input) real array of derivative values at the data points.
+C The value corresponding to X(I) must be stored in
+C D(1+(I-1)*INCFD), I=1(1)N.
+C (output) the value of D at X(1) and/or X(N) is changed, if
+C necessary, to produce the requested boundary conditions.
+C no other entries in D are changed.
+C
+C INCFD -- (input) increment between successive values in D.
+C This argument is provided primarily for 2-D applications.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C Warning errors:
+C IERR = 1 if IBEG.LT.0 and D(1) had to be adjusted for
+C monotonicity.
+C IERR = 2 if IEND.LT.0 and D(1+(N-1)*INCFD) had to be
+C adjusted for monotonicity.
+C IERR = 3 if both of the above are true.
+C
+C -------
+C WARNING: This routine does no validity-checking of arguments.
+C -------
+C
+C Fortran intrinsics used: ABS.
+C
+C***SEE ALSO PCHIC
+C***ROUTINES CALLED PCHDF, PCHST, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820218 DATE WRITTEN
+C 820805 Converted to SLATEC library version.
+C 870707 Minor corrections made to prologue..
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR section in prologue. (WRB)
+C 930503 Improved purpose. (FNF)
+C***END PROLOGUE PCHCE
+C
+C Programming notes:
+C 1. The function PCHST(ARG1,ARG2) is assumed to return zero if
+C either argument is zero, +1 if they are of the same sign, and
+C -1 if they are of opposite sign.
+C 2. One could reduce the number of arguments and amount of local
+C storage, at the expense of reduced code clarity, by passing in
+C the array WK (rather than splitting it into H and SLOPE) and
+C increasing its length enough to incorporate STEMP and XTEMP.
+C 3. The two monotonicity checks only use the sufficient conditions.
+C Thus, it is possible (but unlikely) for a boundary condition to
+C be changed, even though the original interpolant was monotonic.
+C (At least the result is a continuous function of the data.)
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER IC(2), N, INCFD, IERR
+ REAL VC(2), X(*), H(*), SLOPE(*), D(INCFD,*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER IBEG, IEND, IERF, INDEX, J, K
+ REAL HALF, STEMP(3), THREE, TWO, XTEMP(4), ZERO
+ SAVE ZERO, HALF, TWO, THREE
+ REAL PCHDF, PCHST
+C
+C INITIALIZE.
+C
+ DATA ZERO /0./, HALF /0.5/, TWO /2./, THREE /3./
+C
+C***FIRST EXECUTABLE STATEMENT PCHCE
+ IBEG = IC(1)
+ IEND = IC(2)
+ IERR = 0
+C
+C SET TO DEFAULT BOUNDARY CONDITIONS IF N IS TOO SMALL.
+C
+ IF ( ABS(IBEG).GT.N ) IBEG = 0
+ IF ( ABS(IEND).GT.N ) IEND = 0
+C
+C TREAT BEGINNING BOUNDARY CONDITION.
+C
+ IF (IBEG .EQ. 0) GO TO 2000
+ K = ABS(IBEG)
+ IF (K .EQ. 1) THEN
+C BOUNDARY VALUE PROVIDED.
+ D(1,1) = VC(1)
+ ELSE IF (K .EQ. 2) THEN
+C BOUNDARY SECOND DERIVATIVE PROVIDED.
+ D(1,1) = HALF*( (THREE*SLOPE(1) - D(1,2)) - HALF*VC(1)*H(1) )
+ ELSE IF (K .LT. 5) THEN
+C USE K-POINT DERIVATIVE FORMULA.
+C PICK UP FIRST K POINTS, IN REVERSE ORDER.
+ DO 10 J = 1, K
+ INDEX = K-J+1
+C INDEX RUNS FROM K DOWN TO 1.
+ XTEMP(J) = X(INDEX)
+ IF (J .LT. K) STEMP(J) = SLOPE(INDEX-1)
+ 10 CONTINUE
+C -----------------------------
+ D(1,1) = PCHDF (K, XTEMP, STEMP, IERF)
+C -----------------------------
+ IF (IERF .NE. 0) GO TO 5001
+ ELSE
+C USE 'NOT A KNOT' CONDITION.
+ D(1,1) = ( THREE*(H(1)*SLOPE(2) + H(2)*SLOPE(1))
+ * - TWO*(H(1)+H(2))*D(1,2) - H(1)*D(1,3) ) / H(2)
+ ENDIF
+C
+ IF (IBEG .GT. 0) GO TO 2000
+C
+C CHECK D(1,1) FOR COMPATIBILITY WITH MONOTONICITY.
+C
+ IF (SLOPE(1) .EQ. ZERO) THEN
+ IF (D(1,1) .NE. ZERO) THEN
+ D(1,1) = ZERO
+ IERR = IERR + 1
+ ENDIF
+ ELSE IF ( PCHST(D(1,1),SLOPE(1)) .LT. ZERO) THEN
+ D(1,1) = ZERO
+ IERR = IERR + 1
+ ELSE IF ( ABS(D(1,1)) .GT. THREE*ABS(SLOPE(1)) ) THEN
+ D(1,1) = THREE*SLOPE(1)
+ IERR = IERR + 1
+ ENDIF
+C
+C TREAT END BOUNDARY CONDITION.
+C
+ 2000 CONTINUE
+ IF (IEND .EQ. 0) GO TO 5000
+ K = ABS(IEND)
+ IF (K .EQ. 1) THEN
+C BOUNDARY VALUE PROVIDED.
+ D(1,N) = VC(2)
+ ELSE IF (K .EQ. 2) THEN
+C BOUNDARY SECOND DERIVATIVE PROVIDED.
+ D(1,N) = HALF*( (THREE*SLOPE(N-1) - D(1,N-1)) +
+ * HALF*VC(2)*H(N-1) )
+ ELSE IF (K .LT. 5) THEN
+C USE K-POINT DERIVATIVE FORMULA.
+C PICK UP LAST K POINTS.
+ DO 2010 J = 1, K
+ INDEX = N-K+J
+C INDEX RUNS FROM N+1-K UP TO N.
+ XTEMP(J) = X(INDEX)
+ IF (J .LT. K) STEMP(J) = SLOPE(INDEX)
+ 2010 CONTINUE
+C -----------------------------
+ D(1,N) = PCHDF (K, XTEMP, STEMP, IERF)
+C -----------------------------
+ IF (IERF .NE. 0) GO TO 5001
+ ELSE
+C USE 'NOT A KNOT' CONDITION.
+ D(1,N) = ( THREE*(H(N-1)*SLOPE(N-2) + H(N-2)*SLOPE(N-1))
+ * - TWO*(H(N-1)+H(N-2))*D(1,N-1) - H(N-1)*D(1,N-2) )
+ * / H(N-2)
+ ENDIF
+C
+ IF (IEND .GT. 0) GO TO 5000
+C
+C CHECK D(1,N) FOR COMPATIBILITY WITH MONOTONICITY.
+C
+ IF (SLOPE(N-1) .EQ. ZERO) THEN
+ IF (D(1,N) .NE. ZERO) THEN
+ D(1,N) = ZERO
+ IERR = IERR + 2
+ ENDIF
+ ELSE IF ( PCHST(D(1,N),SLOPE(N-1)) .LT. ZERO) THEN
+ D(1,N) = ZERO
+ IERR = IERR + 2
+ ELSE IF ( ABS(D(1,N)) .GT. THREE*ABS(SLOPE(N-1)) ) THEN
+ D(1,N) = THREE*SLOPE(N-1)
+ IERR = IERR + 2
+ ENDIF
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ RETURN
+C
+C ERROR RETURN.
+C
+ 5001 CONTINUE
+C ERROR RETURN FROM PCHDF.
+C *** THIS CASE SHOULD NEVER OCCUR ***
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'PCHCE', 'ERROR RETURN FROM PCHDF', IERR,
+ + 1)
+ RETURN
+C------------- LAST LINE OF PCHCE FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchci.f b/Lib/Slatec/slatec/pchci.f
new file mode 100644
index 0000000..072cf24
--- /dev/null
+++ b/Lib/Slatec/slatec/pchci.f
@@ -0,0 +1,184 @@
+*DECK PCHCI
+ SUBROUTINE PCHCI (N, H, SLOPE, D, INCFD)
+C***BEGIN PROLOGUE PCHCI
+C***SUBSIDIARY
+C***PURPOSE Set interior derivatives for PCHIC
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE SINGLE PRECISION (PCHCI-S, DPCHCI-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C PCHCI: PCHIC Initial Derivative Setter.
+C
+C Called by PCHIC to set derivatives needed to determine a monotone
+C piecewise cubic Hermite interpolant to the data.
+C
+C Default boundary conditions are provided which are compatible
+C with monotonicity. If the data are only piecewise monotonic, the
+C interpolant will have an extremum at each point where monotonicity
+C switches direction.
+C
+C To facilitate two-dimensional applications, includes an increment
+C between successive values of the D-array.
+C
+C The resulting piecewise cubic Hermite function should be identical
+C (within roundoff error) to that produced by PCHIM.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N
+C REAL H(N), SLOPE(N), D(INCFD,N)
+C
+C CALL PCHCI (N, H, SLOPE, D, INCFD)
+C
+C Parameters:
+C
+C N -- (input) number of data points.
+C If N=2, simply does linear interpolation.
+C
+C H -- (input) real array of interval lengths.
+C SLOPE -- (input) real array of data slopes.
+C If the data are (X(I),Y(I)), I=1(1)N, then these inputs are:
+C H(I) = X(I+1)-X(I),
+C SLOPE(I) = (Y(I+1)-Y(I))/H(I), I=1(1)N-1.
+C
+C D -- (output) real array of derivative values at the data points.
+C If the data are monotonic, these values will determine a
+C a monotone cubic Hermite function.
+C The value corresponding to X(I) is stored in
+C D(1+(I-1)*INCFD), I=1(1)N.
+C No other entries in D are changed.
+C
+C INCFD -- (input) increment between successive values in D.
+C This argument is provided primarily for 2-D applications.
+C
+C -------
+C WARNING: This routine does no validity-checking of arguments.
+C -------
+C
+C Fortran intrinsics used: ABS, MAX, MIN.
+C
+C***SEE ALSO PCHIC
+C***ROUTINES CALLED PCHST
+C***REVISION HISTORY (YYMMDD)
+C 820218 DATE WRITTEN
+C 820601 Modified end conditions to be continuous functions of
+C data when monotonicity switches in next interval.
+C 820602 1. Modified formulas so end conditions are less prone
+C to over/underflow problems.
+C 2. Minor modification to HSUM calculation.
+C 820805 Converted to SLATEC library version.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR section in prologue. (WRB)
+C 930503 Improved purpose. (FNF)
+C***END PROLOGUE PCHCI
+C
+C Programming notes:
+C 1. The function PCHST(ARG1,ARG2) is assumed to return zero if
+C either argument is zero, +1 if they are of the same sign, and
+C -1 if they are of opposite sign.
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD
+ REAL H(*), SLOPE(*), D(INCFD,*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, NLESS1
+ REAL DEL1, DEL2, DMAX, DMIN, DRAT1, DRAT2, HSUM, HSUMT3, THREE,
+ * W1, W2, ZERO
+ SAVE ZERO, THREE
+ REAL PCHST
+C
+C INITIALIZE.
+C
+ DATA ZERO /0./, THREE /3./
+C***FIRST EXECUTABLE STATEMENT PCHCI
+ NLESS1 = N - 1
+ DEL1 = SLOPE(1)
+C
+C SPECIAL CASE N=2 -- USE LINEAR INTERPOLATION.
+C
+ IF (NLESS1 .GT. 1) GO TO 10
+ D(1,1) = DEL1
+ D(1,N) = DEL1
+ GO TO 5000
+C
+C NORMAL CASE (N .GE. 3).
+C
+ 10 CONTINUE
+ DEL2 = SLOPE(2)
+C
+C SET D(1) VIA NON-CENTERED THREE-POINT FORMULA, ADJUSTED TO BE
+C SHAPE-PRESERVING.
+C
+ HSUM = H(1) + H(2)
+ W1 = (H(1) + HSUM)/HSUM
+ W2 = -H(1)/HSUM
+ D(1,1) = W1*DEL1 + W2*DEL2
+ IF ( PCHST(D(1,1),DEL1) .LE. ZERO) THEN
+ D(1,1) = ZERO
+ ELSE IF ( PCHST(DEL1,DEL2) .LT. ZERO) THEN
+C NEED DO THIS CHECK ONLY IF MONOTONICITY SWITCHES.
+ DMAX = THREE*DEL1
+ IF (ABS(D(1,1)) .GT. ABS(DMAX)) D(1,1) = DMAX
+ ENDIF
+C
+C LOOP THROUGH INTERIOR POINTS.
+C
+ DO 50 I = 2, NLESS1
+ IF (I .EQ. 2) GO TO 40
+C
+ HSUM = H(I-1) + H(I)
+ DEL1 = DEL2
+ DEL2 = SLOPE(I)
+ 40 CONTINUE
+C
+C SET D(I)=0 UNLESS DATA ARE STRICTLY MONOTONIC.
+C
+ D(1,I) = ZERO
+ IF ( PCHST(DEL1,DEL2) .LE. ZERO) GO TO 50
+C
+C USE BRODLIE MODIFICATION OF BUTLAND FORMULA.
+C
+ HSUMT3 = HSUM+HSUM+HSUM
+ W1 = (HSUM + H(I-1))/HSUMT3
+ W2 = (HSUM + H(I) )/HSUMT3
+ DMAX = MAX( ABS(DEL1), ABS(DEL2) )
+ DMIN = MIN( ABS(DEL1), ABS(DEL2) )
+ DRAT1 = DEL1/DMAX
+ DRAT2 = DEL2/DMAX
+ D(1,I) = DMIN/(W1*DRAT1 + W2*DRAT2)
+C
+ 50 CONTINUE
+C
+C SET D(N) VIA NON-CENTERED THREE-POINT FORMULA, ADJUSTED TO BE
+C SHAPE-PRESERVING.
+C
+ W1 = -H(N-1)/HSUM
+ W2 = (H(N-1) + HSUM)/HSUM
+ D(1,N) = W1*DEL1 + W2*DEL2
+ IF ( PCHST(D(1,N),DEL2) .LE. ZERO) THEN
+ D(1,N) = ZERO
+ ELSE IF ( PCHST(DEL1,DEL2) .LT. ZERO) THEN
+C NEED DO THIS CHECK ONLY IF MONOTONICITY SWITCHES.
+ DMAX = THREE*DEL2
+ IF (ABS(D(1,N)) .GT. ABS(DMAX)) D(1,N) = DMAX
+ ENDIF
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ RETURN
+C------------- LAST LINE OF PCHCI FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchcm.f b/Lib/Slatec/slatec/pchcm.f
new file mode 100644
index 0000000..7b82380
--- /dev/null
+++ b/Lib/Slatec/slatec/pchcm.f
@@ -0,0 +1,236 @@
+*DECK PCHCM
+ SUBROUTINE PCHCM (N, X, F, D, INCFD, SKIP, ISMON, IERR)
+C***BEGIN PROLOGUE PCHCM
+C***PURPOSE Check a cubic Hermite function for monotonicity.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3
+C***TYPE SINGLE PRECISION (PCHCM-S, DPCHCM-D)
+C***KEYWORDS CUBIC HERMITE INTERPOLATION, MONOTONE INTERPOLATION,
+C PCHIP, PIECEWISE CUBIC INTERPOLATION, UTILITY ROUTINE
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Computing & Mathematics Research Division
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C *Usage:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, ISMON(N), IERR
+C REAL X(N), F(INCFD,N), D(INCFD,N)
+C LOGICAL SKIP
+C
+C CALL PCHCM (N, X, F, D, INCFD, SKIP, ISMON, IERR)
+C
+C *Arguments:
+C
+C N:IN is the number of data points. (Error return if N.LT.2 .)
+C
+C X:IN is a real array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F:IN is a real array of function values. F(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C D:IN is a real array of derivative values. D(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C INCFD:IN is the increment between successive values in F and D.
+C (Error return if INCFD.LT.1 .)
+C
+C SKIP:INOUT is a logical variable which should be set to
+C .TRUE. if the user wishes to skip checks for validity of
+C preceding parameters, or to .FALSE. otherwise.
+C This will save time in case these checks have already
+C been performed.
+C SKIP will be set to .TRUE. on normal return.
+C
+C ISMON:OUT is an integer array indicating on which intervals the
+C PCH function defined by N, X, F, D is monotonic.
+C For data interval [X(I),X(I+1)],
+C ISMON(I) = -3 if function is probably decreasing;
+C ISMON(I) = -1 if function is strictly decreasing;
+C ISMON(I) = 0 if function is constant;
+C ISMON(I) = 1 if function is strictly increasing;
+C ISMON(I) = 2 if function is non-monotonic;
+C ISMON(I) = 3 if function is probably increasing.
+C If ABS(ISMON)=3, this means that the D-values are near
+C the boundary of the monotonicity region. A small
+C increase produces non-monotonicity; decrease, strict
+C monotonicity.
+C The above applies to I=1(1)N-1. ISMON(N) indicates whether
+C the entire function is monotonic on [X(1),X(N)].
+C
+C IERR:OUT is an error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C (The ISMON-array has not been changed in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C
+C *Description:
+C
+C PCHCM: Piecewise Cubic Hermite -- Check Monotonicity.
+C
+C Checks the piecewise cubic Hermite function defined by N,X,F,D
+C for monotonicity.
+C
+C To provide compatibility with PCHIM and PCHIC, includes an
+C increment between successive values of the F- and D-arrays.
+C
+C *Cautions:
+C This provides the same capability as old PCHMC, except that a
+C new output value, -3, was added February 1989. (Formerly, -3
+C and +3 were lumped together in the single value 3.) Codes that
+C flag nonmonotonicity by "IF (ISMON.EQ.2)" need not be changed.
+C Codes that check via "IF (ISMON.GE.3)" should change the test to
+C "IF (IABS(ISMON).GE.3)". Codes that declare monotonicity via
+C "IF (ISMON.LE.1)" should change to "IF (IABS(ISMON).LE.1)".
+C
+C***REFERENCES F. N. Fritsch and R. E. Carlson, Monotone piecewise
+C cubic interpolation, SIAM Journal on Numerical Ana-
+C lysis 17, 2 (April 1980), pp. 238-246.
+C***ROUTINES CALLED CHFCM, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820518 DATE WRITTEN
+C 820804 Converted to SLATEC library version.
+C 831201 Reversed order of subscripts of F and D, so that the
+C routine will work properly when INCFD.GT.1 . (Bug!!)
+C 870707 Minor cosmetic changes to prologue.
+C 890208 Added possible ISMON value of -3 and modified code so
+C that 1,3,-1 produces ISMON(N)=2, rather than 3.
+C 890306 Added caution about changed output.
+C 890407 Changed name from PCHMC to PCHCM, as requested at the
+C March 1989 SLATEC CML meeting, and made a few other
+C minor modifications necessitated by this change.
+C 890407 Converted to new SLATEC format.
+C 890407 Modified DESCRIPTION to LDOC format.
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 920429 Revised format and order of references. (WRB,FNF)
+C***END PROLOGUE PCHCM
+C
+C Fortran intrinsics used: ISIGN.
+C Other routines used: CHFCM, XERMSG.
+C
+C ----------------------------------------------------------------------
+C
+C Programming notes:
+C
+C An alternate organization would have separate loops for computing
+C ISMON(i), i=1,...,NSEG, and for the computation of ISMON(N). The
+C first loop can be readily parallelized, since the NSEG calls to
+C CHFCM are independent. The second loop can be cut short if
+C ISMON(N) is ever equal to 2, for it cannot be changed further.
+C
+C To produce a double precision version, simply:
+C a. Change PCHCM to DPCHCM wherever it occurs,
+C b. Change CHFCM to DCHFCM wherever it occurs, and
+C c. Change the real declarations to double precision.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, ISMON(N), IERR
+ REAL X(N), F(INCFD,N), D(INCFD,N)
+ LOGICAL SKIP
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, NSEG
+ REAL DELTA
+ INTEGER CHFCM
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT PCHCM
+ IF (SKIP) GO TO 5
+C
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+ SKIP = .TRUE.
+C
+C FUNCTION DEFINITION IS OK -- GO ON.
+C
+ 5 CONTINUE
+ NSEG = N - 1
+ DO 90 I = 1, NSEG
+ DELTA = (F(1,I+1)-F(1,I))/(X(I+1)-X(I))
+C -------------------------------
+ ISMON(I) = CHFCM (D(1,I), D(1,I+1), DELTA)
+C -------------------------------
+ IF (I .EQ. 1) THEN
+ ISMON(N) = ISMON(1)
+ ELSE
+C Need to figure out cumulative monotonicity from following
+C "multiplication table":
+C
+C + I S M O N (I)
+C + -3 -1 0 1 3 2
+C +------------------------+
+C I -3 I -3 -3 -3 2 2 2 I
+C S -1 I -3 -1 -1 2 2 2 I
+C M 0 I -3 -1 0 1 3 2 I
+C O 1 I 2 2 1 1 3 2 I
+C N 3 I 2 2 3 3 3 2 I
+C (N) 2 I 2 2 2 2 2 2 I
+C +------------------------+
+C Note that the 2 row and column are out of order so as not
+C to obscure the symmetry in the rest of the table.
+C
+C No change needed if equal or constant on this interval or
+C already declared nonmonotonic.
+ IF ( (ISMON(I).NE.ISMON(N)) .AND. (ISMON(I).NE.0)
+ . .AND. (ISMON(N).NE.2) ) THEN
+ IF ( (ISMON(I).EQ.2) .OR. (ISMON(N).EQ.0) ) THEN
+ ISMON(N) = ISMON(I)
+ ELSE IF (ISMON(I)*ISMON(N) .LT. 0) THEN
+C This interval has opposite sense from curve so far.
+ ISMON(N) = 2
+ ELSE
+C At this point, both are nonzero with same sign, and
+C we have already eliminated case both +-1.
+ ISMON(N) = ISIGN (3, ISMON(N))
+ ENDIF
+ ENDIF
+ ENDIF
+ 90 CONTINUE
+C
+C NORMAL RETURN.
+C
+ IERR = 0
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'PCHCM',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'PCHCM', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ RETURN
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'PCHCM', 'X-ARRAY NOT STRICTLY INCREASING'
+ + , IERR, 1)
+ RETURN
+C------------- LAST LINE OF PCHCM FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchcs.f b/Lib/Slatec/slatec/pchcs.f
new file mode 100644
index 0000000..c7f0357
--- /dev/null
+++ b/Lib/Slatec/slatec/pchcs.f
@@ -0,0 +1,235 @@
+*DECK PCHCS
+ SUBROUTINE PCHCS (SWITCH, N, H, SLOPE, D, INCFD, IERR)
+C***BEGIN PROLOGUE PCHCS
+C***SUBSIDIARY
+C***PURPOSE Adjusts derivative values for PCHIC
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE SINGLE PRECISION (PCHCS-S, DPCHCS-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C PCHCS: PCHIC Monotonicity Switch Derivative Setter.
+C
+C Called by PCHIC to adjust the values of D in the vicinity of a
+C switch in direction of monotonicity, to produce a more "visually
+C pleasing" curve than that given by PCHIM .
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, IERR
+C REAL SWITCH, H(N), SLOPE(N), D(INCFD,N)
+C
+C CALL PCHCS (SWITCH, N, H, SLOPE, D, INCFD, IERR)
+C
+C Parameters:
+C
+C SWITCH -- (input) indicates the amount of control desired over
+C local excursions from data.
+C
+C N -- (input) number of data points. (assumes N.GT.2 .)
+C
+C H -- (input) real array of interval lengths.
+C SLOPE -- (input) real array of data slopes.
+C If the data are (X(I),Y(I)), I=1(1)N, then these inputs are:
+C H(I) = X(I+1)-X(I),
+C SLOPE(I) = (Y(I+1)-Y(I))/H(I), I=1(1)N-1.
+C
+C D -- (input) real array of derivative values at the data points,
+C as determined by PCHCI.
+C (output) derivatives in the vicinity of switches in direction
+C of monotonicity may be adjusted to produce a more "visually
+C pleasing" curve.
+C The value corresponding to X(I) is stored in
+C D(1+(I-1)*INCFD), I=1(1)N.
+C No other entries in D are changed.
+C
+C INCFD -- (input) increment between successive values in D.
+C This argument is provided primarily for 2-D applications.
+C
+C IERR -- (output) error flag. should be zero.
+C If negative, trouble in PCHSW. (should never happen.)
+C
+C -------
+C WARNING: This routine does no validity-checking of arguments.
+C -------
+C
+C Fortran intrinsics used: ABS, MAX, MIN.
+C
+C***SEE ALSO PCHIC
+C***ROUTINES CALLED PCHST, PCHSW
+C***REVISION HISTORY (YYMMDD)
+C 820218 DATE WRITTEN
+C 820617 Redesigned to (1) fix problem with lack of continuity
+C approaching a flat-topped peak (2) be cleaner and
+C easier to verify.
+C Eliminated subroutines PCHSA and PCHSX in the process.
+C 820622 1. Limited fact to not exceed one, so computed D is a
+C convex combination of PCHCI value and PCHSD value.
+C 2. Changed fudge from 1 to 4 (based on experiments).
+C 820623 Moved PCHSD to an inline function (eliminating MSWTYP).
+C 820805 Converted to SLATEC library version.
+C 870813 Minor cosmetic changes.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR section in prologue. (WRB)
+C 930503 Improved purpose. (FNF)
+C***END PROLOGUE PCHCS
+C
+C Programming notes:
+C 1. The function PCHST(ARG1,ARG2) is assumed to return zero if
+C either argument is zero, +1 if they are of the same sign, and
+C -1 if they are of opposite sign.
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, IERR
+ REAL SWITCH, H(*), SLOPE(*), D(INCFD,*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, INDX, K, NLESS1
+ REAL DEL(3), DEXT, DFLOC, DFMX, FACT, FUDGE, ONE, SLMAX,
+ * WTAVE(2), ZERO
+ SAVE ZERO, ONE, FUDGE
+ REAL PCHST
+C
+C DEFINE INLINE FUNCTION FOR WEIGHTED AVERAGE OF SLOPES.
+C
+ REAL PCHSD, S1, S2, H1, H2
+ PCHSD(S1,S2,H1,H2) = (H2/(H1+H2))*S1 + (H1/(H1+H2))*S2
+C
+C INITIALIZE.
+C
+ DATA ZERO /0./, ONE /1./
+ DATA FUDGE /4./
+C***FIRST EXECUTABLE STATEMENT PCHCS
+ IERR = 0
+ NLESS1 = N - 1
+C
+C LOOP OVER SEGMENTS.
+C
+ DO 900 I = 2, NLESS1
+ IF ( PCHST(SLOPE(I-1),SLOPE(I)) ) 100, 300, 900
+C --------------------------
+C
+ 100 CONTINUE
+C
+C....... SLOPE SWITCHES MONOTONICITY AT I-TH POINT .....................
+C
+C DO NOT CHANGE D IF 'UP-DOWN-UP'.
+ IF (I .GT. 2) THEN
+ IF ( PCHST(SLOPE(I-2),SLOPE(I)) .GT. ZERO) GO TO 900
+C --------------------------
+ ENDIF
+ IF (I .LT. NLESS1) THEN
+ IF ( PCHST(SLOPE(I+1),SLOPE(I-1)) .GT. ZERO) GO TO 900
+C ----------------------------
+ ENDIF
+C
+C ....... COMPUTE PROVISIONAL VALUE FOR D(1,I).
+C
+ DEXT = PCHSD (SLOPE(I-1), SLOPE(I), H(I-1), H(I))
+C
+C ....... DETERMINE WHICH INTERVAL CONTAINS THE EXTREMUM.
+C
+ IF ( PCHST(DEXT, SLOPE(I-1)) ) 200, 900, 250
+C -----------------------
+C
+ 200 CONTINUE
+C DEXT AND SLOPE(I-1) HAVE OPPOSITE SIGNS --
+C EXTREMUM IS IN (X(I-1),X(I)).
+ K = I-1
+C SET UP TO COMPUTE NEW VALUES FOR D(1,I-1) AND D(1,I).
+ WTAVE(2) = DEXT
+ IF (K .GT. 1)
+ * WTAVE(1) = PCHSD (SLOPE(K-1), SLOPE(K), H(K-1), H(K))
+ GO TO 400
+C
+ 250 CONTINUE
+C DEXT AND SLOPE(I) HAVE OPPOSITE SIGNS --
+C EXTREMUM IS IN (X(I),X(I+1)).
+ K = I
+C SET UP TO COMPUTE NEW VALUES FOR D(1,I) AND D(1,I+1).
+ WTAVE(1) = DEXT
+ IF (K .LT. NLESS1)
+ * WTAVE(2) = PCHSD (SLOPE(K), SLOPE(K+1), H(K), H(K+1))
+ GO TO 400
+C
+ 300 CONTINUE
+C
+C....... AT LEAST ONE OF SLOPE(I-1) AND SLOPE(I) IS ZERO --
+C CHECK FOR FLAT-TOPPED PEAK .......................
+C
+ IF (I .EQ. NLESS1) GO TO 900
+ IF ( PCHST(SLOPE(I-1), SLOPE(I+1)) .GE. ZERO) GO TO 900
+C -----------------------------
+C
+C WE HAVE FLAT-TOPPED PEAK ON (X(I),X(I+1)).
+ K = I
+C SET UP TO COMPUTE NEW VALUES FOR D(1,I) AND D(1,I+1).
+ WTAVE(1) = PCHSD (SLOPE(K-1), SLOPE(K), H(K-1), H(K))
+ WTAVE(2) = PCHSD (SLOPE(K), SLOPE(K+1), H(K), H(K+1))
+C
+ 400 CONTINUE
+C
+C....... AT THIS POINT WE HAVE DETERMINED THAT THERE WILL BE AN EXTREMUM
+C ON (X(K),X(K+1)), WHERE K=I OR I-1, AND HAVE SET ARRAY WTAVE--
+C WTAVE(1) IS A WEIGHTED AVERAGE OF SLOPE(K-1) AND SLOPE(K),
+C IF K.GT.1
+C WTAVE(2) IS A WEIGHTED AVERAGE OF SLOPE(K) AND SLOPE(K+1),
+C IF K.LT.N-1
+C
+ SLMAX = ABS(SLOPE(K))
+ IF (K .GT. 1) SLMAX = MAX( SLMAX, ABS(SLOPE(K-1)) )
+ IF (K.LT.NLESS1) SLMAX = MAX( SLMAX, ABS(SLOPE(K+1)) )
+C
+ IF (K .GT. 1) DEL(1) = SLOPE(K-1) / SLMAX
+ DEL(2) = SLOPE(K) / SLMAX
+ IF (K.LT.NLESS1) DEL(3) = SLOPE(K+1) / SLMAX
+C
+ IF ((K.GT.1) .AND. (K.LT.NLESS1)) THEN
+C NORMAL CASE -- EXTREMUM IS NOT IN A BOUNDARY INTERVAL.
+ FACT = FUDGE* ABS(DEL(3)*(DEL(1)-DEL(2))*(WTAVE(2)/SLMAX))
+ D(1,K) = D(1,K) + MIN(FACT,ONE)*(WTAVE(1) - D(1,K))
+ FACT = FUDGE* ABS(DEL(1)*(DEL(3)-DEL(2))*(WTAVE(1)/SLMAX))
+ D(1,K+1) = D(1,K+1) + MIN(FACT,ONE)*(WTAVE(2) - D(1,K+1))
+ ELSE
+C SPECIAL CASE K=1 (WHICH CAN OCCUR ONLY IF I=2) OR
+C K=NLESS1 (WHICH CAN OCCUR ONLY IF I=NLESS1).
+ FACT = FUDGE* ABS(DEL(2))
+ D(1,I) = MIN(FACT,ONE) * WTAVE(I-K+1)
+C NOTE THAT I-K+1 = 1 IF K=I (=NLESS1),
+C I-K+1 = 2 IF K=I-1(=1).
+ ENDIF
+C
+C
+C....... ADJUST IF NECESSARY TO LIMIT EXCURSIONS FROM DATA.
+C
+ IF (SWITCH .LE. ZERO) GO TO 900
+C
+ DFLOC = H(K)*ABS(SLOPE(K))
+ IF (K .GT. 1) DFLOC = MAX( DFLOC, H(K-1)*ABS(SLOPE(K-1)) )
+ IF (K.LT.NLESS1) DFLOC = MAX( DFLOC, H(K+1)*ABS(SLOPE(K+1)) )
+ DFMX = SWITCH*DFLOC
+ INDX = I-K+1
+C INDX = 1 IF K=I, 2 IF K=I-1.
+C ---------------------------------------------------------------
+ CALL PCHSW (DFMX, INDX, D(1,K), D(1,K+1), H(K), SLOPE(K), IERR)
+C ---------------------------------------------------------------
+ IF (IERR .NE. 0) RETURN
+C
+C....... END OF SEGMENT LOOP.
+C
+ 900 CONTINUE
+C
+ RETURN
+C------------- LAST LINE OF PCHCS FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchdf.f b/Lib/Slatec/slatec/pchdf.f
new file mode 100644
index 0000000..e40a900
--- /dev/null
+++ b/Lib/Slatec/slatec/pchdf.f
@@ -0,0 +1,106 @@
+*DECK PCHDF
+ REAL FUNCTION PCHDF (K, X, S, IERR)
+C***BEGIN PROLOGUE PCHDF
+C***SUBSIDIARY
+C***PURPOSE Computes divided differences for PCHCE and PCHSP
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE SINGLE PRECISION (PCHDF-S, DPCHDF-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C PCHDF: PCHIP Finite Difference Formula
+C
+C Uses a divided difference formulation to compute a K-point approx-
+C imation to the derivative at X(K) based on the data in X and S.
+C
+C Called by PCHCE and PCHSP to compute 3- and 4-point boundary
+C derivative approximations.
+C
+C ----------------------------------------------------------------------
+C
+C On input:
+C K is the order of the desired derivative approximation.
+C K must be at least 3 (error return if not).
+C X contains the K values of the independent variable.
+C X need not be ordered, but the values **MUST** be
+C distinct. (Not checked here.)
+C S contains the associated slope values:
+C S(I) = (F(I+1)-F(I))/(X(I+1)-X(I)), I=1(1)K-1.
+C (Note that S need only be of length K-1.)
+C
+C On return:
+C S will be destroyed.
+C IERR will be set to -1 if K.LT.2 .
+C PCHDF will be set to the desired derivative approximation if
+C IERR=0 or to zero if IERR=-1.
+C
+C ----------------------------------------------------------------------
+C
+C***SEE ALSO PCHCE, PCHSP
+C***REFERENCES Carl de Boor, A Practical Guide to Splines, Springer-
+C Verlag, New York, 1978, pp. 10-16.
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820503 DATE WRITTEN
+C 820805 Converted to SLATEC library version.
+C 870813 Minor cosmetic changes.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890411 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR and DATE WRITTEN sections in prologue. (WRB)
+C 920429 Revised format and order of references. (WRB,FNF)
+C 930503 Improved purpose. (FNF)
+C***END PROLOGUE PCHDF
+C
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER K, IERR
+ REAL X(K), S(K)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, J
+ REAL VALUE, ZERO
+ SAVE ZERO
+ DATA ZERO /0./
+C
+C CHECK FOR LEGAL VALUE OF K.
+C
+C***FIRST EXECUTABLE STATEMENT PCHDF
+ IF (K .LT. 3) GO TO 5001
+C
+C COMPUTE COEFFICIENTS OF INTERPOLATING POLYNOMIAL.
+C
+ DO 10 J = 2, K-1
+ DO 9 I = 1, K-J
+ S(I) = (S(I+1)-S(I))/(X(I+J)-X(I))
+ 9 CONTINUE
+ 10 CONTINUE
+C
+C EVALUATE DERIVATIVE AT X(K).
+C
+ VALUE = S(1)
+ DO 20 I = 2, K-1
+ VALUE = S(I) + VALUE*(X(K)-X(I))
+ 20 CONTINUE
+C
+C NORMAL RETURN.
+C
+ IERR = 0
+ PCHDF = VALUE
+ RETURN
+C
+C ERROR RETURN.
+C
+ 5001 CONTINUE
+C K.LT.3 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'PCHDF', 'K LESS THAN THREE', IERR, 1)
+ PCHDF = ZERO
+ RETURN
+C------------- LAST LINE OF PCHDF FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchfd.f b/Lib/Slatec/slatec/pchfd.f
new file mode 100644
index 0000000..b073e55
--- /dev/null
+++ b/Lib/Slatec/slatec/pchfd.f
@@ -0,0 +1,320 @@
+*DECK PCHFD
+ SUBROUTINE PCHFD (N, X, F, D, INCFD, SKIP, NE, XE, FE, DE, IERR)
+C***BEGIN PROLOGUE PCHFD
+C***PURPOSE Evaluate a piecewise cubic Hermite function and its first
+C derivative at an array of points. May be used by itself
+C for Hermite interpolation, or as an evaluator for PCHIM
+C or PCHIC. If only function values are required, use
+C PCHFE instead.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3, H1
+C***TYPE SINGLE PRECISION (PCHFD-S, DPCHFD-D)
+C***KEYWORDS CUBIC HERMITE DIFFERENTIATION, CUBIC HERMITE EVALUATION,
+C HERMITE INTERPOLATION, PCHIP, PIECEWISE CUBIC EVALUATION
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C PCHFD: Piecewise Cubic Hermite Function and Derivative
+C evaluator
+C
+C Evaluates the cubic Hermite function defined by N, X, F, D, to-
+C gether with its first derivative, at the points XE(J), J=1(1)NE.
+C
+C If only function values are required, use PCHFE, instead.
+C
+C To provide compatibility with PCHIM and PCHIC, includes an
+C increment between successive values of the F- and D-arrays.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, NE, IERR
+C REAL X(N), F(INCFD,N), D(INCFD,N), XE(NE), FE(NE), DE(NE)
+C LOGICAL SKIP
+C
+C CALL PCHFD (N, X, F, D, INCFD, SKIP, NE, XE, FE, DE, IERR)
+C
+C Parameters:
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C
+C X -- (input) real array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real array of function values. F(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C D -- (input) real array of derivative values. D(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C INCFD -- (input) increment between successive values in F and D.
+C (Error return if INCFD.LT.1 .)
+C
+C SKIP -- (input/output) logical variable which should be set to
+C .TRUE. if the user wishes to skip checks for validity of
+C preceding parameters, or to .FALSE. otherwise.
+C This will save time in case these checks have already
+C been performed (say, in PCHIM or PCHIC).
+C SKIP will be set to .TRUE. on normal return.
+C
+C NE -- (input) number of evaluation points. (Error return if
+C NE.LT.1 .)
+C
+C XE -- (input) real array of points at which the functions are to
+C be evaluated.
+C
+C
+C NOTES:
+C 1. The evaluation will be most efficient if the elements
+C of XE are increasing relative to X;
+C that is, XE(J) .GE. X(I)
+C implies XE(K) .GE. X(I), all K.GE.J .
+C 2. If any of the XE are outside the interval [X(1),X(N)],
+C values are extrapolated from the nearest extreme cubic,
+C and a warning error is returned.
+C
+C FE -- (output) real array of values of the cubic Hermite function
+C defined by N, X, F, D at the points XE.
+C
+C DE -- (output) real array of values of the first derivative of
+C the same function at the points XE.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C Warning error:
+C IERR.GT.0 means that extrapolation was performed at
+C IERR points.
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C IERR = -4 if NE.LT.1 .
+C (Output arrays have not been changed in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C IERR = -5 if an error has occurred in the lower-level
+C routine CHFDV. NB: this should never happen.
+C Notify the author **IMMEDIATELY** if it does.
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED CHFDV, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 811020 DATE WRITTEN
+C 820803 Minor cosmetic changes for release 1.
+C 870707 Minor cosmetic changes to prologue.
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C***END PROLOGUE PCHFD
+C Programming notes:
+C
+C 1. To produce a double precision version, simply:
+C a. Change PCHFD to DPCHFD, and CHFDV to DCHFDV, wherever they
+C occur,
+C b. Change the real declaration to double precision,
+C
+C 2. Most of the coding between the call to CHFDV and the end of
+C the IR-loop could be eliminated if it were permissible to
+C assume that XE is ordered relative to X.
+C
+C 3. CHFDV does not assume that X1 is less than X2. thus, it would
+C be possible to write a version of PCHFD that assumes a strict-
+C ly decreasing X-array by simply running the IR-loop backwards
+C (and reversing the order of appropriate tests).
+C
+C 4. The present code has a minor bug, which I have decided is not
+C worth the effort that would be required to fix it.
+C If XE contains points in [X(N-1),X(N)], followed by points .LT.
+C X(N-1), followed by points .GT.X(N), the extrapolation points
+C will be counted (at least) twice in the total returned in IERR.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, NE, IERR
+ REAL X(*), F(INCFD,*), D(INCFD,*), XE(*), FE(*), DE(*)
+ LOGICAL SKIP
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, IERC, IR, J, JFIRST, NEXT(2), NJ
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT PCHFD
+ IF (SKIP) GO TO 5
+C
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+C
+C FUNCTION DEFINITION IS OK, GO ON.
+C
+ 5 CONTINUE
+ IF ( NE.LT.1 ) GO TO 5004
+ IERR = 0
+ SKIP = .TRUE.
+C
+C LOOP OVER INTERVALS. ( INTERVAL INDEX IS IL = IR-1 . )
+C ( INTERVAL IS X(IL).LE.X.LT.X(IR) . )
+ JFIRST = 1
+ IR = 2
+ 10 CONTINUE
+C
+C SKIP OUT OF LOOP IF HAVE PROCESSED ALL EVALUATION POINTS.
+C
+ IF (JFIRST .GT. NE) GO TO 5000
+C
+C LOCATE ALL POINTS IN INTERVAL.
+C
+ DO 20 J = JFIRST, NE
+ IF (XE(J) .GE. X(IR)) GO TO 30
+ 20 CONTINUE
+ J = NE + 1
+ GO TO 40
+C
+C HAVE LOCATED FIRST POINT BEYOND INTERVAL.
+C
+ 30 CONTINUE
+ IF (IR .EQ. N) J = NE + 1
+C
+ 40 CONTINUE
+ NJ = J - JFIRST
+C
+C SKIP EVALUATION IF NO POINTS IN INTERVAL.
+C
+ IF (NJ .EQ. 0) GO TO 50
+C
+C EVALUATE CUBIC AT XE(I), I = JFIRST (1) J-1 .
+C
+C ----------------------------------------------------------------
+ CALL CHFDV (X(IR-1),X(IR), F(1,IR-1),F(1,IR), D(1,IR-1),D(1,IR),
+ * NJ, XE(JFIRST), FE(JFIRST), DE(JFIRST), NEXT, IERC)
+C ----------------------------------------------------------------
+ IF (IERC .LT. 0) GO TO 5005
+C
+ IF (NEXT(2) .EQ. 0) GO TO 42
+C IF (NEXT(2) .GT. 0) THEN
+C IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(2) TO THE
+C RIGHT OF X(IR).
+C
+ IF (IR .LT. N) GO TO 41
+C IF (IR .EQ. N) THEN
+C THESE ARE ACTUALLY EXTRAPOLATION POINTS.
+ IERR = IERR + NEXT(2)
+ GO TO 42
+ 41 CONTINUE
+C ELSE
+C WE SHOULD NEVER HAVE GOTTEN HERE.
+ GO TO 5005
+C ENDIF
+C ENDIF
+ 42 CONTINUE
+C
+ IF (NEXT(1) .EQ. 0) GO TO 49
+C IF (NEXT(1) .GT. 0) THEN
+C IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(1) TO THE
+C LEFT OF X(IR-1).
+C
+ IF (IR .GT. 2) GO TO 43
+C IF (IR .EQ. 2) THEN
+C THESE ARE ACTUALLY EXTRAPOLATION POINTS.
+ IERR = IERR + NEXT(1)
+ GO TO 49
+ 43 CONTINUE
+C ELSE
+C XE IS NOT ORDERED RELATIVE TO X, SO MUST ADJUST
+C EVALUATION INTERVAL.
+C
+C FIRST, LOCATE FIRST POINT TO LEFT OF X(IR-1).
+ DO 44 I = JFIRST, J-1
+ IF (XE(I) .LT. X(IR-1)) GO TO 45
+ 44 CONTINUE
+C NOTE-- CANNOT DROP THROUGH HERE UNLESS THERE IS AN ERROR
+C IN CHFDV.
+ GO TO 5005
+C
+ 45 CONTINUE
+C RESET J. (THIS WILL BE THE NEW JFIRST.)
+ J = I
+C
+C NOW FIND OUT HOW FAR TO BACK UP IN THE X-ARRAY.
+ DO 46 I = 1, IR-1
+ IF (XE(J) .LT. X(I)) GO TO 47
+ 46 CONTINUE
+C NB-- CAN NEVER DROP THROUGH HERE, SINCE XE(J).LT.X(IR-1).
+C
+ 47 CONTINUE
+C AT THIS POINT, EITHER XE(J) .LT. X(1)
+C OR X(I-1) .LE. XE(J) .LT. X(I) .
+C RESET IR, RECOGNIZING THAT IT WILL BE INCREMENTED BEFORE
+C CYCLING.
+ IR = MAX(1, I-1)
+C ENDIF
+C ENDIF
+ 49 CONTINUE
+C
+ JFIRST = J
+C
+C END OF IR-LOOP.
+C
+ 50 CONTINUE
+ IR = IR + 1
+ IF (IR .LE. N) GO TO 10
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'PCHFD',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'PCHFD', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ RETURN
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'PCHFD', 'X-ARRAY NOT STRICTLY INCREASING'
+ + , IERR, 1)
+ RETURN
+C
+ 5004 CONTINUE
+C NE.LT.1 RETURN.
+ IERR = -4
+ CALL XERMSG ('SLATEC', 'PCHFD',
+ + 'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)
+ RETURN
+C
+ 5005 CONTINUE
+C ERROR RETURN FROM CHFDV.
+C *** THIS CASE SHOULD NEVER OCCUR ***
+ IERR = -5
+ CALL XERMSG ('SLATEC', 'PCHFD',
+ + 'ERROR RETURN FROM CHFDV -- FATAL', IERR, 2)
+ RETURN
+C------------- LAST LINE OF PCHFD FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchfe.f b/Lib/Slatec/slatec/pchfe.f
new file mode 100644
index 0000000..5bd9a28
--- /dev/null
+++ b/Lib/Slatec/slatec/pchfe.f
@@ -0,0 +1,308 @@
+*DECK PCHFE
+ SUBROUTINE PCHFE (N, X, F, D, INCFD, SKIP, NE, XE, FE, IERR)
+C***BEGIN PROLOGUE PCHFE
+C***PURPOSE Evaluate a piecewise cubic Hermite function at an array of
+C points. May be used by itself for Hermite interpolation,
+C or as an evaluator for PCHIM or PCHIC.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3
+C***TYPE SINGLE PRECISION (PCHFE-S, DPCHFE-D)
+C***KEYWORDS CUBIC HERMITE EVALUATION, HERMITE INTERPOLATION, PCHIP,
+C PIECEWISE CUBIC EVALUATION
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C PCHFE: Piecewise Cubic Hermite Function Evaluator
+C
+C Evaluates the cubic Hermite function defined by N, X, F, D at
+C the points XE(J), J=1(1)NE.
+C
+C To provide compatibility with PCHIM and PCHIC, includes an
+C increment between successive values of the F- and D-arrays.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, NE, IERR
+C REAL X(N), F(INCFD,N), D(INCFD,N), XE(NE), FE(NE)
+C LOGICAL SKIP
+C
+C CALL PCHFE (N, X, F, D, INCFD, SKIP, NE, XE, FE, IERR)
+C
+C Parameters:
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C
+C X -- (input) real array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real array of function values. F(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C D -- (input) real array of derivative values. D(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C INCFD -- (input) increment between successive values in F and D.
+C (Error return if INCFD.LT.1 .)
+C
+C SKIP -- (input/output) logical variable which should be set to
+C .TRUE. if the user wishes to skip checks for validity of
+C preceding parameters, or to .FALSE. otherwise.
+C This will save time in case these checks have already
+C been performed (say, in PCHIM or PCHIC).
+C SKIP will be set to .TRUE. on normal return.
+C
+C NE -- (input) number of evaluation points. (Error return if
+C NE.LT.1 .)
+C
+C XE -- (input) real array of points at which the function is to be
+C evaluated.
+C
+C NOTES:
+C 1. The evaluation will be most efficient if the elements
+C of XE are increasing relative to X;
+C that is, XE(J) .GE. X(I)
+C implies XE(K) .GE. X(I), all K.GE.J .
+C 2. If any of the XE are outside the interval [X(1),X(N)],
+C values are extrapolated from the nearest extreme cubic,
+C and a warning error is returned.
+C
+C FE -- (output) real array of values of the cubic Hermite function
+C defined by N, X, F, D at the points XE.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C Warning error:
+C IERR.GT.0 means that extrapolation was performed at
+C IERR points.
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C IERR = -4 if NE.LT.1 .
+C (The FE-array has not been changed in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED CHFEV, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 811020 DATE WRITTEN
+C 820803 Minor cosmetic changes for release 1.
+C 870707 Minor cosmetic changes to prologue.
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C***END PROLOGUE PCHFE
+C Programming notes:
+C
+C 1. To produce a double precision version, simply:
+C a. Change PCHFE to DPCHFE, and CHFEV to DCHFEV, wherever they
+C occur,
+C b. Change the real declaration to double precision,
+C
+C 2. Most of the coding between the call to CHFEV and the end of
+C the IR-loop could be eliminated if it were permissible to
+C assume that XE is ordered relative to X.
+C
+C 3. CHFEV does not assume that X1 is less than X2. thus, it would
+C be possible to write a version of PCHFE that assumes a strict-
+C ly decreasing X-array by simply running the IR-loop backwards
+C (and reversing the order of appropriate tests).
+C
+C 4. The present code has a minor bug, which I have decided is not
+C worth the effort that would be required to fix it.
+C If XE contains points in [X(N-1),X(N)], followed by points .LT.
+C X(N-1), followed by points .GT.X(N), the extrapolation points
+C will be counted (at least) twice in the total returned in IERR.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, NE, IERR
+ REAL X(*), F(INCFD,*), D(INCFD,*), XE(*), FE(*)
+ LOGICAL SKIP
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, IERC, IR, J, JFIRST, NEXT(2), NJ
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT PCHFE
+ IF (SKIP) GO TO 5
+C
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+C
+C FUNCTION DEFINITION IS OK, GO ON.
+C
+ 5 CONTINUE
+ IF ( NE.LT.1 ) GO TO 5004
+ IERR = 0
+ SKIP = .TRUE.
+C
+C LOOP OVER INTERVALS. ( INTERVAL INDEX IS IL = IR-1 . )
+C ( INTERVAL IS X(IL).LE.X.LT.X(IR) . )
+ JFIRST = 1
+ IR = 2
+ 10 CONTINUE
+C
+C SKIP OUT OF LOOP IF HAVE PROCESSED ALL EVALUATION POINTS.
+C
+ IF (JFIRST .GT. NE) GO TO 5000
+C
+C LOCATE ALL POINTS IN INTERVAL.
+C
+ DO 20 J = JFIRST, NE
+ IF (XE(J) .GE. X(IR)) GO TO 30
+ 20 CONTINUE
+ J = NE + 1
+ GO TO 40
+C
+C HAVE LOCATED FIRST POINT BEYOND INTERVAL.
+C
+ 30 CONTINUE
+ IF (IR .EQ. N) J = NE + 1
+C
+ 40 CONTINUE
+ NJ = J - JFIRST
+C
+C SKIP EVALUATION IF NO POINTS IN INTERVAL.
+C
+ IF (NJ .EQ. 0) GO TO 50
+C
+C EVALUATE CUBIC AT XE(I), I = JFIRST (1) J-1 .
+C
+C ----------------------------------------------------------------
+ CALL CHFEV (X(IR-1),X(IR), F(1,IR-1),F(1,IR), D(1,IR-1),D(1,IR),
+ * NJ, XE(JFIRST), FE(JFIRST), NEXT, IERC)
+C ----------------------------------------------------------------
+ IF (IERC .LT. 0) GO TO 5005
+C
+ IF (NEXT(2) .EQ. 0) GO TO 42
+C IF (NEXT(2) .GT. 0) THEN
+C IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(2) TO THE
+C RIGHT OF X(IR).
+C
+ IF (IR .LT. N) GO TO 41
+C IF (IR .EQ. N) THEN
+C THESE ARE ACTUALLY EXTRAPOLATION POINTS.
+ IERR = IERR + NEXT(2)
+ GO TO 42
+ 41 CONTINUE
+C ELSE
+C WE SHOULD NEVER HAVE GOTTEN HERE.
+ GO TO 5005
+C ENDIF
+C ENDIF
+ 42 CONTINUE
+C
+ IF (NEXT(1) .EQ. 0) GO TO 49
+C IF (NEXT(1) .GT. 0) THEN
+C IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(1) TO THE
+C LEFT OF X(IR-1).
+C
+ IF (IR .GT. 2) GO TO 43
+C IF (IR .EQ. 2) THEN
+C THESE ARE ACTUALLY EXTRAPOLATION POINTS.
+ IERR = IERR + NEXT(1)
+ GO TO 49
+ 43 CONTINUE
+C ELSE
+C XE IS NOT ORDERED RELATIVE TO X, SO MUST ADJUST
+C EVALUATION INTERVAL.
+C
+C FIRST, LOCATE FIRST POINT TO LEFT OF X(IR-1).
+ DO 44 I = JFIRST, J-1
+ IF (XE(I) .LT. X(IR-1)) GO TO 45
+ 44 CONTINUE
+C NOTE-- CANNOT DROP THROUGH HERE UNLESS THERE IS AN ERROR
+C IN CHFEV.
+ GO TO 5005
+C
+ 45 CONTINUE
+C RESET J. (THIS WILL BE THE NEW JFIRST.)
+ J = I
+C
+C NOW FIND OUT HOW FAR TO BACK UP IN THE X-ARRAY.
+ DO 46 I = 1, IR-1
+ IF (XE(J) .LT. X(I)) GO TO 47
+ 46 CONTINUE
+C NB-- CAN NEVER DROP THROUGH HERE, SINCE XE(J).LT.X(IR-1).
+C
+ 47 CONTINUE
+C AT THIS POINT, EITHER XE(J) .LT. X(1)
+C OR X(I-1) .LE. XE(J) .LT. X(I) .
+C RESET IR, RECOGNIZING THAT IT WILL BE INCREMENTED BEFORE
+C CYCLING.
+ IR = MAX(1, I-1)
+C ENDIF
+C ENDIF
+ 49 CONTINUE
+C
+ JFIRST = J
+C
+C END OF IR-LOOP.
+C
+ 50 CONTINUE
+ IR = IR + 1
+ IF (IR .LE. N) GO TO 10
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'PCHFE',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'PCHFE', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ RETURN
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'PCHFE', 'X-ARRAY NOT STRICTLY INCREASING'
+ + , IERR, 1)
+ RETURN
+C
+ 5004 CONTINUE
+C NE.LT.1 RETURN.
+ IERR = -4
+ CALL XERMSG ('SLATEC', 'PCHFE',
+ + 'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)
+ RETURN
+C
+ 5005 CONTINUE
+C ERROR RETURN FROM CHFEV.
+C *** THIS CASE SHOULD NEVER OCCUR ***
+ IERR = -5
+ CALL XERMSG ('SLATEC', 'PCHFE',
+ + 'ERROR RETURN FROM CHFEV -- FATAL', IERR, 2)
+ RETURN
+C------------- LAST LINE OF PCHFE FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchia.f b/Lib/Slatec/slatec/pchia.f
new file mode 100644
index 0000000..91ed672
--- /dev/null
+++ b/Lib/Slatec/slatec/pchia.f
@@ -0,0 +1,265 @@
+*DECK PCHIA
+ REAL FUNCTION PCHIA (N, X, F, D, INCFD, SKIP, A, B, IERR)
+C***BEGIN PROLOGUE PCHIA
+C***PURPOSE Evaluate the definite integral of a piecewise cubic
+C Hermite function over an arbitrary interval.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3, H2A1B2
+C***TYPE SINGLE PRECISION (PCHIA-S, DPCHIA-D)
+C***KEYWORDS CUBIC HERMITE INTERPOLATION, NUMERICAL INTEGRATION, PCHIP,
+C QUADRATURE
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C PCHIA: Piecewise Cubic Hermite Integrator, Arbitrary limits
+C
+C Evaluates the definite integral of the cubic Hermite function
+C defined by N, X, F, D over the interval [A, B].
+C
+C To provide compatibility with PCHIM and PCHIC, includes an
+C increment between successive values of the F- and D-arrays.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, IERR
+C REAL X(N), F(INCFD,N), D(INCFD,N), A, B
+C REAL VALUE, PCHIA
+C LOGICAL SKIP
+C
+C VALUE = PCHIA (N, X, F, D, INCFD, SKIP, A, B, IERR)
+C
+C Parameters:
+C
+C VALUE -- (output) value of the requested integral.
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C
+C X -- (input) real array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real array of function values. F(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C D -- (input) real array of derivative values. D(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C INCFD -- (input) increment between successive values in F and D.
+C (Error return if INCFD.LT.1 .)
+C
+C SKIP -- (input/output) logical variable which should be set to
+C .TRUE. if the user wishes to skip checks for validity of
+C preceding parameters, or to .FALSE. otherwise.
+C This will save time in case these checks have already
+C been performed (say, in PCHIM or PCHIC).
+C SKIP will be set to .TRUE. on return with IERR.GE.0 .
+C
+C A,B -- (input) the limits of integration.
+C NOTE: There is no requirement that [A,B] be contained in
+C [X(1),X(N)]. However, the resulting integral value
+C will be highly suspect, if not.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C Warning errors:
+C IERR = 1 if A is outside the interval [X(1),X(N)].
+C IERR = 2 if B is outside the interval [X(1),X(N)].
+C IERR = 3 if both of the above are true. (Note that this
+C means that either [A,B] contains data interval
+C or the intervals do not intersect at all.)
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C (VALUE will be zero in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C IERR = -4 in case of an error return from PCHID (which
+C should never occur).
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED CHFIE, PCHID, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820730 DATE WRITTEN
+C 820804 Converted to SLATEC library version.
+C 870707 Corrected double precision conversion instructions.
+C 870813 Minor cosmetic changes.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890703 Corrected category record. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 930503 Corrected to set VALUE=0 when IERR.lt.0. (FNF)
+C 930504 Changed CHFIV to CHFIE. (FNF)
+C***END PROLOGUE PCHIA
+C
+C Programming notes:
+C 1. The error flag from PCHID is tested, because a logic flaw
+C could conceivably result in IERD=-4, which should be reported.
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, IERR
+ REAL X(*), F(INCFD,*), D(INCFD,*), A, B
+ LOGICAL SKIP
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, IA, IB, IERD, IL, IR
+ REAL VALUE, XA, XB, ZERO
+ SAVE ZERO
+ REAL CHFIE, PCHID
+C
+C INITIALIZE.
+C
+ DATA ZERO /0./
+C***FIRST EXECUTABLE STATEMENT PCHIA
+ VALUE = ZERO
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+ IF (SKIP) GO TO 5
+C
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+C
+C FUNCTION DEFINITION IS OK, GO ON.
+C
+ 5 CONTINUE
+ SKIP = .TRUE.
+ IERR = 0
+ IF ( (A.LT.X(1)) .OR. (A.GT.X(N)) ) IERR = IERR + 1
+ IF ( (B.LT.X(1)) .OR. (B.GT.X(N)) ) IERR = IERR + 2
+C
+C COMPUTE INTEGRAL VALUE.
+C
+ IF (A .NE. B) THEN
+ XA = MIN (A, B)
+ XB = MAX (A, B)
+ IF (XB .LE. X(2)) THEN
+C INTERVAL IS TO LEFT OF X(2), SO USE FIRST CUBIC.
+C --------------------------------------
+ VALUE = CHFIE (X(1),X(2), F(1,1),F(1,2),
+ + D(1,1),D(1,2), A, B)
+C --------------------------------------
+ ELSE IF (XA .GE. X(N-1)) THEN
+C INTERVAL IS TO RIGHT OF X(N-1), SO USE LAST CUBIC.
+C -----------------------------------------
+ VALUE = CHFIE(X(N-1),X(N), F(1,N-1),F(1,N),
+ + D(1,N-1),D(1,N), A, B)
+C -----------------------------------------
+ ELSE
+C 'NORMAL' CASE -- XA.LT.XB, XA.LT.X(N-1), XB.GT.X(2).
+C ......LOCATE IA AND IB SUCH THAT
+C X(IA-1).LT.XA.LE.X(IA).LE.X(IB).LE.XB.LE.X(IB+1)
+ IA = 1
+ DO 10 I = 1, N-1
+ IF (XA .GT. X(I)) IA = I + 1
+ 10 CONTINUE
+C IA = 1 IMPLIES XA.LT.X(1) . OTHERWISE,
+C IA IS LARGEST INDEX SUCH THAT X(IA-1).LT.XA,.
+C
+ IB = N
+ DO 20 I = N, IA, -1
+ IF (XB .LT. X(I)) IB = I - 1
+ 20 CONTINUE
+C IB = N IMPLIES XB.GT.X(N) . OTHERWISE,
+C IB IS SMALLEST INDEX SUCH THAT XB.LT.X(IB+1) .
+C
+C ......COMPUTE THE INTEGRAL.
+ IF (IB .LT. IA) THEN
+C THIS MEANS IB = IA-1 AND
+C (A,B) IS A SUBSET OF (X(IB),X(IA)).
+C ------------------------------------------
+ VALUE = CHFIE (X(IB),X(IA), F(1,IB),F(1,IA),
+ + D(1,IB),D(1,IA), A, B)
+C ------------------------------------------
+ ELSE
+C
+C FIRST COMPUTE INTEGRAL OVER (X(IA),X(IB)).
+C (Case (IB .EQ. IA) is taken care of by initialization
+C of VALUE to ZERO.)
+ IF (IB .GT. IA) THEN
+C ---------------------------------------------
+ VALUE = PCHID (N, X, F, D, INCFD, SKIP, IA, IB, IERD)
+C ---------------------------------------------
+ IF (IERD .LT. 0) GO TO 5004
+ ENDIF
+C
+C THEN ADD ON INTEGRAL OVER (XA,X(IA)).
+ IF (XA .LT. X(IA)) THEN
+ IL = MAX(1, IA-1)
+ IR = IL + 1
+C -------------------------------------
+ VALUE = VALUE + CHFIE (X(IL),X(IR), F(1,IL),F(1,IR),
+ + D(1,IL),D(1,IR), XA, X(IA))
+C -------------------------------------
+ ENDIF
+C
+C THEN ADD ON INTEGRAL OVER (X(IB),XB).
+ IF (XB .GT. X(IB)) THEN
+ IR = MIN (IB+1, N)
+ IL = IR - 1
+C -------------------------------------
+ VALUE = VALUE + CHFIE (X(IL),X(IR), F(1,IL),F(1,IR),
+ + D(1,IL),D(1,IR), X(IB), XB)
+C -------------------------------------
+ ENDIF
+C
+C FINALLY, ADJUST SIGN IF NECESSARY.
+ IF (A .GT. B) VALUE = -VALUE
+ ENDIF
+ ENDIF
+ ENDIF
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ PCHIA = VALUE
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'PCHIA',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ GO TO 5000
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'PCHIA', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ GO TO 5000
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'PCHIA',
+ + 'X-ARRAY NOT STRICTLY INCREASING', IERR, 1)
+ GO TO 5000
+C
+ 5004 CONTINUE
+C TROUBLE IN PCHID. (SHOULD NEVER OCCUR.)
+ IERR = -4
+ CALL XERMSG ('SLATEC', 'PCHIA', 'TROUBLE IN PCHID', IERR, 1)
+ GO TO 5000
+C------------- LAST LINE OF PCHIA FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchic.f b/Lib/Slatec/slatec/pchic.f
new file mode 100644
index 0000000..cd0eda6
--- /dev/null
+++ b/Lib/Slatec/slatec/pchic.f
@@ -0,0 +1,341 @@
+*DECK PCHIC
+ SUBROUTINE PCHIC (IC, VC, SWITCH, N, X, F, D, INCFD, WK, NWK,
+ + IERR)
+C***BEGIN PROLOGUE PCHIC
+C***PURPOSE Set derivatives needed to determine a piecewise monotone
+C piecewise cubic Hermite interpolant to given data.
+C User control is available over boundary conditions and/or
+C treatment of points where monotonicity switches direction.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E1A
+C***TYPE SINGLE PRECISION (PCHIC-S, DPCHIC-D)
+C***KEYWORDS CUBIC HERMITE INTERPOLATION, MONOTONE INTERPOLATION,
+C PCHIP, PIECEWISE CUBIC INTERPOLATION,
+C SHAPE-PRESERVING INTERPOLATION
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C PCHIC: Piecewise Cubic Hermite Interpolation Coefficients.
+C
+C Sets derivatives needed to determine a piecewise monotone piece-
+C wise cubic interpolant to the data given in X and F satisfying the
+C boundary conditions specified by IC and VC.
+C
+C The treatment of points where monotonicity switches direction is
+C controlled by argument SWITCH.
+C
+C To facilitate two-dimensional applications, includes an increment
+C between successive values of the F- and D-arrays.
+C
+C The resulting piecewise cubic Hermite function may be evaluated
+C by PCHFE or PCHFD.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER IC(2), N, NWK, IERR
+C REAL VC(2), SWITCH, X(N), F(INCFD,N), D(INCFD,N), WK(NWK)
+C
+C CALL PCHIC (IC, VC, SWITCH, N, X, F, D, INCFD, WK, NWK, IERR)
+C
+C Parameters:
+C
+C IC -- (input) integer array of length 2 specifying desired
+C boundary conditions:
+C IC(1) = IBEG, desired condition at beginning of data.
+C IC(2) = IEND, desired condition at end of data.
+C
+C IBEG = 0 for the default boundary condition (the same as
+C used by PCHIM).
+C If IBEG.NE.0, then its sign indicates whether the boundary
+C derivative is to be adjusted, if necessary, to be
+C compatible with monotonicity:
+C IBEG.GT.0 if no adjustment is to be performed.
+C IBEG.LT.0 if the derivative is to be adjusted for
+C monotonicity.
+C
+C Allowable values for the magnitude of IBEG are:
+C IBEG = 1 if first derivative at X(1) is given in VC(1).
+C IBEG = 2 if second derivative at X(1) is given in VC(1).
+C IBEG = 3 to use the 3-point difference formula for D(1).
+C (Reverts to the default b.c. if N.LT.3 .)
+C IBEG = 4 to use the 4-point difference formula for D(1).
+C (Reverts to the default b.c. if N.LT.4 .)
+C IBEG = 5 to set D(1) so that the second derivative is con-
+C tinuous at X(2). (Reverts to the default b.c. if N.LT.4.)
+C This option is somewhat analogous to the "not a knot"
+C boundary condition provided by PCHSP.
+C
+C NOTES (IBEG):
+C 1. An error return is taken if ABS(IBEG).GT.5 .
+C 2. Only in case IBEG.LE.0 is it guaranteed that the
+C interpolant will be monotonic in the first interval.
+C If the returned value of D(1) lies between zero and
+C 3*SLOPE(1), the interpolant will be monotonic. This
+C is **NOT** checked if IBEG.GT.0 .
+C 3. If IBEG.LT.0 and D(1) had to be changed to achieve mono-
+C tonicity, a warning error is returned.
+C
+C IEND may take on the same values as IBEG, but applied to
+C derivative at X(N). In case IEND = 1 or 2, the value is
+C given in VC(2).
+C
+C NOTES (IEND):
+C 1. An error return is taken if ABS(IEND).GT.5 .
+C 2. Only in case IEND.LE.0 is it guaranteed that the
+C interpolant will be monotonic in the last interval.
+C If the returned value of D(1+(N-1)*INCFD) lies between
+C zero and 3*SLOPE(N-1), the interpolant will be monotonic.
+C This is **NOT** checked if IEND.GT.0 .
+C 3. If IEND.LT.0 and D(1+(N-1)*INCFD) had to be changed to
+C achieve monotonicity, a warning error is returned.
+C
+C VC -- (input) real array of length 2 specifying desired boundary
+C values, as indicated above.
+C VC(1) need be set only if IC(1) = 1 or 2 .
+C VC(2) need be set only if IC(2) = 1 or 2 .
+C
+C SWITCH -- (input) indicates desired treatment of points where
+C direction of monotonicity switches:
+C Set SWITCH to zero if interpolant is required to be mono-
+C tonic in each interval, regardless of monotonicity of data.
+C NOTES:
+C 1. This will cause D to be set to zero at all switch
+C points, thus forcing extrema there.
+C 2. The result of using this option with the default boun-
+C dary conditions will be identical to using PCHIM, but
+C will generally cost more compute time.
+C This option is provided only to facilitate comparison
+C of different switch and/or boundary conditions.
+C Set SWITCH nonzero to use a formula based on the 3-point
+C difference formula in the vicinity of switch points.
+C If SWITCH is positive, the interpolant on each interval
+C containing an extremum is controlled to not deviate from
+C the data by more than SWITCH*DFLOC, where DFLOC is the
+C maximum of the change of F on this interval and its two
+C immediate neighbors.
+C If SWITCH is negative, no such control is to be imposed.
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C
+C X -- (input) real array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real array of dependent variable values to be inter-
+C polated. F(1+(I-1)*INCFD) is value corresponding to X(I).
+C
+C D -- (output) real array of derivative values at the data points.
+C These values will determine a monotone cubic Hermite func-
+C tion on each subinterval on which the data are monotonic,
+C except possibly adjacent to switches in monotonicity.
+C The value corresponding to X(I) is stored in
+C D(1+(I-1)*INCFD), I=1(1)N.
+C No other entries in D are changed.
+C
+C INCFD -- (input) increment between successive values in F and D.
+C This argument is provided primarily for 2-D applications.
+C (Error return if INCFD.LT.1 .)
+C
+C WK -- (scratch) real array of working storage. The user may wish
+C to know that the returned values are:
+C WK(I) = H(I) = X(I+1) - X(I) ;
+C WK(N-1+I) = SLOPE(I) = (F(1,I+1) - F(1,I)) / H(I)
+C for I = 1(1)N-1.
+C
+C NWK -- (input) length of work array.
+C (Error return if NWK.LT.2*(N-1) .)
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C Warning errors:
+C IERR = 1 if IBEG.LT.0 and D(1) had to be adjusted for
+C monotonicity.
+C IERR = 2 if IEND.LT.0 and D(1+(N-1)*INCFD) had to be
+C adjusted for monotonicity.
+C IERR = 3 if both of the above are true.
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C IERR = -4 if ABS(IBEG).GT.5 .
+C IERR = -5 if ABS(IEND).GT.5 .
+C IERR = -6 if both of the above are true.
+C IERR = -7 if NWK.LT.2*(N-1) .
+C (The D-array has not been changed in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C
+C***REFERENCES 1. F. N. Fritsch, Piecewise Cubic Hermite Interpolation
+C Package, Report UCRL-87285, Lawrence Livermore Nation-
+C al Laboratory, July 1982. [Poster presented at the
+C SIAM 30th Anniversary Meeting, 19-23 July 1982.]
+C 2. F. N. Fritsch and J. Butland, A method for construc-
+C ting local monotone piecewise cubic interpolants, SIAM
+C Journal on Scientific and Statistical Computing 5, 2
+C (June 1984), pp. 300-304.
+C 3. F. N. Fritsch and R. E. Carlson, Monotone piecewise
+C cubic interpolation, SIAM Journal on Numerical Ana-
+C lysis 17, 2 (April 1980), pp. 238-246.
+C***ROUTINES CALLED PCHCE, PCHCI, PCHCS, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820218 DATE WRITTEN
+C 820804 Converted to SLATEC library version.
+C 870813 Updated Reference 2.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890703 Corrected category record. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 920429 Revised format and order of references. (WRB,FNF)
+C***END PROLOGUE PCHIC
+C Programming notes:
+C
+C To produce a double precision version, simply:
+C a. Change PCHIC to DPCHIC wherever it occurs,
+C b. Change PCHCE to DPCHCE wherever it occurs,
+C c. Change PCHCI to DPCHCI wherever it occurs,
+C d. Change PCHCS to DPCHCS wherever it occurs,
+C e. Change the real declarations to double precision, and
+C f. Change the constant ZERO to double precision.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER IC(2), N, INCFD, NWK, IERR
+ REAL VC(2), SWITCH, X(*), F(INCFD,*), D(INCFD,*), WK(NWK)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, IBEG, IEND, NLESS1
+ REAL ZERO
+ SAVE ZERO
+ DATA ZERO /0./
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT PCHIC
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+C
+ IBEG = IC(1)
+ IEND = IC(2)
+ IERR = 0
+ IF (ABS(IBEG) .GT. 5) IERR = IERR - 1
+ IF (ABS(IEND) .GT. 5) IERR = IERR - 2
+ IF (IERR .LT. 0) GO TO 5004
+C
+C FUNCTION DEFINITION IS OK -- GO ON.
+C
+ NLESS1 = N - 1
+ IF ( NWK .LT. 2*NLESS1 ) GO TO 5007
+C
+C SET UP H AND SLOPE ARRAYS.
+C
+ DO 20 I = 1, NLESS1
+ WK(I) = X(I+1) - X(I)
+ WK(NLESS1+I) = (F(1,I+1) - F(1,I)) / WK(I)
+ 20 CONTINUE
+C
+C SPECIAL CASE N=2 -- USE LINEAR INTERPOLATION.
+C
+ IF (NLESS1 .GT. 1) GO TO 1000
+ D(1,1) = WK(2)
+ D(1,N) = WK(2)
+ GO TO 3000
+C
+C NORMAL CASE (N .GE. 3) .
+C
+ 1000 CONTINUE
+C
+C SET INTERIOR DERIVATIVES AND DEFAULT END CONDITIONS.
+C
+C --------------------------------------
+ CALL PCHCI (N, WK(1), WK(N), D, INCFD)
+C --------------------------------------
+C
+C SET DERIVATIVES AT POINTS WHERE MONOTONICITY SWITCHES DIRECTION.
+C
+ IF (SWITCH .EQ. ZERO) GO TO 3000
+C ----------------------------------------------------
+ CALL PCHCS (SWITCH, N, WK(1), WK(N), D, INCFD, IERR)
+C ----------------------------------------------------
+ IF (IERR .NE. 0) GO TO 5008
+C
+C SET END CONDITIONS.
+C
+ 3000 CONTINUE
+ IF ( (IBEG.EQ.0) .AND. (IEND.EQ.0) ) GO TO 5000
+C -------------------------------------------------------
+ CALL PCHCE (IC, VC, N, X, WK(1), WK(N), D, INCFD, IERR)
+C -------------------------------------------------------
+ IF (IERR .LT. 0) GO TO 5009
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'PCHIC',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'PCHIC', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ RETURN
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'PCHIC', 'X-ARRAY NOT STRICTLY INCREASING'
+ + , IERR, 1)
+ RETURN
+C
+ 5004 CONTINUE
+C IC OUT OF RANGE RETURN.
+ IERR = IERR - 3
+ CALL XERMSG ('SLATEC', 'PCHIC', 'IC OUT OF RANGE', IERR, 1)
+ RETURN
+C
+ 5007 CONTINUE
+C NWK .LT. 2*(N-1) RETURN.
+ IERR = -7
+ CALL XERMSG ('SLATEC', 'PCHIC', 'WORK ARRAY TOO SMALL', IERR, 1)
+ RETURN
+C
+ 5008 CONTINUE
+C ERROR RETURN FROM PCHCS.
+ IERR = -8
+ CALL XERMSG ('SLATEC', 'PCHIC', 'ERROR RETURN FROM PCHCS', IERR,
+ + 1)
+ RETURN
+C
+ 5009 CONTINUE
+C ERROR RETURN FROM PCHCE.
+C *** THIS CASE SHOULD NEVER OCCUR ***
+ IERR = -9
+ CALL XERMSG ('SLATEC', 'PCHIC', 'ERROR RETURN FROM PCHCE', IERR,
+ + 1)
+ RETURN
+C------------- LAST LINE OF PCHIC FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchid.f b/Lib/Slatec/slatec/pchid.f
new file mode 100644
index 0000000..dc9de85
--- /dev/null
+++ b/Lib/Slatec/slatec/pchid.f
@@ -0,0 +1,190 @@
+*DECK PCHID
+ REAL FUNCTION PCHID (N, X, F, D, INCFD, SKIP, IA, IB, IERR)
+C***BEGIN PROLOGUE PCHID
+C***PURPOSE Evaluate the definite integral of a piecewise cubic
+C Hermite function over an interval whose endpoints are data
+C points.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3, H2A1B2
+C***TYPE SINGLE PRECISION (PCHID-S, DPCHID-D)
+C***KEYWORDS CUBIC HERMITE INTERPOLATION, NUMERICAL INTEGRATION, PCHIP,
+C QUADRATURE
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C PCHID: Piecewise Cubic Hermite Integrator, Data limits
+C
+C Evaluates the definite integral of the cubic Hermite function
+C defined by N, X, F, D over the interval [X(IA), X(IB)].
+C
+C To provide compatibility with PCHIM and PCHIC, includes an
+C increment between successive values of the F- and D-arrays.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, IA, IB, IERR
+C REAL X(N), F(INCFD,N), D(INCFD,N)
+C LOGICAL SKIP
+C
+C VALUE = PCHID (N, X, F, D, INCFD, SKIP, IA, IB, IERR)
+C
+C Parameters:
+C
+C VALUE -- (output) value of the requested integral.
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C
+C X -- (input) real array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real array of function values. F(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C D -- (input) real array of derivative values. D(1+(I-1)*INCFD) is
+C the value corresponding to X(I).
+C
+C INCFD -- (input) increment between successive values in F and D.
+C (Error return if INCFD.LT.1 .)
+C
+C SKIP -- (input/output) logical variable which should be set to
+C .TRUE. if the user wishes to skip checks for validity of
+C preceding parameters, or to .FALSE. otherwise.
+C This will save time in case these checks have already
+C been performed (say, in PCHIM or PCHIC).
+C SKIP will be set to .TRUE. on return with IERR = 0 or -4.
+C
+C IA,IB -- (input) indices in X-array for the limits of integration.
+C both must be in the range [1,N]. (Error return if not.)
+C No restrictions on their relative values.
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C IERR = -4 if IA or IB is out of range.
+C (VALUE will be zero in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820723 DATE WRITTEN
+C 820804 Converted to SLATEC library version.
+C 870813 Minor cosmetic changes.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890703 Corrected category record. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 930504 Corrected to set VALUE=0 when IERR.ne.0. (FNF)
+C***END PROLOGUE PCHID
+C
+C Programming notes:
+C 1. This routine uses a special formula that is valid only for
+C integrals whose limits coincide with data values. This is
+C mathematically equivalent to, but much more efficient than,
+C calls to CHFIE.
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, IA, IB, IERR
+ REAL X(*), F(INCFD,*), D(INCFD,*)
+ LOGICAL SKIP
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, IUP, LOW
+ REAL H, HALF, SIX, SUM, VALUE, ZERO
+ SAVE ZERO, HALF, SIX
+C
+C INITIALIZE.
+C
+ DATA ZERO /0./, HALF /0.5/, SIX /6./
+C***FIRST EXECUTABLE STATEMENT PCHID
+ VALUE = ZERO
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+ IF (SKIP) GO TO 5
+C
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+C
+C FUNCTION DEFINITION IS OK, GO ON.
+C
+ 5 CONTINUE
+ SKIP = .TRUE.
+ IF ((IA.LT.1) .OR. (IA.GT.N)) GO TO 5004
+ IF ((IB.LT.1) .OR. (IB.GT.N)) GO TO 5004
+ IERR = 0
+C
+C COMPUTE INTEGRAL VALUE.
+C
+ IF (IA .NE. IB) THEN
+ LOW = MIN(IA, IB)
+ IUP = MAX(IA, IB) - 1
+ SUM = ZERO
+ DO 10 I = LOW, IUP
+ H = X(I+1) - X(I)
+ SUM = SUM + H*( (F(1,I) + F(1,I+1)) +
+ * (D(1,I) - D(1,I+1))*(H/SIX) )
+ 10 CONTINUE
+ VALUE = HALF * SUM
+ IF (IA .GT. IB) VALUE = -VALUE
+ ENDIF
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ PCHID = VALUE
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'PCHID',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ GO TO 5000
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'PCHID', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ GO TO 5000
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'PCHID',
+ + 'X-ARRAY NOT STRICTLY INCREASING', IERR, 1)
+ GO TO 5000
+C
+ 5004 CONTINUE
+C IA OR IB OUT OF RANGE RETURN.
+ IERR = -4
+ CALL XERMSG ('SLATEC', 'PCHID', 'IA OR IB OUT OF RANGE', IERR, 1)
+ GO TO 5000
+C------------- LAST LINE OF PCHID FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchim.f b/Lib/Slatec/slatec/pchim.f
new file mode 100644
index 0000000..8c12f00
--- /dev/null
+++ b/Lib/Slatec/slatec/pchim.f
@@ -0,0 +1,280 @@
+*DECK PCHIM
+ SUBROUTINE PCHIM (N, X, F, D, INCFD, IERR)
+C***BEGIN PROLOGUE PCHIM
+C***PURPOSE Set derivatives needed to determine a monotone piecewise
+C cubic Hermite interpolant to given data. Boundary values
+C are provided which are compatible with monotonicity. The
+C interpolant will have an extremum at each point where mono-
+C tonicity switches direction. (See PCHIC if user control is
+C desired over boundary or switch conditions.)
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E1A
+C***TYPE SINGLE PRECISION (PCHIM-S, DPCHIM-D)
+C***KEYWORDS CUBIC HERMITE INTERPOLATION, MONOTONE INTERPOLATION,
+C PCHIP, PIECEWISE CUBIC INTERPOLATION
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C PCHIM: Piecewise Cubic Hermite Interpolation to
+C Monotone data.
+C
+C Sets derivatives needed to determine a monotone piecewise cubic
+C Hermite interpolant to the data given in X and F.
+C
+C Default boundary conditions are provided which are compatible
+C with monotonicity. (See PCHIC if user control of boundary con-
+C ditions is desired.)
+C
+C If the data are only piecewise monotonic, the interpolant will
+C have an extremum at each point where monotonicity switches direc-
+C tion. (See PCHIC if user control is desired in such cases.)
+C
+C To facilitate two-dimensional applications, includes an increment
+C between successive values of the F- and D-arrays.
+C
+C The resulting piecewise cubic Hermite function may be evaluated
+C by PCHFE or PCHFD.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER N, IERR
+C REAL X(N), F(INCFD,N), D(INCFD,N)
+C
+C CALL PCHIM (N, X, F, D, INCFD, IERR)
+C
+C Parameters:
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C If N=2, simply does linear interpolation.
+C
+C X -- (input) real array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real array of dependent variable values to be inter-
+C polated. F(1+(I-1)*INCFD) is value corresponding to X(I).
+C PCHIM is designed for monotonic data, but it will work for
+C any F-array. It will force extrema at points where mono-
+C tonicity switches direction. If some other treatment of
+C switch points is desired, PCHIC should be used instead.
+C -----
+C D -- (output) real array of derivative values at the data points.
+C If the data are monotonic, these values will determine a
+C a monotone cubic Hermite function.
+C The value corresponding to X(I) is stored in
+C D(1+(I-1)*INCFD), I=1(1)N.
+C No other entries in D are changed.
+C
+C INCFD -- (input) increment between successive values in F and D.
+C This argument is provided primarily for 2-D applications.
+C (Error return if INCFD.LT.1 .)
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C Warning error:
+C IERR.GT.0 means that IERR switches in the direction
+C of monotonicity were detected.
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C (The D-array has not been changed in any of these cases.)
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C
+C***REFERENCES 1. F. N. Fritsch and J. Butland, A method for construc-
+C ting local monotone piecewise cubic interpolants, SIAM
+C Journal on Scientific and Statistical Computing 5, 2
+C (June 1984), pp. 300-304.
+C 2. F. N. Fritsch and R. E. Carlson, Monotone piecewise
+C cubic interpolation, SIAM Journal on Numerical Ana-
+C lysis 17, 2 (April 1980), pp. 238-246.
+C***ROUTINES CALLED PCHST, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 811103 DATE WRITTEN
+C 820201 1. Introduced PCHST to reduce possible over/under-
+C flow problems.
+C 2. Rearranged derivative formula for same reason.
+C 820602 1. Modified end conditions to be continuous functions
+C of data when monotonicity switches in next interval.
+C 2. Modified formulas so end conditions are less prone
+C of over/underflow problems.
+C 820803 Minor cosmetic changes for release 1.
+C 870813 Updated Reference 1.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890703 Corrected category record. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 920429 Revised format and order of references. (WRB,FNF)
+C***END PROLOGUE PCHIM
+C Programming notes:
+C
+C 1. The function PCHST(ARG1,ARG2) is assumed to return zero if
+C either argument is zero, +1 if they are of the same sign, and
+C -1 if they are of opposite sign.
+C 2. To produce a double precision version, simply:
+C a. Change PCHIM to DPCHIM wherever it occurs,
+C b. Change PCHST to DPCHST wherever it occurs,
+C c. Change all references to the Fortran intrinsics to their
+C double precision equivalents,
+C d. Change the real declarations to double precision, and
+C e. Change the constants ZERO and THREE to double precision.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER N, INCFD, IERR
+ REAL X(*), F(INCFD,*), D(INCFD,*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER I, NLESS1
+ REAL DEL1, DEL2, DMAX, DMIN, DRAT1, DRAT2, DSAVE,
+ * H1, H2, HSUM, HSUMT3, THREE, W1, W2, ZERO
+ SAVE ZERO, THREE
+ REAL PCHST
+ DATA ZERO /0./, THREE /3./
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT PCHIM
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 I = 2, N
+ IF ( X(I).LE.X(I-1) ) GO TO 5003
+ 1 CONTINUE
+C
+C FUNCTION DEFINITION IS OK, GO ON.
+C
+ IERR = 0
+ NLESS1 = N - 1
+ H1 = X(2) - X(1)
+ DEL1 = (F(1,2) - F(1,1))/H1
+ DSAVE = DEL1
+C
+C SPECIAL CASE N=2 -- USE LINEAR INTERPOLATION.
+C
+ IF (NLESS1 .GT. 1) GO TO 10
+ D(1,1) = DEL1
+ D(1,N) = DEL1
+ GO TO 5000
+C
+C NORMAL CASE (N .GE. 3).
+C
+ 10 CONTINUE
+ H2 = X(3) - X(2)
+ DEL2 = (F(1,3) - F(1,2))/H2
+C
+C SET D(1) VIA NON-CENTERED THREE-POINT FORMULA, ADJUSTED TO BE
+C SHAPE-PRESERVING.
+C
+ HSUM = H1 + H2
+ W1 = (H1 + HSUM)/HSUM
+ W2 = -H1/HSUM
+ D(1,1) = W1*DEL1 + W2*DEL2
+ IF ( PCHST(D(1,1),DEL1) .LE. ZERO) THEN
+ D(1,1) = ZERO
+ ELSE IF ( PCHST(DEL1,DEL2) .LT. ZERO) THEN
+C NEED DO THIS CHECK ONLY IF MONOTONICITY SWITCHES.
+ DMAX = THREE*DEL1
+ IF (ABS(D(1,1)) .GT. ABS(DMAX)) D(1,1) = DMAX
+ ENDIF
+C
+C LOOP THROUGH INTERIOR POINTS.
+C
+ DO 50 I = 2, NLESS1
+ IF (I .EQ. 2) GO TO 40
+C
+ H1 = H2
+ H2 = X(I+1) - X(I)
+ HSUM = H1 + H2
+ DEL1 = DEL2
+ DEL2 = (F(1,I+1) - F(1,I))/H2
+ 40 CONTINUE
+C
+C SET D(I)=0 UNLESS DATA ARE STRICTLY MONOTONIC.
+C
+ D(1,I) = ZERO
+ IF ( PCHST(DEL1,DEL2) ) 42, 41, 45
+C
+C COUNT NUMBER OF CHANGES IN DIRECTION OF MONOTONICITY.
+C
+ 41 CONTINUE
+ IF (DEL2 .EQ. ZERO) GO TO 50
+ IF ( PCHST(DSAVE,DEL2) .LT. ZERO) IERR = IERR + 1
+ DSAVE = DEL2
+ GO TO 50
+C
+ 42 CONTINUE
+ IERR = IERR + 1
+ DSAVE = DEL2
+ GO TO 50
+C
+C USE BRODLIE MODIFICATION OF BUTLAND FORMULA.
+C
+ 45 CONTINUE
+ HSUMT3 = HSUM+HSUM+HSUM
+ W1 = (HSUM + H1)/HSUMT3
+ W2 = (HSUM + H2)/HSUMT3
+ DMAX = MAX( ABS(DEL1), ABS(DEL2) )
+ DMIN = MIN( ABS(DEL1), ABS(DEL2) )
+ DRAT1 = DEL1/DMAX
+ DRAT2 = DEL2/DMAX
+ D(1,I) = DMIN/(W1*DRAT1 + W2*DRAT2)
+C
+ 50 CONTINUE
+C
+C SET D(N) VIA NON-CENTERED THREE-POINT FORMULA, ADJUSTED TO BE
+C SHAPE-PRESERVING.
+C
+ W1 = -H2/HSUM
+ W2 = (H2 + HSUM)/HSUM
+ D(1,N) = W1*DEL1 + W2*DEL2
+ IF ( PCHST(D(1,N),DEL2) .LE. ZERO) THEN
+ D(1,N) = ZERO
+ ELSE IF ( PCHST(DEL1,DEL2) .LT. ZERO) THEN
+C NEED DO THIS CHECK ONLY IF MONOTONICITY SWITCHES.
+ DMAX = THREE*DEL2
+ IF (ABS(D(1,N)) .GT. ABS(DMAX)) D(1,N) = DMAX
+ ENDIF
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'PCHIM',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'PCHIM', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ RETURN
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'PCHIM', 'X-ARRAY NOT STRICTLY INCREASING'
+ + , IERR, 1)
+ RETURN
+C------------- LAST LINE OF PCHIM FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchkt.f b/Lib/Slatec/slatec/pchkt.f
new file mode 100644
index 0000000..2662c37
--- /dev/null
+++ b/Lib/Slatec/slatec/pchkt.f
@@ -0,0 +1,95 @@
+*DECK PCHKT
+ SUBROUTINE PCHKT (N, X, KNOTYP, T)
+C***BEGIN PROLOGUE PCHKT
+C***SUBSIDIARY
+C***PURPOSE Compute B-spline knot sequence for PCHBS.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E3
+C***TYPE SINGLE PRECISION (PCHKT-S, DPCHKT-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C Set a knot sequence for the B-spline representation of a PCH
+C function with breakpoints X. All knots will be at least double.
+C Endknots are set as:
+C (1) quadruple knots at endpoints if KNOTYP=0;
+C (2) extrapolate the length of end interval if KNOTYP=1;
+C (3) periodic if KNOTYP=2.
+C
+C Input arguments: N, X, KNOTYP.
+C Output arguments: T.
+C
+C Restrictions/assumptions:
+C 1. N.GE.2 . (not checked)
+C 2. X(i).LT.X(i+1), i=1,...,N . (not checked)
+C 3. 0.LE.KNOTYP.LE.2 . (Acts like KNOTYP=0 for any other value.)
+C
+C***SEE ALSO PCHBS
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 870701 DATE WRITTEN
+C 900405 Converted Fortran to upper case.
+C 900410 Converted prologue to SLATEC 4.0 format.
+C 900410 Minor cosmetic changes.
+C 930514 Changed NKNOTS from an output to an input variable. (FNF)
+C 930604 Removed unused variable NKNOTS from argument list. (FNF)
+C***END PROLOGUE PCHKT
+C
+C*Internal Notes:
+C
+C Since this is subsidiary to PCHBS, which validates its input before
+C calling, it is unnecessary for such validation to be done here.
+C
+C**End
+C
+C Declare arguments.
+C
+ INTEGER N, KNOTYP
+ REAL X(*), T(*)
+C
+C Declare local variables.
+C
+ INTEGER J, K, NDIM
+ REAL HBEG, HEND
+C***FIRST EXECUTABLE STATEMENT PCHKT
+C
+C Initialize.
+C
+ NDIM = 2*N
+C
+C Set interior knots.
+C
+ J = 1
+ DO 20 K = 1, N
+ J = J + 2
+ T(J) = X(K)
+ T(J+1) = T(J)
+ 20 CONTINUE
+C Assertion: At this point T(3),...,T(NDIM+2) have been set and
+C J=NDIM+1.
+C
+C Set end knots according to KNOTYP.
+C
+ HBEG = X(2) - X(1)
+ HEND = X(N) - X(N-1)
+ IF (KNOTYP.EQ.1 ) THEN
+C Extrapolate.
+ T(2) = X(1) - HBEG
+ T(NDIM+3) = X(N) + HEND
+ ELSE IF ( KNOTYP.EQ.2 ) THEN
+C Periodic.
+ T(2) = X(1) - HEND
+ T(NDIM+3) = X(N) + HBEG
+ ELSE
+C Quadruple end knots.
+ T(2) = X(1)
+ T(NDIM+3) = X(N)
+ ENDIF
+ T(1) = T(2)
+ T(NDIM+4) = T(NDIM+3)
+C
+C Terminate.
+C
+ RETURN
+C------------- LAST LINE OF PCHKT FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchsp.f b/Lib/Slatec/slatec/pchsp.f
new file mode 100644
index 0000000..e192011
--- /dev/null
+++ b/Lib/Slatec/slatec/pchsp.f
@@ -0,0 +1,388 @@
+*DECK PCHSP
+ SUBROUTINE PCHSP (IC, VC, N, X, F, D, INCFD, WK, NWK, IERR)
+C***BEGIN PROLOGUE PCHSP
+C***PURPOSE Set derivatives needed to determine the Hermite represen-
+C tation of the cubic spline interpolant to given data, with
+C specified boundary conditions.
+C***LIBRARY SLATEC (PCHIP)
+C***CATEGORY E1A
+C***TYPE SINGLE PRECISION (PCHSP-S, DPCHSP-D)
+C***KEYWORDS CUBIC HERMITE INTERPOLATION, PCHIP,
+C PIECEWISE CUBIC INTERPOLATION, SPLINE INTERPOLATION
+C***AUTHOR Fritsch, F. N., (LLNL)
+C Lawrence Livermore National Laboratory
+C P.O. Box 808 (L-316)
+C Livermore, CA 94550
+C FTS 532-4275, (510) 422-4275
+C***DESCRIPTION
+C
+C PCHSP: Piecewise Cubic Hermite Spline
+C
+C Computes the Hermite representation of the cubic spline inter-
+C polant to the data given in X and F satisfying the boundary
+C conditions specified by IC and VC.
+C
+C To facilitate two-dimensional applications, includes an increment
+C between successive values of the F- and D-arrays.
+C
+C The resulting piecewise cubic Hermite function may be evaluated
+C by PCHFE or PCHFD.
+C
+C NOTE: This is a modified version of C. de Boor's cubic spline
+C routine CUBSPL.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C PARAMETER (INCFD = ...)
+C INTEGER IC(2), N, NWK, IERR
+C REAL VC(2), X(N), F(INCFD,N), D(INCFD,N), WK(NWK)
+C
+C CALL PCHSP (IC, VC, N, X, F, D, INCFD, WK, NWK, IERR)
+C
+C Parameters:
+C
+C IC -- (input) integer array of length 2 specifying desired
+C boundary conditions:
+C IC(1) = IBEG, desired condition at beginning of data.
+C IC(2) = IEND, desired condition at end of data.
+C
+C IBEG = 0 to set D(1) so that the third derivative is con-
+C tinuous at X(2). This is the "not a knot" condition
+C provided by de Boor's cubic spline routine CUBSPL.
+C < This is the default boundary condition. >
+C IBEG = 1 if first derivative at X(1) is given in VC(1).
+C IBEG = 2 if second derivative at X(1) is given in VC(1).
+C IBEG = 3 to use the 3-point difference formula for D(1).
+C (Reverts to the default b.c. if N.LT.3 .)
+C IBEG = 4 to use the 4-point difference formula for D(1).
+C (Reverts to the default b.c. if N.LT.4 .)
+C NOTES:
+C 1. An error return is taken if IBEG is out of range.
+C 2. For the "natural" boundary condition, use IBEG=2 and
+C VC(1)=0.
+C
+C IEND may take on the same values as IBEG, but applied to
+C derivative at X(N). In case IEND = 1 or 2, the value is
+C given in VC(2).
+C
+C NOTES:
+C 1. An error return is taken if IEND is out of range.
+C 2. For the "natural" boundary condition, use IEND=2 and
+C VC(2)=0.
+C
+C VC -- (input) real array of length 2 specifying desired boundary
+C values, as indicated above.
+C VC(1) need be set only if IC(1) = 1 or 2 .
+C VC(2) need be set only if IC(2) = 1 or 2 .
+C
+C N -- (input) number of data points. (Error return if N.LT.2 .)
+C
+C X -- (input) real array of independent variable values. The
+C elements of X must be strictly increasing:
+C X(I-1) .LT. X(I), I = 2(1)N.
+C (Error return if not.)
+C
+C F -- (input) real array of dependent variable values to be inter-
+C polated. F(1+(I-1)*INCFD) is value corresponding to X(I).
+C
+C D -- (output) real array of derivative values at the data points.
+C These values will determine the cubic spline interpolant
+C with the requested boundary conditions.
+C The value corresponding to X(I) is stored in
+C D(1+(I-1)*INCFD), I=1(1)N.
+C No other entries in D are changed.
+C
+C INCFD -- (input) increment between successive values in F and D.
+C This argument is provided primarily for 2-D applications.
+C (Error return if INCFD.LT.1 .)
+C
+C WK -- (scratch) real array of working storage.
+C
+C NWK -- (input) length of work array.
+C (Error return if NWK.LT.2*N .)
+C
+C IERR -- (output) error flag.
+C Normal return:
+C IERR = 0 (no errors).
+C "Recoverable" errors:
+C IERR = -1 if N.LT.2 .
+C IERR = -2 if INCFD.LT.1 .
+C IERR = -3 if the X-array is not strictly increasing.
+C IERR = -4 if IBEG.LT.0 or IBEG.GT.4 .
+C IERR = -5 if IEND.LT.0 of IEND.GT.4 .
+C IERR = -6 if both of the above are true.
+C IERR = -7 if NWK is too small.
+C NOTE: The above errors are checked in the order listed,
+C and following arguments have **NOT** been validated.
+C (The D-array has not been changed in any of these cases.)
+C IERR = -8 in case of trouble solving the linear system
+C for the interior derivative values.
+C (The D-array may have been changed in this case.)
+C ( Do **NOT** use it! )
+C
+C***REFERENCES Carl de Boor, A Practical Guide to Splines, Springer-
+C Verlag, New York, 1978, pp. 53-59.
+C***ROUTINES CALLED PCHDF, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820503 DATE WRITTEN
+C 820804 Converted to SLATEC library version.
+C 870707 Minor cosmetic changes to prologue.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890703 Corrected category record. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 920429 Revised format and order of references. (WRB,FNF)
+C***END PROLOGUE PCHSP
+C Programming notes:
+C
+C To produce a double precision version, simply:
+C a. Change PCHSP to DPCHSP wherever it occurs,
+C b. Change the real declarations to double precision, and
+C c. Change the constants ZERO, HALF, ... to double precision.
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER IC(2), N, INCFD, NWK, IERR
+ REAL VC(2), X(*), F(INCFD,*), D(INCFD,*), WK(2,*)
+C
+C DECLARE LOCAL VARIABLES.
+C
+ INTEGER IBEG, IEND, INDEX, J, NM1
+ REAL G, HALF, ONE, STEMP(3), THREE, TWO, XTEMP(4), ZERO
+ SAVE ZERO, HALF, ONE, TWO, THREE
+ REAL PCHDF
+C
+ DATA ZERO /0./, HALF /0.5/, ONE /1./, TWO /2./, THREE /3./
+C
+C VALIDITY-CHECK ARGUMENTS.
+C
+C***FIRST EXECUTABLE STATEMENT PCHSP
+ IF ( N.LT.2 ) GO TO 5001
+ IF ( INCFD.LT.1 ) GO TO 5002
+ DO 1 J = 2, N
+ IF ( X(J).LE.X(J-1) ) GO TO 5003
+ 1 CONTINUE
+C
+ IBEG = IC(1)
+ IEND = IC(2)
+ IERR = 0
+ IF ( (IBEG.LT.0).OR.(IBEG.GT.4) ) IERR = IERR - 1
+ IF ( (IEND.LT.0).OR.(IEND.GT.4) ) IERR = IERR - 2
+ IF ( IERR.LT.0 ) GO TO 5004
+C
+C FUNCTION DEFINITION IS OK -- GO ON.
+C
+ IF ( NWK .LT. 2*N ) GO TO 5007
+C
+C COMPUTE FIRST DIFFERENCES OF X SEQUENCE AND STORE IN WK(1,.). ALSO,
+C COMPUTE FIRST DIVIDED DIFFERENCE OF DATA AND STORE IN WK(2,.).
+ DO 5 J=2,N
+ WK(1,J) = X(J) - X(J-1)
+ WK(2,J) = (F(1,J) - F(1,J-1))/WK(1,J)
+ 5 CONTINUE
+C
+C SET TO DEFAULT BOUNDARY CONDITIONS IF N IS TOO SMALL.
+C
+ IF ( IBEG.GT.N ) IBEG = 0
+ IF ( IEND.GT.N ) IEND = 0
+C
+C SET UP FOR BOUNDARY CONDITIONS.
+C
+ IF ( (IBEG.EQ.1).OR.(IBEG.EQ.2) ) THEN
+ D(1,1) = VC(1)
+ ELSE IF (IBEG .GT. 2) THEN
+C PICK UP FIRST IBEG POINTS, IN REVERSE ORDER.
+ DO 10 J = 1, IBEG
+ INDEX = IBEG-J+1
+C INDEX RUNS FROM IBEG DOWN TO 1.
+ XTEMP(J) = X(INDEX)
+ IF (J .LT. IBEG) STEMP(J) = WK(2,INDEX)
+ 10 CONTINUE
+C --------------------------------
+ D(1,1) = PCHDF (IBEG, XTEMP, STEMP, IERR)
+C --------------------------------
+ IF (IERR .NE. 0) GO TO 5009
+ IBEG = 1
+ ENDIF
+C
+ IF ( (IEND.EQ.1).OR.(IEND.EQ.2) ) THEN
+ D(1,N) = VC(2)
+ ELSE IF (IEND .GT. 2) THEN
+C PICK UP LAST IEND POINTS.
+ DO 15 J = 1, IEND
+ INDEX = N-IEND+J
+C INDEX RUNS FROM N+1-IEND UP TO N.
+ XTEMP(J) = X(INDEX)
+ IF (J .LT. IEND) STEMP(J) = WK(2,INDEX+1)
+ 15 CONTINUE
+C --------------------------------
+ D(1,N) = PCHDF (IEND, XTEMP, STEMP, IERR)
+C --------------------------------
+ IF (IERR .NE. 0) GO TO 5009
+ IEND = 1
+ ENDIF
+C
+C --------------------( BEGIN CODING FROM CUBSPL )--------------------
+C
+C **** A TRIDIAGONAL LINEAR SYSTEM FOR THE UNKNOWN SLOPES S(J) OF
+C F AT X(J), J=1,...,N, IS GENERATED AND THEN SOLVED BY GAUSS ELIM-
+C INATION, WITH S(J) ENDING UP IN D(1,J), ALL J.
+C WK(1,.) AND WK(2,.) ARE USED FOR TEMPORARY STORAGE.
+C
+C CONSTRUCT FIRST EQUATION FROM FIRST BOUNDARY CONDITION, OF THE FORM
+C WK(2,1)*S(1) + WK(1,1)*S(2) = D(1,1)
+C
+ IF (IBEG .EQ. 0) THEN
+ IF (N .EQ. 2) THEN
+C NO CONDITION AT LEFT END AND N = 2.
+ WK(2,1) = ONE
+ WK(1,1) = ONE
+ D(1,1) = TWO*WK(2,2)
+ ELSE
+C NOT-A-KNOT CONDITION AT LEFT END AND N .GT. 2.
+ WK(2,1) = WK(1,3)
+ WK(1,1) = WK(1,2) + WK(1,3)
+ D(1,1) =((WK(1,2) + TWO*WK(1,1))*WK(2,2)*WK(1,3)
+ * + WK(1,2)**2*WK(2,3)) / WK(1,1)
+ ENDIF
+ ELSE IF (IBEG .EQ. 1) THEN
+C SLOPE PRESCRIBED AT LEFT END.
+ WK(2,1) = ONE
+ WK(1,1) = ZERO
+ ELSE
+C SECOND DERIVATIVE PRESCRIBED AT LEFT END.
+ WK(2,1) = TWO
+ WK(1,1) = ONE
+ D(1,1) = THREE*WK(2,2) - HALF*WK(1,2)*D(1,1)
+ ENDIF
+C
+C IF THERE ARE INTERIOR KNOTS, GENERATE THE CORRESPONDING EQUATIONS AND
+C CARRY OUT THE FORWARD PASS OF GAUSS ELIMINATION, AFTER WHICH THE J-TH
+C EQUATION READS WK(2,J)*S(J) + WK(1,J)*S(J+1) = D(1,J).
+C
+ NM1 = N-1
+ IF (NM1 .GT. 1) THEN
+ DO 20 J=2,NM1
+ IF (WK(2,J-1) .EQ. ZERO) GO TO 5008
+ G = -WK(1,J+1)/WK(2,J-1)
+ D(1,J) = G*D(1,J-1)
+ * + THREE*(WK(1,J)*WK(2,J+1) + WK(1,J+1)*WK(2,J))
+ WK(2,J) = G*WK(1,J-1) + TWO*(WK(1,J) + WK(1,J+1))
+ 20 CONTINUE
+ ENDIF
+C
+C CONSTRUCT LAST EQUATION FROM SECOND BOUNDARY CONDITION, OF THE FORM
+C (-G*WK(2,N-1))*S(N-1) + WK(2,N)*S(N) = D(1,N)
+C
+C IF SLOPE IS PRESCRIBED AT RIGHT END, ONE CAN GO DIRECTLY TO BACK-
+C SUBSTITUTION, SINCE ARRAYS HAPPEN TO BE SET UP JUST RIGHT FOR IT
+C AT THIS POINT.
+ IF (IEND .EQ. 1) GO TO 30
+C
+ IF (IEND .EQ. 0) THEN
+ IF (N.EQ.2 .AND. IBEG.EQ.0) THEN
+C NOT-A-KNOT AT RIGHT ENDPOINT AND AT LEFT ENDPOINT AND N = 2.
+ D(1,2) = WK(2,2)
+ GO TO 30
+ ELSE IF ((N.EQ.2) .OR. (N.EQ.3 .AND. IBEG.EQ.0)) THEN
+C EITHER (N=3 AND NOT-A-KNOT ALSO AT LEFT) OR (N=2 AND *NOT*
+C NOT-A-KNOT AT LEFT END POINT).
+ D(1,N) = TWO*WK(2,N)
+ WK(2,N) = ONE
+ IF (WK(2,N-1) .EQ. ZERO) GO TO 5008
+ G = -ONE/WK(2,N-1)
+ ELSE
+C NOT-A-KNOT AND N .GE. 3, AND EITHER N.GT.3 OR ALSO NOT-A-
+C KNOT AT LEFT END POINT.
+ G = WK(1,N-1) + WK(1,N)
+C DO NOT NEED TO CHECK FOLLOWING DENOMINATORS (X-DIFFERENCES).
+ D(1,N) = ((WK(1,N)+TWO*G)*WK(2,N)*WK(1,N-1)
+ * + WK(1,N)**2*(F(1,N-1)-F(1,N-2))/WK(1,N-1))/G
+ IF (WK(2,N-1) .EQ. ZERO) GO TO 5008
+ G = -G/WK(2,N-1)
+ WK(2,N) = WK(1,N-1)
+ ENDIF
+ ELSE
+C SECOND DERIVATIVE PRESCRIBED AT RIGHT ENDPOINT.
+ D(1,N) = THREE*WK(2,N) + HALF*WK(1,N)*D(1,N)
+ WK(2,N) = TWO
+ IF (WK(2,N-1) .EQ. ZERO) GO TO 5008
+ G = -ONE/WK(2,N-1)
+ ENDIF
+C
+C COMPLETE FORWARD PASS OF GAUSS ELIMINATION.
+C
+ WK(2,N) = G*WK(1,N-1) + WK(2,N)
+ IF (WK(2,N) .EQ. ZERO) GO TO 5008
+ D(1,N) = (G*D(1,N-1) + D(1,N))/WK(2,N)
+C
+C CARRY OUT BACK SUBSTITUTION
+C
+ 30 CONTINUE
+ DO 40 J=NM1,1,-1
+ IF (WK(2,J) .EQ. ZERO) GO TO 5008
+ D(1,J) = (D(1,J) - WK(1,J)*D(1,J+1))/WK(2,J)
+ 40 CONTINUE
+C --------------------( END CODING FROM CUBSPL )--------------------
+C
+C NORMAL RETURN.
+C
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C N.LT.2 RETURN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'PCHSP',
+ + 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C INCFD.LT.1 RETURN.
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'PCHSP', 'INCREMENT LESS THAN ONE', IERR,
+ + 1)
+ RETURN
+C
+ 5003 CONTINUE
+C X-ARRAY NOT STRICTLY INCREASING.
+ IERR = -3
+ CALL XERMSG ('SLATEC', 'PCHSP', 'X-ARRAY NOT STRICTLY INCREASING'
+ + , IERR, 1)
+ RETURN
+C
+ 5004 CONTINUE
+C IC OUT OF RANGE RETURN.
+ IERR = IERR - 3
+ CALL XERMSG ('SLATEC', 'PCHSP', 'IC OUT OF RANGE', IERR, 1)
+ RETURN
+C
+ 5007 CONTINUE
+C NWK TOO SMALL RETURN.
+ IERR = -7
+ CALL XERMSG ('SLATEC', 'PCHSP', 'WORK ARRAY TOO SMALL', IERR, 1)
+ RETURN
+C
+ 5008 CONTINUE
+C SINGULAR SYSTEM.
+C *** THEORETICALLY, THIS CAN ONLY OCCUR IF SUCCESSIVE X-VALUES ***
+C *** ARE EQUAL, WHICH SHOULD ALREADY HAVE BEEN CAUGHT (IERR=-3). ***
+ IERR = -8
+ CALL XERMSG ('SLATEC', 'PCHSP', 'SINGULAR LINEAR SYSTEM', IERR,
+ + 1)
+ RETURN
+C
+ 5009 CONTINUE
+C ERROR RETURN FROM PCHDF.
+C *** THIS CASE SHOULD NEVER OCCUR ***
+ IERR = -9
+ CALL XERMSG ('SLATEC', 'PCHSP', 'ERROR RETURN FROM PCHDF', IERR,
+ + 1)
+ RETURN
+C------------- LAST LINE OF PCHSP FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchst.f b/Lib/Slatec/slatec/pchst.f
new file mode 100644
index 0000000..e623120
--- /dev/null
+++ b/Lib/Slatec/slatec/pchst.f
@@ -0,0 +1,57 @@
+*DECK PCHST
+ REAL FUNCTION PCHST (ARG1, ARG2)
+C***BEGIN PROLOGUE PCHST
+C***SUBSIDIARY
+C***PURPOSE PCHIP Sign-Testing Routine
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE SINGLE PRECISION (PCHST-S, DPCHST-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C PCHST: PCHIP Sign-Testing Routine.
+C
+C Returns:
+C -1. if ARG1 and ARG2 are of opposite sign.
+C 0. if either argument is zero.
+C +1. if ARG1 and ARG2 are of the same sign.
+C
+C The object is to do this without multiplying ARG1*ARG2, to avoid
+C possible over/underflow problems.
+C
+C Fortran intrinsics used: SIGN.
+C
+C***SEE ALSO PCHCE, PCHCI, PCHCS, PCHIM
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 811103 DATE WRITTEN
+C 820805 Converted to SLATEC library version.
+C 870813 Minor cosmetic changes.
+C 890411 Added SAVE statements (Vers. 3.2).
+C 890411 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR and DATE WRITTEN sections in prologue. (WRB)
+C 930503 Improved purpose. (FNF)
+C***END PROLOGUE PCHST
+C
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ REAL ARG1, ARG2
+C
+C DECLARE LOCAL VARIABLES.
+C
+ REAL ONE, ZERO
+ SAVE ZERO, ONE
+ DATA ZERO /0./, ONE /1./
+C
+C PERFORM THE TEST.
+C
+C***FIRST EXECUTABLE STATEMENT PCHST
+ PCHST = SIGN(ONE,ARG1) * SIGN(ONE,ARG2)
+ IF ((ARG1.EQ.ZERO) .OR. (ARG2.EQ.ZERO)) PCHST = ZERO
+C
+ RETURN
+C------------- LAST LINE OF PCHST FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pchsw.f b/Lib/Slatec/slatec/pchsw.f
new file mode 100644
index 0000000..11d7fb5
--- /dev/null
+++ b/Lib/Slatec/slatec/pchsw.f
@@ -0,0 +1,192 @@
+*DECK PCHSW
+ SUBROUTINE PCHSW (DFMAX, IEXTRM, D1, D2, H, SLOPE, IERR)
+C***BEGIN PROLOGUE PCHSW
+C***SUBSIDIARY
+C***PURPOSE Limits excursion from data for PCHCS
+C***LIBRARY SLATEC (PCHIP)
+C***TYPE SINGLE PRECISION (PCHSW-S, DPCHSW-D)
+C***AUTHOR Fritsch, F. N., (LLNL)
+C***DESCRIPTION
+C
+C PCHSW: PCHCS Switch Excursion Limiter.
+C
+C Called by PCHCS to adjust D1 and D2 if necessary to insure that
+C the extremum on this interval is not further than DFMAX from the
+C extreme data value.
+C
+C ----------------------------------------------------------------------
+C
+C Calling sequence:
+C
+C INTEGER IEXTRM, IERR
+C REAL DFMAX, D1, D2, H, SLOPE
+C
+C CALL PCHSW (DFMAX, IEXTRM, D1, D2, H, SLOPE, IERR)
+C
+C Parameters:
+C
+C DFMAX -- (input) maximum allowed difference between F(IEXTRM) and
+C the cubic determined by derivative values D1,D2. (assumes
+C DFMAX.GT.0.)
+C
+C IEXTRM -- (input) index of the extreme data value. (assumes
+C IEXTRM = 1 or 2 . Any value .NE.1 is treated as 2.)
+C
+C D1,D2 -- (input) derivative values at the ends of the interval.
+C (Assumes D1*D2 .LE. 0.)
+C (output) may be modified if necessary to meet the restriction
+C imposed by DFMAX.
+C
+C H -- (input) interval length. (Assumes H.GT.0.)
+C
+C SLOPE -- (input) data slope on the interval.
+C
+C IERR -- (output) error flag. should be zero.
+C If IERR=-1, assumption on D1 and D2 is not satisfied.
+C If IERR=-2, quadratic equation locating extremum has
+C negative discriminant (should never occur).
+C
+C -------
+C WARNING: This routine does no validity-checking of arguments.
+C -------
+C
+C Fortran intrinsics used: ABS, SIGN, SQRT.
+C
+C***SEE ALSO PCHCS
+C***ROUTINES CALLED R1MACH, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 820218 DATE WRITTEN
+C 820805 Converted to SLATEC library version.
+C 870707 Replaced DATA statement for SMALL with a use of R1MACH.
+C 890411 1. Added SAVE statements (Vers. 3.2).
+C 2. Added REAL R1MACH for consistency with D.P. version.
+C 890411 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900328 Added TYPE section. (WRB)
+C 910408 Updated AUTHOR and DATE WRITTEN sections in prologue. (WRB)
+C 920526 Eliminated possible divide by zero problem. (FNF)
+C 930503 Improved purpose. (FNF)
+C***END PROLOGUE PCHSW
+C
+C**End
+C
+C DECLARE ARGUMENTS.
+C
+ INTEGER IEXTRM, IERR
+ REAL DFMAX, D1, D2, H, SLOPE
+C
+C DECLARE LOCAL VARIABLES.
+C
+ REAL CP, FACT, HPHI, LAMBDA, NU, ONE, PHI, RADCAL, RHO, SIGMA,
+ * SMALL, THAT, THIRD, THREE, TWO, ZERO
+ SAVE ZERO, ONE, TWO, THREE, FACT
+ SAVE THIRD
+ REAL R1MACH
+C
+ DATA ZERO /0./, ONE /1./, TWO /2./, THREE /3./, FACT /100./
+C THIRD SHOULD BE SLIGHTLY LESS THAN 1/3.
+ DATA THIRD /0.33333/
+C
+C NOTATION AND GENERAL REMARKS.
+C
+C RHO IS THE RATIO OF THE DATA SLOPE TO THE DERIVATIVE BEING TESTED.
+C LAMBDA IS THE RATIO OF D2 TO D1.
+C THAT = T-HAT(RHO) IS THE NORMALIZED LOCATION OF THE EXTREMUM.
+C PHI IS THE NORMALIZED VALUE OF P(X)-F1 AT X = XHAT = X-HAT(RHO),
+C WHERE THAT = (XHAT - X1)/H .
+C THAT IS, P(XHAT)-F1 = D*H*PHI, WHERE D=D1 OR D2.
+C SIMILARLY, P(XHAT)-F2 = D*H*(PHI-RHO) .
+C
+C SMALL SHOULD BE A FEW ORDERS OF MAGNITUDE GREATER THAN MACHEPS.
+C***FIRST EXECUTABLE STATEMENT PCHSW
+ SMALL = FACT*R1MACH(4)
+C
+C DO MAIN CALCULATION.
+C
+ IF (D1 .EQ. ZERO) THEN
+C
+C SPECIAL CASE -- D1.EQ.ZERO .
+C
+C IF D2 IS ALSO ZERO, THIS ROUTINE SHOULD NOT HAVE BEEN CALLED.
+ IF (D2 .EQ. ZERO) GO TO 5001
+C
+ RHO = SLOPE/D2
+C EXTREMUM IS OUTSIDE INTERVAL WHEN RHO .GE. 1/3 .
+ IF (RHO .GE. THIRD) GO TO 5000
+ THAT = (TWO*(THREE*RHO-ONE)) / (THREE*(TWO*RHO-ONE))
+ PHI = THAT**2 * ((THREE*RHO-ONE)/THREE)
+C
+C CONVERT TO DISTANCE FROM F2 IF IEXTRM.NE.1 .
+ IF (IEXTRM .NE. 1) PHI = PHI - RHO
+C
+C TEST FOR EXCEEDING LIMIT, AND ADJUST ACCORDINGLY.
+ HPHI = H * ABS(PHI)
+ IF (HPHI*ABS(D2) .GT. DFMAX) THEN
+C AT THIS POINT, HPHI.GT.0, SO DIVIDE IS OK.
+ D2 = SIGN (DFMAX/HPHI, D2)
+ ENDIF
+ ELSE
+C
+ RHO = SLOPE/D1
+ LAMBDA = -D2/D1
+ IF (D2 .EQ. ZERO) THEN
+C
+C SPECIAL CASE -- D2.EQ.ZERO .
+C
+C EXTREMUM IS OUTSIDE INTERVAL WHEN RHO .GE. 1/3 .
+ IF (RHO .GE. THIRD) GO TO 5000
+ CP = TWO - THREE*RHO
+ NU = ONE - TWO*RHO
+ THAT = ONE / (THREE*NU)
+ ELSE
+ IF (LAMBDA .LE. ZERO) GO TO 5001
+C
+C NORMAL CASE -- D1 AND D2 BOTH NONZERO, OPPOSITE SIGNS.
+C
+ NU = ONE - LAMBDA - TWO*RHO
+ SIGMA = ONE - RHO
+ CP = NU + SIGMA
+ IF (ABS(NU) .GT. SMALL) THEN
+ RADCAL = (NU - (TWO*RHO+ONE))*NU + SIGMA**2
+ IF (RADCAL .LT. ZERO) GO TO 5002
+ THAT = (CP - SQRT(RADCAL)) / (THREE*NU)
+ ELSE
+ THAT = ONE/(TWO*SIGMA)
+ ENDIF
+ ENDIF
+ PHI = THAT*((NU*THAT - CP)*THAT + ONE)
+C
+C CONVERT TO DISTANCE FROM F2 IF IEXTRM.NE.1 .
+ IF (IEXTRM .NE. 1) PHI = PHI - RHO
+C
+C TEST FOR EXCEEDING LIMIT, AND ADJUST ACCORDINGLY.
+ HPHI = H * ABS(PHI)
+ IF (HPHI*ABS(D1) .GT. DFMAX) THEN
+C AT THIS POINT, HPHI.GT.0, SO DIVIDE IS OK.
+ D1 = SIGN (DFMAX/HPHI, D1)
+ D2 = -LAMBDA*D1
+ ENDIF
+ ENDIF
+C
+C NORMAL RETURN.
+C
+ 5000 CONTINUE
+ IERR = 0
+ RETURN
+C
+C ERROR RETURNS.
+C
+ 5001 CONTINUE
+C D1 AND D2 BOTH ZERO, OR BOTH NONZERO AND SAME SIGN.
+ IERR = -1
+ CALL XERMSG ('SLATEC', 'PCHSW', 'D1 AND/OR D2 INVALID', IERR, 1)
+ RETURN
+C
+ 5002 CONTINUE
+C NEGATIVE VALUE OF RADICAL (SHOULD NEVER OCCUR).
+ IERR = -2
+ CALL XERMSG ('SLATEC', 'PCHSW', 'NEGATIVE RADICAL', IERR, 1)
+ RETURN
+C------------- LAST LINE OF PCHSW FOLLOWS ------------------------------
+ END
diff --git a/Lib/Slatec/slatec/pcoef.f b/Lib/Slatec/slatec/pcoef.f
new file mode 100644
index 0000000..5f6e63d
--- /dev/null
+++ b/Lib/Slatec/slatec/pcoef.f
@@ -0,0 +1,78 @@
+*DECK PCOEF
+ SUBROUTINE PCOEF (L, C, TC, A)
+C***BEGIN PROLOGUE PCOEF
+C***PURPOSE Convert the POLFIT coefficients to Taylor series form.
+C***LIBRARY SLATEC
+C***CATEGORY K1A1A2
+C***TYPE SINGLE PRECISION (PCOEF-S, DPCOEF-D)
+C***KEYWORDS CURVE FITTING, DATA FITTING, LEAST SQUARES, POLYNOMIAL FIT
+C***AUTHOR Shampine, L. F., (SNLA)
+C Davenport, S. M., (SNLA)
+C***DESCRIPTION
+C
+C Written BY L. F. Shampine and S. M. Davenport.
+C
+C Abstract
+C
+C POLFIT computes the least squares polynomial fit of degree L as
+C a sum of orthogonal polynomials. PCOEF changes this fit to its
+C Taylor expansion about any point C , i.e. writes the polynomial
+C as a sum of powers of (X-C). Taking C=0. gives the polynomial
+C in powers of X, but a suitable non-zero C often leads to
+C polynomials which are better scaled and more accurately evaluated.
+C
+C The parameters for PCOEF are
+C
+C INPUT --
+C L - Indicates the degree of polynomial to be changed to
+C its Taylor expansion. To obtain the Taylor
+C coefficients in reverse order, input L as the
+C negative of the degree desired. The absolute value
+C of L must be less than or equal to NDEG, the highest
+C degree polynomial fitted by POLFIT .
+C C - The point about which the Taylor expansion is to be
+C made.
+C A - Work and output array containing values from last
+C call to POLFIT .
+C
+C OUTPUT --
+C TC - Vector containing the first LL+1 Taylor coefficients
+C where LL=ABS(L). If L.GT.0 , the coefficients are
+C in the usual Taylor series order, i.e.
+C P(X) = TC(1) + TC(2)*(X-C) + ... + TC(N+1)*(X-C)**N
+C If L .LT. 0, the coefficients are in reverse order,
+C i.e.
+C P(X) = TC(1)*(X-C)**N + ... + TC(N)*(X-C) + TC(N+1)
+C
+C***REFERENCES L. F. Shampine, S. M. Davenport and R. E. Huddleston,
+C Curve fitting by polynomials in one variable, Report
+C SLA-74-0270, Sandia Laboratories, June 1974.
+C***ROUTINES CALLED PVALUE
+C***REVISION HISTORY (YYMMDD)
+C 740601 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890531 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE PCOEF
+C
+ DIMENSION A(*), TC(*)
+C***FIRST EXECUTABLE STATEMENT PCOEF
+ LL = ABS(L)
+ LLP1 = LL + 1
+ CALL PVALUE (LL,LL,C,TC(1),TC(2),A)
+ IF (LL .LT. 2) GO TO 2
+ FAC = 1.0
+ DO 1 I = 3,LLP1
+ FAC = FAC*(I-1)
+ 1 TC(I) = TC(I)/FAC
+ 2 IF (L .GE. 0) GO TO 4
+ NR = LLP1/2
+ LLP2 = LL + 2
+ DO 3 I = 1,NR
+ SAVE = TC(I)
+ NEW = LLP2 - I
+ TC(I) = TC(NEW)
+ 3 TC(NEW) = SAVE
+ 4 RETURN
+ END
diff --git a/Lib/Slatec/slatec/polfit.f b/Lib/Slatec/slatec/polfit.f
new file mode 100644
index 0000000..12427b1
--- /dev/null
+++ b/Lib/Slatec/slatec/polfit.f
@@ -0,0 +1,352 @@
+*DECK POLFIT
+ SUBROUTINE POLFIT (N, X, Y, W, MAXDEG, NDEG, EPS, R, IERR, A)
+C***BEGIN PROLOGUE POLFIT
+C***PURPOSE Fit discrete data in a least squares sense by polynomials
+C in one variable.
+C***LIBRARY SLATEC
+C***CATEGORY K1A1A2
+C***TYPE SINGLE PRECISION (POLFIT-S, DPOLFT-D)
+C***KEYWORDS CURVE FITTING, DATA FITTING, LEAST SQUARES, POLYNOMIAL FIT
+C***AUTHOR Shampine, L. F., (SNLA)
+C Davenport, S. M., (SNLA)
+C Huddleston, R. E., (SNLL)
+C***DESCRIPTION
+C
+C Abstract
+C
+C Given a collection of points X(I) and a set of values Y(I) which
+C correspond to some function or measurement at each of the X(I),
+C subroutine POLFIT computes the weighted least-squares polynomial
+C fits of all degrees up to some degree either specified by the user
+C or determined by the routine. The fits thus obtained are in
+C orthogonal polynomial form. Subroutine PVALUE may then be
+C called to evaluate the fitted polynomials and any of their
+C derivatives at any point. The subroutine PCOEF may be used to
+C express the polynomial fits as powers of (X-C) for any specified
+C point C.
+C
+C The parameters for POLFIT are
+C
+C Input --
+C N - the number of data points. The arrays X, Y and W
+C must be dimensioned at least N (N .GE. 1).
+C X - array of values of the independent variable. These
+C values may appear in any order and need not all be
+C distinct.
+C Y - array of corresponding function values.
+C W - array of positive values to be used as weights. If
+C W(1) is negative, POLFIT will set all the weights
+C to 1.0, which means unweighted least squares error
+C will be minimized. To minimize relative error, the
+C user should set the weights to: W(I) = 1.0/Y(I)**2,
+C I = 1,...,N .
+C MAXDEG - maximum degree to be allowed for polynomial fit.
+C MAXDEG may be any non-negative integer less than N.
+C Note -- MAXDEG cannot be equal to N-1 when a
+C statistical test is to be used for degree selection,
+C i.e., when input value of EPS is negative.
+C EPS - specifies the criterion to be used in determining
+C the degree of fit to be computed.
+C (1) If EPS is input negative, POLFIT chooses the
+C degree based on a statistical F test of
+C significance. One of three possible
+C significance levels will be used: .01, .05 or
+C .10. If EPS=-1.0 , the routine will
+C automatically select one of these levels based
+C on the number of data points and the maximum
+C degree to be considered. If EPS is input as
+C -.01, -.05, or -.10, a significance level of
+C .01, .05, or .10, respectively, will be used.
+C (2) If EPS is set to 0., POLFIT computes the
+C polynomials of degrees 0 through MAXDEG .
+C (3) If EPS is input positive, EPS is the RMS
+C error tolerance which must be satisfied by the
+C fitted polynomial. POLFIT will increase the
+C degree of fit until this criterion is met or
+C until the maximum degree is reached.
+C
+C Output --
+C NDEG - degree of the highest degree fit computed.
+C EPS - RMS error of the polynomial of degree NDEG .
+C R - vector of dimension at least NDEG containing values
+C of the fit of degree NDEG at each of the X(I) .
+C Except when the statistical test is used, these
+C values are more accurate than results from subroutine
+C PVALUE normally are.
+C IERR - error flag with the following possible values.
+C 1 -- indicates normal execution, i.e., either
+C (1) the input value of EPS was negative, and the
+C computed polynomial fit of degree NDEG
+C satisfies the specified F test, or
+C (2) the input value of EPS was 0., and the fits of
+C all degrees up to MAXDEG are complete, or
+C (3) the input value of EPS was positive, and the
+C polynomial of degree NDEG satisfies the RMS
+C error requirement.
+C 2 -- invalid input parameter. At least one of the input
+C parameters has an illegal value and must be corrected
+C before POLFIT can proceed. Valid input results
+C when the following restrictions are observed
+C N .GE. 1
+C 0 .LE. MAXDEG .LE. N-1 for EPS .GE. 0.
+C 0 .LE. MAXDEG .LE. N-2 for EPS .LT. 0.
+C W(1)=-1.0 or W(I) .GT. 0., I=1,...,N .
+C 3 -- cannot satisfy the RMS error requirement with a
+C polynomial of degree no greater than MAXDEG . Best
+C fit found is of degree MAXDEG .
+C 4 -- cannot satisfy the test for significance using
+C current value of MAXDEG . Statistically, the
+C best fit found is of order NORD . (In this case,
+C NDEG will have one of the values: MAXDEG-2,
+C MAXDEG-1, or MAXDEG). Using a higher value of
+C MAXDEG may result in passing the test.
+C A - work and output array having at least 3N+3MAXDEG+3
+C locations
+C
+C Note - POLFIT calculates all fits of degrees up to and including
+C NDEG . Any or all of these fits can be evaluated or
+C expressed as powers of (X-C) using PVALUE and PCOEF
+C after just one call to POLFIT .
+C
+C***REFERENCES L. F. Shampine, S. M. Davenport and R. E. Huddleston,
+C Curve fitting by polynomials in one variable, Report
+C SLA-74-0270, Sandia Laboratories, June 1974.
+C***ROUTINES CALLED PVALUE, XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 740601 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890531 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C 920527 Corrected erroneous statements in DESCRIPTION. (WRB)
+C***END PROLOGUE POLFIT
+ DOUBLE PRECISION TEMD1,TEMD2
+ DIMENSION X(*), Y(*), W(*), R(*), A(*)
+ DIMENSION CO(4,3)
+ SAVE CO
+ DATA CO(1,1), CO(2,1), CO(3,1), CO(4,1), CO(1,2), CO(2,2),
+ 1 CO(3,2), CO(4,2), CO(1,3), CO(2,3), CO(3,3),
+ 2 CO(4,3)/-13.086850,-2.4648165,-3.3846535,-1.2973162,
+ 3 -3.3381146,-1.7812271,-3.2578406,-1.6589279,
+ 4 -1.6282703,-1.3152745,-3.2640179,-1.9829776/
+C***FIRST EXECUTABLE STATEMENT POLFIT
+ M = ABS(N)
+ IF (M .EQ. 0) GO TO 30
+ IF (MAXDEG .LT. 0) GO TO 30
+ A(1) = MAXDEG
+ MOP1 = MAXDEG + 1
+ IF (M .LT. MOP1) GO TO 30
+ IF (EPS .LT. 0.0 .AND. M .EQ. MOP1) GO TO 30
+ XM = M
+ ETST = EPS*EPS*XM
+ IF (W(1) .LT. 0.0) GO TO 2
+ DO 1 I = 1,M
+ IF (W(I) .LE. 0.0) GO TO 30
+ 1 CONTINUE
+ GO TO 4
+ 2 DO 3 I = 1,M
+ 3 W(I) = 1.0
+ 4 IF (EPS .GE. 0.0) GO TO 8
+C
+C DETERMINE SIGNIFICANCE LEVEL INDEX TO BE USED IN STATISTICAL TEST FOR
+C CHOOSING DEGREE OF POLYNOMIAL FIT
+C
+ IF (EPS .GT. (-.55)) GO TO 5
+ IDEGF = M - MAXDEG - 1
+ KSIG = 1
+ IF (IDEGF .LT. 10) KSIG = 2
+ IF (IDEGF .LT. 5) KSIG = 3
+ GO TO 8
+ 5 KSIG = 1
+ IF (EPS .LT. (-.03)) KSIG = 2
+ IF (EPS .LT. (-.07)) KSIG = 3
+C
+C INITIALIZE INDEXES AND COEFFICIENTS FOR FITTING
+C
+ 8 K1 = MAXDEG + 1
+ K2 = K1 + MAXDEG
+ K3 = K2 + MAXDEG + 2
+ K4 = K3 + M
+ K5 = K4 + M
+ DO 9 I = 2,K4
+ 9 A(I) = 0.0
+ W11 = 0.0
+ IF (N .LT. 0) GO TO 11
+C
+C UNCONSTRAINED CASE
+C
+ DO 10 I = 1,M
+ K4PI = K4 + I
+ A(K4PI) = 1.0
+ 10 W11 = W11 + W(I)
+ GO TO 13
+C
+C CONSTRAINED CASE
+C
+ 11 DO 12 I = 1,M
+ K4PI = K4 + I
+ 12 W11 = W11 + W(I)*A(K4PI)**2
+C
+C COMPUTE FIT OF DEGREE ZERO
+C
+ 13 TEMD1 = 0.0D0
+ DO 14 I = 1,M
+ K4PI = K4 + I
+ TEMD1 = TEMD1 + DBLE(W(I))*DBLE(Y(I))*DBLE(A(K4PI))
+ 14 CONTINUE
+ TEMD1 = TEMD1/DBLE(W11)
+ A(K2+1) = TEMD1
+ SIGJ = 0.0
+ DO 15 I = 1,M
+ K4PI = K4 + I
+ K5PI = K5 + I
+ TEMD2 = TEMD1*DBLE(A(K4PI))
+ R(I) = TEMD2
+ A(K5PI) = TEMD2 - DBLE(R(I))
+ 15 SIGJ = SIGJ + W(I)*((Y(I)-R(I)) - A(K5PI))**2
+ J = 0
+C
+C SEE IF POLYNOMIAL OF DEGREE 0 SATISFIES THE DEGREE SELECTION CRITERION
+C
+ IF (EPS) 24,26,27
+C
+C INCREMENT DEGREE
+C
+ 16 J = J + 1
+ JP1 = J + 1
+ K1PJ = K1 + J
+ K2PJ = K2 + J
+ SIGJM1 = SIGJ
+C
+C COMPUTE NEW B COEFFICIENT EXCEPT WHEN J = 1
+C
+ IF (J .GT. 1) A(K1PJ) = W11/W1
+C
+C COMPUTE NEW A COEFFICIENT
+C
+ TEMD1 = 0.0D0
+ DO 18 I = 1,M
+ K4PI = K4 + I
+ TEMD2 = A(K4PI)
+ TEMD1 = TEMD1 + DBLE(X(I))*DBLE(W(I))*TEMD2*TEMD2
+ 18 CONTINUE
+ A(JP1) = TEMD1/DBLE(W11)
+C
+C EVALUATE ORTHOGONAL POLYNOMIAL AT DATA POINTS
+C
+ W1 = W11
+ W11 = 0.0
+ DO 19 I = 1,M
+ K3PI = K3 + I
+ K4PI = K4 + I
+ TEMP = A(K3PI)
+ A(K3PI) = A(K4PI)
+ A(K4PI) = (X(I)-A(JP1))*A(K3PI) - A(K1PJ)*TEMP
+ 19 W11 = W11 + W(I)*A(K4PI)**2
+C
+C GET NEW ORTHOGONAL POLYNOMIAL COEFFICIENT USING PARTIAL DOUBLE
+C PRECISION
+C
+ TEMD1 = 0.0D0
+ DO 20 I = 1,M
+ K4PI = K4 + I
+ K5PI = K5 + I
+ TEMD2 = DBLE(W(I))*DBLE((Y(I)-R(I))-A(K5PI))*DBLE(A(K4PI))
+ 20 TEMD1 = TEMD1 + TEMD2
+ TEMD1 = TEMD1/DBLE(W11)
+ A(K2PJ+1) = TEMD1
+C
+C UPDATE POLYNOMIAL EVALUATIONS AT EACH OF THE DATA POINTS, AND
+C ACCUMULATE SUM OF SQUARES OF ERRORS. THE POLYNOMIAL EVALUATIONS ARE
+C COMPUTED AND STORED IN EXTENDED PRECISION. FOR THE I-TH DATA POINT,
+C THE MOST SIGNIFICANT BITS ARE STORED IN R(I) , AND THE LEAST
+C SIGNIFICANT BITS ARE IN A(K5PI) .
+C
+ SIGJ = 0.0
+ DO 21 I = 1,M
+ K4PI = K4 + I
+ K5PI = K5 + I
+ TEMD2 = DBLE(R(I)) + DBLE(A(K5PI)) + TEMD1*DBLE(A(K4PI))
+ R(I) = TEMD2
+ A(K5PI) = TEMD2 - DBLE(R(I))
+ 21 SIGJ = SIGJ + W(I)*((Y(I)-R(I)) - A(K5PI))**2
+C
+C SEE IF DEGREE SELECTION CRITERION HAS BEEN SATISFIED OR IF DEGREE
+C MAXDEG HAS BEEN REACHED
+C
+ IF (EPS) 23,26,27
+C
+C COMPUTE F STATISTICS (INPUT EPS .LT. 0.)
+C
+ 23 IF (SIGJ .EQ. 0.0) GO TO 29
+ DEGF = M - J - 1
+ DEN = (CO(4,KSIG)*DEGF + 1.0)*DEGF
+ FCRIT = (((CO(3,KSIG)*DEGF) + CO(2,KSIG))*DEGF + CO(1,KSIG))/DEN
+ FCRIT = FCRIT*FCRIT
+ F = (SIGJM1 - SIGJ)*DEGF/SIGJ
+ IF (F .LT. FCRIT) GO TO 25
+C
+C POLYNOMIAL OF DEGREE J SATISFIES F TEST
+C
+ 24 SIGPAS = SIGJ
+ JPAS = J
+ NFAIL = 0
+ IF (MAXDEG .EQ. J) GO TO 32
+ GO TO 16
+C
+C POLYNOMIAL OF DEGREE J FAILS F TEST. IF THERE HAVE BEEN THREE
+C SUCCESSIVE FAILURES, A STATISTICALLY BEST DEGREE HAS BEEN FOUND.
+C
+ 25 NFAIL = NFAIL + 1
+ IF (NFAIL .GE. 3) GO TO 29
+ IF (MAXDEG .EQ. J) GO TO 32
+ GO TO 16
+C
+C RAISE THE DEGREE IF DEGREE MAXDEG HAS NOT YET BEEN REACHED (INPUT
+C EPS = 0.)
+C
+ 26 IF (MAXDEG .EQ. J) GO TO 28
+ GO TO 16
+C
+C SEE IF RMS ERROR CRITERION IS SATISFIED (INPUT EPS .GT. 0.)
+C
+ 27 IF (SIGJ .LE. ETST) GO TO 28
+ IF (MAXDEG .EQ. J) GO TO 31
+ GO TO 16
+C
+C RETURNS
+C
+ 28 IERR = 1
+ NDEG = J
+ SIG = SIGJ
+ GO TO 33
+ 29 IERR = 1
+ NDEG = JPAS
+ SIG = SIGPAS
+ GO TO 33
+ 30 IERR = 2
+ CALL XERMSG ('SLATEC', 'POLFIT', 'INVALID INPUT PARAMETER.', 2,
+ + 1)
+ GO TO 37
+ 31 IERR = 3
+ NDEG = MAXDEG
+ SIG = SIGJ
+ GO TO 33
+ 32 IERR = 4
+ NDEG = JPAS
+ SIG = SIGPAS
+C
+ 33 A(K3) = NDEG
+C
+C WHEN STATISTICAL TEST HAS BEEN USED, EVALUATE THE BEST POLYNOMIAL AT
+C ALL THE DATA POINTS IF R DOES NOT ALREADY CONTAIN THESE VALUES
+C
+ IF(EPS .GE. 0.0 .OR. NDEG .EQ. MAXDEG) GO TO 36
+ NDER = 0
+ DO 35 I = 1,M
+ CALL PVALUE (NDEG,NDER,X(I),R(I),YP,A)
+ 35 CONTINUE
+ 36 EPS = SQRT(SIG/XM)
+ 37 RETURN
+ END
diff --git a/Lib/Slatec/slatec/pvalue.f b/Lib/Slatec/slatec/pvalue.f
new file mode 100644
index 0000000..d20cb78
--- /dev/null
+++ b/Lib/Slatec/slatec/pvalue.f
@@ -0,0 +1,148 @@
+*DECK PVALUE
+ SUBROUTINE PVALUE (L, NDER, X, YFIT, YP, A)
+C***BEGIN PROLOGUE PVALUE
+C***PURPOSE Use the coefficients generated by POLFIT to evaluate the
+C polynomial fit of degree L, along with the first NDER of
+C its derivatives, at a specified point.
+C***LIBRARY SLATEC
+C***CATEGORY K6
+C***TYPE SINGLE PRECISION (PVALUE-S, DP1VLU-D)
+C***KEYWORDS CURVE FITTING, LEAST SQUARES, POLYNOMIAL APPROXIMATION
+C***AUTHOR Shampine, L. F., (SNLA)
+C Davenport, S. M., (SNLA)
+C***DESCRIPTION
+C
+C Written by L. F. Shampine and S. M. Davenport.
+C
+C Abstract
+C
+C The subroutine PVALUE uses the coefficients generated by POLFIT
+C to evaluate the polynomial fit of degree L , along with the first
+C NDER of its derivatives, at a specified point. Computationally
+C stable recurrence relations are used to perform this task.
+C
+C The parameters for PVALUE are
+C
+C Input --
+C L - the degree of polynomial to be evaluated. L may be
+C any non-negative integer which is less than or equal
+C to NDEG , the highest degree polynomial provided
+C by POLFIT .
+C NDER - the number of derivatives to be evaluated. NDER
+C may be 0 or any positive value. If NDER is less
+C than 0, it will be treated as 0.
+C X - the argument at which the polynomial and its
+C derivatives are to be evaluated.
+C A - work and output array containing values from last
+C call to POLFIT .
+C
+C Output --
+C YFIT - value of the fitting polynomial of degree L at X
+C YP - array containing the first through NDER derivatives
+C of the polynomial of degree L . YP must be
+C dimensioned at least NDER in the calling program.
+C
+C***REFERENCES L. F. Shampine, S. M. Davenport and R. E. Huddleston,
+C Curve fitting by polynomials in one variable, Report
+C SLA-74-0270, Sandia Laboratories, June 1974.
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 740601 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890531 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900510 Convert XERRWV calls to XERMSG calls. (RWC)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE PVALUE
+ DIMENSION YP(*),A(*)
+ CHARACTER*8 XERN1, XERN2
+C***FIRST EXECUTABLE STATEMENT PVALUE
+ IF (L .LT. 0) GO TO 12
+ NDO = MAX(NDER,0)
+ NDO = MIN(NDO,L)
+ MAXORD = A(1) + 0.5
+ K1 = MAXORD + 1
+ K2 = K1 + MAXORD
+ K3 = K2 + MAXORD + 2
+ NORD = A(K3) + 0.5
+ IF (L .GT. NORD) GO TO 11
+ K4 = K3 + L + 1
+ IF (NDER .LT. 1) GO TO 2
+ DO 1 I = 1,NDER
+ 1 YP(I) = 0.0
+ 2 IF (L .GE. 2) GO TO 4
+ IF (L .EQ. 1) GO TO 3
+C
+C L IS 0
+C
+ VAL = A(K2+1)
+ GO TO 10
+C
+C L IS 1
+C
+ 3 CC = A(K2+2)
+ VAL = A(K2+1) + (X-A(2))*CC
+ IF (NDER .GE. 1) YP(1) = CC
+ GO TO 10
+C
+C L IS GREATER THAN 1
+C
+ 4 NDP1 = NDO + 1
+ K3P1 = K3 + 1
+ K4P1 = K4 + 1
+ LP1 = L + 1
+ LM1 = L - 1
+ ILO = K3 + 3
+ IUP = K4 + NDP1
+ DO 5 I = ILO,IUP
+ 5 A(I) = 0.0
+ DIF = X - A(LP1)
+ KC = K2 + LP1
+ A(K4P1) = A(KC)
+ A(K3P1) = A(KC-1) + DIF*A(K4P1)
+ A(K3+2) = A(K4P1)
+C
+C EVALUATE RECURRENCE RELATIONS FOR FUNCTION VALUE AND DERIVATIVES
+C
+ DO 9 I = 1,LM1
+ IN = L - I
+ INP1 = IN + 1
+ K1I = K1 + INP1
+ IC = K2 + IN
+ DIF = X - A(INP1)
+ VAL = A(IC) + DIF*A(K3P1) - A(K1I)*A(K4P1)
+ IF (NDO .LE. 0) GO TO 8
+ DO 6 N = 1,NDO
+ K3PN = K3P1 + N
+ K4PN = K4P1 + N
+ 6 YP(N) = DIF*A(K3PN) + N*A(K3PN-1) - A(K1I)*A(K4PN)
+C
+C SAVE VALUES NEEDED FOR NEXT EVALUATION OF RECURRENCE RELATIONS
+C
+ DO 7 N = 1,NDO
+ K3PN = K3P1 + N
+ K4PN = K4P1 + N
+ A(K4PN) = A(K3PN)
+ 7 A(K3PN) = YP(N)
+ 8 A(K4P1) = A(K3P1)
+ 9 A(K3P1) = VAL
+C
+C NORMAL RETURN OR ABORT DUE TO ERROR
+C
+ 10 YFIT = VAL
+ RETURN
+C
+ 11 WRITE (XERN1, '(I8)') L
+ WRITE (XERN2, '(I8)') NORD
+ CALL XERMSG ('SLATEC', 'PVALUE',
+ * 'THE ORDER OF POLYNOMIAL EVALUATION, L = ' // XERN1 //
+ * ' REQUESTED EXCEEDS THE HIGHEST ORDER FIT, NORD = ' // XERN2 //
+ * ', COMPUTED BY POLFIT -- EXECUTION TERMINATED.', 8, 2)
+ RETURN
+C
+ 12 CALL XERMSG ('SLATEC', 'PVALUE',
+ + 'INVALID INPUT PARAMETER. ORDER OF POLYNOMIAL EVALUATION ' //
+ + 'REQUESTED IS NEGATIVE -- EXECUTION TERMINATED.', 2, 2)
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/pythag.f b/Lib/Slatec/slatec/pythag.f
new file mode 100644
index 0000000..dc3ef31
--- /dev/null
+++ b/Lib/Slatec/slatec/pythag.f
@@ -0,0 +1,39 @@
+*DECK PYTHAG
+ REAL FUNCTION PYTHAG (A, B)
+C***BEGIN PROLOGUE PYTHAG
+C***SUBSIDIARY
+C***PURPOSE Compute the complex square root of a complex number without
+C destructive overflow or underflow.
+C***LIBRARY SLATEC
+C***TYPE SINGLE PRECISION (PYTHAG-S)
+C***AUTHOR (UNKNOWN)
+C***DESCRIPTION
+C
+C Finds sqrt(A**2+B**2) without overflow or destructive underflow
+C
+C***SEE ALSO EISDOC
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 811101 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900402 Added TYPE section. (WRB)
+C***END PROLOGUE PYTHAG
+ REAL A,B
+C
+ REAL P,Q,R,S,T
+C***FIRST EXECUTABLE STATEMENT PYTHAG
+ P = MAX(ABS(A),ABS(B))
+ Q = MIN(ABS(A),ABS(B))
+ IF (Q .EQ. 0.0E0) GO TO 20
+ 10 CONTINUE
+ R = (Q/P)**2
+ T = 4.0E0 + R
+ IF (T .EQ. 4.0E0) GO TO 20
+ S = R/T
+ P = P + 2.0E0*P*S
+ Q = Q*S
+ GO TO 10
+ 20 PYTHAG = P
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/r1mach.f b/Lib/Slatec/slatec/r1mach.f
new file mode 100644
index 0000000..43bc451
--- /dev/null
+++ b/Lib/Slatec/slatec/r1mach.f
@@ -0,0 +1,419 @@
+*DECK R1MACH
+ REAL FUNCTION R1MACH (I)
+C***BEGIN PROLOGUE R1MACH
+C***PURPOSE Return floating point machine dependent constants.
+C***LIBRARY SLATEC
+C***CATEGORY R1
+C***TYPE SINGLE PRECISION (R1MACH-S, D1MACH-D)
+C***KEYWORDS MACHINE CONSTANTS
+C***AUTHOR Fox, P. A., (Bell Labs)
+C Hall, A. D., (Bell Labs)
+C Schryer, N. L., (Bell Labs)
+C***DESCRIPTION
+C
+C R1MACH can be used to obtain machine-dependent parameters for the
+C local machine environment. It is a function subprogram with one
+C (input) argument, and can be referenced as follows:
+C
+C A = R1MACH(I)
+C
+C where I=1,...,5. The (output) value of A above is determined by
+C the (input) value of I. The results for various values of I are
+C discussed below.
+C
+C R1MACH(1) = B**(EMIN-1), the smallest positive magnitude.
+C R1MACH(2) = B**EMAX*(1 - B**(-T)), the largest magnitude.
+C R1MACH(3) = B**(-T), the smallest relative spacing.
+C R1MACH(4) = B**(1-T), the largest relative spacing.
+C R1MACH(5) = LOG10(B)
+C
+C Assume single precision numbers are represented in the T-digit,
+C base-B form
+C
+C sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
+C
+C where 0 .LE. X(I) .LT. B for I=1,...,T, 0 .LT. X(1), and
+C EMIN .LE. E .LE. EMAX.
+C
+C The values of B, T, EMIN and EMAX are provided in I1MACH as
+C follows:
+C I1MACH(10) = B, the base.
+C I1MACH(11) = T, the number of base-B digits.
+C I1MACH(12) = EMIN, the smallest exponent E.
+C I1MACH(13) = EMAX, the largest exponent E.
+C
+C To alter this function for a particular environment, the desired
+C set of DATA statements should be activated by removing the C from
+C column 1. Also, the values of R1MACH(1) - R1MACH(4) should be
+C checked for consistency with the local operating system.
+C
+C***REFERENCES P. A. Fox, A. D. Hall and N. L. Schryer, Framework for
+C a portable library, ACM Transactions on Mathematical
+C Software 4, 2 (June 1978), pp. 177-188.
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 790101 DATE WRITTEN
+C 890213 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
+C 900618 Added DEC RISC constants. (WRB)
+C 900723 Added IBM RS 6000 constants. (WRB)
+C 910710 Added HP 730 constants. (SMR)
+C 911114 Added Convex IEEE constants. (WRB)
+C 920121 Added SUN -r8 compiler option constants. (WRB)
+C 920229 Added Touchstone Delta i860 constants. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C 920625 Added CONVEX -p8 and -pd8 compiler option constants.
+C (BKS, WRB)
+C 930201 Added DEC Alpha and SGI constants. (RWC and WRB)
+C***END PROLOGUE R1MACH
+C
+ INTEGER SMALL(2)
+ INTEGER LARGE(2)
+ INTEGER RIGHT(2)
+ INTEGER DIVER(2)
+ INTEGER LOG10(2)
+C
+ REAL RMACH(5)
+ SAVE RMACH
+C
+ EQUIVALENCE (RMACH(1),SMALL(1))
+ EQUIVALENCE (RMACH(2),LARGE(1))
+ EQUIVALENCE (RMACH(3),RIGHT(1))
+ EQUIVALENCE (RMACH(4),DIVER(1))
+ EQUIVALENCE (RMACH(5),LOG10(1))
+C
+C MACHINE CONSTANTS FOR THE AMIGA
+C ABSOFT FORTRAN COMPILER USING THE 68020/68881 COMPILER OPTION
+C
+C DATA SMALL(1) / Z'00800000' /
+C DATA LARGE(1) / Z'7F7FFFFF' /
+C DATA RIGHT(1) / Z'33800000' /
+C DATA DIVER(1) / Z'34000000' /
+C DATA LOG10(1) / Z'3E9A209B' /
+C
+C MACHINE CONSTANTS FOR THE AMIGA
+C ABSOFT FORTRAN COMPILER USING SOFTWARE FLOATING POINT
+C
+C DATA SMALL(1) / Z'00800000' /
+C DATA LARGE(1) / Z'7EFFFFFF' /
+C DATA RIGHT(1) / Z'33800000' /
+C DATA DIVER(1) / Z'34000000' /
+C DATA LOG10(1) / Z'3E9A209B' /
+C
+C MACHINE CONSTANTS FOR THE APOLLO
+C
+C DATA SMALL(1) / 16#00800000 /
+C DATA LARGE(1) / 16#7FFFFFFF /
+C DATA RIGHT(1) / 16#33800000 /
+C DATA DIVER(1) / 16#34000000 /
+C DATA LOG10(1) / 16#3E9A209B /
+C
+C MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM
+C
+C DATA RMACH(1) / Z400800000 /
+C DATA RMACH(2) / Z5FFFFFFFF /
+C DATA RMACH(3) / Z4E9800000 /
+C DATA RMACH(4) / Z4EA800000 /
+C DATA RMACH(5) / Z500E730E8 /
+C
+C MACHINE CONSTANTS FOR THE BURROUGHS 5700/6700/7700 SYSTEMS
+C
+C DATA RMACH(1) / O1771000000000000 /
+C DATA RMACH(2) / O0777777777777777 /
+C DATA RMACH(3) / O1311000000000000 /
+C DATA RMACH(4) / O1301000000000000 /
+C DATA RMACH(5) / O1157163034761675 /
+C
+C MACHINE CONSTANTS FOR THE CDC 170/180 SERIES USING NOS/VE
+C
+C DATA RMACH(1) / Z"3001800000000000" /
+C DATA RMACH(2) / Z"4FFEFFFFFFFFFFFE" /
+C DATA RMACH(3) / Z"3FD2800000000000" /
+C DATA RMACH(4) / Z"3FD3800000000000" /
+C DATA RMACH(5) / Z"3FFF9A209A84FBCF" /
+C
+C MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES
+C
+C DATA RMACH(1) / 00564000000000000000B /
+C DATA RMACH(2) / 37767777777777777776B /
+C DATA RMACH(3) / 16414000000000000000B /
+C DATA RMACH(4) / 16424000000000000000B /
+C DATA RMACH(5) / 17164642023241175720B /
+C
+C MACHINE CONSTANTS FOR THE CELERITY C1260
+C
+C DATA SMALL(1) / Z'00800000' /
+C DATA LARGE(1) / Z'7F7FFFFF' /
+C DATA RIGHT(1) / Z'33800000' /
+C DATA DIVER(1) / Z'34000000' /
+C DATA LOG10(1) / Z'3E9A209B' /
+C
+C MACHINE CONSTANTS FOR THE CONVEX
+C USING THE -fn COMPILER OPTION
+C
+C DATA RMACH(1) / Z'00800000' /
+C DATA RMACH(2) / Z'7FFFFFFF' /
+C DATA RMACH(3) / Z'34800000' /
+C DATA RMACH(4) / Z'35000000' /
+C DATA RMACH(5) / Z'3F9A209B' /
+C
+C MACHINE CONSTANTS FOR THE CONVEX
+C USING THE -fi COMPILER OPTION
+C
+C DATA RMACH(1) / Z'00800000' /
+C DATA RMACH(2) / Z'7F7FFFFF' /
+C DATA RMACH(3) / Z'33800000' /
+C DATA RMACH(4) / Z'34000000' /
+C DATA RMACH(5) / Z'3E9A209B' /
+C
+C MACHINE CONSTANTS FOR THE CONVEX
+C USING THE -p8 OR -pd8 COMPILER OPTION
+C
+C DATA RMACH(1) / Z'0010000000000000' /
+C DATA RMACH(2) / Z'7FFFFFFFFFFFFFFF' /
+C DATA RMACH(3) / Z'3CC0000000000000' /
+C DATA RMACH(4) / Z'3CD0000000000000' /
+C DATA RMACH(5) / Z'3FF34413509F79FF' /
+C
+C MACHINE CONSTANTS FOR THE CRAY
+C
+C DATA RMACH(1) / 200034000000000000000B /
+C DATA RMACH(2) / 577767777777777777776B /
+C DATA RMACH(3) / 377224000000000000000B /
+C DATA RMACH(4) / 377234000000000000000B /
+C DATA RMACH(5) / 377774642023241175720B /
+C
+C MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200
+C NOTE - IT MAY BE APPROPRIATE TO INCLUDE THE FOLLOWING CARD -
+C STATIC RMACH(5)
+C
+C DATA SMALL / 20K, 0 /
+C DATA LARGE / 77777K, 177777K /
+C DATA RIGHT / 35420K, 0 /
+C DATA DIVER / 36020K, 0 /
+C DATA LOG10 / 40423K, 42023K /
+C
+C MACHINE CONSTANTS FOR THE DEC ALPHA
+C USING G_FLOAT
+C
+C DATA RMACH(1) / '00000080'X /
+C DATA RMACH(2) / 'FFFF7FFF'X /
+C DATA RMACH(3) / '00003480'X /
+C DATA RMACH(4) / '00003500'X /
+C DATA RMACH(5) / '209B3F9A'X /
+C
+C MACHINE CONSTANTS FOR THE DEC ALPHA
+C USING IEEE_FLOAT
+C
+C DATA RMACH(1) / '00800000'X /
+C DATA RMACH(2) / '7F7FFFFF'X /
+C DATA RMACH(3) / '33800000'X /
+C DATA RMACH(4) / '34000000'X /
+C DATA RMACH(5) / '3E9A209B'X /
+C
+C MACHINE CONSTANTS FOR THE DEC RISC
+C
+C DATA RMACH(1) / Z'00800000' /
+C DATA RMACH(2) / Z'7F7FFFFF' /
+C DATA RMACH(3) / Z'33800000' /
+C DATA RMACH(4) / Z'34000000' /
+C DATA RMACH(5) / Z'3E9A209B' /
+C
+C MACHINE CONSTANTS FOR THE DEC VAX
+C (EXPRESSED IN INTEGER AND HEXADECIMAL)
+C THE HEX FORMAT BELOW MAY NOT BE SUITABLE FOR UNIX SYSTEMS
+C THE INTEGER FORMAT SHOULD BE OK FOR UNIX SYSTEMS
+C
+C DATA SMALL(1) / 128 /
+C DATA LARGE(1) / -32769 /
+C DATA RIGHT(1) / 13440 /
+C DATA DIVER(1) / 13568 /
+C DATA LOG10(1) / 547045274 /
+C
+C DATA SMALL(1) / Z00000080 /
+C DATA LARGE(1) / ZFFFF7FFF /
+C DATA RIGHT(1) / Z00003480 /
+C DATA DIVER(1) / Z00003500 /
+C DATA LOG10(1) / Z209B3F9A /
+C
+C MACHINE CONSTANTS FOR THE ELXSI 6400
+C (ASSUMING REAL*4 IS THE DEFAULT REAL)
+C
+C DATA SMALL(1) / '00800000'X /
+C DATA LARGE(1) / '7F7FFFFF'X /
+C DATA RIGHT(1) / '33800000'X /
+C DATA DIVER(1) / '34000000'X /
+C DATA LOG10(1) / '3E9A209B'X /
+C
+C MACHINE CONSTANTS FOR THE HARRIS 220
+C
+C DATA SMALL(1), SMALL(2) / '20000000, '00000201 /
+C DATA LARGE(1), LARGE(2) / '37777777, '00000177 /
+C DATA RIGHT(1), RIGHT(2) / '20000000, '00000352 /
+C DATA DIVER(1), DIVER(2) / '20000000, '00000353 /
+C DATA LOG10(1), LOG10(2) / '23210115, '00000377 /
+C
+C MACHINE CONSTANTS FOR THE HONEYWELL 600/6000 SERIES
+C
+C DATA RMACH(1) / O402400000000 /
+C DATA RMACH(2) / O376777777777 /
+C DATA RMACH(3) / O714400000000 /
+C DATA RMACH(4) / O716400000000 /
+C DATA RMACH(5) / O776464202324 /
+C
+C MACHINE CONSTANTS FOR THE HP 730
+C
+C DATA RMACH(1) / Z'00800000' /
+C DATA RMACH(2) / Z'7F7FFFFF' /
+C DATA RMACH(3) / Z'33800000' /
+C DATA RMACH(4) / Z'34000000' /
+C DATA RMACH(5) / Z'3E9A209B' /
+C
+C MACHINE CONSTANTS FOR THE HP 2100
+C 3 WORD DOUBLE PRECISION WITH FTN4
+C
+C DATA SMALL(1), SMALL(2) / 40000B, 1 /
+C DATA LARGE(1), LARGE(2) / 77777B, 177776B /
+C DATA RIGHT(1), RIGHT(2) / 40000B, 325B /
+C DATA DIVER(1), DIVER(2) / 40000B, 327B /
+C DATA LOG10(1), LOG10(2) / 46420B, 46777B /
+C
+C MACHINE CONSTANTS FOR THE HP 2100
+C 4 WORD DOUBLE PRECISION WITH FTN4
+C
+C DATA SMALL(1), SMALL(2) / 40000B, 1 /
+C DATA LARGE(1), LARGE(2) / 77777B, 177776B /
+C DATA RIGHT(1), RIGHT(2) / 40000B, 325B /
+C DATA DIVER(1), DIVER(2) / 40000B, 327B /
+C DATA LOG10(1), LOG10(2) / 46420B, 46777B /
+C
+C MACHINE CONSTANTS FOR THE HP 9000
+C
+C DATA SMALL(1) / 00004000000B /
+C DATA LARGE(1) / 17677777777B /
+C DATA RIGHT(1) / 06340000000B /
+C DATA DIVER(1) / 06400000000B /
+C DATA LOG10(1) / 07646420233B /
+C
+C MACHINE CONSTANTS FOR THE IBM 360/370 SERIES,
+C THE XEROX SIGMA 5/7/9, THE SEL SYSTEMS 85/86 AND
+C THE PERKIN ELMER (INTERDATA) 7/32.
+C
+C DATA RMACH(1) / Z00100000 /
+C DATA RMACH(2) / Z7FFFFFFF /
+C DATA RMACH(3) / Z3B100000 /
+C DATA RMACH(4) / Z3C100000 /
+C DATA RMACH(5) / Z41134413 /
+C
+C MACHINE CONSTANTS FOR THE IBM PC
+C
+C DATA SMALL(1) / 1.18E-38 /
+C DATA LARGE(1) / 3.40E+38 /
+C DATA RIGHT(1) / 0.595E-07 /
+C DATA DIVER(1) / 1.19E-07 /
+C DATA LOG10(1) / 0.30102999566 /
+C
+C MACHINE CONSTANTS FOR THE IBM RS 6000
+C
+C DATA RMACH(1) / Z'00800000' /
+C DATA RMACH(2) / Z'7F7FFFFF' /
+C DATA RMACH(3) / Z'33800000' /
+C DATA RMACH(4) / Z'34000000' /
+C DATA RMACH(5) / Z'3E9A209B' /
+C
+C MACHINE CONSTANTS FOR THE INTEL i860
+C
+C DATA RMACH(1) / Z'00800000' /
+C DATA RMACH(2) / Z'7F7FFFFF' /
+C DATA RMACH(3) / Z'33800000' /
+C DATA RMACH(4) / Z'34000000' /
+C DATA RMACH(5) / Z'3E9A209B' /
+C
+C MACHINE CONSTANTS FOR THE PDP-10 (KA OR KI PROCESSOR)
+C
+C DATA RMACH(1) / "000400000000 /
+C DATA RMACH(2) / "377777777777 /
+C DATA RMACH(3) / "146400000000 /
+C DATA RMACH(4) / "147400000000 /
+C DATA RMACH(5) / "177464202324 /
+C
+C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING
+C 32-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL).
+C
+C DATA SMALL(1) / 8388608 /
+C DATA LARGE(1) / 2147483647 /
+C DATA RIGHT(1) / 880803840 /
+C DATA DIVER(1) / 889192448 /
+C DATA LOG10(1) / 1067065499 /
+C
+C DATA RMACH(1) / O00040000000 /
+C DATA RMACH(2) / O17777777777 /
+C DATA RMACH(3) / O06440000000 /
+C DATA RMACH(4) / O06500000000 /
+C DATA RMACH(5) / O07746420233 /
+C
+C MACHINE CONSTANTS FOR PDP-11 FORTRAN SUPPORTING
+C 16-BIT INTEGERS (EXPRESSED IN INTEGER AND OCTAL).
+C
+C DATA SMALL(1), SMALL(2) / 128, 0 /
+C DATA LARGE(1), LARGE(2) / 32767, -1 /
+C DATA RIGHT(1), RIGHT(2) / 13440, 0 /
+C DATA DIVER(1), DIVER(2) / 13568, 0 /
+C DATA LOG10(1), LOG10(2) / 16282, 8347 /
+C
+C DATA SMALL(1), SMALL(2) / O000200, O000000 /
+C DATA LARGE(1), LARGE(2) / O077777, O177777 /
+C DATA RIGHT(1), RIGHT(2) / O032200, O000000 /
+C DATA DIVER(1), DIVER(2) / O032400, O000000 /
+C DATA LOG10(1), LOG10(2) / O037632, O020233 /
+C
+C MACHINE CONSTANTS FOR THE SILICON GRAPHICS
+C
+C DATA RMACH(1) / Z'00800000' /
+C DATA RMACH(2) / Z'7F7FFFFF' /
+C DATA RMACH(3) / Z'33800000' /
+C DATA RMACH(4) / Z'34000000' /
+C DATA RMACH(5) / Z'3E9A209B' /
+C
+C MACHINE CONSTANTS FOR THE SUN
+C
+C DATA RMACH(1) / Z'00800000' /
+C DATA RMACH(2) / Z'7F7FFFFF' /
+C DATA RMACH(3) / Z'33800000' /
+C DATA RMACH(4) / Z'34000000' /
+C DATA RMACH(5) / Z'3E9A209B' /
+C
+C MACHINE CONSTANTS FOR THE SUN
+C USING THE -r8 COMPILER OPTION
+C
+C DATA RMACH(1) / Z'0010000000000000' /
+C DATA RMACH(2) / Z'7FEFFFFFFFFFFFFF' /
+C DATA RMACH(3) / Z'3CA0000000000000' /
+C DATA RMACH(4) / Z'3CB0000000000000' /
+C DATA RMACH(5) / Z'3FD34413509F79FF' /
+C
+C MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES
+C
+C DATA RMACH(1) / O000400000000 /
+C DATA RMACH(2) / O377777777777 /
+C DATA RMACH(3) / O146400000000 /
+C DATA RMACH(4) / O147400000000 /
+C DATA RMACH(5) / O177464202324 /
+C
+C MACHINE CONSTANTS FOR THE Z80 MICROPROCESSOR
+C
+C DATA SMALL(1), SMALL(2) / 0, 256/
+C DATA LARGE(1), LARGE(2) / -1, -129/
+C DATA RIGHT(1), RIGHT(2) / 0, 26880/
+C DATA DIVER(1), DIVER(2) / 0, 27136/
+C DATA LOG10(1), LOG10(2) / 8347, 32538/
+C
+C***FIRST EXECUTABLE STATEMENT R1MACH
+ IF (I .LT. 1 .OR. I .GT. 5) CALL XERMSG ('SLATEC', 'R1MACH',
+ + 'I OUT OF BOUNDS', 1, 2)
+C
+ R1MACH = RMACH(I)
+ RETURN
+C
+ END
diff --git a/Lib/Slatec/slatec/radb2.f b/Lib/Slatec/slatec/radb2.f
new file mode 100644
index 0000000..7bff5de
--- /dev/null
+++ b/Lib/Slatec/slatec/radb2.f
@@ -0,0 +1,61 @@
+*DECK RADB2
+ SUBROUTINE RADB2 (IDO, L1, CC, CH, WA1)
+C***BEGIN PROLOGUE RADB2
+C***SUBSIDIARY
+C***PURPOSE Calculate the fast Fourier transform of subvectors of
+C length two.
+C***LIBRARY SLATEC (FFTPACK)
+C***TYPE SINGLE PRECISION (RADB2-S)
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C changing dummy array size declarations (1) to (*).
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 890831 Modified array declarations. (WRB)
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900402 Added TYPE section. (WRB)
+C***END PROLOGUE RADB2
+ DIMENSION CC(IDO,2,*), CH(IDO,L1,2), WA1(*)
+C***FIRST EXECUTABLE STATEMENT RADB2
+ DO 101 K=1,L1
+ CH(1,K,1) = CC(1,1,K)+CC(IDO,2,K)
+ CH(1,K,2) = CC(1,1,K)-CC(IDO,2,K)
+ 101 CONTINUE
+ IF (IDO-2) 107,105,102
+ 102 IDP2 = IDO+2
+ IF((IDO-1)/2.LT.L1) GO TO 108
+ DO 104 K=1,L1
+CDIR$ IVDEP
+ DO 103 I=3,IDO,2
+ IC = IDP2-I
+ CH(I-1,K,1) = CC(I-1,1,K)+CC(IC-1,2,K)
+ TR2 = CC(I-1,1,K)-CC(IC-1,2,K)
+ CH(I,K,1) = CC(I,1,K)-CC(IC,2,K)
+ TI2 = CC(I,1,K)+CC(IC,2,K)
+ CH(I-1,K,2) = WA1(I-2)*TR2-WA1(I-1)*TI2
+ CH(I,K,2) = WA1(I-2)*TI2+WA1(I-1)*TR2
+ 103 CONTINUE
+ 104 CONTINUE
+ GO TO 111
+ 108 DO 110 I=3,IDO,2
+ IC = IDP2-I
+CDIR$ IVDEP
+ DO 109 K=1,L1
+ CH(I-1,K,1) = CC(I-1,1,K)+CC(IC-1,2,K)
+ TR2 = CC(I-1,1,K)-CC(IC-1,2,K)
+ CH(I,K,1) = CC(I,1,K)-CC(IC,2,K)
+ TI2 = CC(I,1,K)+CC(IC,2,K)
+ CH(I-1,K,2) = WA1(I-2)*TR2-WA1(I-1)*TI2
+ CH(I,K,2) = WA1(I-2)*TI2+WA1(I-1)*TR2
+ 109 CONTINUE
+ 110 CONTINUE
+ 111 IF (MOD(IDO,2) .EQ. 1) RETURN
+ 105 DO 106 K=1,L1
+ CH(IDO,K,1) = CC(IDO,1,K)+CC(IDO,1,K)
+ CH(IDO,K,2) = -(CC(1,2,K)+CC(1,2,K))
+ 106 CONTINUE
+ 107 RETURN
+ END
diff --git a/Lib/Slatec/slatec/radb3.f b/Lib/Slatec/slatec/radb3.f
new file mode 100644
index 0000000..ae40565
--- /dev/null
+++ b/Lib/Slatec/slatec/radb3.f
@@ -0,0 +1,85 @@
+*DECK RADB3
+ SUBROUTINE RADB3 (IDO, L1, CC, CH, WA1, WA2)
+C***BEGIN PROLOGUE RADB3
+C***SUBSIDIARY
+C***PURPOSE Calculate the fast Fourier transform of subvectors of
+C length three.
+C***LIBRARY SLATEC (FFTPACK)
+C***TYPE SINGLE PRECISION (RADB3-S)
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C (a) changing dummy array size declarations (1) to (*),
+C (b) changing definition of variable TAUI by using
+C FORTRAN intrinsic function SQRT instead of a DATA
+C statement.
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 890831 Modified array declarations. (WRB)
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900402 Added TYPE section. (WRB)
+C***END PROLOGUE RADB3
+ DIMENSION CC(IDO,3,*), CH(IDO,L1,3), WA1(*), WA2(*)
+C***FIRST EXECUTABLE STATEMENT RADB3
+ TAUR = -.5
+ TAUI = .5*SQRT(3.)
+ DO 101 K=1,L1
+ TR2 = CC(IDO,2,K)+CC(IDO,2,K)
+ CR2 = CC(1,1,K)+TAUR*TR2
+ CH(1,K,1) = CC(1,1,K)+TR2
+ CI3 = TAUI*(CC(1,3,K)+CC(1,3,K))
+ CH(1,K,2) = CR2-CI3
+ CH(1,K,3) = CR2+CI3
+ 101 CONTINUE
+ IF (IDO .EQ. 1) RETURN
+ IDP2 = IDO+2
+ IF((IDO-1)/2.LT.L1) GO TO 104
+ DO 103 K=1,L1
+CDIR$ IVDEP
+ DO 102 I=3,IDO,2
+ IC = IDP2-I
+ TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
+ CR2 = CC(I-1,1,K)+TAUR*TR2
+ CH(I-1,K,1) = CC(I-1,1,K)+TR2
+ TI2 = CC(I,3,K)-CC(IC,2,K)
+ CI2 = CC(I,1,K)+TAUR*TI2
+ CH(I,K,1) = CC(I,1,K)+TI2
+ CR3 = TAUI*(CC(I-1,3,K)-CC(IC-1,2,K))
+ CI3 = TAUI*(CC(I,3,K)+CC(IC,2,K))
+ DR2 = CR2-CI3
+ DR3 = CR2+CI3
+ DI2 = CI2+CR3
+ DI3 = CI2-CR3
+ CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
+ CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
+ CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
+ CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
+ 102 CONTINUE
+ 103 CONTINUE
+ RETURN
+ 104 DO 106 I=3,IDO,2
+ IC = IDP2-I
+CDIR$ IVDEP
+ DO 105 K=1,L1
+ TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
+ CR2 = CC(I-1,1,K)+TAUR*TR2
+ CH(I-1,K,1) = CC(I-1,1,K)+TR2
+ TI2 = CC(I,3,K)-CC(IC,2,K)
+ CI2 = CC(I,1,K)+TAUR*TI2
+ CH(I,K,1) = CC(I,1,K)+TI2
+ CR3 = TAUI*(CC(I-1,3,K)-CC(IC-1,2,K))
+ CI3 = TAUI*(CC(I,3,K)+CC(IC,2,K))
+ DR2 = CR2-CI3
+ DR3 = CR2+CI3
+ DI2 = CI2+CR3
+ DI3 = CI2-CR3
+ CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
+ CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
+ CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
+ CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
+ 105 CONTINUE
+ 106 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/radb4.f b/Lib/Slatec/slatec/radb4.f
new file mode 100644
index 0000000..7f88c9c
--- /dev/null
+++ b/Lib/Slatec/slatec/radb4.f
@@ -0,0 +1,109 @@
+*DECK RADB4
+ SUBROUTINE RADB4 (IDO, L1, CC, CH, WA1, WA2, WA3)
+C***BEGIN PROLOGUE RADB4
+C***SUBSIDIARY
+C***PURPOSE Calculate the fast Fourier transform of subvectors of
+C length four.
+C***LIBRARY SLATEC (FFTPACK)
+C***TYPE SINGLE PRECISION (RADB4-S)
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C (a) changing dummy array size declarations (1) to (*),
+C (b) changing definition of variable SQRT2 by using
+C FORTRAN intrinsic function SQRT instead of a DATA
+C statement.
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 890831 Modified array declarations. (WRB)
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900402 Added TYPE section. (WRB)
+C***END PROLOGUE RADB4
+ DIMENSION CC(IDO,4,*), CH(IDO,L1,4), WA1(*), WA2(*), WA3(*)
+C***FIRST EXECUTABLE STATEMENT RADB4
+ SQRT2 = SQRT(2.)
+ DO 101 K=1,L1
+ TR1 = CC(1,1,K)-CC(IDO,4,K)
+ TR2 = CC(1,1,K)+CC(IDO,4,K)
+ TR3 = CC(IDO,2,K)+CC(IDO,2,K)
+ TR4 = CC(1,3,K)+CC(1,3,K)
+ CH(1,K,1) = TR2+TR3
+ CH(1,K,2) = TR1-TR4
+ CH(1,K,3) = TR2-TR3
+ CH(1,K,4) = TR1+TR4
+ 101 CONTINUE
+ IF (IDO-2) 107,105,102
+ 102 IDP2 = IDO+2
+ IF((IDO-1)/2.LT.L1) GO TO 108
+ DO 104 K=1,L1
+CDIR$ IVDEP
+ DO 103 I=3,IDO,2
+ IC = IDP2-I
+ TI1 = CC(I,1,K)+CC(IC,4,K)
+ TI2 = CC(I,1,K)-CC(IC,4,K)
+ TI3 = CC(I,3,K)-CC(IC,2,K)
+ TR4 = CC(I,3,K)+CC(IC,2,K)
+ TR1 = CC(I-1,1,K)-CC(IC-1,4,K)
+ TR2 = CC(I-1,1,K)+CC(IC-1,4,K)
+ TI4 = CC(I-1,3,K)-CC(IC-1,2,K)
+ TR3 = CC(I-1,3,K)+CC(IC-1,2,K)
+ CH(I-1,K,1) = TR2+TR3
+ CR3 = TR2-TR3
+ CH(I,K,1) = TI2+TI3
+ CI3 = TI2-TI3
+ CR2 = TR1-TR4
+ CR4 = TR1+TR4
+ CI2 = TI1+TI4
+ CI4 = TI1-TI4
+ CH(I-1,K,2) = WA1(I-2)*CR2-WA1(I-1)*CI2
+ CH(I,K,2) = WA1(I-2)*CI2+WA1(I-1)*CR2
+ CH(I-1,K,3) = WA2(I-2)*CR3-WA2(I-1)*CI3
+ CH(I,K,3) = WA2(I-2)*CI3+WA2(I-1)*CR3
+ CH(I-1,K,4) = WA3(I-2)*CR4-WA3(I-1)*CI4
+ CH(I,K,4) = WA3(I-2)*CI4+WA3(I-1)*CR4
+ 103 CONTINUE
+ 104 CONTINUE
+ GO TO 111
+ 108 DO 110 I=3,IDO,2
+ IC = IDP2-I
+CDIR$ IVDEP
+ DO 109 K=1,L1
+ TI1 = CC(I,1,K)+CC(IC,4,K)
+ TI2 = CC(I,1,K)-CC(IC,4,K)
+ TI3 = CC(I,3,K)-CC(IC,2,K)
+ TR4 = CC(I,3,K)+CC(IC,2,K)
+ TR1 = CC(I-1,1,K)-CC(IC-1,4,K)
+ TR2 = CC(I-1,1,K)+CC(IC-1,4,K)
+ TI4 = CC(I-1,3,K)-CC(IC-1,2,K)
+ TR3 = CC(I-1,3,K)+CC(IC-1,2,K)
+ CH(I-1,K,1) = TR2+TR3
+ CR3 = TR2-TR3
+ CH(I,K,1) = TI2+TI3
+ CI3 = TI2-TI3
+ CR2 = TR1-TR4
+ CR4 = TR1+TR4
+ CI2 = TI1+TI4
+ CI4 = TI1-TI4
+ CH(I-1,K,2) = WA1(I-2)*CR2-WA1(I-1)*CI2
+ CH(I,K,2) = WA1(I-2)*CI2+WA1(I-1)*CR2
+ CH(I-1,K,3) = WA2(I-2)*CR3-WA2(I-1)*CI3
+ CH(I,K,3) = WA2(I-2)*CI3+WA2(I-1)*CR3
+ CH(I-1,K,4) = WA3(I-2)*CR4-WA3(I-1)*CI4
+ CH(I,K,4) = WA3(I-2)*CI4+WA3(I-1)*CR4
+ 109 CONTINUE
+ 110 CONTINUE
+ 111 IF (MOD(IDO,2) .EQ. 1) RETURN
+ 105 DO 106 K=1,L1
+ TI1 = CC(1,2,K)+CC(1,4,K)
+ TI2 = CC(1,4,K)-CC(1,2,K)
+ TR1 = CC(IDO,1,K)-CC(IDO,3,K)
+ TR2 = CC(IDO,1,K)+CC(IDO,3,K)
+ CH(IDO,K,1) = TR2+TR2
+ CH(IDO,K,2) = SQRT2*(TR1-TI1)
+ CH(IDO,K,3) = TI2+TI2
+ CH(IDO,K,4) = -SQRT2*(TR1+TI1)
+ 106 CONTINUE
+ 107 RETURN
+ END
diff --git a/Lib/Slatec/slatec/radb5.f b/Lib/Slatec/slatec/radb5.f
new file mode 100644
index 0000000..bf72475
--- /dev/null
+++ b/Lib/Slatec/slatec/radb5.f
@@ -0,0 +1,132 @@
+*DECK RADB5
+ SUBROUTINE RADB5 (IDO, L1, CC, CH, WA1, WA2, WA3, WA4)
+C***BEGIN PROLOGUE RADB5
+C***SUBSIDIARY
+C***PURPOSE Calculate the fast Fourier transform of subvectors of
+C length five.
+C***LIBRARY SLATEC (FFTPACK)
+C***TYPE SINGLE PRECISION (RADB5-S)
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C (a) changing dummy array size declarations (1) to (*),
+C (b) changing definition of variables PI, TI11, TI12,
+C TR11, TR12 by using FORTRAN intrinsic functions ATAN
+C and SIN instead of DATA statements.
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 890831 Modified array declarations. (WRB)
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900402 Added TYPE section. (WRB)
+C***END PROLOGUE RADB5
+ DIMENSION CC(IDO,5,*), CH(IDO,L1,5), WA1(*), WA2(*), WA3(*),
+ + WA4(*)
+C***FIRST EXECUTABLE STATEMENT RADB5
+ PI = 4.*ATAN(1.)
+ TR11 = SIN(.1*PI)
+ TI11 = SIN(.4*PI)
+ TR12 = -SIN(.3*PI)
+ TI12 = SIN(.2*PI)
+ DO 101 K=1,L1
+ TI5 = CC(1,3,K)+CC(1,3,K)
+ TI4 = CC(1,5,K)+CC(1,5,K)
+ TR2 = CC(IDO,2,K)+CC(IDO,2,K)
+ TR3 = CC(IDO,4,K)+CC(IDO,4,K)
+ CH(1,K,1) = CC(1,1,K)+TR2+TR3
+ CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
+ CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
+ CI5 = TI11*TI5+TI12*TI4
+ CI4 = TI12*TI5-TI11*TI4
+ CH(1,K,2) = CR2-CI5
+ CH(1,K,3) = CR3-CI4
+ CH(1,K,4) = CR3+CI4
+ CH(1,K,5) = CR2+CI5
+ 101 CONTINUE
+ IF (IDO .EQ. 1) RETURN
+ IDP2 = IDO+2
+ IF((IDO-1)/2.LT.L1) GO TO 104
+ DO 103 K=1,L1
+CDIR$ IVDEP
+ DO 102 I=3,IDO,2
+ IC = IDP2-I
+ TI5 = CC(I,3,K)+CC(IC,2,K)
+ TI2 = CC(I,3,K)-CC(IC,2,K)
+ TI4 = CC(I,5,K)+CC(IC,4,K)
+ TI3 = CC(I,5,K)-CC(IC,4,K)
+ TR5 = CC(I-1,3,K)-CC(IC-1,2,K)
+ TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
+ TR4 = CC(I-1,5,K)-CC(IC-1,4,K)
+ TR3 = CC(I-1,5,K)+CC(IC-1,4,K)
+ CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
+ CH(I,K,1) = CC(I,1,K)+TI2+TI3
+ CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
+ CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
+ CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
+ CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
+ CR5 = TI11*TR5+TI12*TR4
+ CI5 = TI11*TI5+TI12*TI4
+ CR4 = TI12*TR5-TI11*TR4
+ CI4 = TI12*TI5-TI11*TI4
+ DR3 = CR3-CI4
+ DR4 = CR3+CI4
+ DI3 = CI3+CR4
+ DI4 = CI3-CR4
+ DR5 = CR2+CI5
+ DR2 = CR2-CI5
+ DI5 = CI2-CR5
+ DI2 = CI2+CR5
+ CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
+ CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
+ CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
+ CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
+ CH(I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4
+ CH(I,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4
+ CH(I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5
+ CH(I,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5
+ 102 CONTINUE
+ 103 CONTINUE
+ RETURN
+ 104 DO 106 I=3,IDO,2
+ IC = IDP2-I
+CDIR$ IVDEP
+ DO 105 K=1,L1
+ TI5 = CC(I,3,K)+CC(IC,2,K)
+ TI2 = CC(I,3,K)-CC(IC,2,K)
+ TI4 = CC(I,5,K)+CC(IC,4,K)
+ TI3 = CC(I,5,K)-CC(IC,4,K)
+ TR5 = CC(I-1,3,K)-CC(IC-1,2,K)
+ TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
+ TR4 = CC(I-1,5,K)-CC(IC-1,4,K)
+ TR3 = CC(I-1,5,K)+CC(IC-1,4,K)
+ CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
+ CH(I,K,1) = CC(I,1,K)+TI2+TI3
+ CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
+ CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
+ CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
+ CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
+ CR5 = TI11*TR5+TI12*TR4
+ CI5 = TI11*TI5+TI12*TI4
+ CR4 = TI12*TR5-TI11*TR4
+ CI4 = TI12*TI5-TI11*TI4
+ DR3 = CR3-CI4
+ DR4 = CR3+CI4
+ DI3 = CI3+CR4
+ DI4 = CI3-CR4
+ DR5 = CR2+CI5
+ DR2 = CR2-CI5
+ DI5 = CI2-CR5
+ DI2 = CI2+CR5
+ CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
+ CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
+ CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
+ CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
+ CH(I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4
+ CH(I,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4
+ CH(I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5
+ CH(I,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5
+ 105 CONTINUE
+ 106 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/radbg.f b/Lib/Slatec/slatec/radbg.f
new file mode 100644
index 0000000..e8ccc06
--- /dev/null
+++ b/Lib/Slatec/slatec/radbg.f
@@ -0,0 +1,189 @@
+*DECK RADBG
+ SUBROUTINE RADBG (IDO, IP, L1, IDL1, CC, C1, C2, CH, CH2, WA)
+C***BEGIN PROLOGUE RADBG
+C***SUBSIDIARY
+C***PURPOSE Calculate the fast Fourier transform of subvectors of
+C arbitrary length.
+C***LIBRARY SLATEC (FFTPACK)
+C***TYPE SINGLE PRECISION (RADBG-S)
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C (a) changing dummy array size declarations (1) to (*),
+C (b) changing references to intrinsic function FLOAT
+C to REAL, and
+C (c) changing definition of variable TPI by using
+C FORTRAN intrinsic function ATAN instead of a DATA
+C statement.
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900402 Added TYPE section. (WRB)
+C***END PROLOGUE RADBG
+ DIMENSION CH(IDO,L1,*), CC(IDO,IP,*), C1(IDO,L1,*),
+ + C2(IDL1,*), CH2(IDL1,*), WA(*)
+C***FIRST EXECUTABLE STATEMENT RADBG
+ TPI = 8.*ATAN(1.)
+ ARG = TPI/IP
+ DCP = COS(ARG)
+ DSP = SIN(ARG)
+ IDP2 = IDO+2
+ NBD = (IDO-1)/2
+ IPP2 = IP+2
+ IPPH = (IP+1)/2
+ IF (IDO .LT. L1) GO TO 103
+ DO 102 K=1,L1
+ DO 101 I=1,IDO
+ CH(I,K,1) = CC(I,1,K)
+ 101 CONTINUE
+ 102 CONTINUE
+ GO TO 106
+ 103 DO 105 I=1,IDO
+ DO 104 K=1,L1
+ CH(I,K,1) = CC(I,1,K)
+ 104 CONTINUE
+ 105 CONTINUE
+ 106 DO 108 J=2,IPPH
+ JC = IPP2-J
+ J2 = J+J
+ DO 107 K=1,L1
+ CH(1,K,J) = CC(IDO,J2-2,K)+CC(IDO,J2-2,K)
+ CH(1,K,JC) = CC(1,J2-1,K)+CC(1,J2-1,K)
+ 107 CONTINUE
+ 108 CONTINUE
+ IF (IDO .EQ. 1) GO TO 116
+ IF (NBD .LT. L1) GO TO 112
+ DO 111 J=2,IPPH
+ JC = IPP2-J
+ DO 110 K=1,L1
+CDIR$ IVDEP
+ DO 109 I=3,IDO,2
+ IC = IDP2-I
+ CH(I-1,K,J) = CC(I-1,2*J-1,K)+CC(IC-1,2*J-2,K)
+ CH(I-1,K,JC) = CC(I-1,2*J-1,K)-CC(IC-1,2*J-2,K)
+ CH(I,K,J) = CC(I,2*J-1,K)-CC(IC,2*J-2,K)
+ CH(I,K,JC) = CC(I,2*J-1,K)+CC(IC,2*J-2,K)
+ 109 CONTINUE
+ 110 CONTINUE
+ 111 CONTINUE
+ GO TO 116
+ 112 DO 115 J=2,IPPH
+ JC = IPP2-J
+CDIR$ IVDEP
+ DO 114 I=3,IDO,2
+ IC = IDP2-I
+ DO 113 K=1,L1
+ CH(I-1,K,J) = CC(I-1,2*J-1,K)+CC(IC-1,2*J-2,K)
+ CH(I-1,K,JC) = CC(I-1,2*J-1,K)-CC(IC-1,2*J-2,K)
+ CH(I,K,J) = CC(I,2*J-1,K)-CC(IC,2*J-2,K)
+ CH(I,K,JC) = CC(I,2*J-1,K)+CC(IC,2*J-2,K)
+ 113 CONTINUE
+ 114 CONTINUE
+ 115 CONTINUE
+ 116 AR1 = 1.
+ AI1 = 0.
+ DO 120 L=2,IPPH
+ LC = IPP2-L
+ AR1H = DCP*AR1-DSP*AI1
+ AI1 = DCP*AI1+DSP*AR1
+ AR1 = AR1H
+ DO 117 IK=1,IDL1
+ C2(IK,L) = CH2(IK,1)+AR1*CH2(IK,2)
+ C2(IK,LC) = AI1*CH2(IK,IP)
+ 117 CONTINUE
+ DC2 = AR1
+ DS2 = AI1
+ AR2 = AR1
+ AI2 = AI1
+ DO 119 J=3,IPPH
+ JC = IPP2-J
+ AR2H = DC2*AR2-DS2*AI2
+ AI2 = DC2*AI2+DS2*AR2
+ AR2 = AR2H
+ DO 118 IK=1,IDL1
+ C2(IK,L) = C2(IK,L)+AR2*CH2(IK,J)
+ C2(IK,LC) = C2(IK,LC)+AI2*CH2(IK,JC)
+ 118 CONTINUE
+ 119 CONTINUE
+ 120 CONTINUE
+ DO 122 J=2,IPPH
+ DO 121 IK=1,IDL1
+ CH2(IK,1) = CH2(IK,1)+CH2(IK,J)
+ 121 CONTINUE
+ 122 CONTINUE
+ DO 124 J=2,IPPH
+ JC = IPP2-J
+ DO 123 K=1,L1
+ CH(1,K,J) = C1(1,K,J)-C1(1,K,JC)
+ CH(1,K,JC) = C1(1,K,J)+C1(1,K,JC)
+ 123 CONTINUE
+ 124 CONTINUE
+ IF (IDO .EQ. 1) GO TO 132
+ IF (NBD .LT. L1) GO TO 128
+ DO 127 J=2,IPPH
+ JC = IPP2-J
+ DO 126 K=1,L1
+CDIR$ IVDEP
+ DO 125 I=3,IDO,2
+ CH(I-1,K,J) = C1(I-1,K,J)-C1(I,K,JC)
+ CH(I-1,K,JC) = C1(I-1,K,J)+C1(I,K,JC)
+ CH(I,K,J) = C1(I,K,J)+C1(I-1,K,JC)
+ CH(I,K,JC) = C1(I,K,J)-C1(I-1,K,JC)
+ 125 CONTINUE
+ 126 CONTINUE
+ 127 CONTINUE
+ GO TO 132
+ 128 DO 131 J=2,IPPH
+ JC = IPP2-J
+ DO 130 I=3,IDO,2
+ DO 129 K=1,L1
+ CH(I-1,K,J) = C1(I-1,K,J)-C1(I,K,JC)
+ CH(I-1,K,JC) = C1(I-1,K,J)+C1(I,K,JC)
+ CH(I,K,J) = C1(I,K,J)+C1(I-1,K,JC)
+ CH(I,K,JC) = C1(I,K,J)-C1(I-1,K,JC)
+ 129 CONTINUE
+ 130 CONTINUE
+ 131 CONTINUE
+ 132 CONTINUE
+ IF (IDO .EQ. 1) RETURN
+ DO 133 IK=1,IDL1
+ C2(IK,1) = CH2(IK,1)
+ 133 CONTINUE
+ DO 135 J=2,IP
+ DO 134 K=1,L1
+ C1(1,K,J) = CH(1,K,J)
+ 134 CONTINUE
+ 135 CONTINUE
+ IF (NBD .GT. L1) GO TO 139
+ IS = -IDO
+ DO 138 J=2,IP
+ IS = IS+IDO
+ IDIJ = IS
+ DO 137 I=3,IDO,2
+ IDIJ = IDIJ+2
+ DO 136 K=1,L1
+ C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
+ C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
+ 136 CONTINUE
+ 137 CONTINUE
+ 138 CONTINUE
+ GO TO 143
+ 139 IS = -IDO
+ DO 142 J=2,IP
+ IS = IS+IDO
+ DO 141 K=1,L1
+ IDIJ = IS
+CDIR$ IVDEP
+ DO 140 I=3,IDO,2
+ IDIJ = IDIJ+2
+ C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
+ C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
+ 140 CONTINUE
+ 141 CONTINUE
+ 142 CONTINUE
+ 143 RETURN
+ END
diff --git a/Lib/Slatec/slatec/radf2.f b/Lib/Slatec/slatec/radf2.f
new file mode 100644
index 0000000..99a50e5
--- /dev/null
+++ b/Lib/Slatec/slatec/radf2.f
@@ -0,0 +1,61 @@
+*DECK RADF2
+ SUBROUTINE RADF2 (IDO, L1, CC, CH, WA1)
+C***BEGIN PROLOGUE RADF2
+C***SUBSIDIARY
+C***PURPOSE Calculate the fast Fourier transform of subvectors of
+C length two.
+C***LIBRARY SLATEC (FFTPACK)
+C***TYPE SINGLE PRECISION (RADF2-S)
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C changing dummy array size declarations (1) to (*).
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 890831 Modified array declarations. (WRB)
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900402 Added TYPE section. (WRB)
+C***END PROLOGUE RADF2
+ DIMENSION CH(IDO,2,*), CC(IDO,L1,2), WA1(*)
+C***FIRST EXECUTABLE STATEMENT RADF2
+ DO 101 K=1,L1
+ CH(1,1,K) = CC(1,K,1)+CC(1,K,2)
+ CH(IDO,2,K) = CC(1,K,1)-CC(1,K,2)
+ 101 CONTINUE
+ IF (IDO-2) 107,105,102
+ 102 IDP2 = IDO+2
+ IF((IDO-1)/2.LT.L1) GO TO 108
+ DO 104 K=1,L1
+CDIR$ IVDEP
+ DO 103 I=3,IDO,2
+ IC = IDP2-I
+ TR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+ TI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+ CH(I,1,K) = CC(I,K,1)+TI2
+ CH(IC,2,K) = TI2-CC(I,K,1)
+ CH(I-1,1,K) = CC(I-1,K,1)+TR2
+ CH(IC-1,2,K) = CC(I-1,K,1)-TR2
+ 103 CONTINUE
+ 104 CONTINUE
+ GO TO 111
+ 108 DO 110 I=3,IDO,2
+ IC = IDP2-I
+CDIR$ IVDEP
+ DO 109 K=1,L1
+ TR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+ TI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+ CH(I,1,K) = CC(I,K,1)+TI2
+ CH(IC,2,K) = TI2-CC(I,K,1)
+ CH(I-1,1,K) = CC(I-1,K,1)+TR2
+ CH(IC-1,2,K) = CC(I-1,K,1)-TR2
+ 109 CONTINUE
+ 110 CONTINUE
+ 111 IF (MOD(IDO,2) .EQ. 1) RETURN
+ 105 DO 106 K=1,L1
+ CH(1,2,K) = -CC(IDO,K,2)
+ CH(IDO,1,K) = CC(IDO,K,1)
+ 106 CONTINUE
+ 107 RETURN
+ END
diff --git a/Lib/Slatec/slatec/radf3.f b/Lib/Slatec/slatec/radf3.f
new file mode 100644
index 0000000..6449e32
--- /dev/null
+++ b/Lib/Slatec/slatec/radf3.f
@@ -0,0 +1,83 @@
+*DECK RADF3
+ SUBROUTINE RADF3 (IDO, L1, CC, CH, WA1, WA2)
+C***BEGIN PROLOGUE RADF3
+C***SUBSIDIARY
+C***PURPOSE Calculate the fast Fourier transform of subvectors of
+C length three.
+C***LIBRARY SLATEC (FFTPACK)
+C***TYPE SINGLE PRECISION (RADF3-S)
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C (a) changing dummy array size declarations (1) to (*),
+C (b) changing definition of variable TAUI by using
+C FORTRAN intrinsic function SQRT instead of a DATA
+C statement.
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 890831 Modified array declarations. (WRB)
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900402 Added TYPE section. (WRB)
+C***END PROLOGUE RADF3
+ DIMENSION CH(IDO,3,*), CC(IDO,L1,3), WA1(*), WA2(*)
+C***FIRST EXECUTABLE STATEMENT RADF3
+ TAUR = -.5
+ TAUI = .5*SQRT(3.)
+ DO 101 K=1,L1
+ CR2 = CC(1,K,2)+CC(1,K,3)
+ CH(1,1,K) = CC(1,K,1)+CR2
+ CH(1,3,K) = TAUI*(CC(1,K,3)-CC(1,K,2))
+ CH(IDO,2,K) = CC(1,K,1)+TAUR*CR2
+ 101 CONTINUE
+ IF (IDO .EQ. 1) RETURN
+ IDP2 = IDO+2
+ IF((IDO-1)/2.LT.L1) GO TO 104
+ DO 103 K=1,L1
+CDIR$ IVDEP
+ DO 102 I=3,IDO,2
+ IC = IDP2-I
+ DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+ DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+ DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+ DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+ CR2 = DR2+DR3
+ CI2 = DI2+DI3
+ CH(I-1,1,K) = CC(I-1,K,1)+CR2
+ CH(I,1,K) = CC(I,K,1)+CI2
+ TR2 = CC(I-1,K,1)+TAUR*CR2
+ TI2 = CC(I,K,1)+TAUR*CI2
+ TR3 = TAUI*(DI2-DI3)
+ TI3 = TAUI*(DR3-DR2)
+ CH(I-1,3,K) = TR2+TR3
+ CH(IC-1,2,K) = TR2-TR3
+ CH(I,3,K) = TI2+TI3
+ CH(IC,2,K) = TI3-TI2
+ 102 CONTINUE
+ 103 CONTINUE
+ RETURN
+ 104 DO 106 I=3,IDO,2
+ IC = IDP2-I
+CDIR$ IVDEP
+ DO 105 K=1,L1
+ DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+ DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+ DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+ DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+ CR2 = DR2+DR3
+ CI2 = DI2+DI3
+ CH(I-1,1,K) = CC(I-1,K,1)+CR2
+ CH(I,1,K) = CC(I,K,1)+CI2
+ TR2 = CC(I-1,K,1)+TAUR*CR2
+ TI2 = CC(I,K,1)+TAUR*CI2
+ TR3 = TAUI*(DI2-DI3)
+ TI3 = TAUI*(DR3-DR2)
+ CH(I-1,3,K) = TR2+TR3
+ CH(IC-1,2,K) = TR2-TR3
+ CH(I,3,K) = TI2+TI3
+ CH(IC,2,K) = TI3-TI2
+ 105 CONTINUE
+ 106 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/radf4.f b/Lib/Slatec/slatec/radf4.f
new file mode 100644
index 0000000..1766c93
--- /dev/null
+++ b/Lib/Slatec/slatec/radf4.f
@@ -0,0 +1,105 @@
+*DECK RADF4
+ SUBROUTINE RADF4 (IDO, L1, CC, CH, WA1, WA2, WA3)
+C***BEGIN PROLOGUE RADF4
+C***SUBSIDIARY
+C***PURPOSE Calculate the fast Fourier transform of subvectors of
+C length four.
+C***LIBRARY SLATEC (FFTPACK)
+C***TYPE SINGLE PRECISION (RADF4-S)
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C (a) changing dummy array size declarations (1) to (*).
+C (b) changing definition of variable HSQT2 by using
+C FORTRAN intrinsic function SQRT instead of a DATA
+C statement.
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 890831 Modified array declarations. (WRB)
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900402 Added TYPE section. (WRB)
+C***END PROLOGUE RADF4
+ DIMENSION CC(IDO,L1,4), CH(IDO,4,*), WA1(*), WA2(*), WA3(*)
+C***FIRST EXECUTABLE STATEMENT RADF4
+ HSQT2 = .5*SQRT(2.)
+ DO 101 K=1,L1
+ TR1 = CC(1,K,2)+CC(1,K,4)
+ TR2 = CC(1,K,1)+CC(1,K,3)
+ CH(1,1,K) = TR1+TR2
+ CH(IDO,4,K) = TR2-TR1
+ CH(IDO,2,K) = CC(1,K,1)-CC(1,K,3)
+ CH(1,3,K) = CC(1,K,4)-CC(1,K,2)
+ 101 CONTINUE
+ IF (IDO-2) 107,105,102
+ 102 IDP2 = IDO+2
+ IF((IDO-1)/2.LT.L1) GO TO 111
+ DO 104 K=1,L1
+CDIR$ IVDEP
+ DO 103 I=3,IDO,2
+ IC = IDP2-I
+ CR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+ CI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+ CR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+ CI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+ CR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
+ CI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
+ TR1 = CR2+CR4
+ TR4 = CR4-CR2
+ TI1 = CI2+CI4
+ TI4 = CI2-CI4
+ TI2 = CC(I,K,1)+CI3
+ TI3 = CC(I,K,1)-CI3
+ TR2 = CC(I-1,K,1)+CR3
+ TR3 = CC(I-1,K,1)-CR3
+ CH(I-1,1,K) = TR1+TR2
+ CH(IC-1,4,K) = TR2-TR1
+ CH(I,1,K) = TI1+TI2
+ CH(IC,4,K) = TI1-TI2
+ CH(I-1,3,K) = TI4+TR3
+ CH(IC-1,2,K) = TR3-TI4
+ CH(I,3,K) = TR4+TI3
+ CH(IC,2,K) = TR4-TI3
+ 103 CONTINUE
+ 104 CONTINUE
+ GO TO 110
+ 111 DO 109 I=3,IDO,2
+ IC = IDP2-I
+CDIR$ IVDEP
+ DO 108 K=1,L1
+ CR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+ CI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+ CR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+ CI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+ CR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
+ CI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
+ TR1 = CR2+CR4
+ TR4 = CR4-CR2
+ TI1 = CI2+CI4
+ TI4 = CI2-CI4
+ TI2 = CC(I,K,1)+CI3
+ TI3 = CC(I,K,1)-CI3
+ TR2 = CC(I-1,K,1)+CR3
+ TR3 = CC(I-1,K,1)-CR3
+ CH(I-1,1,K) = TR1+TR2
+ CH(IC-1,4,K) = TR2-TR1
+ CH(I,1,K) = TI1+TI2
+ CH(IC,4,K) = TI1-TI2
+ CH(I-1,3,K) = TI4+TR3
+ CH(IC-1,2,K) = TR3-TI4
+ CH(I,3,K) = TR4+TI3
+ CH(IC,2,K) = TR4-TI3
+ 108 CONTINUE
+ 109 CONTINUE
+ 110 IF (MOD(IDO,2) .EQ. 1) RETURN
+ 105 DO 106 K=1,L1
+ TI1 = -HSQT2*(CC(IDO,K,2)+CC(IDO,K,4))
+ TR1 = HSQT2*(CC(IDO,K,2)-CC(IDO,K,4))
+ CH(IDO,1,K) = TR1+CC(IDO,K,1)
+ CH(IDO,3,K) = CC(IDO,K,1)-TR1
+ CH(1,2,K) = TI1-CC(IDO,K,3)
+ CH(1,4,K) = TI1+CC(IDO,K,3)
+ 106 CONTINUE
+ 107 RETURN
+ END
diff --git a/Lib/Slatec/slatec/radf5.f b/Lib/Slatec/slatec/radf5.f
new file mode 100644
index 0000000..9ffcc1f
--- /dev/null
+++ b/Lib/Slatec/slatec/radf5.f
@@ -0,0 +1,128 @@
+*DECK RADF5
+ SUBROUTINE RADF5 (IDO, L1, CC, CH, WA1, WA2, WA3, WA4)
+C***BEGIN PROLOGUE RADF5
+C***SUBSIDIARY
+C***PURPOSE Calculate the fast Fourier transform of subvectors of
+C length five.
+C***LIBRARY SLATEC (FFTPACK)
+C***TYPE SINGLE PRECISION (RADF5-S)
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C (a) changing dummy array size declarations (1) to (*),
+C (b) changing definition of variables PI, TI11, TI12,
+C TR11, TR12 by using FORTRAN intrinsic functions ATAN
+C and SIN instead of DATA statements.
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 890831 Modified array declarations. (WRB)
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900402 Added TYPE section. (WRB)
+C***END PROLOGUE RADF5
+ DIMENSION CC(IDO,L1,5), CH(IDO,5,*), WA1(*), WA2(*), WA3(*),
+ + WA4(*)
+C***FIRST EXECUTABLE STATEMENT RADF5
+ PI = 4.*ATAN(1.)
+ TR11 = SIN(.1*PI)
+ TI11 = SIN(.4*PI)
+ TR12 = -SIN(.3*PI)
+ TI12 = SIN(.2*PI)
+ DO 101 K=1,L1
+ CR2 = CC(1,K,5)+CC(1,K,2)
+ CI5 = CC(1,K,5)-CC(1,K,2)
+ CR3 = CC(1,K,4)+CC(1,K,3)
+ CI4 = CC(1,K,4)-CC(1,K,3)
+ CH(1,1,K) = CC(1,K,1)+CR2+CR3
+ CH(IDO,2,K) = CC(1,K,1)+TR11*CR2+TR12*CR3
+ CH(1,3,K) = TI11*CI5+TI12*CI4
+ CH(IDO,4,K) = CC(1,K,1)+TR12*CR2+TR11*CR3
+ CH(1,5,K) = TI12*CI5-TI11*CI4
+ 101 CONTINUE
+ IF (IDO .EQ. 1) RETURN
+ IDP2 = IDO+2
+ IF((IDO-1)/2.LT.L1) GO TO 104
+ DO 103 K=1,L1
+CDIR$ IVDEP
+ DO 102 I=3,IDO,2
+ IC = IDP2-I
+ DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+ DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+ DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+ DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+ DR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
+ DI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
+ DR5 = WA4(I-2)*CC(I-1,K,5)+WA4(I-1)*CC(I,K,5)
+ DI5 = WA4(I-2)*CC(I,K,5)-WA4(I-1)*CC(I-1,K,5)
+ CR2 = DR2+DR5
+ CI5 = DR5-DR2
+ CR5 = DI2-DI5
+ CI2 = DI2+DI5
+ CR3 = DR3+DR4
+ CI4 = DR4-DR3
+ CR4 = DI3-DI4
+ CI3 = DI3+DI4
+ CH(I-1,1,K) = CC(I-1,K,1)+CR2+CR3
+ CH(I,1,K) = CC(I,K,1)+CI2+CI3
+ TR2 = CC(I-1,K,1)+TR11*CR2+TR12*CR3
+ TI2 = CC(I,K,1)+TR11*CI2+TR12*CI3
+ TR3 = CC(I-1,K,1)+TR12*CR2+TR11*CR3
+ TI3 = CC(I,K,1)+TR12*CI2+TR11*CI3
+ TR5 = TI11*CR5+TI12*CR4
+ TI5 = TI11*CI5+TI12*CI4
+ TR4 = TI12*CR5-TI11*CR4
+ TI4 = TI12*CI5-TI11*CI4
+ CH(I-1,3,K) = TR2+TR5
+ CH(IC-1,2,K) = TR2-TR5
+ CH(I,3,K) = TI2+TI5
+ CH(IC,2,K) = TI5-TI2
+ CH(I-1,5,K) = TR3+TR4
+ CH(IC-1,4,K) = TR3-TR4
+ CH(I,5,K) = TI3+TI4
+ CH(IC,4,K) = TI4-TI3
+ 102 CONTINUE
+ 103 CONTINUE
+ RETURN
+ 104 DO 106 I=3,IDO,2
+ IC = IDP2-I
+CDIR$ IVDEP
+ DO 105 K=1,L1
+ DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+ DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+ DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+ DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+ DR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
+ DI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
+ DR5 = WA4(I-2)*CC(I-1,K,5)+WA4(I-1)*CC(I,K,5)
+ DI5 = WA4(I-2)*CC(I,K,5)-WA4(I-1)*CC(I-1,K,5)
+ CR2 = DR2+DR5
+ CI5 = DR5-DR2
+ CR5 = DI2-DI5
+ CI2 = DI2+DI5
+ CR3 = DR3+DR4
+ CI4 = DR4-DR3
+ CR4 = DI3-DI4
+ CI3 = DI3+DI4
+ CH(I-1,1,K) = CC(I-1,K,1)+CR2+CR3
+ CH(I,1,K) = CC(I,K,1)+CI2+CI3
+ TR2 = CC(I-1,K,1)+TR11*CR2+TR12*CR3
+ TI2 = CC(I,K,1)+TR11*CI2+TR12*CI3
+ TR3 = CC(I-1,K,1)+TR12*CR2+TR11*CR3
+ TI3 = CC(I,K,1)+TR12*CI2+TR11*CI3
+ TR5 = TI11*CR5+TI12*CR4
+ TI5 = TI11*CI5+TI12*CI4
+ TR4 = TI12*CR5-TI11*CR4
+ TI4 = TI12*CI5-TI11*CI4
+ CH(I-1,3,K) = TR2+TR5
+ CH(IC-1,2,K) = TR2-TR5
+ CH(I,3,K) = TI2+TI5
+ CH(IC,2,K) = TI5-TI2
+ CH(I-1,5,K) = TR3+TR4
+ CH(IC-1,4,K) = TR3-TR4
+ CH(I,5,K) = TI3+TI4
+ CH(IC,4,K) = TI4-TI3
+ 105 CONTINUE
+ 106 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/radfg.f b/Lib/Slatec/slatec/radfg.f
new file mode 100644
index 0000000..ccb3d47
--- /dev/null
+++ b/Lib/Slatec/slatec/radfg.f
@@ -0,0 +1,194 @@
+*DECK RADFG
+ SUBROUTINE RADFG (IDO, IP, L1, IDL1, CC, C1, C2, CH, CH2, WA)
+C***BEGIN PROLOGUE RADFG
+C***SUBSIDIARY
+C***PURPOSE Calculate the fast Fourier transform of subvectors of
+C arbitrary length.
+C***LIBRARY SLATEC (FFTPACK)
+C***TYPE SINGLE PRECISION (RADFG-S)
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C (a) changing dummy array size declarations (1) to (*),
+C (b) changing references to intrinsic function FLOAT
+C to REAL, and
+C (c) changing definition of variable TPI by using
+C FORTRAN intrinsic function ATAN instead of a DATA
+C statement.
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900402 Added TYPE section. (WRB)
+C***END PROLOGUE RADFG
+ DIMENSION CH(IDO,L1,*), CC(IDO,IP,*), C1(IDO,L1,*),
+ + C2(IDL1,*), CH2(IDL1,*), WA(*)
+C***FIRST EXECUTABLE STATEMENT RADFG
+ TPI = 8.*ATAN(1.)
+ ARG = TPI/IP
+ DCP = COS(ARG)
+ DSP = SIN(ARG)
+ IPPH = (IP+1)/2
+ IPP2 = IP+2
+ IDP2 = IDO+2
+ NBD = (IDO-1)/2
+ IF (IDO .EQ. 1) GO TO 119
+ DO 101 IK=1,IDL1
+ CH2(IK,1) = C2(IK,1)
+ 101 CONTINUE
+ DO 103 J=2,IP
+ DO 102 K=1,L1
+ CH(1,K,J) = C1(1,K,J)
+ 102 CONTINUE
+ 103 CONTINUE
+ IF (NBD .GT. L1) GO TO 107
+ IS = -IDO
+ DO 106 J=2,IP
+ IS = IS+IDO
+ IDIJ = IS
+ DO 105 I=3,IDO,2
+ IDIJ = IDIJ+2
+ DO 104 K=1,L1
+ CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J)
+ CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J)
+ 104 CONTINUE
+ 105 CONTINUE
+ 106 CONTINUE
+ GO TO 111
+ 107 IS = -IDO
+ DO 110 J=2,IP
+ IS = IS+IDO
+ DO 109 K=1,L1
+ IDIJ = IS
+CDIR$ IVDEP
+ DO 108 I=3,IDO,2
+ IDIJ = IDIJ+2
+ CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J)
+ CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J)
+ 108 CONTINUE
+ 109 CONTINUE
+ 110 CONTINUE
+ 111 IF (NBD .LT. L1) GO TO 115
+ DO 114 J=2,IPPH
+ JC = IPP2-J
+ DO 113 K=1,L1
+CDIR$ IVDEP
+ DO 112 I=3,IDO,2
+ C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC)
+ C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC)
+ C1(I,K,J) = CH(I,K,J)+CH(I,K,JC)
+ C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J)
+ 112 CONTINUE
+ 113 CONTINUE
+ 114 CONTINUE
+ GO TO 121
+ 115 DO 118 J=2,IPPH
+ JC = IPP2-J
+ DO 117 I=3,IDO,2
+ DO 116 K=1,L1
+ C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC)
+ C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC)
+ C1(I,K,J) = CH(I,K,J)+CH(I,K,JC)
+ C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J)
+ 116 CONTINUE
+ 117 CONTINUE
+ 118 CONTINUE
+ GO TO 121
+ 119 DO 120 IK=1,IDL1
+ C2(IK,1) = CH2(IK,1)
+ 120 CONTINUE
+ 121 DO 123 J=2,IPPH
+ JC = IPP2-J
+ DO 122 K=1,L1
+ C1(1,K,J) = CH(1,K,J)+CH(1,K,JC)
+ C1(1,K,JC) = CH(1,K,JC)-CH(1,K,J)
+ 122 CONTINUE
+ 123 CONTINUE
+C
+ AR1 = 1.
+ AI1 = 0.
+ DO 127 L=2,IPPH
+ LC = IPP2-L
+ AR1H = DCP*AR1-DSP*AI1
+ AI1 = DCP*AI1+DSP*AR1
+ AR1 = AR1H
+ DO 124 IK=1,IDL1
+ CH2(IK,L) = C2(IK,1)+AR1*C2(IK,2)
+ CH2(IK,LC) = AI1*C2(IK,IP)
+ 124 CONTINUE
+ DC2 = AR1
+ DS2 = AI1
+ AR2 = AR1
+ AI2 = AI1
+ DO 126 J=3,IPPH
+ JC = IPP2-J
+ AR2H = DC2*AR2-DS2*AI2
+ AI2 = DC2*AI2+DS2*AR2
+ AR2 = AR2H
+ DO 125 IK=1,IDL1
+ CH2(IK,L) = CH2(IK,L)+AR2*C2(IK,J)
+ CH2(IK,LC) = CH2(IK,LC)+AI2*C2(IK,JC)
+ 125 CONTINUE
+ 126 CONTINUE
+ 127 CONTINUE
+ DO 129 J=2,IPPH
+ DO 128 IK=1,IDL1
+ CH2(IK,1) = CH2(IK,1)+C2(IK,J)
+ 128 CONTINUE
+ 129 CONTINUE
+C
+ IF (IDO .LT. L1) GO TO 132
+ DO 131 K=1,L1
+ DO 130 I=1,IDO
+ CC(I,1,K) = CH(I,K,1)
+ 130 CONTINUE
+ 131 CONTINUE
+ GO TO 135
+ 132 DO 134 I=1,IDO
+ DO 133 K=1,L1
+ CC(I,1,K) = CH(I,K,1)
+ 133 CONTINUE
+ 134 CONTINUE
+ 135 DO 137 J=2,IPPH
+ JC = IPP2-J
+ J2 = J+J
+ DO 136 K=1,L1
+ CC(IDO,J2-2,K) = CH(1,K,J)
+ CC(1,J2-1,K) = CH(1,K,JC)
+ 136 CONTINUE
+ 137 CONTINUE
+ IF (IDO .EQ. 1) RETURN
+ IF (NBD .LT. L1) GO TO 141
+ DO 140 J=2,IPPH
+ JC = IPP2-J
+ J2 = J+J
+ DO 139 K=1,L1
+CDIR$ IVDEP
+ DO 138 I=3,IDO,2
+ IC = IDP2-I
+ CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC)
+ CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC)
+ CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC)
+ CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J)
+ 138 CONTINUE
+ 139 CONTINUE
+ 140 CONTINUE
+ RETURN
+ 141 DO 144 J=2,IPPH
+ JC = IPP2-J
+ J2 = J+J
+ DO 143 I=3,IDO,2
+ IC = IDP2-I
+ DO 142 K=1,L1
+ CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC)
+ CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC)
+ CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC)
+ CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J)
+ 142 CONTINUE
+ 143 CONTINUE
+ 144 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/rfftb.f b/Lib/Slatec/slatec/rfftb.f
new file mode 100644
index 0000000..0a044c5
--- /dev/null
+++ b/Lib/Slatec/slatec/rfftb.f
@@ -0,0 +1,96 @@
+*DECK RFFTB
+ SUBROUTINE RFFTB (N, R, WSAVE)
+C***BEGIN PROLOGUE RFFTB
+C***SUBSIDIARY
+C***PURPOSE Compute the backward fast Fourier transform of a real
+C coefficient array.
+C***LIBRARY SLATEC (FFTPACK)
+C***CATEGORY J1A1
+C***TYPE SINGLE PRECISION (RFFTB-S, CFFTB-C)
+C***KEYWORDS FFTPACK, FOURIER TRANSFORM
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***DESCRIPTION
+C
+C ********************************************************************
+C * NOTICE NOTICE NOTICE NOTICE NOTICE NOTICE NOTICE *
+C ********************************************************************
+C * *
+C * This routine uses non-standard Fortran 77 constructs and will *
+C * be removed from the library at a future date. You are *
+C * requested to use RFFTB1. *
+C * *
+C ********************************************************************
+C
+C Subroutine RFFTB computes the real periodic sequence from its
+C Fourier coefficients (Fourier synthesis). The transform is defined
+C below at output parameter R.
+C
+C Input Arguments
+C
+C N the length of the array R to be transformed. The method
+C is most efficient when N is a product of small primes.
+C N may change so long as different work arrays are provided.
+C
+C R a real array of length N which contains the sequence
+C to be transformed.
+C
+C WSAVE a work array which must be dimensioned at least 2*N+15
+C in the program that calls RFFTB. The WSAVE array must be
+C initialized by calling subroutine RFFTI, and a different
+C WSAVE array must be used for each different value of N.
+C This initialization does not have to be repeated so long as
+C remains unchanged. Thus subsequent transforms can be
+C obtained faster than the first. Moreover, the same WSAVE
+C array can be used by RFFTF and RFFTB as long as N remains
+C unchanged.
+C
+C Output Argument
+C
+C R For N even and for I = 1,...,N
+C
+C R(I) = R(1)+(-1)**(I-1)*R(N)
+C
+C plus the sum from K=2 to K=N/2 of
+C
+C 2.*R(2*K-2)*COS((K-1)*(I-1)*2*PI/N)
+C
+C -2.*R(2*K-1)*SIN((K-1)*(I-1)*2*PI/N)
+C
+C For N odd and for I = 1,...,N
+C
+C R(I) = R(1) plus the sum from K=2 to K=(N+1)/2 of
+C
+C 2.*R(2*K-2)*COS((K-1)*(I-1)*2*PI/N)
+C
+C -2.*R(2*K-1)*SIN((K-1)*(I-1)*2*PI/N)
+C
+C Note: This transform is unnormalized since a call of RFFTF
+C followed by a call of RFFTB will multiply the input
+C sequence by N.
+C
+C WSAVE contains results which must not be destroyed between
+C calls of RFFTB or RFFTF.
+C
+C***REFERENCES P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
+C Computations (G. Rodrigue, ed.), Academic Press,
+C 1982, pp. 51-83.
+C***ROUTINES CALLED RFFTB1
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C changing dummy array size declarations (1) to (*).
+C 861211 REVISION DATE from Version 3.2
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900131 Routine changed from user-callable to subsidiary
+C because of non-standard Fortran 77 arguments in the
+C call to CFFTB1. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE RFFTB
+ DIMENSION R(*), WSAVE(*)
+C***FIRST EXECUTABLE STATEMENT RFFTB
+ IF (N .EQ. 1) RETURN
+ CALL RFFTB1 (N,R,WSAVE,WSAVE(N+1),WSAVE(2*N+1))
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/rfftb1.f b/Lib/Slatec/slatec/rfftb1.f
new file mode 100644
index 0000000..c91fad7
--- /dev/null
+++ b/Lib/Slatec/slatec/rfftb1.f
@@ -0,0 +1,143 @@
+*DECK RFFTB1
+ SUBROUTINE RFFTB1 (N, C, CH, WA, IFAC)
+C***BEGIN PROLOGUE RFFTB1
+C***PURPOSE Compute the backward fast Fourier transform of a real
+C coefficient array.
+C***LIBRARY SLATEC (FFTPACK)
+C***CATEGORY J1A1
+C***TYPE SINGLE PRECISION (RFFTB1-S, CFFTB1-C)
+C***KEYWORDS FFTPACK, FOURIER TRANSFORM
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***DESCRIPTION
+C
+C Subroutine RFFTB1 computes the real periodic sequence from its
+C Fourier coefficients (Fourier synthesis). The transform is defined
+C below at output parameter C.
+C
+C The arrays WA and IFAC which are used by subroutine RFFTB1 must be
+C initialized by calling subroutine RFFTI1.
+C
+C Input Arguments
+C
+C N the length of the array R to be transformed. The method
+C is most efficient when N is a product of small primes.
+C N may change so long as different work arrays are provided.
+C
+C C a real array of length N which contains the sequence
+C to be transformed.
+C
+C CH a real work array of length at least N.
+C
+C WA a real work array which must be dimensioned at least N.
+C
+C IFAC an integer work array which must be dimensioned at least 15.
+C
+C The WA and IFAC arrays must be initialized by calling
+C subroutine RFFTI1, and different WA and IFAC arrays must be
+C used for each different value of N. This initialization
+C does not have to be repeated so long as N remains unchanged.
+C Thus subsequent transforms can be obtained faster than the
+C first. The same WA and IFAC arrays can be used by RFFTF1
+C and RFFTB1.
+C
+C Output Argument
+C
+C C For N even and for I = 1,...,N
+C
+C C(I) = C(1)+(-1)**(I-1)*C(N)
+C
+C plus the sum from K=2 to K=N/2 of
+C
+C 2.*C(2*K-2)*COS((K-1)*(I-1)*2*PI/N)
+C
+C -2.*C(2*K-1)*SIN((K-1)*(I-1)*2*PI/N)
+C
+C For N odd and for I = 1,...,N
+C
+C C(I) = C(1) plus the sum from K=2 to K=(N+1)/2 of
+C
+C 2.*C(2*K-2)*COS((K-1)*(I-1)*2*PI/N)
+C
+C -2.*C(2*K-1)*SIN((K-1)*(I-1)*2*PI/N)
+C
+C Notes: This transform is unnormalized since a call of RFFTF1
+C followed by a call of RFFTB1 will multiply the input
+C sequence by N.
+C
+C WA and IFAC contain initialization calculations which must
+C not be destroyed between calls of subroutine RFFTF1 or
+C RFFTB1.
+C
+C***REFERENCES P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
+C Computations (G. Rodrigue, ed.), Academic Press,
+C 1982, pp. 51-83.
+C***ROUTINES CALLED RADB2, RADB3, RADB4, RADB5, RADBG
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C changing dummy array size declarations (1) to (*).
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900131 Routine changed from subsidiary to user-callable. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE RFFTB1
+ DIMENSION CH(*), C(*), WA(*), IFAC(*)
+C***FIRST EXECUTABLE STATEMENT RFFTB1
+ NF = IFAC(2)
+ NA = 0
+ L1 = 1
+ IW = 1
+ DO 116 K1=1,NF
+ IP = IFAC(K1+2)
+ L2 = IP*L1
+ IDO = N/L2
+ IDL1 = IDO*L1
+ IF (IP .NE. 4) GO TO 103
+ IX2 = IW+IDO
+ IX3 = IX2+IDO
+ IF (NA .NE. 0) GO TO 101
+ CALL RADB4 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
+ GO TO 102
+ 101 CALL RADB4 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
+ 102 NA = 1-NA
+ GO TO 115
+ 103 IF (IP .NE. 2) GO TO 106
+ IF (NA .NE. 0) GO TO 104
+ CALL RADB2 (IDO,L1,C,CH,WA(IW))
+ GO TO 105
+ 104 CALL RADB2 (IDO,L1,CH,C,WA(IW))
+ 105 NA = 1-NA
+ GO TO 115
+ 106 IF (IP .NE. 3) GO TO 109
+ IX2 = IW+IDO
+ IF (NA .NE. 0) GO TO 107
+ CALL RADB3 (IDO,L1,C,CH,WA(IW),WA(IX2))
+ GO TO 108
+ 107 CALL RADB3 (IDO,L1,CH,C,WA(IW),WA(IX2))
+ 108 NA = 1-NA
+ GO TO 115
+ 109 IF (IP .NE. 5) GO TO 112
+ IX2 = IW+IDO
+ IX3 = IX2+IDO
+ IX4 = IX3+IDO
+ IF (NA .NE. 0) GO TO 110
+ CALL RADB5 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+ GO TO 111
+ 110 CALL RADB5 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+ 111 NA = 1-NA
+ GO TO 115
+ 112 IF (NA .NE. 0) GO TO 113
+ CALL RADBG (IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
+ GO TO 114
+ 113 CALL RADBG (IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
+ 114 IF (IDO .EQ. 1) NA = 1-NA
+ 115 L1 = L2
+ IW = IW+(IP-1)*IDO
+ 116 CONTINUE
+ IF (NA .EQ. 0) RETURN
+ DO 117 I=1,N
+ C(I) = CH(I)
+ 117 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/rfftf.f b/Lib/Slatec/slatec/rfftf.f
new file mode 100644
index 0000000..454c2b1
--- /dev/null
+++ b/Lib/Slatec/slatec/rfftf.f
@@ -0,0 +1,97 @@
+*DECK RFFTF
+ SUBROUTINE RFFTF (N, R, WSAVE)
+C***BEGIN PROLOGUE RFFTF
+C***SUBSIDIARY
+C***PURPOSE Compute the forward transform of a real, periodic sequence.
+C***LIBRARY SLATEC (FFTPACK)
+C***CATEGORY J1A1
+C***TYPE SINGLE PRECISION (RFFTF-S, CFFTF-C)
+C***KEYWORDS FFTPACK, FOURIER TRANSFORM
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***DESCRIPTION
+C
+C ********************************************************************
+C * NOTICE NOTICE NOTICE NOTICE NOTICE NOTICE NOTICE *
+C ********************************************************************
+C * *
+C * This routine uses non-standard Fortran 77 constructs and will *
+C * be removed from the library at a future date. You are *
+C * requested to use RFFTF1. *
+C * *
+C ********************************************************************
+C
+C Subroutine RFFTF computes the Fourier coefficients of a real
+C periodic sequence (Fourier analysis). The transform is defined
+C below at output parameter R.
+C
+C Input Arguments
+C
+C N the length of the array R to be transformed. The method
+C is most efficient when N is a product of small primes.
+C N may change so long as different work arrays are provided.
+C
+C R a real array of length N which contains the sequence
+C to be transformed.
+C
+C WSAVE a work array which must be dimensioned at least 2*N+15
+C in the program that calls RFFTF. The WSAVE array must be
+C initialized by calling subroutine RFFTI, and a different
+C WSAVE array must be used for each different value of N.
+C This initialization does not have to be repeated so long as
+C remains unchanged. Thus subsequent transforms can be
+C obtained faster than the first. Moreover, the same WSAVE
+C array can be used by RFFTF and RFFTB as long as N remains
+C unchanged.
+C
+C Output Argument
+C
+C R R(1) = the sum from I=1 to I=N of R(I)
+C
+C If N is even set L = N/2; if N is odd set L = (N+1)/2
+C
+C then for K = 2,...,L
+C
+C R(2*K-2) = the sum from I = 1 to I = N of
+C
+C R(I)*COS((K-1)*(I-1)*2*PI/N)
+C
+C R(2*K-1) = the sum from I = 1 to I = N of
+C
+C -R(I)*SIN((K-1)*(I-1)*2*PI/N)
+C
+C If N is even
+C
+C R(N) = the sum from I = 1 to I = N of
+C
+C (-1)**(I-1)*R(I)
+C
+C Note: This transform is unnormalized since a call of RFFTF
+C followed by a call of RFFTB will multiply the input
+C sequence by N.
+C
+C WSAVE contains results which must not be destroyed between
+C calls of RFFTF or RFFTB.
+C
+C***REFERENCES P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
+C Computations (G. Rodrigue, ed.), Academic Press,
+C 1982, pp. 51-83.
+C***ROUTINES CALLED RFFTF1
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C changing dummy array size declarations (1) to (*).
+C 861211 REVISION DATE from Version 3.2
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900131 Routine changed from user-callable to subsidiary
+C because of non-standard Fortran 77 arguments in the
+C call to CFFTB1. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE RFFTF
+ DIMENSION R(*), WSAVE(*)
+C***FIRST EXECUTABLE STATEMENT RFFTF
+ IF (N .EQ. 1) RETURN
+ CALL RFFTF1 (N,R,WSAVE,WSAVE(N+1),WSAVE(2*N+1))
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/rfftf1.f b/Lib/Slatec/slatec/rfftf1.f
new file mode 100644
index 0000000..e0e1910
--- /dev/null
+++ b/Lib/Slatec/slatec/rfftf1.f
@@ -0,0 +1,144 @@
+*DECK RFFTF1
+ SUBROUTINE RFFTF1 (N, C, CH, WA, IFAC)
+C***BEGIN PROLOGUE RFFTF1
+C***PURPOSE Compute the forward transform of a real, periodic sequence.
+C***LIBRARY SLATEC (FFTPACK)
+C***CATEGORY J1A1
+C***TYPE SINGLE PRECISION (RFFTF1-S, CFFTF1-C)
+C***KEYWORDS FFTPACK, FOURIER TRANSFORM
+C***AUTHOR Swarztrauber, P. N., (NCAR)
+C***DESCRIPTION
+C
+C Subroutine RFFTF1 computes the Fourier coefficients of a real
+C periodic sequence (Fourier analysis). The transform is defined
+C below at output parameter C.
+C
+C The arrays WA and IFAC which are used by subroutine RFFTB1 must be
+C initialized by calling subroutine RFFTI1.
+C
+C Input Arguments
+C
+C N the length of the array R to be transformed. The method
+C is most efficient when N is a product of small primes.
+C N may change so long as different work arrays are provided.
+C
+C C a real array of length N which contains the sequence
+C to be transformed.
+C
+C CH a real work array of length at least N.
+C
+C WA a real work array which must be dimensioned at least N.
+C
+C IFAC an integer work array which must be dimensioned at least 15.
+C
+C The WA and IFAC arrays must be initialized by calling
+C subroutine RFFTI1, and different WA and IFAC arrays must be
+C used for each different value of N. This initialization
+C does not have to be repeated so long as N remains unchanged.
+C Thus subsequent transforms can be obtained faster than the
+C first. The same WA and IFAC arrays can be used by RFFTF1
+C and RFFTB1.
+C
+C Output Argument
+C
+C C C(1) = the sum from I=1 to I=N of R(I)
+C
+C If N is even set L = N/2; if N is odd set L = (N+1)/2
+C
+C then for K = 2,...,L
+C
+C C(2*K-2) = the sum from I = 1 to I = N of
+C
+C C(I)*COS((K-1)*(I-1)*2*PI/N)
+C
+C C(2*K-1) = the sum from I = 1 to I = N of
+C
+C -C(I)*SIN((K-1)*(I-1)*2*PI/N)
+C
+C If N is even
+C
+C C(N) = the sum from I = 1 to I = N of
+C
+C (-1)**(I-1)*C(I)
+C
+C Notes: This transform is unnormalized since a call of RFFTF1
+C followed by a call of RFFTB1 will multiply the input
+C sequence by N.
+C
+C WA and IFAC contain initialization calculations which must
+C not be destroyed between calls of subroutine RFFTF1 or
+C RFFTB1.
+C
+C***REFERENCES P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
+C Computations (G. Rodrigue, ed.), Academic Press,
+C 1982, pp. 51-83.
+C***ROUTINES CALLED RADF2, RADF3, RADF4, RADF5, RADFG
+C***REVISION HISTORY (YYMMDD)
+C 790601 DATE WRITTEN
+C 830401 Modified to use SLATEC library source file format.
+C 860115 Modified by Ron Boisvert to adhere to Fortran 77 by
+C changing dummy array size declarations (1) to (*).
+C 881128 Modified by Dick Valent to meet prologue standards.
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900131 Routine changed from subsidiary to user-callable. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE RFFTF1
+ DIMENSION CH(*), C(*), WA(*), IFAC(*)
+C***FIRST EXECUTABLE STATEMENT RFFTF1
+ NF = IFAC(2)
+ NA = 1
+ L2 = N
+ IW = N
+ DO 111 K1=1,NF
+ KH = NF-K1
+ IP = IFAC(KH+3)
+ L1 = L2/IP
+ IDO = N/L2
+ IDL1 = IDO*L1
+ IW = IW-(IP-1)*IDO
+ NA = 1-NA
+ IF (IP .NE. 4) GO TO 102
+ IX2 = IW+IDO
+ IX3 = IX2+IDO
+ IF (NA .NE. 0) GO TO 101
+ CALL RADF4 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
+ GO TO 110
+ 101 CALL RADF4 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
+ GO TO 110
+ 102 IF (IP .NE. 2) GO TO 104
+ IF (NA .NE. 0) GO TO 103
+ CALL RADF2 (IDO,L1,C,CH,WA(IW))
+ GO TO 110
+ 103 CALL RADF2 (IDO,L1,CH,C,WA(IW))
+ GO TO 110
+ 104 IF (IP .NE. 3) GO TO 106
+ IX2 = IW+IDO
+ IF (NA .NE. 0) GO TO 105
+ CALL RADF3 (IDO,L1,C,CH,WA(IW),WA(IX2))
+ GO TO 110
+ 105 CALL RADF3 (IDO,L1,CH,C,WA(IW),WA(IX2))
+ GO TO 110
+ 106 IF (IP .NE. 5) GO TO 108
+ IX2 = IW+IDO
+ IX3 = IX2+IDO
+ IX4 = IX3+IDO
+ IF (NA .NE. 0) GO TO 107
+ CALL RADF5 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+ GO TO 110
+ 107 CALL RADF5 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+ GO TO 110
+ 108 IF (IDO .EQ. 1) NA = 1-NA
+ IF (NA .NE. 0) GO TO 109
+ CALL RADFG (IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
+ NA = 1
+ GO TO 110
+ 109 CALL RADFG (IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
+ NA = 0
+ 110 L2 = L1
+ 111 CONTINUE
+ IF (NA .EQ. 1) RETURN
+ DO 112 I=1,N
+ C(I) = CH(I)
+ 112 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/rs.f b/Lib/Slatec/slatec/rs.f
new file mode 100644
index 0000000..a040935
--- /dev/null
+++ b/Lib/Slatec/slatec/rs.f
@@ -0,0 +1,90 @@
+*DECK RSFOO
+ SUBROUTINE RSFOO (NM, N, A, W, MATZ, Z, FV1, FV2, IERR)
+C***BEGIN PROLOGUE RS
+C***PURPOSE Compute the eigenvalues and, optionally, the eigenvectors
+C of a real symmetric matrix.
+C***LIBRARY SLATEC (EISPACK)
+C***CATEGORY D4A1
+C***TYPE SINGLE PRECISION (RS-S, CH-C)
+C***KEYWORDS EIGENVALUES, EIGENVECTORS, EISPACK
+C***AUTHOR Smith, B. T., et al.
+C***DESCRIPTION
+C
+C This subroutine calls the recommended sequence of
+C subroutines from the eigensystem subroutine package (EISPACK)
+C to find the eigenvalues and eigenvectors (if desired)
+C of a REAL SYMMETRIC matrix.
+C
+C On Input
+C
+C NM must be set to the row dimension of the two-dimensional
+C array parameters, A and Z, as declared in the calling
+C program dimension statement. NM is an INTEGER variable.
+C
+C N is the order of the matrix A. N is an INTEGER variable.
+C N must be less than or equal to NM.
+C
+C A contains the real symmetric matrix. A is a two-dimensional
+C REAL array, dimensioned A(NM,N).
+C
+C MATZ is an INTEGER variable set equal to zero if only
+C eigenvalues are desired. Otherwise, it is set to any
+C non-zero integer for both eigenvalues and eigenvectors.
+C
+C On Output
+C
+C A is unaltered.
+C
+C W contains the eigenvalues in ascending order. W is a one-
+C dimensional REAL array, dimensioned W(N).
+C
+C Z contains the eigenvectors if MATZ is not zero. The
+C eigenvectors are orthonormal. Z is a two-dimensional
+C REAL array, dimensioned Z(NM,N).
+C
+C IERR is an INTEGER flag set to
+C Zero for normal return,
+C 10*N if N is greater than NM,
+C J if the J-th eigenvalue has not been
+C determined after 30 iterations.
+C The eigenvalues, and eigenvectors if requested,
+C should be correct for indices 1, 2, ..., IERR-1.
+C
+C FV1 and FV2 are one-dimensional REAL arrays used for temporary
+C storage, dimensioned FV1(N) and FV2(N).
+C
+C Questions and comments should be directed to B. S. Garbow,
+C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
+C ------------------------------------------------------------------
+C
+C***REFERENCES B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
+C Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
+C system Routines - EISPACK Guide, Springer-Verlag,
+C 1976.
+C***ROUTINES CALLED TQL2, TQLRAT, TRED1, TRED2
+C***REVISION HISTORY (YYMMDD)
+C 760101 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE RS
+C
+ INTEGER N,NM,IERR,MATZ
+ REAL A(NM,*),W(*),Z(NM,*),FV1(*),FV2(*)
+C
+C***FIRST EXECUTABLE STATEMENT RS
+ IF (N .LE. NM) GO TO 10
+ IERR = 10 * N
+ GO TO 50
+C
+ 10 IF (MATZ .NE. 0) GO TO 20
+C .......... FIND EIGENVALUES ONLY ..........
+ CALL TRED1(NM,N,A,W,FV1,FV2)
+ CALL TQLRAT(N,W,FV2,IERR)
+ GO TO 50
+C .......... FIND BOTH EIGENVALUES AND EIGENVECTORS ..........
+ 20 CALL TRED2(NM,N,A,W,FV1,Z)
+ CALL TQL2(NM,N,W,FV1,Z,IERR)
+ 50 RETURN
+ END
diff --git a/Lib/Slatec/slatec/sasum.f b/Lib/Slatec/slatec/sasum.f
new file mode 100644
index 0000000..4699a21
--- /dev/null
+++ b/Lib/Slatec/slatec/sasum.f
@@ -0,0 +1,79 @@
+*DECK SASUM
+ REAL FUNCTION SASUM (N, SX, INCX)
+C***BEGIN PROLOGUE SASUM
+C***PURPOSE Compute the sum of the magnitudes of the elements of a
+C vector.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A3A
+C***TYPE SINGLE PRECISION (SASUM-S, DASUM-D, SCASUM-C)
+C***KEYWORDS BLAS, LINEAR ALGEBRA, SUM OF MAGNITUDES OF A VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(S)
+C SX single precision vector with N elements
+C INCX storage spacing between elements of SX
+C
+C --Output--
+C SASUM single precision result (zero if N .LE. 0)
+C
+C Returns sum of magnitudes of single precision SX.
+C SASUM = sum from 0 to N-1 of ABS(SX(IX+I*INCX)),
+C where IX = 1 if INCX .GE. 0, else IX = 1+(1-N)*INCX.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900821 Modified to correct problem with a negative increment.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SASUM
+ REAL SX(*)
+ INTEGER I, INCX, IX, M, MP1, N
+C***FIRST EXECUTABLE STATEMENT SASUM
+ SASUM = 0.0E0
+ IF (N .LE. 0) RETURN
+C
+ IF (INCX .EQ. 1) GOTO 20
+C
+C Code for increment not equal to 1.
+C
+ IX = 1
+ IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
+ DO 10 I = 1,N
+ SASUM = SASUM + ABS(SX(IX))
+ IX = IX + INCX
+ 10 CONTINUE
+ RETURN
+C
+C Code for increment equal to 1.
+C
+C Clean-up loop so remaining vector length is a multiple of 6.
+C
+ 20 M = MOD(N,6)
+ IF (M .EQ. 0) GOTO 40
+ DO 30 I = 1,M
+ SASUM = SASUM + ABS(SX(I))
+ 30 CONTINUE
+ IF (N .LT. 6) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,6
+ SASUM = SASUM + ABS(SX(I)) + ABS(SX(I+1)) + ABS(SX(I+2)) +
+ 1 ABS(SX(I+3)) + ABS(SX(I+4)) + ABS(SX(I+5))
+ 50 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/saxpy.f b/Lib/Slatec/slatec/saxpy.f
new file mode 100644
index 0000000..d7e7d82
--- /dev/null
+++ b/Lib/Slatec/slatec/saxpy.f
@@ -0,0 +1,92 @@
+*DECK SAXPY
+ SUBROUTINE SAXPY (N, SA, SX, INCX, SY, INCY)
+C***BEGIN PROLOGUE SAXPY
+C***PURPOSE Compute a constant times a vector plus a vector.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A7
+C***TYPE SINGLE PRECISION (SAXPY-S, DAXPY-D, CAXPY-C)
+C***KEYWORDS BLAS, LINEAR ALGEBRA, TRIAD, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C SA single precision scalar multiplier
+C SX single precision vector with N elements
+C INCX storage spacing between elements of SX
+C SY single precision vector with N elements
+C INCY storage spacing between elements of SY
+C
+C --Output--
+C SY single precision result (unchanged if N .LE. 0)
+C
+C Overwrite single precision SY with single precision SA*SX +SY.
+C For I = 0 to N-1, replace SY(LY+I*INCY) with SA*SX(LX+I*INCX) +
+C SY(LY+I*INCY),
+C where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
+C defined in a similar way using INCY.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920310 Corrected definition of LX in DESCRIPTION. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SAXPY
+ REAL SX(*), SY(*), SA
+C***FIRST EXECUTABLE STATEMENT SAXPY
+ IF (N.LE.0 .OR. SA.EQ.0.0E0) RETURN
+ IF (INCX .EQ. INCY) IF (INCX-1) 5,20,60
+C
+C Code for unequal or nonpositive increments.
+C
+ 5 IX = 1
+ IY = 1
+ IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
+ IF (INCY .LT. 0) IY = (-N+1)*INCY + 1
+ DO 10 I = 1,N
+ SY(IY) = SY(IY) + SA*SX(IX)
+ IX = IX + INCX
+ IY = IY + INCY
+ 10 CONTINUE
+ RETURN
+C
+C Code for both increments equal to 1.
+C
+C Clean-up loop so remaining vector length is a multiple of 4.
+C
+ 20 M = MOD(N,4)
+ IF (M .EQ. 0) GO TO 40
+ DO 30 I = 1,M
+ SY(I) = SY(I) + SA*SX(I)
+ 30 CONTINUE
+ IF (N .LT. 4) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,4
+ SY(I) = SY(I) + SA*SX(I)
+ SY(I+1) = SY(I+1) + SA*SX(I+1)
+ SY(I+2) = SY(I+2) + SA*SX(I+2)
+ SY(I+3) = SY(I+3) + SA*SX(I+3)
+ 50 CONTINUE
+ RETURN
+C
+C Code for equal, positive, non-unit increments.
+C
+ 60 NS = N*INCX
+ DO 70 I = 1,NS,INCX
+ SY(I) = SA*SX(I) + SY(I)
+ 70 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/sdot.f b/Lib/Slatec/slatec/sdot.f
new file mode 100644
index 0000000..8c7cde2
--- /dev/null
+++ b/Lib/Slatec/slatec/sdot.f
@@ -0,0 +1,89 @@
+*DECK SDOT
+ REAL FUNCTION SDOT (N, SX, INCX, SY, INCY)
+C***BEGIN PROLOGUE SDOT
+C***PURPOSE Compute the inner product of two vectors.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A4
+C***TYPE SINGLE PRECISION (SDOT-S, DDOT-D, CDOTU-C)
+C***KEYWORDS BLAS, INNER PRODUCT, LINEAR ALGEBRA, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C SX single precision vector with N elements
+C INCX storage spacing between elements of SX
+C SY single precision vector with N elements
+C INCY storage spacing between elements of SY
+C
+C --Output--
+C SDOT single precision dot product (zero if N .LE. 0)
+C
+C Returns the dot product of single precision SX and SY.
+C SDOT = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY),
+C where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
+C defined in a similar way using INCY.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920310 Corrected definition of LX in DESCRIPTION. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SDOT
+ REAL SX(*), SY(*)
+C***FIRST EXECUTABLE STATEMENT SDOT
+ SDOT = 0.0E0
+ IF (N .LE. 0) RETURN
+ IF (INCX .EQ. INCY) IF (INCX-1) 5,20,60
+C
+C Code for unequal or nonpositive increments.
+C
+ 5 IX = 1
+ IY = 1
+ IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
+ IF (INCY .LT. 0) IY = (-N+1)*INCY + 1
+ DO 10 I = 1,N
+ SDOT = SDOT + SX(IX)*SY(IY)
+ IX = IX + INCX
+ IY = IY + INCY
+ 10 CONTINUE
+ RETURN
+C
+C Code for both increments equal to 1.
+C
+C Clean-up loop so remaining vector length is a multiple of 5.
+C
+ 20 M = MOD(N,5)
+ IF (M .EQ. 0) GO TO 40
+ DO 30 I = 1,M
+ SDOT = SDOT + SX(I)*SY(I)
+ 30 CONTINUE
+ IF (N .LT. 5) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,5
+ SDOT = SDOT + SX(I)*SY(I) + SX(I+1)*SY(I+1) + SX(I+2)*SY(I+2) +
+ 1 SX(I+3)*SY(I+3) + SX(I+4)*SY(I+4)
+ 50 CONTINUE
+ RETURN
+C
+C Code for equal, positive, non-unit increments.
+C
+ 60 NS = N*INCX
+ DO 70 I = 1,NS,INCX
+ SDOT = SDOT + SX(I)*SY(I)
+ 70 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/sgeco.f b/Lib/Slatec/slatec/sgeco.f
new file mode 100644
index 0000000..ded72fe
--- /dev/null
+++ b/Lib/Slatec/slatec/sgeco.f
@@ -0,0 +1,207 @@
+*DECK SGECO
+ SUBROUTINE SGECO (A, LDA, N, IPVT, RCOND, Z)
+C***BEGIN PROLOGUE SGECO
+C***PURPOSE Factor a matrix using Gaussian elimination and estimate
+C the condition number of the matrix.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2A1
+C***TYPE SINGLE PRECISION (SGECO-S, DGECO-D, CGECO-C)
+C***KEYWORDS CONDITION NUMBER, GENERAL MATRIX, LINEAR ALGEBRA, LINPACK,
+C MATRIX FACTORIZATION
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C SGECO factors a real matrix by Gaussian elimination
+C and estimates the condition of the matrix.
+C
+C If RCOND is not needed, SGEFA is slightly faster.
+C To solve A*X = B , follow SGECO by SGESL.
+C To compute INVERSE(A)*C , follow SGECO by SGESL.
+C To compute DETERMINANT(A) , follow SGECO by SGEDI.
+C To compute INVERSE(A) , follow SGECO by SGEDI.
+C
+C On Entry
+C
+C A REAL(LDA, N)
+C the matrix to be factored.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C On Return
+C
+C A an upper triangular matrix and the multipliers
+C which were used to obtain it.
+C The factorization can be written A = L*U , where
+C L is a product of permutation and unit lower
+C triangular matrices and U is upper triangular.
+C
+C IPVT INTEGER(N)
+C an integer vector of pivot indices.
+C
+C RCOND REAL
+C an estimate of the reciprocal condition of A .
+C For the system A*X = B , relative perturbations
+C in A and B of size EPSILON may cause
+C relative perturbations in X of size EPSILON/RCOND .
+C If RCOND is so small that the logical expression
+C 1.0 + RCOND .EQ. 1.0
+C is true, then A may be singular to working
+C precision. In particular, RCOND is zero if
+C exact singularity is detected or the estimate
+C underflows.
+C
+C Z REAL(N)
+C a work vector whose contents are usually unimportant.
+C If A is close to a singular matrix, then Z is
+C an approximate null vector in the sense that
+C NORM(A*Z) = RCOND*NORM(A)*NORM(Z) .
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED SASUM, SAXPY, SDOT, SGEFA, SSCAL
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SGECO
+ INTEGER LDA,N,IPVT(*)
+ REAL A(LDA,*),Z(*)
+ REAL RCOND
+C
+ REAL SDOT,EK,T,WK,WKM
+ REAL ANORM,S,SASUM,SM,YNORM
+ INTEGER INFO,J,K,KB,KP1,L
+C
+C COMPUTE 1-NORM OF A
+C
+C***FIRST EXECUTABLE STATEMENT SGECO
+ ANORM = 0.0E0
+ DO 10 J = 1, N
+ ANORM = MAX(ANORM,SASUM(N,A(1,J),1))
+ 10 CONTINUE
+C
+C FACTOR
+C
+ CALL SGEFA(A,LDA,N,IPVT,INFO)
+C
+C RCOND = 1/(NORM(A)*(ESTIMATE OF NORM(INVERSE(A)))) .
+C ESTIMATE = NORM(Z)/NORM(Y) WHERE A*Z = Y AND TRANS(A)*Y = E .
+C TRANS(A) IS THE TRANSPOSE OF A . THE COMPONENTS OF E ARE
+C CHOSEN TO CAUSE MAXIMUM LOCAL GROWTH IN THE ELEMENTS OF W WHERE
+C TRANS(U)*W = E . THE VECTORS ARE FREQUENTLY RESCALED TO AVOID
+C OVERFLOW.
+C
+C SOLVE TRANS(U)*W = E
+C
+ EK = 1.0E0
+ DO 20 J = 1, N
+ Z(J) = 0.0E0
+ 20 CONTINUE
+ DO 100 K = 1, N
+ IF (Z(K) .NE. 0.0E0) EK = SIGN(EK,-Z(K))
+ IF (ABS(EK-Z(K)) .LE. ABS(A(K,K))) GO TO 30
+ S = ABS(A(K,K))/ABS(EK-Z(K))
+ CALL SSCAL(N,S,Z,1)
+ EK = S*EK
+ 30 CONTINUE
+ WK = EK - Z(K)
+ WKM = -EK - Z(K)
+ S = ABS(WK)
+ SM = ABS(WKM)
+ IF (A(K,K) .EQ. 0.0E0) GO TO 40
+ WK = WK/A(K,K)
+ WKM = WKM/A(K,K)
+ GO TO 50
+ 40 CONTINUE
+ WK = 1.0E0
+ WKM = 1.0E0
+ 50 CONTINUE
+ KP1 = K + 1
+ IF (KP1 .GT. N) GO TO 90
+ DO 60 J = KP1, N
+ SM = SM + ABS(Z(J)+WKM*A(K,J))
+ Z(J) = Z(J) + WK*A(K,J)
+ S = S + ABS(Z(J))
+ 60 CONTINUE
+ IF (S .GE. SM) GO TO 80
+ T = WKM - WK
+ WK = WKM
+ DO 70 J = KP1, N
+ Z(J) = Z(J) + T*A(K,J)
+ 70 CONTINUE
+ 80 CONTINUE
+ 90 CONTINUE
+ Z(K) = WK
+ 100 CONTINUE
+ S = 1.0E0/SASUM(N,Z,1)
+ CALL SSCAL(N,S,Z,1)
+C
+C SOLVE TRANS(L)*Y = W
+C
+ DO 120 KB = 1, N
+ K = N + 1 - KB
+ IF (K .LT. N) Z(K) = Z(K) + SDOT(N-K,A(K+1,K),1,Z(K+1),1)
+ IF (ABS(Z(K)) .LE. 1.0E0) GO TO 110
+ S = 1.0E0/ABS(Z(K))
+ CALL SSCAL(N,S,Z,1)
+ 110 CONTINUE
+ L = IPVT(K)
+ T = Z(L)
+ Z(L) = Z(K)
+ Z(K) = T
+ 120 CONTINUE
+ S = 1.0E0/SASUM(N,Z,1)
+ CALL SSCAL(N,S,Z,1)
+C
+ YNORM = 1.0E0
+C
+C SOLVE L*V = Y
+C
+ DO 140 K = 1, N
+ L = IPVT(K)
+ T = Z(L)
+ Z(L) = Z(K)
+ Z(K) = T
+ IF (K .LT. N) CALL SAXPY(N-K,T,A(K+1,K),1,Z(K+1),1)
+ IF (ABS(Z(K)) .LE. 1.0E0) GO TO 130
+ S = 1.0E0/ABS(Z(K))
+ CALL SSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+ 130 CONTINUE
+ 140 CONTINUE
+ S = 1.0E0/SASUM(N,Z,1)
+ CALL SSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+C
+C SOLVE U*Z = V
+C
+ DO 160 KB = 1, N
+ K = N + 1 - KB
+ IF (ABS(Z(K)) .LE. ABS(A(K,K))) GO TO 150
+ S = ABS(A(K,K))/ABS(Z(K))
+ CALL SSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+ 150 CONTINUE
+ IF (A(K,K) .NE. 0.0E0) Z(K) = Z(K)/A(K,K)
+ IF (A(K,K) .EQ. 0.0E0) Z(K) = 1.0E0
+ T = -Z(K)
+ CALL SAXPY(K-1,T,A(1,K),1,Z(1),1)
+ 160 CONTINUE
+C MAKE ZNORM = 1.0
+ S = 1.0E0/SASUM(N,Z,1)
+ CALL SSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+C
+ IF (ANORM .NE. 0.0E0) RCOND = YNORM/ANORM
+ IF (ANORM .EQ. 0.0E0) RCOND = 0.0E0
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/sgedi.f b/Lib/Slatec/slatec/sgedi.f
new file mode 100644
index 0000000..13fd504
--- /dev/null
+++ b/Lib/Slatec/slatec/sgedi.f
@@ -0,0 +1,140 @@
+*DECK SGEDI
+ SUBROUTINE SGEDI (A, LDA, N, IPVT, DET, WORK, JOB)
+C***BEGIN PROLOGUE SGEDI
+C***PURPOSE Compute the determinant and inverse of a matrix using the
+C factors computed by SGECO or SGEFA.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2A1, D3A1
+C***TYPE SINGLE PRECISION (SGEDI-S, DGEDI-D, CGEDI-C)
+C***KEYWORDS DETERMINANT, INVERSE, LINEAR ALGEBRA, LINPACK, MATRIX
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C SGEDI computes the determinant and inverse of a matrix
+C using the factors computed by SGECO or SGEFA.
+C
+C On Entry
+C
+C A REAL(LDA, N)
+C the output from SGECO or SGEFA.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C IPVT INTEGER(N)
+C the pivot vector from SGECO or SGEFA.
+C
+C WORK REAL(N)
+C work vector. Contents destroyed.
+C
+C JOB INTEGER
+C = 11 both determinant and inverse.
+C = 01 inverse only.
+C = 10 determinant only.
+C
+C On Return
+C
+C A inverse of original matrix if requested.
+C Otherwise unchanged.
+C
+C DET REAL(2)
+C determinant of original matrix if requested.
+C Otherwise not referenced.
+C Determinant = DET(1) * 10.0**DET(2)
+C with 1.0 .LE. ABS(DET(1)) .LT. 10.0
+C or DET(1) .EQ. 0.0 .
+C
+C Error Condition
+C
+C A division by zero will occur if the input factor contains
+C a zero on the diagonal and the inverse is requested.
+C It will not occur if the subroutines are called correctly
+C and if SGECO has set RCOND .GT. 0.0 or SGEFA has set
+C INFO .EQ. 0 .
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED SAXPY, SSCAL, SSWAP
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SGEDI
+ INTEGER LDA,N,IPVT(*),JOB
+ REAL A(LDA,*),DET(2),WORK(*)
+C
+ REAL T
+ REAL TEN
+ INTEGER I,J,K,KB,KP1,L,NM1
+C***FIRST EXECUTABLE STATEMENT SGEDI
+C
+C COMPUTE DETERMINANT
+C
+ IF (JOB/10 .EQ. 0) GO TO 70
+ DET(1) = 1.0E0
+ DET(2) = 0.0E0
+ TEN = 10.0E0
+ DO 50 I = 1, N
+ IF (IPVT(I) .NE. I) DET(1) = -DET(1)
+ DET(1) = A(I,I)*DET(1)
+ IF (DET(1) .EQ. 0.0E0) GO TO 60
+ 10 IF (ABS(DET(1)) .GE. 1.0E0) GO TO 20
+ DET(1) = TEN*DET(1)
+ DET(2) = DET(2) - 1.0E0
+ GO TO 10
+ 20 CONTINUE
+ 30 IF (ABS(DET(1)) .LT. TEN) GO TO 40
+ DET(1) = DET(1)/TEN
+ DET(2) = DET(2) + 1.0E0
+ GO TO 30
+ 40 CONTINUE
+ 50 CONTINUE
+ 60 CONTINUE
+ 70 CONTINUE
+C
+C COMPUTE INVERSE(U)
+C
+ IF (MOD(JOB,10) .EQ. 0) GO TO 150
+ DO 100 K = 1, N
+ A(K,K) = 1.0E0/A(K,K)
+ T = -A(K,K)
+ CALL SSCAL(K-1,T,A(1,K),1)
+ KP1 = K + 1
+ IF (N .LT. KP1) GO TO 90
+ DO 80 J = KP1, N
+ T = A(K,J)
+ A(K,J) = 0.0E0
+ CALL SAXPY(K,T,A(1,K),1,A(1,J),1)
+ 80 CONTINUE
+ 90 CONTINUE
+ 100 CONTINUE
+C
+C FORM INVERSE(U)*INVERSE(L)
+C
+ NM1 = N - 1
+ IF (NM1 .LT. 1) GO TO 140
+ DO 130 KB = 1, NM1
+ K = N - KB
+ KP1 = K + 1
+ DO 110 I = KP1, N
+ WORK(I) = A(I,K)
+ A(I,K) = 0.0E0
+ 110 CONTINUE
+ DO 120 J = KP1, N
+ T = WORK(J)
+ CALL SAXPY(N,T,A(1,J),1,A(1,K),1)
+ 120 CONTINUE
+ L = IPVT(K)
+ IF (L .NE. K) CALL SSWAP(N,A(1,K),1,A(1,L),1)
+ 130 CONTINUE
+ 140 CONTINUE
+ 150 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/sgefa.f b/Lib/Slatec/slatec/sgefa.f
new file mode 100644
index 0000000..c4d3a0f
--- /dev/null
+++ b/Lib/Slatec/slatec/sgefa.f
@@ -0,0 +1,117 @@
+*DECK SGEFA
+ SUBROUTINE SGEFA (A, LDA, N, IPVT, INFO)
+C***BEGIN PROLOGUE SGEFA
+C***PURPOSE Factor a matrix using Gaussian elimination.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2A1
+C***TYPE SINGLE PRECISION (SGEFA-S, DGEFA-D, CGEFA-C)
+C***KEYWORDS GENERAL MATRIX, LINEAR ALGEBRA, LINPACK,
+C MATRIX FACTORIZATION
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C SGEFA factors a real matrix by Gaussian elimination.
+C
+C SGEFA is usually called by SGECO, but it can be called
+C directly with a saving in time if RCOND is not needed.
+C (Time for SGECO) = (1 + 9/N)*(Time for SGEFA) .
+C
+C On Entry
+C
+C A REAL(LDA, N)
+C the matrix to be factored.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C On Return
+C
+C A an upper triangular matrix and the multipliers
+C which were used to obtain it.
+C The factorization can be written A = L*U , where
+C L is a product of permutation and unit lower
+C triangular matrices and U is upper triangular.
+C
+C IPVT INTEGER(N)
+C an integer vector of pivot indices.
+C
+C INFO INTEGER
+C = 0 normal value.
+C = K if U(K,K) .EQ. 0.0 . This is not an error
+C condition for this subroutine, but it does
+C indicate that SGESL or SGEDI will divide by zero
+C if called. Use RCOND in SGECO for a reliable
+C indication of singularity.
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED ISAMAX, SAXPY, SSCAL
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SGEFA
+ INTEGER LDA,N,IPVT(*),INFO
+ REAL A(LDA,*)
+C
+ REAL T
+ INTEGER ISAMAX,J,K,KP1,L,NM1
+C
+C GAUSSIAN ELIMINATION WITH PARTIAL PIVOTING
+C
+C***FIRST EXECUTABLE STATEMENT SGEFA
+ INFO = 0
+ NM1 = N - 1
+ IF (NM1 .LT. 1) GO TO 70
+ DO 60 K = 1, NM1
+ KP1 = K + 1
+C
+C FIND L = PIVOT INDEX
+C
+ L = ISAMAX(N-K+1,A(K,K),1) + K - 1
+ IPVT(K) = L
+C
+C ZERO PIVOT IMPLIES THIS COLUMN ALREADY TRIANGULARIZED
+C
+ IF (A(L,K) .EQ. 0.0E0) GO TO 40
+C
+C INTERCHANGE IF NECESSARY
+C
+ IF (L .EQ. K) GO TO 10
+ T = A(L,K)
+ A(L,K) = A(K,K)
+ A(K,K) = T
+ 10 CONTINUE
+C
+C COMPUTE MULTIPLIERS
+C
+ T = -1.0E0/A(K,K)
+ CALL SSCAL(N-K,T,A(K+1,K),1)
+C
+C ROW ELIMINATION WITH COLUMN INDEXING
+C
+ DO 30 J = KP1, N
+ T = A(L,J)
+ IF (L .EQ. K) GO TO 20
+ A(L,J) = A(K,J)
+ A(K,J) = T
+ 20 CONTINUE
+ CALL SAXPY(N-K,T,A(K+1,K),1,A(K+1,J),1)
+ 30 CONTINUE
+ GO TO 50
+ 40 CONTINUE
+ INFO = K
+ 50 CONTINUE
+ 60 CONTINUE
+ 70 CONTINUE
+ IPVT(N) = N
+ IF (A(N,N) .EQ. 0.0E0) INFO = N
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/sgesl.f b/Lib/Slatec/slatec/sgesl.f
new file mode 100644
index 0000000..b7009b7
--- /dev/null
+++ b/Lib/Slatec/slatec/sgesl.f
@@ -0,0 +1,137 @@
+
+* ======================================================================
+* NIST Guide to Available Math Software.
+* Source for module SGESL from package SLATEC.
+* Retrieved from CAMSUN on Sat Sep 25 04:54:59 1999.
+* ======================================================================
+*DECK SGESL
+ SUBROUTINE SGESL (A, LDA, N, IPVT, B, JOB)
+C***BEGIN PROLOGUE SGESL
+C***PURPOSE Solve the real system A*X=B or TRANS(A)*X=B using the
+C factors of SGECO or SGEFA.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2A1
+C***TYPE SINGLE PRECISION (SGESL-S, DGESL-D, CGESL-C)
+C***KEYWORDS LINEAR ALGEBRA, LINPACK, MATRIX, SOLVE
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C SGESL solves the real system
+C A * X = B or TRANS(A) * X = B
+C using the factors computed by SGECO or SGEFA.
+C
+C On Entry
+C
+C A REAL(LDA, N)
+C the output from SGECO or SGEFA.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C IPVT INTEGER(N)
+C the pivot vector from SGECO or SGEFA.
+C
+C B REAL(N)
+C the right hand side vector.
+C
+C JOB INTEGER
+C = 0 to solve A*X = B ,
+C = nonzero to solve TRANS(A)*X = B where
+C TRANS(A) is the transpose.
+C
+C On Return
+C
+C B the solution vector X .
+C
+C Error Condition
+C
+C A division by zero will occur if the input factor contains a
+C zero on the diagonal. Technically, this indicates singularity,
+C but it is often caused by improper arguments or improper
+C setting of LDA . It will not occur if the subroutines are
+C called correctly and if SGECO has set RCOND .GT. 0.0
+C or SGEFA has set INFO .EQ. 0 .
+C
+C To compute INVERSE(A) * C where C is a matrix
+C with P columns
+C CALL SGECO(A,LDA,N,IPVT,RCOND,Z)
+C IF (RCOND is too small) GO TO ...
+C DO 10 J = 1, P
+C CALL SGESL(A,LDA,N,IPVT,C(1,J),0)
+C 10 CONTINUE
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED SAXPY, SDOT
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SGESL
+ INTEGER LDA,N,IPVT(*),JOB
+ REAL A(LDA,*),B(*)
+C
+ REAL SDOT,T
+ INTEGER K,KB,L,NM1
+C***FIRST EXECUTABLE STATEMENT SGESL
+ NM1 = N - 1
+ IF (JOB .NE. 0) GO TO 50
+C
+C JOB = 0 , SOLVE A * X = B
+C FIRST SOLVE L*Y = B
+C
+ IF (NM1 .LT. 1) GO TO 30
+ DO 20 K = 1, NM1
+ L = IPVT(K)
+ T = B(L)
+ IF (L .EQ. K) GO TO 10
+ B(L) = B(K)
+ B(K) = T
+ 10 CONTINUE
+ CALL SAXPY(N-K,T,A(K+1,K),1,B(K+1),1)
+ 20 CONTINUE
+ 30 CONTINUE
+C
+C NOW SOLVE U*X = Y
+C
+ DO 40 KB = 1, N
+ K = N + 1 - KB
+ B(K) = B(K)/A(K,K)
+ T = -B(K)
+ CALL SAXPY(K-1,T,A(1,K),1,B(1),1)
+ 40 CONTINUE
+ GO TO 100
+ 50 CONTINUE
+C
+C JOB = NONZERO, SOLVE TRANS(A) * X = B
+C FIRST SOLVE TRANS(U)*Y = B
+C
+ DO 60 K = 1, N
+ T = SDOT(K-1,A(1,K),1,B(1),1)
+ B(K) = (B(K) - T)/A(K,K)
+ 60 CONTINUE
+C
+C NOW SOLVE TRANS(L)*X = Y
+C
+ IF (NM1 .LT. 1) GO TO 90
+ DO 80 KB = 1, NM1
+ K = N - KB
+ B(K) = B(K) + SDOT(N-K,A(K+1,K),1,B(K+1),1)
+ L = IPVT(K)
+ IF (L .EQ. K) GO TO 70
+ T = B(L)
+ B(L) = B(K)
+ B(K) = T
+ 70 CONTINUE
+ 80 CONTINUE
+ 90 CONTINUE
+ 100 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/snrm2.f b/Lib/Slatec/slatec/snrm2.f
new file mode 100644
index 0000000..c8b0b0a
--- /dev/null
+++ b/Lib/Slatec/slatec/snrm2.f
@@ -0,0 +1,161 @@
+*DECK SNRM2
+ REAL FUNCTION SNRM2 (N, SX, INCX)
+C***BEGIN PROLOGUE SNRM2
+C***PURPOSE Compute the Euclidean length (L2 norm) of a vector.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A3B
+C***TYPE SINGLE PRECISION (SNRM2-S, DNRM2-D, SCNRM2-C)
+C***KEYWORDS BLAS, EUCLIDEAN LENGTH, EUCLIDEAN NORM, L2,
+C LINEAR ALGEBRA, UNITARY, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C SX single precision vector with N elements
+C INCX storage spacing between elements of SX
+C
+C --Output--
+C SNRM2 single precision result (zero if N .LE. 0)
+C
+C Euclidean norm of the N-vector stored in SX with storage
+C increment INCX .
+C If N .LE. 0, return with result = 0.
+C If N .GE. 1, then INCX must be .GE. 1
+C
+C Four Phase Method using two built-in constants that are
+C hopefully applicable to all machines.
+C CUTLO = maximum of SQRT(U/EPS) over all known machines.
+C CUTHI = minimum of SQRT(V) over all known machines.
+C where
+C EPS = smallest no. such that EPS + 1. .GT. 1.
+C U = smallest positive no. (underflow limit)
+C V = largest no. (overflow limit)
+C
+C Brief Outline of Algorithm.
+C
+C Phase 1 scans zero components.
+C Move to phase 2 when a component is nonzero and .LE. CUTLO
+C Move to phase 3 when a component is .GT. CUTLO
+C Move to phase 4 when a component is .GE. CUTHI/M
+C where M = N for X() real and M = 2*N for complex.
+C
+C Values for CUTLO and CUTHI.
+C From the environmental parameters listed in the IMSL converter
+C document the limiting values are as follows:
+C CUTLO, S.P. U/EPS = 2**(-102) for Honeywell. Close seconds are
+C Univac and DEC at 2**(-103)
+C Thus CUTLO = 2**(-51) = 4.44089E-16
+C CUTHI, S.P. V = 2**127 for Univac, Honeywell, and DEC.
+C Thus CUTHI = 2**(63.5) = 1.30438E19
+C CUTLO, D.P. U/EPS = 2**(-67) for Honeywell and DEC.
+C Thus CUTLO = 2**(-33.5) = 8.23181D-11
+C CUTHI, D.P. same as S.P. CUTHI = 1.30438D19
+C DATA CUTLO, CUTHI /8.232D-11, 1.304D19/
+C DATA CUTLO, CUTHI /4.441E-16, 1.304E19/
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SNRM2
+ INTEGER NEXT
+ REAL SX(*), CUTLO, CUTHI, HITEST, SUM, XMAX, ZERO, ONE
+ SAVE CUTLO, CUTHI, ZERO, ONE
+ DATA ZERO, ONE /0.0E0, 1.0E0/
+C
+ DATA CUTLO, CUTHI /4.441E-16, 1.304E19/
+C***FIRST EXECUTABLE STATEMENT SNRM2
+ IF (N .GT. 0) GO TO 10
+ SNRM2 = ZERO
+ GO TO 300
+C
+ 10 ASSIGN 30 TO NEXT
+ SUM = ZERO
+ NN = N * INCX
+C
+C BEGIN MAIN LOOP
+C
+ I = 1
+ 20 GO TO NEXT,(30, 50, 70, 110)
+ 30 IF (ABS(SX(I)) .GT. CUTLO) GO TO 85
+ ASSIGN 50 TO NEXT
+ XMAX = ZERO
+C
+C PHASE 1. SUM IS ZERO
+C
+ 50 IF (SX(I) .EQ. ZERO) GO TO 200
+ IF (ABS(SX(I)) .GT. CUTLO) GO TO 85
+C
+C PREPARE FOR PHASE 2.
+C
+ ASSIGN 70 TO NEXT
+ GO TO 105
+C
+C PREPARE FOR PHASE 4.
+C
+ 100 I = J
+ ASSIGN 110 TO NEXT
+ SUM = (SUM / SX(I)) / SX(I)
+ 105 XMAX = ABS(SX(I))
+ GO TO 115
+C
+C PHASE 2. SUM IS SMALL.
+C SCALE TO AVOID DESTRUCTIVE UNDERFLOW.
+C
+ 70 IF (ABS(SX(I)) .GT. CUTLO) GO TO 75
+C
+C COMMON CODE FOR PHASES 2 AND 4.
+C IN PHASE 4 SUM IS LARGE. SCALE TO AVOID OVERFLOW.
+C
+ 110 IF (ABS(SX(I)) .LE. XMAX) GO TO 115
+ SUM = ONE + SUM * (XMAX / SX(I))**2
+ XMAX = ABS(SX(I))
+ GO TO 200
+C
+ 115 SUM = SUM + (SX(I)/XMAX)**2
+ GO TO 200
+C
+C PREPARE FOR PHASE 3.
+C
+ 75 SUM = (SUM * XMAX) * XMAX
+C
+C FOR REAL OR D.P. SET HITEST = CUTHI/N
+C FOR COMPLEX SET HITEST = CUTHI/(2*N)
+C
+ 85 HITEST = CUTHI / N
+C
+C PHASE 3. SUM IS MID-RANGE. NO SCALING.
+C
+ DO 95 J = I,NN,INCX
+ IF (ABS(SX(J)) .GE. HITEST) GO TO 100
+ 95 SUM = SUM + SX(J)**2
+ SNRM2 = SQRT( SUM )
+ GO TO 300
+C
+ 200 CONTINUE
+ I = I + INCX
+ IF (I .LE. NN) GO TO 20
+C
+C END OF MAIN LOOP.
+C
+C COMPUTE SQUARE ROOT AND ADJUST FOR SCALING.
+C
+ SNRM2 = XMAX * SQRT(SUM)
+ 300 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/spoco.f b/Lib/Slatec/slatec/spoco.f
new file mode 100644
index 0000000..000b076
--- /dev/null
+++ b/Lib/Slatec/slatec/spoco.f
@@ -0,0 +1,208 @@
+*DECK SPOCO
+ SUBROUTINE SPOCO (A, LDA, N, RCOND, Z, INFO)
+C***BEGIN PROLOGUE SPOCO
+C***PURPOSE Factor a real symmetric positive definite matrix
+C and estimate the condition number of the matrix.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2B1B
+C***TYPE SINGLE PRECISION (SPOCO-S, DPOCO-D, CPOCO-C)
+C***KEYWORDS CONDITION NUMBER, LINEAR ALGEBRA, LINPACK,
+C MATRIX FACTORIZATION, POSITIVE DEFINITE
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C SPOCO factors a real symmetric positive definite matrix
+C and estimates the condition of the matrix.
+C
+C If RCOND is not needed, SPOFA is slightly faster.
+C To solve A*X = B , follow SPOCO by SPOSL.
+C To compute INVERSE(A)*C , follow SPOCO by SPOSL.
+C To compute DETERMINANT(A) , follow SPOCO by SPODI.
+C To compute INVERSE(A) , follow SPOCO by SPODI.
+C
+C On Entry
+C
+C A REAL(LDA, N)
+C the symmetric matrix to be factored. Only the
+C diagonal and upper triangle are used.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C On Return
+C
+C A an upper triangular matrix R so that A = TRANS(R)*R
+C where TRANS(R) is the transpose.
+C The strict lower triangle is unaltered.
+C If INFO .NE. 0 , the factorization is not complete.
+C
+C RCOND REAL
+C an estimate of the reciprocal condition of A .
+C For the system A*X = B , relative perturbations
+C in A and B of size EPSILON may cause
+C relative perturbations in X of size EPSILON/RCOND .
+C If RCOND is so small that the logical expression
+C 1.0 + RCOND .EQ. 1.0
+C is true, then A may be singular to working
+C precision. In particular, RCOND is zero if
+C exact singularity is detected or the estimate
+C underflows. If INFO .NE. 0 , RCOND is unchanged.
+C
+C Z REAL(N)
+C a work vector whose contents are usually unimportant.
+C If A is close to a singular matrix, then Z is
+C an approximate null vector in the sense that
+C NORM(A*Z) = RCOND*NORM(A)*NORM(Z) .
+C If INFO .NE. 0 , Z is unchanged.
+C
+C INFO INTEGER
+C = 0 for normal return.
+C = K signals an error condition. The leading minor
+C of order K is not positive definite.
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED SASUM, SAXPY, SDOT, SPOFA, SSCAL
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SPOCO
+ INTEGER LDA,N,INFO
+ REAL A(LDA,*),Z(*)
+ REAL RCOND
+C
+ REAL SDOT,EK,T,WK,WKM
+ REAL ANORM,S,SASUM,SM,YNORM
+ INTEGER I,J,JM1,K,KB,KP1
+C
+C FIND NORM OF A USING ONLY UPPER HALF
+C
+C***FIRST EXECUTABLE STATEMENT SPOCO
+ DO 30 J = 1, N
+ Z(J) = SASUM(J,A(1,J),1)
+ JM1 = J - 1
+ IF (JM1 .LT. 1) GO TO 20
+ DO 10 I = 1, JM1
+ Z(I) = Z(I) + ABS(A(I,J))
+ 10 CONTINUE
+ 20 CONTINUE
+ 30 CONTINUE
+ ANORM = 0.0E0
+ DO 40 J = 1, N
+ ANORM = MAX(ANORM,Z(J))
+ 40 CONTINUE
+C
+C FACTOR
+C
+ CALL SPOFA(A,LDA,N,INFO)
+ IF (INFO .NE. 0) GO TO 180
+C
+C RCOND = 1/(NORM(A)*(ESTIMATE OF NORM(INVERSE(A)))) .
+C ESTIMATE = NORM(Z)/NORM(Y) WHERE A*Z = Y AND A*Y = E .
+C THE COMPONENTS OF E ARE CHOSEN TO CAUSE MAXIMUM LOCAL
+C GROWTH IN THE ELEMENTS OF W WHERE TRANS(R)*W = E .
+C THE VECTORS ARE FREQUENTLY RESCALED TO AVOID OVERFLOW.
+C
+C SOLVE TRANS(R)*W = E
+C
+ EK = 1.0E0
+ DO 50 J = 1, N
+ Z(J) = 0.0E0
+ 50 CONTINUE
+ DO 110 K = 1, N
+ IF (Z(K) .NE. 0.0E0) EK = SIGN(EK,-Z(K))
+ IF (ABS(EK-Z(K)) .LE. A(K,K)) GO TO 60
+ S = A(K,K)/ABS(EK-Z(K))
+ CALL SSCAL(N,S,Z,1)
+ EK = S*EK
+ 60 CONTINUE
+ WK = EK - Z(K)
+ WKM = -EK - Z(K)
+ S = ABS(WK)
+ SM = ABS(WKM)
+ WK = WK/A(K,K)
+ WKM = WKM/A(K,K)
+ KP1 = K + 1
+ IF (KP1 .GT. N) GO TO 100
+ DO 70 J = KP1, N
+ SM = SM + ABS(Z(J)+WKM*A(K,J))
+ Z(J) = Z(J) + WK*A(K,J)
+ S = S + ABS(Z(J))
+ 70 CONTINUE
+ IF (S .GE. SM) GO TO 90
+ T = WKM - WK
+ WK = WKM
+ DO 80 J = KP1, N
+ Z(J) = Z(J) + T*A(K,J)
+ 80 CONTINUE
+ 90 CONTINUE
+ 100 CONTINUE
+ Z(K) = WK
+ 110 CONTINUE
+ S = 1.0E0/SASUM(N,Z,1)
+ CALL SSCAL(N,S,Z,1)
+C
+C SOLVE R*Y = W
+C
+ DO 130 KB = 1, N
+ K = N + 1 - KB
+ IF (ABS(Z(K)) .LE. A(K,K)) GO TO 120
+ S = A(K,K)/ABS(Z(K))
+ CALL SSCAL(N,S,Z,1)
+ 120 CONTINUE
+ Z(K) = Z(K)/A(K,K)
+ T = -Z(K)
+ CALL SAXPY(K-1,T,A(1,K),1,Z(1),1)
+ 130 CONTINUE
+ S = 1.0E0/SASUM(N,Z,1)
+ CALL SSCAL(N,S,Z,1)
+C
+ YNORM = 1.0E0
+C
+C SOLVE TRANS(R)*V = Y
+C
+ DO 150 K = 1, N
+ Z(K) = Z(K) - SDOT(K-1,A(1,K),1,Z(1),1)
+ IF (ABS(Z(K)) .LE. A(K,K)) GO TO 140
+ S = A(K,K)/ABS(Z(K))
+ CALL SSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+ 140 CONTINUE
+ Z(K) = Z(K)/A(K,K)
+ 150 CONTINUE
+ S = 1.0E0/SASUM(N,Z,1)
+ CALL SSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+C
+C SOLVE R*Z = V
+C
+ DO 170 KB = 1, N
+ K = N + 1 - KB
+ IF (ABS(Z(K)) .LE. A(K,K)) GO TO 160
+ S = A(K,K)/ABS(Z(K))
+ CALL SSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+ 160 CONTINUE
+ Z(K) = Z(K)/A(K,K)
+ T = -Z(K)
+ CALL SAXPY(K-1,T,A(1,K),1,Z(1),1)
+ 170 CONTINUE
+C MAKE ZNORM = 1.0
+ S = 1.0E0/SASUM(N,Z,1)
+ CALL SSCAL(N,S,Z,1)
+ YNORM = S*YNORM
+C
+ IF (ANORM .NE. 0.0E0) RCOND = YNORM/ANORM
+ IF (ANORM .EQ. 0.0E0) RCOND = 0.0E0
+ 180 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/spodi.f b/Lib/Slatec/slatec/spodi.f
new file mode 100644
index 0000000..0b5a8e5
--- /dev/null
+++ b/Lib/Slatec/slatec/spodi.f
@@ -0,0 +1,136 @@
+*DECK SPODI
+ SUBROUTINE SPODI (A, LDA, N, DET, JOB)
+C***BEGIN PROLOGUE SPODI
+C***PURPOSE Compute the determinant and inverse of a certain real
+C symmetric positive definite matrix using the factors
+C computed by SPOCO, SPOFA or SQRDC.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2B1B, D3B1B
+C***TYPE SINGLE PRECISION (SPODI-S, DPODI-D, CPODI-C)
+C***KEYWORDS DETERMINANT, INVERSE, LINEAR ALGEBRA, LINPACK, MATRIX,
+C POSITIVE DEFINITE
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C SPODI computes the determinant and inverse of a certain
+C real symmetric positive definite matrix (see below)
+C using the factors computed by SPOCO, SPOFA or SQRDC.
+C
+C On Entry
+C
+C A REAL(LDA, N)
+C the output A from SPOCO or SPOFA
+C or the output X from SQRDC.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C JOB INTEGER
+C = 11 both determinant and inverse.
+C = 01 inverse only.
+C = 10 determinant only.
+C
+C On Return
+C
+C A If SPOCO or SPOFA was used to factor A , then
+C SPODI produces the upper half of INVERSE(A) .
+C If SQRDC was used to decompose X , then
+C SPODI produces the upper half of INVERSE(TRANS(X)*X),
+C where TRANS(X) is the transpose.
+C Elements of A below the diagonal are unchanged.
+C If the units digit of JOB is zero, A is unchanged.
+C
+C DET REAL(2)
+C determinant of A or of TRANS(X)*X if requested.
+C Otherwise not referenced.
+C Determinant = DET(1) * 10.0**DET(2)
+C with 1.0 .LE. DET(1) .LT. 10.0
+C or DET(1) .EQ. 0.0 .
+C
+C Error Condition
+C
+C A division by zero will occur if the input factor contains
+C a zero on the diagonal and the inverse is requested.
+C It will not occur if the subroutines are called correctly
+C and if SPOCO or SPOFA has set INFO .EQ. 0 .
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED SAXPY, SSCAL
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SPODI
+ INTEGER LDA,N,JOB
+ REAL A(LDA,*)
+ REAL DET(2)
+C
+ REAL T
+ REAL S
+ INTEGER I,J,JM1,K,KP1
+C***FIRST EXECUTABLE STATEMENT SPODI
+C
+C COMPUTE DETERMINANT
+C
+ IF (JOB/10 .EQ. 0) GO TO 70
+ DET(1) = 1.0E0
+ DET(2) = 0.0E0
+ S = 10.0E0
+ DO 50 I = 1, N
+ DET(1) = A(I,I)**2*DET(1)
+ IF (DET(1) .EQ. 0.0E0) GO TO 60
+ 10 IF (DET(1) .GE. 1.0E0) GO TO 20
+ DET(1) = S*DET(1)
+ DET(2) = DET(2) - 1.0E0
+ GO TO 10
+ 20 CONTINUE
+ 30 IF (DET(1) .LT. S) GO TO 40
+ DET(1) = DET(1)/S
+ DET(2) = DET(2) + 1.0E0
+ GO TO 30
+ 40 CONTINUE
+ 50 CONTINUE
+ 60 CONTINUE
+ 70 CONTINUE
+C
+C COMPUTE INVERSE(R)
+C
+ IF (MOD(JOB,10) .EQ. 0) GO TO 140
+ DO 100 K = 1, N
+ A(K,K) = 1.0E0/A(K,K)
+ T = -A(K,K)
+ CALL SSCAL(K-1,T,A(1,K),1)
+ KP1 = K + 1
+ IF (N .LT. KP1) GO TO 90
+ DO 80 J = KP1, N
+ T = A(K,J)
+ A(K,J) = 0.0E0
+ CALL SAXPY(K,T,A(1,K),1,A(1,J),1)
+ 80 CONTINUE
+ 90 CONTINUE
+ 100 CONTINUE
+C
+C FORM INVERSE(R) * TRANS(INVERSE(R))
+C
+ DO 130 J = 1, N
+ JM1 = J - 1
+ IF (JM1 .LT. 1) GO TO 120
+ DO 110 K = 1, JM1
+ T = A(K,J)
+ CALL SAXPY(K,T,A(1,J),1,A(1,K),1)
+ 110 CONTINUE
+ 120 CONTINUE
+ T = A(J,J)
+ CALL SSCAL(J,T,A(1,J),1)
+ 130 CONTINUE
+ 140 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/spofa.f b/Lib/Slatec/slatec/spofa.f
new file mode 100644
index 0000000..aed2313
--- /dev/null
+++ b/Lib/Slatec/slatec/spofa.f
@@ -0,0 +1,81 @@
+*DECK SPOFA
+ SUBROUTINE SPOFA (A, LDA, N, INFO)
+C***BEGIN PROLOGUE SPOFA
+C***PURPOSE Factor a real symmetric positive definite matrix.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D2B1B
+C***TYPE SINGLE PRECISION (SPOFA-S, DPOFA-D, CPOFA-C)
+C***KEYWORDS LINEAR ALGEBRA, LINPACK, MATRIX FACTORIZATION,
+C POSITIVE DEFINITE
+C***AUTHOR Moler, C. B., (U. of New Mexico)
+C***DESCRIPTION
+C
+C SPOFA factors a real symmetric positive definite matrix.
+C
+C SPOFA is usually called by SPOCO, but it can be called
+C directly with a saving in time if RCOND is not needed.
+C (Time for SPOCO) = (1 + 18/N)*(Time for SPOFA) .
+C
+C On Entry
+C
+C A REAL(LDA, N)
+C the symmetric matrix to be factored. Only the
+C diagonal and upper triangle are used.
+C
+C LDA INTEGER
+C the leading dimension of the array A .
+C
+C N INTEGER
+C the order of the matrix A .
+C
+C On Return
+C
+C A an upper triangular matrix R so that A = TRANS(R)*R
+C where TRANS(R) is the transpose.
+C The strict lower triangle is unaltered.
+C If INFO .NE. 0 , the factorization is not complete.
+C
+C INFO INTEGER
+C = 0 for normal return.
+C = K signals an error condition. The leading minor
+C of order K is not positive definite.
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED SDOT
+C***REVISION HISTORY (YYMMDD)
+C 780814 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SPOFA
+ INTEGER LDA,N,INFO
+ REAL A(LDA,*)
+C
+ REAL SDOT,T
+ REAL S
+ INTEGER J,JM1,K
+C***FIRST EXECUTABLE STATEMENT SPOFA
+ DO 30 J = 1, N
+ INFO = J
+ S = 0.0E0
+ JM1 = J - 1
+ IF (JM1 .LT. 1) GO TO 20
+ DO 10 K = 1, JM1
+ T = A(K,J) - SDOT(K-1,A(1,K),1,A(1,J),1)
+ T = T/A(K,K)
+ A(K,J) = T
+ S = S + T*T
+ 10 CONTINUE
+ 20 CONTINUE
+ S = A(J,J) - S
+ IF (S .LE. 0.0E0) GO TO 40
+ A(J,J) = SQRT(S)
+ 30 CONTINUE
+ INFO = 0
+ 40 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/srot.f b/Lib/Slatec/slatec/srot.f
new file mode 100644
index 0000000..184889c
--- /dev/null
+++ b/Lib/Slatec/slatec/srot.f
@@ -0,0 +1,89 @@
+*DECK SROT
+ SUBROUTINE SROT (N, SX, INCX, SY, INCY, SC, SS)
+C***BEGIN PROLOGUE SROT
+C***PURPOSE Apply a plane Givens rotation.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A8
+C***TYPE SINGLE PRECISION (SROT-S, DROT-D, CSROT-C)
+C***KEYWORDS BLAS, GIVENS ROTATION, GIVENS TRANSFORMATION,
+C LINEAR ALGEBRA, PLANE ROTATION, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C SX single precision vector with N elements
+C INCX storage spacing between elements of SX
+C SY single precision vector with N elements
+C INCY storage spacing between elements of SY
+C SC element of rotation matrix
+C SS element of rotation matrix
+C
+C --Output--
+C SX rotated vector SX (unchanged if N .LE. 0)
+C SY rotated vector SY (unchanged if N .LE. 0)
+C
+C Multiply the 2 x 2 matrix ( SC SS) times the 2 x N matrix (SX**T)
+C (-SS SC) (SY**T)
+C where **T indicates transpose. The elements of SX are in
+C SX(LX+I*INCX), I = 0 to N-1, where LX = 1 if INCX .GE. 0, else
+C LX = 1+(1-N)*INCX, and similarly for SY using LY and INCY.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 861211 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920310 Corrected definition of LX in DESCRIPTION. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SROT
+ REAL SX, SY, SC, SS, ZERO, ONE, W, Z
+ DIMENSION SX(*), SY(*)
+ SAVE ZERO, ONE
+ DATA ZERO, ONE /0.0E0, 1.0E0/
+C***FIRST EXECUTABLE STATEMENT SROT
+ IF (N .LE. 0 .OR. (SS .EQ. ZERO .AND. SC .EQ. ONE)) GO TO 40
+ IF (.NOT. (INCX .EQ. INCY .AND. INCX .GT. 0)) GO TO 20
+C
+C Code for equal and positive increments.
+C
+ NSTEPS=INCX*N
+ DO 10 I = 1,NSTEPS,INCX
+ W=SX(I)
+ Z=SY(I)
+ SX(I)=SC*W+SS*Z
+ SY(I)=-SS*W+SC*Z
+ 10 CONTINUE
+ GO TO 40
+C
+C Code for unequal or nonpositive increments.
+C
+ 20 CONTINUE
+ KX=1
+ KY=1
+C
+ IF (INCX .LT. 0) KX = 1-(N-1)*INCX
+ IF (INCY .LT. 0) KY = 1-(N-1)*INCY
+C
+ DO 30 I = 1,N
+ W=SX(KX)
+ Z=SY(KY)
+ SX(KX)=SC*W+SS*Z
+ SY(KY)=-SS*W+SC*Z
+ KX=KX+INCX
+ KY=KY+INCY
+ 30 CONTINUE
+ 40 CONTINUE
+C
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/srotg.f b/Lib/Slatec/slatec/srotg.f
new file mode 100644
index 0000000..3dc4d9d
--- /dev/null
+++ b/Lib/Slatec/slatec/srotg.f
@@ -0,0 +1,106 @@
+*DECK SROTG
+ SUBROUTINE SROTG (SA, SB, SC, SS)
+C***BEGIN PROLOGUE SROTG
+C***PURPOSE Construct a plane Givens rotation.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1B10
+C***TYPE SINGLE PRECISION (SROTG-S, DROTG-D, CROTG-C)
+C***KEYWORDS BLAS, GIVENS ROTATION, GIVENS TRANSFORMATION,
+C LINEAR ALGEBRA, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C SA single precision scalar
+C SB single precision scalar
+C
+C --Output--
+C SA single precision result R
+C SB single precision result Z
+C SC single precision result
+C SS single precision result
+C
+C Construct the Givens transformation
+C
+C ( SC SS )
+C G = ( ) , SC**2 + SS**2 = 1 ,
+C (-SS SC )
+C
+C which zeros the second entry of the 2-vector (SA,SB)**T.
+C
+C The quantity R = (+/-)SQRT(SA**2 + SB**2) overwrites SA in
+C storage. The value of SB is overwritten by a value Z which
+C allows SC and SS to be recovered by the following algorithm:
+C
+C If Z=1 set SC=0.0 and SS=1.0
+C If ABS(Z) .LT. 1 set SC=SQRT(1-Z**2) and SS=Z
+C If ABS(Z) .GT. 1 set SC=1/Z and SS=SQRT(1-SC**2)
+C
+C Normally, the subprogram SROT(N,SX,INCX,SY,INCY,SC,SS) will
+C next be called to apply the transformation to a 2 by N matrix.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 861211 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SROTG
+C***FIRST EXECUTABLE STATEMENT SROTG
+ IF (ABS(SA) .LE. ABS(SB)) GO TO 10
+C
+C *** HERE ABS(SA) .GT. ABS(SB) ***
+C
+ U = SA + SA
+ V = SB / U
+C
+C NOTE THAT U AND R HAVE THE SIGN OF SA
+C
+ R = SQRT(0.25E0 + V**2) * U
+C
+C NOTE THAT SC IS POSITIVE
+C
+ SC = SA / R
+ SS = V * (SC + SC)
+ SB = SS
+ SA = R
+ RETURN
+C
+C *** HERE ABS(SA) .LE. ABS(SB) ***
+C
+ 10 IF (SB .EQ. 0.0E0) GO TO 20
+ U = SB + SB
+ V = SA / U
+C
+C NOTE THAT U AND R HAVE THE SIGN OF SB
+C (R IS IMMEDIATELY STORED IN SA)
+C
+ SA = SQRT(0.25E0 + V**2) * U
+C
+C NOTE THAT SS IS POSITIVE
+C
+ SS = SB / SA
+ SC = V * (SS + SS)
+ IF (SC .EQ. 0.0E0) GO TO 15
+ SB = 1.0E0 / SC
+ RETURN
+ 15 SB = 1.0E0
+ RETURN
+C
+C *** HERE SA = SB = 0.0 ***
+C
+ 20 SC = 1.0E0
+ SS = 0.0E0
+ RETURN
+C
+ END
diff --git a/Lib/Slatec/slatec/sscal.f b/Lib/Slatec/slatec/sscal.f
new file mode 100644
index 0000000..2ad12c0
--- /dev/null
+++ b/Lib/Slatec/slatec/sscal.f
@@ -0,0 +1,80 @@
+*DECK SSCAL
+ SUBROUTINE SSCAL (N, SA, SX, INCX)
+C***BEGIN PROLOGUE SSCAL
+C***PURPOSE Multiply a vector by a constant.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A6
+C***TYPE SINGLE PRECISION (SSCAL-S, DSCAL-D, CSCAL-C)
+C***KEYWORDS BLAS, LINEAR ALGEBRA, SCALE, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C SA single precision scale factor
+C SX single precision vector with N elements
+C INCX storage spacing between elements of SX
+C
+C --Output--
+C SX single precision result (unchanged if N .LE. 0)
+C
+C Replace single precision SX by single precision SA*SX.
+C For I = 0 to N-1, replace SX(IX+I*INCX) with SA * SX(IX+I*INCX),
+C where IX = 1 if INCX .GE. 0, else IX = 1+(1-N)*INCX.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900821 Modified to correct problem with a negative increment.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SSCAL
+ REAL SA, SX(*)
+ INTEGER I, INCX, IX, M, MP1, N
+C***FIRST EXECUTABLE STATEMENT SSCAL
+ IF (N .LE. 0) RETURN
+ IF (INCX .EQ. 1) GOTO 20
+C
+C Code for increment not equal to 1.
+C
+ IX = 1
+ IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
+ DO 10 I = 1,N
+ SX(IX) = SA*SX(IX)
+ IX = IX + INCX
+ 10 CONTINUE
+ RETURN
+C
+C Code for increment equal to 1.
+C
+C Clean-up loop so remaining vector length is a multiple of 5.
+C
+ 20 M = MOD(N,5)
+ IF (M .EQ. 0) GOTO 40
+ DO 30 I = 1,M
+ SX(I) = SA*SX(I)
+ 30 CONTINUE
+ IF (N .LT. 5) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,5
+ SX(I) = SA*SX(I)
+ SX(I+1) = SA*SX(I+1)
+ SX(I+2) = SA*SX(I+2)
+ SX(I+3) = SA*SX(I+3)
+ SX(I+4) = SA*SX(I+4)
+ 50 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/ssvdc.f b/Lib/Slatec/slatec/ssvdc.f
new file mode 100644
index 0000000..c2893e4
--- /dev/null
+++ b/Lib/Slatec/slatec/ssvdc.f
@@ -0,0 +1,487 @@
+*DECK SSVDC
+ SUBROUTINE SSVDC (X, LDX, N, P, S, E, U, LDU, V, LDV, WORK, JOB,
+ + INFO)
+C***BEGIN PROLOGUE SSVDC
+C***PURPOSE Perform the singular value decomposition of a rectangular
+C matrix.
+C***LIBRARY SLATEC (LINPACK)
+C***CATEGORY D6
+C***TYPE SINGLE PRECISION (SSVDC-S, DSVDC-D, CSVDC-C)
+C***KEYWORDS LINEAR ALGEBRA, LINPACK, MATRIX,
+C SINGULAR VALUE DECOMPOSITION
+C***AUTHOR Stewart, G. W., (U. of Maryland)
+C***DESCRIPTION
+C
+C SSVDC is a subroutine to reduce a real NxP matrix X by orthogonal
+C transformations U and V to diagonal form. The elements S(I) are
+C the singular values of X. The columns of U are the corresponding
+C left singular vectors, and the columns of V the right singular
+C vectors.
+C
+C On Entry
+C
+C X REAL(LDX,P), where LDX .GE. N.
+C X contains the matrix whose singular value
+C decomposition is to be computed. X is
+C destroyed by SSVDC.
+C
+C LDX INTEGER
+C LDX is the leading dimension of the array X.
+C
+C N INTEGER
+C N is the number of rows of the matrix X.
+C
+C P INTEGER
+C P is the number of columns of the matrix X.
+C
+C LDU INTEGER
+C LDU is the leading dimension of the array U.
+C (See below).
+C
+C LDV INTEGER
+C LDV is the leading dimension of the array V.
+C (See below).
+C
+C WORK REAL(N)
+C work is a scratch array.
+C
+C JOB INTEGER
+C JOB controls the computation of the singular
+C vectors. It has the decimal expansion AB
+C with the following meaning
+C
+C A .EQ. 0 Do not compute the left singular
+C vectors.
+C A .EQ. 1 Return the N left singular vectors
+C in U.
+C A .GE. 2 Return the first MIN(N,P) singular
+C vectors in U.
+C B .EQ. 0 Do not compute the right singular
+C vectors.
+C B .EQ. 1 Return the right singular vectors
+C in V.
+C
+C On Return
+C
+C S REAL(MM), where MM=MIN(N+1,P).
+C The first MIN(N,P) entries of S contain the
+C singular values of X arranged in descending
+C order of magnitude.
+C
+C E REAL(P).
+C E ordinarily contains zeros. However, see the
+C discussion of INFO for exceptions.
+C
+C U REAL(LDU,K), where LDU .GE. N. If JOBA .EQ. 1, then
+C K .EQ. N. If JOBA .GE. 2 , then
+C K .EQ. MIN(N,P).
+C U contains the matrix of right singular vectors.
+C U is not referenced if JOBA .EQ. 0. If N .LE. P
+C or if JOBA .EQ. 2, then U may be identified with X
+C in the subroutine call.
+C
+C V REAL(LDV,P), where LDV .GE. P.
+C V contains the matrix of right singular vectors.
+C V is not referenced if JOB .EQ. 0. If P .LE. N,
+C then V may be identified with X in the
+C subroutine call.
+C
+C INFO INTEGER.
+C the singular values (and their corresponding
+C singular vectors) S(INFO+1),S(INFO+2),...,S(M)
+C are correct (here M=MIN(N,P)). Thus if
+C INFO .EQ. 0, all the singular values and their
+C vectors are correct. In any event, the matrix
+C B = TRANS(U)*X*V is the bidiagonal matrix
+C with the elements of S on its diagonal and the
+C elements of E on its super-diagonal (TRANS(U)
+C is the transpose of U). Thus the singular
+C values of X and B are the same.
+C
+C***REFERENCES J. J. Dongarra, J. R. Bunch, C. B. Moler, and G. W.
+C Stewart, LINPACK Users' Guide, SIAM, 1979.
+C***ROUTINES CALLED SAXPY, SDOT, SNRM2, SROT, SROTG, SSCAL, SSWAP
+C***REVISION HISTORY (YYMMDD)
+C 790319 DATE WRITTEN
+C 890531 Changed all specific intrinsics to generic. (WRB)
+C 890531 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900326 Removed duplicate information from DESCRIPTION section.
+C (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SSVDC
+ INTEGER LDX,N,P,LDU,LDV,JOB,INFO
+ REAL X(LDX,*),S(*),E(*),U(LDU,*),V(LDV,*),WORK(*)
+C
+C
+ INTEGER I,ITER,J,JOBU,K,KASE,KK,L,LL,LLS,LM1,LP1,LS,LU,M,MAXIT,
+ 1 MM,MM1,MP1,NCT,NCTP1,NCU,NRT,NRTP1
+ REAL SDOT,T
+ REAL B,C,CS,EL,EMM1,F,G,SNRM2,SCALE,SHIFT,SL,SM,SN,SMM1,T1,TEST,
+ 1 ZTEST
+ LOGICAL WANTU,WANTV
+C***FIRST EXECUTABLE STATEMENT SSVDC
+C
+C SET THE MAXIMUM NUMBER OF ITERATIONS.
+C
+ MAXIT = 30
+C
+C DETERMINE WHAT IS TO BE COMPUTED.
+C
+ WANTU = .FALSE.
+ WANTV = .FALSE.
+ JOBU = MOD(JOB,100)/10
+ NCU = N
+ IF (JOBU .GT. 1) NCU = MIN(N,P)
+ IF (JOBU .NE. 0) WANTU = .TRUE.
+ IF (MOD(JOB,10) .NE. 0) WANTV = .TRUE.
+C
+C REDUCE X TO BIDIAGONAL FORM, STORING THE DIAGONAL ELEMENTS
+C IN S AND THE SUPER-DIAGONAL ELEMENTS IN E.
+C
+ INFO = 0
+ NCT = MIN(N-1,P)
+ NRT = MAX(0,MIN(P-2,N))
+ LU = MAX(NCT,NRT)
+ IF (LU .LT. 1) GO TO 170
+ DO 160 L = 1, LU
+ LP1 = L + 1
+ IF (L .GT. NCT) GO TO 20
+C
+C COMPUTE THE TRANSFORMATION FOR THE L-TH COLUMN AND
+C PLACE THE L-TH DIAGONAL IN S(L).
+C
+ S(L) = SNRM2(N-L+1,X(L,L),1)
+ IF (S(L) .EQ. 0.0E0) GO TO 10
+ IF (X(L,L) .NE. 0.0E0) S(L) = SIGN(S(L),X(L,L))
+ CALL SSCAL(N-L+1,1.0E0/S(L),X(L,L),1)
+ X(L,L) = 1.0E0 + X(L,L)
+ 10 CONTINUE
+ S(L) = -S(L)
+ 20 CONTINUE
+ IF (P .LT. LP1) GO TO 50
+ DO 40 J = LP1, P
+ IF (L .GT. NCT) GO TO 30
+ IF (S(L) .EQ. 0.0E0) GO TO 30
+C
+C APPLY THE TRANSFORMATION.
+C
+ T = -SDOT(N-L+1,X(L,L),1,X(L,J),1)/X(L,L)
+ CALL SAXPY(N-L+1,T,X(L,L),1,X(L,J),1)
+ 30 CONTINUE
+C
+C PLACE THE L-TH ROW OF X INTO E FOR THE
+C SUBSEQUENT CALCULATION OF THE ROW TRANSFORMATION.
+C
+ E(J) = X(L,J)
+ 40 CONTINUE
+ 50 CONTINUE
+ IF (.NOT.WANTU .OR. L .GT. NCT) GO TO 70
+C
+C PLACE THE TRANSFORMATION IN U FOR SUBSEQUENT BACK
+C MULTIPLICATION.
+C
+ DO 60 I = L, N
+ U(I,L) = X(I,L)
+ 60 CONTINUE
+ 70 CONTINUE
+ IF (L .GT. NRT) GO TO 150
+C
+C COMPUTE THE L-TH ROW TRANSFORMATION AND PLACE THE
+C L-TH SUPER-DIAGONAL IN E(L).
+C
+ E(L) = SNRM2(P-L,E(LP1),1)
+ IF (E(L) .EQ. 0.0E0) GO TO 80
+ IF (E(LP1) .NE. 0.0E0) E(L) = SIGN(E(L),E(LP1))
+ CALL SSCAL(P-L,1.0E0/E(L),E(LP1),1)
+ E(LP1) = 1.0E0 + E(LP1)
+ 80 CONTINUE
+ E(L) = -E(L)
+ IF (LP1 .GT. N .OR. E(L) .EQ. 0.0E0) GO TO 120
+C
+C APPLY THE TRANSFORMATION.
+C
+ DO 90 I = LP1, N
+ WORK(I) = 0.0E0
+ 90 CONTINUE
+ DO 100 J = LP1, P
+ CALL SAXPY(N-L,E(J),X(LP1,J),1,WORK(LP1),1)
+ 100 CONTINUE
+ DO 110 J = LP1, P
+ CALL SAXPY(N-L,-E(J)/E(LP1),WORK(LP1),1,X(LP1,J),1)
+ 110 CONTINUE
+ 120 CONTINUE
+ IF (.NOT.WANTV) GO TO 140
+C
+C PLACE THE TRANSFORMATION IN V FOR SUBSEQUENT
+C BACK MULTIPLICATION.
+C
+ DO 130 I = LP1, P
+ V(I,L) = E(I)
+ 130 CONTINUE
+ 140 CONTINUE
+ 150 CONTINUE
+ 160 CONTINUE
+ 170 CONTINUE
+C
+C SET UP THE FINAL BIDIAGONAL MATRIX OR ORDER M.
+C
+ M = MIN(P,N+1)
+ NCTP1 = NCT + 1
+ NRTP1 = NRT + 1
+ IF (NCT .LT. P) S(NCTP1) = X(NCTP1,NCTP1)
+ IF (N .LT. M) S(M) = 0.0E0
+ IF (NRTP1 .LT. M) E(NRTP1) = X(NRTP1,M)
+ E(M) = 0.0E0
+C
+C IF REQUIRED, GENERATE U.
+C
+ IF (.NOT.WANTU) GO TO 300
+ IF (NCU .LT. NCTP1) GO TO 200
+ DO 190 J = NCTP1, NCU
+ DO 180 I = 1, N
+ U(I,J) = 0.0E0
+ 180 CONTINUE
+ U(J,J) = 1.0E0
+ 190 CONTINUE
+ 200 CONTINUE
+ IF (NCT .LT. 1) GO TO 290
+ DO 280 LL = 1, NCT
+ L = NCT - LL + 1
+ IF (S(L) .EQ. 0.0E0) GO TO 250
+ LP1 = L + 1
+ IF (NCU .LT. LP1) GO TO 220
+ DO 210 J = LP1, NCU
+ T = -SDOT(N-L+1,U(L,L),1,U(L,J),1)/U(L,L)
+ CALL SAXPY(N-L+1,T,U(L,L),1,U(L,J),1)
+ 210 CONTINUE
+ 220 CONTINUE
+ CALL SSCAL(N-L+1,-1.0E0,U(L,L),1)
+ U(L,L) = 1.0E0 + U(L,L)
+ LM1 = L - 1
+ IF (LM1 .LT. 1) GO TO 240
+ DO 230 I = 1, LM1
+ U(I,L) = 0.0E0
+ 230 CONTINUE
+ 240 CONTINUE
+ GO TO 270
+ 250 CONTINUE
+ DO 260 I = 1, N
+ U(I,L) = 0.0E0
+ 260 CONTINUE
+ U(L,L) = 1.0E0
+ 270 CONTINUE
+ 280 CONTINUE
+ 290 CONTINUE
+ 300 CONTINUE
+C
+C IF IT IS REQUIRED, GENERATE V.
+C
+ IF (.NOT.WANTV) GO TO 350
+ DO 340 LL = 1, P
+ L = P - LL + 1
+ LP1 = L + 1
+ IF (L .GT. NRT) GO TO 320
+ IF (E(L) .EQ. 0.0E0) GO TO 320
+ DO 310 J = LP1, P
+ T = -SDOT(P-L,V(LP1,L),1,V(LP1,J),1)/V(LP1,L)
+ CALL SAXPY(P-L,T,V(LP1,L),1,V(LP1,J),1)
+ 310 CONTINUE
+ 320 CONTINUE
+ DO 330 I = 1, P
+ V(I,L) = 0.0E0
+ 330 CONTINUE
+ V(L,L) = 1.0E0
+ 340 CONTINUE
+ 350 CONTINUE
+C
+C MAIN ITERATION LOOP FOR THE SINGULAR VALUES.
+C
+ MM = M
+ ITER = 0
+ 360 CONTINUE
+C
+C QUIT IF ALL THE SINGULAR VALUES HAVE BEEN FOUND.
+C
+ IF (M .EQ. 0) GO TO 620
+C
+C IF TOO MANY ITERATIONS HAVE BEEN PERFORMED, SET
+C FLAG AND RETURN.
+C
+ IF (ITER .LT. MAXIT) GO TO 370
+ INFO = M
+ GO TO 620
+ 370 CONTINUE
+C
+C THIS SECTION OF THE PROGRAM INSPECTS FOR
+C NEGLIGIBLE ELEMENTS IN THE S AND E ARRAYS. ON
+C COMPLETION THE VARIABLES KASE AND L ARE SET AS FOLLOWS.
+C
+C KASE = 1 IF S(M) AND E(L-1) ARE NEGLIGIBLE AND L.LT.M
+C KASE = 2 IF S(L) IS NEGLIGIBLE AND L.LT.M
+C KASE = 3 IF E(L-1) IS NEGLIGIBLE, L.LT.M, AND
+C S(L), ..., S(M) ARE NOT NEGLIGIBLE (QR STEP).
+C KASE = 4 IF E(M-1) IS NEGLIGIBLE (CONVERGENCE).
+C
+ DO 390 LL = 1, M
+ L = M - LL
+ IF (L .EQ. 0) GO TO 400
+ TEST = ABS(S(L)) + ABS(S(L+1))
+ ZTEST = TEST + ABS(E(L))
+ IF (ZTEST .NE. TEST) GO TO 380
+ E(L) = 0.0E0
+ GO TO 400
+ 380 CONTINUE
+ 390 CONTINUE
+ 400 CONTINUE
+ IF (L .NE. M - 1) GO TO 410
+ KASE = 4
+ GO TO 480
+ 410 CONTINUE
+ LP1 = L + 1
+ MP1 = M + 1
+ DO 430 LLS = LP1, MP1
+ LS = M - LLS + LP1
+ IF (LS .EQ. L) GO TO 440
+ TEST = 0.0E0
+ IF (LS .NE. M) TEST = TEST + ABS(E(LS))
+ IF (LS .NE. L + 1) TEST = TEST + ABS(E(LS-1))
+ ZTEST = TEST + ABS(S(LS))
+ IF (ZTEST .NE. TEST) GO TO 420
+ S(LS) = 0.0E0
+ GO TO 440
+ 420 CONTINUE
+ 430 CONTINUE
+ 440 CONTINUE
+ IF (LS .NE. L) GO TO 450
+ KASE = 3
+ GO TO 470
+ 450 CONTINUE
+ IF (LS .NE. M) GO TO 460
+ KASE = 1
+ GO TO 470
+ 460 CONTINUE
+ KASE = 2
+ L = LS
+ 470 CONTINUE
+ 480 CONTINUE
+ L = L + 1
+C
+C PERFORM THE TASK INDICATED BY KASE.
+C
+ GO TO (490,520,540,570), KASE
+C
+C DEFLATE NEGLIGIBLE S(M).
+C
+ 490 CONTINUE
+ MM1 = M - 1
+ F = E(M-1)
+ E(M-1) = 0.0E0
+ DO 510 KK = L, MM1
+ K = MM1 - KK + L
+ T1 = S(K)
+ CALL SROTG(T1,F,CS,SN)
+ S(K) = T1
+ IF (K .EQ. L) GO TO 500
+ F = -SN*E(K-1)
+ E(K-1) = CS*E(K-1)
+ 500 CONTINUE
+ IF (WANTV) CALL SROT(P,V(1,K),1,V(1,M),1,CS,SN)
+ 510 CONTINUE
+ GO TO 610
+C
+C SPLIT AT NEGLIGIBLE S(L).
+C
+ 520 CONTINUE
+ F = E(L-1)
+ E(L-1) = 0.0E0
+ DO 530 K = L, M
+ T1 = S(K)
+ CALL SROTG(T1,F,CS,SN)
+ S(K) = T1
+ F = -SN*E(K)
+ E(K) = CS*E(K)
+ IF (WANTU) CALL SROT(N,U(1,K),1,U(1,L-1),1,CS,SN)
+ 530 CONTINUE
+ GO TO 610
+C
+C PERFORM ONE QR STEP.
+C
+ 540 CONTINUE
+C
+C CALCULATE THE SHIFT.
+C
+ SCALE = MAX(ABS(S(M)),ABS(S(M-1)),ABS(E(M-1)),ABS(S(L)),
+ 1 ABS(E(L)))
+ SM = S(M)/SCALE
+ SMM1 = S(M-1)/SCALE
+ EMM1 = E(M-1)/SCALE
+ SL = S(L)/SCALE
+ EL = E(L)/SCALE
+ B = ((SMM1 + SM)*(SMM1 - SM) + EMM1**2)/2.0E0
+ C = (SM*EMM1)**2
+ SHIFT = 0.0E0
+ IF (B .EQ. 0.0E0 .AND. C .EQ. 0.0E0) GO TO 550
+ SHIFT = SQRT(B**2+C)
+ IF (B .LT. 0.0E0) SHIFT = -SHIFT
+ SHIFT = C/(B + SHIFT)
+ 550 CONTINUE
+ F = (SL + SM)*(SL - SM) - SHIFT
+ G = SL*EL
+C
+C CHASE ZEROS.
+C
+ MM1 = M - 1
+ DO 560 K = L, MM1
+ CALL SROTG(F,G,CS,SN)
+ IF (K .NE. L) E(K-1) = F
+ F = CS*S(K) + SN*E(K)
+ E(K) = CS*E(K) - SN*S(K)
+ G = SN*S(K+1)
+ S(K+1) = CS*S(K+1)
+ IF (WANTV) CALL SROT(P,V(1,K),1,V(1,K+1),1,CS,SN)
+ CALL SROTG(F,G,CS,SN)
+ S(K) = F
+ F = CS*E(K) + SN*S(K+1)
+ S(K+1) = -SN*E(K) + CS*S(K+1)
+ G = SN*E(K+1)
+ E(K+1) = CS*E(K+1)
+ IF (WANTU .AND. K .LT. N)
+ 1 CALL SROT(N,U(1,K),1,U(1,K+1),1,CS,SN)
+ 560 CONTINUE
+ E(M-1) = F
+ ITER = ITER + 1
+ GO TO 610
+C
+C CONVERGENCE.
+C
+ 570 CONTINUE
+C
+C MAKE THE SINGULAR VALUE POSITIVE.
+C
+ IF (S(L) .GE. 0.0E0) GO TO 580
+ S(L) = -S(L)
+ IF (WANTV) CALL SSCAL(P,-1.0E0,V(1,L),1)
+ 580 CONTINUE
+C
+C ORDER THE SINGULAR VALUE.
+C
+ 590 IF (L .EQ. MM) GO TO 600
+ IF (S(L) .GE. S(L+1)) GO TO 600
+ T = S(L)
+ S(L) = S(L+1)
+ S(L+1) = T
+ IF (WANTV .AND. L .LT. P)
+ 1 CALL SSWAP(P,V(1,L),1,V(1,L+1),1)
+ IF (WANTU .AND. L .LT. N)
+ 1 CALL SSWAP(N,U(1,L),1,U(1,L+1),1)
+ L = L + 1
+ GO TO 590
+ 600 CONTINUE
+ ITER = 0
+ M = M - 1
+ 610 CONTINUE
+ GO TO 360
+ 620 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/sswap.f b/Lib/Slatec/slatec/sswap.f
new file mode 100644
index 0000000..1424ce9
--- /dev/null
+++ b/Lib/Slatec/slatec/sswap.f
@@ -0,0 +1,102 @@
+*DECK SSWAP
+ SUBROUTINE SSWAP (N, SX, INCX, SY, INCY)
+C***BEGIN PROLOGUE SSWAP
+C***PURPOSE Interchange two vectors.
+C***LIBRARY SLATEC (BLAS)
+C***CATEGORY D1A5
+C***TYPE SINGLE PRECISION (SSWAP-S, DSWAP-D, CSWAP-C, ISWAP-I)
+C***KEYWORDS BLAS, INTERCHANGE, LINEAR ALGEBRA, VECTOR
+C***AUTHOR Lawson, C. L., (JPL)
+C Hanson, R. J., (SNLA)
+C Kincaid, D. R., (U. of Texas)
+C Krogh, F. T., (JPL)
+C***DESCRIPTION
+C
+C B L A S Subprogram
+C Description of Parameters
+C
+C --Input--
+C N number of elements in input vector(s)
+C SX single precision vector with N elements
+C INCX storage spacing between elements of SX
+C SY single precision vector with N elements
+C INCY storage spacing between elements of SY
+C
+C --Output--
+C SX input vector SY (unchanged if N .LE. 0)
+C SY input vector SX (unchanged if N .LE. 0)
+C
+C Interchange single precision SX and single precision SY.
+C For I = 0 to N-1, interchange SX(LX+I*INCX) and SY(LY+I*INCY),
+C where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
+C defined in a similar way using INCY.
+C
+C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
+C Krogh, Basic linear algebra subprograms for Fortran
+C usage, Algorithm No. 539, Transactions on Mathematical
+C Software 5, 3 (September 1979), pp. 308-323.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 791001 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920310 Corrected definition of LX in DESCRIPTION. (WRB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE SSWAP
+ REAL SX(*), SY(*), STEMP1, STEMP2, STEMP3
+C***FIRST EXECUTABLE STATEMENT SSWAP
+ IF (N .LE. 0) RETURN
+ IF (INCX .EQ. INCY) IF (INCX-1) 5,20,60
+C
+C Code for unequal or nonpositive increments.
+C
+ 5 IX = 1
+ IY = 1
+ IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
+ IF (INCY .LT. 0) IY = (-N+1)*INCY + 1
+ DO 10 I = 1,N
+ STEMP1 = SX(IX)
+ SX(IX) = SY(IY)
+ SY(IY) = STEMP1
+ IX = IX + INCX
+ IY = IY + INCY
+ 10 CONTINUE
+ RETURN
+C
+C Code for both increments equal to 1.
+C
+C Clean-up loop so remaining vector length is a multiple of 3.
+C
+ 20 M = MOD(N,3)
+ IF (M .EQ. 0) GO TO 40
+ DO 30 I = 1,M
+ STEMP1 = SX(I)
+ SX(I) = SY(I)
+ SY(I) = STEMP1
+ 30 CONTINUE
+ IF (N .LT. 3) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,3
+ STEMP1 = SX(I)
+ STEMP2 = SX(I+1)
+ STEMP3 = SX(I+2)
+ SX(I) = SY(I)
+ SX(I+1) = SY(I+1)
+ SX(I+2) = SY(I+2)
+ SY(I) = STEMP1
+ SY(I+1) = STEMP2
+ SY(I+2) = STEMP3
+ 50 CONTINUE
+ RETURN
+C
+C Code for equal, positive, non-unit increments.
+C
+ 60 NS = N*INCX
+ DO 70 I = 1,NS,INCX
+ STEMP1 = SX(I)
+ SX(I) = SY(I)
+ SY(I) = STEMP1
+ 70 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/tql2.f b/Lib/Slatec/slatec/tql2.f
new file mode 100644
index 0000000..40d9938
--- /dev/null
+++ b/Lib/Slatec/slatec/tql2.f
@@ -0,0 +1,203 @@
+*DECK TQL2
+ SUBROUTINE TQL2 (NM, N, D, E, Z, IERR)
+C***BEGIN PROLOGUE TQL2
+C***PURPOSE Compute the eigenvalues and eigenvectors of symmetric
+C tridiagonal matrix.
+C***LIBRARY SLATEC (EISPACK)
+C***CATEGORY D4A5, D4C2A
+C***TYPE SINGLE PRECISION (TQL2-S)
+C***KEYWORDS EIGENVALUES, EIGENVECTORS, EISPACK
+C***AUTHOR Smith, B. T., et al.
+C***DESCRIPTION
+C
+C This subroutine is a translation of the ALGOL procedure TQL2,
+C NUM. MATH. 11, 293-306(1968) by Bowdler, Martin, Reinsch, and
+C Wilkinson.
+C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 227-240(1971).
+C
+C This subroutine finds the eigenvalues and eigenvectors
+C of a SYMMETRIC TRIDIAGONAL matrix by the QL method.
+C The eigenvectors of a FULL SYMMETRIC matrix can also
+C be found if TRED2 has been used to reduce this
+C full matrix to tridiagonal form.
+C
+C On Input
+C
+C NM must be set to the row dimension of the two-dimensional
+C array parameter, Z, as declared in the calling program
+C dimension statement. NM is an INTEGER variable.
+C
+C N is the order of the matrix. N is an INTEGER variable.
+C N must be less than or equal to NM.
+C
+C D contains the diagonal elements of the symmetric tridiagonal
+C matrix. D is a one-dimensional REAL array, dimensioned D(N).
+C
+C E contains the subdiagonal elements of the symmetric
+C tridiagonal matrix in its last N-1 positions. E(1) is
+C arbitrary. E is a one-dimensional REAL array, dimensioned
+C E(N).
+C
+C Z contains the transformation matrix produced in the
+C reduction by TRED2, if performed. If the eigenvectors
+C of the tridiagonal matrix are desired, Z must contain
+C the identity matrix. Z is a two-dimensional REAL array,
+C dimensioned Z(NM,N).
+C
+C On Output
+C
+C D contains the eigenvalues in ascending order. If an
+C error exit is made, the eigenvalues are correct but
+C unordered for indices 1, 2, ..., IERR-1.
+C
+C E has been destroyed.
+C
+C Z contains orthonormal eigenvectors of the symmetric
+C tridiagonal (or full) matrix. If an error exit is made,
+C Z contains the eigenvectors associated with the stored
+C eigenvalues.
+C
+C IERR is an INTEGER flag set to
+C Zero for normal return,
+C J if the J-th eigenvalue has not been
+C determined after 30 iterations.
+C
+C Calls PYTHAG(A,B) for sqrt(A**2 + B**2).
+C
+C Questions and comments should be directed to B. S. Garbow,
+C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
+C ------------------------------------------------------------------
+C
+C***REFERENCES B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
+C Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
+C system Routines - EISPACK Guide, Springer-Verlag,
+C 1976.
+C***ROUTINES CALLED PYTHAG
+C***REVISION HISTORY (YYMMDD)
+C 760101 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE TQL2
+C
+ INTEGER I,J,K,L,M,N,II,L1,L2,NM,MML,IERR
+ REAL D(*),E(*),Z(NM,*)
+ REAL B,C,C2,C3,DL1,EL1,F,G,H,P,R,S,S2
+ REAL PYTHAG
+C
+C***FIRST EXECUTABLE STATEMENT TQL2
+ IERR = 0
+ IF (N .EQ. 1) GO TO 1001
+C
+ DO 100 I = 2, N
+ 100 E(I-1) = E(I)
+C
+ F = 0.0E0
+ B = 0.0E0
+ E(N) = 0.0E0
+C
+ DO 240 L = 1, N
+ J = 0
+ H = ABS(D(L)) + ABS(E(L))
+ IF (B .LT. H) B = H
+C .......... LOOK FOR SMALL SUB-DIAGONAL ELEMENT ..........
+ DO 110 M = L, N
+ IF (B + ABS(E(M)) .EQ. B) GO TO 120
+C .......... E(N) IS ALWAYS ZERO, SO THERE IS NO EXIT
+C THROUGH THE BOTTOM OF THE LOOP ..........
+ 110 CONTINUE
+C
+ 120 IF (M .EQ. L) GO TO 220
+ 130 IF (J .EQ. 30) GO TO 1000
+ J = J + 1
+C .......... FORM SHIFT ..........
+ L1 = L + 1
+ L2 = L1 + 1
+ G = D(L)
+ P = (D(L1) - G) / (2.0E0 * E(L))
+ R = PYTHAG(P,1.0E0)
+ D(L) = E(L) / (P + SIGN(R,P))
+ D(L1) = E(L) * (P + SIGN(R,P))
+ DL1 = D(L1)
+ H = G - D(L)
+ IF (L2 .GT. N) GO TO 145
+C
+ DO 140 I = L2, N
+ 140 D(I) = D(I) - H
+C
+ 145 F = F + H
+C .......... QL TRANSFORMATION ..........
+ P = D(M)
+ C = 1.0E0
+ C2 = C
+ EL1 = E(L1)
+ S = 0.0E0
+ MML = M - L
+C .......... FOR I=M-1 STEP -1 UNTIL L DO -- ..........
+ DO 200 II = 1, MML
+ C3 = C2
+ C2 = C
+ S2 = S
+ I = M - II
+ G = C * E(I)
+ H = C * P
+ IF (ABS(P) .LT. ABS(E(I))) GO TO 150
+ C = E(I) / P
+ R = SQRT(C*C+1.0E0)
+ E(I+1) = S * P * R
+ S = C / R
+ C = 1.0E0 / R
+ GO TO 160
+ 150 C = P / E(I)
+ R = SQRT(C*C+1.0E0)
+ E(I+1) = S * E(I) * R
+ S = 1.0E0 / R
+ C = C * S
+ 160 P = C * D(I) - S * G
+ D(I+1) = H + S * (C * G + S * D(I))
+C .......... FORM VECTOR ..........
+ DO 180 K = 1, N
+ H = Z(K,I+1)
+ Z(K,I+1) = S * Z(K,I) + C * H
+ Z(K,I) = C * Z(K,I) - S * H
+ 180 CONTINUE
+C
+ 200 CONTINUE
+C
+ P = -S * S2 * C3 * EL1 * E(L) / DL1
+ E(L) = S * P
+ D(L) = C * P
+ IF (B + ABS(E(L)) .GT. B) GO TO 130
+ 220 D(L) = D(L) + F
+ 240 CONTINUE
+C .......... ORDER EIGENVALUES AND EIGENVECTORS ..........
+ DO 300 II = 2, N
+ I = II - 1
+ K = I
+ P = D(I)
+C
+ DO 260 J = II, N
+ IF (D(J) .GE. P) GO TO 260
+ K = J
+ P = D(J)
+ 260 CONTINUE
+C
+ IF (K .EQ. I) GO TO 300
+ D(K) = D(I)
+ D(I) = P
+C
+ DO 280 J = 1, N
+ P = Z(J,I)
+ Z(J,I) = Z(J,K)
+ Z(J,K) = P
+ 280 CONTINUE
+C
+ 300 CONTINUE
+C
+ GO TO 1001
+C .......... SET ERROR -- NO CONVERGENCE TO AN
+C EIGENVALUE AFTER 30 ITERATIONS ..........
+ 1000 IERR = L
+ 1001 RETURN
+ END
diff --git a/Lib/Slatec/slatec/tqlrat.f b/Lib/Slatec/slatec/tqlrat.f
new file mode 100644
index 0000000..8cb7b9c
--- /dev/null
+++ b/Lib/Slatec/slatec/tqlrat.f
@@ -0,0 +1,165 @@
+*DECK TQLRAT
+ SUBROUTINE TQLRAT (N, D, E2, IERR)
+C***BEGIN PROLOGUE TQLRAT
+C***PURPOSE Compute the eigenvalues of symmetric tridiagonal matrix
+C using a rational variant of the QL method.
+C***LIBRARY SLATEC (EISPACK)
+C***CATEGORY D4A5, D4C2A
+C***TYPE SINGLE PRECISION (TQLRAT-S)
+C***KEYWORDS EIGENVALUES OF A SYMMETRIC TRIDIAGONAL MATRIX, EISPACK,
+C QL METHOD
+C***AUTHOR Smith, B. T., et al.
+C***DESCRIPTION
+C
+C This subroutine is a translation of the ALGOL procedure TQLRAT.
+C
+C This subroutine finds the eigenvalues of a SYMMETRIC
+C TRIDIAGONAL matrix by the rational QL method.
+C
+C On Input
+C
+C N is the order of the matrix. N is an INTEGER variable.
+C
+C D contains the diagonal elements of the symmetric tridiagonal
+C matrix. D is a one-dimensional REAL array, dimensioned D(N).
+C
+C E2 contains the squares of the subdiagonal elements of the
+C symmetric tridiagonal matrix in its last N-1 positions.
+C E2(1) is arbitrary. E2 is a one-dimensional REAL array,
+C dimensioned E2(N).
+C
+C On Output
+C
+C D contains the eigenvalues in ascending order. If an
+C error exit is made, the eigenvalues are correct and
+C ordered for indices 1, 2, ..., IERR-1, but may not be
+C the smallest eigenvalues.
+C
+C E2 has been destroyed.
+C
+C IERR is an INTEGER flag set to
+C Zero for normal return,
+C J if the J-th eigenvalue has not been
+C determined after 30 iterations.
+C
+C Calls PYTHAG(A,B) for sqrt(A**2 + B**2).
+C
+C Questions and comments should be directed to B. S. Garbow,
+C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
+C ------------------------------------------------------------------
+C
+C***REFERENCES B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
+C Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
+C system Routines - EISPACK Guide, Springer-Verlag,
+C 1976.
+C C. H. Reinsch, Eigenvalues of a real, symmetric, tri-
+C diagonal matrix, Algorithm 464, Communications of the
+C ACM 16, 11 (November 1973), pp. 689.
+C***ROUTINES CALLED PYTHAG, R1MACH
+C***REVISION HISTORY (YYMMDD)
+C 760101 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE TQLRAT
+C
+ INTEGER I,J,L,M,N,II,L1,MML,IERR
+ REAL D(*),E2(*)
+ REAL B,C,F,G,H,P,R,S,MACHEP
+ REAL PYTHAG
+ LOGICAL FIRST
+C
+ SAVE FIRST, MACHEP
+ DATA FIRST /.TRUE./
+C***FIRST EXECUTABLE STATEMENT TQLRAT
+ IF (FIRST) THEN
+ MACHEP = R1MACH(4)
+ ENDIF
+ FIRST = .FALSE.
+C
+ IERR = 0
+ IF (N .EQ. 1) GO TO 1001
+C
+ DO 100 I = 2, N
+ 100 E2(I-1) = E2(I)
+C
+ F = 0.0E0
+ B = 0.0E0
+ E2(N) = 0.0E0
+C
+ DO 290 L = 1, N
+ J = 0
+ H = MACHEP * (ABS(D(L)) + SQRT(E2(L)))
+ IF (B .GT. H) GO TO 105
+ B = H
+ C = B * B
+C .......... LOOK FOR SMALL SQUARED SUB-DIAGONAL ELEMENT ..........
+ 105 DO 110 M = L, N
+ IF (E2(M) .LE. C) GO TO 120
+C .......... E2(N) IS ALWAYS ZERO, SO THERE IS NO EXIT
+C THROUGH THE BOTTOM OF THE LOOP ..........
+ 110 CONTINUE
+C
+ 120 IF (M .EQ. L) GO TO 210
+ 130 IF (J .EQ. 30) GO TO 1000
+ J = J + 1
+C .......... FORM SHIFT ..........
+ L1 = L + 1
+ S = SQRT(E2(L))
+ G = D(L)
+ P = (D(L1) - G) / (2.0E0 * S)
+ R = PYTHAG(P,1.0E0)
+ D(L) = S / (P + SIGN(R,P))
+ H = G - D(L)
+C
+ DO 140 I = L1, N
+ 140 D(I) = D(I) - H
+C
+ F = F + H
+C .......... RATIONAL QL TRANSFORMATION ..........
+ G = D(M)
+ IF (G .EQ. 0.0E0) G = B
+ H = G
+ S = 0.0E0
+ MML = M - L
+C .......... FOR I=M-1 STEP -1 UNTIL L DO -- ..........
+ DO 200 II = 1, MML
+ I = M - II
+ P = G * H
+ R = P + E2(I)
+ E2(I+1) = S * R
+ S = E2(I) / R
+ D(I+1) = H + S * (H + D(I))
+ G = D(I) - E2(I) / G
+ IF (G .EQ. 0.0E0) G = B
+ H = G * P / R
+ 200 CONTINUE
+C
+ E2(L) = S * G
+ D(L) = H
+C .......... GUARD AGAINST UNDERFLOW IN CONVERGENCE TEST ..........
+ IF (H .EQ. 0.0E0) GO TO 210
+ IF (ABS(E2(L)) .LE. ABS(C/H)) GO TO 210
+ E2(L) = H * E2(L)
+ IF (E2(L) .NE. 0.0E0) GO TO 130
+ 210 P = D(L) + F
+C .......... ORDER EIGENVALUES ..........
+ IF (L .EQ. 1) GO TO 250
+C .......... FOR I=L STEP -1 UNTIL 2 DO -- ..........
+ DO 230 II = 2, L
+ I = L + 2 - II
+ IF (P .GE. D(I-1)) GO TO 270
+ D(I) = D(I-1)
+ 230 CONTINUE
+C
+ 250 I = 1
+ 270 D(I) = P
+ 290 CONTINUE
+C
+ GO TO 1001
+C .......... SET ERROR -- NO CONVERGENCE TO AN
+C EIGENVALUE AFTER 30 ITERATIONS ..........
+ 1000 IERR = L
+ 1001 RETURN
+ END
diff --git a/Lib/Slatec/slatec/tred1.f b/Lib/Slatec/slatec/tred1.f
new file mode 100644
index 0000000..1586bd5
--- /dev/null
+++ b/Lib/Slatec/slatec/tred1.f
@@ -0,0 +1,142 @@
+*DECK TRED1
+ SUBROUTINE TRED1 (NM, N, A, D, E, E2)
+C***BEGIN PROLOGUE TRED1
+C***PURPOSE Reduce a real symmetric matrix to symmetric tridiagonal
+C matrix using orthogonal similarity transformations.
+C***LIBRARY SLATEC (EISPACK)
+C***CATEGORY D4C1B1
+C***TYPE SINGLE PRECISION (TRED1-S)
+C***KEYWORDS EIGENVALUES, EIGENVECTORS, EISPACK
+C***AUTHOR Smith, B. T., et al.
+C***DESCRIPTION
+C
+C This subroutine is a translation of the ALGOL procedure TRED1,
+C NUM. MATH. 11, 181-195(1968) by Martin, Reinsch, and Wilkinson.
+C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971).
+C
+C This subroutine reduces a REAL SYMMETRIC matrix
+C to a symmetric tridiagonal matrix using
+C orthogonal similarity transformations.
+C
+C On Input
+C
+C NM must be set to the row dimension of the two-dimensional
+C array parameter, A, as declared in the calling program
+C dimension statement. NM is an INTEGER variable.
+C
+C N is the order of the matrix A. N is an INTEGER variable.
+C N must be less than or equal to NM.
+C
+C A contains the real symmetric input matrix. Only the lower
+C triangle of the matrix need be supplied. A is a two-
+C dimensional REAL array, dimensioned A(NM,N).
+C
+C On Output
+C
+C A contains information about the orthogonal transformations
+C used in the reduction in its strict lower triangle. The
+C full upper triangle of A is unaltered.
+C
+C D contains the diagonal elements of the symmetric tridiagonal
+C matrix. D is a one-dimensional REAL array, dimensioned D(N).
+C
+C E contains the subdiagonal elements of the symmetric
+C tridiagonal matrix in its last N-1 positions. E(1) is set
+C to zero. E is a one-dimensional REAL array, dimensioned
+C E(N).
+C
+C E2 contains the squares of the corresponding elements of E.
+C E2 may coincide with E if the squares are not needed.
+C E2 is a one-dimensional REAL array, dimensioned E2(N).
+C
+C Questions and comments should be directed to B. S. Garbow,
+C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
+C ------------------------------------------------------------------
+C
+C***REFERENCES B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
+C Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
+C system Routines - EISPACK Guide, Springer-Verlag,
+C 1976.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 760101 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE TRED1
+C
+ INTEGER I,J,K,L,N,II,NM,JP1
+ REAL A(NM,*),D(*),E(*),E2(*)
+ REAL F,G,H,SCALE
+C
+C***FIRST EXECUTABLE STATEMENT TRED1
+ DO 100 I = 1, N
+ 100 D(I) = A(I,I)
+C .......... FOR I=N STEP -1 UNTIL 1 DO -- ..........
+ DO 300 II = 1, N
+ I = N + 1 - II
+ L = I - 1
+ H = 0.0E0
+ SCALE = 0.0E0
+ IF (L .LT. 1) GO TO 130
+C .......... SCALE ROW (ALGOL TOL THEN NOT NEEDED) ..........
+ DO 120 K = 1, L
+ 120 SCALE = SCALE + ABS(A(I,K))
+C
+ IF (SCALE .NE. 0.0E0) GO TO 140
+ 130 E(I) = 0.0E0
+ E2(I) = 0.0E0
+ GO TO 290
+C
+ 140 DO 150 K = 1, L
+ A(I,K) = A(I,K) / SCALE
+ H = H + A(I,K) * A(I,K)
+ 150 CONTINUE
+C
+ E2(I) = SCALE * SCALE * H
+ F = A(I,L)
+ G = -SIGN(SQRT(H),F)
+ E(I) = SCALE * G
+ H = H - F * G
+ A(I,L) = F - G
+ IF (L .EQ. 1) GO TO 270
+ F = 0.0E0
+C
+ DO 240 J = 1, L
+ G = 0.0E0
+C .......... FORM ELEMENT OF A*U ..........
+ DO 180 K = 1, J
+ 180 G = G + A(J,K) * A(I,K)
+C
+ JP1 = J + 1
+ IF (L .LT. JP1) GO TO 220
+C
+ DO 200 K = JP1, L
+ 200 G = G + A(K,J) * A(I,K)
+C .......... FORM ELEMENT OF P ..........
+ 220 E(J) = G / H
+ F = F + E(J) * A(I,J)
+ 240 CONTINUE
+C
+ H = F / (H + H)
+C .......... FORM REDUCED A ..........
+ DO 260 J = 1, L
+ F = A(I,J)
+ G = E(J) - H * F
+ E(J) = G
+C
+ DO 260 K = 1, J
+ A(J,K) = A(J,K) - F * E(K) - G * A(I,K)
+ 260 CONTINUE
+C
+ 270 DO 280 K = 1, L
+ 280 A(I,K) = SCALE * A(I,K)
+C
+ 290 H = D(I)
+ D(I) = A(I,I)
+ A(I,I) = H
+ 300 CONTINUE
+C
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/tred2.f b/Lib/Slatec/slatec/tred2.f
new file mode 100644
index 0000000..6b52c32
--- /dev/null
+++ b/Lib/Slatec/slatec/tred2.f
@@ -0,0 +1,166 @@
+*DECK TRED2
+ SUBROUTINE TRED2 (NM, N, A, D, E, Z)
+C***BEGIN PROLOGUE TRED2
+C***PURPOSE Reduce a real symmetric matrix to a symmetric tridiagonal
+C matrix using and accumulating orthogonal transformations.
+C***LIBRARY SLATEC (EISPACK)
+C***CATEGORY D4C1B1
+C***TYPE SINGLE PRECISION (TRED2-S)
+C***KEYWORDS EIGENVALUES, EIGENVECTORS, EISPACK
+C***AUTHOR Smith, B. T., et al.
+C***DESCRIPTION
+C
+C This subroutine is a translation of the ALGOL procedure TRED2,
+C NUM. MATH. 11, 181-195(1968) by Martin, Reinsch, and Wilkinson.
+C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971).
+C
+C This subroutine reduces a REAL SYMMETRIC matrix to a
+C symmetric tridiagonal matrix using and accumulating
+C orthogonal similarity transformations.
+C
+C On Input
+C
+C NM must be set to the row dimension of the two-dimensional
+C array parameters, A and Z, as declared in the calling
+C program dimension statement. NM is an INTEGER variable.
+C
+C N is the order of the matrix A. N is an INTEGER variable.
+C N must be less than or equal to NM.
+C
+C A contains the real symmetric input matrix. Only the lower
+C triangle of the matrix need be supplied. A is a two-
+C dimensional REAL array, dimensioned A(NM,N).
+C
+C On Output
+C
+C D contains the diagonal elements of the symmetric tridiagonal
+C matrix. D is a one-dimensional REAL array, dimensioned D(N).
+C
+C E contains the subdiagonal elements of the symmetric
+C tridiagonal matrix in its last N-1 positions. E(1) is set
+C to zero. E is a one-dimensional REAL array, dimensioned
+C E(N).
+C
+C Z contains the orthogonal transformation matrix produced in
+C the reduction. Z is a two-dimensional REAL array,
+C dimensioned Z(NM,N).
+C
+C A and Z may coincide. If distinct, A is unaltered.
+C
+C Questions and comments should be directed to B. S. Garbow,
+C APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
+C ------------------------------------------------------------------
+C
+C***REFERENCES B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
+C Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
+C system Routines - EISPACK Guide, Springer-Verlag,
+C 1976.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 760101 DATE WRITTEN
+C 890831 Modified array declarations. (WRB)
+C 890831 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE TRED2
+C
+ INTEGER I,J,K,L,N,II,NM,JP1
+ REAL A(NM,*),D(*),E(*),Z(NM,*)
+ REAL F,G,H,HH,SCALE
+C
+C***FIRST EXECUTABLE STATEMENT TRED2
+ DO 100 I = 1, N
+C
+ DO 100 J = 1, I
+ Z(I,J) = A(I,J)
+ 100 CONTINUE
+C
+ IF (N .EQ. 1) GO TO 320
+C .......... FOR I=N STEP -1 UNTIL 2 DO -- ..........
+ DO 300 II = 2, N
+ I = N + 2 - II
+ L = I - 1
+ H = 0.0E0
+ SCALE = 0.0E0
+ IF (L .LT. 2) GO TO 130
+C .......... SCALE ROW (ALGOL TOL THEN NOT NEEDED) ..........
+ DO 120 K = 1, L
+ 120 SCALE = SCALE + ABS(Z(I,K))
+C
+ IF (SCALE .NE. 0.0E0) GO TO 140
+ 130 E(I) = Z(I,L)
+ GO TO 290
+C
+ 140 DO 150 K = 1, L
+ Z(I,K) = Z(I,K) / SCALE
+ H = H + Z(I,K) * Z(I,K)
+ 150 CONTINUE
+C
+ F = Z(I,L)
+ G = -SIGN(SQRT(H),F)
+ E(I) = SCALE * G
+ H = H - F * G
+ Z(I,L) = F - G
+ F = 0.0E0
+C
+ DO 240 J = 1, L
+ Z(J,I) = Z(I,J) / H
+ G = 0.0E0
+C .......... FORM ELEMENT OF A*U ..........
+ DO 180 K = 1, J
+ 180 G = G + Z(J,K) * Z(I,K)
+C
+ JP1 = J + 1
+ IF (L .LT. JP1) GO TO 220
+C
+ DO 200 K = JP1, L
+ 200 G = G + Z(K,J) * Z(I,K)
+C .......... FORM ELEMENT OF P ..........
+ 220 E(J) = G / H
+ F = F + E(J) * Z(I,J)
+ 240 CONTINUE
+C
+ HH = F / (H + H)
+C .......... FORM REDUCED A ..........
+ DO 260 J = 1, L
+ F = Z(I,J)
+ G = E(J) - HH * F
+ E(J) = G
+C
+ DO 260 K = 1, J
+ Z(J,K) = Z(J,K) - F * E(K) - G * Z(I,K)
+ 260 CONTINUE
+C
+ 290 D(I) = H
+ 300 CONTINUE
+C
+ 320 D(1) = 0.0E0
+ E(1) = 0.0E0
+C .......... ACCUMULATION OF TRANSFORMATION MATRICES ..........
+ DO 500 I = 1, N
+ L = I - 1
+ IF (D(I) .EQ. 0.0E0) GO TO 380
+C
+ DO 360 J = 1, L
+ G = 0.0E0
+C
+ DO 340 K = 1, L
+ 340 G = G + Z(I,K) * Z(K,J)
+C
+ DO 360 K = 1, L
+ Z(K,J) = Z(K,J) - G * Z(K,I)
+ 360 CONTINUE
+C
+ 380 D(I) = Z(I,I)
+ Z(I,I) = 1.0E0
+ IF (L .LT. 1) GO TO 500
+C
+ DO 400 J = 1, L
+ Z(I,J) = 0.0E0
+ Z(J,I) = 0.0E0
+ 400 CONTINUE
+C
+ 500 CONTINUE
+C
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/xerbla.f b/Lib/Slatec/slatec/xerbla.f
new file mode 100644
index 0000000..25316b3
--- /dev/null
+++ b/Lib/Slatec/slatec/xerbla.f
@@ -0,0 +1,55 @@
+*DECK XERBLA
+ SUBROUTINE XERBLA (SRNAME, INFO)
+C***BEGIN PROLOGUE XERBLA
+C***SUBSIDIARY
+C***PURPOSE Error handler for the Level 2 and Level 3 BLAS Routines.
+C***LIBRARY SLATEC
+C***CATEGORY R3
+C***TYPE ALL (XERBLA-A)
+C***KEYWORDS ERROR MESSAGE
+C***AUTHOR Dongarra, J. J., (ANL)
+C***DESCRIPTION
+C
+C Purpose
+C =======
+C
+C It is called by Level 2 and 3 BLAS routines if an input parameter
+C is invalid.
+C
+C Parameters
+C ==========
+C
+C SRNAME - CHARACTER*6.
+C On entry, SRNAME specifies the name of the routine which
+C called XERBLA.
+C
+C INFO - INTEGER.
+C On entry, INFO specifies the position of the invalid
+C parameter in the parameter-list of the calling routine.
+C
+C***REFERENCES (NONE)
+C***ROUTINES CALLED XERMSG
+C***REVISION HISTORY (YYMMDD)
+C 860720 DATE WRITTEN
+C 910610 Routine rewritten to serve as an interface between the
+C Level 2 and Level 3 BLAS routines and the SLATEC error
+C handler XERMSG. (BKS)
+C***END PROLOGUE XERBLA
+C
+C .. Scalar Arguments ..
+ INTEGER INFO
+ CHARACTER*6 SRNAME
+ CHARACTER*2 XERN1
+C
+C***FIRST EXECUTABLE STATEMENT XERBLA
+C
+ WRITE (XERN1, '(I2)') INFO
+ CALL XERMSG ('SLATEC', SRNAME, 'On entry to '//SRNAME//
+ $ ' parameter number '//XERN1//' had an illegal value',
+ $ INFO,1)
+C
+ RETURN
+C
+C End of XERBLA.
+C
+ END
diff --git a/Lib/Slatec/slatec/xercnt.f b/Lib/Slatec/slatec/xercnt.f
new file mode 100644
index 0000000..06c82ab
--- /dev/null
+++ b/Lib/Slatec/slatec/xercnt.f
@@ -0,0 +1,60 @@
+*DECK XERCNT
+ SUBROUTINE XERCNT (LIBRAR, SUBROU, MESSG, NERR, LEVEL, KONTRL)
+C***BEGIN PROLOGUE XERCNT
+C***SUBSIDIARY
+C***PURPOSE Allow user control over handling of errors.
+C***LIBRARY SLATEC (XERROR)
+C***CATEGORY R3C
+C***TYPE ALL (XERCNT-A)
+C***KEYWORDS ERROR, XERROR
+C***AUTHOR Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C Abstract
+C Allows user control over handling of individual errors.
+C Just after each message is recorded, but before it is
+C processed any further (i.e., before it is printed or
+C a decision to abort is made), a call is made to XERCNT.
+C If the user has provided his own version of XERCNT, he
+C can then override the value of KONTROL used in processing
+C this message by redefining its value.
+C KONTRL may be set to any value from -2 to 2.
+C The meanings for KONTRL are the same as in XSETF, except
+C that the value of KONTRL changes only for this message.
+C If KONTRL is set to a value outside the range from -2 to 2,
+C it will be moved back into that range.
+C
+C Description of Parameters
+C
+C --Input--
+C LIBRAR - the library that the routine is in.
+C SUBROU - the subroutine that XERMSG is being called from
+C MESSG - the first 20 characters of the error message.
+C NERR - same as in the call to XERMSG.
+C LEVEL - same as in the call to XERMSG.
+C KONTRL - the current value of the control flag as set
+C by a call to XSETF.
+C
+C --Output--
+C KONTRL - the new value of KONTRL. If KONTRL is not
+C defined, it will remain at its original value.
+C This changed value of control affects only
+C the current occurrence of the current message.
+C
+C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C Error-handling Package, SAND82-0800, Sandia
+C Laboratories, 1982.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790801 DATE WRITTEN
+C 861211 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900206 Routine changed from user-callable to subsidiary. (WRB)
+C 900510 Changed calling sequence to include LIBRARY and SUBROUTINE
+C names, changed routine name from XERCTL to XERCNT. (RWC)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE XERCNT
+ CHARACTER*(*) LIBRAR, SUBROU, MESSG
+C***FIRST EXECUTABLE STATEMENT XERCNT
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/xerhlt.f b/Lib/Slatec/slatec/xerhlt.f
new file mode 100644
index 0000000..a3d3ae3
--- /dev/null
+++ b/Lib/Slatec/slatec/xerhlt.f
@@ -0,0 +1,39 @@
+*DECK XERHLT
+ SUBROUTINE XERHLT (MESSG)
+C***BEGIN PROLOGUE XERHLT
+C***SUBSIDIARY
+C***PURPOSE Abort program execution and print error message.
+C***LIBRARY SLATEC (XERROR)
+C***CATEGORY R3C
+C***TYPE ALL (XERHLT-A)
+C***KEYWORDS ABORT PROGRAM EXECUTION, ERROR, XERROR
+C***AUTHOR Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C Abstract
+C ***Note*** machine dependent routine
+C XERHLT aborts the execution of the program.
+C The error message causing the abort is given in the calling
+C sequence, in case one needs it for printing on a dayfile,
+C for example.
+C
+C Description of Parameters
+C MESSG is as in XERMSG.
+C
+C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C Error-handling Package, SAND82-0800, Sandia
+C Laboratories, 1982.
+C***ROUTINES CALLED (NONE)
+C***REVISION HISTORY (YYMMDD)
+C 790801 DATE WRITTEN
+C 861211 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900206 Routine changed from user-callable to subsidiary. (WRB)
+C 900510 Changed calling sequence to delete length of character
+C and changed routine name from XERABT to XERHLT. (RWC)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE XERHLT
+ CHARACTER*(*) MESSG
+C***FIRST EXECUTABLE STATEMENT XERHLT
+ CALL SLATECBARF
+ END
diff --git a/Lib/Slatec/slatec/xermsg.f b/Lib/Slatec/slatec/xermsg.f
new file mode 100644
index 0000000..46c83ec
--- /dev/null
+++ b/Lib/Slatec/slatec/xermsg.f
@@ -0,0 +1,364 @@
+*DECK XERMSG
+ SUBROUTINE XERMSG (LIBRAR, SUBROU, MESSG, NERR, LEVEL)
+C***BEGIN PROLOGUE XERMSG
+C***PURPOSE Process error messages for SLATEC and other libraries.
+C***LIBRARY SLATEC (XERROR)
+C***CATEGORY R3C
+C***TYPE ALL (XERMSG-A)
+C***KEYWORDS ERROR MESSAGE, XERROR
+C***AUTHOR Fong, Kirby, (NMFECC at LLNL)
+C***DESCRIPTION
+C
+C XERMSG processes a diagnostic message in a manner determined by the
+C value of LEVEL and the current value of the library error control
+C flag, KONTRL. See subroutine XSETF for details.
+C
+C LIBRAR A character constant (or character variable) with the name
+C of the library. This will be 'SLATEC' for the SLATEC
+C Common Math Library. The error handling package is
+C general enough to be used by many libraries
+C simultaneously, so it is desirable for the routine that
+C detects and reports an error to identify the library name
+C as well as the routine name.
+C
+C SUBROU A character constant (or character variable) with the name
+C of the routine that detected the error. Usually it is the
+C name of the routine that is calling XERMSG. There are
+C some instances where a user callable library routine calls
+C lower level subsidiary routines where the error is
+C detected. In such cases it may be more informative to
+C supply the name of the routine the user called rather than
+C the name of the subsidiary routine that detected the
+C error.
+C
+C MESSG A character constant (or character variable) with the text
+C of the error or warning message. In the example below,
+C the message is a character constant that contains a
+C generic message.
+C
+C CALL XERMSG ('SLATEC', 'MMPY',
+C *'THE ORDER OF THE MATRIX EXCEEDS THE ROW DIMENSION',
+C *3, 1)
+C
+C It is possible (and is sometimes desirable) to generate a
+C specific message--e.g., one that contains actual numeric
+C values. Specific numeric values can be converted into
+C character strings using formatted WRITE statements into
+C character variables. This is called standard Fortran
+C internal file I/O and is exemplified in the first three
+C lines of the following example. You can also catenate
+C substrings of characters to construct the error message.
+C Here is an example showing the use of both writing to
+C an internal file and catenating character strings.
+C
+C CHARACTER*5 CHARN, CHARL
+C WRITE (CHARN,10) N
+C WRITE (CHARL,10) LDA
+C 10 FORMAT(I5)
+C CALL XERMSG ('SLATEC', 'MMPY', 'THE ORDER'//CHARN//
+C * ' OF THE MATRIX EXCEEDS ITS ROW DIMENSION OF'//
+C * CHARL, 3, 1)
+C
+C There are two subtleties worth mentioning. One is that
+C the // for character catenation is used to construct the
+C error message so that no single character constant is
+C continued to the next line. This avoids confusion as to
+C whether there are trailing blanks at the end of the line.
+C The second is that by catenating the parts of the message
+C as an actual argument rather than encoding the entire
+C message into one large character variable, we avoid
+C having to know how long the message will be in order to
+C declare an adequate length for that large character
+C variable. XERMSG calls XERPRN to print the message using
+C multiple lines if necessary. If the message is very long,
+C XERPRN will break it into pieces of 72 characters (as
+C requested by XERMSG) for printing on multiple lines.
+C Also, XERMSG asks XERPRN to prefix each line with ' * '
+C so that the total line length could be 76 characters.
+C Note also that XERPRN scans the error message backwards
+C to ignore trailing blanks. Another feature is that
+C the substring '$$' is treated as a new line sentinel
+C by XERPRN. If you want to construct a multiline
+C message without having to count out multiples of 72
+C characters, just use '$$' as a separator. '$$'
+C obviously must occur within 72 characters of the
+C start of each line to have its intended effect since
+C XERPRN is asked to wrap around at 72 characters in
+C addition to looking for '$$'.
+C
+C NERR An integer value that is chosen by the library routine's
+C author. It must be in the range -99 to 999 (three
+C printable digits). Each distinct error should have its
+C own error number. These error numbers should be described
+C in the machine readable documentation for the routine.
+C The error numbers need be unique only within each routine,
+C so it is reasonable for each routine to start enumerating
+C errors from 1 and proceeding to the next integer.
+C
+C LEVEL An integer value in the range 0 to 2 that indicates the
+C level (severity) of the error. Their meanings are
+C
+C -1 A warning message. This is used if it is not clear
+C that there really is an error, but the user's attention
+C may be needed. An attempt is made to only print this
+C message once.
+C
+C 0 A warning message. This is used if it is not clear
+C that there really is an error, but the user's attention
+C may be needed.
+C
+C 1 A recoverable error. This is used even if the error is
+C so serious that the routine cannot return any useful
+C answer. If the user has told the error package to
+C return after recoverable errors, then XERMSG will
+C return to the Library routine which can then return to
+C the user's routine. The user may also permit the error
+C package to terminate the program upon encountering a
+C recoverable error.
+C
+C 2 A fatal error. XERMSG will not return to its caller
+C after it receives a fatal error. This level should
+C hardly ever be used; it is much better to allow the
+C user a chance to recover. An example of one of the few
+C cases in which it is permissible to declare a level 2
+C error is a reverse communication Library routine that
+C is likely to be called repeatedly until it integrates
+C across some interval. If there is a serious error in
+C the input such that another step cannot be taken and
+C the Library routine is called again without the input
+C error having been corrected by the caller, the Library
+C routine will probably be called forever with improper
+C input. In this case, it is reasonable to declare the
+C error to be fatal.
+C
+C Each of the arguments to XERMSG is input; none will be modified by
+C XERMSG. A routine may make multiple calls to XERMSG with warning
+C level messages; however, after a call to XERMSG with a recoverable
+C error, the routine should return to the user. Do not try to call
+C XERMSG with a second recoverable error after the first recoverable
+C error because the error package saves the error number. The user
+C can retrieve this error number by calling another entry point in
+C the error handling package and then clear the error number when
+C recovering from the error. Calling XERMSG in succession causes the
+C old error number to be overwritten by the latest error number.
+C This is considered harmless for error numbers associated with
+C warning messages but must not be done for error numbers of serious
+C errors. After a call to XERMSG with a recoverable error, the user
+C must be given a chance to call NUMXER or XERCLR to retrieve or
+C clear the error number.
+C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C Error-handling Package, SAND82-0800, Sandia
+C Laboratories, 1982.
+C***ROUTINES CALLED FDUMP, J4SAVE, XERCNT, XERHLT, XERPRN, XERSVE
+C***REVISION HISTORY (YYMMDD)
+C 880101 DATE WRITTEN
+C 880621 REVISED AS DIRECTED AT SLATEC CML MEETING OF FEBRUARY 1988.
+C THERE ARE TWO BASIC CHANGES.
+C 1. A NEW ROUTINE, XERPRN, IS USED INSTEAD OF XERPRT TO
+C PRINT MESSAGES. THIS ROUTINE WILL BREAK LONG MESSAGES
+C INTO PIECES FOR PRINTING ON MULTIPLE LINES. '$$' IS
+C ACCEPTED AS A NEW LINE SENTINEL. A PREFIX CAN BE
+C ADDED TO EACH LINE TO BE PRINTED. XERMSG USES EITHER
+C ' ***' OR ' * ' AND LONG MESSAGES ARE BROKEN EVERY
+C 72 CHARACTERS (AT MOST) SO THAT THE MAXIMUM LINE
+C LENGTH OUTPUT CAN NOW BE AS GREAT AS 76.
+C 2. THE TEXT OF ALL MESSAGES IS NOW IN UPPER CASE SINCE THE
+C FORTRAN STANDARD DOCUMENT DOES NOT ADMIT THE EXISTENCE
+C OF LOWER CASE.
+C 880708 REVISED AFTER THE SLATEC CML MEETING OF JUNE 29 AND 30.
+C THE PRINCIPAL CHANGES ARE
+C 1. CLARIFY COMMENTS IN THE PROLOGUES
+C 2. RENAME XRPRNT TO XERPRN
+C 3. REWORK HANDLING OF '$$' IN XERPRN TO HANDLE BLANK LINES
+C SIMILAR TO THE WAY FORMAT STATEMENTS HANDLE THE /
+C CHARACTER FOR NEW RECORDS.
+C 890706 REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO
+C CLEAN UP THE CODING.
+C 890721 REVISED TO USE NEW FEATURE IN XERPRN TO COUNT CHARACTERS IN
+C PREFIX.
+C 891013 REVISED TO CORRECT COMMENTS.
+C 891214 Prologue converted to Version 4.0 format. (WRB)
+C 900510 Changed test on NERR to be -9999999 < NERR < 99999999, but
+C NERR .ne. 0, and on LEVEL to be -2 < LEVEL < 3. Added
+C LEVEL=-1 logic, changed calls to XERSAV to XERSVE, and
+C XERCTL to XERCNT. (RWC)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE XERMSG
+ CHARACTER*(*) LIBRAR, SUBROU, MESSG
+ CHARACTER*8 XLIBR, XSUBR
+ CHARACTER*72 TEMP
+ CHARACTER*20 LFIRST
+C***FIRST EXECUTABLE STATEMENT XERMSG
+ LKNTRL = J4SAVE (2, 0, .FALSE.)
+ MAXMES = J4SAVE (4, 0, .FALSE.)
+C
+C LKNTRL IS A LOCAL COPY OF THE CONTROL FLAG KONTRL.
+C MAXMES IS THE MAXIMUM NUMBER OF TIMES ANY PARTICULAR MESSAGE
+C SHOULD BE PRINTED.
+C
+C WE PRINT A FATAL ERROR MESSAGE AND TERMINATE FOR AN ERROR IN
+C CALLING XERMSG. THE ERROR NUMBER SHOULD BE POSITIVE,
+C AND THE LEVEL SHOULD BE BETWEEN 0 AND 2.
+C
+ IF (NERR.LT.-9999999 .OR. NERR.GT.99999999 .OR. NERR.EQ.0 .OR.
+ * LEVEL.LT.-1 .OR. LEVEL.GT.2) THEN
+ CALL XERPRN (' ***', -1, 'FATAL ERROR IN...$$ ' //
+ * 'XERMSG -- INVALID ERROR NUMBER OR LEVEL$$ '//
+ * 'JOB ABORT DUE TO FATAL ERROR.', 72)
+ CALL XERSVE (' ', ' ', ' ', 0, 0, 0, KDUMMY)
+ CALL XERHLT (' ***XERMSG -- INVALID INPUT')
+ RETURN
+ ENDIF
+C
+C RECORD THE MESSAGE.
+C
+ I = J4SAVE (1, NERR, .TRUE.)
+ CALL XERSVE (LIBRAR, SUBROU, MESSG, 1, NERR, LEVEL, KOUNT)
+C
+C HANDLE PRINT-ONCE WARNING MESSAGES.
+C
+ IF (LEVEL.EQ.-1 .AND. KOUNT.GT.1) RETURN
+C
+C ALLOW TEMPORARY USER OVERRIDE OF THE CONTROL FLAG.
+C
+ XLIBR = LIBRAR
+ XSUBR = SUBROU
+ LFIRST = MESSG
+ LERR = NERR
+ LLEVEL = LEVEL
+ CALL XERCNT (XLIBR, XSUBR, LFIRST, LERR, LLEVEL, LKNTRL)
+C
+ LKNTRL = MAX(-2, MIN(2,LKNTRL))
+ MKNTRL = ABS(LKNTRL)
+C
+C SKIP PRINTING IF THE CONTROL FLAG VALUE AS RESET IN XERCNT IS
+C ZERO AND THE ERROR IS NOT FATAL.
+C
+ IF (LEVEL.LT.2 .AND. LKNTRL.EQ.0) GO TO 30
+ IF (LEVEL.EQ.0 .AND. KOUNT.GT.MAXMES) GO TO 30
+ IF (LEVEL.EQ.1 .AND. KOUNT.GT.MAXMES .AND. MKNTRL.EQ.1) GO TO 30
+ IF (LEVEL.EQ.2 .AND. KOUNT.GT.MAX(1,MAXMES)) GO TO 30
+C
+C ANNOUNCE THE NAMES OF THE LIBRARY AND SUBROUTINE BY BUILDING A
+C MESSAGE IN CHARACTER VARIABLE TEMP (NOT EXCEEDING 66 CHARACTERS)
+C AND SENDING IT OUT VIA XERPRN. PRINT ONLY IF CONTROL FLAG
+C IS NOT ZERO.
+C
+ IF (LKNTRL .NE. 0) THEN
+ TEMP(1:21) = 'MESSAGE FROM ROUTINE '
+ I = MIN(LEN(SUBROU), 16)
+ TEMP(22:21+I) = SUBROU(1:I)
+ TEMP(22+I:33+I) = ' IN LIBRARY '
+ LTEMP = 33 + I
+ I = MIN(LEN(LIBRAR), 16)
+ TEMP(LTEMP+1:LTEMP+I) = LIBRAR (1:I)
+ TEMP(LTEMP+I+1:LTEMP+I+1) = '.'
+ LTEMP = LTEMP + I + 1
+ CALL XERPRN (' ***', -1, TEMP(1:LTEMP), 72)
+ ENDIF
+C
+C IF LKNTRL IS POSITIVE, PRINT AN INTRODUCTORY LINE BEFORE
+C PRINTING THE MESSAGE. THE INTRODUCTORY LINE TELLS THE CHOICE
+C FROM EACH OF THE FOLLOWING THREE OPTIONS.
+C 1. LEVEL OF THE MESSAGE
+C 'INFORMATIVE MESSAGE'
+C 'POTENTIALLY RECOVERABLE ERROR'
+C 'FATAL ERROR'
+C 2. WHETHER CONTROL FLAG WILL ALLOW PROGRAM TO CONTINUE
+C 'PROG CONTINUES'
+C 'PROG ABORTED'
+C 3. WHETHER OR NOT A TRACEBACK WAS REQUESTED. (THE TRACEBACK
+C MAY NOT BE IMPLEMENTED AT SOME SITES, SO THIS ONLY TELLS
+C WHAT WAS REQUESTED, NOT WHAT WAS DELIVERED.)
+C 'TRACEBACK REQUESTED'
+C 'TRACEBACK NOT REQUESTED'
+C NOTICE THAT THE LINE INCLUDING FOUR PREFIX CHARACTERS WILL NOT
+C EXCEED 74 CHARACTERS.
+C WE SKIP THE NEXT BLOCK IF THE INTRODUCTORY LINE IS NOT NEEDED.
+C
+ IF (LKNTRL .GT. 0) THEN
+C
+C THE FIRST PART OF THE MESSAGE TELLS ABOUT THE LEVEL.
+C
+ IF (LEVEL .LE. 0) THEN
+ TEMP(1:20) = 'INFORMATIVE MESSAGE,'
+ LTEMP = 20
+ ELSEIF (LEVEL .EQ. 1) THEN
+ TEMP(1:30) = 'POTENTIALLY RECOVERABLE ERROR,'
+ LTEMP = 30
+ ELSE
+ TEMP(1:12) = 'FATAL ERROR,'
+ LTEMP = 12
+ ENDIF
+C
+C THEN WHETHER THE PROGRAM WILL CONTINUE.
+C
+ IF ((MKNTRL.EQ.2 .AND. LEVEL.GE.1) .OR.
+ * (MKNTRL.EQ.1 .AND. LEVEL.EQ.2)) THEN
+ TEMP(LTEMP+1:LTEMP+14) = ' PROG ABORTED,'
+ LTEMP = LTEMP + 14
+ ELSE
+ TEMP(LTEMP+1:LTEMP+16) = ' PROG CONTINUES,'
+ LTEMP = LTEMP + 16
+ ENDIF
+C
+C FINALLY TELL WHETHER THERE SHOULD BE A TRACEBACK.
+C
+ IF (LKNTRL .GT. 0) THEN
+ TEMP(LTEMP+1:LTEMP+20) = ' TRACEBACK REQUESTED'
+ LTEMP = LTEMP + 20
+ ELSE
+ TEMP(LTEMP+1:LTEMP+24) = ' TRACEBACK NOT REQUESTED'
+ LTEMP = LTEMP + 24
+ ENDIF
+ CALL XERPRN (' ***', -1, TEMP(1:LTEMP), 72)
+ ENDIF
+C
+C NOW SEND OUT THE MESSAGE.
+C
+ CALL XERPRN (' * ', -1, MESSG, 72)
+C
+C IF LKNTRL IS POSITIVE, WRITE THE ERROR NUMBER AND REQUEST A
+C TRACEBACK.
+C
+ IF (LKNTRL .GT. 0) THEN
+ WRITE (TEMP, '(''ERROR NUMBER = '', I8)') NERR
+ DO 10 I=16,22
+ IF (TEMP(I:I) .NE. ' ') GO TO 20
+ 10 CONTINUE
+C
+ 20 CALL XERPRN (' * ', -1, TEMP(1:15) // TEMP(I:23), 72)
+ CALL FDUMP
+ ENDIF
+C
+C IF LKNTRL IS NOT ZERO, PRINT A BLANK LINE AND AN END OF MESSAGE.
+C
+ IF (LKNTRL .NE. 0) THEN
+ CALL XERPRN (' * ', -1, ' ', 72)
+ CALL XERPRN (' ***', -1, 'END OF MESSAGE', 72)
+ CALL XERPRN (' ', 0, ' ', 72)
+ ENDIF
+C
+C IF THE ERROR IS NOT FATAL OR THE ERROR IS RECOVERABLE AND THE
+C CONTROL FLAG IS SET FOR RECOVERY, THEN RETURN.
+C
+ 30 IF (LEVEL.LE.0 .OR. (LEVEL.EQ.1 .AND. MKNTRL.LE.1)) RETURN
+C
+C THE PROGRAM WILL BE STOPPED DUE TO AN UNRECOVERED ERROR OR A
+C FATAL ERROR. PRINT THE REASON FOR THE ABORT AND THE ERROR
+C SUMMARY IF THE CONTROL FLAG AND THE MAXIMUM ERROR COUNT PERMIT.
+C
+ IF (LKNTRL.GT.0 .AND. KOUNT.LT.MAX(1,MAXMES)) THEN
+ IF (LEVEL .EQ. 1) THEN
+ CALL XERPRN
+ * (' ***', -1, 'JOB ABORT DUE TO UNRECOVERED ERROR.', 72)
+ ELSE
+ CALL XERPRN(' ***', -1, 'JOB ABORT DUE TO FATAL ERROR.', 72)
+ ENDIF
+ CALL XERSVE (' ', ' ', ' ', -1, 0, 0, KDUMMY)
+ CALL XERHLT (' ')
+ ELSE
+ CALL XERHLT (MESSG)
+ ENDIF
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/xerprn.f b/Lib/Slatec/slatec/xerprn.f
new file mode 100644
index 0000000..97eedf4
--- /dev/null
+++ b/Lib/Slatec/slatec/xerprn.f
@@ -0,0 +1,228 @@
+*DECK XERPRN
+ SUBROUTINE XERPRN (PREFIX, NPREF, MESSG, NWRAP)
+C***BEGIN PROLOGUE XERPRN
+C***SUBSIDIARY
+C***PURPOSE Print error messages processed by XERMSG.
+C***LIBRARY SLATEC (XERROR)
+C***CATEGORY R3C
+C***TYPE ALL (XERPRN-A)
+C***KEYWORDS ERROR MESSAGES, PRINTING, XERROR
+C***AUTHOR Fong, Kirby, (NMFECC at LLNL)
+C***DESCRIPTION
+C
+C This routine sends one or more lines to each of the (up to five)
+C logical units to which error messages are to be sent. This routine
+C is called several times by XERMSG, sometimes with a single line to
+C print and sometimes with a (potentially very long) message that may
+C wrap around into multiple lines.
+C
+C PREFIX Input argument of type CHARACTER. This argument contains
+C characters to be put at the beginning of each line before
+C the body of the message. No more than 16 characters of
+C PREFIX will be used.
+C
+C NPREF Input argument of type INTEGER. This argument is the number
+C of characters to use from PREFIX. If it is negative, the
+C intrinsic function LEN is used to determine its length. If
+C it is zero, PREFIX is not used. If it exceeds 16 or if
+C LEN(PREFIX) exceeds 16, only the first 16 characters will be
+C used. If NPREF is positive and the length of PREFIX is less
+C than NPREF, a copy of PREFIX extended with blanks to length
+C NPREF will be used.
+C
+C MESSG Input argument of type CHARACTER. This is the text of a
+C message to be printed. If it is a long message, it will be
+C broken into pieces for printing on multiple lines. Each line
+C will start with the appropriate prefix and be followed by a
+C piece of the message. NWRAP is the number of characters per
+C piece; that is, after each NWRAP characters, we break and
+C start a new line. In addition the characters '$$' embedded
+C in MESSG are a sentinel for a new line. The counting of
+C characters up to NWRAP starts over for each new line. The
+C value of NWRAP typically used by XERMSG is 72 since many
+C older error messages in the SLATEC Library are laid out to
+C rely on wrap-around every 72 characters.
+C
+C NWRAP Input argument of type INTEGER. This gives the maximum size
+C piece into which to break MESSG for printing on multiple
+C lines. An embedded '$$' ends a line, and the count restarts
+C at the following character. If a line break does not occur
+C on a blank (it would split a word) that word is moved to the
+C next line. Values of NWRAP less than 16 will be treated as
+C 16. Values of NWRAP greater than 132 will be treated as 132.
+C The actual line length will be NPREF + NWRAP after NPREF has
+C been adjusted to fall between 0 and 16 and NWRAP has been
+C adjusted to fall between 16 and 132.
+C
+C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C Error-handling Package, SAND82-0800, Sandia
+C Laboratories, 1982.
+C***ROUTINES CALLED I1MACH, XGETUA
+C***REVISION HISTORY (YYMMDD)
+C 880621 DATE WRITTEN
+C 880708 REVISED AFTER THE SLATEC CML SUBCOMMITTEE MEETING OF
+C JUNE 29 AND 30 TO CHANGE THE NAME TO XERPRN AND TO REWORK
+C THE HANDLING OF THE NEW LINE SENTINEL TO BEHAVE LIKE THE
+C SLASH CHARACTER IN FORMAT STATEMENTS.
+C 890706 REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO
+C STREAMLINE THE CODING AND FIX A BUG THAT CAUSED EXTRA BLANK
+C LINES TO BE PRINTED.
+C 890721 REVISED TO ADD A NEW FEATURE. A NEGATIVE VALUE OF NPREF
+C CAUSES LEN(PREFIX) TO BE USED AS THE LENGTH.
+C 891013 REVISED TO CORRECT ERROR IN CALCULATING PREFIX LENGTH.
+C 891214 Prologue converted to Version 4.0 format. (WRB)
+C 900510 Added code to break messages between words. (RWC)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE XERPRN
+ CHARACTER*(*) PREFIX, MESSG
+ INTEGER NPREF, NWRAP
+ CHARACTER*148 CBUFF
+ INTEGER IU(5), NUNIT
+ CHARACTER*2 NEWLIN
+ PARAMETER (NEWLIN = '$$')
+C***FIRST EXECUTABLE STATEMENT XERPRN
+ CALL XGETUA(IU,NUNIT)
+C
+C A ZERO VALUE FOR A LOGICAL UNIT NUMBER MEANS TO USE THE STANDARD
+C ERROR MESSAGE UNIT INSTEAD. I1MACH(4) RETRIEVES THE STANDARD
+C ERROR MESSAGE UNIT.
+C
+ N = I1MACH(4)
+ DO 10 I=1,NUNIT
+ IF (IU(I) .EQ. 0) IU(I) = N
+ 10 CONTINUE
+C
+C LPREF IS THE LENGTH OF THE PREFIX. THE PREFIX IS PLACED AT THE
+C BEGINNING OF CBUFF, THE CHARACTER BUFFER, AND KEPT THERE DURING
+C THE REST OF THIS ROUTINE.
+C
+ IF ( NPREF .LT. 0 ) THEN
+ LPREF = LEN(PREFIX)
+ ELSE
+ LPREF = NPREF
+ ENDIF
+ LPREF = MIN(16, LPREF)
+ IF (LPREF .NE. 0) CBUFF(1:LPREF) = PREFIX
+C
+C LWRAP IS THE MAXIMUM NUMBER OF CHARACTERS WE WANT TO TAKE AT ONE
+C TIME FROM MESSG TO PRINT ON ONE LINE.
+C
+ LWRAP = MAX(16, MIN(132, NWRAP))
+C
+C SET LENMSG TO THE LENGTH OF MESSG, IGNORE ANY TRAILING BLANKS.
+C
+ LENMSG = LEN(MESSG)
+ N = LENMSG
+ DO 20 I=1,N
+ IF (MESSG(LENMSG:LENMSG) .NE. ' ') GO TO 30
+ LENMSG = LENMSG - 1
+ 20 CONTINUE
+ 30 CONTINUE
+C
+C IF THE MESSAGE IS ALL BLANKS, THEN PRINT ONE BLANK LINE.
+C
+ IF (LENMSG .EQ. 0) THEN
+ CBUFF(LPREF+1:LPREF+1) = ' '
+ DO 40 I=1,NUNIT
+ WRITE(IU(I), '(A)') CBUFF(1:LPREF+1)
+ 40 CONTINUE
+ RETURN
+ ENDIF
+C
+C SET NEXTC TO THE POSITION IN MESSG WHERE THE NEXT SUBSTRING
+C STARTS. FROM THIS POSITION WE SCAN FOR THE NEW LINE SENTINEL.
+C WHEN NEXTC EXCEEDS LENMSG, THERE IS NO MORE TO PRINT.
+C WE LOOP BACK TO LABEL 50 UNTIL ALL PIECES HAVE BEEN PRINTED.
+C
+C WE LOOK FOR THE NEXT OCCURRENCE OF THE NEW LINE SENTINEL. THE
+C INDEX INTRINSIC FUNCTION RETURNS ZERO IF THERE IS NO OCCURRENCE
+C OR IF THE LENGTH OF THE FIRST ARGUMENT IS LESS THAN THE LENGTH
+C OF THE SECOND ARGUMENT.
+C
+C THERE ARE SEVERAL CASES WHICH SHOULD BE CHECKED FOR IN THE
+C FOLLOWING ORDER. WE ARE ATTEMPTING TO SET LPIECE TO THE NUMBER
+C OF CHARACTERS THAT SHOULD BE TAKEN FROM MESSG STARTING AT
+C POSITION NEXTC.
+C
+C LPIECE .EQ. 0 THE NEW LINE SENTINEL DOES NOT OCCUR IN THE
+C REMAINDER OF THE CHARACTER STRING. LPIECE
+C SHOULD BE SET TO LWRAP OR LENMSG+1-NEXTC,
+C WHICHEVER IS LESS.
+C
+C LPIECE .EQ. 1 THE NEW LINE SENTINEL STARTS AT MESSG(NEXTC:
+C NEXTC). LPIECE IS EFFECTIVELY ZERO, AND WE
+C PRINT NOTHING TO AVOID PRODUCING UNNECESSARY
+C BLANK LINES. THIS TAKES CARE OF THE SITUATION
+C WHERE THE LIBRARY ROUTINE HAS A MESSAGE OF
+C EXACTLY 72 CHARACTERS FOLLOWED BY A NEW LINE
+C SENTINEL FOLLOWED BY MORE CHARACTERS. NEXTC
+C SHOULD BE INCREMENTED BY 2.
+C
+C LPIECE .GT. LWRAP+1 REDUCE LPIECE TO LWRAP.
+C
+C ELSE THIS LAST CASE MEANS 2 .LE. LPIECE .LE. LWRAP+1
+C RESET LPIECE = LPIECE-1. NOTE THAT THIS
+C PROPERLY HANDLES THE END CASE WHERE LPIECE .EQ.
+C LWRAP+1. THAT IS, THE SENTINEL FALLS EXACTLY
+C AT THE END OF A LINE.
+C
+ NEXTC = 1
+ 50 LPIECE = INDEX(MESSG(NEXTC:LENMSG), NEWLIN)
+ IF (LPIECE .EQ. 0) THEN
+C
+C THERE WAS NO NEW LINE SENTINEL FOUND.
+C
+ IDELTA = 0
+ LPIECE = MIN(LWRAP, LENMSG+1-NEXTC)
+ IF (LPIECE .LT. LENMSG+1-NEXTC) THEN
+ DO 52 I=LPIECE+1,2,-1
+ IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN
+ LPIECE = I-1
+ IDELTA = 1
+ GOTO 54
+ ENDIF
+ 52 CONTINUE
+ ENDIF
+ 54 CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
+ NEXTC = NEXTC + LPIECE + IDELTA
+ ELSEIF (LPIECE .EQ. 1) THEN
+C
+C WE HAVE A NEW LINE SENTINEL AT MESSG(NEXTC:NEXTC+1).
+C DON'T PRINT A BLANK LINE.
+C
+ NEXTC = NEXTC + 2
+ GO TO 50
+ ELSEIF (LPIECE .GT. LWRAP+1) THEN
+C
+C LPIECE SHOULD BE SET DOWN TO LWRAP.
+C
+ IDELTA = 0
+ LPIECE = LWRAP
+ DO 56 I=LPIECE+1,2,-1
+ IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN
+ LPIECE = I-1
+ IDELTA = 1
+ GOTO 58
+ ENDIF
+ 56 CONTINUE
+ 58 CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
+ NEXTC = NEXTC + LPIECE + IDELTA
+ ELSE
+C
+C IF WE ARRIVE HERE, IT MEANS 2 .LE. LPIECE .LE. LWRAP+1.
+C WE SHOULD DECREMENT LPIECE BY ONE.
+C
+ LPIECE = LPIECE - 1
+ CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
+ NEXTC = NEXTC + LPIECE + 2
+ ENDIF
+C
+C PRINT
+C
+ DO 60 I=1,NUNIT
+ WRITE(IU(I), '(A)') CBUFF(1:LPREF+LPIECE)
+ 60 CONTINUE
+C
+ IF (NEXTC .LE. LENMSG) GO TO 50
+ RETURN
+ END
diff --git a/Lib/Slatec/slatec/xersve.f b/Lib/Slatec/slatec/xersve.f
new file mode 100644
index 0000000..6bd2a4f
--- /dev/null
+++ b/Lib/Slatec/slatec/xersve.f
@@ -0,0 +1,155 @@
+*DECK XERSVE
+ SUBROUTINE XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL,
+ + ICOUNT)
+C***BEGIN PROLOGUE XERSVE
+C***SUBSIDIARY
+C***PURPOSE Record that an error has occurred.
+C***LIBRARY SLATEC (XERROR)
+C***CATEGORY R3
+C***TYPE ALL (XERSVE-A)
+C***KEYWORDS ERROR, XERROR
+C***AUTHOR Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C *Usage:
+C
+C INTEGER KFLAG, NERR, LEVEL, ICOUNT
+C CHARACTER * (len) LIBRAR, SUBROU, MESSG
+C
+C CALL XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL, ICOUNT)
+C
+C *Arguments:
+C
+C LIBRAR :IN is the library that the message is from.
+C SUBROU :IN is the subroutine that the message is from.
+C MESSG :IN is the message to be saved.
+C KFLAG :IN indicates the action to be performed.
+C when KFLAG > 0, the message in MESSG is saved.
+C when KFLAG=0 the tables will be dumped and
+C cleared.
+C when KFLAG < 0, the tables will be dumped and
+C not cleared.
+C NERR :IN is the error number.
+C LEVEL :IN is the error severity.
+C ICOUNT :OUT the number of times this message has been seen,
+C or zero if the table has overflowed and does not
+C contain this message specifically. When KFLAG=0,
+C ICOUNT will not be altered.
+C
+C *Description:
+C
+C Record that this error occurred and possibly dump and clear the
+C tables.
+C
+C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C Error-handling Package, SAND82-0800, Sandia
+C Laboratories, 1982.
+C***ROUTINES CALLED I1MACH, XGETUA
+C***REVISION HISTORY (YYMMDD)
+C 800319 DATE WRITTEN
+C 861211 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 900413 Routine modified to remove reference to KFLAG. (WRB)
+C 900510 Changed to add LIBRARY NAME and SUBROUTINE to calling
+C sequence, use IF-THEN-ELSE, make number of saved entries
+C easily changeable, changed routine name from XERSAV to
+C XERSVE. (RWC)
+C 910626 Added LIBTAB and SUBTAB to SAVE statement. (BKS)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE XERSVE
+ PARAMETER (LENTAB=10)
+ INTEGER LUN(5)
+ CHARACTER*(*) LIBRAR, SUBROU, MESSG
+ CHARACTER*8 LIBTAB(LENTAB), SUBTAB(LENTAB), LIB, SUB
+ CHARACTER*20 MESTAB(LENTAB), MES
+ DIMENSION NERTAB(LENTAB), LEVTAB(LENTAB), KOUNT(LENTAB)
+ SAVE LIBTAB, SUBTAB, MESTAB, NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG
+ DATA KOUNTX/0/, NMSG/0/
+C***FIRST EXECUTABLE STATEMENT XERSVE
+C
+ IF (KFLAG.LE.0) THEN
+C
+C Dump the table.
+C
+ IF (NMSG.EQ.0) RETURN
+C
+C Print to each unit.
+C
+ CALL XGETUA (LUN, NUNIT)
+ DO 20 KUNIT = 1,NUNIT
+ IUNIT = LUN(KUNIT)
+ IF (IUNIT.EQ.0) IUNIT = I1MACH(4)
+C
+C Print the table header.
+C
+ WRITE (IUNIT,9000)
+C
+C Print body of table.
+C
+ DO 10 I = 1,NMSG
+ WRITE (IUNIT,9010) LIBTAB(I), SUBTAB(I), MESTAB(I),
+ * NERTAB(I),LEVTAB(I),KOUNT(I)
+ 10 CONTINUE
+C
+C Print number of other errors.
+C
+ IF (KOUNTX.NE.0) WRITE (IUNIT,9020) KOUNTX
+ WRITE (IUNIT,9030)
+ 20 CONTINUE
+C
+C Clear the error tables.
+C
+ IF (KFLAG.EQ.0) THEN
+ NMSG = 0
+ KOUNTX = 0
+ ENDIF
+ ELSE
+C
+C PROCESS A MESSAGE...
+C SEARCH FOR THIS MESSG, OR ELSE AN EMPTY SLOT FOR THIS MESSG,
+C OR ELSE DETERMINE THAT THE ERROR TABLE IS FULL.
+C
+ LIB = LIBRAR
+ SUB = SUBROU
+ MES = MESSG
+ DO 30 I = 1,NMSG
+ IF (LIB.EQ.LIBTAB(I) .AND. SUB.EQ.SUBTAB(I) .AND.
+ * MES.EQ.MESTAB(I) .AND. NERR.EQ.NERTAB(I) .AND.
+ * LEVEL.EQ.LEVTAB(I)) THEN
+ KOUNT(I) = KOUNT(I) + 1
+ ICOUNT = KOUNT(I)
+ RETURN
+ ENDIF
+ 30 CONTINUE
+C
+ IF (NMSG.LT.LENTAB) THEN
+C
+C Empty slot found for new message.
+C
+ NMSG = NMSG + 1
+ LIBTAB(I) = LIB
+ SUBTAB(I) = SUB
+ MESTAB(I) = MES
+ NERTAB(I) = NERR
+ LEVTAB(I) = LEVEL
+ KOUNT (I) = 1
+ ICOUNT = 1
+ ELSE
+C
+C Table is full.
+C
+ KOUNTX = KOUNTX+1
+ ICOUNT = 0
+ ENDIF
+ ENDIF
+ RETURN
+C
+C Formats.
+C
+ 9000 FORMAT ('0 ERROR MESSAGE SUMMARY' /
+ + ' LIBRARY SUBROUTINE MESSAGE START NERR',
+ + ' LEVEL COUNT')
+ 9010 FORMAT (1X,A,3X,A,3X,A,3I10)
+ 9020 FORMAT ('0OTHER ERRORS NOT INDIVIDUALLY TABULATED = ', I10)
+ 9030 FORMAT (1X)
+ END
diff --git a/Lib/Slatec/slatec/xgetua.f b/Lib/Slatec/slatec/xgetua.f
new file mode 100644
index 0000000..2e7db02
--- /dev/null
+++ b/Lib/Slatec/slatec/xgetua.f
@@ -0,0 +1,51 @@
+*DECK XGETUA
+ SUBROUTINE XGETUA (IUNITA, N)
+C***BEGIN PROLOGUE XGETUA
+C***PURPOSE Return unit number(s) to which error messages are being
+C sent.
+C***LIBRARY SLATEC (XERROR)
+C***CATEGORY R3C
+C***TYPE ALL (XGETUA-A)
+C***KEYWORDS ERROR, XERROR
+C***AUTHOR Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C Abstract
+C XGETUA may be called to determine the unit number or numbers
+C to which error messages are being sent.
+C These unit numbers may have been set by a call to XSETUN,
+C or a call to XSETUA, or may be a default value.
+C
+C Description of Parameters
+C --Output--
+C IUNIT - an array of one to five unit numbers, depending
+C on the value of N. A value of zero refers to the
+C default unit, as defined by the I1MACH machine
+C constant routine. Only IUNIT(1),...,IUNIT(N) are
+C defined by XGETUA. The values of IUNIT(N+1),...,
+C IUNIT(5) are not defined (for N .LT. 5) or altered
+C in any way by XGETUA.
+C N - the number of units to which copies of the
+C error messages are being sent. N will be in the
+C range from 1 to 5.
+C
+C***REFERENCES R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C Error-handling Package, SAND82-0800, Sandia
+C Laboratories, 1982.
+C***ROUTINES CALLED J4SAVE
+C***REVISION HISTORY (YYMMDD)
+C 790801 DATE WRITTEN
+C 861211 REVISION DATE from Version 3.2
+C 891214 Prologue converted to Version 4.0 format. (BAB)
+C 920501 Reformatted the REFERENCES section. (WRB)
+C***END PROLOGUE XGETUA
+ DIMENSION IUNITA(5)
+C***FIRST EXECUTABLE STATEMENT XGETUA
+ N = J4SAVE(5,0,.FALSE.)
+ DO 30 I=1,N
+ INDEX = I+4
+ IF (I.EQ.1) INDEX = 3
+ IUNITA(I) = J4SAVE(INDEX,0,.FALSE.)
+ 30 CONTINUE
+ RETURN
+ END
diff --git a/Lib/Transform/Cartography/Cartography.pm b/Lib/Transform/Cartography/Cartography.pm
new file mode 100644
index 0000000..da7abb5
--- /dev/null
+++ b/Lib/Transform/Cartography/Cartography.pm
@@ -0,0 +1,2935 @@
+=head1 NAME
+
+PDL::Transform::Cartography - Useful cartographic projections
+
+=head1 SYNOPSIS
+
+ # make a Mercator map of Earth
+ use PDL::Transform::Cartography;
+ $a = earth_coast();
+ $a = graticule(10,2)->glue(1,$a);
+ $t = t_mercator;
+ $w = pgwin(xs);
+ $w->lines($t->apply($a)->clean_lines());
+
+=head1 DESCRIPTION
+
+PDL::Transform::Cartography includes a variety of useful cartographic
+and observing projections (mappings of the surface of a sphere),
+including reprojected observer coordinates. See L<PDL::Transform>
+for more information about image transforms in general.
+
+Cartographic transformations are used for projecting not just
+terrestrial maps, but also any nearly spherical surface including the
+Sun, the Celestial sphere, various moons and planets, distant stars,
+etc. They also are useful for interpreting scientific images, which
+are themselves generally projections of a sphere onto a flat focal
+plane (e.g. the L<t_gnomonic|/t_gnomonic> projection).
+
+Unless otherwise noted, all the transformations in this file convert
+from (theta,phi) coordinates on the unit sphere (e.g. (lon,lat) on a
+planet or (RA,dec) on the celestial sphere) into some sort of
+projected coordinates, and have inverse transformations that convert
+back to (theta,phi). This is equivalent to working from the
+equidistant cylindrical (or L<"plate caree"|/t_caree>) projection, if
+you are a cartography wonk.
+
+The projected coordinates are generally in units of body radii
+(radians), so that multiplying the output by the scale of the map
+yields physical units that are correct wherever the scale is correct
+for that projection. For example, areas should be correct everywhere
+in the authalic projections; and linear scales are correct along
+meridians in the equidistant projections and along the standard
+parallels in all the projections.
+
+The transformations that are authalic (equal-area), conformal
+(equal-angle), azimuthal (circularly symmetric), or perspective (true
+perspective on a focal plane from some viewpoint) are marked. The
+first two categories are mutually exclusive for all but the
+L<"unit sphere"|/t_unit_sphere> 3-D projection.
+
+Extra dimensions tacked on to each point to be transformed are, in
+general, ignored. That is so that you can add on an extra index
+to keep track of pen color. For example, L<earth_coast|/earth_coast>
+returns a 3x<n> piddle containing (lon, lat, pen) at each list location.
+Transforming the vector list retains the pen value as the first index
+after the dimensional directions.
+
+=head1 GENERAL NOTES ON CARTOGRAPHY
+
+Unless otherwise noted, the transformations and miscellaneous
+information in this section are taken from Snyder & Voxland 1989: "An
+Album of Map Projections", US Geological Survey Professional Paper
+1453, US Printing Office (Denver); and from Snyder 1987: "Map
+Projections - A Working Manual", US Geological Survey Professional
+Paper 1395, US Printing Office (Denver, USA). You can obtain your own
+copy of both by contacting the U.S. Geological Survey, Federal Center,
+Box 25425, Denver, CO 80225 USA.
+
+The mathematics of cartography have a long history, and the details
+are far trickier than the broad overview. For terrestrial (and, in
+general, planetary) cartography, the best reference datum is not a
+sphere but an oblate ellipsoid due to centrifugal force from the
+planet's rotation. Furthermore, because all rocky planets, including
+Earth, have randomly placed mass concentrations that affect the
+gravitational field, the reference gravitational isosurface (sea level
+on Earth) is even more complex than an ellipsoid and, in general,
+different ellipsoids have been used for different locations at the
+same time and for the same location at different times.
+
+The transformations in this package use a spherical datum and hence
+include global distortion at about the 0.5% level for terrestrial maps
+(Earth's oblateness is ~1/300). This is roughly equal to the
+dimensional precision of physical maps printed on paper (due to
+stretching and warping of the paper) but is significant at larger
+scales (e.g. for regional maps). If you need more precision than
+that, you will want to implement and use the ellipsoidal
+transformations from Snyder 1987 or another reference work on geodesy.
+A good name for that package would be C<...::Cartography::Geodetic>.
+
+=head1 GENERAL NOTES ON PERSPECTIVE AND SCIENTIFIC IMAGES
+
+Cartographic transformations are useful for interpretation of
+scientific images, as all cameras produce projections of the celestial
+sphere onto the focal plane of the camera. A simple (single-element)
+optical system with a planar focal plane generates
+L<gnomonic|/t_gnomonic> images -- that is to say, gnomonic projections
+of a portion of the celestial sphere near the paraxial direction.
+This is the projection that most consumer grade cameras produce.
+
+Magnification in an optical system changes the angle of incidence
+of the rays on the focal plane for a given angle of incidence at the
+aperture. For example, a 10x telescope with a 2 degree field of view
+exhibits the same gnomonic distortion as a simple optical system with
+a 20 degree field of view. Wide-angle optics typically have magnification
+less than 1 ('fisheye lenses'), reducing the gnomonic distortion
+considerably but introducing L<"equidistant azimuthal"|/t_az_eqd> distortion --
+there's no such thing as a free lunch!
+
+Because many solar-system objects are spherical,
+PDL::Transform::Cartography includes perspective projections for
+producing maps of spherical bodies from perspective views. Those
+projections are L<"t_vertical"|/t_vertical> and
+L<"t_perspective"|/t_perspective>. They map between (lat,lon) on the
+spherical body and planar projected coordinates at the viewpoint.
+L<"t_vertical"|/t_vertical> is the vertical perspective projection
+given by Snyder, but L<"t_perspective"|/t_perspective> is a fully
+general perspective projection that also handles magnification correction.
+
+=head1 TRANSVERSE & OBLIQUE PROJECTIONS; STANDARD OPTIONS
+
+Oblique projections rotate the sphere (and graticule) to an arbitrary
+angle before generating the projection; transverse projections rotate
+the sphere exactly 90 degrees before generating the projection.
+
+Most of the projections accept the following standard options,
+useful for making transverse and oblique projection maps.
+
+=over 3
+
+=item o, origin, Origin [default (0,0,0)]
+
+The origin of the oblique map coordinate system, in (old-theta, old-phi)
+coordinates.
+
+=item r, roll, Roll [default 0.0]
+
+The roll angle of the sphere about the origin, measured CW from (N = up)
+for reasonable values of phi and CW from (S = up) for unreasonable
+values of phi. This is equivalent to observer roll angle CCW from the
+same direction.
+
+=item u, unit, Unit [default 'degree']
+
+This is the name of the angular unit to use in the lon/lat coordinate system.
+
+=item b, B
+
+The "B" angle of the body -- used for extraterrestrial maps. Setting
+this parameter is exactly equivalent to setting the phi component
+of the origin, and in fact overrides it.
+
+=item l,L
+
+The longitude of the central meridian as observed -- used for extraterrestrial
+maps. Setting this parameter is exactly equivalent to setting the theta
+component of the origin, and in fact overrides it.
+
+=item p,P
+
+The "P" (or position) angle of the body -- used for extraterrestrial maps.
+This parameter is a synonym for the roll angle, above.
+
+=item bad, Bad, missing, Missing [default nan]
+
+This is the value that missing points get. Mainly useful for the
+inverse transforms. (This should work fine if set to BAD, if you have
+bad-value support compiled in). The default nan is asin(1.2), calculated
+at load time.
+
+=back
+
+=head1 EXAMPLES
+
+Draw a Mercator map of the world on-screen:
+
+ $w = pgwin(xs);
+ $w->lines(earth_coast->apply(t_mercator)->clean_lines);
+
+Here, C<earth_coast()> returns a 3xn piddle containing (lon, lat, pen)
+values for the included world coastal outline; C<t_mercator> converts
+the values to projected Mercator coordinates, and C<clean_lines> breaks
+lines that cross the 180th meridian.
+
+Draw a Mercator map of the world, with lon/lat at 10 degree intervals:
+
+ $w = pgwin(xs)
+ $a = earth_coast()->glue(1,graticule(10,1));
+ $w->lines($a->apply(t_mercator)->clean_lines);
+
+This works just the same as the first example, except that a map graticule
+has been applied with interline spacing of 10 degrees lon/lat and
+inter-vertex spacing of 1 degree (so that each meridian contains 181 points,
+and each parallel contains 361 points).
+
+=head1 NOTES
+
+Currently angular conversions are rather simpleminded. A list of
+common conversions is present in the main constructor, which inserts a
+conversion constant to radians into the {params} field of the new
+transform. Something like Math::Convert::Units should be used instead
+to generate the conversion constant.
+
+A cleaner higher-level interface is probably needed (see the examples);
+for example, earth_coast could return a graticule if asked, instead of
+needing one to be glued on.
+
+The class structure is somewhat messy because of the varying needs of
+the different transformations. PDL::Transform::Cartography is a base
+class that interprets the origin options and sets up the basic
+machinery of the Transform. The conic projections have their
+own subclass, PDL::Transform::Conic, that interprets the standard
+parallels. Since the cylindrical and azimuthal projections are pretty
+simple, they are not subclassed.
+
+The perl 5.6.1 compiler is quite slow at adding new classes to the
+structure, so it does not makes sense to subclass new transformations
+merely for the sake of pedantry.
+
+=head1 AUTHOR
+
+Copyright 2002, Craig DeForest (deforest at boulder.swri.edu). This
+module may be modified and distributed under the same terms as PDL
+itself. The module comes with NO WARRANTY.
+
+The included digital world map is derived from the 1987 CIA World Map,
+translated to ASCII in 1988 by Joe Dellinger (geojoe at freeusp.org) and
+simplified in 1995 by Kirk Johnson (tuna at indra.com) for the program
+XEarth. The map comes with NO WARRANTY. An ASCII version of the map,
+and a sample PDL function to read it, may be found in the Demos
+subdirectory of the PDL source distribution.
+
+=head1 FUNCTIONS
+
+The module exports both transform constructors ('t_<foo>') and some
+auxiliary functions (no leading 't_').
+
+=cut
+
+# Import PDL::Transform into the calling package -- the cartography
+# stuff isn't much use without it.
+use PDL::Transform;
+
+package PDL::Transform::Cartography;
+use PDL::Core ':Internal'; # Load 'topdl' (internal routine)
+
+ at ISA = ( 'Exporter','PDL::Transform' );
+our $VERSION = "0.6";
+$VERSION = eval $VERSION;
+
+BEGIN {
+ use Exporter ();
+ @EXPORT_OK = qw(graticule earth_image earth_coast clean_lines t_unit_sphere t_orthographic t_rot_sphere t_caree t_mercator t_utm t_sin_lat t_sinusoidal t_conic t_albers t_lambert t_stereographic t_gnomonic t_az_eqd t_az_eqa t_vertical t_perspective t_hammer t_aitoff);
+ @EXPORT = @EXPORT_OK;
+ %EXPORT_TAGS = (Func=>[@EXPORT_OK]);
+}
+
+use PDL;
+use PDL::Transform;
+use PDL::MatrixOps;
+use PDL::NiceSlice;
+
+use Carp;
+
+
+##############################
+# Steal _opt from PDL::Transform.
+*PDL::Transform::Cartography::_opt = \&PDL::Transform::_opt;
+use overload '""' => \&_strval;
+
+use strict;
+
+our $PI = $PDL::Transform::PI;
+our $DEG2RAD = $PDL::Transform::DEG2RAD;
+our $RAD2DEG = $PDL::Transform::RAD2DEG;
+
+sub _strval {
+ my($me) = shift;
+ $me->stringify();
+}
+
+######################################################################
+
+=head2 graticule
+
+=for usage
+
+ $lonlatp = graticule(<grid-spacing>,<line-segment-size>);
+ $lonlatp = graticule(<grid-spacing>,<line-segment-size>,1);
+
+=for ref
+
+(Cartography) PDL constructor - generate a lat/lon grid.
+
+Returns a grid of meridians and parallels as a list of vectors suitable
+for sending to
+L<PDL::Graphics::PGPLOT::Window::lines|PDL::Graphics::PGPLOT::Window/lines>
+for plotting.
+The grid is in degrees in (theta, phi) coordinates -- this is (E lon, N lat)
+for terrestrial grids or (RA, dec) for celestial ones. You must then
+transform the graticule in the same way that you transform the map.
+
+You can attach the graticule to a vector map using the syntax:
+
+ $out = graticule(10,2)->glue(1,$map);
+
+In array context you get back a 2-element list containing a piddle of
+the (theta,phi) pairs and a piddle of the pen values (1 or 0) suitable for
+calling
+L<PDL::Graphics::PGPLOT::Window::lines|PDL::Graphics::PGPLOT::Window/lines>.
+In scalar context the two elements are combined into a single piddle.
+
+The pen values associated with the graticule are negative, which will cause
+L<PDL::Graphics::PGPLOT::Window::lines|PDL::Graphics::PGPLOT::Window/lines>
+to plot them as hairlines.
+
+If a third argument is given, it is a hash of options, which can be:
+
+=over 3
+
+=item nan - if true, use two columns instead of three, and separate lines with a 'nan' break
+
+=item lonpos - if true, all reported longitudes are positive (0 to 360) instead of (-180 to 180).
+
+=item dup - if true, the meridian at the far boundary is duplicated.
+
+==back
+
+=cut
+
+sub graticule {
+ my $grid = shift;
+ my $step = shift;
+ my $hash = shift; $hash = {} unless defined($hash); # avoid // for ancient compatibility
+ my $two_cols = $hash->{nan} || 0;
+ my $lonpos = $hash->{lonpos} || 0;
+ my $dup = $hash->{dup} || 0;
+
+ $grid = 10 unless defined($grid);
+ $grid = $grid->at(0) if(ref($grid) eq 'PDL');
+
+ $step = $grid/2 unless defined($step);
+ $step = $step->at(0) if(ref($step) eq 'PDL');
+
+ # Figure number of parallels and meridians
+ my $np = 2 * int(90/$grid);
+ my $nm = 2 * int(180/$grid);
+
+ # First do parallels.
+ my $xp = xvals(360/$step + 1 + !!$two_cols, $np + 1) * $step - 180 * (!$lonpos);
+ my $yp = yvals(360/$step + 1 + !!$two_cols, $np + 1) * 180/$np - 90;
+ $xp->(-1,:) .= $yp->(-1,:) .= asin(pdl(1.1)) if($two_cols);
+
+ # Next do meridians.
+ my $xm = yvals( 180/$step + 1 + !!$two_cols, $nm + !!$dup ) * 360/$nm - 180 * (!$lonpos);
+ my $ym = xvals( 180/$step + 1 + !!$two_cols, $nm + !!$dup ) * $step - 90;
+ $xm->(-1,:) .= $ym->(-1,:) .= asin(pdl(1.1)) if($two_cols);
+
+
+ if($two_cols) {
+ return pdl( $xp->flat->append($xm->flat),
+ $yp->flat->append($ym->flat)
+ )->mv(1,0);
+ } else {
+ our $pp = (zeroes($xp)-1); $pp->((-1)) .= 0;
+ our $pm = (zeroes($xm)-1); $pm->((-1)) .= 0;
+
+ if(wantarray) {
+ return ( pdl( $xp->flat->append($xm->flat),
+ $yp->flat->append($ym->flat)
+ )->mv(1,0),
+
+ $pp->flat->append($pm->flat)
+ );
+ } else {
+ return pdl( $xp->flat->append($xm->flat),
+ $yp->flat->append($ym->flat),
+ $pp->flat->append($pm->flat)
+ )->mv(1,0);
+ }
+ barf "This can't happen";
+ }
+}
+
+=head2 earth_coast
+
+=for usage
+
+ $a = earth_coast()
+
+=for ref
+
+(Cartography) PDL constructor - coastline map of Earth
+
+Returns a vector coastline map based on the 1987 CIA World Coastline
+database (see author information). The vector coastline data are in
+plate caree format so they can be converted to other projections via
+the L<apply|PDL::Transform/apply> method and cartographic transforms,
+and are suitable for plotting with the
+L<lines|PDL::Graphics::PGPLOT::Window/lines>
+method in the PGPLOT
+output library: the first dimension is (X,Y,pen) with breaks having
+a pen value of 0 and hairlines having negative pen values. The second
+dimension threads over all the points in the data set.
+
+The vector map includes lines that pass through the antipodean
+meridian, so if you want to plot it without reprojecting, you should
+run it through L<clean_lines|/clean_lines> first:
+
+ $w = pgwin();
+ $w->lines(earth_coast->clean_lines); # plot plate caree map of world
+ $w->lines(earth_coast->apply(t_gnomonic))# plot gnomonic map of world
+
+C<earth_coast> is just a quick-and-dirty way of loading the file
+"earth_coast.vec.fits" that is part of the normal installation tree.
+
+=cut
+
+sub earth_coast {
+ my $fn = "PDL/Transform/Cartography/earth_coast.vec.fits";
+ local $_;
+ foreach(@INC) {
+ my $file = "$_/$fn";
+ return rfits($file) if(-e $file);
+ }
+ barf("earth_coast: $fn not found in \@INC.\n");
+}
+
+=head2 earth_image
+
+=for usage
+
+ $rgb = earth_image()
+
+=for ref
+
+(Cartography) PDL constructor - RGB pixel map of Earth
+
+Returns an RGB image of Earth based on data from the MODIS instrument
+on the NASA EOS/Terra satellite. (You can get a full-resolution
+image from L<http://earthobservatory.nasa.gov/Newsroom/BlueMarble/>).
+The image is a plate caree map, so you can convert it to other
+projections via the L<map|PDL::Transform/map> method and cartographic
+transforms.
+
+This is just a quick-and-dirty way of loading the earth-image files that
+are distributed along with PDL.
+
+=cut
+
+sub earth_image {
+ my($nd) = shift;
+ my $f;
+ my $dir = "PDL/Transform/Cartography/earth_";
+ $f = ($nd =~ m/^n/i) ? "${dir}night.jpg" : "${dir}day.jpg";
+
+ local $_;
+ my $im;
+ my $found = 0;
+ foreach(@INC) {
+ my $file = "$_/$f";
+ if(-e $file) {
+ $found = 1;
+ $im = rpic($file)->mv(0,-1);
+ }
+ last if defined($im);
+ }
+
+ barf("earth_image: $f not found in \@INC\n")
+ unless defined($found);
+ barf("earth_image: couldn't load $f; you may need to install netpbm.\n")
+ unless defined($im);
+
+ my $h = $im->fhdr;
+
+ $h->{SIMPLE} = 'T';
+ $h->{NAXIS} = 3;
+ $h->{NAXIS1}=2048; $h->{CRPIX1}=1024.5; $h->{CRVAL1}=0;
+ $h->{NAXIS2}=1024; $h->{CRPIX2}=512.5; $h->{CRVAL2}=0;
+ $h->{NAXIS3}=3, $h->{CRPIX3}=1; $h->{CRVAL3}=0;
+ $h->{CTYPE1}='Longitude'; $h->{CUNIT1}='degrees'; $h->{CDELT1}=180/1024.0;
+ $h->{CTYPE2}='Latitude'; $h->{CUNIT2}='degrees'; $h->{CDELT2}=180/1024.0;
+ $h->{CTYPE3}='RGB'; $h->{CUNIT3}='index'; $h->{CDELT3}=1.0;
+ $h->{COMMENT}='Plate Caree Projection';
+ $h->{HISTORY}='PDL Distribution Image, derived from NASA/MODIS data',
+
+ $im->hdrcpy(1);
+ $im;
+}
+
+=head2 clean_lines
+
+=for usage
+
+ $a = clean_lines(t_mercator->apply(scalar(earth_coast())));
+ $a = clean_lines($line_pen, [threshold]);
+ $a = $lines->clean_lines;
+
+=for ref
+
+(Cartography) PDL method - remove projection irregularities
+
+C<clean_lines> massages vector data to remove jumps due to singularities
+in the transform.
+
+In the first (scalar) form, C<$line_pen> contains both (X,Y) points and pen
+values suitable to be fed to
+L<lines|PDL::Graphics::PGPLOT::Window/lines>:
+in the second (list) form, C<$lines> contains the (X,Y) points and C<$pen>
+contains the pen values.
+
+C<clean_lines> assumes that all the outline polylines are local --
+that is to say, there are no large jumps. Any jumps larger than a
+threshold size are broken by setting the appropriate pen values to 0.
+
+The C<threshold> parameter sets the relative size of the largest jump, relative
+to the map range (as determined by a min/max operation). The default size is
+0.1.
+
+NOTES
+
+This almost never catches stuff near the apex of cylindrical maps,
+because the anomalous vectors get arbitrarily small. This could be
+improved somewhat by looking at individual runs of the pen and using
+a relative length scale that is calibrated to the rest of each run.
+it is probably not worth the computational overhead.
+
+=cut
+
+*PDL::clean_lines = \&clean_lines;
+sub clean_lines {
+ my($lines) = shift;
+ my($a) = shift;
+ my($b) = shift;
+ my($l,$p,$th);
+
+ $th = 0.1;
+
+ if(defined($b)) {
+ # separate case with thresh
+ $l = $lines;
+ $p = $a->is_inplace?$a:$a->copy;
+ $th = $b;
+ } else {
+ if(!defined($a)) {
+ # duplex case no thresh
+ $l = $lines->(0:1);
+ $p = $lines->is_inplace ? $lines->((2)) : $lines->((2))->sever;
+ } elsif(UNIVERSAL::isa($a,'PDL') &&
+ $lines->((0))->nelem == $a->nelem) {
+ # Separate case no thresh
+ $l = $lines;
+ $p = $a->is_inplace ? $a : $a->copy;;
+ } else {
+ # duplex case with thresh
+ $l = $lines->(0:1);
+ $p = $lines->is_inplace ? $lines->((2)) : $lines->((2))->sever;
+ $th = $a;
+ }
+ }
+
+ my $pok = (($p != 0) & isfinite($p));
+ # Kludge to work around minmax bug (nans confuse it!)
+ my($l0) = $l->((0));
+ my($x0,$x1) = $l0->where(isfinite($l0) & $pok)->minmax;
+ my($xth) = abs($x1-$x0) * $th;
+
+ my($l1) = $l->((1));
+ ($x0,$x1) = $l1->where(isfinite($l1) & $pok)->minmax;
+ my($yth) = abs($x1-$x0) * $th;
+
+ my $diff = abs($l->(:,1:-1) - $l->(:,0:-2));
+
+ $diff->where(!isfinite($diff)) .= 2*($xth + $yth);
+ $p->where(($diff->((0)) > $xth) | ($diff->((1)) > $yth)) .= 0;
+ if(wantarray){
+ return($l,$p);
+ } else {
+ return $l->append($p->dummy(0,1));
+ }
+}
+
+
+
+######################################################################
+
+###
+# Units parser
+# Get unit, return conversion factor to radii, or undef if no match found.
+#
+sub _uconv{
+ ###
+ # Replace this with a more general units resolver call!
+ ###
+ local($_) = shift;
+ my($silent) =shift;
+
+ my($a) =
+ ( m/^deg/i ? $DEG2RAD :
+ m/^arcmin/i ? $DEG2RAD / 60 :
+ m/^arcsec/i ? $DEG2RAD / 3600 :
+ m/^hour/i ? $DEG2RAD * 15 : # Right ascension
+ m/^min/i ? $DEG2RAD * 15/60 : # Right ascension
+ m/^microrad/i ? 1e-6 :
+ m/^millirad/i ? 1e-3 :
+ m/^rad(ian)?s?$/i ? 1.0 :
+ m/^meter/ ? 1.0/6371000 : # Assuming Earth cartography!
+ m/^kilometer/ ? 1.0/6371 :
+ m/^km/ ? 1.0/6371 :
+ m/^Mm/ ? 1.0/6.371 :
+ m/^mile/ ? 1.0/(637100000/2.54/12/5280) :
+ undef
+ );
+ print STDERR "Cartography: unrecognized unit '$_'\n"
+ if( (!defined $a) && !$silent && ($PDL::debug || $PDL::verbose));
+ $a;
+}
+
+###
+#
+# Cartography general constructor -- called by the individual map
+# constructors. Not underscored because it's certainly OK to call from
+# outside -- but the *last* argument is the name of the transform.
+#
+# The options list is put into the {options} field of the newly constructed
+# Transform -- fastidious subclass constructors will want to delete it before
+# returning.
+#
+
+
+sub _new { new('PDL::Transform::Cartography', at _); } # not exported
+sub new {
+ my($class) = shift;
+ my($name) = pop;
+
+ my($o) = $_[0];
+ $o = {@_}
+ unless(ref $o eq 'HASH');
+
+ my($me) = PDL::Transform::new($class);
+ $me->{idim} = $me->{odim} = 2;
+ $me->{name} = $name;
+
+ ####
+ # Parse origin and units arguments
+ #
+ my $or = _opt($o,['o','origin','Origin'],zeroes(2));
+ if($or->nelem != 2) {
+ croak("PDL::Transform::Cartography: origin must have 2 elements\n");
+ }
+
+ my($l) = _opt($o,['l','L']);
+ my($b) = _opt($o,['b','B']);
+
+ $or->(0) .= $l if defined($l);
+ $or->(1) .= $b if defined($b);
+
+ my $roll = topdl(_opt($o,['r','roll','Roll','P'],0));
+ my $unit = _opt($o,['u','unit','Unit'],'degrees');
+
+ $me->{params}->{conv} = my $conv = _uconv($unit);
+ $me->{params}->{u} = $unit;
+
+ $me->{itype} = ['longitude','latitude'];
+ $me->{iunit} = [$me->{params}->{u},$me->{params}->{u}];
+
+ my($ou) = _opt($o,['ou','ounit','OutputUnit'],undef);
+ $me->{params}->{ou} = $ou;
+ if(defined $ou) {
+ if(!(ref $ou)) {
+ $me->{params}->{oconv} = _uconv($ou);
+ } else {
+ my @oconv;
+ map {push(@oconv,_uconv($_))} @$ou;
+ $me->{params}->{oconv} = topdl([@oconv]);
+ }
+ } else {
+ $me->{params}->{oconv} = undef;
+ }
+ $me->{ounit} = $me->{params}->{ou};
+
+ $me->{params}->{o} = $or * $conv;
+ $me->{params}->{roll} = $roll * $conv;
+
+ $me->{params}->{bad} = _opt($o,['b','bad','Bad','missing','Missing'],
+ asin(pdl(1.1)));
+
+ # Get the standard parallel (in general there's only one; the conics
+ # have two but that's handled by _c_new)
+ $me->{params}->{std} = topdl(_opt($me->{options},
+ ['s','std','standard','Standard'],
+ 0))->at(0) * $me->{params}->{conv};
+
+ $me->{options} = $o;
+ $me;
+}
+
+# Compose self with t_rot_sphere if necessary -- useful for
+# finishing off the transformations that accept the origin and roll
+# options.
+sub PDL::Transform::Cartography::_finish {
+ my($me) = shift;
+ if( ($me->{params}->{o}->(0) != 0) ||
+ ($me->{params}->{o}->(1) != 0) ||
+ ($me->{params}->{roll} != 0)
+ ) {
+ my $out = t_compose($me,t_rot_sphere($me->{options}));
+ $out->{itype} = $me->{itype};
+ $out->{iunit} = $me->{iunit};
+ $out->{otype} = $me->{otype};
+ $out->{ounit} = $me->{ounit};
+ $out->{odim} = 2;
+ $out->{idim} = 2;
+ return $out;
+ }
+ return $me;
+}
+
+
+######################################################################
+
+=head2 t_unit_sphere
+
+=for usage
+
+ $t = t_unit_sphere(<options>);
+
+=for ref
+
+(Cartography) 3-D globe projection (conformal; authalic)
+
+This is similar to the inverse of
+L<t_spherical|PDL::Transform/t_spherical>,
+but the
+inverse transform projects 3-D coordinates onto the unit sphere,
+yielding only a 2-D (lon/lat) output. Similarly, the forward
+transform deprojects 2-D (lon/lat) coordinates onto the surface of a
+unit sphere.
+
+The cartesian system has its Z axis pointing through the pole of the
+(lon,lat) system, and its X axis pointing through the equator at the
+prime meridian.
+
+Unit sphere mapping is unusual in that it is both conformal and authalic.
+That is possible because it properly embeds the sphere in 3-space, as a
+notional globe.
+
+This is handy as an intermediate step in lots of transforms, as
+Cartesian 3-space is cleaner to work with than spherical 2-space.
+
+Higher dimensional indices are preserved, so that "rider" indices (such as
+pen value) are propagated.
+
+There is no oblique transform for t_unit_sphere, largely because
+it's so easy to rotate the output using t_linear once it's out into
+Cartesian space. In fact, the other projections implement oblique
+transforms by
+L<wrapping|PDL::Transform/t_wrap>
+L<t_linear|PDL::Transform/t_linear> with
+L<t_unit_sphere|/t_unit_sphere>.
+
+OPTIONS:
+
+=over 3
+
+=item radius, Radius (default 1.0)
+
+The radius of the sphere, for the inverse transform. (Radius is ignored
+in the forward transform). Defaults to 1.0 so that the resulting Cartesian
+coordinates are in units of "body radii".
+
+=back
+
+=cut
+
+sub t_unit_sphere {
+ my($me) = _new(@_,'Unit Sphere Projection');
+ $me->{odim} = 3;
+
+ $me->{params}->{otype} = ['X','Y','Z'];
+ $me->{params}->{ounit} = ['body radii','body radii','body radii'];
+
+ $me->{params}->{r} = topdl(_opt($me->{options},
+ ['r','radius','Radius'],
+ 1.0)
+ )->at(0);
+
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my(@dims) = $d->dims;
+ $dims[0] ++;
+ my $out = zeroes(@dims);
+
+ my($thetaphi) = ((defined $o->{conv} && $o->{conv} != 1.0) ?
+ $d->(0:1) * $o->{conv} : $d->(0:1)
+ );
+
+ my $th = $thetaphi->((0));
+ my $ph = $thetaphi->((1));
+
+ # use x as a holding tank for the cos-phi multiplier
+ $out->((0)) .= $o->{r} * cos($ph) ;
+ $out->((1)) .= $out->((0)) * sin($th);
+ $out->((0)) *= cos($th);
+
+ $out->((2)) .= $o->{r} * sin($ph);
+
+ if($d->dim(0) > 2) {
+ $out->(3:-1) .= $d->(2:-1);
+ }
+
+ $out;
+
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+
+ my($d0,$d1,$d2) = ($d->((0)),$d->((1)),$d->((2)));
+ my($r) = sqrt(($d->(0:2)*$d->(0:2))->sumover);
+ my(@dims) = $d->dims;
+ $dims[0]--;
+ my($out) = zeroes(@dims);
+
+ $out->((0)) .= atan2($d1,$d0);
+ $out->((1)) .= asin($d2/$r);
+
+ if($d->dim(0) > 3) {
+ $out->(2:-1) .= $d->(3:-1);
+ }
+
+ $out->(0:1) /= $o->{conv}
+ if(defined $o->{conv} && $o->{conv} != 1.0);
+
+ $out;
+ };
+
+
+ $me;
+}
+
+######################################################################
+
+=head2 t_rot_sphere
+
+=for usage
+
+ $t = t_rot_sphere({origin=>[<theta>,<phi>],roll=>[<roll>]});
+
+=for ref
+
+(Cartography) Generate oblique projections
+
+You feed in the origin in (theta,phi) and a roll angle, and you get back
+out (theta', phi') coordinates. This is useful for making oblique or
+transverse projections: just compose t_rot_sphere with your favorite
+projection and you get an oblique one.
+
+Most of the projections automagically compose themselves with t_rot_sphere
+if you feed in an origin or roll angle.
+
+t_rot_sphere converts the base plate caree projection (straight lon, straight
+lat) to a Cassini projection.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=back
+
+=cut
+
+# helper routine for making the rotation matrix
+sub _rotmat {
+ my($th,$ph,$r) = @_;
+
+ pdl( [ cos($th) , -sin($th), 0 ], # apply theta
+ [ sin($th) , cos($th), 0 ],
+ [ 0, 0, 1 ] )
+ x
+ pdl( [ cos($ph), 0, -sin($ph) ], # apply phi
+ [ 0, 1, 0 ],
+ [ sin($ph), 0, cos($ph) ] )
+ x
+ pdl( [ 1, 0 , 0 ], # apply roll last
+ [ 0, cos($r), -sin($r) ],
+ [ 0, sin($r), cos($r) ])
+ ;
+}
+
+sub t_rot_sphere {
+ my($me) = _new(@_,'Spherical rotation');
+
+
+ my($th,$ph) = $me->{params}->{o}->list;
+ my($r) = $me->{params}->{roll}->at(0);
+
+ my($rotmat) = _rotmat($th,$ph,$r);
+
+ my $out = t_wrap( t_linear(m=>$rotmat, d=>3), t_unit_sphere());
+ $out->{itype} = $me->{itype};
+ $out->{iunit} = $me->{iunit};
+ $out->{otype} = ['rotated longitude','rotated latitude'];
+ $out->{ounit} = $me->{iunit};
+
+ $out;
+}
+
+
+######################################################################
+
+=head2 t_orthographic
+
+=for usage
+
+ $t = t_orthographic(<options>);
+
+=for ref
+
+(Cartography) Ortho. projection (azimuthal; perspective)
+
+This is a perspective view as seen from infinite distance. You
+can specify the sub-viewer point in (lon,lat) coordinates, and a rotation
+angle of the map CW from (north=up). This is equivalent to specify
+viewer roll angle CCW from (north=up).
+
+t_orthographic is a convenience interface to t_unit_sphere -- it is implemented
+as a composition of a t_unit_sphere call, a rotation, and a slice.
+
+[*] In the default case where the near hemisphere is mapped, the
+inverse exists. There is no single inverse for the whole-sphere case,
+so the inverse transform superimposes everything on a single
+hemisphere. If you want an invertible 3-D transform, you want
+L<t_unit_sphere|/t_unit_sphere>.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=item m, mask, Mask, h, hemisphere, Hemisphere [default 'near']
+
+The hemisphere to keep in the projection (see L<PDL::Transform::Cartography>).
+
+=back
+
+NOTES
+
+Alone of the various projections, this one does not use
+L<t_rot_sphere|/t_rot_sphere> to handle the standard options, because
+the cartesian coordinates of the rotated sphere are already correctly
+projected -- t_rot_sphere would put them back into (theta', phi')
+coordinates.
+
+=cut
+
+sub t_orthographic {
+ my($me) = _new(@_,'Orthographic Projection');
+
+ $me->{otype} = ['projected X','projected Y'];
+ $me->{ounit} = ['body radii','body radii'];
+
+ my $m= _opt($me->{options},
+ ['m','mask','Mask','h','hemi','hemisphere','Hemisphere'],
+ 1);
+ if($m=~m/^b/i) {
+ $me->{params}->{m} = 0;
+ } elsif($m=~m/^n/i) {
+ $me->{params}->{m} = 1;
+ } elsif($m=~m/^f/i) {
+ $me->{params}->{m} = 2;
+ } else {
+ $me->{params}->{m} = $m;
+ }
+
+ my $origin= $me->{params}->{o} * $RAD2DEG;
+ my $roll = $me->{params}->{roll} * $RAD2DEG;
+
+ $me->{params}->{t_int} =
+ t_compose(
+ t_linear(rot=>[90 - $origin->at(1),
+ 0,
+ 90 + $origin->at(0)],
+ d=>3),
+ t_unit_sphere(u=>$me->{params}->{u})
+ );
+
+ $me->{params}->{t_int} =
+ t_compose(
+ t_linear(rot=>[0,0,$roll->at(0)],d=>3),
+ $me->{params}->{t_int}
+ )
+ if($roll->at(0));
+
+ $me->{name} = "orthographic";
+
+ $me->{idim} = 2;
+ $me->{odim} = 2;
+
+ $me->{func} = sub {
+ my ($d,$o) = @_ ;
+ my ($out) = $o->{t_int}->apply($d);
+ if($o->{m}) {
+ my $idx;
+ $idx = whichND($out->((2)) < 0)
+ if($o->{m} == 1);
+ $idx = whichND($out->((2)) > 0)
+ if($o->{m} == 2);
+ if(defined $idx && ref $idx eq 'PDL' && $idx->nelem){
+ $out->((0))->range($idx) .= $o->{bad};
+ $out->((1))->range($idx) .= $o->{bad};
+ }
+ }
+
+ my($d0) = $out->dim(0);
+
+ # Remove the Z direction
+ ($d0 > 3) ? $out->(pdl(0,1,3..$d0-1)) : $out->(0:1);
+
+ };
+
+ # This is slow to run, quick to code -- could be made better by
+ # having its own 2-d inverse instead of calling the internal one.
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+ my($d1) = $d->(0:1);
+ my(@dims) = $d->dims;
+ $dims[0]++;
+ my($out) = zeroes(@dims);
+ $out->(0:1) .= $d1;
+ $out->(3:-1) .= $d->(2:-1)
+ if($dims[0] > 3);
+
+ $out->((2)) .= sqrt(1 - ($d1*$d1)->sumover);
+ $out->((2)) *= -1 if($o->{m} == 2);
+
+ $o->{t_int}->invert($out);
+ };
+
+ $me;
+}
+
+######################################################################
+
+=head2 t_caree
+
+=for usage
+
+ $t = t_caree(<options>);
+
+=for ref
+
+(Cartography) Plate Caree projection (cylindrical; equidistant)
+
+This is the simple Plate Caree projection -- also called a "lat/lon plot".
+The horizontal axis is theta; the vertical axis is phi. This is a no-op
+if the angular unit is radians; it is a simple scale otherwise.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=item s, std, standard, Standard (default 0)
+
+The standard parallel where the transformation is conformal. Conformality
+is achieved by shrinking of the horizontal scale to match the
+vertical scale (which is correct everywhere).
+
+=back
+
+=cut
+
+ at PDL::Transform::Cartography::Caree::ISA = ('PDL::Transform::Cartography');
+
+sub t_caree {
+ my($me) = _new(@_,'Plate Caree Projection');
+ my $p = $me->{params};
+
+ $me->{otype} = ['projected longitude','latitude'];
+ $me->{ounit} = ['proj. body radii','body radii'];
+
+ $p->{stretch} = cos($p->{std});
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+ $out->(0:1) *= $o->{conv};
+ $out->(0) *= $p->{stretch};
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o)= @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+ $out->(0:1) /= $o->{conv};
+ $out->(0) /= $p->{stretch};
+ $out;
+ };
+
+ $me->_finish;
+}
+
+######################################################################
+
+=head2 t_mercator
+
+=for usage
+
+ $t = t_mercator(<options>);
+
+=for ref
+
+(Cartography) Mercator projection (cylindrical; conformal)
+
+This is perhaps the most famous of all map projections: meridians are mapped
+to parallel vertical lines and parallels are unevenly spaced horizontal lines.
+The poles are shifted to +/- infinity. The output values are in units of
+globe-radii for easy conversion to kilometers; hence the horizontal extent
+is -pi to pi.
+
+You can get oblique Mercator projections by specifying the C<origin> or
+C<roll> options; this is implemented via L<t_rot_sphere|/t_rot_sphere>.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=item c, clip, Clip (default 75 [degrees])
+
+The north/south clipping boundary of the transformation. Because the poles are
+displaced to infinity, many applications require a clipping boundary. The
+value is in whatever angular unit you set with the standard 'units' option.
+The default roughly matches interesting landforms on Earth.
+For no clipping at all, set b=>0. For asymmetric clipping, use a 2-element
+list ref or piddle.
+
+=item s, std, Standard (default 0)
+
+This is the parallel at which the map has correct scale. The scale
+is also correct at the parallel of opposite sign.
+
+=back
+
+=cut
+
+
+ at PDL::Transform::Cartography::Mercator::ISA = ('PDL::Transform::Cartography');
+
+sub t_mercator {
+ my($me) = _new(@_,'Mercator Projection');
+ my $p = $me->{params};
+
+# This is a lot of shenanigans just to get the clip parallels, but what the
+# heck -- it's not a hot spot and it saves copying the input data (for
+# nondestructive clipping).
+ $p->{c} = _opt($me->{options},
+ ['c','clip','Clip'],
+ undef);
+ if(defined($p->{c})) {
+ $p->{c} = topdl($p->{c});
+ $p->{c} *= $p->{conv};
+ } else {
+ $p->{c} = pdl($DEG2RAD * 75);
+ }
+ $p->{c} = abs($p->{c}) * pdl(-1,1) if($p->{c}->nelem == 1);
+
+ $p->{c} = log(tan(($p->{c}/2) + $PI/4));
+ $p->{c} = [$p->{c}->list];
+
+ $p->{std} = topdl(_opt($me->{options},
+ ['s','std','standard','Standard'],
+ 0))->at(0) * $p->{conv};
+
+ if($p->{std} == 0) {
+ $me->{otype} = ['longitude','tan latitude'];
+ $me->{ounit} = ['radians',' '] unless(defined $me->{ounit});
+ } else {
+ $me->{otype} = ['proj. longitude','proj. tan latitude'];
+ $me->{ounit} = ['radians',' '] unless(defined $me->{ounit});
+ }
+
+ $p->{stretch} = cos($p->{std});
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ $out->(0:1) *= $o->{conv};
+
+ $out->((1)) .= log(tan($out->((1))/2 + $PI/4));
+ $out->((1)) .= $out->((1))->clip(@{$o->{c}})
+ unless($o->{c}->[0] == $o->{c}->[1]);
+
+ $out->(0:1) *= $o->{stretch};
+ $out->(0:1) /= $o->{oconv} if(defined $o->{oconv});
+
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace? $d : $d->copy;
+
+ $out->(0:1) *= $o->{oconv} if defined($o->{oconv});
+ $out->(0:1) /= $o->{stretch};
+ $out->((1)) .= (atan(exp($out->((1)))) - $PI/4)*2;
+ $out->(0:1) /= $o->{conv};
+
+ $out;
+ };
+
+ $me->_finish;
+}
+
+######################################################################
+
+=head2 t_utm
+
+=for usage
+
+ $t = t_utm(<zone>,<options>);
+
+=for ref
+
+(Cartography) Universal Transverse Mercator projection (cylindrical)
+
+This is the internationally used UTM projection, with 2 subzones
+(North/South). The UTM zones are parametrized individually, so if you
+want a Zone 30 map you should use C<t_utm(30)>. By default you get
+the northern subzone, so that locations in the southern hemisphere get
+negative Y coordinates. If you select the southern subzone (with the
+"subzone=>-1" option), you get offset southern UTM coordinates.
+
+The 20-subzone military system is not yet supported. If/when it is
+implemented, you will be able to enter "subzone=>[a-t]" to select a N/S
+subzone.
+
+Note that UTM is really a family of transverse Mercator projections
+with different central meridia. Each zone properly extends for six
+degrees of longitude on either side of its appropriate central meridian,
+with Zone 1 being centered at -177 degrees longitude (177 west).
+Properly speaking, the zones only extend from 80 degrees south to 84 degrees
+north; but this implementation lets you go all the way to 90 degrees.
+The default UTM coordinates are meters. The origin for each zone is
+on the equator, at an easting of -500,000 meters.
+
+The default output units are meters, assuming that you are wanting a
+map of the Earth. This will break for bodies other than Earth (which
+have different radii and hence different conversions between lat/lon
+angle and meters).
+
+The standard UTM projection has a slight reduction in scale at the
+prime meridian of each zone: the transverse Mercator projection's
+standard "parallels" are 180km e/w of the central meridian. However,
+many Europeans prefer the "Gauss-Kruger" system, which is virtually
+identical to UTM but with a normal tangent Mercator (standard parallel
+on the prime meridian). To get this behavior, set "gk=>1".
+
+Like the rest of the PDL::Transform::Cartography package, t_utm uses a
+spherical datum rather than the "official" ellipsoidal datums for the
+UTM system.
+
+This implementation was derived from the rather nice description by
+Denis J. Dean, located on the web at:
+http://www.cnr.colostate.edu/class_info/nr502/lg3/datums_coordinates/utm.html
+
+OPTIONS
+
+=over 3
+
+=item STANDARD OPTIONS
+
+(No positional options -- Origin and Roll are ignored)
+
+=item ou, ounit, OutputUnit (default 'meters')
+
+(This is likely to become a standard option in a future release) The
+unit of the output map. By default, this is 'meters' for UTM, but you
+may specify 'deg' or 'km' or even (heaven help us) 'miles' if you
+prefer.
+
+=item sz, subzone, SubZone (default 1)
+
+Set this to -1 for the southern hemisphere subzone. Ultimately you
+should be able to set it to a letter to get the corresponding military
+subzone, but that's too much effort for now.
+
+=item gk, gausskruger (default 0)
+
+Set this to 1 to get the (European-style) tangent-plane Mercator with
+standard parallel on the prime meridian. The default of 0 places the
+standard parallels 180km east/west of the prime meridian, yielding better
+average scale across the zone. Setting gk=>1 makes the scale exactly 1.0
+at the central meridian, and >1.0 everywhere else on the projection.
+The difference in scale is about 0.3%.
+
+=back
+
+=cut
+
+sub t_utm {
+ my $zone = (int(shift)-1) % 60 + 1;
+ my($a) = _new(@_,"UTM-$zone");
+ my $opt = $a->{options};
+
+ ## Make sure that there is a conversion (default is 'meters')
+ $a->{ounit} = ['meter','meter'] unless defined($a->{ounit});
+ $a->{ounit} = [$a->{ounit},$a->{ounit}] unless ref($a->{ounit});
+ $a->{params}->{oconv} = _uconv($a->{ounit}->[0]);
+
+ ## Define our zone and NS offset
+ my $subzone = _opt($opt,['sz', 'subzone', 'SubZone'],1);
+ my $offset = zeroes(2);
+ $offset->(0) .= 5e5*(2*$PI/40e6)/$a->{params}->{oconv};
+ $offset->(1) .= ($subzone < 0) ? $PI/2/$a->{params}->{oconv} : 0;
+
+ my $merid = ($zone * 6) - 183;
+
+ my $gk = _opt($opt,['gk','gausskruger'],0);
+
+ my($me) = t_compose(t_linear(post=>$offset,
+ rot=>-90
+ ),
+
+ t_mercator(o=>[$merid,0],
+ r=>90,
+ ou=>$a->{ounit},
+ s=>$gk ? 0 : ($RAD2DEG * (180/6371))
+ )
+ );
+
+
+ my $s = ($zone < 0) ? "S Hemisphere " : "";
+ $me->{otype} = ["UTM-$zone Easting","${s}Northing"];
+ $me->{ounit} = $a->{ounit};
+
+ return $me;
+}
+
+######################################################################
+
+=head2 t_sin_lat
+
+=for usage
+
+ $t = t_sin_lat(<options>);
+
+=for ref
+
+(Cartography) Cyl. equal-area projection (cyl.; authalic)
+
+This projection is commonly used in solar Carrington plots; but not much
+for terrestrial mapping.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=item s,std, Standard (default 0)
+
+This is the parallel at which the map is conformal. It is also conformal
+at the parallel of opposite sign. The conformality is achieved by matched
+vertical stretching and horizontal squishing (to achieve constant area).
+
+=back
+
+=cut
+
+ at PDL::Transform::Cartography::SinLat::ISA = ('PDL::Transform::Cartography');
+sub t_sin_lat {
+ my($me) = _new(@_,"Sine-Latitude Projection");
+
+ $me->{params}->{std} = topdl(_opt($me->{options},
+ ['s','std','standard','Standard'],
+ 0))->at(0) * $me->{params}->{conv};
+
+ if($me->{params}->{std} == 0) {
+ $me->{otype} = ['longitude','sin latitude'];
+ $me->{ounit} = ['radians',' ']; # nonzero but blank!
+ } else {
+ $me->{otype} = ['proj. longitude','proj. sin latitude'];
+ $me->{ounit} = ['radians',' '];
+ }
+
+ $me->{params}->{stretch} = sqrt(cos($me->{params}->{std}));
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ $out->(0:1) *= $me->{params}->{conv};
+ $out->((1)) .= sin($out->((1))) / $o->{stretch};
+ $out->((0)) *= $o->{stretch};
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+ $out->((1)) .= asin($out->((1)) * $o->{stretch});
+ $out->((0)) /= $o->{stretch};
+ $out->(0:1) /= $me->{params}->{conv};
+ $out;
+ };
+
+ $me->_finish;
+}
+
+######################################################################
+
+=head2 t_sinusoidal
+
+=for usage
+
+ $t = t_sinusoidal(<options>);
+
+=for ref
+
+(Cartography) Sinusoidal projection (authalic)
+
+Sinusoidal projection preserves the latitude scale but scales
+longitude according to sin(lat); in this respect it is the companion to
+L<t_sin_lat|/t_sin_lat>, which is also authalic but preserves the
+longitude scale instead.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=back
+
+=cut
+
+sub t_sinusoidal {
+ my($me) = _new(@_,"Sinusoidal Projection");
+ $me->{otype} = ['longitude','latitude'];
+ $me->{ounit} = [' ','radians'];
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+ $out->(0:1) *= $o->{conv};
+
+ $out->((0)) *= cos($out->((1)));
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+ my($x) = $out->((0));
+ my($y) = $out->((1));
+
+ $x /= cos($out->((1)));
+
+ my($rej) = ( (abs($x)>$PI) | (abs($y)>($PI/2)) )->flat;
+ $x->flat->($rej) .= $o->{bad};
+ $y->flat->($rej) .= $o->{bad};
+
+ $out->(0:1) /= $o->{conv};
+ $out;
+ };
+
+ $me->_finish;
+}
+
+
+
+
+
+######################################################################
+#
+# Conic projections are subclassed for easier stringification and
+# parsing of the standard parallels. The constructor gets copied
+# into the current package for ease of hackage.
+#
+# This is a little kludgy -- it's intended for direct calling
+# rather than method calling, and it puts its own class name on the
+# front of the argument list. But, hey, it works...
+#
+ at PDL::Transform::Cartography::Conic::ISA = ('PDL::Transform::Cartography');
+sub _c_new {
+ my($def_std) = pop;
+ my($me) = new('PDL::Transform::Cartography::Conic', at _);
+
+ my($p) = $me->{params};
+ $p->{std} = _opt($me->{options},['s','std','standard','Standard'],
+ $def_std);
+ $p->{std} = topdl($p->{std}) * $me->{params}->{conv};
+ $p->{std} = topdl([$PI/2 * ($p->{std}<0 ? -1 : 1), $p->{std}->at(0)])
+ if($p->{std}->nelem == 1);
+
+ $me->{params}->{cylindrical} = 1
+ if(approx($p->{std}->(0),-$p->{std}->(1)));
+
+ $me;
+}
+
+sub PDL::Transform::Cartography::Conic::stringify {
+ my($me) = shift;
+ my($out) = $me->SUPER::stringify;
+
+ $out .= sprintf("\tStd parallels: %6.2f,%6.2f %s\n",
+ $me->{params}->{std}->at(0) / $me->{params}->{conv},
+ $me->{params}->{std}->at(1) / $me->{params}->{conv},
+ $me->{params}->{u});
+ $out;
+}
+
+######################################################################
+
+=head2 t_conic
+
+=for usage
+
+ $t = t_conic(<options>)
+
+=for ref
+
+(Cartography) Simple conic projection (conic; equidistant)
+
+This is the simplest conic projection, with parallels mapped to
+equidistant concentric circles. It is neither authalic nor conformal.
+This transformation is also referred to as the "Modified Transverse
+Mercator" projection in several maps of Alaska published by the USGS;
+and the American State of New Mexico re-invented the projection in
+1936 for an official map of that State.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=item s, std, Standard (default 29.5, 45.5)
+
+The locations of the standard parallel(s) (where the cone intersects
+the surface of the sphere). If you specify only one then the other is
+taken to be the nearest pole. If you specify both of them to be one
+pole then you get an equidistant azimuthal map. If you specify both
+of them to be opposite and equidistant from the equator you get a
+Plate Caree projection.
+
+=back
+
+=cut
+
+sub t_conic {
+ my($me) = _c_new(@_,"Simple Conic Projection",[29.5,45.5]);
+
+ my($p) = $me->{params};
+
+ if($p->{cylindrical}) {
+ print STDERR "Simple conic: degenerate case; using Plate Caree\n"
+ if($PDL::verbose);
+ return t_caree($me->{options});
+ }
+
+ $p->{n} = ((cos($p->{std}->((0))) - cos($p->{std}->((1))))
+ /
+ ($p->{std}->((1)) - $p->{std}->((0))));
+
+ $p->{G} = cos($p->{std}->((0)))/$p->{n} + $p->{std}->((0));
+
+ $me->{otype} = ['Conic X','Conic Y'];
+ $me->{ounit} = ['Proj. radians','Proj. radians'];
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($rho) = $o->{G} - $d->((1)) * $o->{conv};
+ my($theta) = $o->{n} * $d->((0)) * $o->{conv};
+
+ $out->((0)) .= $rho * sin($theta);
+ $out->((1)) .= $o->{G} - $rho * cos($theta);
+
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($x) = $d->((0));
+ my($y) = $o->{G} - $d->((1));
+ my($rho) = sqrt($x*$x + $y*$y);
+ $rho *= -1 if($o->{n}<0);
+
+ my($theta) = ($o->{n} < 0) ? atan2(-$x,-$y) : atan2($x,$y);
+
+ $out->((1)) .= $o->{G} - $rho;
+ $out->((1))->where(($out->((1)) < -$PI/2) | ($out->((1)) > $PI/2))
+ .= $o->{bad};
+
+ $out->((0)) .= $theta / $o->{n};
+ $out->((0))->where(($out->((0)) < -$PI) | ($out->((0)) > $PI/2))
+ .= $o->{bad};
+
+ $out->(0:1) /= $o->{conv};
+
+ $out;
+ };
+
+ $me->_finish;
+}
+
+
+
+
+######################################################################
+
+=head2 t_albers
+
+=for usage
+
+ $t = t_albers(<options>)
+
+=for ref
+
+(Cartography) Albers conic projection (conic; authalic)
+
+This is the standard projection used by the US Geological Survey for
+sectionals of the 50 contiguous United States of America.
+
+The projection reduces to the Lambert equal-area conic (infrequently
+used and not to be confused with the Lambert conformal conic,
+L<t_lambert|/t_lambert>!) if the pole is used as one of the two
+standard parallels.
+
+Notionally, this is a conic projection onto a cone that intersects the
+sphere at the two standard parallels; it works best when the two parallels
+straddle the region of interest.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=item s, std, standard, Standard (default (29.5,45.5))
+
+The locations of the standard parallel(s). If you specify only one then
+the other is taken to be the nearest pole and a Lambert Equal-Area Conic
+map results. If you specify both standard parallels to be the same pole,
+then the projection reduces to the Lambert Azimuthal Equal-Area map as
+aq special case. (Note that L<t_lambert|/t_lambert> is Lambert's
+Conformal Conic, the most commonly used of Lambert's projections.)
+
+The default values for the standard parallels are those chosen by Adams
+for maps of the lower 48 US states: (29.5,45.5). The USGS recommends
+(55,65) for maps of Alaska and (8,18) for maps of Hawaii -- these latter
+are chosen to also include the Canal Zone and Philippine Islands farther
+south, which is why both of those parallels are south of the Hawaiian islands.
+
+The transformation reduces to the cylindrical equal-area (sin-lat)
+transformation in the case where the standard parallels are opposite and
+equidistant from the equator, and in fact this is implemented by a call to
+t_sin_lat.
+
+=back
+
+=cut
+
+sub t_albers {
+ my($me) = _c_new(@_,"Albers Equal-Area Conic Projection",[29.5,45.5]);
+
+ my($p) = $me->{params};
+
+ if($p->{cylindrical}) {
+ print STDERR "Albers equal-area conic: degenerate case; using equal-area cylindrical\n"
+ if($PDL::verbose);
+ return t_sin_lat($me->{options});
+ }
+
+ $p->{n} = sin($p->{std})->sumover / 2;
+ $p->{C} = (cos($p->{std}->((1)))*cos($p->{std}->((1))) +
+ 2 * $p->{n} * sin($p->{std}->((1))) );
+ $p->{rho0} = sqrt($p->{C}) / $p->{n};
+
+ $me->{otype} = ['Conic X','Conic Y'];
+ $me->{ounit} = ['Proj. radians','Proj. radians'];
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($rho) = sqrt( $o->{C} - 2 * $o->{n} * sin($d->((1)) * $o->{conv}) ) / $o->{n};
+ my($theta) = $o->{n} * $d->((0)) * $o->{conv};
+
+ $out->((0)) .= $rho * sin($theta);
+ $out->((1)) .= $p->{rho0} - $rho * cos($theta);
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($x) = $d->((0));
+ my($y) = $o->{rho0} - $d->((1));
+
+ my($theta) = ($o->{n} < 0) ? atan2 -$x,-$y : atan2 $x, $y;
+ my($rho) = sqrt( $x*$x + $y*$y ) * $o->{n};
+
+ $out->((1)) .= asin( ( $o->{C} - ( $rho * $rho ) ) / (2 * $o->{n}) );
+
+ $out->((0)) .= $theta / $o->{n};
+ $out->((0))->where(($out->((0))>$PI) | ($out->((0))<-$PI)) .= $o->{bad};
+
+ $out->(0:1) /= $o->{conv};
+
+ $out;
+ };
+
+ $me->_finish;
+}
+
+######################################################################
+
+=head2 t_lambert
+
+=for usage
+
+ $t = t_lambert(<options>);
+
+=for ref
+
+(Cartography) Lambert conic projection (conic; conformal)
+
+Lambert conformal conic projection is widely used in aeronautical
+charts and state base maps published by the USA's FAA and USGS. It's
+especially useful for mid-latitude charts. In particular, straight lines
+approximate (but are not exactly) great circle routes of up to ~2 radians.
+
+The default standard parallels are 33 and 45 to match the USGS state
+1:500,000 base maps of the United States. At scales of 1:500,000 and
+larger, discrepancies between the spherical and ellipsoidal projections
+become important; use care with this projection on spheres.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=item s, std, standard, Standard (default (33,45))
+
+The locations of the standard parallel(s) for the conic projection.
+The transform reduces to the Mercator projection in the case where the
+standard parallels are opposite and equidistant from the equator, and
+in fact this is implemented by a call to t_mercator.
+
+=item c, clip, Clip (default [-75,75])
+
+Because the transform is conformal, the distant pole is displaced to
+infinity. Many applications require a clipping boundary. The value
+is in whatever angular unit you set with the standard 'unit' option.
+For consistency with L<t_mercator|/t_mercator>, clipping works the same
+way even though in most cases only one pole needs it. Set this to 0
+for no clipping at all.
+
+=back
+
+=cut
+
+sub t_lambert {
+ my($me)= _c_new(@_,"Lambert Conformal Conic Projection",[33,45]);
+ my($p) = $me->{params};
+
+ if($p->{cylindrical}){
+ print STDERR "Lambert conformal conic: std parallels are opposite & equal; using Mercator\n"
+ if($PDL::verbose);
+ return t_mercator($me->{options});
+ }
+
+ # Find clipping parallels
+ $p->{c} = _opt($me->{options},['c','clip','Clip'],undef);
+ if(defined($p->{c})) {
+ $p->{c} = topdl($p->{c});
+ } else {
+ $p->{c} = topdl([-75,75]);
+ }
+ $p->{c} = abs($p->{c}) * topdl([-1,1]) if($p->{c}->nelem == 1);
+ $p->{c} = [$p->{c}->list];
+
+ # Prefrobnicate
+ if(approx($p->{std}->((0)),$p->{std}->((1)))) {
+ $p->{n} = sin($p->{std}->((0)));
+ } else {
+ $p->{n} = (log(cos($p->{std}->((0)))/cos($p->{std}->((1))))
+ /
+ log( tan( $PI/4 + $p->{std}->((1))/2 )
+ /
+ tan( $PI/4 + $p->{std}->((0))/2 )
+ )
+ );
+ }
+
+ $p->{F} = ( cos($p->{std}->((0)))
+ *
+ ( tan( $PI/4 + $p->{std}->((0))/2 ) ** $p->{n} ) / $p->{n}
+ );
+
+ $p->{rho0} = $p->{F};
+
+ $me->{otype} = ['Conic X','Conic Y'];
+ $me->{ounit} = ['Proj. radians','Proj. radians'];
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($cl) = ( ($o->{c}->[0] == $o->{c}->[1]) ?
+ $d->((1))*$o->{conv} :
+ ($d->((1))->clip(@{$o->{c}}) * $o->{conv})
+ );
+
+ my($rho) = $o->{F} / ( tan($PI/4 + ($cl)/2 ) ** $o->{n} );
+ my($theta) = $o->{n} * $d->((0)) * $o->{conv};
+
+ $out->((0)) .= $rho * sin($theta);
+ $out->((1)) .= $o->{rho0} - $rho * cos($theta);
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($x) = $d->((0));
+ my($y) = $o->{rho0} - $d->((1));
+
+ my($rho) = sqrt($x * $x + $y * $y);
+ $rho *= -1 if($o->{n} < 0);
+ my($theta) = ($o->{n} < 0) ? atan2(-$x,-$y):(atan2 $x,$y);
+
+
+ $out->((0)) .= $theta / $o->{n};
+ $out->((0))->where(($out->((0)) > $PI) | ($out->((0)) < -$PI)) .= $o->{bad};
+
+
+ $out->((1)) .= 2 * atan(($o->{F}/$rho)**(1.0/$o->{n})) - $PI/2;
+ $out->((1))->where(($out->((1)) > $PI/2) | ($out->((1)) < -$PI/2)) .= $o->{bad};
+
+ $out->(0:1) /= $o->{conv};
+
+ $out;
+ };
+
+
+ $me->_finish;
+}
+
+######################################################################
+
+=head2 t_stereographic
+
+=for usage
+
+ $t = t_stereographic(<options>);
+
+=for ref
+
+(Cartography) Stereographic projection (az.; conf.; persp.)
+
+The stereographic projection is a true perspective (planar) projection
+from a point on the spherical surface opposite the origin of the map.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=item c, clip, Clip (default 120)
+
+This is the angular distance from the center to the edge of the
+projected map. The default 120 degrees gives you most of the opposite
+hemisphere but avoids the hugely distorted part near the antipodes.
+
+=back
+
+=cut
+
+sub t_stereographic {
+ my($me) = _new(@_,"Stereographic Projection");
+
+ $me->{params}->{k0} = 1.0;
+ $me->{params}->{c} = _opt($me->{options},
+ ['c','clip','Clip'],
+ 120) * $me->{params}->{conv};
+
+ $me->{otype} = ['Stereo X','Stereo Y'];
+ $me->{ounit} = ['Proj. body radii','Proj. radians'];
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($th,$ph) = ($out->((0)) * $o->{conv},
+ $out->((1)) * $o->{conv});
+
+ my($cph) = cos($ph); # gets re-used
+ my($k) = 2 * $o->{k0} / (1 + cos($th) * $cph);
+ $out->((0)) .= $k * $cph * sin($th);
+ $out->((1)) .= $k * sin($ph);
+
+ my($cl0) = 2*$o->{k0} / (1 + cos($o->{c}));
+ $out->((0))->where($k>$cl0) .= $o->{bad};
+ $out->((1))->where($k>$cl0) .= $o->{bad};
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($x) = $d->((0));
+ my($y) = $d->((1));
+ my($rho) = sqrt($x*$x + $y*$y);
+ my($c) = 2 * atan2($rho,2*$o->{k0});
+
+ $out->((0)) .= atan2($x * sin($c), $rho * cos($c));
+ $out->((1)) .= asin($y * sin($c) / $rho);
+
+ $out ->(0:1) /= $o->{conv};
+ $out;
+ };
+
+ $me->_finish;
+}
+
+######################################################################
+
+=head2 t_gnomonic
+
+=for usage
+
+ $t = t_gnomonic(<options>);
+
+=for ref
+
+(Cartography) Gnomonic (focal-plane) projection (az.; persp.)
+
+The gnomonic projection projects a hemisphere onto a tangent plane.
+It is useful in cartography for the property that straight lines are
+great circles; and it is useful in scientific imaging because
+it is the projection generated by a simple optical system with a flat
+focal plane.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=item c, clip, Clip (default 75)
+
+This is the angular distance from the center to the edge of the
+projected map. The default 75 degrees gives you most of the
+hemisphere but avoids the hugely distorted part near the horizon.
+
+=back
+
+=cut
+
+sub t_gnomonic {
+ my($me) = _new(@_,"Gnomonic Projection");
+
+ $me->{params}->{k0} = 1.0; # Useful for standard parallel (TBD: add one)
+
+ $me->{params}->{c} = topdl(_opt($me->{options},
+ ['c','clip','Clip'],
+ 75) * $me->{params}->{conv});
+
+ $me->{params}->{c} .= $me->{params}->{c}->clip(undef,(90-1e-6)*$me->{params}->{conv});
+
+ $me->{otype} = ['Tangent-plane X','Tangent-plane Y'];
+ $me->{ounit} = ['Proj. radians','Proj. radians'];
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($th,$ph) = ($out->((0)) * $o->{conv},
+ $out->((1)) * $o->{conv});
+
+ my($cph) = cos($ph); # gets re-used
+
+ my($k) = $o->{k0} / (cos($th) * $cph);
+ my($cl0) = $o->{k0} / (cos($o->{c}));
+
+ $out->((0)) .= $k * $cph * sin($th);
+ $out->((1)) .= $k * sin($ph);
+
+ my $idx = whichND(($k > $cl0) | ($k < 0) | (!isfinite($k)));
+ if($idx->nelem) {
+ $out->((0))->range($idx) .= $o->{bad};
+ $out->((1))->range($idx) .= $o->{bad};
+ }
+
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($x) = $d->((0));
+ my($y) = $d->((1));
+
+ my($rho) = sqrt($x*$x + $y*$y);
+ my($c) = atan($rho/$o->{k0});
+
+ $out->((0)) .= atan2($x * sin($c), $rho * cos($c));
+ $out->((1)) .= asin($y * sin($c) / $rho);
+
+ my $idx = whichND($rho==0);
+
+ if($idx->nelem) {
+ $out->((0))->range($idx) .= 0;
+ $out->((1))->range($idx) .= 0;
+ }
+ $out->(0:1) /= $o->{conv};
+ $out;
+ };
+
+ $me->_finish;
+}
+
+######################################################################
+
+=head2 t_az_eqd
+
+=for usage
+
+ $t = t_az_eqd(<options>);
+
+=for ref
+
+(Cartography) Azimuthal equidistant projection (az.; equi.)
+
+Basic azimuthal projection preserving length along radial lines from
+the origin (meridians, in the original polar aspect). Hence, both
+azimuth and distance are correct for journeys beginning at the origin.
+
+Applied to the celestial sphere, this is the projection made by
+fisheye lenses; it is also the projection into which C<t_vertical>
+puts perspective views.
+
+The projected plane scale is normally taken to be planetary radii;
+this is useful for cartographers but not so useful for scientific
+observers. Setting the 't=>1' option causes the output scale to shift
+to camera angular coordinates (the angular unit is determined by the
+standard 'Units' option; default is degrees).
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=item c, clip, Clip (default 180 degrees)
+
+The largest angle relative to the origin. Default is the whole sphere.
+
+=back
+
+=cut
+
+sub t_az_eqd {
+ my($me) = _new(@_,"Equidistant Azimuthal Projection");
+
+ $me->{params}->{c} = topdl(_opt($me->{options},
+ ['c','clip','Clip'],
+ 180) * $me->{params}->{conv});
+
+ $me->{otype} = ['X distance','Y distance'];
+ $me->{ounit} = ['radians','radians'];
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($ph) = $d->((1)) * $o->{conv};
+ my($th) = $d->((0)) * $o->{conv};
+
+ my $cos_c = cos($ph) * cos($th);
+ my $c = acos($cos_c);
+ my $k = $c / sin($c);
+ $k->where($c==0) .= 1;
+
+ my($x,$y) = ($out->((0)), $out->((1)));
+
+ $x .= $k * cos($ph) * sin($th);
+ $y .= $k * sin($ph);
+
+ my $idx = whichND($c > $o->{c});
+ if($idx->nelem) {
+ $x->range($idx) .= $o->{bad};
+ $y->range($idx) .= $o->{bad};
+ }
+
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+ my($x) = $d->((0));
+ my($y) = $d->((1));
+
+ my $rho = sqrt(($d->(0:1)*$d->(0:1))->sumover);
+ # Order is important -- ((0)) overwrites $x if is_inplace!
+ $out->((0)) .= atan2( $x * sin($rho), $rho * cos $rho );
+ $out->((1)) .= asin( $y * sin($rho) / $rho );
+
+ my $idx = whichND($rho == 0);
+ if($idx->nelem) {
+ $out->((0))->range($idx) .= 0;
+ $out->((1))->range($idx) .= 0;
+ }
+
+ $out->(0:1) /= $o->{conv};
+
+ $out;
+ };
+
+ $me->_finish;
+}
+
+
+######################################################################
+
+=head2 t_az_eqa
+
+=for usage
+
+ $t = t_az_eqa(<options>);
+
+=for ref
+
+(Cartography) Azimuthal equal-area projection (az.; auth.)
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=item c, clip, Clip (default 180 degrees)
+
+The largest angle relative to the origin. Default is the whole sphere.
+
+=back
+
+=cut
+
+sub t_az_eqa {
+ my($me) = _new(@_,"Equal-Area Azimuthal Projection");
+
+ $me->{params}->{c} = topdl(_opt($me->{options},
+ ['c','clip','Clip'],
+ 180) * $me->{params}->{conv});
+
+ $me->{otype} = ['Azimuthal X','Azimuthal Y'];
+ $me->{ounit} = ['Proj. radians','Proj. radians'];
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($ph) = $d->((1)) * $o->{conv};
+ my($th) = $d->((0)) * $o->{conv};
+
+ my($c) = acos(cos($ph) * cos($th));
+ my($rho) = 2 * sin($c/2);
+ my($k) = 1.0/cos($c/2);
+
+ my($x,$y) = ($out->((0)),$out->((1)));
+ $x .= $k * cos($ph) * sin($th);
+ $y .= $k * sin($ph);
+
+ my $idx = whichND($c > $o->{c});
+ if($idx->nelem) {
+ $x->range($idx) .= $o->{bad};
+ $y->range($idx) .= $o->{bad};
+ }
+
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ my($x,$y) = ($d->((0)),$d->((1)));
+ my($ph,$th) = ($out->((0)),$out->((1)));
+ my($rho) = sqrt($x*$x + $y*$y);
+ my($c) = 2 * asin($rho/2);
+
+ $ph .= asin($d->((1)) * sin($c) / $rho);
+ $th .= atan2($x * sin($c),$rho * cos($c));
+
+ $ph /= $o->{conv};
+ $th /= $o->{conv};
+
+ $out;
+ };
+
+ $me->_finish;
+}
+
+
+######################################################################
+
+=head2 t_aitoff
+
+=head2 t_hammer
+
+=for ref
+
+(Cartography) Hammer/Aitoff elliptical projection (az.; auth.)
+
+The Hammer/Aitoff projection is often used to display the Celestial
+sphere. It is mathematically related to the Lambert Azimuthal Equal-Area
+projection (L<t_az_eqa|/t_az_eqa>), and maps the sphere to an ellipse of unit
+eccentricity, with vertical radius sqrt(2) and horizontal radius of
+2 sqrt(2).
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=back
+
+=cut
+
+*t_aitoff = \&t_hammer;
+
+sub t_hammer {
+ my($me) = _new(@_,"Hammer/Aitoff Projection");
+
+ $me->{otype} = ['Longitude','Latitude'];
+ $me->{ounit} = [' ',' '];
+ $me->{odim} = 2;
+ $me->{idim} = 2;
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+ $out->(0:1) *= $o->{conv};
+ my($th) = $out->((0));
+ my($ph) = $out->((1));
+ my($t) = sqrt( 2 / (1 + cos($ph) * cos($th/2)));
+ $th .= 2 * $t * cos($ph) * sin($th/2);
+ $ph .= $t * sin($ph);
+ $out;
+ }
+ ;
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+ my($x) = $out->((0));
+ my($y) = $out->((1));
+
+ my($rej) = which(($x*$x/8 + $y*$y/2)->flat > 1);
+
+ my($zz);
+ my($z) = sqrt( $zz = (1 - $x*$x/16 - $y*$y/4) );
+ $x .= 2 * atan( ($z * $x) / (4 * $zz - 2) );
+ $y .= asin($y * $z);
+
+ $out->(0:1) /= $o->{conv};
+
+ $x->flat->($rej) .= $o->{bad};
+ $y->flat->($rej) .= $o->{bad};
+
+ $out;
+ };
+
+ $me->_finish;
+}
+
+
+######################################################################
+
+=head2 t_vertical, t_zenithal -- vertical perspective projection
+
+=for usage
+
+ $t = t_vertical(<options>);
+
+=for ref
+
+(Cartography) Vertical perspective projection (az.; persp.)
+
+Vertical perspective projection is a generalization of L<gnomonic|/t_gnomonic>
+and L<stereographic|/t_stereographic> projection, and a special case of
+L<perspective|/t_perspective> projection. It is a projection from the
+sphere onto a tangent plane from a point at the camera location.
+
+Vertical projections are also called "zenithal", and t_zenithal is an
+alias for t_vertical.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+=item m, mask, Mask, h, hemisphere, Hemisphere [default 'near']
+
+The hemisphere to keep in the projection (see L<PDL::Transform::Cartography>).
+
+=item r0, R0, radius, d, dist, distance [default 2.0]
+
+The altitude of the focal plane above the center of the sphere. The default
+places the point of view one radius above the surface.
+
+=item t, telescope, Telescope, cam, Camera (default '')
+
+If this is set, then the central scale is in telescope or camera
+angular units rather than in planetary radii. The angular units are
+parsed as with the normal 'u' option for the lon/lat specification.
+If you specify a non-string value (such as 1) then you get telescope-frame
+radians, suitable for working on with other transformations.
+
+=item f, fish, fisheye (default '')
+
+If this is set then the output is in azimuthal equidistant coordinates
+instead of in tangent-plane coordinates. This is a convenience function
+for '(t_az_eqd) x !(t_gnomonic) x (t_vertical)'.
+
+=back
+
+=cut
+
+sub t_vertical {
+ my($me) = _new(@_,'Vertical Perspective');
+ my $p = $me->{params};
+
+ my $m= _opt($me->{options},
+ ['m','mask','Mask','h','hemi','hemisphere','Hemisphere'],
+ 1);
+
+ $me->{otype} = ['Perspective X','Perspective Y'];
+ $me->{ounit} = ['Body radii','Body radii'];
+
+ if($m=~m/^b/i) {
+ $p->{m} = 0;
+ } elsif($m=~m/^n/i) {
+ $p->{m} = 1;
+ } elsif($m=~m/^f/i) {
+ $p->{m} = 2;
+ } else {
+ $p->{m} = $m;
+ }
+
+ $p->{r0} = _opt($me->{options},
+ ['r0','R0','radius','Radius',
+ 'd','dist','distance','Distance'],
+ 2.0
+ );
+
+ if($p->{r0} == 0) {
+ print "t_vertical: r0 = 0; using t_gnomonic instead\n"
+ if($PDL::verbose);
+ return t_gnomonic($me->{options});
+ }
+
+ if($p->{r0} == 1) {
+ print "t_vertical: r0 = 1; using t_stereographic instead\n"
+ if($PDL::verbose);
+ return t_stereographic($me->{options});
+ }
+
+
+ $p->{t} = _opt($me->{options},
+ ['t','tele','telescope','Telescope',
+ 'cam','camera','Camera'],
+ undef);
+
+ $p->{f} = _opt($me->{options},
+ ['f','fish','fisheye','Fisheye'],
+ undef);
+
+ $p->{t} = 'rad'
+ if($p->{f} && !defined($p->{t}));
+
+ $p->{tconv} = _uconv($p->{t},1) || _uconv('rad')
+ if(defined $p->{t});
+
+ $me->{func} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+ my($th) = $d->((0))*$o->{conv};
+ my($ph) = $d->((1))*$o->{conv};
+
+ my($cph) = cos($ph);
+
+ my($cos_c) = $cph * cos($th);
+
+ my($k) = (($o->{r0} - 1) /
+ ($o->{r0} - $cos_c));
+
+ # If it's a telescope perspective, figure the apparent size
+ # of the globe and scale accordingly.
+ if($o->{t}) {
+ my($theta) = asin(1/$o->{r0});
+ }
+
+ $out->(0:1) /= ($o->{r0} - 1.0) * ($o->{f} ? 1.0 : $o->{tconv})
+ if($o->{t});
+
+
+
+ $out->((0)) .= $cph * sin($th);
+ $out->((1)) .= sin($ph);
+
+ # Handle singularity at the origin
+ $k->where(($out->((0)) == 0) & ($out->((1)) == 0)) .= 0;
+ $out->(0:1) *= $k->dummy(0,2);
+
+ if($o->{m}) {
+ my $idx;
+ $idx = whichND($cos_c < 1.0/$o->{r0})
+ if($o->{m} == 1);
+ $idx = whichND($cos_c > 1.0/$o->{r0})
+ if($o->{m} == 2);
+
+ if(defined $idx && ref $idx eq 'PDL' && $idx->nelem){
+ $out->((0))->range($idx) .= $o->{bad};
+ $out->((1))->range($idx) .= $o->{bad};
+ }
+ }
+
+
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+ my($out) = $d->is_inplace ? $d : $d->copy;
+
+ # Reverse the hemisphere if the mask is set to 'far'
+ my($P) = ($o->{m} == 2) ? -$o->{r0} : $o->{r0};
+
+ $out->(0:1) *= ($P - 1.0) * ($o->{f} ? 1.0 : $o->{tconv})
+ if($o->{t});
+
+ my($rho) = sqrt(sumover($d->(0:1) * $d->(0:1)));
+ my($sin_c) = ( ( $P - sqrt( 1 - ($rho*$rho * ($P+1)/($P-1)) ) ) /
+ ( ($P-1)/$rho + $rho/($P-1) )
+ );
+
+ my($cos_c) = sqrt(1 - $sin_c*$sin_c);
+
+ # Switch c's quadrant where necessary, by inverting cos(c).
+ if($P<0) {
+ my $idx = whichND($rho > ($P-1/$P));
+ $cos_c->range($idx) *= -1
+ if($idx->nelem > 0);
+ }
+
+
+ $out->((0)) .= atan( $d->((0)) * $sin_c / ($rho * $cos_c) );
+ $out->((1)) .= asin( $d->((1)) * $sin_c / $rho );
+
+ $out->(0:1) /= $o->{conv};
+
+ $out;
+ };
+
+
+ # Compose on both front and back as necessary.
+ return t_compose( t_scale(1.0/$p->{tconv}),
+ t_az_eqd,
+ t_gnomonic->inverse,
+ $me->_finish )
+ if($p->{f});
+
+ $me->_finish;
+ }
+
+*t_zenithal = \&t_vertical;
+
+######################################################################
+
+=head2 t_perspective
+
+=for usage
+
+ $t = t_perspective(<options>);
+
+=for ref
+
+(Cartography) Arbitrary perspective projection
+
+Perspective projection onto a focal plane from an arbitrary location
+within or without the sphere, with an arbitary central look direction,
+and with correction for magnification within the optical system.
+
+In the forward direction, t_perspective generates perspective views of
+a sphere given (lon/lat) mapping or vector information. In the reverse
+direction, t_perspective produces (lon/lat) maps from aerial or distant
+photographs of spherical objects.
+
+Viewpoints outside the sphere treat the sphere as opaque by default,
+though you can use the 'm' option to specify either the near or far
+surface (relative to the origin). Viewpoints below the surface treat
+the sphere as transparent and undergo a mirror reversal for
+consistency with projections that are special cases of the perspective
+projection (e.g. t_gnomonic for r0=0 or t_stereographic for r0=-1).
+
+Magnification correction handles the extra edge distortion due to
+higher angles between the focal plane and focused rays within the
+optical system of your camera. If you do not happen to know the
+magnification of your camera, a simple rule of thumb is that the
+magnification of a reflective telescope is roughly its focal length
+(plate scale) divided by its physical length; and the magnification of
+a compound refractive telescope is roughly twice its physical length divided
+by its focal length. Simple optical sytems with a single optic have
+magnification = 1. Fisheye lenses have magnification < 1.
+
+This transformation was derived by direct geometrical calculation
+rather than being translated from Voxland & Snyder.
+
+OPTIONS
+
+=over 3
+
+=item STANDARD POSITIONAL OPTIONS
+
+As always, the 'origin' field specifies the sub-camera point on the
+sphere.
+
+The 'roll' option is the roll angle about the sub-camera point, for
+consistency with the other projectons.
+
+=item p, ptg, pointing, Pointing (default (0,0,0))
+
+The pointing direction, in (horiz. offset, vert. offset, roll) of the
+camera relative to the center of the sphere. This is a spherical
+coordinate system with the origin pointing directly at the sphere and
+the pole pointing north in the pre-rolled coordinate system set by the
+standard origin. It's most useful for space-based images taken some distance
+from the body in question (e.g. images of other planets or the Sun).
+
+Be careful not to confuse 'p' (pointing) with 'P' (P angle, a standard
+synonym for roll).
+
+=item c, cam, camera, Camera (default undef)
+
+Alternate way of specifying the camera pointing, using a spherical
+coordinate system with poles at the zenith (positive) and nadir
+(negative) -- this is useful for aerial photographs and such, where
+the point of view is near the surface of the sphere. You specify
+(azimuth from N, altitude from horizontal, roll from vertical=up). If
+you specify pointing by this method, it overrides the 'pointing'
+option, above. This coordinate system is most useful for aerial photography
+or low-orbit work, where the nadir is not necessarily the most interesting
+part of the scene.
+
+=item r0, R0, radius, d, dist, distance [default 2.0]
+
+The altitude of the point of view above the center of the sphere.
+The default places the point of view 1 radius aboove the surface.
+Do not confuse this with 'r', the standard origin roll angle! Setting
+r0 < 1 gives a viewpoint inside the sphere. In that case, the images are
+mirror-reversed to preserve the chiralty of the perspective. Setting
+r0=0 gives gnomonic projections; setting r0=-1 gives stereographic projections.
+Setting r0 < -1 gives strange results.
+
+=item iu, im_unit, image_unit, Image_Unit (default 'degrees')
+
+This is the angular units in which the viewing camera is calibrated
+at the center of the image.
+
+=item mag, magnification, Magnification (default 1.0)
+
+This is the magnification factor applied to the optics -- it affects the
+amount of tangent-plane distortion within the telescope.
+1.0 yields the view from a simple optical system; higher values are
+telescopic, while lower values are wide-angle (fisheye). Higher
+magnification leads to higher angles within the optical system, and more
+tangent-plane distortion at the edges of the image.
+The magnification is applied to the incident angles themselves, rather than
+to their tangents (simple two-element telescopes magnify tan(theta) rather
+than theta itself); this is appropriate because wide-field optics more
+often conform to the equidistant azimuthal approximation than to the
+tangent plane approximation. If you need more detailed control of
+the relationship between incident angle and focal-plane position,
+use mag=1.0 and compose the transform with something else to tweak the
+angles.
+
+=item m, mask, Mask, h, hemisphere, Hemisphere [default 'near']
+
+'hemisphere' is by analogy to other cartography methods although the two
+regions to be selected are not really hemispheres.
+
+=item f, fov, field_of_view, Field_Of_View [default 60 degrees]
+
+The field of view of the telescope -- sets the crop radius on the
+focal plane. If you pass in a scalar, you get a circular crop. If you
+pass in a 2-element list ref, you get a rectilinear crop, with the
+horizontal 'radius' and vertical 'radius' set separately.
+
+=back
+
+EXAMPLES
+
+Model a camera looking at the Sun through a 10x telescope from Earth
+(~230 solar radii from the Sun), with an 0.5 degree field of view and
+a solar P (roll) angle of 30 degrees, in February (sub-Earth solar
+latitude is 7 degrees south). Convert a solar FITS image taken with
+that camera to a FITS lon/lat map of the Sun with 20 pixels/degree
+latitude:
+
+ # Define map output header (no need if you don't want a FITS output map)
+ $maphdr = {NAXIS1=>7200,NAXIS2=>3600, # Size of image
+ CTYPE1=>longitude,CTYPE2=>latitude, # Type of axes
+ CUNIT1=>deg,CUNIT2=>deg, # Unit of axes
+ CDELT1=>0.05,CDELT2=>0.05, # Scale of axes
+ CRPIX1=>3601,CRPIX2=>1801, # Center of map
+ CRVAL1=>0,CRVAL2=>0 # (lon,lat) of center
+ };
+
+ # Set up the perspective transformation, and apply it.
+ $t = t_perspective(r0=>229,fov=>0.5,mag=>10,P=>30,B=>-7);
+ $map = $im->map( $t , $maphdr );
+
+Draw an aerial-view map of the Chesapeake Bay, as seen from a sounding
+rocket at an altitude of 100km, looking NNE from ~200km south of
+Washington (the radius of Earth is 6378 km; Washington D.C. is at
+roughly 77W,38N). Superimpose a linear coastline map on a photographic map.
+
+ $a = graticule(1,0.1)->glue(1,earth_coast());
+ $t = t_perspective(r0=>6478/6378.0,fov=>60,cam=>[22.5,-20],o=>[-77,36])
+ $w = pgwin(size=>[10,6],J=>1);
+ $w->fits_imag(earth_image()->map($t,[800,500],{m=>linear}));
+ $w->hold;
+ $w->lines($a->apply($t),{xt=>'Degrees',yt=>'Degrees'});
+ $w->release;
+
+Model a 5x telescope looking at Betelgeuse with a 10 degree field of view
+(since the telescope is looking at the Celestial sphere, r is 0 and this
+is just an expensive modified-gnomonic projection).
+
+ $t = t_perspective(r0=>0,fov=>10,mag=>5,o=>[88.79,7.41])
+
+=cut
+
+sub t_perspective {
+ my($me) = _new(@_,'Focal-Plane Perspective');
+ my $p = $me->{params};
+
+ my $m= _opt($me->{options},
+ ['m','mask','Mask','h','hemi','hemisphere','Hemisphere'],
+ 1);
+ $p->{m} = $m;
+ $p->{m} = 0 if($m=~m/^b/i);
+ $p->{m} = 1 if($m=~m/^n/i);
+ $p->{m} = 2 if($m=~m/^f/i);
+
+ $p->{r0} = _opt($me->{options},
+ ['r0','R0','radius','Radius',
+ 'd','dist','distance','Distance'],
+ 2.0
+ );
+
+ $p->{iu} = _opt($me->{options},
+ ['i','iu','image_unit','Image_Unit'],
+ 'degrees');
+
+ $p->{tconv} = _uconv($p->{iu});
+
+ $p->{mag} = _opt($me->{options},
+ ['mag','magnification','Magnification'],
+ 1.0);
+
+ # Regular pointing pseudovector -- make sure there are exactly 3 elements
+ $p->{p} = (topdl(_opt($me->{options},
+ ['p','ptg','pointing','Pointing'],
+ [0,0,0])
+ )
+ * $p->{tconv}
+ )->append(zeroes(3))->(0:2);
+
+ $p->{pmat} = _rotmat( (- $p->{p})->list );
+
+ # Funky camera pointing pseudovector overrides normal pointing option
+ $p->{c} = _opt($me->{options},
+ ['c','cam','camera','Camera'],
+ undef
+ );
+
+ if(defined($p->{c})) {
+ $p->{c} = (topdl($p->{c}) * $p->{tconv})->append(zeroes(3))->(0:2);
+
+ $p->{pmat} = ( _rotmat( 0,-$PI/2,0 ) x
+ _rotmat( (-$p->{c})->list )
+ );
+ }
+
+ # Reflect X axis if we're inside the sphere.
+ if($p->{r0}<1) {
+ $p->{pmat} = topdl([[-1,0,0],[0,1,0],[0,0,1]]) x $p->{pmat};
+ }
+
+ $p->{f} = ( _opt($me->{options},
+ ['f','fov','field_of_view','Field_of_View'],
+ topdl($PI*2/3) / $p->{tconv} / $p->{mag} )
+ * $p->{tconv}
+ );
+
+ $me->{otype} = ['Tan X','Tan Y'];
+ $me->{ounit} = [$p->{iu},$p->{iu}];
+
+ # "Prefilter" -- subsidiary transform to convert the
+ # spherical coordinates to 3-D coords in the viewer's
+ # reference frame (Y,Z are more-or-less tangent-plane X and Y,
+ # and -X is the direction toward the planet, before rotation
+ # to account for pointing).
+
+ $me->{params}->{prefilt} =
+ t_compose(
+ # Offset for the camera pointing.
+ t_linear(m=>$p->{pmat},
+ d=>3),
+
+ # Rotate the sphere so the correct origin is at the
+ # maximum-X point, then move the whole thing in the
+ # -X direction by r0.
+ t_linear(m=>(_rotmat($p->{o}->at(0),
+ $p->{o}->at(1),
+ $p->{roll}->at(0))
+ ),
+ d=>3,
+ post=> topdl( [- $me->{params}->{r0},0,0] )
+ ),
+
+ # Put initial sci. coords into Cartesian space
+ t_unit_sphere(u=>'radian')
+ );
+
+ # Store the origin of the sphere -- useful for the inverse function
+ $me->{params}->{sph_origin} = (
+ topdl([-$me->{params}->{r0},0,0]) x
+ $p->{pmat}
+ )->(:,(0));
+
+ #
+ # Finally, the meat -- the forward function!
+ #
+ $me->{func} = sub {
+ my($d,$o) = @_;
+
+ my($out) = $d->is_inplace ? $d : $d->copy;
+ $out->(0:1) *= $o->{conv};
+
+ # If we're outside the sphere, do hemisphere filtering
+ my $idx;
+ if(abs($o->{r0}) < 1 ) {
+ $idx = null;
+ } else {
+ # Great-circle distance to origin
+ my($cos_c) = ( sin($o->{o}->((1))) * sin($out->((1)))
+ +
+ cos($o->{o}->((1))) * cos($out->((1))) *
+ cos($out->((0)) - $o->{o}->((0)))
+ );
+
+ my($thresh) = (1.0/$o->{r0});
+
+ if($o->{m}==1) {
+ $idx = whichND($cos_c < $thresh);
+ } elsif($o->{m}==2) {
+ $idx = whichND($cos_c > $thresh);
+ } else {
+ $idx = null;
+ }
+ }
+
+ ### Transform everything -- just chuck out the bad points at the end.
+
+ ## convert to 3-D viewer coordinates (there's a dimension change!)
+ my $dc = $out->apply($o->{prefilt});
+
+ ## Apply the tangent-plane transform, and scale by the magnification.
+ my $dcyz = $dc->(1:2);
+
+ my $r = ( $dcyz * $dcyz ) -> sumover -> sqrt ;
+ my $rscale;
+ if( $o->{mag} == 1.0 ) {
+ $rscale = - 1.0 / $dc->((0));
+ } else {
+ print "(using magnification...)\n" if $PDL::verbose;
+ $rscale = - tan( $o->{mag} * atan( $r / $dc->((0)) ) ) / $r;
+ }
+ $r *= $rscale;
+ $out->(0:1) .= $dcyz * $rscale->dummy(0,1);
+
+ # Chuck points that are outside the FOV: glue those points
+ # onto the removal list. The conditional works around a bug
+ # in 2.3.4cvs and earlier: null piddles make append() crash.
+ my $w;
+ if(ref $o->{f} eq 'ARRAY') {
+ $w = whichND( ( abs($dcyz->((0))) > $o->{f}->[0] ) |
+ ( abs($dcyz->((1))) > $o->{f}->[1] ) |
+ ($r < 0)
+ );
+ } else {
+ $w = whichND( ($r > $o->{f}) | ($r < 0) );
+ }
+
+ $idx = ($idx->nelem) ? $idx->glue(1,$w) : $w
+ if($w->nelem);
+
+ if($idx->nelem) {
+ $out->((0))->range($idx) .= $o->{bad};
+ $out->((1))->range($idx) .= $o->{bad};
+ }
+
+ ## Scale by the output conversion factor
+ $out->(0:1) /= $o->{tconv};
+
+ $out;
+ };
+
+
+ #
+ # Inverse function
+ #
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+
+ my($out) = $d->is_inplace ? $d : $d->copy;
+ $out->(0:1) *= $o->{tconv};
+
+ my $oyz = $out->(0:1) ;
+
+ ## Inverse-magnify if required
+ if($o->{mag} != 1.0) {
+ my $r = ($oyz * $oyz)->sumover->sqrt;
+ my $scale = tan( atan( $r ) / $o->{mag} ) / $r;
+ $out->(0:1) *= $scale->dummy(0,1);
+ }
+
+ ## Solve for the X coordinate of the surface.
+ ## This is a quadratic in the tangent-plane coordinates;
+ ## so here we just figure out the coefficients and plug into
+ ## the quadratic formula. $b here is actually -B/2.
+ my $a = ($oyz * $oyz)->sumover + 1;
+ my $b = ( $o->{sph_origin}->((0))
+ - ($o->{sph_origin}->(1:2) * $oyz)->sumover
+ );
+ my $c = topdl($o->{r0}*$o->{r0} - 1);
+
+ my $x;
+ if($o->{m} == 2) {
+ # Exceptional case: mask asks for the far hemisphere
+ $x = - ( $b - sqrt($b*$b - $a * $c) ) / $a;
+ } else {
+ # normal case: mask asks for the near hemisphere
+ $x = - ( $b + sqrt($b*$b - $a * $c) ) / $a;
+ }
+
+ ## Assemble the 3-space coordinates of the points
+ my $int = $out->(0)->append($out);
+ $int->sever;
+ $int->((0)) .= -1.0;
+ $int->(0:2) *= $x->dummy(0,3);
+
+ ## convert back to (lon,lat) coordinates...
+ $out .= $int->invert($o->{prefilt});
+
+ # If we're outside the sphere, do hemisphere filtering
+ my $idx;
+ if(abs($o->{r0}) < 1 ) {
+ $idx = null;
+ } else {
+ # Great-circle distance to origin
+ my($cos_c) = ( sin($o->{o}->((1))) * sin($out->((1)))
+ +
+ cos($o->{o}->((1))) * cos($out->((1))) *
+ cos($out->((0)) - $o->{o}->((0)))
+ );
+
+ my($thresh) = (1.0/$o->{r0});
+
+ if($o->{m}==1) {
+ $idx = whichND($cos_c < $thresh);
+ } elsif($o->{m}==2) {
+ $idx = whichND($cos_c > $thresh);
+ }
+ else {
+ $idx = null;
+ }
+ }
+
+ ## Convert to the units the user requested
+ $out->(0:1) /= $o->{conv};
+
+ ## Mark bad values
+ if($idx->nelem) {
+ $out->((0))->range($idx) .= $o->{bad};
+ $out->((1))->range($idx) .= $o->{bad};
+ }
+
+ $out;
+
+ };
+
+ $me;
+ }
+
+1;
diff --git a/Lib/Transform/Cartography/Makefile.PL b/Lib/Transform/Cartography/Makefile.PL
new file mode 100644
index 0000000..6c812c2
--- /dev/null
+++ b/Lib/Transform/Cartography/Makefile.PL
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+
+# "Globe/Globe.pm" puts Globe.pm in the correct subdir!
+WriteMakefile(
+ 'NAME' => 'PDL::Transform::Cartography',
+ VERSION_FROM => '../../../Basic/Core/Version.pm',
+ PM => { (map {($_ => '$(INST_LIBDIR)/'.$_)} <*.pm>),
+ (map {($_ => '$(INST_LIBDIR)/Cartography/'.$_)} <*.fits *.jpg>)},
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
+
diff --git a/Lib/Transform/Cartography/earth_coast.vec.fits b/Lib/Transform/Cartography/earth_coast.vec.fits
new file mode 100644
index 0000000..8f1e462
Binary files /dev/null and b/Lib/Transform/Cartography/earth_coast.vec.fits differ
diff --git a/Lib/Transform/Cartography/earth_day.jpg b/Lib/Transform/Cartography/earth_day.jpg
new file mode 100644
index 0000000..5d7c96f
Binary files /dev/null and b/Lib/Transform/Cartography/earth_day.jpg differ
diff --git a/Lib/Transform/Cartography/earth_night.jpg b/Lib/Transform/Cartography/earth_night.jpg
new file mode 100644
index 0000000..5d3e0bb
Binary files /dev/null and b/Lib/Transform/Cartography/earth_night.jpg differ
diff --git a/Lib/Transform/Makefile.PL b/Lib/Transform/Makefile.PL
new file mode 100644
index 0000000..98a3f56
--- /dev/null
+++ b/Lib/Transform/Makefile.PL
@@ -0,0 +1,13 @@
+use ExtUtils::MakeMaker;
+
+ at pack = (["transform.pd",Transform,PDL::Transform]);
+%hash = pdlpp_stdargs_int(@::pack);
+$hash{DIR} = ['Cartography', 'Proj4'];
+
+WriteMakefile( %hash );
+
+sub MY::postamble {
+ pdlpp_postamble_int(@::pack);
+}
+
+
diff --git a/Lib/Transform/Proj4/Makefile.PL b/Lib/Transform/Proj4/Makefile.PL
new file mode 100644
index 0000000..aeecd76
--- /dev/null
+++ b/Lib/Transform/Proj4/Makefile.PL
@@ -0,0 +1,211 @@
+#
+# Makefile.PL for PDL::Transform::Proj4
+#
+# Judd Taylor, USF IMaRS
+# 18 March 2003
+#
+use strict;
+use warnings;
+
+use Config;
+
+BEGIN {
+ print STDERR join "\n", sort grep { m/Carp/ } keys %INC;
+ print STDERR "*****************************************\n";
+ use lib '../../../inc';
+ if (($^V eq v5.8.8 or $] >= 5.016 and $] < 5.017) and exists $INC{'Carp.pm'}) {
+ warn "Carp initially at: $INC{'Carp.pm'}\n";
+ delete $INC{'Carp.pm'};
+ eval "use Carp";
+ }
+ if (($^V eq 'v5.8.8' or $] >= 5.016 and $] < 5.017) and exists $INC{'Carp/Heavy.pm'}) {
+ warn "Carp initially at: $INC{'Carp/Heavy.pm'}\n";
+ delete $INC{'Carp/Heavy.pm'};
+ eval "use Carp::Heavy";
+ }
+ print STDERR "*****************************************\n";
+ print STDERR join "\n", sort grep { m/Carp/ } keys %INC;
+ use Devel::CheckLib;
+}
+
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+my $package_name;
+my $transform_proj4_lib_path;
+my $include_path;
+my $donot;
+
+BEGIN
+{
+ # Generic descripton of how to optionally add this package to the PDL Tree:
+ $package_name = "PDL::Transform::Proj4";
+ my $lib_name = "Proj4";
+ my $find_libs = [ 'libproj.so', 'libproj.a' ];
+ my $find_incs = [ 'proj_api.h' ];
+ my $config_flag = 'WITH_PROJ';
+ my $config_libs = 'PROJ_LIBS';
+ my $config_incs = 'PROJ_INC';
+ my @lib_locations = (
+ '/usr/lib64',
+ '/usr/local/lib64',
+ '/lib64',
+ '/usr/lib',
+ '/usr/local/lib',
+ '/lib',
+ split(/ /, $Config{libpth}),
+ );
+ my @inc_locations = (
+ '/usr/include',
+ '/usr/local/include',
+ $Config{usrinc},
+ );
+
+ #
+ # You probably won't need to edit anything below here (until the very end):
+ #
+
+ my $msg = "";
+ my $forcebuild=0; # Note: forcebuild not used
+
+ if (defined $PDL::Config{$config_flag} && $PDL::Config{$config_flag}==0)
+ {
+ $msg = "\n Will skip build of $package_name on this system \n";
+ goto skip;
+ }
+
+ if (defined $PDL::Config{$config_flag} && $PDL::Config{$config_flag}==1)
+ {
+ print "\n Will forcibly try and build $package_name on this system \n\n";
+ $forcebuild=1;
+ }
+
+ # Look for Proj4 includes/libs
+
+ # get locations from perldl.conf, if specified there:
+ @lib_locations = @{$PDL::Config{$config_libs}}
+ if( defined $PDL::Config{$config_libs} );
+ @inc_locations = @{$PDL::Config{$config_incs}}
+ if( defined $PDL::Config{$config_incs} );
+
+ #
+ # Do the search:
+ #
+
+ my $fl; #fl stores find_lib iterator for use in $msg
+
+ foreach my $libdir ( @lib_locations )
+ {
+ my $found = 0;
+ foreach my $find_lib ( @$find_libs )
+ {
+ $fl = $find_lib;
+ if ( -e "$libdir/$find_lib" )
+ {
+ $transform_proj4_lib_path = $libdir; # use a variable name that's unique to this Makefile.PL
+ print "\t$package_name: Found $libdir/$find_lib\n";
+ $found = 1;
+ }
+ last if $found;
+ }
+ last if $found;
+ } # foreach $libdir...
+
+ unless( defined( $transform_proj4_lib_path ) )
+ {
+ $msg .= "\tCannot find $lib_name library, $fl.\n"
+ . "\tPlease add the correct library path to Makefile.PL or install $lib_name.\n";
+ }
+
+
+ # Look for the include files:
+ my $fi;
+ foreach my $incdir ( @inc_locations )
+ {
+ foreach my $find_inc ( @$find_incs )
+ {
+ $fi = $find_inc;
+ if ( -e "$incdir/$find_inc" )
+ {
+ $include_path = $incdir;
+ last;
+ }
+ }
+ }
+
+ unless( defined( $include_path ) )
+ {
+ $msg .= "\tCannot find $lib_name header file, $fi.\n"
+ . "\tPlease add the correct library path to Makefile.PL or install $lib_name.\n";
+ }
+
+ #
+ # Make sure everything we wanted is found:
+ #
+ unless( defined( $include_path ) && defined( $transform_proj4_lib_path ) )
+ {
+ $msg .= " Skipping build of $package_name.\n";
+ }
+
+ skip:
+
+ if ($msg && $forcebuild==0)
+ {
+ warn " Testing support libraries for $package_name:\n$msg\n";
+ $msg =~ s/\n//g;
+ write_dummy_make( $msg );
+ $donot = 1;
+ $PDL::Config{$config_flag}=0;
+ }
+ else
+ {
+ my $infomsg = 'check for projUV';
+ my $header = 'proj_api.h';
+ my $include = "#include <$header>";
+ my $progbody = 'projUV puv = { 5.0, 10.0 };';
+ my $libs = "-L$transform_proj4_lib_path -lproj -lm";
+ my $cflags = "-I$include_path";
+
+ if (trylink($infomsg,$include,$progbody,$libs,$cflags) or $forcebuild) {
+ # now see if pj_init works
+ ## print STDERR "header=>$header, LIBS=>$libs, INC=>$cflags, function=>'projPJ mypj = pj_init_plus(\"+proj=eqc +lon_0=0\"); if (! mypj) return 1; else return 0;'\n";
+
+ if (
+ check_lib(
+ function=>'projPJ mypj = pj_init_plus("+proj=eqc +lon_0=0"); if (! mypj) return 1; else return 0;',
+ header=>$header,
+ incpath=>$include_path,
+ lib=>'proj',
+ libpath=>$transform_proj4_lib_path,
+ ) or $forcebuild) {
+ print " Building $package_name. Turn off $config_flag if there are any problems\n\n";
+ $PDL::Config{$config_flag}=1;
+ $donot = 0;
+ }
+ else {
+ warn " PROJ4 library found but cannot initialize projection, won't build\n";
+ $PDL::Config{$config_flag}=0;
+ $donot = 1;
+ }
+ }
+ else {
+ warn " Include+Library configuration for PROJ4 does not support the projUV type\n";
+ $PDL::Config{$config_flag}=0;
+ $donot = 1;
+ }
+ }
+
+} # BEGIN...
+
+return if $donot; # yes, this must be return (exit will kill Makefile.PL process)
+
+my $ppfile = "Proj4.pd";
+my $package = [$ppfile, 'Proj4', $package_name];
+my %hash = pdlpp_stdargs($package);
+$hash{VERSION_FROM} = $ppfile;
+#$hash{TYPEMAPS} = [&PDL_TYPEMAP()];
+$hash{LIBS} = ["-L$transform_proj4_lib_path -lproj -lm"];
+$hash{INC} = PDL_INCLUDE() . " -I$include_path";
+WriteMakefile(%hash);
+
+sub MY::postamble { pdlpp_postamble_int( $package ); }
diff --git a/Lib/Transform/Proj4/Proj4.pd b/Lib/Transform/Proj4/Proj4.pd
new file mode 100644
index 0000000..235557d
--- /dev/null
+++ b/Lib/Transform/Proj4/Proj4.pd
@@ -0,0 +1,531 @@
+ #
+# Proj4.pd
+#
+# PDL::PP Definition file for the PDL::Transform::Proj4 module
+#
+# Judd Taylor, USF IMaRS
+# 4 Apr 2006
+#
+
+use strict;
+
+# It won't build without this:
+# 8 Aug 2006 - JT - Well, I guess it can!
+#use lib '../../../blib/lib';
+#use lib '../../../blib/arch';
+
+use PDL;
+#use PDL::Transform; # This is not needed, and just causes trouble!
+use PDL::GIS::Proj;
+
+use vars qw( $VERSION );
+$VERSION = "1.32";
+
+pp_add_isa( 'PDL::Transform' );
+
+# This array holds the list of functions we want to export (everything here is explicit!)
+#
+my @export_funcs = ();
+
+pp_addbegin( <<'ENDBEGIN' );
+use PDL;
+use PDL::NiceSlice;
+use PDL::Transform;
+use PDL::GIS::Proj;
+ENDBEGIN
+
+#
+# Put in the general projection:
+#
+pp_addpm( { At => 'Top' }, <<'ENDPM' );
+
+#
+# PDL::Transform::Proj4
+#
+# Judd Taylor, USF IMaRS
+# 4 Apr 2006
+#
+
+=head1 NAME
+
+PDL::Transform::Proj4 - PDL::Transform interface to the Proj4 projection library
+
+=head1 SYNOPSIS
+
+ # Using the generalized proj interface:
+ # Make an orthographic map of Earth
+ use PDL::Transform::Cartography;
+ use PDL::Transform::Proj4;
+ $a = earth_coast();
+ $a = graticule(10,2)->glue(1,$a);
+ $t = t_proj( proj_params => "+proj=ortho +ellps=WGS84 +lon_0=-90 +lat_0=40" );
+ $w = pgwin(xs);
+ $w->lines($t->apply($a)->clean_lines());
+
+ # Using the aliased functions:
+ # Make an orthographic map of Earth
+ use PDL::Transform::Cartography;
+ use PDL::Transform::Proj4;
+ $a = earth_coast();
+ $a = graticule(10,2)->glue(1,$a);
+ $t = t_proj_ortho( ellps => 'WGS84', lon_0 => -90, lat_0 => 40 )
+ $w = pgwin(xs);
+ $w->lines($t->apply($a)->clean_lines());
+
+=head1 DESCRIPTION
+
+Works like PDL::Transform::Cartography, but using the proj library in the background.
+
+Please see the proj library docs at L<http://www.remotesensing.org/proj> for more information
+on proj, and how to use the library.
+
+=head1 GENERALIZED INTERFACE
+
+The main object here is the PDL::Transform::Proj4 object, aliased to the t_proj() function.
+
+This object accepts all of the standard options described below, but mainly is there to be called
+with just the B<proj_params> option defined.
+
+When options are used, they must be used with a '+' before them when placed in the proj_params string,
+but that is not required otherwise. See the SYNOPSIS above.
+
+=head2 ALIASED INTERFACE
+
+Other than t_proj(), all of the other transforms below have been autogenerated, and may not work
+properly. The main problem is determining the parameters a projection requires from the proj
+library itself.
+
+Due to the difficulties in doing this, there may be times when the proj docs specify a parameter
+for a projection that won't work using the anon-hash type specification. In that case, just throw
+that parameter in the proj_params string, and everything should work fine.
+
+=head1 PARAMETERS AVAILABLE IN ALL PROJECTIONS
+
+=head2 General Parameters
+
+=head3 proj_params
+
+This is a string containing the proj "plus style" parameters. This would be similar to what you
+would put on the command line for the 'proj' tool. Like "+proj=ortho +ellps=WGS84 +lon_0=-90 +lat_0=40".
+
+This parameter overrides the others below when it contains parameters that are also specified
+explicitly.
+
+=head3 proj
+
+The proj projection code to use (like ortho...)
+
+=head3 x_0
+
+Cartesian X offset for the output of the transformation
+
+=head3 y_0
+
+Cartesian Y offset for the output of the transformation
+
+=head3 lat_0
+
+Central latitude for the projection.
+NOTE: This may mean other things depending on the projection selected, read the proj docs!
+
+=head3 lon_0
+
+Central longitude for the projection.
+NOTE: This may mean other things depending on the projection selected, read the proj docs!
+
+=head3 units
+
+Cartesian units used for the output of the projection.
+NOTE: Like most of the options here, this is likely useless in the current implementation
+of this library.
+
+=head3 init
+
+Specify a file:unit for proj to use for its runtime defaults. See the proj docs.
+
+=head3 no_defs
+
+Don't load any defaults. See the proj docs.
+
+=head3 over
+
+Normally, the transformation limits the output to between -180 and 180 degrees (or the
+cartesian equivalent), but with this option that behavior is turned off.
+
+=head3 geoc
+
+Input values are geocentric coordinates.
+
+=head2 Earth Figure Parameters
+
+=head3 ellps
+
+Ellipsoid datum to use. Ex: WGS72, WGS74.
+See the proj docs and command line tool for list of possibilities ('proj -le').
+
+=head3 R
+
+Radius of the Earth.
+
+=head3 R_A
+
+Radius of a sphere with equivalent surface area of specified ellipse.
+
+=head3 R_V
+
+Radius of a sphere with equivalent volume of specified ellipse.
+
+=head3 R_a
+
+Arithmetic mean of the major and minor axis, Ra = (a + b)/2.
+
+=head3 R_g
+
+Geometric mean of the major and minor axis, Rg = (ab)1/2.
+
+=head3 R_h
+
+Harmonic mean of the major and minor axis, Rh = 2ab/(a + b).
+
+=head3 R_lat_a=phi
+
+Arithmetic mean of the principle radii at latitude phi.
+
+=head3 R_lat_g=phi
+
+Geometric mean of the principle radii at latitude phi.
+
+=head3 b
+
+Semiminor axis or polar radius
+
+=head3 f
+
+Flattening
+
+=head3 rf
+
+Reciprocal flattening, +rf=1/f
+
+=head3 e
+
+Eccentricity +e=e
+
+=head3 es
+
+Eccentricity squared +es=e2
+
+=cut
+
+
+sub new
+{
+ my $proto = shift;
+ my $sub = "PDL::Transform::Proj4::new()";
+ #print STDERR "$sub: ARGS: [" . join(", ", @_ ) . "]\n";
+ my $class = ref($proto) || $proto;
+ my $self = $class->SUPER::new( @_ );
+
+ bless ($self, $class);
+
+ my $o = $_[0];
+ unless( (ref $o) )
+ { $o = {@_}; }
+
+ #use Data::Dumper;
+ #my $dd2 = Data::Dumper->new( [$o], ["$sub: o"] );
+ #$dd2->Indent(1);
+ #print STDERR $dd2->Dump();
+
+ $self->{name} = "Proj4";
+
+ # Grab our options:
+
+ # Used in the general sense:
+ $self->{params}->{proj_params} = PDL::Transform::_opt( $o, ['proj_params','params'] );
+
+ # Projection options available to all projections:
+ $self->{general_params} = [ qw( proj x_0 y_0 lat_0 lon_0 units init ) ];
+ foreach my $param ( @{ $self->{general_params} } )
+ { $self->{params}->{$param} = PDL::Transform::_opt( $o, [ $param ] ); }
+
+ # Options that have no value (like "+over"):
+ $self->{bool_params} = [ qw( no_defs over geoc ) ];
+ foreach my $param ( @{ $self->{bool_params} } )
+ { $self->{params}->{$param} = ( PDL::Transform::_opt( $o, [ $param ] ) ) ? 'ON' : undef; }
+
+ # Options for the Earth figure: (ellipsoid, etc):
+ $self->{earth_params} = [ qw( ellps R R_A R_V R_a R_g R_h R_lat_a R_lat_g b f rf e es ) ];
+ foreach my $param ( @{ $self->{earth_params} } )
+ { $self->{params}->{$param} = PDL::Transform::_opt( $o, [ $param ] ); }
+
+ # First process the old params that may already be in the string:
+ # These override the specific params set above:
+ if( defined( $self->{params}->{proj_params} ) )
+ {
+ $self->{orig_proj_params} = $self->{params}->{proj_params};
+
+ my @params = split( /\s+/, $self->{orig_proj_params} );
+ foreach my $param ( @params )
+ {
+ if( $param =~ /^\+(\S+)=(\S+)/ )
+ {
+ my ($name, $val) = ($1, $2);
+ $self->{params}->{$name} = $val;
+ #print STDERR "$sub: $name => $val\n";
+ }
+ elsif( $param =~ /^\+(\S+)/ )
+ { # Boolean option
+ $self->{params}->{$1} = 'ON';
+ }
+ }
+ }
+
+ # Update the proj_string to current options:
+ #
+ $self->update_proj_string();
+
+ #my $dd = Data::Dumper->new( [$self->{params}], ["$sub: params"] );
+ #$dd->Indent(1);
+ #print STDERR $dd->Dump();
+
+ ##############################
+ # The meat -- just copy and paste from Transform.pm :)
+ # (and do some proj stuff here as well)
+
+ # Forward transformation:
+ $self->{func} = sub
+ {
+ my $in = shift;
+ my $opt = shift;
+ my $sub = "PDL::Transform::Proj4->{func}()";
+
+ my $out = $in->new_or_inplace();
+
+ # Always set the badflag to 1 here, to handle possible bad projection values:
+ $out->badflag(1);
+
+ PDL::GIS::Proj::fwd_trans_inplace( $out->((0)), $out->((1)), $opt->{proj_params}, 1 );
+ return $out;
+ };
+
+ # Inverse transformation:
+ $self->{inv} = sub
+ {
+ my $in = shift;
+ my $opt = shift;
+ my $sub = "PDL::Transform::Proj4->{inv}()";
+
+ my $out = $in->new_or_inplace();
+
+ # Always set the badflag to 1 here, to handle possible bad projection values:
+ $out->badflag(1);
+
+ PDL::GIS::Proj::inv_trans_inplace( $out->((0)), $out->((1)), $opt->{proj_params}, 1 );
+ return $out;
+ };
+
+ return $self;
+} # End of new()...
+
+sub update_proj_string
+{
+ my $self = shift;
+ my $sub = "PDL::Transform::Proj4::update_proj_string()";
+
+ # (Re)Generate the proj_params string from the options passed:
+ #
+ delete( $self->{params}->{proj_params} );
+ my $proj_string = "";
+
+ foreach my $param ( keys %{ $self->{params} } )
+ {
+ next unless defined( $self->{params}->{$param} );
+
+ $proj_string .= ( $self->{params}->{$param} eq 'ON' )
+ ? "+$param " : " +$param=" . $self->{params}->{$param} . " ";
+ #print STDERR "$sub: Adding \'$proj_string\'...\n";
+ }
+
+ #print STDERR "$sub: Final proj_params: \'$proj_string\'\n";
+
+ $self->{params}->{proj_params} = $proj_string;
+} # End of update_proj_string()...
+
+sub proj_params
+{
+ my $self = shift;
+ $self->update_proj_string();
+ return $self->{params}->{proj_params};
+} # End of proj_params()...
+
+sub t_proj
+{
+ PDL::Transform::Proj4->new( @_ );
+} # End of t_proj()...
+
+1;
+
+ENDPM
+
+#
+# Add the docs for t_proj:
+#
+pp_addpm( { At => 'Middle' }, <<'ENDPM' );
+
+=head1 FUNCTIONS
+
+=head2 t_proj
+
+This is the main entry point for the generalized interface. See above on its usage.
+
+=cut
+
+
+ENDPM
+push( @export_funcs, 't_proj' );
+
+#
+# Add in the auto-getnerated projection classes:
+#
+my $projections = PDL::GIS::Proj::load_projection_information();
+
+foreach my $name ( sort keys %$projections )
+{
+ #print STDERR "Generating code for projection $name...\n";
+
+ my $projection = $projections->{$name};
+
+ # Start out with a blank template:
+ my $template = <<'ENDTEMPLATE';
+
+#
+# Autogenerated code for the Proj4 projection code:
+# INSERT_NAME_HERE
+#
+package PDL::Transform::Proj4::INSERT_NAME_HERE;
+use PDL::Transform::Proj4;
+ at ISA = ( 'PDL::Transform::Proj4' );
+
+sub new
+{
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $sub = "PDL::Transform::Proj4::INSERT_NAME_HERE::new()";
+ #print STDERR "$sub: ARGS: [" . join(", ", @_ ) . "]\n";
+ my $self = $class->SUPER::new( @_ );
+ bless ($self, $class);
+
+ my $o = $_[0];
+ unless( (ref $o) )
+ { $o = {@_}; }
+
+ #use Data::Dumper;
+ #my $dd2 = Data::Dumper->new( [$o], ["$sub: o"] );
+ #$dd2->Indent(1);
+ #print STDERR $dd2->Dump();
+
+ $self->{name} = "INSERT_FULL_NAME_HERE";
+ $self->{proj_code} = "INSERT_NAME_HERE";
+
+ # Make sure proj is set in the options:
+ $self->{params}->{proj} = $self->{proj_code};
+
+ # Grab our projection specific options:
+ #
+ $self->{projection_params} = [ qw( INSERT_PARAM_LIST_HERE ) ];
+ foreach my $param ( @{ $self->{projection_params} } )
+ { $self->{params}->{$param} = PDL::Transform::_opt( $o, [ $param ] ); }
+
+ $self->update_proj_string();
+
+ #my $dd = Data::Dumper->new( [$self->{params}], ["$sub: params"] );
+ #$dd->Indent(1);
+ #print STDERR $dd->Dump();
+
+ #print STDERR "$sub: Final proj_params: \'" . $self->{params}->{proj_params} . "\'\n";
+
+ return $self;
+} # End of PDL::Transform::INSERT_NAME_HERE::new()...
+
+1;
+
+ENDTEMPLATE
+
+ # Fill in the projection name:
+ $template =~ s/INSERT_NAME_HERE/$name/sg;
+
+ # Fill in the full name of the projection:
+ $template =~ s/INSERT_FULL_NAME_HERE/$projection->{NAME}/sg;
+
+ # Fill in the parameter list:
+ my $param_list = join(' ', @{ $projection->{PARAMS}->{PROJ} } );
+ $template =~ s/INSERT_PARAM_LIST_HERE/$param_list/sg;
+
+ # Add the code to the module:
+ pp_addpm( {At => 'Bot'}, $template );
+
+ # Generate the alias sub:
+ my $alias_name = "t_proj_$name";
+ push( @export_funcs, $alias_name );
+
+
+ my $doc_param_list = "";
+ if( scalar( @{ $projection->{PARAMS}->{PROJ} } ) )
+ {
+ $doc_param_list .= "\nProjection Parameters\n\n=for options\n\n=over 4\n\n";
+ foreach my $param ( sort @{ $projection->{PARAMS}->{PROJ} } )
+ { $doc_param_list .= "=item $param\n\n"; }
+ $doc_param_list .= "=back\n\n";
+ }
+
+ my $alias_template = <<'ENDTEMPLATE';
+=head2 INSERT_ALIAS_NAME_HERE
+
+Autogenerated transformation function for Proj4 projection code INSERT_NAME_HERE.
+
+The full name for this projection is INSERT_FULL_NAME_HERE.
+INSERT_PARAM_LIST_HERE
+
+=cut
+
+
+sub INSERT_ALIAS_NAME_HERE
+ { PDL::Transform::Proj4::INSERT_NAME_HERE->new( @_ ); }
+ENDTEMPLATE
+
+ $alias_template =~ s/INSERT_ALIAS_NAME_HERE/$alias_name/sg;
+ $alias_template =~ s/INSERT_NAME_HERE/$name/sg;
+ $alias_template =~ s/INSERT_FULL_NAME_HERE/$projection->{NAME}/sg;
+ $alias_template =~ s/INSERT_PARAM_LIST_HERE/$doc_param_list/sg;
+
+ pp_addpm( {At => 'Middle'}, $alias_template );
+
+} # for each projection...
+
+pp_add_exported('', join(' ', @export_funcs ) );
+
+
+# Empty pp_def(), so it will actually generate the code below in the output file!
+#
+pp_def( '_proj4_dummy',
+ Pars => 'i(); [o] o();',
+ Doc => undef,
+ Code => ';' );
+
+# Add the end docs:
+#
+pp_addpm( {At => 'Bot'}, <<'ENDDOC');
+
+=head1 AUTHOR & MAINTAINER
+
+Judd Taylor, Orbital Systems, Ltd.
+judd dot t at orbitalsystems dot com
+
+=cut
+
+
+ENDDOC
+
+pp_done();
+
diff --git a/Lib/Transform/Proj4/README b/Lib/Transform/Proj4/README
new file mode 100644
index 0000000..205fc89
--- /dev/null
+++ b/Lib/Transform/Proj4/README
@@ -0,0 +1,53 @@
+NAME
+
+ PDL::Transform::Proj
+
+DESCRIPTION
+
+ This is a port of the Proj library to PDL.
+
+COPYRIGHT NOTICE
+
+ Copyright 2003 Judd Taylor, USF Institute for Marine Remote Sensing (judd at marine.usf.edu).
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ I'm making it GPL now, so I should probably update the above notice!
+
+PREREQUISITES
+
+ Proj4 C library (tested with 4.4.5)
+ Perl (tested with 5.8.0)
+ PDL (tested with 2.3.4 with BadVals)
+
+BUILD INSTRUCTIONS
+
+ 1. Install the Proj4 library if you haven't already.
+
+ 2. Edit the Makefile.PL to point the $proj4_include_path and $proj4_lib_path variables
+ to your installation of the Proj4 library.
+
+ 3. Make the makefiles with the command:
+ shell> perl Makefile.PL
+
+ 4. Build the software with the command:
+ shell> make
+
+ 5. Install the software with the command:
+ shell> make install
+
+ 6. Test the software (option) using the included script test_proj4.pl.
+ NOTE: There are no regression tests yet, but if something is wrong with the install,
+ it will probably break the test script.
+
+USAGE
+
+ See the POD in the lib itself, and check out the test script.
+
+CHANGES
+
+ 1.0: Inital version
+
+
diff --git a/Lib/Transform/Proj4/TODO b/Lib/Transform/Proj4/TODO
new file mode 100644
index 0000000..894f088
--- /dev/null
+++ b/Lib/Transform/Proj4/TODO
@@ -0,0 +1,5 @@
+#
+# TODO for version 1.32 of PDL::Transform::Proj:
+#
+
+
diff --git a/Lib/Transform/transform.pd b/Lib/Transform/transform.pd
new file mode 100644
index 0000000..79309b8
--- /dev/null
+++ b/Lib/Transform/transform.pd
@@ -0,0 +1,3912 @@
+
+pp_addpm({At=>'Top'},<<'+======EOD======');
+
+=head1 NAME
+
+PDL::Transform - Coordinate transforms, image warping, and N-D functions
+
+=head1 SYNOPSIS
+
+use PDL::Transform;
+
+ my $t = new PDL::Transform::<type>(<opt>)
+
+ $out = $t->apply($in) # Apply transform to some N-vectors (Transform method)
+ $out = $in->apply($t) # Apply transform to some N-vectors (PDL method)
+
+ $im1 = $t->map($im); # Transform image coordinates (Transform method)
+ $im1 = $im->map($t); # Transform image coordinates (PDL method)
+
+ $t2 = $t->compose($t1); # compose two transforms
+ $t2 = $t x $t1; # compose two transforms (by analogy to matrix mult.)
+
+ $t3 = $t2->inverse(); # invert a transform
+ $t3 = !$t2; # invert a transform (by analogy to logical "not")
+
+=head1 DESCRIPTION
+
+PDL::Transform is a convenient way to represent coordinate
+transformations and resample images. It embodies functions mapping
+R^N -> R^M, both with and without inverses. Provision exists for
+parametrizing functions, and for composing them. You can use this
+part of the Transform object to keep track of arbitrary functions
+mapping R^N -> R^M with or without inverses.
+
+The simplest way to use a Transform object is to transform vector
+data between coordinate systems. The L<apply|/apply> method
+accepts a PDL whose 0th dimension is coordinate index (all other
+dimensions are threaded over) and transforms the vectors into the new
+coordinate system.
+
+Transform also includes image resampling, via the L<map|/map> method.
+You define a coordinate transform using a Transform object, then use
+it to remap an image PDL. The output is a remapped, resampled image.
+
+You can define and compose several transformations, then apply them
+all at once to an image. The image is interpolated only once, when
+all the composed transformations are applied.
+
+In keeping with standard practice, but somewhat counterintuitively,
+the L<map|/map> engine uses the inverse transform to map coordinates
+FROM the destination dataspace (or image plane) TO the source dataspace;
+hence PDL::Transform keeps track of both the forward and inverse transform.
+
+For terseness and convenience, most of the constructors are exported
+into the current package with the name C<< t_<transform> >>, so the following
+(for example) are synonyms:
+
+ $t = new PDL::Transform::Radial(); # Long way
+
+ $t = t_radial(); # Short way
+
+Several math operators are overloaded, so that you can compose and
+invert functions with expression syntax instead of method syntax (see below).
+
+=head1 EXAMPLE
+
+Coordinate transformations and mappings are a little counterintuitive
+at first. Here are some examples of transforms in action:
+
+ use PDL::Transform;
+ $a = rfits('m51.fits'); # Substitute path if necessary!
+ $ts = t_linear(Scale=>3); # Scaling transform
+
+ $w = pgwin(xs);
+ $w->imag($a);
+
+ ## Grow m51 by a factor of 3; origin is at lower left.
+ $b = $ts->map($a,{pix=>1}); # pix option uses direct pixel coord system
+ $w->imag($b);
+
+ ## Shrink m51 by a factor of 3; origin still at lower left.
+ $c = $ts->unmap($a, {pix=>1});
+ $w->imag($c);
+
+ ## Grow m51 by a factor of 3; origin is at scientific origin.
+ $d = $ts->map($a,$a->hdr); # FITS hdr template prevents autoscaling
+ $w->imag($d);
+
+ ## Shrink m51 by a factor of 3; origin is still at sci. origin.
+ $e = $ts->unmap($a,$a->hdr);
+ $w->imag($e);
+
+ ## A no-op: shrink m51 by a factor of 3, then autoscale back to size
+ $f = $ts->map($a); # No template causes autoscaling of output
+
+=head1 OPERATOR OVERLOADS
+
+=over 3
+
+=item '!'
+
+The bang is a unary inversion operator. It binds exactly as
+tightly as the normal bang operator.
+
+=item 'x'
+
+By analogy to matrix multiplication, 'x' is the compose operator, so these
+two expressions are equivalent:
+
+ $f->inverse()->compose($g)->compose($f) # long way
+ !$f x $g x $f # short way
+
+Both of those expressions are equivalent to the mathematical expression
+f^-1 o g o f, or f^-1(g(f(x))).
+
+=item '**'
+
+By analogy to numeric powers, you can apply an operator a positive
+integer number of times with the ** operator:
+
+ $f->compose($f)->compose($f) # long way
+ $f**3 # short way
+
+=back
+
+=head1 INTERNALS
+
+Transforms are perl hashes. Here's a list of the meaning of each key:
+
+=over 3
+
+=item func
+
+Ref to a subroutine that evaluates the transformed coordinates. It's
+called with the input coordinate, and the "params" hash. This
+springboarding is done via explicit ref rather than by subclassing,
+for convenience both in coding new transforms (just add the
+appropriate sub to the module) and in adding custom transforms at
+run-time. Note that, if possible, new C<func>s should support
+L<inplace|PDL::Core/inplace> operation to save memory when the data are flagged
+inplace. But C<func> should always return its result even when
+flagged to compute in-place.
+
+C<func> should treat the 0th dimension of its input as a dimensional
+index (running 0..N-1 for R^N operation) and thread over all other input
+dimensions.
+
+=item inv
+
+Ref to an inverse method that reverses the transformation. It must
+accept the same "params" hash that the forward method accepts. This
+key can be left undefined in cases where there is no inverse.
+
+=item idim, odim
+
+Number of useful dimensions for indexing on the input and output sides
+(ie the order of the 0th dimension of the coordinates to be fed in or
+that come out). If this is set to 0, then as many are allocated as needed.
+
+=item name
+
+A shorthand name for the transformation (convenient for debugging).
+You should plan on using UNIVERAL::isa to identify classes of
+transformation, e.g. all linear transformations should be subclasses
+of PDL::Transform::Linear. That makes it easier to add smarts to,
+e.g., the compose() method.
+
+=item itype
+
+An array containing the name of the quantity that is expected from the
+input piddle for the transform, for each dimension. This field is advisory,
+and can be left blank if there's no obvious quantity associated with
+the transform. This is analogous to the CTYPEn field used in FITS headers.
+
+=item oname
+
+Same as itype, but reporting what quantity is delivered for each
+dimension.
+
+=item iunit
+
+The units expected on input, if a specific unit (e.g. degrees) is expected.
+This field is advisory, and can be left blank if there's no obvious
+unit associated with the transform.
+
+=item ounit
+
+Same as iunit, but reporting what quantity is delivered for each dimension.
+
+=item params
+
+Hash ref containing relevant parameters or anything else the func needs to
+work right.
+
+=item is_inverse
+
+Bit indicating whether the transform has been inverted. That is useful
+for some stringifications (see the PDL::Transform::Linear
+stringifier), and may be useful for other things.
+
+=back
+
+Transforms should be inplace-aware where possible, to prevent excessive
+memory usage.
+
+If you define a new type of transform, consider generating a new stringify
+method for it. Just define the sub "stringify" in the subclass package.
+It should call SUPER::stringify to generate the first line (though
+the PDL::Transform::Composition bends this rule by tweaking the
+top-level line), then output (indented) additional lines as necessary to
+fully describe the transformation.
+
+=head1 NOTES
+
+Transforms have a mechanism for labeling the units and type of each
+coordinate, but it is just advisory. A routine to identify and, if
+necessary, modify units by scaling would be a good idea. Currently,
+it just assumes that the coordinates are correct for (e.g.) FITS
+scientific-to-pixel transformations.
+
+Composition works OK but should probably be done in a more
+sophisticated way so that, for example, linear transformations are
+combined at the matrix level instead of just strung together
+pixel-to-pixel.
+
+=head1 FUNCTIONS
+
+There are both operators and constructors. The constructors are all
+exported, all begin with "t_", and all return objects that are subclasses
+of PDL::Transform.
+
+The L<apply|/apply>, L<invert|/invert>, L<map|/map>,
+and L<unmap|/unmap> methods are also exported to the C<PDL> package: they
+are both Transform methods and PDL methods.
+
+=cut
+
++======EOD======
+
+
+pp_addpm({At=>'Bot'},<<'+======EOD======');
+
+=head1 AUTHOR
+
+Copyright 2002, 2003 Craig DeForest. There is no warranty. You are allowed
+to redistribute this software under certain conditions. For details,
+see the file COPYING in the PDL distribution. If this file is
+separated from the PDL distribution, the copyright notice should be
+included in the file.
+
+=cut
+
+package PDL::Transform;
+use Carp;
+use overload '""' => \&_strval;
+use overload 'x' => \&_compose_op;
+use overload '**' => \&_pow_op;
+use overload '!' => \&t_inverse;
+
+use PDL;
+use PDL::MatrixOps;
+
+our $PI = 3.1415926535897932384626;
+our $DEG2RAD = $PI / 180;
+our $RAD2DEG = 180/$PI;
+our $E = exp(1);
+
+
+#### little helper kludge parses a list of synonyms
+sub _opt {
+ my($hash) = shift;
+ my($synonyms) = shift;
+ my($alt) = shift; # default is undef -- ok.
+ local($_);
+ foreach $_(@$synonyms){
+ return (UNIVERSAL::isa($alt,'PDL')) ? PDL->pdl($hash->{$_}) : $hash->{$_}
+ if defined($hash->{$_}) ;
+ }
+ return $alt;
+}
+
+######################################################################
+#
+# Stringification hack. _strval just does a method search on stringify
+# for the object itself. This gets around the fact that stringification
+# overload is a subroutine call, not a method search.
+#
+
+sub _strval {
+ my($me) = shift;
+ $me->stringify();
+}
+
+######################################################################
+#
+# PDL::Transform overall stringifier. Subclassed stringifiers should
+# call this routine first then append auxiliary information.
+#
+sub stringify {
+ my($me) = shift;
+ my($mestr) = (ref $me);
+ $mestr =~ s/PDL::Transform:://;
+ my $out = $mestr . " (" . $me->{name} . "): ";
+ $out .= "fwd ". ((defined ($me->{func})) ? ( (ref($me->{func}) eq 'CODE') ? "ok" : "non-CODE(!!)" ): "missing")."; ";
+ $out .= "inv ". ((defined ($me->{inv})) ? ( (ref($me->{inv}) eq 'CODE') ? "ok" : "non-CODE(!!)" ):"missing").".\n";
+}
+
++======EOD======
+
+pp_add_exported('apply');
+pp_addpm(<<'+======EOD_apply======');
+
+=head2 apply
+
+=for sig
+
+ Signature: (data(); PDL::Transform t)
+
+=for usage
+
+ $out = $data->apply($t);
+ $out = $t->apply($data);
+
+=for ref
+
+Apply a transformation to some input coordinates.
+
+In the example, C<$t> is a PDL::Transform and C<$data> is a PDL to
+be interpreted as a collection of N-vectors (with index in the 0th
+dimension). The output is a similar but transformed PDL.
+
+For convenience, this is both a PDL method and a Transform method.
+
+=cut
+
+use Carp;
+
+*PDL::apply = \&apply;
+sub apply {
+ my($me) = shift;
+ my($from) = shift;
+
+ if(UNIVERSAL::isa($me,'PDL')){
+ my($a) = $from;
+ $from = $me;
+ $me = $a;
+ }
+
+ if(UNIVERSAL::isa($me,'PDL::Transform') && UNIVERSAL::isa($from,'PDL')){
+ croak "Applying a PDL::Transform with no func! Oops.\n" unless(defined($me->{func}) and ref($me->{func}) eq 'CODE');
+ my $result = &{$me->{func}}($from,$me->{params});
+ $result->is_inplace(0); # clear inplace flag, just in case.
+ return $result;
+ } else {
+ croak "apply requires both a PDL and a PDL::Transform.\n";
+ }
+
+}
+
++======EOD_apply======
+
+pp_add_exported('invert');
+pp_addpm(<<'+======EOD_invert======');
+
+=head2 invert
+
+=for sig
+
+ Signature: (data(); PDL::Transform t)
+
+=for usage
+
+ $out = $t->invert($data);
+ $out = $data->invert($t);
+
+=for ref
+
+Apply an inverse transformation to some input coordinates.
+
+In the example, C<$t> is a PDL::Transform and C<$data> is a piddle to
+be interpreted as a collection of N-vectors (with index in the 0th
+dimension). The output is a similar piddle.
+
+For convenience this is both a PDL method and a PDL::Transform method.
+
+=cut
+
+*PDL::invert = \&invert;
+sub invert {
+ my($me) = shift;
+ my($data) = shift;
+
+ if(UNIVERSAL::isa($me,'PDL')){
+ my($a) = $data;
+ $data = $me;
+ $me = $a;
+ }
+
+ if(UNIVERSAL::isa($me,'PDL::Transform') && UNIVERSAL::isa($data,'PDL')){
+ croak "Inverting a PDL::Transform with no inverse! Oops.\n" unless(defined($me->{inv}) and ref($me->{inv}) eq 'CODE');
+ my $result = &{$me->{inv}}($data, $me->{params});
+ $result->is_inplace(0); # make sure inplace flag is clear.
+ return $result;
+ } else {
+ croak("invert requires a PDL and a PDL::Transform (did you want 'inverse' instead?)\n");
+ }
+}
+
++======EOD_invert======
+
+pp_addhdr(<<'+==EOD_map_auxiliary==');
+
+
+/*
+ * Singular-value decomposition code is borrowed from
+ * MatrixOps -- cut-and-pasted here because of linker trouble.
+ * It's used by the auxiliary matrix manipulation code, below.
+ *
+ */
+
+void pdl_xform_svd(PDL_Double *W, PDL_Double *Z, int nRow, int nCol)
+{
+ int i, j, k, EstColRank, RotCount, SweepCount, slimit;
+ PDL_Double eps, e2, tol, vt, p, h2, x0, y0, q, r, c0, s0, c2, d1, d2;
+ eps = 1e-6;
+ slimit = nCol/4;
+ if (slimit < 6.0)
+ slimit = 6;
+ SweepCount = 0;
+ e2 = 10.0*nRow*eps*eps;
+ tol = eps*.1;
+ EstColRank = nCol;
+ for (i=0; i<nCol; i++) {
+ for (j=0; j<nCol; j++) {
+ W[nCol*(nRow+i)+j] = 0.0;
+ }
+ W[nCol*(nRow+i)+i] = 1.0; /* rjrw 7/7/99: moved this line out of j loop */
+ }
+ RotCount = EstColRank*(EstColRank-1)/2;
+ while (RotCount != 0 && SweepCount <= slimit)
+ {
+ RotCount = EstColRank*(EstColRank-1)/2;
+ SweepCount++;
+ for (j=0; j<EstColRank-1; j++)
+ {
+ for (k=j+1; k<EstColRank; k++)
+ {
+ p = q = r = 0.0;
+ for (i=0; i<nRow; i++)
+ {
+ x0 = W[nCol*i+j]; y0 = W[nCol*i+k];
+ p += x0*y0; q += x0*x0; r += y0*y0;
+ }
+ Z[j] = q; Z[k] = r;
+ if (q >= r)
+ {
+ if (q<=e2*Z[0] || fabs(p)<=tol*q) RotCount--;
+ else
+ {
+ p /= q; r = 1 - r/q; vt = sqrt(4*p*p+r*r);
+ c0 = sqrt(fabs(.5*(1+r/vt))); s0 = p/(vt*c0);
+ for (i=0; i<nRow+nCol; i++)
+ {
+ d1 = W[nCol*i+j]; d2 = W[nCol*i+k];
+ W[nCol*i+j] = d1*c0+d2*s0; W[nCol*i+k] = -d1*s0+d2*c0;
+ }
+ }
+ }
+ else
+ {
+ p /= r; q = q/r-1; vt = sqrt(4*p*p+q*q);
+ s0 = sqrt(fabs(.5*(1-q/vt)));
+ if (p<0) s0 = -s0;
+ c0 = p/(vt*s0);
+ for (i=0; i<nRow+nCol; i++)
+ {
+ d1 = W[nCol*i+j]; d2 = W[nCol*i+k];
+ W[nCol*i+j] = d1*c0+d2*s0; W[nCol*i+k] = -d1*s0+d2*c0;
+ }
+ }
+ }
+ }
+ while (EstColRank>=3 && Z[(EstColRank-1)]<=Z[0]*tol+tol*tol)
+ EstColRank--;
+ }
+}
+
+
+/*
+ * PDL_xform_aux:
+ * This handles the matrix manipulation part of the Jacobian filtered
+ * mapping code. It's separate from the main code because it's
+ * independent of the data type of the original arrays.
+ *
+ *Given a pre-allocated workspace and
+ * an integer set of coordinates, generate the discrete Jacobian
+ * from the map, pad the singular values, and return the inverse
+ * Jacobian, the largest singular value of the Jacobian itself, and
+ * the determinant of the original Jacobian. Boundary values use the
+ * asymmetric discrete Jacobian; others use the symmetric discrete Jacobian.
+ *
+ * The map and workspace must be of type PDL_D. If the dimensionality is
+ * d, then the workspace must have at least 3*n^2+n elements. The
+ * inverse of the padded Jacobian is returned in the first n^2 elements.
+ * The determinant of the original Jacobian gets stuffed into the n^2
+ * element of the workspace. The largest padded singular value is returned.
+ *
+ */
+
+PDL_Double PDL_xform_aux ( pdl *map, PDL_Long *coords, PDL_Double *tmp, PDL_Double sv_min) {
+ short ndims;
+ PDL_Long i, j, k;
+ PDL_Long offset;
+ PDL_Double det;
+ PDL_Double *jptr;
+ PDL_Double *svptr;
+ PDL_Double *aptr,*bptr;
+ PDL_Double max_sv = 0.0;
+
+ ndims = map->ndims-1;
+
+ /****** Accumulate the Jacobian */
+ /* Accumulate the offset into the map array */
+ for( i=offset=0; i<ndims; i++)
+ offset += coords[i] * map->dimincs[i+1];
+
+ jptr = tmp + ndims*ndims;
+
+ for( i=0; i<ndims; i++) { /* Loop over offset direction */
+ char bot = (coords[i] <=0);
+ char top = (coords[i] >= map->dims[i+1]-1);
+ char symmetric = !(bot || top);
+ PDL_Double *ohi,*olo;
+ PDL_Long diff = map->dimincs[i+1];
+ ohi = ((PDL_Double *)map->data) + ( offset + ( top ? 0 : diff ));
+ olo = ((PDL_Double *)map->data) + ( offset - ( bot ? 0 : diff ));
+
+ for( j=0; j<ndims; j++) { /* Loop over dimension */
+ PDL_Double jel = *ohi - *olo;
+
+ ohi += map->dimincs[0];
+ olo += map->dimincs[0];
+
+ if(symmetric)
+ jel /= 2;
+ *(jptr++) = jel;
+ }
+ }
+
+ /****** Singular-value decompose the Jacobian
+ * The svd routine produces the squares of the singular values,
+ * and requires normalization for one of the rotation matrices.
+ */
+
+ jptr = tmp + ndims*ndims;
+ svptr = tmp + 3*ndims*ndims;
+ pdl_xform_svd(jptr,svptr,ndims,ndims);
+
+ aptr = svptr;
+ for (i=0;i<ndims;i++,aptr++)
+ *aptr = sqrt(*aptr);
+
+
+ /* fix-up matrices here */
+ bptr = jptr;
+ for(i=0; i<ndims;i++) {
+ aptr = svptr;
+ for(j=0;j<ndims;j++)
+ *(bptr++) /= *(aptr++);
+ }
+
+ /****** Store the determinant, and pad the singular values as necessary.*/
+ aptr = svptr;
+ det = 1.0;
+ for(i=0;i<ndims;i++) {
+ det *= *aptr;
+ if(*aptr < sv_min)
+ *aptr = sv_min;
+ if(*aptr > max_sv )
+ max_sv = *aptr;
+ aptr++;
+ }
+
+ /****** Generate the inverse matrix */
+ /* Multiply B-transpose times 1/S times A-transpose. */
+ /* since S is diagonal we just divide by the appropriate element. */
+ /* */
+ aptr = tmp + ndims*ndims;
+ bptr = aptr + ndims*ndims;
+ jptr= tmp;
+
+ for(i=0;i<ndims;i++) {
+ for(j=0;j<ndims;j++) {
+ *jptr = 0;
+
+ for(k=0;k<ndims;k++)
+ *jptr += aptr[j*ndims + k] * bptr[k*ndims + i] / *svptr;
+
+ jptr++;
+ }
+ svptr++;
+ }
+
+ *jptr = det;
+ return max_sv;
+}
+
++==EOD_map_auxiliary==
+
+pp_add_exported('map');
+pp_def('map',
+ Pars=>'k0()', # Dummy to set type (should match the type of "in").
+ OtherPars=>'SV *in; SV *out; SV *map; SV *boundary; SV *method;
+ SV *big; SV *blur; SV *sv_min; SV *flux; SV *bv',
+ Code=><<'+==EOD_map_c_code==',
+/*
+ * Pixel interpolation & averaging code
+ *
+ * Calls a common coordinate-transformation block (see following hdr)
+ * that isn't dependent on the type of the input variable.
+ *
+ * The inputs are SVs to avoid hassling with threadloops; threading
+ * is handled internally. To simplify the threading business, any
+ * thread dimensions should all be collapsed to a single one by the
+ * perl front-end.
+ *
+ */
+
+ short ndims; /* Number of dimensions we're working in */
+ PDL_Double *tmp; /* Workspace for prefrobnication */
+ PDL_Long *ovec; /* output pixel loop vector */
+ PDL_Long *ivec; /* input pixel loop vector */
+ PDL_Long *ibvec; /* input pixel base offset vector */
+ PDL_Double *dvec; /* Residual vector for linearization */
+ PDL_Double *tvec; /* Temporary floating-point vector */
+ PDL_Double *acc; /* Threaded accumulator */
+ char *bounds; /* Boundary condition packed string */
+ char method; /* Method identifier (gets one of 'h','g') */
+ PDL_Long big; /* Max size of input footprint for each pix */
+ PDL_Double blur; /* Scaling of filter */
+ PDL_Double sv_min; /* minimum singular value */
+ char flux; /* Flag to indicate flux conservation */
+ PDL_Double *map_ptr;
+ PDL_Long i, j;
+ $GENERIC() badval = SvNV($COMP(bv));
+
+ pdl *in = PDL->SvPDLV($COMP(in));
+ pdl *out = PDL->SvPDLV($COMP(out));
+ pdl *map = PDL->SvPDLV($COMP(map));
+
+ PDL->make_physical(in);
+ PDL->make_physical(out);
+ PDL->make_physical(map);
+
+ ndims = map->ndims -1;
+
+ /***************************************************************************/
+ /** Check that the dimensionalities are consistent. This is **/
+ /** allegedly done already in the perl part, but should not cost more **/
+ /** than a few hundred clock cycles -- cheap at twice the price. **/
+ /** **/
+ /**/ if(map->ndims != out->ndims) /**/
+ /**/ barf("%s", "Bug in map: index dims aren't consistent\n"); /**/
+ /**/ for(i=0;i<out->ndims-1;i++) { /**/
+ /**/ static char buf[100]; /**/
+ /**/ if(map->dims[i+1] != out->dims[i]) { /**/
+ /**/ sprintf(buf,"Bug in map: dim %d is %d; expected %d\n", /**/
+ /**/ i,map->dims[i+1],out->dims[i]); /**/
+ /**/ barf("%s", buf); /**/
+ /**/ } /**/
+ /**/ } /**/
+ /**/ if(map->dims[0] != in->ndims - 1) /**/
+ /**/ barf("%s", "Bug in map - index vec - input mismatch\n"); /**/
+ /**/ if(out->dims[out->ndims-1] != in->dims[in->ndims-1]) /**/
+ /**/ barf("%s", "Bug in map: thread dimension error\n"); /**/
+ /***************************************************************************/
+
+ /*
+ * Allocate all our dynamic workspaces at once...
+ * */
+ ovec = (PDL_Long *)(PDL->smalloc( (STRLEN)
+ ( sizeof(PDL_Long) * 3 * ndims
+ + sizeof(PDL_Double) * (3*ndims*ndims + 3*ndims)
+ + sizeof(PDL_Double) * in->dims[ndims]
+ + sizeof(char) * ndims )
+ )
+ );
+ ivec = &(ovec[ndims]);
+ ibvec = &(ivec[ndims]);
+ dvec = (PDL_Double *)(&(ibvec[ndims]));
+ tvec = &(dvec[ndims]);
+ acc = &(tvec[ndims]);
+ tmp = &(acc[in->dims[ndims]]);
+ bounds = (char *)(&(tmp [3*ndims*ndims+ndims]));
+
+
+/***
+ * Fill in the boundary condition array
+ * (cut-and-pasted from the range() code...)
+ */
+ {
+ char *bstr;
+ STRLEN blen;
+ bstr = SvPV($COMP(boundary),blen);
+
+ if(blen == 0) {
+ /* If no boundary is specified then every dim gets truncated */
+ int i;
+ for (i=0;i<ndims;i++)
+ bounds[i] = 1;
+ } else {
+ int i;
+ for(i=0;i<ndims;i++) {
+ switch(bstr[i < blen ? i : blen-1 ]) {
+ case '0': case 'f': case 'F': /* forbid */
+ bounds[i] = 0;
+ break;
+ case '1': case 't': case 'T': /* truncate */
+ bounds[i] = 1;
+ break;
+ case '2': case 'e': case 'E': /* extend */
+ bounds[i] = 2;
+ break;
+ case '3': case 'p': case 'P': /* periodic */
+ bounds[i] = 3;
+ break;
+ case '4': case 'm': case 'M': /* mirror */
+ bounds[i] = 4;
+ break;
+ default:
+ {
+ char buf[BUFSIZ];
+ sprintf(buf,"Error in map: Unknown boundary condition '%c'",bstr[i]);
+ barf("%s", buf);
+ }
+ break;
+ }
+ }
+ }
+ }
+
+/***
+ * Parse out the 'method', 'big', 'blur', and 'sv_min' arguments
+ */
+ {
+ char *mstr;
+ STRLEN mlen;
+ mstr = SvPV($COMP(method),mlen);
+
+ if(mlen==0)
+ method = 'h';
+ else switch(*mstr) {
+ case 'h': case 'H':
+ method = 'h'; break;
+ case 'g': case 'G':
+ case 'j': case 'J':
+ method = 'g'; break;
+ default:
+ {
+ char err[80];
+ sprintf(err,"Bug in map: unknown method '%c'",*mstr);
+ barf("%s", err);
+ }
+ break;
+ }
+ }
+ big = labs((PDL_Long) (SvNV($COMP(big))));
+ blur = fabs((PDL_Double) (SvNV($COMP(blur))));
+ sv_min = fabs((PDL_Double) (SvNV($COMP(sv_min))));
+ flux = (SvNV($COMP(flux)) != 0);
+
+ /* End of initialization */
+ /*************************************************************/
+ /* Start of Real Work */
+
+ /* Initialize coordinate vector and map offset
+ */
+ for(i=0;i<ndims;i++)
+ ovec[i] = 0;
+ map_ptr = (PDL_Double *)(map->data);
+
+ /* Main pixel loop */
+ do {
+ PDL_Long psize;
+ PDL_Double wgt;
+
+ /* Prefrobnicate the transformation matrix */
+ psize = (PDL_Long)(blur * PDL_xform_aux(map, ovec, tmp, sv_min) + 0.5 )+1;
+ if(psize <= big) {
+ /*
+ * Use the prefrobnicated matrix to generate a local linearization
+ * dvec gets the delta; ibvec gets the base.
+ */
+ {
+ PDL_Double *mp = map_ptr;
+ for (i=0;i<ndims;i++) {
+ dvec[i] = *mp - ( ibvec[i] = (PDL_Long)(*mp + 0.5)); /* assignment */
+ mp += map->dimincs[0];
+ }
+ }
+
+ /*
+ * Initialize input delta vector
+ */
+ for(i=0;i<ndims;i++)
+ ivec[i] = - psize;
+
+ /*
+ * Initialize accumulators
+ */
+ {
+ PDL_Double *ac = acc;
+ for(i=0; i < in->dims[ndims]; i++)
+ *(ac++) = 0.0;
+ }
+ wgt = 0;
+
+ do { /* Input accumulation loop */
+ int bound_ok = 1;
+ PDL_Long i_off = 0;
+
+ /* Find the offset for the current input point, applying boundaries */
+
+ for(i=0; i<ndims && bound_ok; i++) {
+ j = ivec[i] + ibvec[i];
+ if(j < 0 || j >= in->dims[i]) {
+ switch(bounds[i]) {
+ case 0: /* no breakage allowed */
+ barf("%s", "index out-of-bounds in map");
+ break;
+ case 1: /* truncation */
+ bound_ok = 0;
+ break;
+ case 2: /* extension -- crop */
+ if(j<0)
+ j = 0;
+ else if(j>= in->dims[i])
+ j = in->dims[i] - 1;
+ break;
+ case 3: /* periodic -- mod it */
+ j %= in->dims[i];
+ if(j<0)
+ j += in->dims[i];
+ break;
+ case 4: /* mirror -- reflect off the edges */
+ j += in->dims[i];
+ j %= (in->dims[i] * 2);
+ if(j < 0)
+ j += in->dims[i] * 2;
+ j -= in->dims[i];
+ if(j < 0) {
+ j *= -1;
+ j -= 1;
+ }
+ break;
+ default:
+ barf("%s", "Unknown boundary condition in map -- bug alert!");
+ break;
+ }
+ }
+ i_off += in->dimincs[i] * j;
+ }
+
+ { /* convenience block for bounds handling and data weighting */
+ PDL_Double alpha = 1.0;
+ PDL_Double *ap = tvec;
+ PDL_Double *bp = dvec;
+ PDL_Double *cp;
+ PDL_Long *ip = ivec;
+
+ for(i=0; i<ndims; i++)
+ *(ap++) = *(ip++) - *(bp++);
+
+ /* Calculate the linearization-transformed point, and
+ * infer a weighting from it. Use the per-dimension Hanning
+ * window or a radial Gaussian.
+ */
+ cp = tmp;
+
+ switch(method) {
+ PDL_Double dd;
+
+ case 'h':
+ for(i=0; i<ndims; i++) {
+ dd = 0;
+ ap = tvec;
+ for(j=0;j<ndims; j++)
+ dd += *(ap++) * *(cp++);
+ dd = fabs(dd) / blur;
+ if( dd > 1 ) {
+ alpha = 0;
+ i = ndims;
+ } else
+ alpha *= (0.5 + 0.5 * cos( dd * 3.1415926536 ));
+ }
+ break;
+ case 'g':
+ {PDL_Double sum = 0;
+
+ for(i=0; i<ndims; i++) {
+ dd = 0;
+ ap = tvec;
+ for(j=0;j<ndims; j++)
+ dd += *(ap++) * *(cp++);
+ dd /= blur;
+ sum += dd * dd;
+ if(sum > 4) /* 2 pixels -- four half-widths */
+ i = ndims; /* exit early if this pixel is too far outside the footprint of the ideal point */
+ }
+
+ if(sum > 4)
+ alpha = 0;
+ else
+ alpha = exp(-sum * 1.386294); /* Gaussian, rt(2)-pix HWHM */
+ }
+ break;
+ default:
+ {
+ char buf[80];
+ sprintf(buf,"This can't happen: method='%c'",method);
+ barf("%s", buf);
+ }
+ }
+
+
+
+ if(bound_ok)
+ {
+ PDL_Double *ac = acc;
+ $GENERIC() *dat = (($GENERIC() *)(in->data)) + i_off;
+ for( i=0; i < out->dims[ndims]; i++ ) {
+ *(ac++) += *dat * alpha;
+ dat += in->dimincs[ndims];
+ }
+ wgt += alpha;
+
+ }/* end of bound_ok check */
+
+ } /* end of data collection convenience block */
+
+ /* Advance input accumulation loop */
+ for(i=0;
+ (i < ndims) &&
+ (++(ivec[i]) > psize);
+ i++) {
+ ivec[i] = -psize;
+ }
+ } while(i<ndims); /* end of total data accumulation loop */
+
+ {
+ PDL_Double *ac = acc;
+ $GENERIC() *dat = out->data;
+
+ for(i=0;i<ndims;i++)
+ dat += out->dimincs[i] * ovec[i];
+
+ if(wgt) {
+ if(flux) {
+ PDL_Double det = tmp[ndims*ndims];
+ for(i=0; i < out->dims[ndims]; i++) {
+ *dat = *(ac++) / wgt * det;
+ dat += out->dimincs[ndims];
+ }
+ } else {
+ for(i=0; i < out->dims[ndims]; i++) {
+ *dat = *(ac++) / wgt;
+ dat += out->dimincs[ndims];
+ }
+ }
+ } else { /* wgt==0 */
+ for(i=0;i<out->dims[ndims];i++){
+ *dat = badval;
+ }
+ }
+ }
+
+ /* End of code for normal pixels */
+ } else {
+ /* The pixel was ludicrously huge -- just set this pixel to nan */
+ $GENERIC() *dat = out->data;
+ for(i=0;i<ndims;i++)
+ dat += out->dimincs[i] * ovec[i];
+ for(i=0;i<out->dims[ndims];i++) {
+ *dat = badval; /* Should handle bad values too -- not yet */
+ dat += out->dimincs[ndims];
+ }
+ }
+
+ /* Increment the pixel counter */
+ {
+ PDL_Long *aptr = ovec;
+ for(i=0;
+ (i<ndims) &&
+ (map_ptr += map->dimincs[i+1]) && /* Funky pre-test increment */
+ (++(ovec[i]) >= out->dims[i]); /* Actual carry test */
+ i++) {
+ ovec[i] = 0;
+ map_ptr -= out->dims[i] * map->dimincs[i+1];
+ }
+ }
+ } while(i<ndims);
+
+
++==EOD_map_c_code==
+
+ Doc=><<'+==EOD_map_doc==',
+
+=head2 PDL::match
+
+=for usage
+
+ $b = $a->match($c); # Match $c's header and size
+ $b = $a->match([100,200]); # Rescale to 100x200 pixels
+ $b = $a->match([100,200],{rect=>1}); # Rescale and remove rotation/skew.
+
+=for ref
+
+Resample a scientific image to the same coordinate system as another.
+
+The example above is syntactic sugar for
+
+ $b = $a->map(t_identity, $c, ...);
+
+it resamples the input PDL with the identity transformation in
+scientific coordinates, and matches the pixel coordinate system to
+$c's FITS header.
+
+There is one difference between match and map: match makes the
+C<rectify> option to C<map> default to 0, not 1. This only affects
+matching where autoscaling is required (i.e. the array ref example
+above). By default, that example simply scales $a to the new size and
+maintains any rotation or skew in its scientiic-to-pixel coordinate
+transform.
+
+=head2 map
+
+=for usage
+
+ $b = $a->map($xform,[<template>],[\%opt]); # Distort $a with tranform $xform
+ $b = $a->map(t_identity,[$pdl],[\%opt]); # rescale $a to match $pdl's dims.
+
+=for ref
+
+Resample an image or N-D dataset using a coordinate transform.
+
+The data are resampled so that the new pixel indices are proportional
+to the transformed coordinates rather than the original ones.
+
+The operation uses the inverse transform: each output pixel location
+is inverse-transformed back to a location in the original dataset, and
+the value is interpolated or sampled appropriately and copied into the
+output domain. A variety of sampling options are available, trading
+off speed and mathematical correctness.
+
+For convenience, this is both a PDL method and a PDL::Transform method.
+
+C<map> is FITS-aware: if there is a FITS header in the input data,
+then the coordinate transform acts on the scientific coordinate system
+rather than the pixel coordinate system.
+
+By default, the output coordinates are separated from pixel coordinates
+by a single layer of indirection. You can specify the mapping between
+output transform (scientific) coordinates to pixel coordinates using
+the C<orange> and C<irange> options (see below), or by supplying a
+FITS header in the template.
+
+If you don't specify an output transform, then the output is
+autoscaled: C<map> transforms a few vectors in the forward direction
+to generate a mapping that will put most of the data on the image
+plane, for most transformations. The calculated mapping gets stuck in the
+output's FITS header.
+
+Autoscaling is especially useful for rescaling images -- if you specify
+the identity transform and allow autoscaling, you duplicate the
+functionality of L<rescale2d|PDL::Image2D/rescale2d>, but with more
+options for interpolation.
+
+You can operate in pixel space, and avoid autoscaling of the output,
+by setting the C<nofits> option (see below).
+
+The output has the same data type as the input. This is a feature,
+but it can lead to strange-looking banding behaviors if you use
+interpolation on an integer input variable.
+
+The C<template> can be one of:
+
+=over 3
+
+=item * a PDL
+
+The PDL and its header are copied to the output array, which is then
+populated with data. If the PDL has a FITS header, then the FITS
+transform is automatically applied so that $t applies to the output
+scientific coordinates and not to the output pixel coordinates. In
+this case the NAXIS fields of the FITS header are ignored.
+
+=item * a FITS header stored as a hash ref
+
+The FITS NAXIS fields are used to define the output array, and the
+FITS transformation is applied to the coordinates so that $t applies to the
+output scientific coordinates.
+
+=item * a list ref
+
+This is a list of dimensions for the output array. The code estimates
+appropriate pixel scaling factors to fill the available space. The
+scaling factors are placed in the output FITS header.
+
+=item * nothing
+
+In this case, the input image size is used as a template, and scaling
+is done as with the list ref case (above).
+
+=back
+
+OPTIONS:
+
+The following options are interpreted:
+
+=over 3
+
+=item b, bound, boundary, Boundary (default = 'truncate')
+
+This is the boundary condition to be applied to the input image; it is
+passed verbatim to L<range|PDL::Slices/range> or
+L<interpND|PDL::Primitive/interpND> in the sampling or interpolating
+stage. Other values are 'forbid','extend', and 'periodic'. You can
+abbreviate this to a single letter. The default 'truncate' causes the
+entire notional space outside the original image to be filled with 0.
+
+=item pix, Pixel, nf, nofits, NoFITS (default = 0)
+
+If you set this to a true value, then FITS headers and interpretation
+are ignored; the transformation is treated as being in raw pixel coordinates.
+
+=item j, J, just, justify, Justify (default = 0)
+
+If you set this to 1, then output pixels are autoscaled to have unit
+aspect ratio in the output coordinates. If you set it to a non-1
+value, then it is the aspect ratio between the first dimension and all
+subsequent dimensions -- or, for a 2-D transformation, the scientific
+pixel aspect ratio. Values less than 1 shrink the scale in the first
+dimension compared to the other dimensions; values greater than 1
+enlarge it compared to the other dimensions. (This is the same sense
+as in the L<PGPLOT|PDL::Graphics::PGPLOT>interface.)
+
+=item ir, irange, input_range, Input_Range
+
+This is a way to modify the autoscaling. It specifies the range of
+input scientific (not necessarily pixel) coordinates that you want to be
+mapped to the output image. It can be either a nested array ref or
+a piddle. The 0th dim (outside coordinate in the array ref) is
+dimension index in the data; the 1st dim should have order 2.
+For example, passing in either [[-1,2],[3,4]] or pdl([[-1,2],[3,4]])
+limites the map to the quadrilateral in input space defined by the
+four points (-1,3), (-1,4), (2,4), and (2,3).
+
+As with plain autoscaling, the quadrilateral gets sparsely sampled by
+the autoranger, so pathological transformations can give you strange
+results.
+
+This parameter is overridden by C<orange>, below.
+
+=item or, orange, output_range, Output_Range
+
+This sets the window of output space that is to be sampled onto the
+output array. It works exactly like C<irange>, except that it specifies
+a quadrilateral in output space. Since the output pixel array is itself
+a quadrilateral, you get pretty much exactly what you asked for.
+
+This parameter overrides C<irange>, if both are specified. It forces
+rectification of the output (so that scientific axes align with the pixel
+grid).
+
+=item r, rect, rectify
+
+This option defaults TRUE and controls how autoscaling is performed. If
+it is true or undefined, then autoscaling adjusts so that pixel coordinates
+in the output image are proportional to individual scientific coordinates.
+If it is false, then autoscaling automatically applies the inverse of any
+input FITS transformation *before* autoscaling the pixels. In the special
+case of linear transformations, this preserves the rectangular shape of the
+original pixel grid and makes output pixel coordinate proportional to input
+coordinate.
+
+=item m, method, Method
+
+This option controls the interpolation method to be used.
+Interpolation greatly affects both speed and quality of output. For
+most cases the option is directly passed to
+L<interpND|PDL::Primitive/interpnd> for interpolation. Possible
+options, in order from fastest to slowest, are:
+
+=over 3
+
+
+=item * s, sample (default for ints)
+
+Pixel values in the output plane are sampled from the closest data value
+in the input plane. This is very fast but not very accurate for either
+magnification or decimation (shrinking). It is the default for templates
+of integer type.
+
+=item * l, linear (default for floats)
+
+Pixel values are linearly interpolated from the closest data value in the
+input plane. This is reasonably fast but only accurate for magnification.
+Decimation (shrinking) of the image causes aliasing and loss of photometry
+as features fall between the samples. It is the default for floating-point
+templates.
+
+=item * c, cubic
+
+Pixel values are interpolated using an N-cubic scheme from a 4-pixel
+N-cube around each coordinate value. As with linear interpolation,
+this is only accurate for magnification.
+
+=item * f, fft
+
+Pixel values are interpolated using the term coefficients of the
+Fourier transform of the original data. This is the most appropriate
+technique for some kinds of data, but can yield undesired "ringing" for
+expansion of normal images. Best suited to studying images with
+repetitive or wavelike features.
+
+=item * h, hanning
+
+Pixel values are filtered through a spatially-variable filter tuned to
+the computed Jacobian of the transformation, with hanning-window
+(cosine) pixel rolloff in each dimension. This prevents aliasing in the
+case where the image is distorted or shrunk, but allows small amounts
+of aliasing at pixel edges wherever the image is enlarged.
+
+=item * g, gaussian, j, jacobian
+
+Pixel values are filtered through a spatially-variable filter tuned to
+the computed Jacobian of the transformation, with radial Gaussian
+rolloff. This is the most accurate resampling method, in the sense of
+introducing the fewest artifacts into a properly sampled data set.
+
+=back
+
+=item blur, Blur (default = 1.0)
+
+This value scales the input-space footprint of each output pixel in
+the gaussian and hanning methods. It's retained for historical
+reasons. Larger values yield blurrier images; values significantly
+smaller than unity cause aliasing.
+
+=item sv, SV (default = 1.0)
+
+This value lets you set the lower limit of the transformation's
+singular values in the hanning and gaussian methods, limiting the
+minimum radius of influence associated with each output pixel. Large
+numbers yield smoother interpolation in magnified parts of the image
+but don't affect reduced parts of the image.
+
+=item big, Big (default = 0.2)
+
+This is the largest allowable input spot size which may be mapped to a
+single output pixel by the hanning and gaussian methods, in units of
+the largest non-thread input dimension. (i.e. the default won't let
+you reduce the original image to less than 5 pixels across). This places
+a limit on how long the processing can take for pathological transformations.
+Smaller numbers keep the code from hanging for a long time; larger numbers
+provide for photometric accuracy in more pathological cases. Numbers larer
+than 1.0 are silly, because they allow the entire input array to be compressed
+into a region smaller than a single pixel.
+
+Wherever an output pixel would require averaging over an area that is too
+big in input space, it instead gets NaN or the equivalent (bad values are
+not yet supported).
+
+=item phot, photometry, Photometry
+
+This lets you set the style of photometric conversion to be used in the
+hanning or gaussian methods. You may choose:
+
+=over 3
+
+=item * 0, s, surf, surface, Surface (default)
+
+(this is the default): surface brightness is preserved over the transformation,
+so features maintain their original intensity. This is what the sampling
+and interpolation methods do.
+
+=item * 1, f, flux, Flux
+
+Total flux is preserved over the transformation, so that the brightness
+integral over image regions is preserved. Parts of the image that are
+shrunk wind up brighter; parts that are enlarged end up fainter.
+
+=back
+
+=back
+
+VARIABLE FILTERING:
+
+The 'hanning' and 'gaussian' methods of interpolation give
+photometrically accurate resampling of the input data for arbitrary
+transformations. At each pixel, the code generates a linear
+approximation to the input transformation, and uses that linearization
+to estimate the "footprint" of the output pixel in the input space.
+The output value is a weighted average of the appropriate input spaces.
+
+A caveat about these methods is that they assume the transformation is
+continuous. Transformations that contain discontinuities will give
+incorrect results near the discontinuity. In particular, the 180th
+meridian isn't handled well in lat/lon mapping transformations (see
+L<PDL::Transform::Cartography>) -- pixels along the 180th meridian get
+the average value of everything along the parallel occupied by the
+pixel. This flaw is inherent in the assumptions that underly creating
+a Jacobian matrix. Maybe someone will write code to work around it.
+Maybe that someone is you.
+
+=cut
+
++==EOD_map_doc==
+ PMCode => <<'+==EOD_map_perlcode=='
+
+sub PDL::match {
+ # Set default for rectification to 0 for simple matching...
+ if( ref($_[$#_]) ne 'HASH' ) {
+ push(@_,{})
+ }
+ my @k = grep(m/^r(e(c(t)?)?)?/,keys %{$_[$#_]});
+ unless(@k) {
+ $_[$#_]->{rectify} = 0;
+ }
+ t_identity()->map(@_);
+}
+
+
+*PDL::map = \↦
+sub map {
+ my($me) = shift;
+ my($in) = shift;
+
+ if(UNIVERSAL::isa($me,'PDL') && UNIVERSAL::isa($in,'PDL::Transform')) {
+ my($a) = $in;
+ $in = $me;
+ $me = $a;
+ }
+
+ barf ("PDL::Transform::map: source is not defined or is not a PDL\n")
+ unless(defined $in and UNIVERSAL::isa($in,'PDL'));
+
+ my($tmp) = shift;
+ my($opt) = shift;
+
+ # Check for options-but-no-template case
+ if(ref $tmp eq 'HASH' && !(defined $opt)) {
+ if(!defined($tmp->{NAXIS})) { # FITS headers all have NAXIS.
+ $opt = $tmp;
+ $tmp = undef;
+ }
+ }
+
+ croak("PDL::Transform::map: Option 'p' was ambiguous and has been removed. You probably want 'pix' or 'phot'.") if exists($opt->{'p'});
+
+ $tmp = [$in->dims] unless(defined($tmp));
+
+ # Generate an appropriate output piddle for values to go in
+ my($out);
+ my(@odims);
+ my($ohdr);
+ if(UNIVERSAL::isa($tmp,'PDL')) {
+ @odims = $tmp->dims;
+
+ my($a);
+ if(defined ($a = $tmp->gethdr)) {
+ my(%b) = %{$a};
+ $ohdr = \%b;
+ }
+ } elsif(ref $tmp eq 'HASH') {
+ # (must be a fits header -- or would be filtered above)
+ for my $i(1..$tmp->{NAXIS}){
+ push(@odims,$tmp->{"NAXIS$i"});
+ }
+ # deep-copy fits header into output
+ my %foo = %{$tmp};
+ $ohdr = \%foo;
+ } elsif(ref $tmp eq 'ARRAY') {
+ @odims = @$tmp;
+ } else {
+ barf("map: confused about dimensions of the output array...\n");
+ }
+
+ if(scalar(@odims) < scalar($in->dims)) {
+ my @idims = $in->dims;
+ push(@odims, splice(@idims,scalar(@odims)));
+ }
+
+ $out = PDL::new_from_specification('PDL',$in->type, at odims);
+ $out->sethdr($ohdr) if defined($ohdr);
+
+ if($PDL::Bad::Status and $in->badflag()) {
+ $out->badflag(1);
+ }
+
+ ##############################
+ ## Figure out the dimensionality of the
+ ## transform itself (extra dimensions come along for the ride)
+ my $nd = $me->{odim} || $me->{idim} || 2;
+ my @sizes = $out->dims;
+ my @dd = @sizes;
+
+ splice @dd,$nd; # Cut out dimensions after the end
+
+ # Check that there are elements in the output fields...
+ barf "map: output has no dims!\n"
+ unless(@dd);
+ my $ddtotal = 1;
+ map {$ddtotal *= $_} @dd;
+ barf "map: output has no elements (at least one dim is 0)!\n"
+ unless($ddtotal);
+
+
+ ##############################
+ # If necessary, generate an appropriate FITS header for the output.
+
+ my $nofits = _opt($opt, ['nf','nofits','NoFITS','pix','pixel','Pixel']);
+
+ ##############################
+ # Autoscale by transforming a subset of the input points' coordinates
+ # to the output range, and pick a FITS header that fits the output
+ # coordinates into the given template.
+ #
+ # Autoscaling always produces a simple, linear mapping in the FITS header.
+ # We support more complex mappings (via t_fits) but only to match a pre-existing
+ # FITS header (which doesn't use autoscaling).
+ #
+ # If the rectify option is set (the default) then the image is rectified
+ # in scientific coordinates; if it is clear, then the existing matrix
+ # is used, preserving any shear or rotation in the coordinate system.
+ # Since we eschew CROTA whenever possible, the CDi_j formalism is used instead.
+ my $f_in = (defined($in->hdr->{NAXIS}) ? t_fits($in,{ignore_rgb=>1}) : t_identity());
+
+ unless((defined $out->gethdr && $out->hdr->{NAXIS}) or $nofits) {
+ print "generating output FITS header..." if($PDL::Transform::debug);
+
+ $out->sethdr($in->hdr_copy) # Copy extraneous fields...
+ if(defined $in->hdr);
+
+ my $samp_ratio = 300;
+
+ my $orange = _opt($opt, ['or','orange','output_range','Output_Range'],
+ undef);
+
+ my $omin;
+ my $omax;
+ my $osize;
+
+
+ my $rectify = _opt($opt,['r','rect','rectify','Rectify'],1);
+
+
+ if (defined $orange) {
+ # orange always rectifies the coordinates -- the output scientific
+ # coordinates *must* align with the axes, or orange wouldn't make
+ # sense.
+ print "using user's orange..." if($PDL::Transform::debug);
+ $orange = pdl($orange) unless(UNIVERSAL::isa($orange,'PDL'));
+ barf "map: orange must be 2xN for an N-D transform"
+ unless ( (($orange->dim(1)) == $nd )
+ && $orange->ndims == 2);
+
+ $omin = $orange->slice("(0)");
+ $omax = $orange->slice("(1)");
+ $osize = $omax - $omin;
+
+ $rectify = 1;
+
+ } else {
+
+ ##############################
+ # Real autoscaling happens here.
+
+
+ if(!$rectify and ref( $f_in ) !~ /Linear/) {
+ print STDERR "Warning: map can't preserve nonlinear FITS distortions while autoscaling.\n";
+ $rectify=1;
+ }
+ if(!$rectify and $f_in->{name} eq 'identity') {
+ $rectify = 1;
+ }
+
+ my $f_tr = ( $rectify ?
+ $me x $f_in :
+ ( ($me->{name} eq 'identity') ? # Simple optimization for match()
+ $me : # identity -- just matching
+ !$f_in x $me x $f_in # common case
+ )
+ );
+
+ my $samps = (pdl(($in->dims)[0..$nd-1]))->clip(0,$samp_ratio);
+
+ my $coords = ndcoords(($samps + 1)->list);
+
+ my $t;
+ my $irange = _opt($opt, ['ir','irange','input_range','Input_Range'],
+ undef);
+
+ # If input range is defined, sample that quadrilateral -- else
+ # sample the quad defined by the boundaries of the input image.
+ if(defined $irange) {
+ print "using user's irange..." if($PDL::Transform::debug);
+ $irange = pdl($irange) unless(UNIVERSAL::isa($irange,'PDL'));
+ barf "map: irange must be 2xN for an N-D transform"
+ unless ( (($irange->dim(1)) == $nd )
+ && $irange->ndims == 2);
+
+ $coords *= ($irange->slice("(1)") - $irange->slice("(0)")) / $samps;
+ $coords += $irange->slice("(0)");
+ $coords -= 0.5; # offset to pixel corners...
+ $t = $me;
+ } else {
+ $coords *= pdl(($in->dims)[0..$nd-1]) / $samps;
+ $coords -= 0.5; # offset to pixel corners...
+ $t = $f_tr;
+ }
+ my $ocoords = $t->apply($coords)->mv(0,-1)->clump($nd);
+
+ # discard non-finite entries
+ my $oc2 = $ocoords->range(
+ which(
+ $ocoords->
+ xchg(0,1)->
+ sumover->
+ isfinite
+ )
+ ->dummy(0,1)
+ );
+
+ $omin = $oc2->minimum;
+ $omax = $oc2->maximum;
+
+ $osize = $omax - $omin;
+ my $tosize;
+ ($tosize = $osize->where($osize == 0)) .= 1.0;
+ }
+
+ my ($scale) = $osize / pdl(($out->dims)[0..$nd-1]);
+
+ my $justify = _opt($opt,['j','J','just','justify','Justify'],0);
+ if($justify) {
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $scale->slice("0")) *= $justify;
+ $scale .= $scale->max;
+ $scale->slice("0") /= $justify;
+ }
+
+ print "done with autoscale. Making fits header....\n" if($PDL::Transform::debug);
+ if( $rectify ) {
+ # Rectified header generation -- make a simple coordinate header with no
+ # rotation or skew.
+ print "rectify\n" if($PDL::Transform::debug);
+ for my $d(1..$nd) {
+ $out->hdr->{"CRPIX$d"} = 1 + ($out->dim($d-1)-1)/2 ;
+ $out->hdr->{"CDELT$d"} = $scale->at($d-1);
+ $out->hdr->{"CRVAL$d"} = ( $omin->at($d-1) + $omax->at($d-1) ) /2 ;
+ $out->hdr->{"NAXIS$d"} = $out->dim($d-1);
+ $out->hdr->{"CTYPE$d"} = ( (defined($me->{otype}) ?
+ $me->{otype}->[$d-1] : "")
+ || $in->hdr->{"CTYPE$d"}
+ || "");
+ $out->hdr->{"CUNIT$d"} = ( (defined($me->{ounit}) ?
+ $me->{ounit}->[$d-1] : "")
+ || $in->hdr->{"CUNIT$d"}
+ || $in->hdr->{"CTYPE$d"}
+ || "");
+ }
+ $out->hdr->{"NAXIS"} = $nd;
+
+ $out->hdr->{"SIMPLE"} = 'T';
+ $out->hdr->{"HISTORY"} .= "Header written by PDL::Transform::Cartography::map";
+
+ ### Eliminate fancy newfangled output header pointing tags if they exist
+ ### These are the CROTA<n>, PCi_j, and CDi_j.
+ for $k(keys %{$out->hdr}) {
+ if( $k=~m/(^CROTA\d*$)|(^(CD|PC)\d+_\d+[A-Z]?$)/ ){
+ delete $out->hdr->{$k};
+ }
+ }
+ } else {
+ # Non-rectified output -- generate a CDi_j matrix instead of the simple formalism.
+ # We have to deal with a linear transformation: we've got: (scaling) x !input x (t x input),
+ # where input is a linear transformation with offset and scaling is a simple scaling. We have
+ # the scaling parameters and the matrix for !input -- we have only to merge them and then we
+ # can write out the FITS header in CDi_j form.
+ print "non-rectify\n" if($PDL::Transform::debug);
+ my $midpoint_val = (pdl(($out->dims)[0..$nd-1])/2 * $scale)->apply( $f_in );
+ print "midpoint_val is $midpoint_val\n" if($PDL::Transform::debug);
+ # linear transformation
+ unless(ref($f_in) =~ m/Linear/) {
+ croak("Whups -- got a nonlinear t_fits transformation. Can't deal with it.");
+ }
+
+ my $inv_sc_mat = zeroes($nd,$nd);
+ $inv_sc_mat->diagonal(0,1) .= $scale;
+ my $mat = $f_in->{params}->{matrix} x $inv_sc_mat;
+ print "scale is $scale; mat is $mat\n" if($PDL::Transform::debug);
+
+ print "looping dims 1..$nd: " if($PDL::Transform::debug);
+ for my $d(1..$nd) {
+ print "$d..." if($PDL::Transform::debug);
+ $out->hdr->{"CRPIX$d"} = 1 + ($out->dim($d-1)-1)/2;
+ $out->hdr->{"CRVAL$d"} = $midpoint_val->at($d-1);
+ $out->hdr->{"NAXIS$d"} = $out->dim($d-1);
+ $out->hdr->{"CTYPE$d"} = ( (defined($me->{otype}) ?
+ $me->{otype}->[$d-1] : "")
+ || $in->hdr->{"CTYPE$d"}
+ || "");
+ $out->hdr->{"CUNIT$d"} = ( (defined($me->{ounit}) ?
+ $me->{ounit}->[$d-1] : "")
+ || $in->hdr->{"CUNIT$d"}
+ || $in->hdr->{"CTYPE$d"}
+ || "");
+ for my $e(1..$nd) {
+ $out->hdr->{"CD${d}_${e}"} = $mat->at($d-1,$e-1);
+ print "setting CD${d}_${e} to ".$mat->at($d-1,$e-1)."\n" if($PDL::Transform::debug);
+ }
+ }
+
+ ## Eliminate competing header pointing tags if they exist
+ for $k(keys %{$out->hdr}) {
+ if( $k =~ m/(^CROTA\d*$)|(^(PC)\d+_\d+[A-Z]?$)|(CDELT\d*$)/ ) {
+ delete $out->hdr->{$k};
+ }
+ }
+ }
+
+
+
+ }
+
+ $out->hdrcpy(1);
+
+ ##############################
+ # Sandwich the transform between the input and output plane FITS headers.
+ unless($nofits) {
+ $me = !(t_fits($out,{ignore_rgb=>1})) x $me x $f_in;
+ }
+
+ ##############################
+ ## Figure out the interpND options
+ my $method = _opt($opt,['m','method','Method'],undef);
+ my $bound = _opt($opt,['b','bound','boundary','Boundary'],'t');
+
+
+ ##############################
+ ## Rubber meets the road: calculate the inverse transformed points.
+ my $ndc = PDL::Basic::ndcoords(@dd);
+ my $idx = $me->invert($ndc->double);
+
+ barf "map: Transformation had no inverse\n" unless defined($idx);
+
+ ##############################
+ ## Integrate ? (Jacobian, Gaussian, Hanning)
+ my $integrate = ($method =~ m/^[jghJGH]/) if defined($method);
+
+ ##############################
+ ## Sampling code:
+ ## just transform and interpolate.
+ ## ( Kind of an anticlimax after all that, eh? )
+ if(!$integrate) {
+ my $a = $in->interpND($idx,{method=>$method, bound=>$bound});
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $out->slice(":")) .= $a; # trivial slice prevents header overwrite...
+ return $out;
+ }
+
+ ##############################
+ ## Anti-aliasing code:
+ ## Condition the input and call the pixelwise C interpolator.
+ ##
+
+ barf("PDL::Transform::map: Too many dims in transformation\n")
+ if($in->ndims < $idx->ndims-1);
+
+ ####################
+ ## Condition the threading -- pixelwise interpolator only threads
+ ## in 1 dimension, so squish all thread dimensions into 1, if necessary
+ my @iddims = $idx->dims;
+ if($in->ndims == $#iddims) {
+ $in2 = $in->dummy(-1,1);
+ } else {
+ $in2 = ( $in
+ ->reorder($nd..$in->ndims-1, 0..$nd-1)
+ ->clump($in->ndims - $nd)
+ ->mv(0,-1)
+ );
+ }
+
+ ####################
+ # Allocate the output array
+ my $o2 = PDL->new_from_specification($in2->type,
+ @iddims[1..$#iddims],
+ $in2->dim(-1)
+ );
+
+ ####################
+ # Pack boundary string if necessary
+ if(defined $bound) {
+ if(ref $bound eq 'ARRAY') {
+ my ($s,$el);
+ foreach $el(@$bound) {
+ barf "Illegal boundary value '$el' in range"
+ unless( $el =~ m/^([0123fFtTeEpPmM])/ );
+ $s .= $1;
+ }
+ $bound = $s;
+ }
+ elsif($bound !~ m/^[0123ftepx]+$/ && $bound =~ m/^([0123ftepx])/i ) {
+ $bound = $1;
+ }
+ }
+
+ ####################
+ # Get the blur and minimum-sv values
+ my $blur = _opt($opt,['blur','Blur'],1.0);
+ my $svmin = _opt($opt,['sv','SV'],1.0);
+ my $big = _opt($opt,['big','Big'],1.0);
+ my $flux = _opt($opt,['phot','photometry'],0);
+ my @idims = $in->dims;
+
+ $flux = ($flux =~ m/^[1fF]/);
+ $big = $big * max(pdl(@idims[0..$nd])) / 2;
+ $blur = $blur->at(0) if(ref $blur);
+ $svmin = $svmin->at(0) if(ref $svmin);
+
+ my $bv;
+ if($PDL::Bad::Status and $in->badflag){
+ $bv = $in->badvalue;
+ } else {
+ $bv = 0;
+ }
+
+ ### The first argument is a dummy to set $GENERIC.
+ $idx = double($idx) unless($idx->type == double);
+ &PDL::_map_int( $in2->flat->index(0),
+ $in2, $o2, $idx,
+ $bound, $method, $big, $blur, $svmin, $flux, $bv);
+
+ my @rdims = (@iddims[1..$#iddims], @idims[$#iddims..$#idims]);
+ {
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $out->slice(":")) .= $o2->reshape(@rdims);
+ }
+ return $out;
+}
+
++==EOD_map_perlcode==
+
+);
+
+
+pp_add_exported('unmap');
+pp_addpm(<<'+======EOD_unmap======');
+
+######################################################################
+
+=head2 unmap
+
+=for sig
+
+ Signature: (data(); PDL::Transform a; template(); \%opt)
+
+=for usage
+
+ $out_image = $in_image->unmap($t,[<options>],[<template>]);
+ $out_image = $t->unmap($in_image,[<options>],[<template>]);
+
+=for ref
+
+Map an image or N-D dataset using the inverse as a coordinate transform.
+
+This convenience function just inverts $t and calls L<map|/map> on
+the inverse; everything works the same otherwise. For convenience, it
+is both a PDL method and a PDL::Transform method.
+
+=cut
+
+*PDL::unmap = \&unmap;
+sub unmap {
+ my($me) = shift;
+ my($data) = shift;
+ my(@params) = @_;
+
+ if(UNIVERSAL::isa($data,'PDL::Transform') && UNIVERSAL::isa($me,'PDL')) {
+ my $a = $data;
+ $data = $me;
+ $me = $a;
+ }
+
+ return $me->inverse->map($data, at params);
+}
+
++======EOD_unmap======
+
+pp_add_exported('t_inverse');
+pp_addpm(<<'+======EOD_t_inverse======');
+
+=head2 t_inverse
+
+=for usage
+
+ $t2 = t_inverse($t);
+ $t2 = $t->inverse;
+ $t2 = $t ** -1;
+ $t2 = !$t;
+
+=for ref
+
+Return the inverse of a PDL::Transform. This just reverses the
+func/inv, idim/odim, itype/otype, and iunit/ounit pairs. Note that
+sometimes you end up with a transform that cannot be applied or
+mapped, because either the mathematical inverse doesn't exist or the
+inverse func isn't implemented.
+
+You can invert a transform by raising it to a negative power, or by
+negating it with '!'.
+
+The inverse transform remains connected to the main transform because
+they both point to the original parameters hash. That turns out to be
+useful.
+
+=cut
+
+*t_inverse = \&inverse;
+
+sub inverse {
+ my($me) = shift;
+
+ unless(defined($me->{inv})) {
+ Carp::cluck("PDL::Transform::inverse: got a transform with no inverse.\n");
+ return undef;
+ }
+
+ my(%out) = %$me; # force explicit copy of top-level
+ my($out) = \%out;
+
+ $out->{inv} = $me->{func};
+ $out->{func} = $me->{inv};
+
+ $out->{idim} = $me->{odim};
+ $out->{odim} = $me->{idim};
+
+ $out->{otype} = $me->{itype};
+ $out->{itype} = $me->{otype};
+
+ $out->{ounit} = $me->{iunit};
+ $out->{iunit} = $me->{ounit};
+
+ $out->{name} = "(inverse ".$me->{name}.")";
+
+ $out->{is_inverse} = !($out->{is_inverse});
+
+ bless $out,(ref $me);
+ return $out;
+}
+
++======EOD_t_inverse======
+
+pp_add_exported('t_compose');
+pp_addpm(<<'+======EOD_t_compose======');
+
+=head2 t_compose
+
+=for usage
+
+ $f2 = t_compose($f, $g,[...]);
+ $f2 = $f->compose($g[,$h,$i,...]);
+ $f2 = $f x $g x ...;
+
+=for ref
+
+Function composition: f(g(x)), f(g(h(x))), ...
+
+You can also compose transforms using the overloaded matrix-multiplication
+(nee repeat) operator 'x'.
+
+This is accomplished by inserting a splicing code ref into the C<func>
+and C<inv> slots. It combines multiple compositions into a single
+list of transforms to be executed in order, fram last to first (in
+keeping with standard mathematical notation). If one of the functions is
+itself a composition, it is interpolated into the list rather than left
+separate. Ultimately, linear transformations may also be combined within
+the list.
+
+No checking is done that the itype/otype and iunit/ounit fields are
+compatible -- that may happen later, or you can implement it yourself
+if you like.
+
+=cut
+
+ at PDL::Transform::Composition::ISA = ('PDL::Transform');
+sub PDL::Transform::Composition::stringify {
+ package PDL::Transform::Composition;
+ my($me) = shift;
+ my($out) = SUPER::stringify $me;
+ $out;
+}
+
+*t_compose = \&compose;
+
+sub compose {
+ local($_);
+ my(@funcs) = @_;
+ my($me) = PDL::Transform->new;
+
+ # No inputs case: return the identity function
+ return $me
+ if(!@funcs);
+
+ $me->{name} = "";
+ my($f);
+ my(@clist);
+
+ for $f(@funcs) {
+
+ $me->{idim} = $f->{idim} if($f->{idim} > $me->{idim});
+ $me->{odim} = $f->{odim} if($f->{odim} > $me->{odim});
+
+ if(UNIVERSAL::isa($f,"PDL::Transform::Composition")) {
+ if($f->{is_inverse}) {
+ for(reverse(@{$f->{params}->{clist}})) {
+ push(@clist,$_->inverse);
+ $me->{name} .= " o inverse ( ".$_->{name}." )";
+ }
+ } else {
+ for(@{$f->{params}->{clist}}) {
+ push(@clist,$_);
+ $me->{name} .= " o ".$_->{name};
+ }
+ }
+ } else { # Not a composition -- just push the transform onto the list.
+ push(@clist,$f);
+ $me->{name} .= " o ".$f->{name};
+ }
+ }
+
+ $me->{name}=~ s/^ o //; # Get rid of leading composition mark
+
+ $me->{otype} = $funcs[0]->{otype};
+ $me->{ounit} = $funcs[0]->{ounit};
+
+ $me->{itype} = $funcs[-1]->{itype};
+ $me->{iunit} = $funcs[-1]->{iunit};
+
+ $me->{params}->{clist} = \@clist;
+
+ $me->{func} = sub {
+ my ($data,$p) = @_;
+ my ($ip) = $data->is_inplace;
+ for my $t ( reverse @{$p->{clist}} ) {
+ croak("Error: tried to apply a PDL::Transform with no function inside a composition!\n offending transform: $t\n")
+ unless(defined($t->{func}) and ref($t->{func}) eq 'CODE');
+ $data = $t->{func}($ip ? $data->inplace : $data, $t->{params});
+ }
+ $data->is_inplace(0); # clear inplace flag (avoid core bug with inplace)
+ $data;
+ };
+
+ $me->{inv} = sub {
+ my($data,$p) = @_;
+ my($ip) = $data->is_inplace;
+ for my $t ( @{$p->{clist}} ) {
+ croak("Error: tried to invert a non-invertible PDL::Transform inside a composition!\n offending transform: $t\n")
+ unless(defined($t->{inv}) and ref($t->{inv}) eq 'CODE');
+ $data = &{$t->{inv}}($ip ? $data->inplace : $data, $t->{params});
+ }
+ $data;
+ };
+
+ return bless($me,'PDL::Transform::Composition');
+}
+
++======EOD_t_compose======
+
+
+pp_add_exported('t_wrap');
+pp_addpm(<<'+======EOD_t_wrap======');
+
+=head2 t_wrap
+
+=for usage
+
+ $g1fg = $f->wrap($g);
+ $g1fg = t_wrap($f,$g);
+
+=for ref
+
+Shift a transform into a different space by 'wrapping' it with a second.
+
+This is just a convenience function for two
+L<t_compose|/t_compose> calls. C<< $a->wrap($b) >> is the same as
+C<(!$b) x $a x $b>: the resulting transform first hits the data with
+$b, then with $a, then with the inverse of $b.
+
+For example, to shift the origin of rotation, do this:
+
+ $im = rfits('m51.fits');
+ $tf = t_fits($im);
+ $tr = t_linear({rot=>30});
+ $im1 = $tr->map($tr); # Rotate around pixel origin
+ $im2 = $tr->map($tr->wrap($tf)); # Rotate round FITS scientific origin
+
+=cut
+
+*t_wrap = \&wrap;
+
+sub wrap {
+ my($f) = shift;
+ my($g) = shift;
+
+ return $g->inverse->compose($f,$g);
+}
+
+
+
+######################################################################
+
+# Composition operator -- handles 'x'.
+sub _compose_op {
+ my($a,$b,$c) = @_;
+ $c ? compose($b,$a) : compose($a,$b);
+}
+
+# Raise-to-power operator -- handles '**'.
+
+sub _pow_op {
+ my($a,$b,$c) = @_;
+
+ barf("%s", "Can't raise anything to the power of a transform")
+ if($c || UNIVERSAL::isa($b,'PDL::Transform')) ;
+
+ $a = $a->inverse
+ if($b < 0);
+
+ return $a if(abs($b) == 1);
+ return new PDL::Transform if(abs($b) == 0);
+
+ my(@l);
+ for my $i(1..abs($b)) {
+ push(@l,$a);
+ }
+
+ t_compose(@l);
+}
+
++======EOD_t_wrap======
+
+
+pp_add_exported('t_identity');
+pp_addpm(<<'+======EOD_t_identity======');
+
+=head2 t_identity
+
+=for usage
+
+ my $xform = t_identity
+ my $xform = new PDL::Transform;
+
+=for ref
+
+Generic constructor generates the identity transform.
+
+This constructor really is trivial -- it is mainly used by the other transform
+constructors. It takes no parameters and returns the identity transform.
+
+=cut
+
+sub _identity { return shift; }
+sub t_identity { new PDL::Transform(@_) };
+
+sub new {
+ my($class) = shift;
+ my $me = {name=>'identity',
+ idim => 0,
+ odim => 0,
+ func=>\&PDL::Transform::_identity,
+ inv=>\&PDL::Transform::_identity,
+ params=>{}
+ };
+
+ return bless $me,$class;
+}
+
++======EOD_t_identity======
+
+
+pp_add_exported('t_lookup');
+pp_addpm(<<'+======EOD_t_lookup======');
+
+=head2 t_lookup
+
+=for usage
+
+ $f = t_lookup($lookup, {<options>});
+
+=for ref
+
+Transform by lookup into an explicit table.
+
+You specify an N+1-D PDL that is interpreted as an N-D lookup table of
+column vectors (vector index comes last). The last dimension has
+order equal to the output dimensionality of the transform.
+
+For added flexibility in data space, You can specify pre-lookup linear
+scaling and offset of the data. Of course you can specify the
+interpolation method to be used. The linear scaling stuff is a little
+primitive; if you want more, try composing the linear transform with
+this one.
+
+The prescribed values in the lookup table are treated as
+pixel-centered: that is, if your input array has N elements per row
+then valid data exist between the locations (-0.5) and (N-0.5) in
+lookup pixel space, because the pixels (which are numbered from 0 to
+N-1) are centered on their locations.
+
+Lookup is done using L<interpND|PDL::Primitive/interpnd>, so the boundary conditions
+and threading behaviour follow from that.
+
+The indexed-over dimensions come first in the table, followed by a
+single dimension containing the column vector to be output for each
+set of other dimensions -- ie to output 2-vectors from 2 input
+parameters, each of which can range from 0 to 49, you want an index
+that has dimension list (50,50,2). For the identity lookup table
+you could use C<cat(xvals(50,50),yvals(50,50))>.
+
+If you want to output a single value per input vector, you still need
+that last index threading dimension -- if necessary, use C<dummy(-1,1)>.
+
+The lookup index scaling is: out = lookup[ (scale * data) + offset ].
+
+A simplistic table inversion routine is included. This means that
+you can (for example) use the C<map> method with C<t_lookup> transformations.
+But the table inversion is exceedingly slow, and not practical for tables
+larger than about 100x100. The inversion table is calculated in its
+entirety the first time it is needed, and then cached until the object is
+destroyed.
+
+Options are listed below; there are several synonyms for each.
+
+=over 3
+
+=item s, scale, Scale
+
+(default 1.0) Specifies the linear amount of scaling to be done before
+lookup. You can feed in a scalar or an N-vector; other values may cause
+trouble. If you want to save space in your table, then specify smaller
+scale numbers.
+
+=item o, offset, Offset
+
+(default 0.0) Specifies the linear amount of offset before lookup.
+This is only a scalar, because it is intended to let you switch to
+corner-centered coordinates if you want to (just feed in o=-0.25).
+
+=item b, bound, boundary, Boundary
+
+Boundary condition to be fed to L<interpND|PDL::Primitive/interpND>
+
+=item m, method, Method
+
+Interpolation method to be fed to L<interpND|PDL::Primitive/interpND>
+
+=back
+
+EXAMPLE
+
+To scale logarithmically the Y axis of m51, try:
+
+ $a = float rfits('m51.fits');
+ $lookup = xvals(128,128) -> cat( 10**(yvals(128,128)/50) * 256/10**2.55 );
+ $t = t_lookup($lookup);
+ $b = $t->map($a);
+
+To do the same thing but with a smaller lookup table, try:
+
+ $lookup = 16 * xvals(17,17)->cat(10**(yvals(17,17)/(100/16)) * 16/10**2.55);
+ $t = t_lookup($lookup,{scale=>1/16.0});
+ $b = $t->map($a);
+
+(Notice that, although the lookup table coordinates are is divided by 16,
+it is a 17x17 -- so linear interpolation works right to the edge of the original
+domain.)
+
+NOTES
+
+Inverses are not yet implemented -- the best way to do it might be by
+judicious use of map() on the forward transformation.
+
+the type/unit fields are ignored.
+
+=cut
+
+sub t_lookup {
+ my($class) = 'PDL::Transform';
+ my($source)= shift;
+ my($o) = shift;
+
+ if(!defined($o) && ((ref $source) eq 'HASH')) {
+ Carp::cluck("lookup transform called as sub not method; using 'PDL::Transform' as class...\n");
+ $o = $source;
+ $source = $class;
+ $class = "PDL::Transform";
+ }
+
+ $o = {} unless(ref $o eq 'HASH');
+
+ my($me) = PDL::Transform::new($class);
+
+ my($bound) = _opt($o,['b','bound','boundary','Boundary']);
+ my($method)= _opt($o,['m','meth','method','Method']);
+
+ $me->{idim} = $source->ndims - 1;
+ $me->{odim} = $source->dim($source->ndims-1);
+
+ $me->{params} = {
+ table => $source,
+ scale => _opt($o,['s','scale','Scale'],1.0),
+ offset => _opt($o,['o','off','offset','Offset'],0.0),
+ interpND_opt => {
+ method => $method,
+ bound => $bound,
+ bad => _opt($o,['bad'],0)
+ }
+ };
+
+
+ my $lookup_func = sub {
+ my($data,$p,$table,$scale,$offset) = @_;
+
+ $data = pdl($data)
+ unless ((ref $data) && (UNIVERSAL::isa($data,'PDL')));
+ $main::foo = $data;
+
+ if($data->dim(0) > $me->{idim}) {
+ barf("Too many dims (".$data->dim(0).") for your table (".$me->{idim}.")\n");
+ };
+
+ my($a)= ($table
+ ->interpND(float($data) * $scale + $offset,
+ $p->{interpND_opt}
+ )
+ );
+
+
+ # Put the index dimension (and threaded indices) back at the front of
+ # the dimension list.
+ my($dnd) = $data->ndims - 1;
+ return ($a -> ndims > $data->ndims - 1) ?
+ ($a->reorder( $dnd..($dnd + $table->ndims - $data->dim(0)-1)
+ , 0..$data->ndims-2
+ )
+ ) : $a;
+ };
+
+ $me->{func} = sub {my($data,$p) = @_; &$lookup_func($data,$p,$p->{table},$p->{scale},$p->{offset})};
+
+ #######
+ ## Lazy inverse -- find it if and only if we need it...
+ $me->{inv} = sub {
+ my $data = shift;
+ my $p = shift;
+ if(!defined($p->{'itable'})) {
+ if($me->{idim} != $me->{odim}) {
+ barf("t_lookup: can't calculate an inverse of a projection operation! (idim != odim)");
+ }
+ print "t_lookup: Warning, table inversion is only weakly supported. \n I'll try to invert it using a pretty boneheaded algorithm...\n (If it takes too long, consider writing a faster algorithm!)\n Calculating inverse table (will be cached)...\n" if($PDL::verbose || $PDL::debug || $PDL::Transform::debug);
+ my $itable = zeroes($p->{table});
+ my $minvals = $p->{table}->clump($me->{idim})->minimum;
+ my $maxvals = $p->{table}->clump($me->{idim})->maximum;
+
+ # Scale so that the range runs from 0 through the top pixel in the table
+ my $scale = ( pdl( $itable->dims )->slice("0:-2")-1 ) /
+ (($maxvals - $minvals)+ (($maxvals-$minvals) == 0));
+ my $offset = - ($minvals * $scale);
+
+ $p->{iscale} = $scale;
+ $p->{ioffset} = $offset;
+
+ my $enl_scale = $p->{'enl_scale'} || 10;
+ my $smallcoords = ndcoords((pdl($enl_scale * 2 + 1)->at(0)) x $me->{idim})/ $enl_scale - 1;
+
+ # $oloop runs over (point, index) for all points in the output table, in
+ # $p->{table} output space
+ $oloop = ndcoords($itable->mv(-1,0)->slice("(0)"))->
+ double->
+ mv(0,-1)->
+ clump($itable->ndims-1); # oloop: (pixel, index)
+ {
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $oloop->mv(-1,0)) -= $offset;
+ ($tmp = $oloop->mv(-1,0)) /= $scale;
+ }
+
+ # The Right Thing to do here is to take the outer product of $itable and $otable, then collapse
+ # to find minimum distance. But memory demands for that would be HUGE. Instead we do an
+ # elementwise calculation.
+
+ print "t_lookup: inverting ".$oloop->dim(0)." points...\n" if($PDL::verbose || $PDL::debug || $PDL::Transform::debug);
+ my $pt = $p->{table}->mv(-1,0); # pt runs (index, x,y,...)
+
+ my $itable_flattened = zeroes($oloop);
+
+ for $i(0..$oloop->dim(0)-1) {
+
+ my $olp = $oloop->slice("($i)"); # olp runs (index)
+ my $diff = ($pt - $olp); # diff runs (index, x, y, ...)
+ my $r2 = ($diff * $diff)->sumover; # r2 runs (x,y,...)
+ my $c = whichND($r2==$r2->min)->slice(":,(0)"); # c runs (index)
+
+ # Now zero in on the neighborhood around the point of closest approach.
+ my $neighborhood = $p->{table}->interpND($c + $smallcoords,{method=>'linear',bound=>'t'})->
+ mv(-1,0); # neighborhood runs (index, dx, dy,...)
+ $diff = $neighborhood - $olp; # diff runs (index, dx, dy, ...)
+ $r2 = ($diff * $diff)->sumover; # r2 runs (dx,dy,...)
+ my $dc = $smallcoords->mv(0,-1)->indexND(0+whichND($r2==$r2->min)->slice(":,(0)"));
+
+
+ my $coord = $c + $dc;
+ # At last, we've found the best-fit to an enl_scale'th of an input-table pixel.
+ # Back it out to input-science coordinates, and stuff it in the inverse table.
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $itable_flattened->slice("($i)")) .= $coord;
+
+ print " $i..." if( ($i%1000==0) && ( $PDL::verbose || $PDL::debug || $PDL::Transform::debug));
+ }
+
+ {
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $itable->clump($itable->ndims-1)) .= $itable_flattened;
+ ($tmp = $itable->mv(-1,0)) -= $p->{offset};
+ ($tmp = $itable->mv(-1,0)) /= $p->{scale};
+ }
+
+ $p->{itable} = $itable;
+ }
+ &$lookup_func($data,$p, $p->{itable},$p->{iscale},$p->{ioffset}) ;
+ };
+
+
+ $me->{name} = 'Lookup';
+
+ return $me;
+}
+
++======EOD_t_lookup======
+
+pp_add_exported('t_linear');
+pp_addpm(<<'+======EOD_t_linear======');
+
+=head2 t_linear
+
+=for usage
+
+$f = t_linear({options});
+
+=for ref
+
+Linear (affine) transformations with optional offset
+
+t_linear implements simple matrix multiplication with offset,
+also known as the affine transformations.
+
+You specify the linear transformation with pre-offset, a mixing
+matrix, and a post-offset. That overspecifies the transformation, so
+you can choose your favorite method to specify the transform you want.
+The inverse transform is automagically generated, provided that it
+actually exists (the transform matrix is invertible). Otherwise, the
+inverse transform just croaks.
+
+Extra dimensions in the input vector are ignored, so if you pass a
+3xN vector into a 3-D linear transformation, the final dimension is passed
+through unchanged.
+
+The options you can usefully pass in are:
+
+=over 3
+
+=item s, scale, Scale
+
+A scaling scalar (heh), vector, or matrix. If you specify a vector
+it is treated as a diagonal matrix (for convenience). It gets
+left-multiplied with the transformation matrix you specify (or the
+identity), so that if you specify both a scale and a matrix the
+scaling is done after the rotation or skewing or whatever.
+
+=item r, rot, rota, rotation, Rotation
+
+A rotation angle in degrees -- useful for 2-D and 3-D data only. If
+you pass in a scalar, it specifies a rotation from the 0th axis toward
+the 1st axis. If you pass in a 3-vector as either a PDL or an array
+ref (as in "rot=>[3,4,5]"), then it is treated as a set of Euler
+angles in three dimensions, and a rotation matrix is generated that
+does the following, in order:
+
+=over 3
+
+=item * Rotate by rot->(2) degrees from 0th to 1st axis
+
+=item * Rotate by rot->(1) degrees from the 2nd to the 0th axis
+
+=item * Rotate by rot->(0) degrees from the 1st to the 2nd axis
+
+=back
+
+The rotation matrix is left-multiplied with the transformation matrix
+you specify, so that if you specify both rotation and a general matrix
+the rotation happens after the more general operation -- though that is
+deprecated.
+
+Of course, you can duplicate this functionality -- and get more
+general -- by generating your own rotation matrix and feeding it in
+with the C<matrix> option.
+
+=item m, matrix, Matrix
+
+The transformation matrix. It does not even have to be square, if you want
+to change the dimensionality of your input. If it is invertible (note:
+must be square for that), then you automagically get an inverse transform too.
+
+=item pre, preoffset, offset, Offset
+
+The vector to be added to the data before they get multiplied by the matrix
+(equivalent of CRVAL in FITS, if you are converting from scientific to
+pixel units).
+
+=item post, postoffset, shift, Shift
+
+The vector to be added to the data after it gets multiplied by the matrix
+(equivalent of CRPIX-1 in FITS, if youre converting from scientific to pixel
+units).
+
+=item d, dim, dims, Dims
+
+Most of the time it is obvious how many dimensions you want to deal
+with: if you supply a matrix, it defines the transformation; if you
+input offset vectors in the C<pre> and C<post> options, those define
+the number of dimensions. But if you only supply scalars, there is no way
+to tell and the default number of dimensions is 2. This provides a way
+to do, e.g., 3-D scaling: just set C<{s=><scale-factor>, dims=>3}> and
+you are on your way.
+
+=back
+
+NOTES
+
+the type/unit fields are currently ignored by t_linear.
+
+=cut
+
+ at PDL::Transform::Linear::ISA = ('PDL::Transform');
+
+sub t_linear { new PDL::Transform::Linear(@_); }
+
+sub PDL::Transform::Linear::new {
+ my($class) = shift;
+ my($o) = $_[0];
+ pop @_ if (($#_ % 2 ==0) && !defined($_[-1]));
+ #suppresses a warning if @_ has an odd number of elements and the
+ #last is undef
+
+ if(!(ref $o)) {
+ $o = {@_};
+ }
+
+ my($me) = PDL::Transform::new($class);
+
+ $me->{name} = "linear";
+
+ $me->{params}->{pre} = _opt($o,['pre','Pre','preoffset','offset',
+ 'Offset','PreOffset','Preoffset'],0);
+ $me->{params}->{pre} = pdl($me->{params}->{pre})
+ if(defined $me->{params}->{pre});
+
+ $me->{params}->{post} = _opt($o,['post','Post','postoffset','PostOffset',
+ 'shift','Shift'],0);
+ $me->{params}->{post} = pdl($me->{params}->{post})
+ if(defined $me->{params}->{post});
+
+ $me->{params}->{matrix} = _opt($o,['m','matrix','Matrix','mat','Mat']);
+ $me->{params}->{matrix} = pdl($me->{params}->{matrix})
+ if(defined $me->{params}->{matrix});
+
+ $me->{params}->{rot} = _opt($o,['r','rot','rota','rotation','Rotation']);
+ $me->{params}->{rot} = 0 unless defined($me->{params}->{rot});
+ $me->{params}->{rot} = pdl($me->{params}->{rot});
+
+ my $o_dims = _opt($o,['d','dim','dims','Dims']);
+ $o_dims = pdl($o_dims)
+ if defined($o_dims);
+
+ my $scale = _opt($o,['s','scale','Scale']);
+ $scale = pdl($scale)
+ if defined($scale);
+
+ # Figure out the number of dimensions to transform, and,
+ # if necessary, generate a new matrix.
+
+ if(defined($me->{params}->{matrix})) {
+ my $mat = $me->{params}->{matrix} = $me->{params}->{matrix}->slice(":,:");
+ $me->{idim} = $mat->dim(0);
+ $me->{odim} = $mat->dim(1);
+
+ } else {
+ if(defined($me->{params}->{rot}) &&
+ UNIVERSAL::isa($me->{params}->{rot},'PDL')) {
+ $me->{idim} = $me->{odim} = 2 if($me->{params}->{rot}->nelem == 1);
+ $me->{idim} = $me->{odim} = 3 if($me->{params}->{rot}->nelem == 3);
+ }
+
+ if(defined($scale) &&
+ UNIVERSAL::isa($scale,'PDL') &&
+ $scale->getndims > 0) {
+ $me->{idim} = $me->{odim} = $scale->dim(0);
+ $me->{odim} = $scale->dim(0);
+
+ } elsif(defined($me->{params}->{pre}) &&
+ UNIVERSAL::isa($me->{params}->{pre},'PDL') &&
+ $me->{params}->{pre}->getndims > 0) {
+ $me->{idim} = $me->{odim} = $me->{params}->{pre}->dim(0);
+
+ } elsif(defined($me->{params}->{post}) &&
+ UNIVERSAL::isa($me->{params}->{post},'PDL') &&
+ $me->{params}->{post}->getndims > 0) {
+ $me->{idim} = $me->{odim} = $me->{params}->{post}->dim(0);
+ } elsif(defined($o_dims)) {
+ $me->{idim} = $me->{odim} = $o_dims;
+ } else {
+ print "PDL::Transform::Linear: assuming 2-D transform (set dims option to change)\n" if($PDL::Transform::debug);
+ $me->{idim} = $me->{odim} = 2;
+ }
+
+ $me->{params}->{matrix} = PDL->zeroes($me->{idim},$me->{odim});
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $me->{params}->{matrix}->diagonal(0,1)) .= 1;
+
+ }
+
+ ### Handle rotation option
+ my $rot = $me->{params}->{rot};
+ if(defined($rot)) {
+ # Subrotation closure -- rotates from axis $d->(0) --> $d->(1).
+ my $subrot = sub {
+ my($d,$angle,$m)=@_;
+ my($i) = identity($m->dim(0));
+ my($subm) = $i->dice($d,$d);
+
+ $angle = $angle->at(0)
+ if(UNIVERSAL::isa($angle,'PDL'));
+
+ my($a) = $angle * $DEG2RAD;
+ $subm .= $subm x pdl([cos($a),-sin($a)],[sin($a),cos($a)]);
+ $m .= $m x $i;
+ };
+
+ if(UNIVERSAL::isa($rot,'PDL') && $rot->nelem > 1) {
+ if($rot->ndims == 2) {
+ $me->{params}->{matrix} x= $rot;
+ } elsif($rot->nelem == 3) {
+ my $rm = identity(3);
+
+ # Do these in reverse order to make it more like
+ # function composition!
+ &$subrot(pdl(0,1),$rot->at(2),$rm);
+ &$subrot(pdl(2,0),$rot->at(1),$rm);
+ &$subrot(pdl(1,2),$rot->at(0),$rm);
+
+ $me->{params}->{matrix} .= $me->{params}->{matrix} x $rm;
+ } else {
+ barf("PDL::Transform::Linear: Got a strange rot option -- giving up.\n");
+ }
+ } else {
+ if($rot != 0 and $me->{params}->{matrix}->dim(0)>1) {
+ &$subrot(pdl(0,1),$rot,$me->{params}->{matrix});
+ }
+ }
+ }
+
+
+ #
+ # Apply scaling
+ #
+ $me->{params}->{matrix} = $me->{params}->{matrix}->slice(":,:");
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $me->{params}->{matrix}->diagonal(0,1)) *= $scale
+ if defined($scale);
+
+ #
+ # Check for an inverse and apply it if possible
+ #
+ my($o2);
+ if($me->{params}->{matrix}->det($o2 = {lu=>undef})) {
+ $me->{params}->{inverse} = $me->{params}->{matrix}->inv($o2);
+ } else {
+ delete $me->{params}->{inverse};
+ }
+
+ $me->{params}->{idim} = $me->{idim};
+ $me->{params}->{odim} = $me->{odim};
+
+
+ ##############################
+ # The meat -- just shift, matrix-multiply, and shift again.
+ $me->{func} = sub {
+ my($in,$opt) = @_;
+
+ my($d) = $opt->{matrix}->dim(0)-1;
+
+ barf("Linear transform: transform is $d-D; data only ".($in->dim(0))."\n")
+ if($in->dim(0) < $d);
+
+ my($a) = $in->slice("0:$d")->copy + $opt->{pre};
+ my($out) = $in->is_inplace ? $in : $in->copy;
+
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $out->slice("0:$d")) .= $a x $opt->{matrix} + $opt->{post};
+
+ return $out;
+ };
+
+
+ $me->{inv} = (defined $me->{params}->{inverse}) ? sub {
+ my($in,$opt) = @_;
+
+ my($d) = $opt->{inverse}->dim(0)-1;
+ barf("Linear transform: transform is $d-D; data only ".($in->dim(0))."\n")
+ if($in->dim(0) < $d);
+
+ my($a) = $in->slice("0:$d")->copy - $opt->{post};
+ my($out) = $in->is_inplace ? $in : $in->copy;
+
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $out->slice("0:$d")) .= $a x $opt->{inverse} - $opt->{pre};
+
+ $out;
+ } : undef;
+
+ return $me;
+}
+
+sub PDL::Transform::Linear::stringify {
+ package PDL::Transform::Linear;
+ my($me) = shift; my($out) = SUPER::stringify $me;
+ my $mp = $me->{params};
+
+ if(!($me->{is_inverse})){
+ $out .= "Pre-add: ".($mp->{pre})."\n"
+ if(defined $mp->{pre});
+
+ $out .= "Post-add: ".($mp->{post})."\n"
+ if(defined $mp->{post});
+
+ $out .= "Forward matrix:".($mp->{matrix})
+ if(defined $mp->{matrix});
+
+ $out .= "Inverse matrix:".($mp->{inverse})
+ if(defined $mp->{inverse});
+ } else {
+ $out .= "Pre-add: ".(-$mp->{post})."\n"
+ if(defined $mp->{post});
+
+ $out .= "Post-add: ".(-$mp->{pre})."\n"
+ if(defined $mp->{pre});
+
+ $out .= "Forward matrix:".($mp->{inverse})
+ if(defined $mp->{inverse});
+
+ $out .= "Inverse matrix:".($mp->{matrix})
+ if(defined $mp->{matrix});
+ }
+
+ $out =~ s/\n/\n /go;
+ $out;
+}
+
++======EOD_t_linear======
+
+
+pp_add_exported('t_scale');
+pp_addpm(<<'+======EOD_t_scale======');
+
+=head2 t_scale
+
+=for usage
+
+ $f = t_scale(<scale>)
+
+=for ref
+
+Convenience interface to L<t_linear|/t_linear>.
+
+t_scale produces a tranform that scales around the origin by a fixed
+amount. It acts exactly the same as C<t_linear(Scale=>\<scale\>)>.
+
+=cut
+
+sub t_scale {
+ my($scale) = shift;
+ my($b) = shift;
+ return t_linear(scale=>$scale,%{$b})
+ if(ref $b eq 'HASH');
+ t_linear(Scale=>$scale,$b, at _);
+}
+
++======EOD_t_scale======
+
+pp_add_exported('t_offset ');
+pp_addpm(<<'+======EOD_t_offset ======');
+
+=head2 t_offset
+
+=for usage
+
+ $f = t_offset(<shift>)
+
+=for ref
+
+Convenience interface to L<t_linear|/t_linear>.
+
+t_offset produces a transform that shifts the origin to a new location.
+It acts exactly the same as C<t_linear(Pre=>\<shift\>)>.
+
+=cut
+
+sub t_offset {
+ my($pre) = shift;
+ my($b) = shift;
+ return t_linear(pre=>$pre,%{$b})
+ if(ref $b eq 'HASH');
+
+ t_linear(pre=>$pre,$b, at _);
+}
+
++======EOD_t_offset ======
+
+pp_add_exported('t_rot');
+pp_addpm(<<'+======EOD_t_rot======');
+
+=head2 t_rot
+
+=for usage
+
+ $f = t_rot(<rotation-in-degrees>)
+
+=for ref
+
+Convenience interface to L<t_linear|/t_linear>.
+
+t_rot produces a rotation transform in 2-D (scalar), 3-D (3-vector), or
+N-D (matrix). It acts exactly the same as C<t_linear(Rot=>\<shift\>)>.
+
+=cut
+
+*t_rot = \&t_rotate;
+sub t_rotate {
+ my $rot = shift;
+ my($b) = shift;
+ return t_linear(rot=>$rot,%{$b})
+ if(ref $b eq 'HASH');
+
+ t_linear(rot=>$rot,$b, at _);
+}
+
++======EOD_t_rot======
+
+
+
+pp_add_exported('t_fits');
+pp_addpm(<<'+======EOD_t_fits======');
+
+=head2 t_fits
+
+=for usage
+
+ $f = t_fits($fits,[option]);
+
+=for ref
+
+FITS pixel-to-scientific transformation with inverse
+
+You feed in a hash ref or a PDL with one of those as a header, and you
+get back a transform that converts 0-originated, pixel-centered
+coordinates into scientific coordinates via the transformation in the
+FITS header. For most FITS headers, the transform is reversible, so
+applying the inverse goes the other way. This is just a convenience
+subclass of PDL::Transform::Linear, but with unit/type support
+using the FITS header you supply.
+
+For now, this transform is rather limited -- it really ought to
+accept units differences and stuff like that, but they are just
+ignored for now. Probably that would require putting units into
+the whole transform framework.
+
+This transform implements the linear transform part of the WCS FITS
+standard outlined in Greisen & Calabata 2002 (A&A in press; find it at
+"http://arxiv.org/abs/astro-ph/0207407").
+
+As a special case, you can pass in the boolean option "ignore_rgb"
+(default 0), and if you pass in a 3-D FITS header in which the last
+dimension has exactly 3 elements, it will be ignored in the output
+transformation. That turns out to be handy for handling rgb images.
+
+=cut
+
+sub t_fits {
+ my($class) = 'PDL::Transform::Linear';
+ my($hdr) = shift;
+ my($opt) = shift;
+
+ if(ref $opt ne 'HASH') {
+ $opt = defined $opt ? {$opt, at _} : {} ;
+ }
+
+ $hdr = $hdr->gethdr
+ if(defined $hdr && UNIVERSAL::isa($hdr,'PDL'));
+
+ croak('PDL::Transform::FITS::new requires a FITS header hash\n')
+ if(!defined $hdr || ref $hdr ne 'HASH' || !defined($hdr->{NAXIS}));
+
+ my($n) = $hdr->{NAXIS}; $n = $n->at(0) if(UNIVERSAL::isa($n,'PDL'));
+
+ $n = 2
+ if($opt->{ignore_rgb} && $n==3 && $hdr->{NAXIS3} == 3);
+
+ my($matrix) = PDL->zeroes($hdr->{NAXIS},$hdr->{NAXIS});
+ my($pre) = PDL->zeroes($n);
+ my($post) = PDL->zeroes($n);
+
+ ##############################
+ # Scaling: Use CDi_j formalism if present; otherwise use the
+ # older PCi_j + CDELTi formalism.
+
+ my(@hgrab);
+
+ if(@hgrab = grep(m/^CD\d{1,3}_\d{1,3}$/,keys %$hdr)) { # assignment
+ #
+ # CDi_j formalism
+ #
+ for my $h(@hgrab) {
+ $h =~ m/CD(\d{1,3})_(\d{1,3})/; # Should always match
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $matrix->slice("(".($1-1)."),(".($2-1).")")) .= $hdr->{$h};
+ }
+ print "PDL::Transform::FITS: Detected CDi_j matrix: \n",$matrix,"\n"
+ if($PDL::Transform::debug);
+
+ } else {
+
+ #
+ # PCi_j + CDELTi formalism
+ # If PCi_j aren't present, and N=2, then try using CROTA or
+ # CROTA2 to generate a rotation matrix instea.
+ #
+
+ my($cdm) = PDL->zeroes($n,$n);
+ my($cd) = $cdm->diagonal(0,1);
+
+ my($cpm) = PDL->zeroes($n,$n);
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $cpm->diagonal(0,1)) .= 1; # PC: diagonal defaults to unity
+ $cd .= 1;
+
+
+ if( @hgrab = grep(m/^PC\d{1,3}_\d{1,3}$/,keys %$hdr) ) { # assignment
+
+ for my $h(@hgrab) {
+ $h =~ m/PC(\d{1,3})_(\d{1,3})$/ || die "t_fits - match failed! This should never happen!";
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $cpm->slice("(".($1-1)."),(".($2-1).")")) .= $hdr->{$h};
+ }
+ print "PDL::Transform::FITS: Detected PCi_j matrix: \n",$cpm,"\n"
+ if($PDL::Transform::debug && @hgrab);
+
+ } elsif($n==2 && ( defined $hdr->{CROTA} || defined $hdr->{CROTA1} || defined $hdr->{CROTA2}) ) {
+
+ ## CROTA is deprecated; CROTA1 was used for a while but is unofficial;
+ ## CROTA2 is encouraged instead.
+ my $cr;
+ $cr = $hdr->{CROTA2} unless defined $cr;
+ $cr = $hdr->{CROTA} unless defined $cr;
+ $cr = $hdr->{CROTA1} unless defined $cr;
+
+ $cr *= $DEG2RAD;
+ # Rotation matrix rotates counterclockwise to get from sci to pixel coords
+ # (detector has been rotated ccw, according to FITS standard)
+ $cpm .= pdl( [cos($cr), sin($cr)],[-sin($cr),cos($cr)] );
+
+ }
+
+ for my $i(1..$n) {
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $cd->slice("(".($i-1).")")) .= $hdr->{"CDELT$i"};
+ }
+#If there are no CDELTs, then we assume they are all 1.0,
+#as in PDL::Graphics::PGPLOT::Window::_FITS_tr.
+ $cd+=1 if (all($cd==0));
+
+ $matrix = $cdm x $cpm;
+ }
+
+ my($i1) = 0;
+ for my $i(1..$n) {
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $pre->slice("($i1)")) .= 1 - $hdr->{"CRPIX$i"};
+ ($tmp = $post->slice("($i1)")) .= $hdr->{"CRVAL$i"};
+ $i1++;
+ }
+
+ my($me) = PDL::Transform::Linear::new($class,
+ {'pre'=>$pre,
+ 'post'=>$post,
+ 'matrix'=>$matrix
+ });
+
+ $me->{name} = 'FITS';
+
+ my (@otype, at ounit, at itype, at iunit);
+ our (@names) = ('X','Y','Z') unless @names;
+
+ for my $i(1..$hdr->{NAXIS}) {
+ push(@otype,$hdr->{"CTYPE$i"});
+ push(@ounit,$hdr->{"CUNIT$i"});
+ push(@itype,"Image ". ( ($i-1<=$#names) ? $names[$i-1] : "${i}th dim" ));
+ push(@iunit,"Pixels");
+ }
+
+ $me->{otype} = \@otype;
+ $me->{itype} = \@itype;
+ $me->{ounit} = \@ounit;
+ $me->{iunit} = \@iunit;
+
+ # Check for nonlinear projection...
+# if($hdr->{CTYPE1} =~ m/(\w\w\w\w)\-(\w\w\w)/) {
+# print "Nonlinear transformation found... ignoring nonlinear part...\n";
+# }
+
+ return $me;
+
+
+}
+
++======EOD_t_fits======
+
+
+
+
+
+pp_add_exported('t_code ');
+pp_addpm(<<'+======EOD_t_code ======');
+
+=head2 t_code
+
+=for usage
+
+ $f = t_code(<func>,[<inv>],[options]);
+
+=for ref
+
+Transform implementing arbitrary perl code.
+
+This is a way of getting quick-and-dirty new transforms. You pass in
+anonymous (or otherwise) code refs pointing to subroutines that
+implement the forward and, optionally, inverse transforms. The
+subroutines should accept a data PDL followed by a parameter hash ref,
+and return the transformed data PDL. The parameter hash ref can be
+set via the options, if you want to.
+
+Options that are accepted are:
+
+=over 3
+
+=item p,params
+
+The parameter hash that will be passed back to your code (defaults to the
+empty hash).
+
+=item n,name
+
+The name of the transform (defaults to "code").
+
+=item i, idim (default 2)
+
+The number of input dimensions (additional ones should be passed through
+unchanged)
+
+=item o, odim (default 2)
+
+The number of output dimensions
+
+=item itype
+
+The type of the input dimensions, in an array ref (optional and advisiory)
+
+=item otype
+
+The type of the output dimension, in an array ref (optional and advisory)
+
+=item iunit
+
+The units that are expected for the input dimensions (optional and advisory)
+
+=item ounit
+
+The units that are returned in the output (optional and advisory).
+
+=back
+
+The code variables are executable perl code, either as a code ref or
+as a string that will be eval'ed to produce code refs. If you pass in
+a string, it gets eval'ed at call time to get a code ref. If it compiles
+OK but does not return a code ref, then it gets re-evaluated with "sub {
+... }" wrapped around it, to get a code ref.
+
+Note that code callbacks like this can be used to do really weird
+things and generate equally weird results -- caveat scriptor!
+
+=cut
+
+sub t_code {
+ my($class) = 'PDL::Transform';
+ my($func, $inv, $o) = @_;
+ if(ref $inv eq 'HASH') {
+ $o = $inv;
+ $inv = undef;
+ }
+
+ my($me) = PDL::Transform::new($class);
+ $me->{name} = _opt($o,['n','name','Name']) || "code";
+ $me->{func} = $func;
+ $me->{inv} = $inv;
+ $me->{params} = _opt($o,['p','params','Params']) || {};
+ $me->{idim} = _opt($o,['i','idim']) || 2;
+ $me->{odim} = _opt($o,['o','odim']) || 2;
+ $me->{itype} = _opt($o,['itype']) || [];
+ $me->{otype} = _opt($o,['otype']) || [];
+ $me->{iunit} = _opt($o,['iunit']) || [];
+ $me->{ounit} = _opt($o,['ounit']) || [];
+
+ $me;
+}
+
++======EOD_t_code ======
+
+
+
+pp_add_exported('t_cylindrical');
+pp_add_exported('t_radial');
+pp_addpm(<<'+======EOD_t_cylindrical======');
+
+=head2 t_cylindrical
+
+=head2 t_radial
+
+=for usage
+
+ $f = t_radial(<options>);
+
+=for ref
+
+Convert Cartesian to radial/cylindrical coordinates. (2-D/3-D; with inverse)
+
+Converts 2-D Cartesian to radial (theta,r) coordinates. You can choose
+direct or conformal conversion. Direct conversion preserves radial
+distance from the origin; conformal conversion preserves local angles,
+so that each small-enough part of the image only appears to be scaled
+and rotated, not stretched. Conformal conversion puts the radius on a
+logarithmic scale, so that scaling of the original image plane is
+equivalent to a simple offset of the transformed image plane.
+
+If you use three or more dimensions, the higher dimensions are ignored,
+yielding a conversion from Cartesian to cylindrical coordinates, which
+is why there are two aliases for the same transform. If you use higher
+dimensionality than 2, you must manually specify the origin or you will
+get dimension mismatch errors when you apply the transform.
+
+Theta runs B<clockwise> instead of the more usual counterclockwise; that is
+to preserve the mirror sense of small structures.
+
+OPTIONS:
+
+=over 3
+
+=item d, direct, Direct
+
+Generate (theta,r) coordinates out (this is the default); incompatible
+with Conformal. Theta is in radians, and the radial coordinate is
+in the units of distance in the input plane.
+
+=item r0, c, conformal, Conformal
+
+If defined, this floating-point value causes t_radial to generate
+(theta, ln(r/r0)) coordinates out. Theta is in radians, and the
+radial coordinate varies by 1 for each e-folding of the r0-scaled
+distance from the input origin. The logarithmic scaling is useful for
+viewing both large and small things at the same time, and for keeping
+shapes of small things preserved in the image.
+
+=item o, origin, Origin [default (0,0,0)]
+
+This is the origin of the expansion. Pass in a PDL or an array ref.
+
+=item u, unit, Unit [default 'radians']
+
+This is the angular unit to be used for the azimuth.
+
+=back
+
+EXAMPLES
+
+These examples do transformations back into the same size image as they
+started from; by suitable use of the "transform" option to
+L<unmap|/unmap> you can send them to any size array you like.
+
+Examine radial structure in M51:
+Here, we scale the output to stretch 2*pi radians out to the
+full image width in the horizontal direction, and to stretch 1 radius out
+to a diameter in the vertical direction.
+
+ $a = rfits('m51.fits');
+ $ts = t_linear(s => [250/2.0/3.14159, 2]); # Scale to fill orig. image
+ $tu = t_radial(o => [130,130]); # Expand around galactic core
+ $b = $a->map($ts x $tu);
+
+Examine radial structure in M51 (conformal):
+Here, we scale the output to stretch 2*pi radians out to the full image width
+in the horizontal direction, and scale the vertical direction by the exact
+same amount to preserve conformality of the operation. Notice that
+each piece of the image looks "natural" -- only scaled and not stretched.
+
+ $a = rfits('m51.fits')
+ $ts = t_linear(s=> 250/2.0/3.14159); # Note scalar (heh) scale.
+ $tu = t_radial(o=> [130,130], r0=>5); # 5 pix. radius -> bottom of image
+ $b = $ts->compose($tu)->unmap($a);
+
+
+=cut
+
+*t_cylindrical = \&t_radial;
+sub t_radial {
+ my($class) = 'PDL::Transform';
+ my($o) = $_[0];
+ if(ref $o ne 'HASH') {
+ $o = { @_ };
+ }
+
+ my($me) = PDL::Transform::new($class);
+
+ $me->{params}->{origin} = _opt($o,['o','origin','Origin']);
+ $me->{params}->{origin} = pdl(0,0)
+ unless defined($me->{params}->{origin});
+ $me->{params}->{origin} = PDL->pdl($me->{params}->{origin});
+
+
+ $me->{params}->{r0} = _opt($o,['r0','R0','c','conformal','Conformal']);
+ $me->{params}->{origin} = PDL->pdl($me->{params}->{origin});
+
+ $me->{params}->{u} = _opt($o,['u','unit','Unit'],'radians');
+ ### Replace this kludge with a units call
+ $me->{params}->{angunit} = ($me->{params}->{u} =~ m/^d/i) ? $RAD2DEG : 1.0;
+ print "radial: conversion is $me->{params}->{angunit}\n" if($PDL::Transform::debug);
+
+ $me->{name} = "radial (direct)";
+
+ $me->{idim} = 2;
+ $me->{odim} = 2;
+
+ if($me->{params}->{r0}) {
+ $me->{otype} = ["Azimuth", "Ln radius" . ($me->{params}->{r0} != 1.0 ? "/$me->{params}->{r0}" : "")];
+ $me->{ounit} = [$me->{params}->{u},'']; # true-but-null prevents copying
+ } else {
+ $me->{otype} = ["Azimuth","Radius"];
+ $me->{ounit} = [$me->{params}->{u},'']; # false value copies prev. unit
+ }
+
+ $me->{func} = sub {
+
+ my($data,$o) = @_;
+
+ my($out) = ($data->new_or_inplace);
+
+ my($d) = $data->copy;
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $d->slice("0:1")) -= $o->{origin};
+
+ my($d0) = $d->slice("(0)");
+ my($d1) = $d->slice("(1)");
+
+ # (mod operator on atan2 puts everything in the interval [0,2*PI).)
+ ($tmp = $out->slice("(0)")) .= (atan2(-$d1,$d0) % (2*$PI)) * $me->{params}->{angunit};
+
+ ($tmp = $out->slice("(1)")) .= (defined $o->{r0}) ?
+ 0.5 * log( ($d1*$d1 + $d0 * $d0) / ($o->{r0} * $o->{r0}) ) :
+ sqrt($d1*$d1 + $d0*$d0);
+
+ $out;
+ };
+
+ $me->{inv} = sub {
+
+ my($d,$o) = @_;
+ my($d0,$d1,$out)=
+ ( ($d->is_inplace) ?
+ ($d->slice("(0)")->copy, $d->slice("(1)")->copy->dummy(0,2), $d) :
+ ($d->slice("(0)"), $d->slice("(1)")->dummy(0,2), $d->copy)
+ );
+
+ $d0 /= $me->{params}->{angunit};
+
+ my($os) = $out->slice("0:1");
+ $os .= append(cos($d0)->dummy(0,1),-sin($d0)->dummy(0,1));
+ $os *= defined $o->{r0} ? ($o->{r0} * exp($d1)) : $d1;
+ $os += $o->{origin};
+
+ $out;
+ };
+
+
+ $me;
+}
+
++======EOD_t_cylindrical======
+
+pp_add_exported('t_quadratic');
+pp_addpm(<<'+======EOD_t_quadratic======');
+
+=head2 t_quadratic
+
+=for usage
+
+ $t = t_quadratic(<options>);
+
+=for ref
+
+Quadratic scaling -- cylindrical pincushion (n-d; with inverse)
+
+Quadratic scaling emulates pincushion in a cylindrical optical system:
+separate quadratic scaling is applied to each axis. You can apply
+separate distortion along any of the principal axes. If you want
+different axes, use L<t_wrap|/t_wrap> and L<t_linear|/t_linear> to rotate
+them to the correct angle. The scaling options may be scalars or
+vectors; if they are scalars then the expansion is isotropic.
+
+The formula for the expansion is:
+
+ f(a) = ( <a> + <strength> * a^2/<L_0> ) / (abs(<strength>) + 1)
+
+where <strength> is a scaling coefficient and <L_0> is a fundamental
+length scale. Negative values of <strength> result in a pincushion
+contraction.
+
+Note that, because quadratic scaling does not have a strict inverse for
+coordinate systems that cross the origin, we cheat slightly and use
+$x * abs($x) rather than $x**2. This does the Right thing for pincushion
+and barrel distortion, but means that t_quadratic does not behave exactly
+like t_cubic with a null cubic strength coefficient.
+
+OPTIONS
+
+=over 3
+
+=item o,origin,Origin
+
+The origin of the pincushion. (default is the, er, origin).
+
+=item l,l0,length,Length,r0
+
+The fundamental scale of the transformation -- the radius that remains
+unchanged. (default=1)
+
+=item s,str,strength,Strength
+
+The relative strength of the pincushion. (default = 0.1)
+
+=item honest (default=0)
+
+Sets whether this is a true quadratic coordinate transform. The more
+common form is pincushion or cylindrical distortion, which switches
+branches of the square root at the origin (for symmetric expansion).
+Setting honest to a non-false value forces true quadratic behavior,
+which is not mirror-symmetric about the origin.
+
+=item d, dim, dims, Dims
+
+The number of dimensions to quadratically scale (default is the
+dimensionality of your input vectors)
+
+
+=back
+
+=cut
+
+sub t_quadratic {
+ my($class) = 'PDL::Transform';
+ my($o) = $_[0];
+ if(ref $o ne 'HASH') {
+ $o = {@_};
+ }
+ my($me) = PDL::Transform::new($class);
+
+ $me->{params}->{origin} = _opt($o,['o','origin','Origin'],pdl(0));
+ $me->{params}->{l0} = _opt($o,['r0','l','l0','length','Length'],pdl(1));
+ $me->{params}->{str} = _opt($o,['s','str','strength','Strength'],pdl(0.1));
+ $me->{params}->{dim} = _opt($o,['d','dim','dims','Dims']);
+ $me->{name} = "quadratic";
+
+ $me->{func} = sub {
+ my($data,$o) = @_;
+ my($dd) = $data->copy - $o->{origin};
+ my($d) = (defined $o->{dim}) ? $dd->slice("0:".($o->{dim}-1)) : $dd;
+ $d += $o->{str} * ($d * abs($d)) / $o->{l0};
+ $d /= (abs($o->{str}) + 1);
+ $d += $o->{origin};
+ if($data->is_inplace) {
+ $data .= $dd;
+ return $data;
+ }
+ $dd;
+ };
+
+ $me->{inv} = sub {
+ my($data,$opt) = @_;
+ my($dd) = $data->copy ;
+ my($d) = (defined $opt->{dim}) ? $dd->slice("0:".($opt->{dim}-1)) : $dd;
+ my($o) = $opt->{origin};
+ my($s) = $opt->{str};
+ my($l) = $opt->{l0};
+
+ $d .= ((-1 + sqrt(1 + 4 * $s/$l * abs($d-$o) * (1+abs($s))))
+ / 2 / $s * $l) * (1 - 2*($d < $o));
+ $d += $o;
+ if($data->is_inplace) {
+ $data .= $dd;
+ return $data;
+ }
+ $dd;
+ };
+ $me;
+}
+
++======EOD_t_quadratic======
+
+pp_add_exported('t_cubic');
+pp_addpm(<<'+======EOD_t_cubic=======');
+
+=head2 t_cubic
+
+=for usage
+
+ $t = t_cubic(<options>);
+
+=for ref
+
+Cubic scaling - cubic pincushion (n-d; with inverse)
+
+Cubic scaling is a generalization of t_quadratic to a purely
+cubic expansion.
+
+The formula for the expansion is:
+
+ f(a) = ( a' + st * a'^3/L_0^2 ) / (1 + abs(st)) + origin
+
+where a'=(a-origin). That is a simple pincushion
+expansion/contraction that is fixed at a distance of L_0 from the
+origin.
+
+Because there is no quadratic term the result is always invertible with
+one real root, and there is no mucking about with complex numbers or
+multivalued solutions.
+
+
+OPTIONS
+
+=over 3
+
+=item o,origin,Origin
+
+The origin of the pincushion. (default is the, er, origin).
+
+=item l,l0,length,Length,r0
+
+The fundamental scale of the transformation -- the radius that remains
+unchanged. (default=1)
+
+
+=item d, dim, dims, Dims
+
+The number of dimensions to treat (default is the
+dimensionality of your input vectors)
+
+=back
+
+=cut
+
+sub t_cubic {
+ my ($class) = 'PDL::Transform';
+ my($o) = $_[0];
+ if(ref $o ne 'HASH') {
+ $o = {@_};
+ }
+ my($me) = PDL::Transform::new($class);
+
+ $me->{params}->{dim} = _opt($o,['d','dim','dims','Dims'],undef);
+ $me->{params}->{origin} = _opt($o,['o','origin','Origin'],pdl(0));
+ $me->{params}->{l0} = _opt($o,['r0','l','l0','length','Length'],pdl(1));
+ $me->{params}->{st} = _opt($o,['s','st','str'],pdl(0));
+ $me->{name} = "cubic";
+
+ $me->{params}->{cuberoot} = sub {
+ my $a = shift;
+ my $as = 1 - 2*($a<0);
+ return $as * ( abs($a) ** (1/3) );
+ };
+
+ $me->{func} = sub {
+ my($data,$o) = @_;
+ my($dd) = $data->copy;
+ my($d) = (defined $o->{dim}) ? $dd->slice("0:".($o->{dim}-1)) : $dd;
+
+ $d -= $o->{origin};
+
+ my $dl0 = $d / $o->{l0};
+
+ # f(x) = x + x**3 * ($o->{st} / $o->{l0}**2):
+ # A = ($o->{st}/$dl0**2)
+ # B = 0
+ # C = 1
+ # D = -f(x)
+ $d += $o->{st} * $d * $dl0 * $dl0;
+ $d /= ($o->{st}**2 + 1);
+
+ $d += $o->{origin};
+
+ if($data->is_inplace) {
+ $data .= $dd;
+ return $data;
+ }
+ return $dd;
+ };
+
+ $me->{inv} = sub {
+ my($data,$o) = @_;
+ my($l) = $o->{l0};
+
+ my($dd) = $data->copy;
+ my($d) = (defined $o->{dim}) ? $dd->slice("0:".($o->{dim}-1)) : $dd;
+
+ $d -= $o->{origin};
+ $d *= ($o->{st}+1);
+
+ # Now we have to solve:
+ # A x^3 + B X^2 + C x + D dd = 0
+ # with the assignments above for A,B,C,D.
+ # Since B is zero, this is greatly simplified - the discriminant is always negative,
+ # so there is always exactly one real root.
+ #
+ # The only real hassle is creating a symmetric cube root; for convenience
+ # is stashed in the params hash.
+
+ # First: create coefficients for mnemonics.
+ my ($A, $C, $D) = ( $o->{st} / $l / $l, 1, - $d );
+ my $alpha = 27 * $A * $A * $D;
+ my $beta = 3 * $A * $C;
+
+ my $inner_root = sqrt( $alpha * $alpha + 4 * $beta * $beta * $beta );
+
+ $d .= (-1 / (3 * $A)) *
+ (
+ + &{$o->{cuberoot}}( 0.5 * ( $alpha + $inner_root ) )
+ + &{$o->{cuberoot}}( 0.5 * ( $alpha - $inner_root ) )
+ );
+
+ $d += $origin;
+
+ if($data->is_inplace) {
+ $data .= $dd;
+ return $data;
+ } else {
+ return $dd;
+ }
+ };
+
+ $me;
+}
+
++======EOD_t_cubic=======
+
+
+pp_add_exported('t_quadratic');
+pp_addpm(<<'======EOD_t_quadratic======');
+
+=head2 t_quartic
+
+=for usage
+
+ $t = t_quartic(<options>);
+
+=for ref
+
+Quartic scaling -- cylindrical pincushion (n-d; with inverse)
+
+Quartic scaling is a generalization of t_quadratic to a quartic
+expansion. Only even powers of the input coordinates are retained,
+and (as with t_quadratic) sign is preserved, making it an odd function
+although a true quartic transformation would be an even function.
+
+You can apply separate distortion along any of the principal axes. If
+you want different axes, use L<t_wrap|/t_wrap> and
+L<t_linear|/t_linear> to rotate them to the correct angle. The
+scaling options may be scalars or vectors; if they are scalars then
+the expansion is isotropic.
+
+The formula for the expansion is:
+
+ f(a) = ( <a> + <strength> * a^2/<L_0> ) / (abs(<strength>) + 1)
+
+where <strength> is a scaling coefficient and <L_0> is a fundamental
+length scale. Negative values of <strength> result in a pincushion
+contraction.
+
+Note that, because quadratic scaling does not have a strict inverse for
+coordinate systems that cross the origin, we cheat slightly and use
+$x * abs($x) rather than $x**2. This does the Right thing for pincushion
+and barrel distortion, but means that t_quadratic does not behave exactly
+like t_cubic with a null cubic strength coefficient.
+
+OPTIONS
+
+=over 3
+
+=item o,origin,Origin
+
+The origin of the pincushion. (default is the, er, origin).
+
+=item l,l0,length,Length,r0
+
+The fundamental scale of the transformation -- the radius that remains
+unchanged. (default=1)
+
+=item s,str,strength,Strength
+
+The relative strength of the pincushion. (default = 0.1)
+
+=item honest (default=0)
+
+Sets whether this is a true quadratic coordinate transform. The more
+common form is pincushion or cylindrical distortion, which switches
+branches of the square root at the origin (for symmetric expansion).
+Setting honest to a non-false value forces true quadratic behavior,
+which is not mirror-symmetric about the origin.
+
+=item d, dim, dims, Dims
+
+The number of dimensions to quadratically scale (default is the
+dimensionality of your input vectors)
+
+
+=back
+
+=cut
+
+sub t_quartic {
+ my($class) = 'PDL::Transform';
+ my($o) = $_[0];
+ if(ref $o ne 'HASH') {
+ $o = {@_};
+ }
+ my($me) = PDL::Transform::new($class);
+
+ $me->{params}->{origin} = _opt($o,['o','origin','Origin'],pdl(0));
+ $me->{params}->{l0} = _opt($o,['r0','l','l0','length','Length'],pdl(1));
+ $me->{params}->{str} = _opt($o,['s','str','strength','Strength'],pdl(0.1));
+ $me->{params}->{dim} = _opt($o,['d','dim','dims','Dims']);
+ $me->{name} = "quadratic";
+
+ $me->{func} = sub {
+ my($data,$o) = @_;
+ my($dd) = $data->copy - $o->{origin};
+ my($d) = (defined $o->{dim}) ? $dd->slice("0:".($o->{dim}-1)) : $dd;
+ $d += $o->{str} * ($d * abs($d)) / $o->{l0};
+ $d /= (abs($o->{str}) + 1);
+ $d += $o->{origin};
+ if($data->is_inplace) {
+ $data .= $dd;
+ return $data;
+ }
+ $dd;
+ };
+
+ $me->{inv} = sub {
+ my($data,$opt) = @_;
+ my($dd) = $data->copy ;
+ my($d) = (defined $opt->{dim}) ? $dd->slice("0:".($opt->{dim}-1)) : $dd;
+ my($o) = $opt->{origin};
+ my($s) = $opt->{str};
+ my($l) = $opt->{l0};
+
+ $d .= ((-1 + sqrt(1 + 4 * $s/$l * abs($d-$o) * (1+abs($s))))
+ / 2 / $s * $l) * (1 - 2*($d < $o));
+ $d += $o;
+ if($data->is_inplace) {
+ $data .= $dd;
+ return $data;
+ }
+ $dd;
+ };
+ $me;
+}
+
+======EOD_t_quadratic======
+
+pp_add_exported('t_spherical');
+pp_addpm(<<'+======EOD_t_spherical======');
+
+=head2 t_spherical
+
+=for usage
+
+ $t = t_spherical(<options>);
+
+=for ref
+
+Convert Cartesian to spherical coordinates. (3-D; with inverse)
+
+Convert 3-D Cartesian to spherical (theta, phi, r) coordinates. Theta
+is longitude, centered on 0, and phi is latitude, also centered on 0.
+Unless you specify Euler angles, the pole points in the +Z direction
+and the prime meridian is in the +X direction. The default is for
+theta and phi to be in radians; you can select degrees if you want
+them.
+
+Just as the L<t_radial|/t_radial> 2-D transform acts like a 3-D
+cylindrical transform by ignoring third and higher dimensions,
+Spherical acts like a hypercylindrical transform in four (or higher)
+dimensions. Also as with L<t_radial|/t_radial>, you must manually specify
+the origin if you want to use more dimensions than 3.
+
+To deal with latitude & longitude on the surface of a sphere (rather
+than full 3-D coordinates), see
+L<t_unit_sphere|PDL::Transform::Cartography/t_unit_sphere>.
+
+OPTIONS:
+
+=over 3
+
+=item o, origin, Origin [default (0,0,0)]
+
+This is the Cartesian origin of the spherical expansion. Pass in a PDL
+or an array ref.
+
+=item e, euler, Euler [default (0,0,0)]
+
+This is a 3-vector containing Euler angles to change the angle of the
+pole and ordinate. The first two numbers are the (theta, phi) angles
+of the pole in a (+Z,+X) spherical expansion, and the last is the
+angle that the new prime meridian makes with the meridian of a simply
+tilted sphere. This is implemented by composing the output transform
+with a PDL::Transform::Linear object.
+
+=item u, unit, Unit (default radians)
+
+This option sets the angular unit to be used. Acceptable values are
+"degrees","radians", or reasonable substrings thereof (e.g. "deg", and
+"rad", but "d" and "r" are deprecated). Once genuine unit processing
+comes online (a la Math::Units) any angular unit should be OK.
+
+=back
+
+=cut
+
+sub t_spherical {
+ my($class) = 'PDL::Transform';
+ my($o) = $_[0];
+ if(ref $o ne 'HASH') {
+ $o = { @_ } ;
+ }
+
+ my($me) = PDL::Transform::new($class);
+
+ $me->{idim}=3;
+ $me->{odim}=3;
+
+ $me->{params}->{origin} = _opt($o,['o','origin','Origin']);
+ $me->{params}->{origin} = PDL->zeroes(3)
+ unless defined($me->{params}->{origin});
+ $me->{params}->{origin} = PDL->pdl($me->{params}->{origin});
+
+ $me->{params}->{deg} = _opt($o,['d','degrees','Degrees']);
+
+ my $unit = _opt($o,['u','unit','Unit']);
+ $me->{params}->{angunit} = ($unit =~ m/^d/i) ?
+ $DEG2RAD : undef;
+
+ $me->{name} = "spherical";
+
+ $me->{func} = sub {
+ my($data,$o) = @_;
+ my($d) = $data->copy - $o->{origin};
+
+ my($d0,$d1,$d2) = ($d->slice("(0)"),$d->slice("(1)"),$d->slice("(2)"));
+ my($out) = ($d->is_inplace) ? $data : $data->copy;
+
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $out->slice("(0)")) .= atan2($d1, $d0);
+ ($tmp = $out->slice("(2)")) .= sqrt($d0*$d0 + $d1*$d1 + $d2*$d2);
+ ($tmp = $out->slice("(1)")) .= asin($d2 / $out->slice("(2)"));
+
+ ($tmp = $out->slice("0:1")) /= $o->{angunit}
+ if(defined $o->{angunit});
+
+ $out;
+ };
+
+ $me->{inv} = sub {
+ my($d,$o) = @_;
+
+ my($theta,$phi,$r,$out) =
+ ( ($d->is_inplace) ?
+ ($d->slice("(0)")->copy, $d->slice("(1)")->copy, $d->slice("(2)")->copy, $d) :
+ ($d->slice("(0)"), $d->slice("(1)"), $d->slice("(2)"), $d->copy)
+ );
+
+
+ my($x,$y,$z) =
+ ($out->slice("(0)"),$out->slice("(1)"),$out->slice("(2)"));
+
+ my($ph,$th);
+ if(defined $o->{angunit}){
+ $ph = $o->{angunit} * $phi;
+ $th = $o->{angunit} * $theta;
+ } else {
+ $ph = $phi;
+ $th = $theta;
+ }
+
+ $z .= $r * sin($ph);
+ $x .= $r * cos($ph);
+ $y .= $x * sin($th);
+ $x *= cos($th);
+ $out += $o->{origin};
+
+ $out;
+ };
+
+ $me;
+ }
+
++======EOD_t_spherical======
+
+pp_add_exported('t_projective');
+pp_addpm(<<'+======EOD_t_projective======');
+
+=head2 t_projective
+
+=for usage
+
+ $t = t_projective(<options>);
+
+=for ref
+
+Projective transformation
+
+Projective transforms are simple quadratic, quasi-linear
+transformations. They are the simplest transformation that
+can continuously warp an image plane so that four arbitrarily chosen
+points exactly map to four other arbitrarily chosen points. They
+have the property that straight lines remain straight after transformation.
+
+You can specify your projective transformation directly in homogeneous
+coordinates, or (in 2 dimensions only) as a set of four unique points that
+are mapped one to the other by the transformation.
+
+Projective transforms are quasi-linear because they are most easily
+described as a linear transformation in homogeneous coordinates
+(e.g. (x',y',w) where w is a normalization factor: x = x'/w, etc.).
+In those coordinates, an N-D projective transformation is represented
+as simple multiplication of an N+1-vector by an N+1 x N+1 matrix,
+whose lower-right corner value is 1.
+
+If the bottom row of the matrix consists of all zeroes, then the
+transformation reduces to a linear affine transformation (as in
+L<t_linear|/t_linear>).
+
+If the bottom row of the matrix contains nonzero elements, then the
+transformed x,y,z,etc. coordinates are related to the original coordinates
+by a quadratic polynomial, because the normalization factor 'w' allows
+a second factor of x,y, and/or z to enter the equations.
+
+OPTIONS:
+
+=over 3
+
+=item m, mat, matrix, Matrix
+
+If specified, this is the homogeneous-coordinate matrix to use. It must
+be N+1 x N+1, for an N-dimensional transformation.
+
+=item p, point, points, Points
+
+If specified, this is the set of four points that should be mapped one to the other.
+The homogeneous-coordinate matrix is calculated from them. You should feed in a
+2x2x4 PDL, where the 0 dimension runs over coordinate, the 1 dimension runs between input
+and output, and the 2 dimension runs over point. For example, specifying
+
+ p=> pdl([ [[0,1],[0,1]], [[5,9],[5,8]], [[9,4],[9,3]], [[0,0],[0,0]] ])
+
+maps the origin and the point (0,1) to themselves, the point (5,9) to (5,8), and
+the point (9,4) to (9,3).
+
+This is similar to the behavior of fitwarp2d with a quadratic polynomial.
+
+=back
+
+=cut
+
+sub t_projective {
+ my($class) = 'PDL::Transform';
+ my($o) = $_[0];
+ if(ref $o ne 'HASH') {
+ $o = { @_ };
+ }
+
+ my($me) = PDL::Transform::new($class);
+
+ $me->{name} = "projective";
+
+ ### Set options...
+
+
+ $me->{params}->{idim} = $me->{idim} = _opt($o,['d','dim','Dim']);
+
+ my $matrix;
+ if(defined ($matrix=_opt($o,['m','matrix','Matrix']))) {
+ $matrix = pdl($matrix);
+ die "t_projective: needs a square matrix"
+ if($matrix->dims != 2 || $matrix->dim(0) != $matrix->dim(1));
+
+ $me->{params}->{idim} = $matrix->dim(0)-1
+ unless(defined($me->{params}->{idim}));
+
+ $me->{idim} = $me->{params}->{idim};
+
+ die "t_projective: matrix not compatible with given dimension (should be N+1xN+1)\n"
+ unless($me->{params}->{idim}==$matrix->dim(0)-1);
+
+ my $inv = $matrix->inv;
+ print STDERR "t_projective: warning - received non-invertible matrix\n"
+ unless(all($inv*0 == 0));
+
+ $me->{params}->{matrix} = $matrix;
+ $me->{params}->{matinv} = $inv;
+
+ } elsif(defined ($p=pdl(_opt($o,['p','point','points','Point','Points'])))) {
+ die "t_projective: points array should be 2(x,y) x 2(in,out) x 4(point)\n\t(only 2-D points spec is available just now, sorry)\n"
+ unless($p->dims==3 && all(pdl($p->dims)==pdl(2,2,4)));
+
+ # Solve the system of N equations to find the projective transform
+ my ($p0,$p1,$p2,$p3) = ( $p->slice(":,(0),(0)"), $p->slice(":,(0),(1)"), $p->slice(":,(0),(2)"), $p->slice(":,(0),(3)") );
+ my ($P0,$P1,$P2,$P3) = ( $p->slice(":,(1),(0)"), $p->slice(":,(1),(1)"), $p->slice(":,(1),(2)"), $p->slice(":,(1),(3)") );
+#print "declaring PDL...\n" ;
+ my $M = pdl( [ [$p0->at(0), $p0->at(1), 1, 0, 0, 0, -$P0->at(0)*$p0->at(0), -$P0->at(0)*$p0->at(1)],
+ [ 0, 0, 0, $p0->at(0), $p0->at(1), 1, -$P0->at(1)*$p0->at(0), -$P0->at(1)*$p0->at(1)],
+ [$p1->at(0), $p1->at(1), 1, 0, 0, 0, -$P1->at(0)*$p1->at(0), -$P1->at(0)*$p1->at(1)],
+ [ 0, 0, 0, $p1->at(0), $p1->at(1), 1, -$P1->at(1)*$p1->at(0), -$P1->at(1)*$p1->at(1)],
+ [$p2->at(0), $p2->at(1), 1, 0, 0, 0, -$P2->at(0)*$p2->at(0), -$P2->at(0)*$p2->at(1)],
+ [ 0, 0, 0, $p2->at(0), $p2->at(1), 1, -$P2->at(1)*$p2->at(0), -$P2->at(1)*$p2->at(1)],
+ [$p3->at(0), $p3->at(1), 1, 0, 0, 0, -$P3->at(0)*$p3->at(0), -$P3->at(0)*$p3->at(1)],
+ [ 0, 0, 0, $p3->at(0), $p3->at(1), 1, -$P3->at(1)*$p3->at(0), -$P3->at(1)*$p3->at(1)]
+ ] );
+#print "ok. Finding inverse...\n";
+ my $h = ($M->inv x $p->slice(":,(1),:")->flat->slice("*1"))->slice("(0)");
+# print "ok\n";
+ my $matrix = ones(3,3);
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $matrix->flat->slice("0:7")) .= $h;
+ $me->{params}->{matrix} = $matrix;
+
+ $me->{params}->{matinv} = $matrix->inv;
+ }
+
+
+ $me->{params}->{idim} = 2 unless defined $me->{params}->{idim};
+ $me->{params}->{odim} = $me->{params}->{idim};
+ $me->{idim} = $me->{params}->{idim};
+ $me->{odim} = $me->{params}->{odim};
+
+ $me->{func} = sub {
+ my($data,$o) = @_;
+ my($id) = $data->dim(0);
+ my($d) = $data->glue(0,ones($data->slice("0")));
+ my($out) = ($o->{matrix} x $d->slice("*1"))->slice("(0)");
+ return ($out->slice("0:".($id-1))/$out->slice("$id"));
+ };
+
+ $me->{inv} = sub {
+ my($data,$o) = @_;
+ my($id) = $data->dim(0);
+ my($d) = $data->glue(0,ones($data->slice("0")));
+ my($out) = ($o->{matinv} x $d->slice("*1"))->slice("(0)");
+ return ($out->slice("0:".($id-1))/$out->slice("$id"));
+ };
+
+ $me;
+}
+
++======EOD_t_projective======
+
+pp_done();
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..9e04cf5
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,812 @@
+Bugs.pod
+Basic/AutoLoader.pm
+Basic/Bad/Makefile.PL
+Basic/Bad/bad.pd
+Basic/Complex/Makefile.PL
+Basic/Complex/complex.pd
+Basic/Constants.pm
+Basic/Core/Basic.pm
+Basic/Core/Char.pm
+Basic/Core/Core.pm.PL
+Basic/Core/Core.xs.PL
+Basic/Core/Dbg.pm
+Basic/Core/Dev.pm
+Basic/Core/Exporter.pm
+Basic/Core/Makefile.PL
+Basic/Core/Types.pm.PL
+Basic/Core/pdl.h.PL
+Basic/Core/pdl_hfiles.p
+Basic/Core/pdlapi.c
+Basic/Core/pdlconv.c.PL
+Basic/Core/pdlcore.c.PL
+Basic/Core/pdlcore.h.PL
+Basic/Core/pdlhash.c
+Basic/Core/pdlmagic.c
+Basic/Core/pdlmagic.h
+Basic/Core/pdlsections.g
+Basic/Core/pdlsimple.h.PL
+Basic/Core/pdltest.c
+Basic/Core/pdlthread.c
+Basic/Core/pdlthread.h
+Basic/Core/ppport.h
+Basic/Core/typemap
+Basic/Core/typemap.pdl
+Basic/Gen/Inline/MakePdlppInstallable.pm
+Basic/Gen/Inline/Makefile.PL
+Basic/Gen/Inline/Pdlpp.pm
+Basic/Gen/Makefile.PL
+Basic/Gen/PP.pm
+Basic/Gen/PP/CType.pm
+Basic/Gen/PP/Dims.pm
+Basic/Gen/PP/PDLCode.pm
+Basic/Gen/PP/PdlParObj.pm
+Basic/Gen/PP/Signature.pm
+Basic/Gen/PP/Struct.pm
+Basic/Gen/PP/SymTab.pm
+Basic/Gen/PP/Var.pm
+Basic/Gen/PP/XS.pm
+Basic/Gen/PP/dump.pp
+Basic/Gen/pptemplate.PL
+Basic/Lite.pm
+Basic/LiteF.pm
+Basic/Lvalue.pm
+Basic/Makefile.PL
+Basic/Math/Makefile.PL
+Basic/Math/NOTES
+Basic/Math/acosh.c
+Basic/Math/asinh.c
+Basic/Math/atanh.c
+Basic/Math/const.c
+Basic/Math/cpoly.c
+Basic/Math/cpoly.h
+Basic/Math/infinity.c
+Basic/Math/j0.c
+Basic/Math/j1.c
+Basic/Math/jn.c
+Basic/Math/math.pd
+Basic/Math/mconf.h
+Basic/Math/mtherr.c
+Basic/Math/ndtr.c
+Basic/Math/ndtri.c
+Basic/Math/polevl.c
+Basic/Math/protos.h
+Basic/Math/quiet_nan.c
+Basic/Math/rint.c
+Basic/Math/yn.c
+Basic/Matrix.pm
+Basic/MatrixOps/Makefile.PL
+Basic/MatrixOps/NOTES
+Basic/MatrixOps/README.ssl
+Basic/MatrixOps/blas.c
+Basic/MatrixOps/complex.c
+Basic/MatrixOps/complex.h
+Basic/MatrixOps/eigen.c
+Basic/MatrixOps/eigen.h
+Basic/MatrixOps/eigens.c
+Basic/MatrixOps/matrix.c
+Basic/MatrixOps/matrix.h
+Basic/MatrixOps/matrixops.pd
+Basic/MatrixOps/protos.h
+Basic/MatrixOps/simq.c
+Basic/MatrixOps/sslib.c
+Basic/MatrixOps/sslib.h
+Basic/MatrixOps/svd.c
+Basic/Ops/Makefile.PL
+Basic/Ops/ops.pd
+Basic/Options.pm
+Basic/PDL.pm
+Basic/Pod/API.pod
+Basic/Pod/BadValues.pod
+Basic/Pod/Course.pod
+Basic/Pod/Dataflow.pod
+Basic/Pod/Delta.pod
+Basic/Pod/FAQ.pod
+Basic/Pod/Index.pod
+Basic/Pod/Indexing.pod
+Basic/Pod/Internals.pod
+Basic/Pod/MATLAB.pod
+Basic/Pod/Makefile.PL
+Basic/Pod/Modules.pod
+Basic/Pod/Objects.pod
+Basic/Pod/PP.pod
+Basic/Pod/ParallelCPU.pod
+Basic/Pod/Philosophy.pod
+Basic/Pod/QuickStart.pod
+Basic/Pod/Scilab.pod
+Basic/Pod/Threading.pod
+Basic/Pod/Tips.pod
+Basic/Pod/Tutorials.pod
+Basic/Primitive/Makefile.PL
+Basic/Primitive/primitive.pd
+Basic/Reduce.pm
+Basic/Slices/Makefile.PL
+Basic/Slices/slices.pd
+Basic/SourceFilter/Changes
+Basic/SourceFilter/FilterSimple.pm
+Basic/SourceFilter/FilterUtilCall.pm
+Basic/SourceFilter/Makefile.PL
+Basic/SourceFilter/ModuleCompile.pm
+Basic/SourceFilter/NiceSlice.pm
+Basic/SourceFilter/example
+Basic/SourceFilter/local.perldlrc
+Basic/Test/Makefile.PL
+Basic/Test/tests.pd
+Basic/Ufunc/Makefile.PL
+Basic/Ufunc/ufunc.pd
+Basic/default.perldlrc
+COPYING
+Changes
+Changes_CVS
+DEPENDENCIES
+DEVELOPMENT
+Demos/BAD2_demo.pm.PL
+Demos/BAD_demo.pm.PL
+Demos/Cartography_demo.pm
+Demos/General.pm
+Demos/Gnuplot_demo.pm
+Demos/Makefile.PL
+Demos/PGPLOT_OO_demo.pm
+Demos/PGPLOT_demo.pm
+Demos/Prima.pm
+Demos/Screen.pm
+Demos/Transform_demo.pm
+Demos/TriD/mandel.pl
+Demos/TriD/test3.p
+Demos/TriD/test4.p
+Demos/TriD/test5.p
+Demos/TriD/test7.p
+Demos/TriD/test8.p
+Demos/TriD/test9.p
+Demos/TriD/testimg.p
+Demos/TriD/testvib.p
+Demos/TriD/tmathgraph.p
+Demos/TriD/tvrml.p
+Demos/TriD/tvrml2.p
+Demos/TriD1.pm
+Demos/TriD2.pm
+Demos/TriDGallery.pm
+Demos/earth-interp.pl
+Demos/earth.txt
+Doc/Doc.pm
+Doc/Doc/Config.pm.PL
+Doc/Doc/Perldl.pm
+Doc/Makefile.PL
+Doc/README
+Doc/TODO
+Doc/mkhtmldoc.pl
+Doc/mkpdlfuncpod
+Doc/scantree.pl
+Example/Benchmark/Bench.pm
+Example/Benchmark/Bench.xs
+Example/Benchmark/Makefile.PL
+Example/Benchmark/README
+Example/Benchmark/time.pl
+Example/Fit/lmfit_example.pl
+Example/IO/wmpeg.pl
+Example/InlinePdlpp/Module/Makefile.PL
+Example/InlinePdlpp/Module/MyInlineMod.pm
+Example/InlinePdlpp/Module/t/myinlinemod.t
+Example/InlinePdlpp/inlpp.pl
+Example/InlinePdlpp/inlpp_link.pl
+Example/InlinePdlpp/inlppminimal.pl
+Example/PGPLOT/pgplot.pl
+Example/PGPLOT/std_pgplot.pl
+Example/PLplot/refresh.pdl
+Example/Simplex/tsimp2.pl
+Example/Simplex/tsimp_needs_pgplot.pl
+Example/TriD/3dtest.pl
+Example/TriD/line3d.pl
+Example/TriD/old_trid_clip.pl
+Graphics/Graphics2D.pm
+Graphics/IIS/Makefile.PL
+Graphics/IIS/iis.pd
+Graphics/IIS/libiis.h
+Graphics/IIS/pdliisdisp.c
+Graphics/LUT/LUT.pm
+Graphics/LUT/Makefile.PL
+Graphics/LUT/README
+Graphics/LUT/ramps/Makefile.PL
+Graphics/LUT/ramps/equa.fits
+Graphics/LUT/ramps/expo.fits
+Graphics/LUT/ramps/gamma.fits
+Graphics/LUT/ramps/jigsaw.fits
+Graphics/LUT/ramps/lasritt.fits
+Graphics/LUT/ramps/log.fits
+Graphics/LUT/ramps/neg.fits
+Graphics/LUT/ramps/neglog.fits
+Graphics/LUT/ramps/null.fits
+Graphics/LUT/ramps/ramp.fits
+Graphics/LUT/ramps/stairs.fits
+Graphics/LUT/tables/Makefile.PL
+Graphics/LUT/tables/aips0.fits
+Graphics/LUT/tables/backgr.fits
+Graphics/LUT/tables/bgyrw.fits
+Graphics/LUT/tables/blue.fits
+Graphics/LUT/tables/blulut.fits
+Graphics/LUT/tables/color.fits
+Graphics/LUT/tables/green.fits
+Graphics/LUT/tables/heat.fits
+Graphics/LUT/tables/idl11.fits
+Graphics/LUT/tables/idl12.fits
+Graphics/LUT/tables/idl14.fits
+Graphics/LUT/tables/idl15.fits
+Graphics/LUT/tables/idl2.fits
+Graphics/LUT/tables/idl4.fits
+Graphics/LUT/tables/idl5.fits
+Graphics/LUT/tables/idl6.fits
+Graphics/LUT/tables/isophot.fits
+Graphics/LUT/tables/light.fits
+Graphics/LUT/tables/manycol.fits
+Graphics/LUT/tables/pastel.fits
+Graphics/LUT/tables/rainbow.fits
+Graphics/LUT/tables/rainbow1.fits
+Graphics/LUT/tables/rainbow2.fits
+Graphics/LUT/tables/rainbow3.fits
+Graphics/LUT/tables/rainbow4.fits
+Graphics/LUT/tables/ramp.fits
+Graphics/LUT/tables/random.fits
+Graphics/LUT/tables/random1.fits
+Graphics/LUT/tables/random2.fits
+Graphics/LUT/tables/random3.fits
+Graphics/LUT/tables/random4.fits
+Graphics/LUT/tables/random5.fits
+Graphics/LUT/tables/random6.fits
+Graphics/LUT/tables/real.fits
+Graphics/LUT/tables/red.fits
+Graphics/LUT/tables/smooth.fits
+Graphics/LUT/tables/smooth1.fits
+Graphics/LUT/tables/smooth2.fits
+Graphics/LUT/tables/smooth3.fits
+Graphics/LUT/tables/staircase.fits
+Graphics/LUT/tables/stairs8.fits
+Graphics/LUT/tables/stairs9.fits
+Graphics/LUT/tables/standard.fits
+Graphics/Limits/Limits.pm
+Graphics/Limits/Makefile.PL
+Graphics/Makefile.PL
+Graphics/PGPLOT/Makefile.PL
+Graphics/PGPLOT/PGPLOT.pm
+Graphics/PGPLOT/PGPLOTOptions.pm
+Graphics/PGPLOT/Window/Makefile.PL
+Graphics/PGPLOT/Window/Window.pm
+Graphics/PGPLOT/Window/Window.xs
+Graphics/PGPLOT/Window/typemap
+Graphics/PLplot/Changes
+Graphics/PLplot/Makefile.PL
+Graphics/PLplot/README
+Graphics/PLplot/plplot.pd
+Graphics/State.pm
+Graphics/TriD/Makefile.PL
+Graphics/TriD/OpenGLQ/Makefile.PL
+Graphics/TriD/OpenGLQ/openglq.pd
+Graphics/TriD/POGL/MANIFEST
+Graphics/TriD/POGL/Makefile.PL
+Graphics/TriD/POGL/OpenGL.pm
+Graphics/TriD/POGL/README
+Graphics/TriD/POGL/ignore.txt
+Graphics/TriD/POGL/t/00-load.t
+Graphics/TriD/Rout/Makefile.PL
+Graphics/TriD/Rout/rout.pd
+Graphics/TriD/TriD.pm
+Graphics/TriD/TriD/ArcBall.pm
+Graphics/TriD/TriD/ButtonControl.pm
+Graphics/TriD/TriD/Contours.pm
+Graphics/TriD/TriD/Control3D.pm
+Graphics/TriD/TriD/GL.pm
+Graphics/TriD/TriD/GoBoard.pm
+Graphics/TriD/TriD/Graph.pm
+Graphics/TriD/TriD/Image.pm
+Graphics/TriD/TriD/Labels.pm
+Graphics/TriD/TriD/Lines.pm
+Graphics/TriD/TriD/Logo.pm
+Graphics/TriD/TriD/MathGraph.pm
+Graphics/TriD/TriD/Mesh.pm
+Graphics/TriD/TriD/OOGL.pm
+Graphics/TriD/TriD/Object.pm
+Graphics/TriD/TriD/Objects.pm
+Graphics/TriD/TriD/Polygonize.pm
+Graphics/TriD/TriD/Quaternion.pm
+Graphics/TriD/TriD/SimpleScaler.pm
+Graphics/TriD/TriD/Surface.pm
+Graphics/TriD/TriD/TextObjects.pm
+Graphics/TriD/TriD/VRML.pm
+Graphics/TriD/TriD/ViewPort.pm
+Graphics/TriD/TriD/Window.pm
+Graphics/TriD/VRML/Makefile.PL
+Graphics/TriD/VRML/VRML.pm
+Graphics/TriD/VRML/VRML/Protos.pm
+INSTALL
+INTERNATIONALIZATION
+IO/Browser/Makefile.PL
+IO/Browser/browse.c
+IO/Browser/browser.pd
+IO/Browser/hints/dec_osf.pl
+IO/Dicom/Dicom.pm
+IO/Dicom/Makefile.PL
+IO/Dumper.pm
+IO/ENVI/readenvi.pdl
+IO/FITS/FITS.pm
+IO/FITS/Makefile.PL
+IO/FastRaw/FastRaw.pm
+IO/FastRaw/Makefile.PL
+IO/FlexRaw/FlexRaw.pm
+IO/FlexRaw/Makefile.PL
+IO/GD/Changes
+IO/GD/GD.pd
+IO/GD/Makefile.PL
+IO/GD/TODO
+IO/GD/typemap
+IO/HDF/Changes
+IO/HDF/HDF.pm
+IO/HDF/Makefile.PL
+IO/HDF/SD/Changes
+IO/HDF/SD/MANIFEST
+IO/HDF/SD/Makefile.PL
+IO/HDF/SD/SD.pd
+IO/HDF/TODO
+IO/HDF/VS/Changes
+IO/HDF/VS/MANIFEST
+IO/HDF/VS/Makefile.PL
+IO/HDF/VS/VS.pd
+IO/HDF/buildfunc.pm
+IO/HDF/typemap
+IO/IDL/IDL.pm
+IO/IDL/Makefile.PL
+IO/IDL/README
+IO/IO.pod
+IO/Makefile.PL
+IO/Misc/Makefile.PL
+IO/Misc/misc.pd
+IO/Pnm/Makefile.PL
+IO/Pnm/Pic.pm
+IO/Pnm/pnm.pd
+IO/Storable/Makefile.PL
+IO/Storable/storable.pd
+Known_problems
+Lib/CallExt/CallExt.pm
+Lib/CallExt/CallExt.xs
+Lib/CallExt/Makefile.PL
+Lib/Compression/Makefile.PL
+Lib/Compression/compression.pd
+Lib/Compression/ricecomp.c
+Lib/DiskCache.pm
+Lib/FFT/Makefile.PL
+Lib/FFT/fft.pd
+Lib/FFT/fftn.c
+Lib/FFT/fftn.h
+Lib/Filter/LinPred.pm
+Lib/Filter/Linear.pm
+Lib/Filter/Makefile.PL
+Lib/Fit/Gaussian/Makefile.PL
+Lib/Fit/Gaussian/gauss.c
+Lib/Fit/Gaussian/gaussian.pd
+Lib/Fit/LM.pm
+Lib/Fit/Linfit.pm
+Lib/Fit/Makefile.PL
+Lib/Fit/Polynomial.pm
+Lib/Func.pm
+Lib/GIS/Makefile.PL
+Lib/GIS/Proj/Makefile.PL
+Lib/GIS/Proj/Proj.pd
+Lib/GIS/Proj/README
+Lib/GIS/Proj/TODO
+Lib/GIS/Proj/include/projects.h
+Lib/GSL/DIFF/FUNC.c
+Lib/GSL/DIFF/Makefile.PL
+Lib/GSL/DIFF/gsl_diff.pd
+Lib/GSL/INTEG/FUNC.c
+Lib/GSL/INTEG/Makefile.PL
+Lib/GSL/INTEG/gsl_integ.pd
+Lib/GSL/INTERP/Makefile.PL
+Lib/GSL/INTERP/gsl_interp.pd
+Lib/GSL/INTERP/gslerr.h
+Lib/GSL/INTERP/typemap
+Lib/GSL/MROOT/FUNC.c
+Lib/GSL/MROOT/Makefile.PL
+Lib/GSL/MROOT/gsl_mroot.pd
+Lib/GSL/Makefile.PL
+Lib/GSL/RNG/Makefile.PL
+Lib/GSL/RNG/README
+Lib/GSL/RNG/gsl_random.pd
+Lib/GSL/RNG/typemap
+Lib/GSL/SF/Makefile.PL
+Lib/GSL/SF/README
+Lib/GSL/SF/airy/Makefile.PL
+Lib/GSL/SF/airy/gsl_sf_airy.pd
+Lib/GSL/SF/bessel/Makefile.PL
+Lib/GSL/SF/bessel/gsl_sf_bessel.pd
+Lib/GSL/SF/clausen/Makefile.PL
+Lib/GSL/SF/clausen/gsl_sf_clausen.pd
+Lib/GSL/SF/coulomb/Makefile.PL
+Lib/GSL/SF/coulomb/gsl_sf_coulomb.pd
+Lib/GSL/SF/coupling/Makefile.PL
+Lib/GSL/SF/coupling/gsl_sf_coupling.pd
+Lib/GSL/SF/dawson/Makefile.PL
+Lib/GSL/SF/dawson/gsl_sf_dawson.pd
+Lib/GSL/SF/debye/Makefile.PL
+Lib/GSL/SF/debye/gsl_sf_debye.pd
+Lib/GSL/SF/dilog/Makefile.PL
+Lib/GSL/SF/dilog/gsl_sf_dilog.pd
+Lib/GSL/SF/elementary/Makefile.PL
+Lib/GSL/SF/elementary/gsl_sf_elementary.pd
+Lib/GSL/SF/ellint/Makefile.PL
+Lib/GSL/SF/ellint/gsl_sf_ellint.pd
+Lib/GSL/SF/elljac/Makefile.PL
+Lib/GSL/SF/elljac/gsl_sf_elljac.pd
+Lib/GSL/SF/erf/Makefile.PL
+Lib/GSL/SF/erf/gsl_sf_erf.pd
+Lib/GSL/SF/exp/Makefile.PL
+Lib/GSL/SF/exp/gsl_sf_exp.pd
+Lib/GSL/SF/expint/Makefile.PL
+Lib/GSL/SF/expint/gsl_sf_expint.pd
+Lib/GSL/SF/fermi_dirac/Makefile.PL
+Lib/GSL/SF/fermi_dirac/gsl_sf_fermi_dirac.pd
+Lib/GSL/SF/gamma/Makefile.PL
+Lib/GSL/SF/gamma/gsl_sf_gamma.pd
+Lib/GSL/SF/gegenbauer/Makefile.PL
+Lib/GSL/SF/gegenbauer/gsl_sf_gegenbauer.pd
+Lib/GSL/SF/gslerr.h
+Lib/GSL/SF/hyperg/Makefile.PL
+Lib/GSL/SF/hyperg/gsl_sf_hyperg.pd
+Lib/GSL/SF/laguerre/Makefile.PL
+Lib/GSL/SF/laguerre/gsl_sf_laguerre.pd
+Lib/GSL/SF/legendre/Makefile.PL
+Lib/GSL/SF/legendre/gsl_sf_legendre.pd
+Lib/GSL/SF/log/Makefile.PL
+Lib/GSL/SF/log/gsl_sf_log.pd
+Lib/GSL/SF/poly/Makefile.PL
+Lib/GSL/SF/poly/gsl_sf_poly.pd
+Lib/GSL/SF/pow_int/Makefile.PL
+Lib/GSL/SF/pow_int/gsl_sf_pow_int.pd
+Lib/GSL/SF/psi/Makefile.PL
+Lib/GSL/SF/psi/gsl_sf_psi.pd
+Lib/GSL/SF/synchrotron/Makefile.PL
+Lib/GSL/SF/synchrotron/gsl_sf_synchrotron.pd
+Lib/GSL/SF/transport/Makefile.PL
+Lib/GSL/SF/transport/gsl_sf_transport.pd
+Lib/GSL/SF/trig/Makefile.PL
+Lib/GSL/SF/trig/gsl_sf_trig.pd
+Lib/GSL/SF/zeta/Makefile.PL
+Lib/GSL/SF/zeta/gsl_sf_zeta.pd
+Lib/Image2D/Makefile.PL
+Lib/Image2D/image2d.pd
+Lib/Image2D/resample.c
+Lib/Image2D/resample.h
+Lib/Image2D/rotate.c
+Lib/ImageND/Makefile.PL
+Lib/ImageND/imagend.pd
+Lib/ImageRGB/Makefile.PL
+Lib/ImageRGB/imagergb.pd
+Lib/ImageRGB/pdlppm.h
+Lib/ImageRGB/ppm_quant.c
+Lib/Interpolate/Interpolate.pm
+Lib/Interpolate/Makefile.PL
+Lib/Interpolate/Slatec/Makefile.PL
+Lib/Interpolate/Slatec/Slatec.pm
+Lib/Makefile.PL
+Lib/Minuit/FCN.c
+Lib/Minuit/Makefile.PL
+Lib/Minuit/minuit.pd
+Lib/Minuit/minuitlib/futils.f
+Lib/Minuit/minuitlib/intracfalse.f
+Lib/Minuit/minuitlib/minuit.f
+Lib/Opt/Makefile.PL
+Lib/Opt/Simplex/Makefile.PL
+Lib/Opt/Simplex/Simplex.pm
+Lib/Slatec/Makefile.PL
+Lib/Slatec/slatec.pd
+Lib/Slatec/slatec/chfcm.f
+Lib/Slatec/slatec/chfdv.f
+Lib/Slatec/slatec/chfev.f
+Lib/Slatec/slatec/chfie.f
+Lib/Slatec/slatec/d1mach.f
+Lib/Slatec/slatec/dasum.f
+Lib/Slatec/slatec/daxpy.f
+Lib/Slatec/slatec/dchfcm.f
+Lib/Slatec/slatec/dchfdv.f
+Lib/Slatec/slatec/dchfev.f
+Lib/Slatec/slatec/dchfie.f
+Lib/Slatec/slatec/ddot.f
+Lib/Slatec/slatec/dgeco.f
+Lib/Slatec/slatec/dgedi.f
+Lib/Slatec/slatec/dgefa.f
+Lib/Slatec/slatec/dgesl.f
+Lib/Slatec/slatec/dp1vlu.f
+Lib/Slatec/slatec/dpchbs.f
+Lib/Slatec/slatec/dpchce.f
+Lib/Slatec/slatec/dpchci.f
+Lib/Slatec/slatec/dpchcm.f
+Lib/Slatec/slatec/dpchcs.f
+Lib/Slatec/slatec/dpchdf.f
+Lib/Slatec/slatec/dpchfd.f
+Lib/Slatec/slatec/dpchfe.f
+Lib/Slatec/slatec/dpchia.f
+Lib/Slatec/slatec/dpchic.f
+Lib/Slatec/slatec/dpchid.f
+Lib/Slatec/slatec/dpchim.f
+Lib/Slatec/slatec/dpchkt.f
+Lib/Slatec/slatec/dpchsp.f
+Lib/Slatec/slatec/dpchst.f
+Lib/Slatec/slatec/dpchsw.f
+Lib/Slatec/slatec/dpcoef.f
+Lib/Slatec/slatec/dpoco.f
+Lib/Slatec/slatec/dpodi.f
+Lib/Slatec/slatec/dpofa.f
+Lib/Slatec/slatec/dpolft.f
+Lib/Slatec/slatec/dscal.f
+Lib/Slatec/slatec/dswap.f
+Lib/Slatec/slatec/ezfft1.f
+Lib/Slatec/slatec/ezfftb.f
+Lib/Slatec/slatec/ezfftf.f
+Lib/Slatec/slatec/ezffti.f
+Lib/Slatec/slatec/fdump.f
+Lib/Slatec/slatec/i1mach.f
+Lib/Slatec/slatec/idamax.f
+Lib/Slatec/slatec/isamax.f
+Lib/Slatec/slatec/j4save.f
+Lib/Slatec/slatec/pchbs.f
+Lib/Slatec/slatec/pchce.f
+Lib/Slatec/slatec/pchci.f
+Lib/Slatec/slatec/pchcm.f
+Lib/Slatec/slatec/pchcs.f
+Lib/Slatec/slatec/pchdf.f
+Lib/Slatec/slatec/pchfd.f
+Lib/Slatec/slatec/pchfe.f
+Lib/Slatec/slatec/pchia.f
+Lib/Slatec/slatec/pchic.f
+Lib/Slatec/slatec/pchid.f
+Lib/Slatec/slatec/pchim.f
+Lib/Slatec/slatec/pchkt.f
+Lib/Slatec/slatec/pchsp.f
+Lib/Slatec/slatec/pchst.f
+Lib/Slatec/slatec/pchsw.f
+Lib/Slatec/slatec/pcoef.f
+Lib/Slatec/slatec/polfit.f
+Lib/Slatec/slatec/pvalue.f
+Lib/Slatec/slatec/pythag.f
+Lib/Slatec/slatec/r1mach.f
+Lib/Slatec/slatec/radb2.f
+Lib/Slatec/slatec/radb3.f
+Lib/Slatec/slatec/radb4.f
+Lib/Slatec/slatec/radb5.f
+Lib/Slatec/slatec/radbg.f
+Lib/Slatec/slatec/radf2.f
+Lib/Slatec/slatec/radf3.f
+Lib/Slatec/slatec/radf4.f
+Lib/Slatec/slatec/radf5.f
+Lib/Slatec/slatec/radfg.f
+Lib/Slatec/slatec/rfftb.f
+Lib/Slatec/slatec/rfftb1.f
+Lib/Slatec/slatec/rfftf.f
+Lib/Slatec/slatec/rfftf1.f
+Lib/Slatec/slatec/rs.f
+Lib/Slatec/slatec/sasum.f
+Lib/Slatec/slatec/saxpy.f
+Lib/Slatec/slatec/sdot.f
+Lib/Slatec/slatec/sgeco.f
+Lib/Slatec/slatec/sgedi.f
+Lib/Slatec/slatec/sgefa.f
+Lib/Slatec/slatec/sgesl.f
+Lib/Slatec/slatec/snrm2.f
+Lib/Slatec/slatec/spoco.f
+Lib/Slatec/slatec/spodi.f
+Lib/Slatec/slatec/spofa.f
+Lib/Slatec/slatec/srot.f
+Lib/Slatec/slatec/srotg.f
+Lib/Slatec/slatec/sscal.f
+Lib/Slatec/slatec/ssvdc.f
+Lib/Slatec/slatec/sswap.f
+Lib/Slatec/slatec/tql2.f
+Lib/Slatec/slatec/tqlrat.f
+Lib/Slatec/slatec/tred1.f
+Lib/Slatec/slatec/tred2.f
+Lib/Slatec/slatec/xerbla.f
+Lib/Slatec/slatec/xercnt.f
+Lib/Slatec/slatec/xerhlt.f
+Lib/Slatec/slatec/xermsg.f
+Lib/Slatec/slatec/xerprn.f
+Lib/Slatec/slatec/xersve.f
+Lib/Slatec/slatec/xgetua.f
+Lib/Transform/Cartography/Cartography.pm
+Lib/Transform/Cartography/Makefile.PL
+Lib/Transform/Cartography/earth_coast.vec.fits
+Lib/Transform/Cartography/earth_day.jpg
+Lib/Transform/Cartography/earth_night.jpg
+Lib/Transform/Makefile.PL
+Lib/Transform/Proj4/Makefile.PL
+Lib/Transform/Proj4/Proj4.pd
+Lib/Transform/Proj4/README
+Lib/Transform/Proj4/TODO
+Lib/Transform/transform.pd
+MANIFEST This list of files
+MANIFEST.SKIP
+Makefile.PL
+PDLdb.pl
+Perldl2/Makefile.PL
+Perldl2/Plugin/CleanErrors.pm
+Perldl2/Plugin/Makefile.PL
+Perldl2/Plugin/NiceSlice.pm
+Perldl2/Plugin/PDLCommands.pm
+Perldl2/Plugin/PrintControl.pm
+Perldl2/Profile/Makefile.PL
+Perldl2/Profile/Perldl2.pm
+Perldl2/README
+Perldl2/Script.pm
+Perldl2/TODO
+Perldl2/pdl2
+README
+Release_Notes
+TODO
+TestTools/Mem/foobar
+TestTools/Mem/tmem.pl
+cygwin/INSTALL
+cygwin/README
+cygwin/drivers.list
+cygwin/g77_gcc.conf
+debian/README.Debian
+debian/changelog
+debian/compat
+debian/control
+debian/copyright
+debian/dh_pdl
+debian/f77conf.pl
+debian/fix_man_encoding.sed
+debian/fix_man_name.sed
+debian/patches/series
+debian/pdl.dirs
+debian/pdl.doc-base
+debian/pdl.docs
+debian/pdl.install
+debian/pdl.links
+debian/pdl.lintian-overrides
+debian/pdl.manpages
+debian/pdl.menu
+debian/pdl.postinst
+debian/pdl.prerm
+debian/pdl.remove
+debian/pdl.triggers
+debian/perldl.conf
+debian/rules
+debian/source/format
+debian/write_config_debian.pl
+inc/Carp.pm
+inc/Carp/Heavy.pm
+inc/Devel/CheckLib.pm
+m51.fits
+macosx/README
+pdl.PL
+pdldoc.PL
+perldl.PL
+perldl.conf
+t/aaa_load.t
+t/argtest.t
+t/autoload.t
+t/bad.t
+t/basic.t
+t/bess.t
+t/bool.t
+t/callext.c
+t/callext.t
+t/clump.t
+t/complex.t
+t/config.t
+t/constants.t
+t/constructor.t
+t/conv.t
+t/core.t
+t/croak.t
+t/diskcache.t
+t/dumper.t
+t/erf.t
+t/erfi.t
+t/familyfree.t
+t/fastraw.t
+t/fft.t
+t/fits.t
+t/flexraw.t
+t/flexraw_fortran.t
+t/flow.t
+t/foo.t
+t/func.pdl
+t/func.t
+t/gauss.t
+t/gd_oo_tests.t
+t/gd_tests.t
+t/gis_proj.t
+t/gsl_diff.t
+t/gsl_integ.t
+t/gsl_interp.t
+t/gsl_mroot.t
+t/gsl_rng.t
+t/gsl_sf.t
+t/hdf_sd.t
+t/hdf_vdata.t
+t/hdf_vgroup.t
+t/hdrs.t
+t/hist.t
+t/howbig.t
+t/ica.t
+t/image2d.t
+t/imagend.t
+t/imagergb.t
+t/inline-comment-test.t
+t/inlinepdlpp.t
+t/interp.t
+t/interp_slatec.t
+t/interpol.t
+t/iotypes.t
+t/lgamma.t
+t/limits_00.t
+t/limits_errb.t
+t/limits_keyspecs.t
+t/limits_normalize_dsets.t
+t/limits_range.t
+t/limits_round.t
+t/limits_trans.t
+t/limits_trans_err.t
+t/limits_ulimits.t
+t/linfit.t
+t/lut.t
+t/lvalue.t
+t/magic.t
+t/matmult.t
+t/matrix.t
+t/matrixops.t
+t/minuit.t
+t/misc.t
+t/niceslice.t
+t/nsdatahandle.t
+t/ones.t
+t/opengl.t
+t/ops.t
+t/pdl_from_string.t
+t/pdlchar.t
+t/pgplot.t
+t/physical.t
+t/pic_16bit.t
+t/picnorgb.t
+t/picrgb.t
+t/plplot.t
+t/plplot_no_fork.win32
+t/pnm.t
+t/poly.t
+t/polyroots.t
+t/pp_croaking.t
+t/pp_line_numbers.t
+t/pptest.t
+t/primitive.t
+t/primitive2.t
+t/proj_transform.t
+t/proj_transform2.t
+t/pthread.t
+t/pthreadBarf.t
+t/pthread_auto.t
+t/reduce.t
+t/refs.t
+t/requiredmods.t
+t/rim.t
+t/round.t
+t/scope.t
+t/segfault.t
+t/simplex.t
+t/slatec.t
+t/slice-exceptions.t
+t/slice.t
+t/storable.t
+t/subclass.t
+t/subclass2.t
+t/subclass3.t
+t/subclass4.t
+t/thread.t
+t/thread_def.t
+t/transform.t
+t/trig.t
+t/ufunc.t
+t/unpdl.t
+t/vaffine.t
+t/xvals.t
+utils/perldlpp.pl
+win32/INSTALL
+win32/win32f77.pl
+META.yml Module YAML meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..3537d04
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,269 @@
+%$
+-stamp$
+.*/TAGS$
+.*Version_check$
+.*\#$
+.*\.0$
+.*\.orig$
+.*\.rej$
+/\.\#.*
+/pm_to_blib$
+/tmp.*
+Benchmark/Bench.c
+Benchmark/blib/
+^CVS
+Lib/PCA/PCA*
+MANIFEST\.bak$
+MANIFEST\.old
+META\.yml
+META\.json
+Makefile$
+Makefile\.aperl
+Makefile\.old
+RCS
+\.(tmp|new|diff|ori)$
+\.BAK$
+\.bck$
+\.bs
+\.bundle$
+\.cvsignore$
+\.inlinepdlpp
+\.lck$
+\.o$
+\.out$
+\.patch$
+\.so$
+\.tar\.gz$
+\bcore$
+.exe$
+^Basic/Bad/Bad\.c$
+^Basic/Bad/Bad\.pm$
+^Basic/Bad/Bad\.xs$
+^Basic/Complex/Complex\.c
+^Basic/Complex/Complex\.pm
+^Basic/Complex/Complex\.xs
+^Basic/Core/Config\.pm
+^Basic/Core/Config\.pm
+^Basic/Core/Core\.c$
+^Basic/Core/Core\.pm$
+^Basic/Core/Core\.xs$
+^Basic/Core/Types\.pm$
+^Basic/Core/Version\.pm
+^Basic/Core/Version\.pm
+^Basic/Core/badsupport\.p
+^Basic/Core/check_endian$
+^Basic/Core/isbigendian.p$
+^Basic/Core/mymalloc.p$
+^Basic/Core/pdl\.h$
+^Basic/Core/pdlcore\.[ch]$
+^Basic/Core/pdlsimple\.h$
+^Basic/GTest/GTest\.c$
+^Basic/GTest/GTest\.pm$
+^Basic/GTest/GTest\.xs$
+^Basic/Gen/PP/Dump\.pm$
+^Basic/Gen/PP/Dump\.pm\.tmp$
+^Basic/Gen/pptemplate$
+^Basic/Gen/pptemplate.pod$
+^Basic/Math/Math\.c$
+^Basic/Math/Math\.pm$
+^Basic/Math/Math\.xs$
+^Basic/MatrixOps/MatrixOps\.c
+^Basic/MatrixOps/MatrixOps\.pm
+^Basic/MatrixOps/MatrixOps\.xs
+^Basic/OLD
+^Basic/Ops/Ops\.c$
+^Basic/Ops/Ops\.pm$
+^Basic/Ops/Ops\.xs$
+^Basic/Pod/Export\.pod$
+^Basic/Pod/PP-Inline\.pod$
+^Basic/Primitive/Primitive\.c$
+^Basic/Primitive/Primitive\.pm$
+^Basic/Primitive/Primitive\.xs$
+^Basic/Slices/Slices\.c$
+^Basic/Slices/Slices\.pm$
+^Basic/Slices/Slices\.xs$
+^Basic/SourceFilter/INSTALL
+^Basic/SourceFilter/MANIFEST
+^Basic/SourceFilter/MANIFEST
+^Basic/SourceFilter/README
+^Basic/SourceFilter/README
+^Basic/SourceFilter/README\.head
+^Basic/Test/Tests\..*
+^Basic/Ufunc/Ufunc\.c
+^Basic/Ufunc/Ufunc\.pm
+^Basic/Ufunc/Ufunc\.xs
+^Demos/BAD2_demo.pm$
+^Demos/BAD_demo.pm$
+^Demos/TkTriD_demo.pm$
+^Demos/TriD/test6.p$
+^Doc/Doc/Config.pm$
+^Doc/Pod/pod2usage$
+^Doc/Pod/podselect$
+^Doc/docscan$
+^Doc/pdlfunc\.pod
+^Doc/pdlhead2item$
+^Gen
+^Graphics/IIS/IIS\..*
+^Graphics/PGPLOT/PGPLOT.c
+^Graphics/PGPLOT/Window/Window.c
+^Graphics/PLplot/OPTIONS!
+^Graphics/PLplot/PLplot.c
+^Graphics/PLplot/PLplot.pm
+^Graphics/PLplot/PLplot.xs
+^Graphics/TriD/OpenGL/OpenGL.pm
+^Graphics/TriD/OpenGL/OpenGL.xs
+^Graphics/TriD/OpenGL/OpenGL\.c$
+^Graphics/TriD/OpenGL/X.h.cpp
+^Graphics/TriD/OpenGL/blib
+^Graphics/TriD/OpenGL/gl.h.cpp
+^Graphics/TriD/OpenGL/glu.h.cpp
+^Graphics/TriD/OpenGL/glx.h.cpp
+^Graphics/TriD/OpenGL/glxtokens.h.cpp
+^Graphics/TriD/OpenGL/ppcode.out
+^Graphics/TriD/OpenGL/typemap
+^Graphics/TriD/OpenGLQ/OpenGLQ\.*
+^Graphics/TriD/OpenGLQ/blib
+^Graphics/TriD/OpenGLQ/oglq-expand.pl$
+^Graphics/TriD/Rout/Rout\.*
+^Graphics/TriD/TriD/Tk.pm$
+^IO/Browser/Browser\..*
+^IO/Browser/[Pp][Dd][Cc]
+^IO/ENVI/envi-data
+^IO/ENVI/envi-data.hdr
+^IO/GD/GD\.c
+^IO/GD/GD\.pm
+^IO/GD/GD\.xs
+^IO/HDF/SD/SD\.c
+^IO/HDF/SD/SD\.pm
+^IO/HDF/SD/SD\.xs
+^IO/HDF/VS/VS\.c
+^IO/HDF/VS/VS\.pm
+^IO/HDF/VS/VS\.xs
+^IO/Misc/Misc.*
+^IO/NDF/NDF.pm$
+^IO/Pnm/Pnm\..*
+^IO/Pnm/converters$
+^IO/Pnm/converters/README
+^IO/Pnm/converters/pnmtotiff$
+^IO/Pnm/converters/pnmtotiff.c
+^IO/Pnm/converters/tifftopnm$
+^IO/Pnm/converters/tifftopnm.c
+^IO/Storable/Storable\.c
+^IO/Storable/Storable\.pm
+^IO/Storable/Storable\.xs
+^IO/tmp0
+^IO/tmp0.hdr
+^Image2D/Image2D\..*
+^LOG$
+^Lib/CallExt/CallExt\.c$
+^Lib/Compression/Compression.c
+^Lib/Compression/Compression.pm
+^Lib/Compression/Compression.xs
+^Lib/FFT/FFT\.*
+^Lib/FFTW/FFTW\.c
+^Lib/FFTW/FFTW\.pm
+^Lib/FFTW/FFTW\.xs
+^Lib/FFTW/typespec
+^Lib/Fit/Gaussian/Gaussian\.c
+^Lib/Fit/Gaussian/Gaussian\.pm
+^Lib/Fit/Gaussian/Gaussian\.xs
+^Lib/GIS/Proj/Proj\.c
+^Lib/GIS/Proj/Proj\.pm
+^Lib/GIS/Proj/Proj\.xs
+^Lib/GSL/.*\.pm$
+^Lib/GSL/.*\.xs$
+^Lib/GSL/DIFF/D.*\.c$
+^Lib/GSL/INTEG/I.*\.c$
+^Lib/GSL/INTERP/.*\.c$
+^Lib/GSL/MROOT/M.*\.c$
+^Lib/GSL/RNG/.*\.c$
+^Lib/GSL/RNG\.(pm|xs|c)
+^Lib/GSL/SF/.*\.c$
+^Lib/Gaussian\.pm
+^Lib/Genetic
+^Lib/Image2D/Image2D\..*
+^Lib/ImageND/ImageND\..*
+^Lib/ImageRGB/ImageRGB\..*
+^Lib/Minuit/.*\.a$
+^Lib/Minuit/.*\.pm$
+^Lib/Minuit/.*\.xs$
+^Lib/Minuit/M.*\.c$
+^Lib/Opt/Golden
+^Lib/PCARout/PCARout\..*
+^Lib/Slatec/Slatec.c
+^Lib/Slatec/Slatec.pm
+^Lib/Slatec/Slatec.xs
+^Lib/Slatec/SlatecProtos.h$
+^Lib/Slatec/f77_underscore$
+^Lib/Slatec/slatec/.*\.c$
+^Lib/Transform/Cartography/earth_day.ppm
+^Lib/Transform/Cartography/earth_night.ppm
+^Lib/Transform/Proj4/Makefile.PL-gis$
+^Lib/Transform/Proj4/Proj4\.c
+^Lib/Transform/Proj4/Proj4\.pm
+^Lib/Transform/Proj4/Proj4\.xs
+^Lib/Transform/Transform\.c
+^Lib/Transform/Transform\.pm
+^Lib/Transform/Transform\.xs
+^Padre/readline-fix
+^Perldl2/logo3d.pdl
+^Perldl2/pdl2.pod$
+^Perldl2/tctrl-c.pl
+^Perldl2/trgnu-ctrl-c.txt$
+^Perldl2/work
+^[.]Inline
+^\.\#.*
+^\.exists
+^\.git
+^_Inline
+^a3x3.txt
+^a4x4.txt
+^a9-3x3.txt
+^a9-4x4.txt
+^blib/
+^chm-notes/.*
+^core
+^cygwin/fix-max-memory.txt
+^cygwin/max_memory.c
+^cygwin/rtool.txt
+^cygwin/tmalloc.pl
+^debian/filter-test.pl
+^debian/patched/
+^gsl.pl
+^inc/Alien/Proj4/Makefile.PL
+^inc/Devel
+^inv-data.pl
+^patch
+^pdl$
+^pdl\.c$
+^pdldoc$
+^pdldoc.db$
+^pdldoc.pod
+^perl$
+^perldl$
+^perldl.conf-fast
+^perldl.conf-orig
+^perldl.pod
+^pm_to_blib$
+^podsel$
+^t/.*\.dll(.a)?$
+^t/.*\.pnm$
+^tbyte\.tif$
+^test\.wis$
+^tmp.*
+^tushort\.(tif|rgb)$
+^win32/pbmwin32.tar.gz
+makemakerdflt
+manifypods
+pdlbasicops\.c$
+pdlconv\.c$
+pdlexamples\.c$
+pdlmoremaths\.c$
+pdlsections\.c$
+pdlstats\.c$
+pure_all
+so_locations
+subdirs
+~$
+^work
+^pdl.*-log.txt$
diff --git a/META.json b/META.json
new file mode 100644
index 0000000..6181b6f
--- /dev/null
+++ b/META.json
@@ -0,0 +1,64 @@
+{
+ "abstract" : "Perl Data Language",
+ "author" : [
+ "PerlDL Developers (perldl at jach.hawaii.edu)"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.132140",
+ "license" : [
+ "unknown"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "PDL",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc",
+ "Lib/FFTW"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "Devel::CheckLib" : "1.01"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Astro::FITS::Header" : "0",
+ "Convert::UU" : "0",
+ "Data::Dumper" : "2.121",
+ "ExtUtils::MakeMaker" : "6.56",
+ "File::Map" : "0.57",
+ "File::Spec" : "0.6",
+ "File::Temp" : "0",
+ "Filter::Simple" : "0.88",
+ "Filter::Util::Call" : "0",
+ "Inline" : "0.43",
+ "Module::Compile" : "0.23",
+ "OpenGL" : "0.6702",
+ "Pod::Parser" : "0",
+ "Pod::Select" : "0",
+ "Storable" : "1.03",
+ "Test::Warn" : "0",
+ "Text::Balanced" : "1.89"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "bugtracker" : {
+ "web" : "http://sourceforge.net/p/pdl/bugs/"
+ },
+ "homepage" : "http://pdl.perl.org/"
+ },
+ "version" : "2.007"
+}
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..86e5adf
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,42 @@
+---
+abstract: 'Perl Data Language'
+author:
+ - 'PerlDL Developers (perldl at jach.hawaii.edu)'
+build_requires:
+ ExtUtils::MakeMaker: 0
+configure_requires:
+ Devel::CheckLib: 1.01
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.132140'
+license: unknown
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: PDL
+no_index:
+ directory:
+ - t
+ - inc
+ - Lib/FFTW
+requires:
+ Astro::FITS::Header: 0
+ Convert::UU: 0
+ Data::Dumper: 2.121
+ ExtUtils::MakeMaker: 6.56
+ File::Map: 0.57
+ File::Spec: 0.6
+ File::Temp: 0
+ Filter::Simple: 0.88
+ Filter::Util::Call: 0
+ Inline: 0.43
+ Module::Compile: 0.23
+ OpenGL: 0.6702
+ Pod::Parser: 0
+ Pod::Select: 0
+ Storable: 1.03
+ Test::Warn: 0
+ Text::Balanced: 1.89
+resources:
+ bugtracker: http://sourceforge.net/p/pdl/bugs/
+ homepage: http://pdl.perl.org/
+version: 2.007
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..3f19e8b
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,816 @@
+use lib qw(inc);
+use Devel::CheckLib;
+
+# Prompt the user here for any paths and other configuration
+
+check_lib_or_exit(
+ # fill in what you prompted the user for here
+ lib => [qw()]
+);
+
+
+# Build the whole PDL distribtuion
+
+use 5.008_000; # explicitly require 5.8.x or above
+
+use ExtUtils::MakeMaker 6.56; # for CONFIGURE_REQUIRES support
+
+$::PP_VERBOSE = 0; # =1 makes PP waffle a lot
+
+use Config;
+use IO::File;
+use Cwd;
+
+sub checkbuggysetup {
+ # detect buggy Perl setups
+ if (!$forcebuild &&
+ $Config{osname} eq 'solaris' &&
+ ($Config{cc} =~ /gcc/ || $Config{gccversion} ne '') &&
+ $Config{usemymalloc} eq 'y'
+ ) {
+ die <<'EOM';
+
+FATAL BUG IN YOUR PERL SETUP DETECTED. BUILD TERMINATED.
+
+On this platform the combination of gcc and the Perl malloc
+are buggy. The optimizations lead to random coredumps
+and make PDL essentially unusable.
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+WORKAROUND: YOU MUST RECOMPILE PERL WITH 'usemymalloc=n' !!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+You may override and force the build by including the
+'FORCE' switch:
+
+ perl Makefile.PL FORCE
+
+However, you will most likely end up with an unusable
+PDL build unless *all* optimizations are disabled!
+YOU HAVE BEEN WARNED!!
+
+EOM
+ }
+
+ # check for red hat 5.8.0 problem described at
+ # http://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=87682
+ if ($^V eq v5.8.0 &&
+ $Config{config_args} =~ m/-Dcf_by=Red Hat/) {
+ $redhat580problem = 1;
+ }
+
+ my($dot);
+ for(@INC) {$dot += $_ eq '.'}
+ $dot-- if(@INC[-1] eq '.');
+ if($dot) {
+ $INC = join(":", at INC);
+ warn << "EOM"
+
+**********************************************************************
+Your Perl \@INC path is:
+
+$INC
+
+That seems to include the directory '.' before the last entry in the
+path. Configurations like that might be broken, because they may
+prevent strict division of hierarchy in the module name space.
+In particular, adding a module Foo::Bar::Baz can cause trouble
+if Baz exists in the top level elsewhere, and if you run from the
+Foo/Bar directory.
+
+This happens with the PDL::Config and some other modules. You may
+not be able to build PDL with this \@INC setup.
+
+If you strike trouble, you may need to fix your \@INC.
+**********************************************************************
+
+
+EOM
+unless $ENV{PDL_INC_OK};
+}
+
+}
+
+# The user specifies configuration options using the PDL_CONFIG
+# array in perldl.conf - or ~/.perldl.conf or via the PDLCONF command-line
+# argument.
+#
+# We need to use this information during the 'perl Makefile.PL' process,
+# and historically this has been done by directly accessing %PDL_CONFIG
+# (or %::PDL_CONFIG) variable. However, there are times that this information
+# is also needed during the actual build (ie 'make' cycle), at which point
+# the variable is not available. However Basic/Core/Config.pm is available,
+# but this uses the %PDL::Config variable to access the data.
+#
+# So, we try to avoid this dichotomy by creating a %PDL::Config during
+# the 'perl Makefile.PL' stage and then making sure that PDL_CONFIG
+# is destroyed (so it can't be used by accident).
+#
+# Do we need to worry about Makefile.PL's hacking PDL_CONFIG?
+# Probably...
+#
+%PDL::Config = ();
+
+sub getpdl_config {
+ my ($pdl_conf_file) = @_;
+
+ # First read in distribution config file
+ #
+ require './perldl.conf';
+
+ # Add BAD_VAL tests if CPAN testers
+ #
+ if ($ENV{AUTOMATED_TESTING} == 1) {
+ # warn "Makefile.PL: Automated testing environment: enabling USE_POGL config option\n";
+ # $PDL_CONFIG{USE_POGL} = 1;
+ }
+
+ # Save standard values
+ #
+ %PDL_CONFIG_DIST = %PDL_CONFIG;
+
+ # Now read in the users config file if specified
+ # and convert y/n to 1/0
+ #
+ if (-f $pdl_conf_file) {
+ warn "\nINFORMATION: using file $pdl_conf_file to set configuration defaults\n\n";
+ require $pdl_conf_file;
+ }
+
+ # Sanity checking of user supplied keys (look for ones not defined in dist)
+
+ for(keys %PDL_CONFIG) {
+ if(!exists($PDL_CONFIG_DIST{$_})) {
+ die << "EOD";
+Invalid key $_ found in user supplied $pdl_conf_file
+ - this key appears to be no longer in use.
+ Please review configuration options and check the comments in
+ the file perldl.conf that came with this distribution
+EOD
+ }
+ }
+
+ # Merge in default options where not supplied in users file
+ #
+ for(keys %PDL_CONFIG_DIST) {
+ $PDL_CONFIG{$_} = $PDL_CONFIG_DIST{$_} unless exists $PDL_CONFIG{$_};
+ }
+
+ # Set up the default TEMPDIR if it has not been set by the user
+ #
+ # set up the default directory we use for temporary files throughout
+ # PDL. These are mainly for files created during the build of PDL itself,
+ # but it can also invovle files created whilst building an external
+ # module that uses PDL (e.g. the trylink() function of PDL::Dev needs
+ # a temporary file) or when a module is actually being used (e.g.
+ # PDL::IO::Dumper may need a temporary file).
+ #
+ # We have no policy about what directory to use - the following is
+ # an amalgam of the different choices that have been used within PDL
+ # up to (and including) v2.4.1
+ #
+
+ require File::Spec;
+
+ $PDL_CONFIG{PDL_BUILD_DIR} = File::Spec->rel2abs(File::Spec->curdir());
+
+ $PDL_CONFIG{TEMPDIR} = $^O =~ /MSWin32/i ? 'File::Spec->tmpdir()' : File::Spec->tmpdir()
+ unless exists $PDL_CONFIG{TEMPDIR} and defined $PDL_CONFIG{TEMPDIR};
+
+ # set up the default MALLOCDBG information (if not specified by the user)
+ #
+ if ( exists $PDL_CONFIG{MALLOCDBG} and defined $PDL_CONFIG{MALLOCDBG} ) {
+ my $val = $PDL_CONFIG{MALLOCDBG};
+ my $rval = ref($val);
+ die "ERROR: MALLOCDBG must be set to an associative array, not to a " .
+ ( $rval ? $rval : "SCALAR" ) unless $rval eq "HASH";
+ } else {
+ $PDL_CONFIG{MALLOCDBG} = ();
+ }
+ foreach my $item ( qw( libs include ) ) {
+ $PDL_Config{MALLOCDBG}->{$item} = ""
+ unless exists $PDLConfig{MALLOCDBG}->{$item};
+ }
+
+ # filter out incompatible options for the 'bad' code.
+ # At present we can not have the experimental per-piddle
+ # code turned on (the BADVAL_PER_PDL option) and use
+ # NaN's for floating-point bad values (the BADVAL_USENAN
+ # option).
+ #
+ my $flag_bad = $PDL_CONFIG{WITH_BADVAL} || 0;
+ my $flag_per_pdl = $PDL_CONFIG{BADVAL_PER_PDL} || 0;
+ my $flag_use_nan = $PDL_CONFIG{BADVAL_USENAN} || 0;
+ if ( $flag_bad and $flag_per_pdl and $flag_use_nan ) {
+ print "WARNING: Setting BADVAL_USENAN=0 as BADVAL_PER_PDL option is set!\n\n";
+ $PDL_CONFIG{BADVAL_USENAN} = 0;
+ }
+
+ # create a PDL::Config variable matching the PDL_CONFIG structure
+ # and convert yes/no answers to 1/0
+ #
+ for my $key ( keys %PDL_CONFIG ) {
+ my $val = $PDL_CONFIG{$key};
+ $val =~ s/^y.*/1/i;
+ $val =~ s/^n.*/0/i;
+ $PDL::Config{$key} = $val;
+ }
+
+ # destroy PDL_CONFIG/PDL_CONFIG_DIST so that we can catch any accesses
+ # to them in other Makefile.PL's
+ #
+ %PDL_CONFIG = undef;
+ %PDL_CONFIG_DIST = undef;
+}
+
+sub check_f77conf {
+ my ($seen_f77conf) = @_;
+ return 0 unless $seen_f77conf;
+
+ eval 'require File::Spec';
+ unless ($@ eq "") {
+ print STDERR "can't load File::Spec, skipping f77conf\n";
+ # skip if we don't have File::Spec
+ return 0;
+ }
+ $pdl_f77conf = File::Spec->rel2abs($pdl_f77conf)
+ unless File::Spec->file_name_is_absolute($pdl_f77conf);
+ $PDL::Config{F77CONF} = $pdl_f77conf;
+ return 1;
+}
+
+sub make_Version_pm {
+ # Get Version from Basic/PDL.pm and generated Basic/Core/Version.pm from it
+ require 'Basic/PDL.pm';
+
+ my $versionFile = 'Basic/Core/Version.pm';
+ my $fh = IO::File->new( ">$versionFile" ) or
+ die("Can't Open '$versionFile' for Writing!\n");
+ print $fh <<"EOVF";
+
+package PDL::Version;
+
+# This File was autogenerated by MakeFile.PL from the version
+# number in PDL.pm. It is used by PDL::Lite and others as
+# a single, consistent place to get the current PDL version.
+
+
+our \$VERSION='$PDL::VERSION';
+\$VERSION = eval \$VERSION;
+
+1;
+
+EOVF
+ $fh->close();
+}
+
+sub make_badval_dependencies {
+ # Are we using bad values or not? Are we using NaN or not?
+ # NOTE:
+ # only create if there's been a change (or the file doesn't exist)
+ # since *.pd uses this as a dependency
+ #
+ my $badFile = "Basic/Core/badsupport.p";
+ my $create_badFile = 1;
+
+ # The file '$badFile' sets up bvalflag, usenan, and bvalPerPdl
+ # variables, which is why we can use them once the file has been
+ # loaded via require.
+ #
+ if ( -e $badFile ) {
+ require $badFile;
+ $create_badFile = 0
+ if $bvalflag == $PDL::Config{WITH_BADVAL} and
+ $usenan == $PDL::Config{BADVAL_USENAN} and
+ $bvalPerPdl == $PDL::Config{BADVAL_PER_PDL};
+ }
+
+ if ( $create_badFile ) {
+ my $fh = IO::File->new( ">$badFile" )
+ or die "Can't open '$badFile' for writing.!\n";
+ print $fh "# Autogenerated by top-level Makefile.PL ".(localtime)."\n";
+ print $fh "\$bvalflag = $PDL::Config{WITH_BADVAL};\n";
+ print $fh "\$usenan = $PDL::Config{BADVAL_USENAN};\n";
+ print $fh "\$bvalPerPdl = $PDL::Config{BADVAL_PER_PDL};\n";
+ print $fh "1; # return true\n";
+ $fh->close;
+ }
+}
+
+sub make_Types_pm {
+ # make sure we have Types.pm ready for prime time
+ die "Types.pm.PL not found in Basic/Core"
+ unless -f 'Basic/Core/Types.pm.PL';
+ my $usebvals = $PDL::Config{WITH_BADVAL} ? "BADVALS=1" : "";
+ system( $Config{perlpath}, 'Basic/Core/Types.pm.PL', $usebvals);
+ unless ( -f 'Basic/Core/Types.pm' ) {
+ warn "system( $Config{perlpath}, 'Basic/Core/Types.pm.PL', $usebvals) was run...\n";
+ die "error creating Basic/Core/Types.pm";
+ }
+}
+
+# very simple formatter, assumes structures are *not* nested
+# used by make_PDL_Config_pm
+sub myformat {
+ my $entry = shift;
+ if (ref $entry eq 'ARRAY') {
+ my $list = join ',', (map {('"'.quotemeta($_).'"')} @$entry);
+ return "[$list]";
+ } elsif (ref $entry eq 'HASH') {
+ my $list = join ",\n", (map {('"'.quotemeta($_).'" => "'.
+ quotemeta($entry->{$_}).'"')} keys %$entry);
+ $list = "\n$list\n\t\t" unless $list =~ /^\s*$/;
+ return "{$list}";
+ } else {
+ return join '', '"',quotemeta($PDL::Config{$_}),'"';
+ }
+}
+
+sub make_PDL_Config_pm {
+ print STDERR "Writing Basic/Core/Config.pm\n";
+
+ $PDL::Config{PDL_BUILD_VERSION} = "$PDL::VERSION";
+
+ my $fh = IO::File->new( ">Basic/Core/Config.pm" )
+ or die "Couldn't open Config.pm for writing";
+ print $fh "
+# AUTOMATICALLY GENERATED BY THE PDL TOPLEVEL Makefile.PL.
+# DO NOT HAND-EDIT - CHANGES WILL BE LOST UPON YOUR NEXT
+# 'perl Makefile.PL'!!!
+package PDL;
+use File::Spec;
+\%PDL::Config = (\n";
+ for(keys %PDL::Config) {
+ $fh->print( "\t$_\t=>\t" );
+ if(defined $PDL::Config{$_}) {
+ if($PDL::Config{$_} eq 'File::Spec->tmpdir()') {$fh->print( $PDL::Config{$_} )}
+ else {$fh->print( myformat($PDL::Config{$_}) )}
+ } else {
+ $fh->print( "undef" );
+ }
+ $fh->print(",\n");
+ }
+ $fh->print( ");\n1;" );
+ $fh->close();
+}
+
+##############################
+##############################
+#
+# START:
+# the actual script begins here
+#
+##############################
+##############################
+
+BEGIN{
+ # Version test.
+ # (See also warning note in the END block)
+
+ eval "use 5.6.2";
+ die "\nPDL requires Perl v5.6.2 or later\n\n" if $@ ne "";
+
+ # Check for white space in build directory
+ my $pdl_build_dir = getcwd;
+ if ( $pdl_build_dir =~ /\s+/ ) {
+ warn( "\n+------- WARNING ------------------------------------------------\n"
+ . "| Space detected in path '$pdl_build_dir'\n"
+ . "| PDL may not build correctly! \n"
+ . "+----------------------------------------------------------------\n"
+ );
+
+ my $go_on = prompt("\n Do you wish to continue?", 'y');
+ die "OK, stopping build\n" unless $go_on =~ /^[yY]/;
+ }
+
+ # Check for pre-existing PDL module in @INC
+ eval { require PDL::Lite; PDL::Lite->import(); };
+ unless($@)
+ {
+ # uh-oh! we have a pre-existing PDL in path
+ warn( "\n+------- WARNING ------------------------------------------------\n"
+ . "| PDL version $PDL::Version::VERSION was detected in your \@INC\n"
+ . "| PDL may not build/test correctly with another PDL in \@INC! \n"
+ . "+----------------------------------------------------------------\n\n"
+ );
+ }
+
+ # test for critical modules
+ @hasnt = ();
+ my @test = ( ['Filter::Util::Call','Filter'],
+ ['Filter::Simple','Filter::Simple'],
+ ## ['Module::Compile','Module::Compile'], # don't do this, fails (why?)
+ ['Text::Balanced','Text::Balanced'], );
+ ## $DB::single = 1; # uncomment to have debugger stop here
+ for my $mod (@test) {
+ eval "use $mod->[0]";
+ push @hasnt, $mod->[1] if $@;
+ }
+} # end BEGIN
+
+$seen_pdlconf = 0;
+
+# Scan ARGV for config file argument
+ at ARGV = map {
+ if(/^PDLCONF=(.*)$/) {
+ $seen_pdlconf=1;
+ $pdl_conf_file = $1; ();
+ } elsif (/^F77CONF=(.*)$/) {
+ $seen_f77conf=1;
+ $pdl_f77conf=$1; ();
+ } elsif (/^FORCE$/i) {
+ $forcebuild=1;
+ ();
+ } else {
+ $_
+ }
+} @ARGV;
+
+warn "WARNING: forcing build...\n" if $forcebuild;
+
+checkbuggysetup(); # check for buggy Perl setups
+
+unless ( $seen_pdlconf ) {
+ my $defname = "$ENV{HOME}/.perldl.conf";
+ $pdl_conf_file = $defname if -f $defname;
+}
+
+# needs to be called before any of the make_XX routines
+getpdl_config($pdl_conf_file);
+$seen_f77conf = check_f77conf($seen_f77conf);
+
+# Check environment for SKIP_KNOWN_PROBLEMS
+if (!defined($PDL::Config{SKIP_KNOWN_PROBLEMS}) and defined($ENV{SKIP_KNOWN_PROBLEMS})) {
+ $PDL::Config{SKIP_KNOWN_PROBLEMS} = $ENV{SKIP_KNOWN_PROBLEMS};
+ warn "Makefile.PL: setting SKIP_KNOWN_PROBLEMS Config from environment value: $ENV{SKIP_KNOWN_PROBLEMS}";
+}
+# Add check for POGL if USE_POGL is enabled
+if (!defined($PDL::Config{USE_POGL}) or +$PDL::Config{USE_POGL}) {
+ eval "use OpenGL $PDL::Config{POGL_VERSION} qw();";
+ if ($@) {
+ if (defined($PDL::Config{USE_POGL})) {
+ warn "Makefile.PL: DEPENDENCY ERROR: USE_POGL requires at least OpenGL version $PDL::Config{POGL_VERSION}!\n";
+ exit 0;
+ } else {
+ warn "Makefile.PL: OpenGL-$PDL::Config{POGL_VERSION} not found, setting \$PDL::Config{USE_POGL} => 0\n";
+ $PDL::Config{USE_POGL} = 0;
+ }
+ } else {
+ # Have OpenGL so set USE_POGL option if needed
+ warn "Makefile.PL: Found required OpenGL version, setting USE_POGL => 1\n" unless defined($PDL::Config{USE_POGL});
+ $PDL::Config{USE_POGL} ||= 1;
+ }
+} else {
+ warn "Makefile.PL: Have \$PDL::Config{USE_POGL} => 0 so skipping TriD build with POGL\n";
+}
+
+make_Version_pm();
+
+make_badval_dependencies();
+
+make_Types_pm();
+
+# use ExtUtils::MakeMaker;
+
+# only perform one test if required modules are missing
+# the test will print an informational message and fail
+my %notestsifmodulesmissing = @hasnt ? # are any required modules missing ?
+ (test => {TESTS => 't/requiredmods.t'}) : ();
+
+my @podpms = map { $_.".pod", '$(INST_LIBDIR)/PDL/' . $_ .".pod"}
+ qw/Bugs perldl pdldoc/;
+
+ at prereq = (
+ 'Astro::FITS::Header' => 0,
+ 'Convert::UU' => 0, # for PDL::IO::Dumper
+ 'Data::Dumper' => 2.121, # for PDL::IO::Dumper
+ 'ExtUtils::MakeMaker' => 6.56, # for CONFIGURE_REQUIRES support
+ 'File::Map' => 0.57, # test new mmap implementation
+ 'File::Spec' => 0.6,
+ 'File::Temp' => 0,
+ 'Filter::Util::Call' => 0, # for PDL::NiceSlice
+ 'Filter::Simple' => 0.88, # for new PDL::NiceSlice
+ 'Inline' => 0.43,
+ 'Module::Compile' => 0.23, # for new PDL::NiceSlice
+ 'Pod::Parser' => 0, # version TBD for PDL::Doc
+ 'Pod::Select' => 0, # version TBD for PDL::Doc
+ 'Storable' => 1.03, # for PDL::IO::Storable
+ 'Text::Balanced' => 1.89, # for PDL::NiceSlice
+ 'Test::Warn' => 0, # for t/pptest.t
+ );
+
+# add OpenGL version dependency for CPAN to follow
+push @prereq, ('OpenGL' => $PDL::Config{POGL_VERSION}) if $PDL::Config{USE_POGL};
+
+# push @prereq, ('ExtUtils::F77' => 1.10) unless $seen_f77conf;
+
+my @exe_files = ('perldl', 'pdldoc');
+my $cleanup = 'pdl perldl pdldoc pdldoc.db pdldoc.pod perldl.pod ';
+
+if($^O !~ /mswin32/i) {
+ $cleanup = 'pdl.c ' . $cleanup;
+}
+
+
+##############################
+# Hack to include fPIC on x86_64 systems -
+# use similar mods to affect CCFLAGS on other systems as needed...
+#
+
+my $ccflags = $Config{ccflags};
+if($Config{archname}=~m/x86_64/) {
+ $ccflags .= " -fPIC";
+}
+
+%makefile_hash = (
+ 'PREREQ_PM' => { @prereq },
+ 'CONFIGURE_REQUIRES' => { 'Devel::CheckLib' => 1.01, },
+ 'NAME' => 'PDL',
+ 'VERSION_FROM' => 'Basic/Core/Version.pm',
+ 'EXE_FILES' => \@exe_files,
+ 'PM' => { @podpms }, #so that the script docs are picked up
+ 'META_MERGE' => {
+ no_index => { directory => [ 'Lib/FFTW' ], },
+ resources => {
+ homepage => 'http://pdl.perl.org/',
+ bugtracker => 'http://sourceforge.net/p/pdl/bugs/',
+ repository => {
+ url => 'git://git.code.sf.net/p/pdl/code',
+ type => 'git',
+ web => 'http://sourceforge.net/p/pdl/code/ci/master/tree/',
+ },
+ },
+ },
+ 'MAN1PODS' => { 'Bugs.pod' => '$(INST_MAN1DIR)/PDL::Bugs.$(MAN1EXT)',
+ 'perldl' => '$(INST_MAN1DIR)/perldl.$(MAN1EXT)',
+ 'pdldoc' => '$(INST_MAN1DIR)/pdldoc.$(MAN1EXT)' },
+ 'MAN3PODS' => {}, # don't pick up the script pods again
+ 'OPTIMIZE' => $PDL::Config{OPTIMIZE} || $Config{optimize},
+ 'CCFLAGS' => $ccflags,
+ 'linkext' => { LINKTYPE => '' }, # No linking required
+ # in this directory
+ 'dist' => { COMPRESS => 'gzip',
+ SUFFIX => 'gz',
+ PREOP => ($^O !~ /mswin32/i) ?
+ q[git log --stat --since='29 Apr 2009' > Changes] :
+ '@ :' },
+ 'clean' => {
+ 'FILES' => $cleanup .
+ 'tbyte.tif tmp0 tmp0.hdr tushort.tif ' .
+ 'MANIFEST.bak tmp1* tmpraw* t/tmpraw* t/tmp1* ' .
+ '_Inline/ .inlinepdlpp/ ' .
+ '*.xfig '
+ },
+ 'realclean' => {'FILES' => 'Basic/Core/Config.pm'},
+ ($] ge '5.005') ? (
+ 'AUTHOR' => 'PerlDL Developers (perldl at jach.hawaii.edu)',
+ 'ABSTRACT' => 'Perl Data Language',
+ 'BINARY_LOCATION' => 'PDL.tar.gz',
+ ) : (),
+
+ %notestsifmodulesmissing,
+ );
+
+=begin comment
+
+print "makefile hash is:\n";
+for $k(sort keys %makefile_hash) {
+ print "\t$k\t";
+ $v = $makefile_hash{$k};
+ unless(ref $v) {
+ print $v,"\n";
+ } elsif(ref $v eq 'HASH') {
+ print "HASH:\n";
+ for $vk(sort keys %$v) {
+ print "\t\t$vk\t$v->{$vk}\n";
+ }
+ } elsif(ref $v eq 'ARRAY') {
+ print "ARRAY:\n";
+ for $vv(@$v) {
+ print "\t\t$vv\n";
+ }
+ } else {print "$v\n";}
+
+}
+
+=end comment
+
+=cut
+
+
+WriteMakefile(%makefile_hash);
+
+
+# do *after* WriteMakefile since some options
+# are set by the recursively called Makefile.PLs
+make_PDL_Config_pm(); # write out config to PDL::Config
+
+# Extra build target to build the doc database
+sub MY::postamble {
+ my $text =
+'
+doctest ::
+ @echo "doctest: Building PDL documentation database in blib ..."
+ @$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) \
+ Doc/scantree.pl
+%HTML% @echo "doctest: Building PDL documentation web pages in blib ..."
+%HTML% @$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) \
+%HTML% Doc/mkhtmldoc.pl
+
+doc_site_install ::
+ @echo "doc_site_install: Building PDL documentation database ..."
+ @$(PERL) -Mblib Doc/scantree.pl $(INSTALLSITEARCH)
+%HTML% @echo "doc_site_install: Building PDL documentation web pages ..."
+%HTML% @$(PERL) Doc/mkhtmldoc.pl $(INSTALLSITEARCH)/PDL
+
+doc_perl_install ::
+ @echo "doc_perl_install: Building PDL documentation database ..."
+ @$(PERL) -Mblib Doc/scantree.pl $(INSTALLARCHLIB)
+%HTML% @echo "doc_perl_install: Building PDL documentation web pages ..."
+%HTML% @$(PERL) Doc/mkhtmldoc.pl $(INSTALLARCHLIB)/PDL
+';
+
+
+ if(defined $PDL::Config{HTML_DOCS} && !$PDL::Config{HTML_DOCS}){
+ $text=~ s/\%HTML\%[^\n]*\n//og; # Remove %HTML% lines
+ } else {
+ $text=~ s/\%HTML\%//og; # Remove just %HTML% markers
+ }
+
+
+$text .= << "EOPS" ;
+
+Changes : GITCHANGES
+
+changes : GITCHANGES
+
+GITCHANGES :
+\tgit log --stat --since='29 Apr 2009' > Changes
+
+perldl.pod : perldl subdirs
+\t\$(PERLRUN) -MPod::Select -e "podselect('perldl');" > perldl.pod
+
+pdldoc.pod : pdldoc subdirs
+\t\$(PERLRUN) -MPod::Select -e "podselect('pdldoc');" > pdldoc.pod
+
+EOPS
+
+$text .= << 'EOT' if $^O =~ /cygwin/;
+
+pdl.exe: pdl
+
+EOT
+
+$text .= << 'EOT' if $^O =~ /MSWin/;
+
+DISTWIN32NAME=$(DISTVNAME)-win32
+
+ppm: doctest ppd
+ $(MV) blib/lib/PDL/HtmlDocs/PDL blib/html/lib/PDL
+ $(COMPRESS) -dc win32/pbmwin32.tar.gz | $(TAR) xf -
+ $(MKPATH) $(DISTWIN32NAME)
+ $(CP) win32/Readme $(DISTWIN32NAME)
+ $(CP) win32/install.ppm .
+ $(PERL) -pe "s|</IMPLEMENTATION>|<INSTALL EXEC=\"perl\">install.ppm</INSTALL></IMPLEMENTATION>|" PDL.ppd > PDL.ppd.new
+ $(RM) PDL.ppd
+ $(MV) PDL.ppd.new PDL.ppd
+ $(CP) PDL.ppd $(DISTWIN32NAME)
+ $(TAR) cf $(DISTWIN32NAME)/PDL.tar blib install.ppm
+ cd $(DISTWIN32NAME)
+ $(COMPRESS) PDL.tar
+ $(ZIP) $(DISTWIN32NAME).zip *
+ $(MV) $(DISTWIN32NAME).zip ..
+ cd ..
+ $(RM_RF) $(DISTWIN32NAME)
+EOT
+
+return $text
+
+}
+
+##############################
+# processPL: generate Makefile lines for top-level components that are created by just perling a .PL file.
+
+#EU::MM's processPL() is continually broken on Win32 ... hence:
+
+sub MY::processPL {
+ ### This fix seems necessary with current versions of MM - otherwise it creates circular
+ ### dependencies to "pm_to_blib" for .PL files (!) -- CED 9-July-2008
+ if(1) { ## || $^O =~ /MSWin32/i && ($Config{make} =~ /\bdmake/i || $Config{make} =~ /\bnmake/i)) {
+ my($self) = shift;
+ return "" unless $self->{PL_FILES};
+ my(@m, $plfile);
+ foreach $plfile (sort keys %{$self->{PL_FILES}}) {
+ my $list = ref($self->{PL_FILES}->{$plfile})
+ ? $self->{PL_FILES}->{$plfile}
+ : [$self->{PL_FILES}->{$plfile}];
+ my $target;
+
+
+ if($Config{make} =~ /\bdmake/i) {
+ foreach $target (@$list) {
+ push @m, "
+all :: $target
+ \$(NOECHO) \$(NOOP)
+
+$target :
+ \$(PERLRUNINST) $plfile $target
+";
+ } # close foreach
+ }
+ else {
+ foreach $target (@$list) {
+
+ # Single out pdl.PL for special treatment since it needs compilation
+ # after post-processing. This used to happen automagically; it's not clear
+ # why it still doesn't. (CED 2012-11-12)
+ my $compilestr;
+ if($plfile eq "pdl.PL" && $Config{make} !~ /\bnmake/i) {
+ $compilestr = "\n\t\$(CC) -o pdl pdl.c\n";
+ } else {
+ $compilestr = "";
+ }
+
+ push @m, "
+all :: $target
+ \$(NOECHO) \$(NOOP)
+
+$target ::
+ \$(PERLRUNINST) $plfile $target$compilestr
+";
+
+ } # close foreach
+ }
+ }
+ return join "", @m;
+ }
+ else {
+ package MY;
+ my $self = shift;
+ return $self->SUPER::processPL;
+ }
+}
+
+
+# warn if vital modules are missing
+END {
+ if (@hasnt) {
+ print << 'EOP';
+
+********************************************************
+* IMPORTANT: Your installation will not work since it *
+* lacks critical modules. *
+* ALL TESTS WILL FAIL UNLESS YOU IMMEDIATELY *
+* INSTALL THE FOLLOWING MODULES [available from CPAN]: *
+*
+EOP
+
+ for (@hasnt) { print "*\t$_\n" }
+
+
+ print << 'EOP';
+* *
+* Please install the missing module(s) and start the *
+* PDL build process again (perl Makefile.PL; ....) *
+* *
+********************************************************
+
+EOP
+
+ }
+
+ if ($redhat580problem) {
+ print << "EOP";
+
+************************************************************
+* IMPORTANT: You seem to be on a redhat system with *
+* a Perl 5.8.0 installation. Your Perl installation may be *
+* broken and generate broken makefiles *
+* see *
+* *
+* http://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=87682
+* *
+* for details and workarounds. *
+* In particular check the setting of the LANG environment *
+* variable: *
+* current setting LANG=$ENV{LANG} *
+************************************************************
+
+EOP
+ }
+
+ eval "use 5.8.0";
+ if($@ ne "") {
+ $vstring = sprintf("%vd",$^V);
+ print <<"DEPRECATED-EOM"
+******************************
+*
+* You are using a deprecated version of perl (v$vstring); as of PDL 2.4.7,
+* perl version 5.8 or greater is required. Most stuff will probably
+* still work, but perl versions earlier than 5.8 are deprecated and
+* no longer supported or tested against.
+*
+******************************
+DEPRECATED-EOM
+ } # end of deprecation case
+} # end of END block
diff --git a/PDLdb.pl b/PDLdb.pl
new file mode 100644
index 0000000..71d9aea
--- /dev/null
+++ b/PDLdb.pl
@@ -0,0 +1,9550 @@
+
+=head1 NAME
+
+PDLdb.pl - the perl debugger with PDL support
+
+=head1 SYNOPSIS
+
+ export PERL5DB='BEGIN { require "PDLdb.pl" }' # e.g., with sh/bash
+
+ perl -d your_Perl_script
+
+=head1 DESCRIPTION
+
+C<PDLdb.pl> is an enhanced version of the perl debugger which supports
+PDL::NiceSlice constructs. Set the PERL5DB environment variable as
+shown above and it will be loaded automatically by Perl when you invoke
+a script with C<perl -d>. This documentation tries to outline the
+structure and services provided by C<PDLdb.pl>, i.e., C<perl5db.pl>,
+and to describe how you can use them.
+
+=head1 GENERAL NOTES
+
+The debugger can look pretty forbidding to many Perl programmers. There are
+a number of reasons for this, many stemming out of the debugger's history.
+
+When the debugger was first written, Perl didn't have a lot of its nicer
+features - no references, no lexical variables, no closures, no object-oriented
+programming. So a lot of the things one would normally have done using such
+features was done using global variables, globs and the C<local()> operator
+in creative ways.
+
+Some of these have survived into the current debugger; a few of the more
+interesting and still-useful idioms are noted in this section, along with notes
+on the comments themselves.
+
+=head2 Why not use more lexicals?
+
+Experienced Perl programmers will note that the debugger code tends to use
+mostly package globals rather than lexically-scoped variables. This is done
+to allow a significant amount of control of the debugger from outside the
+debugger itself.
+
+Unfortunately, though the variables are accessible, they're not well
+documented, so it's generally been a decision that hasn't made a lot of
+difference to most users. Where appropriate, comments have been added to
+make variables more accessible and usable, with the understanding that these
+I<are> debugger internals, and are therefore subject to change. Future
+development should probably attempt to replace the globals with a well-defined
+API, but for now, the variables are what we've got.
+
+=head2 Automated variable stacking via C<local()>
+
+As you may recall from reading C<perlfunc>, the C<local()> operator makes a
+temporary copy of a variable in the current scope. When the scope ends, the
+old copy is restored. This is often used in the debugger to handle the
+automatic stacking of variables during recursive calls:
+
+ sub foo {
+ local $some_global++;
+
+ # Do some stuff, then ...
+ return;
+ }
+
+What happens is that on entry to the subroutine, C<$some_global> is localized,
+then altered. When the subroutine returns, Perl automatically undoes the
+localization, restoring the previous value. Voila, automatic stack management.
+
+The debugger uses this trick a I<lot>. Of particular note is C<DB::eval>,
+which lets the debugger get control inside of C<eval>'ed code. The debugger
+localizes a saved copy of C<$@> inside the subroutine, which allows it to
+keep C<$@> safe until it C<DB::eval> returns, at which point the previous
+value of C<$@> is restored. This makes it simple (well, I<simpler>) to keep
+track of C<$@> inside C<eval>s which C<eval> other C<eval's>.
+
+In any case, watch for this pattern. It occurs fairly often.
+
+=head2 The C<^> trick
+
+This is used to cleverly reverse the sense of a logical test depending on
+the value of an auxiliary variable. For instance, the debugger's C<S>
+(search for subroutines by pattern) allows you to negate the pattern
+like this:
+
+ # Find all non-'foo' subs:
+ S !/foo/
+
+Boolean algebra states that the truth table for XOR looks like this:
+
+=over 4
+
+=item * 0 ^ 0 = 0
+
+(! not present and no match) --> false, don't print
+
+=item * 0 ^ 1 = 1
+
+(! not present and matches) --> true, print
+
+=item * 1 ^ 0 = 1
+
+(! present and no match) --> true, print
+
+=item * 1 ^ 1 = 0
+
+(! present and matches) --> false, don't print
+
+=back
+
+As you can see, the first pair applies when C<!> isn't supplied, and
+the second pair applies when it is. The XOR simply allows us to
+compact a more complicated if-then-elseif-else into a more elegant
+(but perhaps overly clever) single test. After all, it needed this
+explanation...
+
+=head2 FLAGS, FLAGS, FLAGS
+
+There is a certain C programming legacy in the debugger. Some variables,
+such as C<$single>, C<$trace>, and C<$frame>, have I<magical> values composed
+of 1, 2, 4, etc. (powers of 2) OR'ed together. This allows several pieces
+of state to be stored independently in a single scalar.
+
+A test like
+
+ if ($scalar & 4) ...
+
+is checking to see if the appropriate bit is on. Since each bit can be
+"addressed" independently in this way, C<$scalar> is acting sort of like
+an array of bits. Obviously, since the contents of C<$scalar> are just a
+bit-pattern, we can save and restore it easily (it will just look like
+a number).
+
+The problem, is of course, that this tends to leave magic numbers scattered
+all over your program whenever a bit is set, cleared, or checked. So why do
+it?
+
+=over 4
+
+=item *
+
+First, doing an arithmetical or bitwise operation on a scalar is
+just about the fastest thing you can do in Perl: C<use constant> actually
+creates a subroutine call, and array and hash lookups are much slower. Is
+this over-optimization at the expense of readability? Possibly, but the
+debugger accesses these variables a I<lot>. Any rewrite of the code will
+probably have to benchmark alternate implementations and see which is the
+best balance of readability and speed, and then document how it actually
+works.
+
+=item *
+
+Second, it's very easy to serialize a scalar number. This is done in
+the restart code; the debugger state variables are saved in C<%ENV> and then
+restored when the debugger is restarted. Having them be just numbers makes
+this trivial.
+
+=item *
+
+Third, some of these variables are being shared with the Perl core
+smack in the middle of the interpreter's execution loop. It's much faster for
+a C program (like the interpreter) to check a bit in a scalar than to access
+several different variables (or a Perl array).
+
+=back
+
+=head2 What are those C<XXX> comments for?
+
+Any comment containing C<XXX> means that the comment is either somewhat
+speculative - it's not exactly clear what a given variable or chunk of
+code is doing, or that it is incomplete - the basics may be clear, but the
+subtleties are not completely documented.
+
+Send in a patch if you can clear up, fill out, or clarify an C<XXX>.
+
+=head1 DATA STRUCTURES MAINTAINED BY CORE
+
+There are a number of special data structures provided to the debugger by
+the Perl interpreter.
+
+The array C<@{$main::{'_<'.$filename}}> (aliased locally to C<@dbline> via glob
+assignment) contains the text from C<$filename>, with each element
+corresponding to a single line of C<$filename>.
+
+The hash C<%{'_<'.$filename}> (aliased locally to C<%dbline> via glob
+assignment) contains breakpoints and actions. The keys are line numbers;
+you can set individual values, but not the whole hash. The Perl interpreter
+uses this hash to determine where breakpoints have been set. Any true value is
+considered to be a breakpoint; C<perl5db.pl> uses C<$break_condition\0$action>.
+Values are magical in numeric context: 1 if the line is breakable, 0 if not.
+
+The scalar C<${"_<$filename"}> simply contains the string C<_<$filename>.
+This is also the case for evaluated strings that contain subroutines, or
+which are currently being executed. The $filename for C<eval>ed strings looks
+like C<(eval 34)> or C<(re_eval 19)>.
+
+=head1 DEBUGGER STARTUP
+
+When C<perl5db.pl> starts, it reads an rcfile (C<perl5db.ini> for
+non-interactive sessions, C<.perldb> for interactive ones) that can set a number
+of options. In addition, this file may define a subroutine C<&afterinit>
+that will be executed (in the debugger's context) after the debugger has
+initialized itself.
+
+Next, it checks the C<PERLDB_OPTS> environment variable and treats its
+contents as the argument of a C<o> command in the debugger.
+
+=head2 STARTUP-ONLY OPTIONS
+
+The following options can only be specified at startup.
+To set them in your rcfile, add a call to
+C<&parse_options("optionName=new_value")>.
+
+=over 4
+
+=item * TTY
+
+the TTY to use for debugging i/o.
+
+=item * noTTY
+
+if set, goes in NonStop mode. On interrupt, if TTY is not set,
+uses the value of noTTY or F<$HOME/.perldbtty$$> to find TTY using
+Term::Rendezvous. Current variant is to have the name of TTY in this
+file.
+
+=item * ReadLine
+
+if false, a dummy ReadLine is used, so you can debug
+ReadLine applications.
+
+=item * NonStop
+
+if true, no i/o is performed until interrupt.
+
+=item * LineInfo
+
+file or pipe to print line number info to. If it is a
+pipe, a short "emacs like" message is used.
+
+=item * RemotePort
+
+host:port to connect to on remote host for remote debugging.
+
+=item * HistFile
+
+file to store session history to. There is no default and so no
+history file is written unless this variable is explicitly set.
+
+=item * HistSize
+
+number of commands to store to the file specified in C<HistFile>.
+Default is 100.
+
+=back
+
+=head3 SAMPLE RCFILE
+
+ &parse_options("NonStop=1 LineInfo=db.out");
+ sub afterinit { $trace = 1; }
+
+The script will run without human intervention, putting trace
+information into C<db.out>. (If you interrupt it, you had better
+reset C<LineInfo> to something I<interactive>!)
+
+=head1 INTERNALS DESCRIPTION
+
+=head2 DEBUGGER INTERFACE VARIABLES
+
+Perl supplies the values for C<%sub>. It effectively inserts
+a C<&DB::DB();> in front of each place that can have a
+breakpoint. At each subroutine call, it calls C<&DB::sub> with
+C<$DB::sub> set to the called subroutine. It also inserts a C<BEGIN
+{require 'perl5db.pl'}> before the first line.
+
+After each C<require>d file is compiled, but before it is executed, a
+call to C<&DB::postponed($main::{'_<'.$filename})> is done. C<$filename>
+is the expanded name of the C<require>d file (as found via C<%INC>).
+
+=head3 IMPORTANT INTERNAL VARIABLES
+
+=head4 C<$CreateTTY>
+
+Used to control when the debugger will attempt to acquire another TTY to be
+used for input.
+
+=over
+
+=item * 1 - on C<fork()>
+
+=item * 2 - debugger is started inside debugger
+
+=item * 4 - on startup
+
+=back
+
+=head4 C<$doret>
+
+The value -2 indicates that no return value should be printed.
+Any other positive value causes C<DB::sub> to print return values.
+
+=head4 C<$evalarg>
+
+The item to be eval'ed by C<DB::eval>. Used to prevent messing with the current
+contents of C<@_> when C<DB::eval> is called.
+
+=head4 C<$frame>
+
+Determines what messages (if any) will get printed when a subroutine (or eval)
+is entered or exited.
+
+=over 4
+
+=item * 0 - No enter/exit messages
+
+=item * 1 - Print I<entering> messages on subroutine entry
+
+=item * 2 - Adds exit messages on subroutine exit. If no other flag is on, acts like 1+2.
+
+=item * 4 - Extended messages: C<< <in|out> I<context>=I<fully-qualified sub name> from I<file>:I<line> >>. If no other flag is on, acts like 1+4.
+
+=item * 8 - Adds parameter information to messages, and overloaded stringify and tied FETCH is enabled on the printed arguments. Ignored if C<4> is not on.
+
+=item * 16 - Adds C<I<context> return from I<subname>: I<value>> messages on subroutine/eval exit. Ignored if C<4> is is not on.
+
+=back
+
+To get everything, use C<$frame=30> (or C<o f=30> as a debugger command).
+The debugger internally juggles the value of C<$frame> during execution to
+protect external modules that the debugger uses from getting traced.
+
+=head4 C<$level>
+
+Tracks current debugger nesting level. Used to figure out how many
+C<E<lt>E<gt>> pairs to surround the line number with when the debugger
+outputs a prompt. Also used to help determine if the program has finished
+during command parsing.
+
+=head4 C<$onetimeDump>
+
+Controls what (if anything) C<DB::eval()> will print after evaluating an
+expression.
+
+=over 4
+
+=item * C<undef> - don't print anything
+
+=item * C<dump> - use C<dumpvar.pl> to display the value returned
+
+=item * C<methods> - print the methods callable on the first item returned
+
+=back
+
+=head4 C<$onetimeDumpDepth>
+
+Controls how far down C<dumpvar.pl> will go before printing C<...> while
+dumping a structure. Numeric. If C<undef>, print all levels.
+
+=head4 C<$signal>
+
+Used to track whether or not an C<INT> signal has been detected. C<DB::DB()>,
+which is called before every statement, checks this and puts the user into
+command mode if it finds C<$signal> set to a true value.
+
+=head4 C<$single>
+
+Controls behavior during single-stepping. Stacked in C<@stack> on entry to
+each subroutine; popped again at the end of each subroutine.
+
+=over 4
+
+=item * 0 - run continuously.
+
+=item * 1 - single-step, go into subs. The C<s> command.
+
+=item * 2 - single-step, don't go into subs. The C<n> command.
+
+=item * 4 - print current sub depth (turned on to force this when C<too much
+recursion> occurs.
+
+=back
+
+=head4 C<$trace>
+
+Controls the output of trace information.
+
+=over 4
+
+=item * 1 - The C<t> command was entered to turn on tracing (every line executed is printed)
+
+=item * 2 - watch expressions are active
+
+=item * 4 - user defined a C<watchfunction()> in C<afterinit()>
+
+=back
+
+=head4 C<$slave_editor>
+
+1 if C<LINEINFO> was directed to a pipe; 0 otherwise.
+
+=head4 C<@cmdfhs>
+
+Stack of filehandles that C<DB::readline()> will read commands from.
+Manipulated by the debugger's C<source> command and C<DB::readline()> itself.
+
+=head4 C<@dbline>
+
+Local alias to the magical line array, C<@{$main::{'_<'.$filename}}> ,
+supplied by the Perl interpreter to the debugger. Contains the source.
+
+=head4 C<@old_watch>
+
+Previous values of watch expressions. First set when the expression is
+entered; reset whenever the watch expression changes.
+
+=head4 C<@saved>
+
+Saves important globals (C<$@>, C<$!>, C<$^E>, C<$,>, C<$/>, C<$\>, C<$^W>)
+so that the debugger can substitute safe values while it's running, and
+restore them when it returns control.
+
+=head4 C<@stack>
+
+Saves the current value of C<$single> on entry to a subroutine.
+Manipulated by the C<c> command to turn off tracing in all subs above the
+current one.
+
+=head4 C<@to_watch>
+
+The 'watch' expressions: to be evaluated before each line is executed.
+
+=head4 C<@typeahead>
+
+The typeahead buffer, used by C<DB::readline>.
+
+=head4 C<%alias>
+
+Command aliases. Stored as character strings to be substituted for a command
+entered.
+
+=head4 C<%break_on_load>
+
+Keys are file names, values are 1 (break when this file is loaded) or undef
+(don't break when it is loaded).
+
+=head4 C<%dbline>
+
+Keys are line numbers, values are C<condition\0action>. If used in numeric
+context, values are 0 if not breakable, 1 if breakable, no matter what is
+in the actual hash entry.
+
+=head4 C<%had_breakpoints>
+
+Keys are file names; values are bitfields:
+
+=over 4
+
+=item * 1 - file has a breakpoint in it.
+
+=item * 2 - file has an action in it.
+
+=back
+
+A zero or undefined value means this file has neither.
+
+=head4 C<%option>
+
+Stores the debugger options. These are character string values.
+
+=head4 C<%postponed>
+
+Saves breakpoints for code that hasn't been compiled yet.
+Keys are subroutine names, values are:
+
+=over 4
+
+=item * C<compile> - break when this sub is compiled
+
+=item * C<< break +0 if <condition> >> - break (conditionally) at the start of this routine. The condition will be '1' if no condition was specified.
+
+=back
+
+=head4 C<%postponed_file>
+
+This hash keeps track of breakpoints that need to be set for files that have
+not yet been compiled. Keys are filenames; values are references to hashes.
+Each of these hashes is keyed by line number, and its values are breakpoint
+definitions (C<condition\0action>).
+
+=head1 DEBUGGER INITIALIZATION
+
+The debugger's initialization actually jumps all over the place inside this
+package. This is because there are several BEGIN blocks (which of course
+execute immediately) spread through the code. Why is that?
+
+The debugger needs to be able to change some things and set some things up
+before the debugger code is compiled; most notably, the C<$deep> variable that
+C<DB::sub> uses to tell when a program has recursed deeply. In addition, the
+debugger has to turn off warnings while the debugger code is compiled, but then
+restore them to their original setting before the program being debugged begins
+executing.
+
+The first C<BEGIN> block simply turns off warnings by saving the current
+setting of C<$^W> and then setting it to zero. The second one initializes
+the debugger variables that are needed before the debugger begins executing.
+The third one puts C<$^X> back to its former value.
+
+We'll detail the second C<BEGIN> block later; just remember that if you need
+to initialize something before the debugger starts really executing, that's
+where it has to go.
+
+=cut
+
+package # this is the PDLdb
+ DB;
+
+BEGIN {eval 'use IO::Handle'}; # Needed for flush only? breaks under miniperl
+
+# Debugger for Perl 5.00x; perl5db.pl patch level:
+$VERSION = 0.01;
+
+$header = "PDLdb.pl version $VERSION";
+
+=head1 DEBUGGER ROUTINES
+
+=head2 C<DB::eval()>
+
+This function replaces straight C<eval()> inside the debugger; it simplifies
+the process of evaluating code in the user's context.
+
+The code to be evaluated is passed via the package global variable
+C<$DB::evalarg>; this is done to avoid fiddling with the contents of C<@_>.
+
+Before we do the C<eval()>, we preserve the current settings of C<$trace>,
+C<$single>, C<$^D> and C<$usercontext>. The latter contains the
+preserved values of C<$@>, C<$!>, C<$^E>, C<$,>, C<$/>, C<$\>, C<$^W> and the
+user's current package, grabbed when C<DB::DB> got control. This causes the
+proper context to be used when the eval is actually done. Afterward, we
+restore C<$trace>, C<$single>, and C<$^D>.
+
+Next we need to handle C<$@> without getting confused. We save C<$@> in a
+local lexical, localize C<$saved[0]> (which is where C<save()> will put
+C<$@>), and then call C<save()> to capture C<$@>, C<$!>, C<$^E>, C<$,>,
+C<$/>, C<$\>, and C<$^W>) and set C<$,>, C<$/>, C<$\>, and C<$^W> to values
+considered sane by the debugger. If there was an C<eval()> error, we print
+it on the debugger's output. If C<$onetimedump> is defined, we call
+C<dumpit> if it's set to 'dump', or C<methods> if it's set to
+'methods'. Setting it to something else causes the debugger to do the eval
+but not print the result - handy if you want to do something else with it
+(the "watch expressions" code does this to get the value of the watch
+expression but not show it unless it matters).
+
+In any case, we then return the list of output from C<eval> to the caller,
+and unwinding restores the former version of C<$@> in C<@saved> as well
+(the localization of C<$saved[0]> goes away at the end of this scope).
+
+=head3 Parameters and variables influencing execution of DB::eval()
+
+C<DB::eval> isn't parameterized in the standard way; this is to keep the
+debugger's calls to C<DB::eval()> from mucking with C<@_>, among other things.
+The variables listed below influence C<DB::eval()>'s execution directly.
+
+=over 4
+
+=item C<$evalarg> - the thing to actually be eval'ed
+
+=item C<$trace> - Current state of execution tracing
+
+=item C<$single> - Current state of single-stepping
+
+=item C<$onetimeDump> - what is to be displayed after the evaluation
+
+=item C<$onetimeDumpDepth> - how deep C<dumpit()> should go when dumping results
+
+=back
+
+The following variables are altered by C<DB::eval()> during its execution. They
+are "stacked" via C<local()>, enabling recursive calls to C<DB::eval()>.
+
+=over 4
+
+=item C<@res> - used to capture output from actual C<eval>.
+
+=item C<$otrace> - saved value of C<$trace>.
+
+=item C<$osingle> - saved value of C<$single>.
+
+=item C<$od> - saved value of C<$^D>.
+
+=item C<$saved[0]> - saved value of C<$@>.
+
+=item $\ - for output of C<$@> if there is an evaluation error.
+
+=back
+
+=head3 The problem of lexicals
+
+The context of C<DB::eval()> presents us with some problems. Obviously,
+we want to be 'sandboxed' away from the debugger's internals when we do
+the eval, but we need some way to control how punctuation variables and
+debugger globals are used.
+
+We can't use local, because the code inside C<DB::eval> can see localized
+variables; and we can't use C<my> either for the same reason. The code
+in this routine compromises and uses C<my>.
+
+After this routine is over, we don't have user code executing in the debugger's
+context, so we can use C<my> freely.
+
+=cut
+
+############################################## Begin lexical danger zone
+
+# 'my' variables used here could leak into (that is, be visible in)
+# the context that the code being evaluated is executing in. This means that
+# the code could modify the debugger's variables.
+#
+# Fiddling with the debugger's context could be Bad. We insulate things as
+# much as we can.
+
+sub eval {
+
+ # 'my' would make it visible from user code
+ # but so does local! --tchrist
+ # Remember: this localizes @DB::res, not @main::res.
+ local @res;
+ {
+
+ # Try to keep the user code from messing with us. Save these so that
+ # even if the eval'ed code changes them, we can put them back again.
+ # Needed because the user could refer directly to the debugger's
+ # package globals (and any 'my' variables in this containing scope)
+ # inside the eval(), and we want to try to stay safe.
+ local $otrace = $trace;
+ local $osingle = $single;
+ local $od = $^D;
+
+ # Untaint the incoming eval() argument.
+ { ($evalarg) = $evalarg =~ /(.*)/s; }
+
+ # $usercontext built in DB::DB near the comment
+ # "set up the context for DB::eval ..."
+ # Evaluate and save any results.
+ $evalarg = PDL::NiceSlice::perldlpp('PDL::NiceSlice',$evalarg);
+ @res = eval "$usercontext $evalarg;\n"; # '\n' for nice recursive debug
+
+ # Restore those old values.
+ $trace = $otrace;
+ $single = $osingle;
+ $^D = $od;
+ }
+
+ # Save the current value of $@, and preserve it in the debugger's copy
+ # of the saved precious globals.
+ my $at = $@;
+
+ # Since we're only saving $@, we only have to localize the array element
+ # that it will be stored in.
+ local $saved[0]; # Preserve the old value of $@
+ eval { &DB::save };
+
+ # Now see whether we need to report an error back to the user.
+ if ($at) {
+ local $\ = '';
+ print $OUT $at;
+ }
+
+ # Display as required by the caller. $onetimeDump and $onetimedumpDepth
+ # are package globals.
+ elsif ($onetimeDump) {
+ if ( $onetimeDump eq 'dump' ) {
+ local $option{dumpDepth} = $onetimedumpDepth
+ if defined $onetimedumpDepth;
+ dumpit( $OUT, \@res );
+ }
+ elsif ( $onetimeDump eq 'methods' ) {
+ methods( $res[0] );
+ }
+ } ## end elsif ($onetimeDump)
+ @res;
+} ## end sub eval
+
+############################################## End lexical danger zone
+
+# After this point it is safe to introduce lexicals.
+# The code being debugged will be executing in its own context, and
+# can't see the inside of the debugger.
+#
+# However, one should not overdo it: leave as much control from outside as
+# possible. If you make something a lexical, it's not going to be addressable
+# from outside the debugger even if you know its name.
+
+# This file is automatically included if you do perl -d.
+# It's probably not useful to include this yourself.
+#
+# Before venturing further into these twisty passages, it is
+# wise to read the perldebguts man page or risk the ire of dragons.
+#
+# (It should be noted that perldebguts will tell you a lot about
+# the underlying mechanics of how the debugger interfaces into the
+# Perl interpreter, but not a lot about the debugger itself. The new
+# comments in this code try to address this problem.)
+
+# Note that no subroutine call is possible until &DB::sub is defined
+# (for subroutines defined outside of the package DB). In fact the same is
+# true if $deep is not defined.
+
+# Enhanced by ilya at math.ohio-state.edu (Ilya Zakharevich)
+
+# modified Perl debugger, to be run from Emacs in perldb-mode
+# Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990
+# Johan Vromans -- upgrade to 4.0 pl 10
+# Ilya Zakharevich -- patches after 5.001 (and some before ;-)
+
+# (We have made efforts to clarify the comments in the change log
+# in other places; some of them may seem somewhat obscure as they
+# were originally written, and explaining them away from the code
+# in question seems conterproductive.. -JM)
+
+########################################################################
+# Changes: 0.94
+# + A lot of things changed after 0.94. First of all, core now informs
+# debugger about entry into XSUBs, overloaded operators, tied operations,
+# BEGIN and END. Handy with `O f=2'.
+# + This can make debugger a little bit too verbose, please be patient
+# and report your problems promptly.
+# + Now the option frame has 3 values: 0,1,2. XXX Document!
+# + Note that if DESTROY returns a reference to the object (or object),
+# the deletion of data may be postponed until the next function call,
+# due to the need to examine the return value.
+#
+# Changes: 0.95
+# + `v' command shows versions.
+#
+# Changes: 0.96
+# + `v' command shows version of readline.
+# primitive completion works (dynamic variables, subs for `b' and `l',
+# options). Can `p %var'
+# + Better help (`h <' now works). New commands <<, >>, {, {{.
+# {dump|print}_trace() coded (to be able to do it from <<cmd).
+# + `c sub' documented.
+# + At last enough magic combined to stop after the end of debuggee.
+# + !! should work now (thanks to Emacs bracket matching an extra
+# `]' in a regexp is caught).
+# + `L', `D' and `A' span files now (as documented).
+# + Breakpoints in `require'd code are possible (used in `R').
+# + Some additional words on internal work of debugger.
+# + `b load filename' implemented.
+# + `b postpone subr' implemented.
+# + now only `q' exits debugger (overwritable on $inhibit_exit).
+# + When restarting debugger breakpoints/actions persist.
+# + Buglet: When restarting debugger only one breakpoint/action per
+# autoloaded function persists.
+#
+# Changes: 0.97: NonStop will not stop in at_exit().
+# + Option AutoTrace implemented.
+# + Trace printed differently if frames are printed too.
+# + new `inhibitExit' option.
+# + printing of a very long statement interruptible.
+# Changes: 0.98: New command `m' for printing possible methods
+# + 'l -' is a synonym for `-'.
+# + Cosmetic bugs in printing stack trace.
+# + `frame' & 8 to print "expanded args" in stack trace.
+# + Can list/break in imported subs.
+# + new `maxTraceLen' option.
+# + frame & 4 and frame & 8 granted.
+# + new command `m'
+# + nonstoppable lines do not have `:' near the line number.
+# + `b compile subname' implemented.
+# + Will not use $` any more.
+# + `-' behaves sane now.
+# Changes: 0.99: Completion for `f', `m'.
+# + `m' will remove duplicate names instead of duplicate functions.
+# + `b load' strips trailing whitespace.
+# completion ignores leading `|'; takes into account current package
+# when completing a subroutine name (same for `l').
+# Changes: 1.07: Many fixed by tchrist 13-March-2000
+# BUG FIXES:
+# + Added bare minimal security checks on perldb rc files, plus
+# comments on what else is needed.
+# + Fixed the ornaments that made "|h" completely unusable.
+# They are not used in print_help if they will hurt. Strip pod
+# if we're paging to less.
+# + Fixed mis-formatting of help messages caused by ornaments
+# to restore Larry's original formatting.
+# + Fixed many other formatting errors. The code is still suboptimal,
+# and needs a lot of work at restructuring. It's also misindented
+# in many places.
+# + Fixed bug where trying to look at an option like your pager
+# shows "1".
+# + Fixed some $? processing. Note: if you use csh or tcsh, you will
+# lose. You should consider shell escapes not using their shell,
+# or else not caring about detailed status. This should really be
+# unified into one place, too.
+# + Fixed bug where invisible trailing whitespace on commands hoses you,
+# tricking Perl into thinking you weren't calling a debugger command!
+# + Fixed bug where leading whitespace on commands hoses you. (One
+# suggests a leading semicolon or any other irrelevant non-whitespace
+# to indicate literal Perl code.)
+# + Fixed bugs that ate warnings due to wrong selected handle.
+# + Fixed a precedence bug on signal stuff.
+# + Fixed some unseemly wording.
+# + Fixed bug in help command trying to call perl method code.
+# + Fixed to call dumpvar from exception handler. SIGPIPE killed us.
+# ENHANCEMENTS:
+# + Added some comments. This code is still nasty spaghetti.
+# + Added message if you clear your pre/post command stacks which was
+# very easy to do if you just typed a bare >, <, or {. (A command
+# without an argument should *never* be a destructive action; this
+# API is fundamentally screwed up; likewise option setting, which
+# is equally buggered.)
+# + Added command stack dump on argument of "?" for >, <, or {.
+# + Added a semi-built-in doc viewer command that calls man with the
+# proper %Config::Config path (and thus gets caching, man -k, etc),
+# or else perldoc on obstreperous platforms.
+# + Added to and rearranged the help information.
+# + Detected apparent misuse of { ... } to declare a block; this used
+# to work but now is a command, and mysteriously gave no complaint.
+#
+# Changes: 1.08: Apr 25, 2001 Jon Eveland <jweveland at yahoo.com>
+# BUG FIX:
+# + This patch to perl5db.pl cleans up formatting issues on the help
+# summary (h h) screen in the debugger. Mostly columnar alignment
+# issues, plus converted the printed text to use all spaces, since
+# tabs don't seem to help much here.
+#
+# Changes: 1.09: May 19, 2001 Ilya Zakharevich <ilya at math.ohio-state.edu>
+# Minor bugs corrected;
+# + Support for auto-creation of new TTY window on startup, either
+# unconditionally, or if started as a kid of another debugger session;
+# + New `O'ption CreateTTY
+# I<CreateTTY> bits control attempts to create a new TTY on events:
+# 1: on fork()
+# 2: debugger is started inside debugger
+# 4: on startup
+# + Code to auto-create a new TTY window on OS/2 (currently one
+# extra window per session - need named pipes to have more...);
+# + Simplified interface for custom createTTY functions (with a backward
+# compatibility hack); now returns the TTY name to use; return of ''
+# means that the function reset the I/O handles itself;
+# + Better message on the semantic of custom createTTY function;
+# + Convert the existing code to create a TTY into a custom createTTY
+# function;
+# + Consistent support for TTY names of the form "TTYin,TTYout";
+# + Switch line-tracing output too to the created TTY window;
+# + make `b fork' DWIM with CORE::GLOBAL::fork;
+# + High-level debugger API cmd_*():
+# cmd_b_load($filenamepart) # b load filenamepart
+# cmd_b_line($lineno [, $cond]) # b lineno [cond]
+# cmd_b_sub($sub [, $cond]) # b sub [cond]
+# cmd_stop() # Control-C
+# cmd_d($lineno) # d lineno (B)
+# The cmd_*() API returns FALSE on failure; in this case it outputs
+# the error message to the debugging output.
+# + Low-level debugger API
+# break_on_load($filename) # b load filename
+# @files = report_break_on_load() # List files with load-breakpoints
+# breakable_line_in_filename($name, $from [, $to])
+# # First breakable line in the
+# # range $from .. $to. $to defaults
+# # to $from, and may be less than
+# # $to
+# breakable_line($from [, $to]) # Same for the current file
+# break_on_filename_line($name, $lineno [, $cond])
+# # Set breakpoint,$cond defaults to
+# # 1
+# break_on_filename_line_range($name, $from, $to [, $cond])
+# # As above, on the first
+# # breakable line in range
+# break_on_line($lineno [, $cond]) # As above, in the current file
+# break_subroutine($sub [, $cond]) # break on the first breakable line
+# ($name, $from, $to) = subroutine_filename_lines($sub)
+# # The range of lines of the text
+# The low-level API returns TRUE on success, and die()s on failure.
+#
+# Changes: 1.10: May 23, 2001 Daniel Lewart <d-lewart at uiuc.edu>
+# BUG FIXES:
+# + Fixed warnings generated by "perl -dWe 42"
+# + Corrected spelling errors
+# + Squeezed Help (h) output into 80 columns
+#
+# Changes: 1.11: May 24, 2001 David Dyck <dcd at tc.fluke.com>
+# + Made "x @INC" work like it used to
+#
+# Changes: 1.12: May 24, 2001 Daniel Lewart <d-lewart at uiuc.edu>
+# + Fixed warnings generated by "O" (Show debugger options)
+# + Fixed warnings generated by "p 42" (Print expression)
+# Changes: 1.13: Jun 19, 2001 Scott.L.Miller at compaq.com
+# + Added windowSize option
+# Changes: 1.14: Oct 9, 2001 multiple
+# + Clean up after itself on VMS (Charles Lane in 12385)
+# + Adding "@ file" syntax (Peter Scott in 12014)
+# + Debug reloading selfloaded stuff (Ilya Zakharevich in 11457)
+# + $^S and other debugger fixes (Ilya Zakharevich in 11120)
+# + Forgot a my() declaration (Ilya Zakharevich in 11085)
+# Changes: 1.15: Nov 6, 2001 Michael G Schwern <schwern at pobox.com>
+# + Updated 1.14 change log
+# + Added *dbline explainatory comments
+# + Mentioning perldebguts man page
+# Changes: 1.16: Feb 15, 2002 Mark-Jason Dominus <mjd at plover.com>
+# + $onetimeDump improvements
+# Changes: 1.17: Feb 20, 2002 Richard Foley <richard.foley at rfi.net>
+# Moved some code to cmd_[.]()'s for clarity and ease of handling,
+# rationalised the following commands and added cmd_wrapper() to
+# enable switching between old and frighteningly consistent new
+# behaviours for diehards: 'o CommandSet=pre580' (sigh...)
+# a(add), A(del) # action expr (added del by line)
+# + b(add), B(del) # break [line] (was b,D)
+# + w(add), W(del) # watch expr (was W,W)
+# # added del by expr
+# + h(summary), h h(long) # help (hh) (was h h,h)
+# + m(methods), M(modules) # ... (was m,v)
+# + o(option) # lc (was O)
+# + v(view code), V(view Variables) # ... (was w,V)
+# Changes: 1.18: Mar 17, 2002 Richard Foley <richard.foley at rfi.net>
+# + fixed missing cmd_O bug
+# Changes: 1.19: Mar 29, 2002 Spider Boardman
+# + Added missing local()s -- DB::DB is called recursively.
+# Changes: 1.20: Feb 17, 2003 Richard Foley <richard.foley at rfi.net>
+# + pre'n'post commands no longer trashed with no args
+# + watch val joined out of eval()
+# Changes: 1.21: Jun 04, 2003 Joe McMahon <mcmahon at ibiblio.org>
+# + Added comments and reformatted source. No bug fixes/enhancements.
+# + Includes cleanup by Robin Barker and Jarkko Hietaniemi.
+# Changes: 1.22 Jun 09, 2003 Alex Vandiver <alexmv at MIT.EDU>
+# + Flush stdout/stderr before the debugger prompt is printed.
+# Changes: 1.23: Dec 21, 2003 Dominique Quatravaux
+# + Fix a side-effect of bug #24674 in the perl debugger ("odd taint bug")
+# Changes: 1.24: Mar 03, 2004 Richard Foley <richard.foley at rfi.net>
+# + Added command to save all debugger commands for sourcing later.
+# + Added command to display parent inheritance tree of given class.
+# + Fixed minor newline in history bug.
+# Changes: 1.25: Apr 17, 2004 Richard Foley <richard.foley at rfi.net>
+# + Fixed option bug (setting invalid options + not recognising valid short forms)
+# Changes: 1.26: Apr 22, 2004 Richard Foley <richard.foley at rfi.net>
+# + unfork the 5.8.x and 5.9.x debuggers.
+# + whitespace and assertions call cleanup across versions
+# + H * deletes (resets) history
+# + i now handles Class + blessed objects
+# Changes: 1.27: May 09, 2004 Richard Foley <richard.foley at rfi.net>
+# + updated pod page references - clunky.
+# + removed windowid restriction for forking into an xterm.
+# + more whitespace again.
+# + wrapped restart and enabled rerun [-n] (go back n steps) command.
+# Changes: 1.28: Oct 12, 2004 Richard Foley <richard.foley at rfi.net>
+# + Added threads support (inc. e and E commands)
+# Changes: 1.29: Nov 28, 2006 Bo Lindbergh <blgl at hagernas.com>
+# + Added macosx_get_fork_TTY support
+# Changes: 1.30: Mar 06, 2007 Andreas Koenig <andk at cpan.org>
+# + Added HistFile, HistSize
+# Changes: 1.31
+# + Remove support for assertions and -A
+# + stop NEXT::AUTOLOAD from emitting warnings under the debugger. RT #25053
+# + "update for Mac OS X 10.5" [finding the tty device]
+# + "What I needed to get the forked debugger to work" [on VMS]
+# + [perl #57016] debugger: o warn=0 die=0 ignored
+# + Note, but don't use, PERLDBf_SAVESRC
+# + Fix #7013: lvalue subs not working inside debugger
+########################################################################
+
+=head1 DEBUGGER INITIALIZATION
+
+The debugger starts up in phases.
+
+=head2 BASIC SETUP
+
+First, it initializes the environment it wants to run in: turning off
+warnings during its own compilation, defining variables which it will need
+to avoid warnings later, setting itself up to not exit when the program
+terminates, and defaulting to printing return values for the C<r> command.
+
+=cut
+
+# Needed for the statement after exec():
+#
+# This BEGIN block is simply used to switch off warnings during debugger
+# compiliation. Probably it would be better practice to fix the warnings,
+# but this is how it's done at the moment.
+
+BEGIN {
+ $ini_warn = $^W;
+ $^W = 0;
+} # Switch compilation warnings off until another BEGIN.
+
+local ($^W) = 0; # Switch run-time warnings off during init.
+
+=head2 THREADS SUPPORT
+
+If we are running under a threaded Perl, we require threads and threads::shared
+if the environment variable C<PERL5DB_THREADED> is set, to enable proper
+threaded debugger control. C<-dt> can also be used to set this.
+
+Each new thread will be announced and the debugger prompt will always inform
+you of each new thread created. It will also indicate the thread id in which
+we are currently running within the prompt like this:
+
+ [tid] DB<$i>
+
+Where C<[tid]> is an integer thread id and C<$i> is the familiar debugger
+command prompt. The prompt will show: C<[0]> when running under threads, but
+not actually in a thread. C<[tid]> is consistent with C<gdb> usage.
+
+While running under threads, when you set or delete a breakpoint (etc.), this
+will apply to all threads, not just the currently running one. When you are
+in a currently executing thread, you will stay there until it completes. With
+the current implementation it is not currently possible to hop from one thread
+to another.
+
+The C<e> and C<E> commands are currently fairly minimal - see C<h e> and C<h E>.
+
+Note that threading support was built into the debugger as of Perl version
+C<5.8.6> and debugger version C<1.2.8>.
+
+=cut
+
+BEGIN {
+ # ensure we can share our non-threaded variables or no-op
+ if ($ENV{PERL5DB_THREADED}) {
+ require threads;
+ require threads::shared;
+ import threads::shared qw(share);
+ $DBGR;
+ share(\$DBGR);
+ lock($DBGR);
+ print "Threads support enabled\n";
+ } else {
+ *lock = sub(*) {};
+ *share = sub(*) {};
+ }
+}
+
+# This would probably be better done with "use vars", but that wasn't around
+# when this code was originally written. (Neither was "use strict".) And on
+# the principle of not fiddling with something that was working, this was
+# left alone.
+warn( # Do not ;-)
+ # These variables control the execution of 'dumpvar.pl'.
+ $dumpvar::hashDepth,
+ $dumpvar::arrayDepth,
+ $dumpvar::dumpDBFiles,
+ $dumpvar::dumpPackages,
+ $dumpvar::quoteHighBit,
+ $dumpvar::printUndef,
+ $dumpvar::globPrint,
+ $dumpvar::usageOnly,
+
+ # used to save @ARGV and extract any debugger-related flags.
+ @ARGS,
+
+ # used to control die() reporting in diesignal()
+ $Carp::CarpLevel,
+
+ # used to prevent multiple entries to diesignal()
+ # (if for instance diesignal() itself dies)
+ $panic,
+
+ # used to prevent the debugger from running nonstop
+ # after a restart
+ $second_time,
+ )
+ if 0;
+
+foreach my $k (keys (%INC)) {
+ &share(\$main::{'_<'.$filename});
+};
+
+# Command-line + PERLLIB:
+# Save the contents of @INC before they are modified elsewhere.
+ at ini_INC = @INC;
+
+# This was an attempt to clear out the previous values of various
+# trapped errors. Apparently it didn't help. XXX More info needed!
+# $prevwarn = $prevdie = $prevbus = $prevsegv = ''; # Does not help?!
+
+# We set these variables to safe values. We don't want to blindly turn
+# off warnings, because other packages may still want them.
+$trace = $signal = $single = 0; # Uninitialized warning suppression
+ # (local $^W cannot help - other packages!).
+
+# Default to not exiting when program finishes; print the return
+# value when the 'r' command is used to return from a subroutine.
+$inhibit_exit = $option{PrintRet} = 1;
+
+=head1 OPTION PROCESSING
+
+The debugger's options are actually spread out over the debugger itself and
+C<dumpvar.pl>; some of these are variables to be set, while others are
+subs to be called with a value. To try to make this a little easier to
+manage, the debugger uses a few data structures to define what options
+are legal and how they are to be processed.
+
+First, the C<@options> array defines the I<names> of all the options that
+are to be accepted.
+
+=cut
+
+ at options = qw(
+ CommandSet HistFile HistSize
+ hashDepth arrayDepth dumpDepth
+ DumpDBFiles DumpPackages DumpReused
+ compactDump veryCompact quote
+ HighBit undefPrint globPrint
+ PrintRet UsageOnly frame
+ AutoTrace TTY noTTY
+ ReadLine NonStop LineInfo
+ maxTraceLen recallCommand ShellBang
+ pager tkRunning ornaments
+ signalLevel warnLevel dieLevel
+ inhibit_exit ImmediateStop bareStringify
+ CreateTTY RemotePort windowSize
+ DollarCaretP
+);
+
+ at RememberOnROptions = qw(DollarCaretP);
+
+=pod
+
+Second, C<optionVars> lists the variables that each option uses to save its
+state.
+
+=cut
+
+%optionVars = (
+ hashDepth => \$dumpvar::hashDepth,
+ arrayDepth => \$dumpvar::arrayDepth,
+ CommandSet => \$CommandSet,
+ DumpDBFiles => \$dumpvar::dumpDBFiles,
+ DumpPackages => \$dumpvar::dumpPackages,
+ DumpReused => \$dumpvar::dumpReused,
+ HighBit => \$dumpvar::quoteHighBit,
+ undefPrint => \$dumpvar::printUndef,
+ globPrint => \$dumpvar::globPrint,
+ UsageOnly => \$dumpvar::usageOnly,
+ CreateTTY => \$CreateTTY,
+ bareStringify => \$dumpvar::bareStringify,
+ frame => \$frame,
+ AutoTrace => \$trace,
+ inhibit_exit => \$inhibit_exit,
+ maxTraceLen => \$maxtrace,
+ ImmediateStop => \$ImmediateStop,
+ RemotePort => \$remoteport,
+ windowSize => \$window,
+ HistFile => \$histfile,
+ HistSize => \$histsize,
+);
+
+=pod
+
+Third, C<%optionAction> defines the subroutine to be called to process each
+option.
+
+=cut
+
+%optionAction = (
+ compactDump => \&dumpvar::compactDump,
+ veryCompact => \&dumpvar::veryCompact,
+ quote => \&dumpvar::quote,
+ TTY => \&TTY,
+ noTTY => \&noTTY,
+ ReadLine => \&ReadLine,
+ NonStop => \&NonStop,
+ LineInfo => \&LineInfo,
+ recallCommand => \&recallCommand,
+ ShellBang => \&shellBang,
+ pager => \&pager,
+ signalLevel => \&signalLevel,
+ warnLevel => \&warnLevel,
+ dieLevel => \&dieLevel,
+ tkRunning => \&tkRunning,
+ ornaments => \&ornaments,
+ RemotePort => \&RemotePort,
+ DollarCaretP => \&DollarCaretP,
+);
+
+=pod
+
+Last, the C<%optionRequire> notes modules that must be C<require>d if an
+option is used.
+
+=cut
+
+# Note that this list is not complete: several options not listed here
+# actually require that dumpvar.pl be loaded for them to work, but are
+# not in the table. A subsequent patch will correct this problem; for
+# the moment, we're just recommenting, and we are NOT going to change
+# function.
+%optionRequire = (
+ compactDump => 'dumpvar.pl',
+ veryCompact => 'dumpvar.pl',
+ quote => 'dumpvar.pl',
+);
+
+=pod
+
+There are a number of initialization-related variables which can be set
+by putting code to set them in a BEGIN block in the C<PERL5DB> environment
+variable. These are:
+
+=over 4
+
+=item C<$rl> - readline control XXX needs more explanation
+
+=item C<$warnLevel> - whether or not debugger takes over warning handling
+
+=item C<$dieLevel> - whether or not debugger takes over die handling
+
+=item C<$signalLevel> - whether or not debugger takes over signal handling
+
+=item C<$pre> - preprompt actions (array reference)
+
+=item C<$post> - postprompt actions (array reference)
+
+=item C<$pretype>
+
+=item C<$CreateTTY> - whether or not to create a new TTY for this debugger
+
+=item C<$CommandSet> - which command set to use (defaults to new, documented set)
+
+=back
+
+=cut
+
+# These guys may be defined in $ENV{PERL5DB} :
+$rl = 1 unless defined $rl;
+$warnLevel = 1 unless defined $warnLevel;
+$dieLevel = 1 unless defined $dieLevel;
+$signalLevel = 1 unless defined $signalLevel;
+$pre = [] unless defined $pre;
+$post = [] unless defined $post;
+$pretype = [] unless defined $pretype;
+$CreateTTY = 3 unless defined $CreateTTY;
+$CommandSet = '580' unless defined $CommandSet;
+
+share($rl);
+share($warnLevel);
+share($dieLevel);
+share($signalLevel);
+share($pre);
+share($post);
+share($pretype);
+share($rl);
+share($CreateTTY);
+share($CommandSet);
+
+=pod
+
+The default C<die>, C<warn>, and C<signal> handlers are set up.
+
+=cut
+
+warnLevel($warnLevel);
+dieLevel($dieLevel);
+signalLevel($signalLevel);
+
+=pod
+
+The pager to be used is needed next. We try to get it from the
+environment first. If it's not defined there, we try to find it in
+the Perl C<Config.pm>. If it's not there, we default to C<more>. We
+then call the C<pager()> function to save the pager name.
+
+=cut
+
+# This routine makes sure $pager is set up so that '|' can use it.
+pager(
+
+ # If PAGER is defined in the environment, use it.
+ defined $ENV{PAGER}
+ ? $ENV{PAGER}
+
+ # If not, see if Config.pm defines it.
+ : eval { require Config }
+ && defined $Config::Config{pager}
+ ? $Config::Config{pager}
+
+ # If not, fall back to 'more'.
+ : 'more'
+ )
+ unless defined $pager;
+
+=pod
+
+We set up the command to be used to access the man pages, the command
+recall character (C<!> unless otherwise defined) and the shell escape
+character (C<!> unless otherwise defined). Yes, these do conflict, and
+neither works in the debugger at the moment.
+
+=cut
+
+setman();
+
+# Set up defaults for command recall and shell escape (note:
+# these currently don't work in linemode debugging).
+&recallCommand("!") unless defined $prc;
+&shellBang("!") unless defined $psh;
+
+=pod
+
+We then set up the gigantic string containing the debugger help.
+We also set the limit on the number of arguments we'll display during a
+trace.
+
+=cut
+
+sethelp();
+
+# If we didn't get a default for the length of eval/stack trace args,
+# set it here.
+$maxtrace = 400 unless defined $maxtrace;
+
+=head2 SETTING UP THE DEBUGGER GREETING
+
+The debugger I<greeting> helps to inform the user how many debuggers are
+running, and whether the current debugger is the primary or a child.
+
+If we are the primary, we just hang onto our pid so we'll have it when
+or if we start a child debugger. If we are a child, we'll set things up
+so we'll have a unique greeting and so the parent will give us our own
+TTY later.
+
+We save the current contents of the C<PERLDB_PIDS> environment variable
+because we mess around with it. We'll also need to hang onto it because
+we'll need it if we restart.
+
+Child debuggers make a label out of the current PID structure recorded in
+PERLDB_PIDS plus the new PID. They also mark themselves as not having a TTY
+yet so the parent will give them one later via C<resetterm()>.
+
+=cut
+
+# Save the current contents of the environment; we're about to
+# much with it. We'll need this if we have to restart.
+$ini_pids = $ENV{PERLDB_PIDS};
+
+if ( defined $ENV{PERLDB_PIDS} ) {
+
+ # We're a child. Make us a label out of the current PID structure
+ # recorded in PERLDB_PIDS plus our (new) PID. Mark us as not having
+ # a term yet so the parent will give us one later via resetterm().
+
+ my $env_pids = $ENV{PERLDB_PIDS};
+ $pids = "[$env_pids]";
+
+ # Unless we are on OpenVMS, all programs under the DCL shell run under
+ # the same PID.
+
+ if (($^O eq 'VMS') && ($env_pids =~ /\b$$\b/)) {
+ $term_pid = $$;
+ }
+ else {
+ $ENV{PERLDB_PIDS} .= "->$$";
+ $term_pid = -1;
+ }
+
+} ## end if (defined $ENV{PERLDB_PIDS...
+else {
+
+ # We're the parent PID. Initialize PERLDB_PID in case we end up with a
+ # child debugger, and mark us as the parent, so we'll know to set up
+ # more TTY's is we have to.
+ $ENV{PERLDB_PIDS} = "$$";
+ $pids = "[pid=$$]";
+ $term_pid = $$;
+}
+
+$pidprompt = '';
+
+# Sets up $emacs as a synonym for $slave_editor.
+*emacs = $slave_editor if $slave_editor; # May be used in afterinit()...
+
+=head2 READING THE RC FILE
+
+The debugger will read a file of initialization options if supplied. If
+running interactively, this is C<.perldb>; if not, it's C<perldb.ini>.
+
+=cut
+
+# As noted, this test really doesn't check accurately that the debugger
+# is running at a terminal or not.
+
+my $dev_tty = '/dev/tty';
+ $dev_tty = 'TT:' if ($^O eq 'VMS');
+if ( -e $dev_tty ) { # this is the wrong metric!
+ $rcfile = ".perldb";
+}
+else {
+ $rcfile = "perldb.ini";
+}
+
+=pod
+
+The debugger does a safety test of the file to be read. It must be owned
+either by the current user or root, and must only be writable by the owner.
+
+=cut
+
+# This wraps a safety test around "do" to read and evaluate the init file.
+#
+# This isn't really safe, because there's a race
+# between checking and opening. The solution is to
+# open and fstat the handle, but then you have to read and
+# eval the contents. But then the silly thing gets
+# your lexical scope, which is unfortunate at best.
+sub safe_do {
+ my $file = shift;
+
+ # Just exactly what part of the word "CORE::" don't you understand?
+ local $SIG{__WARN__};
+ local $SIG{__DIE__};
+
+ unless ( is_safe_file($file) ) {
+ CORE::warn <<EO_GRIPE;
+perldb: Must not source insecure rcfile $file.
+ You or the superuser must be the owner, and it must not
+ be writable by anyone but its owner.
+EO_GRIPE
+ return;
+ } ## end unless (is_safe_file($file...
+
+ do $file;
+ CORE::warn("perldb: couldn't parse $file: $@") if $@;
+} ## end sub safe_do
+
+# This is the safety test itself.
+#
+# Verifies that owner is either real user or superuser and that no
+# one but owner may write to it. This function is of limited use
+# when called on a path instead of upon a handle, because there are
+# no guarantees that filename (by dirent) whose file (by ino) is
+# eventually accessed is the same as the one tested.
+# Assumes that the file's existence is not in doubt.
+sub is_safe_file {
+ my $path = shift;
+ stat($path) || return; # mysteriously vaporized
+ my ( $dev, $ino, $mode, $nlink, $uid, $gid ) = stat(_);
+
+ return 0 if $uid != 0 && $uid != $<;
+ return 0 if $mode & 022;
+ return 1;
+} ## end sub is_safe_file
+
+# If the rcfile (whichever one we decided was the right one to read)
+# exists, we safely do it.
+if ( -f $rcfile ) {
+ safe_do("./$rcfile");
+}
+
+# If there isn't one here, try the user's home directory.
+elsif ( defined $ENV{HOME} && -f "$ENV{HOME}/$rcfile" ) {
+ safe_do("$ENV{HOME}/$rcfile");
+}
+
+# Else try the login directory.
+elsif ( defined $ENV{LOGDIR} && -f "$ENV{LOGDIR}/$rcfile" ) {
+ safe_do("$ENV{LOGDIR}/$rcfile");
+}
+
+# If the PERLDB_OPTS variable has options in it, parse those out next.
+if ( defined $ENV{PERLDB_OPTS} ) {
+ parse_options( $ENV{PERLDB_OPTS} );
+}
+
+=pod
+
+The last thing we do during initialization is determine which subroutine is
+to be used to obtain a new terminal when a new debugger is started. Right now,
+the debugger only handles X Windows, OS/2, and Mac OS X (darwin).
+
+=cut
+
+# Set up the get_fork_TTY subroutine to be aliased to the proper routine.
+# Works if you're running an xterm or xterm-like window, or you're on
+# OS/2, or on Mac OS X. This may need some expansion.
+
+if (not defined &get_fork_TTY) # only if no routine exists
+{
+ if (defined $ENV{TERM} # If we know what kind
+ # of terminal this is,
+ and $ENV{TERM} eq 'xterm' # and it's an xterm,
+ and defined $ENV{DISPLAY} # and what display it's on,
+ )
+ {
+ *get_fork_TTY = \&xterm_get_fork_TTY; # use the xterm version
+ }
+ elsif ( $^O eq 'os2' ) { # If this is OS/2,
+ *get_fork_TTY = \&os2_get_fork_TTY; # use the OS/2 version
+ }
+ elsif ( $^O eq 'darwin' # If this is Mac OS X
+ and defined $ENV{TERM_PROGRAM} # and we're running inside
+ and $ENV{TERM_PROGRAM}
+ eq 'Apple_Terminal' # Terminal.app
+ )
+ {
+ *get_fork_TTY = \&macosx_get_fork_TTY; # use the Mac OS X version
+ }
+} ## end if (not defined &get_fork_TTY...
+
+# untaint $^O, which may have been tainted by the last statement.
+# see bug [perl #24674]
+$^O =~ m/^(.*)\z/;
+$^O = $1;
+
+# Here begin the unreadable code. It needs fixing.
+
+=head2 RESTART PROCESSING
+
+This section handles the restart command. When the C<R> command is invoked, it
+tries to capture all of the state it can into environment variables, and
+then sets C<PERLDB_RESTART>. When we start executing again, we check to see
+if C<PERLDB_RESTART> is there; if so, we reload all the information that
+the R command stuffed into the environment variables.
+
+ PERLDB_RESTART - flag only, contains no restart data itself.
+ PERLDB_HIST - command history, if it's available
+ PERLDB_ON_LOAD - breakpoints set by the rc file
+ PERLDB_POSTPONE - subs that have been loaded/not executed, and have actions
+ PERLDB_VISITED - files that had breakpoints
+ PERLDB_FILE_... - breakpoints for a file
+ PERLDB_OPT - active options
+ PERLDB_INC - the original @INC
+ PERLDB_PRETYPE - preprompt debugger actions
+ PERLDB_PRE - preprompt Perl code
+ PERLDB_POST - post-prompt Perl code
+ PERLDB_TYPEAHEAD - typeahead captured by readline()
+
+We chug through all these variables and plug the values saved in them
+back into the appropriate spots in the debugger.
+
+=cut
+
+if ( exists $ENV{PERLDB_RESTART} ) {
+
+ # We're restarting, so we don't need the flag that says to restart anymore.
+ delete $ENV{PERLDB_RESTART};
+
+ # $restart = 1;
+ @hist = get_list('PERLDB_HIST');
+ %break_on_load = get_list("PERLDB_ON_LOAD");
+ %postponed = get_list("PERLDB_POSTPONE");
+
+ share(@hist);
+ share(@truehist);
+ share(%break_on_load);
+ share(%postponed);
+
+ # restore breakpoints/actions
+ my @had_breakpoints = get_list("PERLDB_VISITED");
+ for ( 0 .. $#had_breakpoints ) {
+ my %pf = get_list("PERLDB_FILE_$_");
+ $postponed_file{ $had_breakpoints[$_] } = \%pf if %pf;
+ }
+
+ # restore options
+ my %opt = get_list("PERLDB_OPT");
+ my ( $opt, $val );
+ while ( ( $opt, $val ) = each %opt ) {
+ $val =~ s/[\\\']/\\$1/g;
+ parse_options("$opt'$val'");
+ }
+
+ # restore original @INC
+ @INC = get_list("PERLDB_INC");
+ @ini_INC = @INC;
+
+ # return pre/postprompt actions and typeahead buffer
+ $pretype = [ get_list("PERLDB_PRETYPE") ];
+ $pre = [ get_list("PERLDB_PRE") ];
+ $post = [ get_list("PERLDB_POST") ];
+ @typeahead = get_list( "PERLDB_TYPEAHEAD", @typeahead );
+} ## end if (exists $ENV{PERLDB_RESTART...
+
+=head2 SETTING UP THE TERMINAL
+
+Now, we'll decide how the debugger is going to interact with the user.
+If there's no TTY, we set the debugger to run non-stop; there's not going
+to be anyone there to enter commands.
+
+=cut
+
+if ($notty) {
+ $runnonstop = 1;
+ share($runnonstop);
+}
+
+=pod
+
+If there is a TTY, we have to determine who it belongs to before we can
+proceed. If this is a slave editor or graphical debugger (denoted by
+the first command-line switch being '-emacs'), we shift this off and
+set C<$rl> to 0 (XXX ostensibly to do straight reads).
+
+=cut
+
+else {
+
+ # Is Perl being run from a slave editor or graphical debugger?
+ # If so, don't use readline, and set $slave_editor = 1.
+ $slave_editor =
+ ( ( defined $main::ARGV[0] ) and ( $main::ARGV[0] eq '-emacs' ) );
+ $rl = 0, shift(@main::ARGV) if $slave_editor;
+
+ #require Term::ReadLine;
+
+=pod
+
+We then determine what the console should be on various systems:
+
+=over 4
+
+=item * Cygwin - We use C<stdin> instead of a separate device.
+
+=cut
+
+ if ( $^O eq 'cygwin' ) {
+
+ # /dev/tty is binary. use stdin for textmode
+ undef $console;
+ }
+
+=item * Unix - use C</dev/tty>.
+
+=cut
+
+ elsif ( -e "/dev/tty" ) {
+ $console = "/dev/tty";
+ }
+
+=item * Windows or MSDOS - use C<con>.
+
+=cut
+
+ elsif ( $^O eq 'dos' or -e "con" or $^O eq 'MSWin32' ) {
+ $console = "con";
+ }
+
+=item * MacOS - use C<Dev:Console:Perl Debug> if this is the MPW version; C<Dev:
+Console> if not.
+
+Note that Mac OS X returns C<darwin>, not C<MacOS>. Also note that the debugger doesn't do anything special for C<darwin>. Maybe it should.
+
+=cut
+
+ elsif ( $^O eq 'MacOS' ) {
+ if ( $MacPerl::Version !~ /MPW/ ) {
+ $console =
+ "Dev:Console:Perl Debug"; # Separate window for application
+ }
+ else {
+ $console = "Dev:Console";
+ }
+ } ## end elsif ($^O eq 'MacOS')
+
+=item * VMS - use C<sys$command>.
+
+=cut
+
+ else {
+
+ # everything else is ...
+ $console = "sys\$command";
+ }
+
+=pod
+
+=back
+
+Several other systems don't use a specific console. We C<undef $console>
+for those (Windows using a slave editor/graphical debugger, NetWare, OS/2
+with a slave editor, Epoc).
+
+=cut
+
+ if ( ( $^O eq 'MSWin32' ) and ( $slave_editor or defined $ENV{EMACS} ) ) {
+
+ # /dev/tty is binary. use stdin for textmode
+ $console = undef;
+ }
+
+ if ( $^O eq 'NetWare' ) {
+
+ # /dev/tty is binary. use stdin for textmode
+ $console = undef;
+ }
+
+ # In OS/2, we need to use STDIN to get textmode too, even though
+ # it pretty much looks like Unix otherwise.
+ if ( defined $ENV{OS2_SHELL} and ( $slave_editor or $ENV{WINDOWID} ) )
+ { # In OS/2
+ $console = undef;
+ }
+
+ # EPOC also falls into the 'got to use STDIN' camp.
+ if ( $^O eq 'epoc' ) {
+ $console = undef;
+ }
+
+=pod
+
+If there is a TTY hanging around from a parent, we use that as the console.
+
+=cut
+
+ $console = $tty if defined $tty;
+
+=head2 SOCKET HANDLING
+
+The debugger is capable of opening a socket and carrying out a debugging
+session over the socket.
+
+If C<RemotePort> was defined in the options, the debugger assumes that it
+should try to start a debugging session on that port. It builds the socket
+and then tries to connect the input and output filehandles to it.
+
+=cut
+
+ # Handle socket stuff.
+
+ if ( defined $remoteport ) {
+
+ # If RemotePort was defined in the options, connect input and output
+ # to the socket.
+ require IO::Socket;
+ $OUT = new IO::Socket::INET(
+ Timeout => '10',
+ PeerAddr => $remoteport,
+ Proto => 'tcp',
+ );
+ if ( !$OUT ) { die "Unable to connect to remote host: $remoteport\n"; }
+ $IN = $OUT;
+ } ## end if (defined $remoteport)
+
+=pod
+
+If no C<RemotePort> was defined, and we want to create a TTY on startup,
+this is probably a situation where multiple debuggers are running (for example,
+a backticked command that starts up another debugger). We create a new IN and
+OUT filehandle, and do the necessary mojo to create a new TTY if we know how
+and if we can.
+
+=cut
+
+ # Non-socket.
+ else {
+
+ # Two debuggers running (probably a system or a backtick that invokes
+ # the debugger itself under the running one). create a new IN and OUT
+ # filehandle, and do the necessary mojo to create a new tty if we
+ # know how, and we can.
+ create_IN_OUT(4) if $CreateTTY & 4;
+ if ($console) {
+
+ # If we have a console, check to see if there are separate ins and
+ # outs to open. (They are assumed identical if not.)
+
+ my ( $i, $o ) = split /,/, $console;
+ $o = $i unless defined $o;
+
+ # read/write on in, or just read, or read on STDIN.
+ open( IN, "+<$i" )
+ || open( IN, "<$i" )
+ || open( IN, "<&STDIN" );
+
+ # read/write/create/clobber out, or write/create/clobber out,
+ # or merge with STDERR, or merge with STDOUT.
+ open( OUT, "+>$o" )
+ || open( OUT, ">$o" )
+ || open( OUT, ">&STDERR" )
+ || open( OUT, ">&STDOUT" ); # so we don't dongle stdout
+
+ } ## end if ($console)
+ elsif ( not defined $console ) {
+
+ # No console. Open STDIN.
+ open( IN, "<&STDIN" );
+
+ # merge with STDERR, or with STDOUT.
+ open( OUT, ">&STDERR" )
+ || open( OUT, ">&STDOUT" ); # so we don't dongle stdout
+ $console = 'STDIN/OUT';
+ } ## end elsif (not defined $console)
+
+ # Keep copies of the filehandles so that when the pager runs, it
+ # can close standard input without clobbering ours.
+ $IN = \*IN, $OUT = \*OUT if $console or not defined $console;
+ } ## end elsif (from if(defined $remoteport))
+
+ # Unbuffer DB::OUT. We need to see responses right away.
+ my $previous = select($OUT);
+ $| = 1; # for DB::OUT
+ select($previous);
+
+ # Line info goes to debugger output unless pointed elsewhere.
+ # Pointing elsewhere makes it possible for slave editors to
+ # keep track of file and position. We have both a filehandle
+ # and a I/O description to keep track of.
+ $LINEINFO = $OUT unless defined $LINEINFO;
+ $lineinfo = $console unless defined $lineinfo;
+ # share($LINEINFO); # <- unable to share globs
+ share($lineinfo); #
+
+=pod
+
+To finish initialization, we show the debugger greeting,
+and then call the C<afterinit()> subroutine if there is one.
+
+=cut
+
+ # Show the debugger greeting.
+ $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
+ unless ($runnonstop) {
+ local $\ = '';
+ local $, = '';
+ if ( $term_pid eq '-1' ) {
+ print $OUT "\nDaughter DB session started...\n";
+ }
+ else {
+ print $OUT "\nLoading DB routines from $header\n";
+ print $OUT (
+ "Editor support ",
+ $slave_editor ? "enabled" : "available", ".\n"
+ );
+ print $OUT
+"\nEnter h or `h h' for help, or `$doccmd perldebug' for more help.\n\n";
+ } ## end else [ if ($term_pid eq '-1')
+ } ## end unless ($runnonstop)
+} ## end else [ if ($notty)
+
+# XXX This looks like a bug to me.
+# Why copy to @ARGS and then futz with @args?
+ at ARGS = @ARGV;
+for (@args) {
+ # Make sure backslashes before single quotes are stripped out, and
+ # keep args unless they are numeric (XXX why?)
+ # s/\'/\\\'/g; # removed while not justified understandably
+ # s/(.*)/'$1'/ unless /^-?[\d.]+$/; # ditto
+}
+
+# If there was an afterinit() sub defined, call it. It will get
+# executed in our scope, so it can fiddle with debugger globals.
+if ( defined &afterinit ) { # May be defined in $rcfile
+ &afterinit();
+}
+
+# Inform us about "Stack dump during die enabled ..." in dieLevel().
+$I_m_init = 1;
+
+############################################################ Subroutines
+
+=head1 SUBROUTINES
+
+=head2 DB
+
+This gigantic subroutine is the heart of the debugger. Called before every
+statement, its job is to determine if a breakpoint has been reached, and
+stop if so; read commands from the user, parse them, and execute
+them, and hen send execution off to the next statement.
+
+Note that the order in which the commands are processed is very important;
+some commands earlier in the loop will actually alter the C<$cmd> variable
+to create other commands to be executed later. This is all highly I<optimized>
+but can be confusing. Check the comments for each C<$cmd ... && do {}> to
+see what's happening in any given command.
+
+=cut
+
+require PDL::NiceSlice;
+
+sub DB {
+
+ # lock the debugger and get the thread id for the prompt
+ lock($DBGR);
+ my $tid;
+ if ($ENV{PERL5DB_THREADED}) {
+ $tid = eval { "[".threads->tid."]" };
+ }
+
+ # Check for whether we should be running continuously or not.
+ # _After_ the perl program is compiled, $single is set to 1:
+ if ( $single and not $second_time++ ) {
+
+ # Options say run non-stop. Run until we get an interrupt.
+ if ($runnonstop) { # Disable until signal
+ # If there's any call stack in place, turn off single
+ # stepping into subs throughout the stack.
+ for ( $i = 0 ; $i <= $stack_depth ; ) {
+ $stack[ $i++ ] &= ~1;
+ }
+
+ # And we are now no longer in single-step mode.
+ $single = 0;
+
+ # If we simply returned at this point, we wouldn't get
+ # the trace info. Fall on through.
+ # return;
+ } ## end if ($runnonstop)
+
+ elsif ($ImmediateStop) {
+
+ # We are supposed to stop here; XXX probably a break.
+ $ImmediateStop = 0; # We've processed it; turn it off
+ $signal = 1; # Simulate an interrupt to force
+ # us into the command loop
+ }
+ } ## end if ($single and not $second_time...
+
+ # If we're in single-step mode, or an interrupt (real or fake)
+ # has occurred, turn off non-stop mode.
+ $runnonstop = 0 if $single or $signal;
+
+ # Preserve current values of $@, $!, $^E, $,, $/, $\, $^W.
+ # The code being debugged may have altered them.
+ &save;
+
+ # Since DB::DB gets called after every line, we can use caller() to
+ # figure out where we last were executing. Sneaky, eh? This works because
+ # caller is returning all the extra information when called from the
+ # debugger.
+ local ( $package, $filename, $line ) = caller;
+ local $filename_ini = $filename;
+
+ # set up the context for DB::eval, so it can properly execute
+ # code on behalf of the user. We add the package in so that the
+ # code is eval'ed in the proper package (not in the debugger!).
+ local $usercontext =
+ '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' . "package $package;";
+
+ # Create an alias to the active file magical array to simplify
+ # the code here.
+ local (*dbline) = $main::{ '_<' . $filename };
+
+ # we need to check for pseudofiles on Mac OS (these are files
+ # not attached to a filename, but instead stored in Dev:Pseudo)
+ if ( $^O eq 'MacOS' && $#dbline < 0 ) {
+ $filename_ini = $filename = 'Dev:Pseudo';
+ *dbline = $main::{ '_<' . $filename };
+ }
+
+ # Last line in the program.
+ local $max = $#dbline;
+
+ # if we have something here, see if we should break.
+ if ( $dbline{$line}
+ && ( ( $stop, $action ) = split( /\0/, $dbline{$line} ) ) )
+ {
+
+ # Stop if the stop criterion says to just stop.
+ if ( $stop eq '1' ) {
+ $signal |= 1;
+ }
+
+ # It's a conditional stop; eval it in the user's context and
+ # see if we should stop. If so, remove the one-time sigil.
+ elsif ($stop) {
+ $evalarg = "\$DB::signal |= 1 if do {$stop}";
+ &eval;
+ $dbline{$line} =~ s/;9($|\0)/$1/;
+ }
+ } ## end if ($dbline{$line} && ...
+
+ # Preserve the current stop-or-not, and see if any of the W
+ # (watch expressions) has changed.
+ my $was_signal = $signal;
+
+ # If we have any watch expressions ...
+ if ( $trace & 2 ) {
+ for ( my $n = 0 ; $n <= $#to_watch ; $n++ ) {
+ $evalarg = $to_watch[$n];
+ local $onetimeDump; # Tell DB::eval() to not output results
+
+ # Fix context DB::eval() wants to return an array, but
+ # we need a scalar here.
+ my ($val) = join( "', '", &eval );
+ $val = ( ( defined $val ) ? "'$val'" : 'undef' );
+
+ # Did it change?
+ if ( $val ne $old_watch[$n] ) {
+
+ # Yep! Show the difference, and fake an interrupt.
+ $signal = 1;
+ print $OUT <<EOP;
+Watchpoint $n:\t$to_watch[$n] changed:
+ old value:\t$old_watch[$n]
+ new value:\t$val
+EOP
+ $old_watch[$n] = $val;
+ } ## end if ($val ne $old_watch...
+ } ## end for (my $n = 0 ; $n <= ...
+ } ## end if ($trace & 2)
+
+=head2 C<watchfunction()>
+
+C<watchfunction()> is a function that can be defined by the user; it is a
+function which will be run on each entry to C<DB::DB>; it gets the
+current package, filename, and line as its parameters.
+
+The watchfunction can do anything it likes; it is executing in the
+debugger's context, so it has access to all of the debugger's internal
+data structures and functions.
+
+C<watchfunction()> can control the debugger's actions. Any of the following
+will cause the debugger to return control to the user's program after
+C<watchfunction()> executes:
+
+=over 4
+
+=item *
+
+Returning a false value from the C<watchfunction()> itself.
+
+=item *
+
+Altering C<$single> to a false value.
+
+=item *
+
+Altering C<$signal> to a false value.
+
+=item *
+
+Turning off the C<4> bit in C<$trace> (this also disables the
+check for C<watchfunction()>. This can be done with
+
+ $trace &= ~4;
+
+=back
+
+=cut
+
+ # If there's a user-defined DB::watchfunction, call it with the
+ # current package, filename, and line. The function executes in
+ # the DB:: package.
+ if ( $trace & 4 ) { # User-installed watch
+ return
+ if watchfunction( $package, $filename, $line )
+ and not $single
+ and not $was_signal
+ and not( $trace & ~4 );
+ } ## end if ($trace & 4)
+
+ # Pick up any alteration to $signal in the watchfunction, and
+ # turn off the signal now.
+ $was_signal = $signal;
+ $signal = 0;
+
+=head2 GETTING READY TO EXECUTE COMMANDS
+
+The debugger decides to take control if single-step mode is on, the
+C<t> command was entered, or the user generated a signal. If the program
+has fallen off the end, we set things up so that entering further commands
+won't cause trouble, and we say that the program is over.
+
+=cut
+
+ # Check to see if we should grab control ($single true,
+ # trace set appropriately, or we got a signal).
+ if ( $single || ( $trace & 1 ) || $was_signal ) {
+
+ # Yes, grab control.
+ if ($slave_editor) {
+
+ # Tell the editor to update its position.
+ $position = "\032\032$filename:$line:0\n";
+ print_lineinfo($position);
+ }
+
+=pod
+
+Special check: if we're in package C<DB::fake>, we've gone through the
+C<END> block at least once. We set up everything so that we can continue
+to enter commands and have a valid context to be in.
+
+=cut
+
+ elsif ( $package eq 'DB::fake' ) {
+
+ # Fallen off the end already.
+ $term || &setterm;
+ print_help(<<EOP);
+Debugged program terminated. Use B<q> to quit or B<R> to restart,
+ use B<o> I<inhibit_exit> to avoid stopping after program termination,
+ B<h q>, B<h R> or B<h o> to get additional info.
+EOP
+
+ # Set the DB::eval context appropriately.
+ $package = 'main';
+ $usercontext =
+ '($@, $!, $^E, $,, $/, $\, $^W) = @saved;'
+ . "package $package;"; # this won't let them modify, alas
+ } ## end elsif ($package eq 'DB::fake')
+
+=pod
+
+If the program hasn't finished executing, we scan forward to the
+next executable line, print that out, build the prompt from the file and line
+number information, and print that.
+
+=cut
+
+ else {
+
+ # Still somewhere in the midst of execution. Set up the
+ # debugger prompt.
+ $sub =~ s/\'/::/; # Swap Perl 4 package separators (') to
+ # Perl 5 ones (sorry, we don't print Klingon
+ #module names)
+
+ $prefix = $sub =~ /::/ ? "" : "${'package'}::";
+ $prefix .= "$sub($filename:";
+ $after = ( $dbline[$line] =~ /\n$/ ? '' : "\n" );
+
+ # Break up the prompt if it's really long.
+ if ( length($prefix) > 30 ) {
+ $position = "$prefix$line):\n$line:\t$dbline[$line]$after";
+ $prefix = "";
+ $infix = ":\t";
+ }
+ else {
+ $infix = "):\t";
+ $position = "$prefix$line$infix$dbline[$line]$after";
+ }
+
+ # Print current line info, indenting if necessary.
+ if ($frame) {
+ print_lineinfo( ' ' x $stack_depth,
+ "$line:\t$dbline[$line]$after" );
+ }
+ else {
+ print_lineinfo($position);
+ }
+
+ # Scan forward, stopping at either the end or the next
+ # unbreakable line.
+ for ( $i = $line + 1 ; $i <= $max && $dbline[$i] == 0 ; ++$i )
+ { #{ vi
+
+ # Drop out on null statements, block closers, and comments.
+ last if $dbline[$i] =~ /^\s*[\;\}\#\n]/;
+
+ # Drop out if the user interrupted us.
+ last if $signal;
+
+ # Append a newline if the line doesn't have one. Can happen
+ # in eval'ed text, for instance.
+ $after = ( $dbline[$i] =~ /\n$/ ? '' : "\n" );
+
+ # Next executable line.
+ $incr_pos = "$prefix$i$infix$dbline[$i]$after";
+ $position .= $incr_pos;
+ if ($frame) {
+
+ # Print it indented if tracing is on.
+ print_lineinfo( ' ' x $stack_depth,
+ "$i:\t$dbline[$i]$after" );
+ }
+ else {
+ print_lineinfo($incr_pos);
+ }
+ } ## end for ($i = $line + 1 ; $i...
+ } ## end else [ if ($slave_editor)
+ } ## end if ($single || ($trace...
+
+=pod
+
+If there's an action to be executed for the line we stopped at, execute it.
+If there are any preprompt actions, execute those as well.
+
+=cut
+
+ # If there's an action, do it now.
+ $evalarg = $action, &eval if $action;
+
+ # Are we nested another level (e.g., did we evaluate a function
+ # that had a breakpoint in it at the debugger prompt)?
+ if ( $single || $was_signal ) {
+
+ # Yes, go down a level.
+ local $level = $level + 1;
+
+ # Do any pre-prompt actions.
+ foreach $evalarg (@$pre) {
+ &eval;
+ }
+
+ # Complain about too much recursion if we passed the limit.
+ print $OUT $stack_depth . " levels deep in subroutine calls!\n"
+ if $single & 4;
+
+ # The line we're currently on. Set $incr to -1 to stay here
+ # until we get a command that tells us to advance.
+ $start = $line;
+ $incr = -1; # for backward motion.
+
+ # Tack preprompt debugger actions ahead of any actual input.
+ @typeahead = ( @$pretype, @typeahead );
+
+=head2 WHERE ARE WE?
+
+XXX Relocate this section?
+
+The debugger normally shows the line corresponding to the current line of
+execution. Sometimes, though, we want to see the next line, or to move elsewhere
+in the file. This is done via the C<$incr>, C<$start>, and C<$max> variables.
+
+C<$incr> controls by how many lines the I<current> line should move forward
+after a command is executed. If set to -1, this indicates that the I<current>
+line shouldn't change.
+
+C<$start> is the I<current> line. It is used for things like knowing where to
+move forwards or backwards from when doing an C<L> or C<-> command.
+
+C<$max> tells the debugger where the last line of the current file is. It's
+used to terminate loops most often.
+
+=head2 THE COMMAND LOOP
+
+Most of C<DB::DB> is actually a command parsing and dispatch loop. It comes
+in two parts:
+
+=over 4
+
+=item *
+
+The outer part of the loop, starting at the C<CMD> label. This loop
+reads a command and then executes it.
+
+=item *
+
+The inner part of the loop, starting at the C<PIPE> label. This part
+is wholly contained inside the C<CMD> block and only executes a command.
+Used to handle commands running inside a pager.
+
+=back
+
+So why have two labels to restart the loop? Because sometimes, it's easier to
+have a command I<generate> another command and then re-execute the loop to do
+the new command. This is faster, but perhaps a bit more convoluted.
+
+=cut
+
+ # The big command dispatch loop. It keeps running until the
+ # user yields up control again.
+ #
+ # If we have a terminal for input, and we get something back
+ # from readline(), keep on processing.
+ CMD:
+ while (
+
+ # We have a terminal, or can get one ...
+ ( $term || &setterm ),
+
+ # ... and it belogs to this PID or we get one for this PID ...
+ ( $term_pid == $$ or resetterm(1) ),
+
+ # ... and we got a line of command input ...
+ defined(
+ $cmd = &readline(
+ "$pidprompt $tid DB"
+ . ( '<' x $level )
+ . ( $#hist + 1 )
+ . ( '>' x $level ) . " "
+ )
+ )
+ )
+ {
+
+ share($cmd);
+ # ... try to execute the input as debugger commands.
+
+ # Don't stop running.
+ $single = 0;
+
+ # No signal is active.
+ $signal = 0;
+
+ # Handle continued commands (ending with \):
+ $cmd =~ s/\\$/\n/ && do {
+ $cmd .= &readline(" cont: ");
+ redo CMD;
+ };
+
+=head4 The null command
+
+A newline entered by itself means I<re-execute the last command>. We grab the
+command out of C<$laststep> (where it was recorded previously), and copy it
+back into C<$cmd> to be executed below. If there wasn't any previous command,
+we'll do nothing below (no command will match). If there was, we also save it
+in the command history and fall through to allow the command parsing to pick
+it up.
+
+=cut
+
+ # Empty input means repeat the last command.
+ $cmd =~ /^$/ && ( $cmd = $laststep );
+ chomp($cmd); # get rid of the annoying extra newline
+ push( @hist, $cmd ) if length($cmd) > 1;
+ push( @truehist, $cmd );
+ share(@hist);
+ share(@truehist);
+
+ # This is a restart point for commands that didn't arrive
+ # via direct user input. It allows us to 'redo PIPE' to
+ # re-execute command processing without reading a new command.
+ PIPE: {
+ $cmd =~ s/^\s+//s; # trim annoying leading whitespace
+ $cmd =~ s/\s+$//s; # trim annoying trailing whitespace
+ ($i) = split( /\s+/, $cmd );
+
+=head3 COMMAND ALIASES
+
+The debugger can create aliases for commands (these are stored in the
+C<%alias> hash). Before a command is executed, the command loop looks it up
+in the alias hash and substitutes the contents of the alias for the command,
+completely replacing it.
+
+=cut
+
+ # See if there's an alias for the command, and set it up if so.
+ if ( $alias{$i} ) {
+
+ # Squelch signal handling; we want to keep control here
+ # if something goes loco during the alias eval.
+ local $SIG{__DIE__};
+ local $SIG{__WARN__};
+
+ # This is a command, so we eval it in the DEBUGGER's
+ # scope! Otherwise, we can't see the special debugger
+ # variables, or get to the debugger's subs. (Well, we
+ # _could_, but why make it even more complicated?)
+ eval "\$cmd =~ $alias{$i}";
+ if ($@) {
+ local $\ = '';
+ print $OUT "Couldn't evaluate `$i' alias: $@";
+ next CMD;
+ }
+ } ## end if ($alias{$i})
+
+=head3 MAIN-LINE COMMANDS
+
+All of these commands work up to and after the program being debugged has
+terminated.
+
+=head4 C<q> - quit
+
+Quit the debugger. This entails setting the C<$fall_off_end> flag, so we don't
+try to execute further, cleaning any restart-related stuff out of the
+environment, and executing with the last value of C<$?>.
+
+=cut
+
+ $cmd =~ /^q$/ && do {
+ $fall_off_end = 1;
+ clean_ENV();
+ exit $?;
+ };
+
+=head4 C<t> - trace
+
+Turn tracing on or off. Inverts the appropriate bit in C<$trace> (q.v.).
+
+=cut
+
+ $cmd =~ /^t$/ && do {
+ $trace ^= 1;
+ local $\ = '';
+ print $OUT "Trace = "
+ . ( ( $trace & 1 ) ? "on" : "off" ) . "\n";
+ next CMD;
+ };
+
+=head4 C<S> - list subroutines matching/not matching a pattern
+
+Walks through C<%sub>, checking to see whether or not to print the name.
+
+=cut
+
+ $cmd =~ /^S(\s+(!)?(.+))?$/ && do {
+
+ $Srev = defined $2; # Reverse scan?
+ $Spatt = $3; # The pattern (if any) to use.
+ $Snocheck = !defined $1; # No args - print all subs.
+
+ # Need to make these sane here.
+ local $\ = '';
+ local $, = '';
+
+ # Search through the debugger's magical hash of subs.
+ # If $nocheck is true, just print the sub name.
+ # Otherwise, check it against the pattern. We then use
+ # the XOR trick to reverse the condition as required.
+ foreach $subname ( sort( keys %sub ) ) {
+ if ( $Snocheck or $Srev ^ ( $subname =~ /$Spatt/ ) ) {
+ print $OUT $subname, "\n";
+ }
+ }
+ next CMD;
+ };
+
+=head4 C<X> - list variables in current package
+
+Since the C<V> command actually processes this, just change this to the
+appropriate C<V> command and fall through.
+
+=cut
+
+ $cmd =~ s/^X\b/V $package/;
+
+=head4 C<V> - list variables
+
+Uses C<dumpvar.pl> to dump out the current values for selected variables.
+
+=cut
+
+ # Bare V commands get the currently-being-debugged package
+ # added.
+ $cmd =~ /^V$/ && do {
+ $cmd = "V $package";
+ };
+
+ # V - show variables in package.
+ $cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do {
+
+ # Save the currently selected filehandle and
+ # force output to debugger's filehandle (dumpvar
+ # just does "print" for output).
+ local ($savout) = select($OUT);
+
+ # Grab package name and variables to dump.
+ $packname = $1;
+ @vars = split( ' ', $2 );
+
+ # If main::dumpvar isn't here, get it.
+ do 'dumpvar.pl' || die $@ unless defined &main::dumpvar;
+ if ( defined &main::dumpvar ) {
+
+ # We got it. Turn off subroutine entry/exit messages
+ # for the moment, along with return values.
+ local $frame = 0;
+ local $doret = -2;
+
+ # must detect sigpipe failures - not catching
+ # then will cause the debugger to die.
+ eval {
+ &main::dumpvar(
+ $packname,
+ defined $option{dumpDepth}
+ ? $option{dumpDepth}
+ : -1, # assume -1 unless specified
+ @vars
+ );
+ };
+
+ # The die doesn't need to include the $@, because
+ # it will automatically get propagated for us.
+ if ($@) {
+ die unless $@ =~ /dumpvar print failed/;
+ }
+ } ## end if (defined &main::dumpvar)
+ else {
+
+ # Couldn't load dumpvar.
+ print $OUT "dumpvar.pl not available.\n";
+ }
+
+ # Restore the output filehandle, and go round again.
+ select($savout);
+ next CMD;
+ };
+
+=head4 C<x> - evaluate and print an expression
+
+Hands the expression off to C<DB::eval>, setting it up to print the value
+via C<dumpvar.pl> instead of just printing it directly.
+
+=cut
+
+ $cmd =~ s/^x\b/ / && do { # Remainder gets done by DB::eval()
+ $onetimeDump = 'dump'; # main::dumpvar shows the output
+
+ # handle special "x 3 blah" syntax XXX propagate
+ # doc back to special variables.
+ if ( $cmd =~ s/^\s*(\d+)(?=\s)/ / ) {
+ $onetimedumpDepth = $1;
+ }
+ };
+
+=head4 C<m> - print methods
+
+Just uses C<DB::methods> to determine what methods are available.
+
+=cut
+
+ $cmd =~ s/^m\s+([\w:]+)\s*$/ / && do {
+ methods($1);
+ next CMD;
+ };
+
+ # m expr - set up DB::eval to do the work
+ $cmd =~ s/^m\b/ / && do { # Rest gets done by DB::eval()
+ $onetimeDump = 'methods'; # method output gets used there
+ };
+
+=head4 C<f> - switch files
+
+=cut
+
+ $cmd =~ /^f\b\s*(.*)/ && do {
+ $file = $1;
+ $file =~ s/\s+$//;
+
+ # help for no arguments (old-style was return from sub).
+ if ( !$file ) {
+ print $OUT
+ "The old f command is now the r command.\n"; # hint
+ print $OUT "The new f command switches filenames.\n";
+ next CMD;
+ } ## end if (!$file)
+
+ # if not in magic file list, try a close match.
+ if ( !defined $main::{ '_<' . $file } ) {
+ if ( ($try) = grep( m#^_<.*$file#, keys %main:: ) ) {
+ {
+ $try = substr( $try, 2 );
+ print $OUT "Choosing $try matching `$file':\n";
+ $file = $try;
+ }
+ } ## end if (($try) = grep(m#^_<.*$file#...
+ } ## end if (!defined $main::{ ...
+
+ # If not successfully switched now, we failed.
+ if ( !defined $main::{ '_<' . $file } ) {
+ print $OUT "No file matching `$file' is loaded.\n";
+ next CMD;
+ }
+
+ # We switched, so switch the debugger internals around.
+ elsif ( $file ne $filename ) {
+ *dbline = $main::{ '_<' . $file };
+ $max = $#dbline;
+ $filename = $file;
+ $start = 1;
+ $cmd = "l";
+ } ## end elsif ($file ne $filename)
+
+ # We didn't switch; say we didn't.
+ else {
+ print $OUT "Already in $file.\n";
+ next CMD;
+ }
+ };
+
+=head4 C<.> - return to last-executed line.
+
+We set C<$incr> to -1 to indicate that the debugger shouldn't move ahead,
+and then we look up the line in the magical C<%dbline> hash.
+
+=cut
+
+ # . command.
+ $cmd =~ /^\.$/ && do {
+ $incr = -1; # stay at current line
+
+ # Reset everything to the old location.
+ $start = $line;
+ $filename = $filename_ini;
+ *dbline = $main::{ '_<' . $filename };
+ $max = $#dbline;
+
+ # Now where are we?
+ print_lineinfo($position);
+ next CMD;
+ };
+
+=head4 C<-> - back one window
+
+We change C<$start> to be one window back; if we go back past the first line,
+we set it to be the first line. We ser C<$incr> to put us back at the
+currently-executing line, and then put a C<l $start +> (list one window from
+C<$start>) in C<$cmd> to be executed later.
+
+=cut
+
+ # - - back a window.
+ $cmd =~ /^-$/ && do {
+
+ # back up by a window; go to 1 if back too far.
+ $start -= $incr + $window + 1;
+ $start = 1 if $start <= 0;
+ $incr = $window - 1;
+
+ # Generate and execute a "l +" command (handled below).
+ $cmd = 'l ' . ($start) . '+';
+ };
+
+=head3 PRE-580 COMMANDS VS. NEW COMMANDS: C<a, A, b, B, h, l, L, M, o, O, P, v, w, W, E<lt>, E<lt>E<lt>, {, {{>
+
+In Perl 5.8.0, a realignment of the commands was done to fix up a number of
+problems, most notably that the default case of several commands destroying
+the user's work in setting watchpoints, actions, etc. We wanted, however, to
+retain the old commands for those who were used to using them or who preferred
+them. At this point, we check for the new commands and call C<cmd_wrapper> to
+deal with them instead of processing them in-line.
+
+=cut
+
+ # All of these commands were remapped in perl 5.8.0;
+ # we send them off to the secondary dispatcher (see below).
+ $cmd =~ /^([aAbBeEhilLMoOPvwW]\b|[<>\{]{1,2})\s*(.*)/so && do {
+ &cmd_wrapper( $1, $2, $line );
+ next CMD;
+ };
+
+=head4 C<y> - List lexicals in higher scope
+
+Uses C<PadWalker> to find the lexicals supplied as arguments in a scope
+above the current one and then displays then using C<dumpvar.pl>.
+
+=cut
+
+ $cmd =~ /^y(?:\s+(\d*)\s*(.*))?$/ && do {
+
+ # See if we've got the necessary support.
+ eval { require PadWalker; PadWalker->VERSION(0.08) }
+ or &warn(
+ $@ =~ /locate/
+ ? "PadWalker module not found - please install\n"
+ : $@
+ )
+ and next CMD;
+
+ # Load up dumpvar if we don't have it. If we can, that is.
+ do 'dumpvar.pl' || die $@ unless defined &main::dumpvar;
+ defined &main::dumpvar
+ or print $OUT "dumpvar.pl not available.\n"
+ and next CMD;
+
+ # Got all the modules we need. Find them and print them.
+ my @vars = split( ' ', $2 || '' );
+
+ # Find the pad.
+ my $h = eval { PadWalker::peek_my( ( $1 || 0 ) + 1 ) };
+
+ # Oops. Can't find it.
+ $@ and $@ =~ s/ at .*//, &warn($@), next CMD;
+
+ # Show the desired vars with dumplex().
+ my $savout = select($OUT);
+
+ # Have dumplex dump the lexicals.
+ dumpvar::dumplex( $_, $h->{$_},
+ defined $option{dumpDepth} ? $option{dumpDepth} : -1,
+ @vars )
+ for sort keys %$h;
+ select($savout);
+ next CMD;
+ };
+
+=head3 COMMANDS NOT WORKING AFTER PROGRAM ENDS
+
+All of the commands below this point don't work after the program being
+debugged has ended. All of them check to see if the program has ended; this
+allows the commands to be relocated without worrying about a 'line of
+demarcation' above which commands can be entered anytime, and below which
+they can't.
+
+=head4 C<n> - single step, but don't trace down into subs
+
+Done by setting C<$single> to 2, which forces subs to execute straight through
+when entered (see C<DB::sub>). We also save the C<n> command in C<$laststep>,
+so a null command knows what to re-execute.
+
+=cut
+
+ # n - next
+ $cmd =~ /^n$/ && do {
+ end_report(), next CMD if $finished and $level <= 1;
+
+ # Single step, but don't enter subs.
+ $single = 2;
+
+ # Save for empty command (repeat last).
+ $laststep = $cmd;
+ last CMD;
+ };
+
+=head4 C<s> - single-step, entering subs
+
+Sets C<$single> to 1, which causes C<DB::sub> to continue tracing inside
+subs. Also saves C<s> as C<$lastcmd>.
+
+=cut
+
+ # s - single step.
+ $cmd =~ /^s$/ && do {
+
+ # Get out and restart the command loop if program
+ # has finished.
+ end_report(), next CMD if $finished and $level <= 1;
+
+ # Single step should enter subs.
+ $single = 1;
+
+ # Save for empty command (repeat last).
+ $laststep = $cmd;
+ last CMD;
+ };
+
+=head4 C<c> - run continuously, setting an optional breakpoint
+
+Most of the code for this command is taken up with locating the optional
+breakpoint, which is either a subroutine name or a line number. We set
+the appropriate one-time-break in C<@dbline> and then turn off single-stepping
+in this and all call levels above this one.
+
+=cut
+
+ # c - start continuous execution.
+ $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do {
+
+ # Hey, show's over. The debugged program finished
+ # executing already.
+ end_report(), next CMD if $finished and $level <= 1;
+
+ # Capture the place to put a one-time break.
+ $subname = $i = $1;
+
+ # Probably not needed, since we finish an interactive
+ # sub-session anyway...
+ # local $filename = $filename;
+ # local *dbline = *dbline; # XXX Would this work?!
+ #
+ # The above question wonders if localizing the alias
+ # to the magic array works or not. Since it's commented
+ # out, we'll just leave that to speculation for now.
+
+ # If the "subname" isn't all digits, we'll assume it
+ # is a subroutine name, and try to find it.
+ if ( $subname =~ /\D/ ) { # subroutine name
+ # Qualify it to the current package unless it's
+ # already qualified.
+ $subname = $package . "::" . $subname
+ unless $subname =~ /::/;
+
+ # find_sub will return "file:line_number" corresponding
+ # to where the subroutine is defined; we call find_sub,
+ # break up the return value, and assign it in one
+ # operation.
+ ( $file, $i ) = ( find_sub($subname) =~ /^(.*):(.*)$/ );
+
+ # Force the line number to be numeric.
+ $i += 0;
+
+ # If we got a line number, we found the sub.
+ if ($i) {
+
+ # Switch all the debugger's internals around so
+ # we're actually working with that file.
+ $filename = $file;
+ *dbline = $main::{ '_<' . $filename };
+
+ # Mark that there's a breakpoint in this file.
+ $had_breakpoints{$filename} |= 1;
+
+ # Scan forward to the first executable line
+ # after the 'sub whatever' line.
+ $max = $#dbline;
+ ++$i while $dbline[$i] == 0 && $i < $max;
+ } ## end if ($i)
+
+ # We didn't find a sub by that name.
+ else {
+ print $OUT "Subroutine $subname not found.\n";
+ next CMD;
+ }
+ } ## end if ($subname =~ /\D/)
+
+ # At this point, either the subname was all digits (an
+ # absolute line-break request) or we've scanned through
+ # the code following the definition of the sub, looking
+ # for an executable, which we may or may not have found.
+ #
+ # If $i (which we set $subname from) is non-zero, we
+ # got a request to break at some line somewhere. On
+ # one hand, if there wasn't any real subroutine name
+ # involved, this will be a request to break in the current
+ # file at the specified line, so we have to check to make
+ # sure that the line specified really is breakable.
+ #
+ # On the other hand, if there was a subname supplied, the
+ # preceding block has moved us to the proper file and
+ # location within that file, and then scanned forward
+ # looking for the next executable line. We have to make
+ # sure that one was found.
+ #
+ # On the gripping hand, we can't do anything unless the
+ # current value of $i points to a valid breakable line.
+ # Check that.
+ if ($i) {
+
+ # Breakable?
+ if ( $dbline[$i] == 0 ) {
+ print $OUT "Line $i not breakable.\n";
+ next CMD;
+ }
+
+ # Yes. Set up the one-time-break sigil.
+ $dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
+ } ## end if ($i)
+
+ # Turn off stack tracing from here up.
+ for ( $i = 0 ; $i <= $stack_depth ; ) {
+ $stack[ $i++ ] &= ~1;
+ }
+ last CMD;
+ };
+
+=head4 C<r> - return from a subroutine
+
+For C<r> to work properly, the debugger has to stop execution again
+immediately after the return is executed. This is done by forcing
+single-stepping to be on in the call level above the current one. If
+we are printing return values when a C<r> is executed, set C<$doret>
+appropriately, and force us out of the command loop.
+
+=cut
+
+ # r - return from the current subroutine.
+ $cmd =~ /^r$/ && do {
+
+ # Can't do anythign if the program's over.
+ end_report(), next CMD if $finished and $level <= 1;
+
+ # Turn on stack trace.
+ $stack[$stack_depth] |= 1;
+
+ # Print return value unless the stack is empty.
+ $doret = $option{PrintRet} ? $stack_depth - 1 : -2;
+ last CMD;
+ };
+
+=head4 C<T> - stack trace
+
+Just calls C<DB::print_trace>.
+
+=cut
+
+ $cmd =~ /^T$/ && do {
+ print_trace( $OUT, 1 ); # skip DB
+ next CMD;
+ };
+
+=head4 C<w> - List window around current line.
+
+Just calls C<DB::cmd_w>.
+
+=cut
+
+ $cmd =~ /^w\b\s*(.*)/s && do { &cmd_w( 'w', $1 ); next CMD; };
+
+=head4 C<W> - watch-expression processing.
+
+Just calls C<DB::cmd_W>.
+
+=cut
+
+ $cmd =~ /^W\b\s*(.*)/s && do { &cmd_W( 'W', $1 ); next CMD; };
+
+=head4 C</> - search forward for a string in the source
+
+We take the argument and treat it as a pattern. If it turns out to be a
+bad one, we return the error we got from trying to C<eval> it and exit.
+If not, we create some code to do the search and C<eval> it so it can't
+mess us up.
+
+=cut
+
+ $cmd =~ /^\/(.*)$/ && do {
+
+ # The pattern as a string.
+ $inpat = $1;
+
+ # Remove the final slash.
+ $inpat =~ s:([^\\])/$:$1:;
+
+ # If the pattern isn't null ...
+ if ( $inpat ne "" ) {
+
+ # Turn of warn and die procesing for a bit.
+ local $SIG{__DIE__};
+ local $SIG{__WARN__};
+
+ # Create the pattern.
+ eval '$inpat =~ m' . "\a$inpat\a";
+ if ( $@ ne "" ) {
+
+ # Oops. Bad pattern. No biscuit.
+ # Print the eval error and go back for more
+ # commands.
+ print $OUT "$@";
+ next CMD;
+ }
+ $pat = $inpat;
+ } ## end if ($inpat ne "")
+
+ # Set up to stop on wrap-around.
+ $end = $start;
+
+ # Don't move off the current line.
+ $incr = -1;
+
+ # Done in eval so nothing breaks if the pattern
+ # does something weird.
+ eval '
+ for (;;) {
+ # Move ahead one line.
+ ++$start;
+
+ # Wrap if we pass the last line.
+ $start = 1 if ($start > $max);
+
+ # Stop if we have gotten back to this line again,
+ last if ($start == $end);
+
+ # A hit! (Note, though, that we are doing
+ # case-insensitive matching. Maybe a qr//
+ # expression would be better, so the user could
+ # do case-sensitive matching if desired.
+ if ($dbline[$start] =~ m' . "\a$pat\a" . 'i) {
+ if ($slave_editor) {
+ # Handle proper escaping in the slave.
+ print $OUT "\032\032$filename:$start:0\n";
+ }
+ else {
+ # Just print the line normally.
+ print $OUT "$start:\t",$dbline[$start],"\n";
+ }
+ # And quit since we found something.
+ last;
+ }
+ } ';
+
+ # If we wrapped, there never was a match.
+ print $OUT "/$pat/: not found\n" if ( $start == $end );
+ next CMD;
+ };
+
+=head4 C<?> - search backward for a string in the source
+
+Same as for C</>, except the loop runs backwards.
+
+=cut
+
+ # ? - backward pattern search.
+ $cmd =~ /^\?(.*)$/ && do {
+
+ # Get the pattern, remove trailing question mark.
+ $inpat = $1;
+ $inpat =~ s:([^\\])\?$:$1:;
+
+ # If we've got one ...
+ if ( $inpat ne "" ) {
+
+ # Turn off die & warn handlers.
+ local $SIG{__DIE__};
+ local $SIG{__WARN__};
+ eval '$inpat =~ m' . "\a$inpat\a";
+
+ if ( $@ ne "" ) {
+
+ # Ouch. Not good. Print the error.
+ print $OUT $@;
+ next CMD;
+ }
+ $pat = $inpat;
+ } ## end if ($inpat ne "")
+
+ # Where we are now is where to stop after wraparound.
+ $end = $start;
+
+ # Don't move away from this line.
+ $incr = -1;
+
+ # Search inside the eval to prevent pattern badness
+ # from killing us.
+ eval '
+ for (;;) {
+ # Back up a line.
+ --$start;
+
+ # Wrap if we pass the first line.
+
+ $start = $max if ($start <= 0);
+
+ # Quit if we get back where we started,
+ last if ($start == $end);
+
+ # Match?
+ if ($dbline[$start] =~ m' . "\a$pat\a" . 'i) {
+ if ($slave_editor) {
+ # Yep, follow slave editor requirements.
+ print $OUT "\032\032$filename:$start:0\n";
+ }
+ else {
+ # Yep, just print normally.
+ print $OUT "$start:\t",$dbline[$start],"\n";
+ }
+
+ # Found, so done.
+ last;
+ }
+ } ';
+
+ # Say we failed if the loop never found anything,
+ print $OUT "?$pat?: not found\n" if ( $start == $end );
+ next CMD;
+ };
+
+=head4 C<$rc> - Recall command
+
+Manages the commands in C<@hist> (which is created if C<Term::ReadLine> reports
+that the terminal supports history). It find the the command required, puts it
+into C<$cmd>, and redoes the loop to execute it.
+
+=cut
+
+ # $rc - recall command.
+ $cmd =~ /^$rc+\s*(-)?(\d+)?$/ && do {
+
+ # No arguments, take one thing off history.
+ pop(@hist) if length($cmd) > 1;
+
+ # Relative (- found)?
+ # Y - index back from most recent (by 1 if bare minus)
+ # N - go to that particular command slot or the last
+ # thing if nothing following.
+ $i = $1 ? ( $#hist - ( $2 || 1 ) ) : ( $2 || $#hist );
+
+ # Pick out the command desired.
+ $cmd = $hist[$i];
+
+ # Print the command to be executed and restart the loop
+ # with that command in the buffer.
+ print $OUT $cmd, "\n";
+ redo CMD;
+ };
+
+=head4 C<$sh$sh> - C<system()> command
+
+Calls the C<DB::system()> to handle the command. This keeps the C<STDIN> and
+C<STDOUT> from getting messed up.
+
+=cut
+
+ # $sh$sh - run a shell command (if it's all ASCII).
+ # Can't run shell commands with Unicode in the debugger, hmm.
+ $cmd =~ /^$sh$sh\s*([\x00-\xff]*)/ && do {
+
+ # System it.
+ &system($1);
+ next CMD;
+ };
+
+=head4 C<$rc I<pattern> $rc> - Search command history
+
+Another command to manipulate C<@hist>: this one searches it with a pattern.
+If a command is found, it is placed in C<$cmd> and executed via C<redo>.
+
+=cut
+
+ # $rc pattern $rc - find a command in the history.
+ $cmd =~ /^$rc([^$rc].*)$/ && do {
+
+ # Create the pattern to use.
+ $pat = "^$1";
+
+ # Toss off last entry if length is >1 (and it always is).
+ pop(@hist) if length($cmd) > 1;
+
+ # Look backward through the history.
+ for ( $i = $#hist ; $i ; --$i ) {
+
+ # Stop if we find it.
+ last if $hist[$i] =~ /$pat/;
+ }
+
+ if ( !$i ) {
+
+ # Never found it.
+ print $OUT "No such command!\n\n";
+ next CMD;
+ }
+
+ # Found it. Put it in the buffer, print it, and process it.
+ $cmd = $hist[$i];
+ print $OUT $cmd, "\n";
+ redo CMD;
+ };
+
+=head4 C<$sh> - Invoke a shell
+
+Uses C<DB::system> to invoke a shell.
+
+=cut
+
+ # $sh - start a shell.
+ $cmd =~ /^$sh$/ && do {
+
+ # Run the user's shell. If none defined, run Bourne.
+ # We resume execution when the shell terminates.
+ &system( $ENV{SHELL} || "/bin/sh" );
+ next CMD;
+ };
+
+=head4 C<$sh I<command>> - Force execution of a command in a shell
+
+Like the above, but the command is passed to the shell. Again, we use
+C<DB::system> to avoid problems with C<STDIN> and C<STDOUT>.
+
+=cut
+
+ # $sh command - start a shell and run a command in it.
+ $cmd =~ /^$sh\s*([\x00-\xff]*)/ && do {
+
+ # XXX: using csh or tcsh destroys sigint retvals!
+ #&system($1); # use this instead
+
+ # use the user's shell, or Bourne if none defined.
+ &system( $ENV{SHELL} || "/bin/sh", "-c", $1 );
+ next CMD;
+ };
+
+=head4 C<H> - display commands in history
+
+Prints the contents of C<@hist> (if any).
+
+=cut
+
+ $cmd =~ /^H\b\s*\*/ && do {
+ @hist = @truehist = ();
+ print $OUT "History cleansed\n";
+ next CMD;
+ };
+
+ $cmd =~ /^H\b\s*(-(\d+))?/ && do {
+
+ # Anything other than negative numbers is ignored by
+ # the (incorrect) pattern, so this test does nothing.
+ $end = $2 ? ( $#hist - $2 ) : 0;
+
+ # Set to the minimum if less than zero.
+ $hist = 0 if $hist < 0;
+
+ # Start at the end of the array.
+ # Stay in while we're still above the ending value.
+ # Tick back by one each time around the loop.
+ for ( $i = $#hist ; $i > $end ; $i-- ) {
+
+ # Print the command unless it has no arguments.
+ print $OUT "$i: ", $hist[$i], "\n"
+ unless $hist[$i] =~ /^.?$/;
+ }
+ next CMD;
+ };
+
+=head4 C<man, doc, perldoc> - look up documentation
+
+Just calls C<runman()> to print the appropriate document.
+
+=cut
+
+ # man, perldoc, doc - show manual pages.
+ $cmd =~ /^(?:man|(?:perl)?doc)\b(?:\s+([^(]*))?$/ && do {
+ runman($1);
+ next CMD;
+ };
+
+=head4 C<p> - print
+
+Builds a C<print EXPR> expression in the C<$cmd>; this will get executed at
+the bottom of the loop.
+
+=cut
+
+ # p - print (no args): print $_.
+ $cmd =~ s/^p$/print {\$DB::OUT} \$_/;
+
+ # p - print the given expression.
+ $cmd =~ s/^p\b/print {\$DB::OUT} /;
+
+=head4 C<=> - define command alias
+
+Manipulates C<%alias> to add or list command aliases.
+
+=cut
+
+ # = - set up a command alias.
+ $cmd =~ s/^=\s*// && do {
+ my @keys;
+ if ( length $cmd == 0 ) {
+
+ # No args, get current aliases.
+ @keys = sort keys %alias;
+ }
+ elsif ( my ( $k, $v ) = ( $cmd =~ /^(\S+)\s+(\S.*)/ ) ) {
+
+ # Creating a new alias. $k is alias name, $v is
+ # alias value.
+
+ # can't use $_ or kill //g state
+ for my $x ( $k, $v ) {
+
+ # Escape "alarm" characters.
+ $x =~ s/\a/\\a/g;
+ }
+
+ # Substitute key for value, using alarm chars
+ # as separators (which is why we escaped them in
+ # the command).
+ $alias{$k} = "s\a$k\a$v\a";
+
+ # Turn off standard warn and die behavior.
+ local $SIG{__DIE__};
+ local $SIG{__WARN__};
+
+ # Is it valid Perl?
+ unless ( eval "sub { s\a$k\a$v\a }; 1" ) {
+
+ # Nope. Bad alias. Say so and get out.
+ print $OUT "Can't alias $k to $v: $@\n";
+ delete $alias{$k};
+ next CMD;
+ }
+
+ # We'll only list the new one.
+ @keys = ($k);
+ } ## end elsif (my ($k, $v) = ($cmd...
+
+ # The argument is the alias to list.
+ else {
+ @keys = ($cmd);
+ }
+
+ # List aliases.
+ for my $k (@keys) {
+
+ # Messy metaquoting: Trim the substiution code off.
+ # We use control-G as the delimiter because it's not
+ # likely to appear in the alias.
+ if ( ( my $v = $alias{$k} ) =~ ss\a$k\a(.*)\a$1 ) {
+
+ # Print the alias.
+ print $OUT "$k\t= $1\n";
+ }
+ elsif ( defined $alias{$k} ) {
+
+ # Couldn't trim it off; just print the alias code.
+ print $OUT "$k\t$alias{$k}\n";
+ }
+ else {
+
+ # No such, dude.
+ print "No alias for $k\n";
+ }
+ } ## end for my $k (@keys)
+ next CMD;
+ };
+
+=head4 C<source> - read commands from a file.
+
+Opens a lexical filehandle and stacks it on C<@cmdfhs>; C<DB::readline> will
+pick it up.
+
+=cut
+
+ # source - read commands from a file (or pipe!) and execute.
+ $cmd =~ /^source\s+(.*\S)/ && do {
+ if ( open my $fh, $1 ) {
+
+ # Opened OK; stick it in the list of file handles.
+ push @cmdfhs, $fh;
+ }
+ else {
+
+ # Couldn't open it.
+ &warn("Can't execute `$1': $!\n");
+ }
+ next CMD;
+ };
+
+=head4 C<save> - send current history to a file
+
+Takes the complete history, (not the shrunken version you see with C<H>),
+and saves it to the given filename, so it can be replayed using C<source>.
+
+Note that all C<^(save|source)>'s are commented out with a view to minimise recursion.
+
+=cut
+
+ # save source - write commands to a file for later use
+ $cmd =~ /^save\s*(.*)$/ && do {
+ my $file = $1 || '.perl5dbrc'; # default?
+ if ( open my $fh, "> $file" ) {
+
+ # chomp to remove extraneous newlines from source'd files
+ chomp( my @truelist =
+ map { m/^\s*(save|source)/ ? "#$_" : $_ }
+ @truehist );
+ print $fh join( "\n", @truelist );
+ print "commands saved in $file\n";
+ }
+ else {
+ &warn("Can't save debugger commands in '$1': $!\n");
+ }
+ next CMD;
+ };
+
+=head4 C<R> - restart
+
+Restart the debugger session.
+
+=head4 C<rerun> - rerun the current session
+
+Return to any given position in the B<true>-history list
+
+=cut
+
+ # R - restart execution.
+ # rerun - controlled restart execution.
+ $cmd =~ /^(R|rerun\s*(.*))$/ && do {
+ my @args = ($1 eq 'R' ? restart() : rerun($2));
+
+ # Close all non-system fds for a clean restart. A more
+ # correct method would be to close all fds that were not
+ # open when the process started, but this seems to be
+ # hard. See "debugger 'R'estart and open database
+ # connections" on p5p.
+
+ my $max_fd = 1024; # default if POSIX can't be loaded
+ if (eval { require POSIX }) {
+ $max_fd = POSIX::sysconf(POSIX::_SC_OPEN_MAX());
+ }
+
+ if (defined $max_fd) {
+ foreach ($^F+1 .. $max_fd-1) {
+ next unless open FD_TO_CLOSE, "<&=$_";
+ close(FD_TO_CLOSE);
+ }
+ }
+
+ # And run Perl again. We use exec() to keep the
+ # PID stable (and that way $ini_pids is still valid).
+ exec(@args) || print $OUT "exec failed: $!\n";
+
+ last CMD;
+ };
+
+=head4 C<|, ||> - pipe output through the pager.
+
+For C<|>, we save C<OUT> (the debugger's output filehandle) and C<STDOUT>
+(the program's standard output). For C<||>, we only save C<OUT>. We open a
+pipe to the pager (restoring the output filehandles if this fails). If this
+is the C<|> command, we also set up a C<SIGPIPE> handler which will simply
+set C<$signal>, sending us back into the debugger.
+
+We then trim off the pipe symbols and C<redo> the command loop at the
+C<PIPE> label, causing us to evaluate the command in C<$cmd> without
+reading another.
+
+=cut
+
+ # || - run command in the pager, with output to DB::OUT.
+ $cmd =~ /^\|\|?\s*[^|]/ && do {
+ if ( $pager =~ /^\|/ ) {
+
+ # Default pager is into a pipe. Redirect I/O.
+ open( SAVEOUT, ">&STDOUT" )
+ || &warn("Can't save STDOUT");
+ open( STDOUT, ">&OUT" )
+ || &warn("Can't redirect STDOUT");
+ } ## end if ($pager =~ /^\|/)
+ else {
+
+ # Not into a pipe. STDOUT is safe.
+ open( SAVEOUT, ">&OUT" ) || &warn("Can't save DB::OUT");
+ }
+
+ # Fix up environment to record we have less if so.
+ fix_less();
+
+ unless ( $piped = open( OUT, $pager ) ) {
+
+ # Couldn't open pipe to pager.
+ &warn("Can't pipe output to `$pager'");
+ if ( $pager =~ /^\|/ ) {
+
+ # Redirect I/O back again.
+ open( OUT, ">&STDOUT" ) # XXX: lost message
+ || &warn("Can't restore DB::OUT");
+ open( STDOUT, ">&SAVEOUT" )
+ || &warn("Can't restore STDOUT");
+ close(SAVEOUT);
+ } ## end if ($pager =~ /^\|/)
+ else {
+
+ # Redirect I/O. STDOUT already safe.
+ open( OUT, ">&STDOUT" ) # XXX: lost message
+ || &warn("Can't restore DB::OUT");
+ }
+ next CMD;
+ } ## end unless ($piped = open(OUT,...
+
+ # Set up broken-pipe handler if necessary.
+ $SIG{PIPE} = \&DB::catch
+ if $pager =~ /^\|/
+ && ( "" eq $SIG{PIPE} || "DEFAULT" eq $SIG{PIPE} );
+
+ # Save current filehandle, unbuffer out, and put it back.
+ $selected = select(OUT);
+ $| = 1;
+
+ # Don't put it back if pager was a pipe.
+ select($selected), $selected = "" unless $cmd =~ /^\|\|/;
+
+ # Trim off the pipe symbols and run the command now.
+ $cmd =~ s/^\|+\s*//;
+ redo PIPE;
+ };
+
+=head3 END OF COMMAND PARSING
+
+Anything left in C<$cmd> at this point is a Perl expression that we want to
+evaluate. We'll always evaluate in the user's context, and fully qualify
+any variables we might want to address in the C<DB> package.
+
+=cut
+
+ # t - turn trace on.
+ $cmd =~ s/^t\s/\$DB::trace |= 1;\n/;
+
+ # s - single-step. Remember the last command was 's'.
+ $cmd =~ s/^s\s/\$DB::single = 1;\n/ && do { $laststep = 's' };
+
+ # n - single-step, but not into subs. Remember last command
+ # was 'n'.
+ $cmd =~ s/^n\s/\$DB::single = 2;\n/ && do { $laststep = 'n' };
+
+ } # PIPE:
+
+ # Make sure the flag that says "the debugger's running" is
+ # still on, to make sure we get control again.
+ $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd";
+
+ # Run *our* eval that executes in the caller's context.
+ &eval;
+
+ # Turn off the one-time-dump stuff now.
+ if ($onetimeDump) {
+ $onetimeDump = undef;
+ $onetimedumpDepth = undef;
+ }
+ elsif ( $term_pid == $$ ) {
+ eval { # May run under miniperl, when not available...
+ STDOUT->flush();
+ STDERR->flush();
+ };
+
+ # XXX If this is the master pid, print a newline.
+ print $OUT "\n";
+ }
+ } ## end while (($term || &setterm...
+
+=head3 POST-COMMAND PROCESSING
+
+After each command, we check to see if the command output was piped anywhere.
+If so, we go through the necessary code to unhook the pipe and go back to
+our standard filehandles for input and output.
+
+=cut
+
+ continue { # CMD:
+
+ # At the end of every command:
+ if ($piped) {
+
+ # Unhook the pipe mechanism now.
+ if ( $pager =~ /^\|/ ) {
+
+ # No error from the child.
+ $? = 0;
+
+ # we cannot warn here: the handle is missing --tchrist
+ close(OUT) || print SAVEOUT "\nCan't close DB::OUT\n";
+
+ # most of the $? crud was coping with broken cshisms
+ # $? is explicitly set to 0, so this never runs.
+ if ($?) {
+ print SAVEOUT "Pager `$pager' failed: ";
+ if ( $? == -1 ) {
+ print SAVEOUT "shell returned -1\n";
+ }
+ elsif ( $? >> 8 ) {
+ print SAVEOUT ( $? & 127 )
+ ? " (SIG#" . ( $? & 127 ) . ")"
+ : "", ( $? & 128 ) ? " -- core dumped" : "", "\n";
+ }
+ else {
+ print SAVEOUT "status ", ( $? >> 8 ), "\n";
+ }
+ } ## end if ($?)
+
+ # Reopen filehandle for our output (if we can) and
+ # restore STDOUT (if we can).
+ open( OUT, ">&STDOUT" ) || &warn("Can't restore DB::OUT");
+ open( STDOUT, ">&SAVEOUT" )
+ || &warn("Can't restore STDOUT");
+
+ # Turn off pipe exception handler if necessary.
+ $SIG{PIPE} = "DEFAULT" if $SIG{PIPE} eq \&DB::catch;
+
+ # Will stop ignoring SIGPIPE if done like nohup(1)
+ # does SIGINT but Perl doesn't give us a choice.
+ } ## end if ($pager =~ /^\|/)
+ else {
+
+ # Non-piped "pager". Just restore STDOUT.
+ open( OUT, ">&SAVEOUT" ) || &warn("Can't restore DB::OUT");
+ }
+
+ # Close filehandle pager was using, restore the normal one
+ # if necessary,
+ close(SAVEOUT);
+ select($selected), $selected = "" unless $selected eq "";
+
+ # No pipes now.
+ $piped = "";
+ } ## end if ($piped)
+ } # CMD:
+
+=head3 COMMAND LOOP TERMINATION
+
+When commands have finished executing, we come here. If the user closed the
+input filehandle, we turn on C<$fall_off_end> to emulate a C<q> command. We
+evaluate any post-prompt items. We restore C<$@>, C<$!>, C<$^E>, C<$,>, C<$/>,
+C<$\>, and C<$^W>, and return a null list as expected by the Perl interpreter.
+The interpreter will then execute the next line and then return control to us
+again.
+
+=cut
+
+ # No more commands? Quit.
+ $fall_off_end = 1 unless defined $cmd; # Emulate `q' on EOF
+
+ # Evaluate post-prompt commands.
+ foreach $evalarg (@$post) {
+ &eval;
+ }
+ } # if ($single || $signal)
+
+ # Put the user's globals back where you found them.
+ ( $@, $!, $^E, $,, $/, $\, $^W ) = @saved;
+ ();
+} ## end sub DB
+
+# The following code may be executed now:
+# BEGIN {warn 4}
+
+=head2 sub
+
+C<sub> is called whenever a subroutine call happens in the program being
+debugged. The variable C<$DB::sub> contains the name of the subroutine
+being called.
+
+The core function of this subroutine is to actually call the sub in the proper
+context, capturing its output. This of course causes C<DB::DB> to get called
+again, repeating until the subroutine ends and returns control to C<DB::sub>
+again. Once control returns, C<DB::sub> figures out whether or not to dump the
+return value, and returns its captured copy of the return value as its own
+return value. The value then feeds back into the program being debugged as if
+C<DB::sub> hadn't been there at all.
+
+C<sub> does all the work of printing the subroutine entry and exit messages
+enabled by setting C<$frame>. It notes what sub the autoloader got called for,
+and also prints the return value if needed (for the C<r> command and if
+the 16 bit is set in C<$frame>).
+
+It also tracks the subroutine call depth by saving the current setting of
+C<$single> in the C<@stack> package global; if this exceeds the value in
+C<$deep>, C<sub> automatically turns on printing of the current depth by
+setting the C<4> bit in C<$single>. In any case, it keeps the current setting
+of stop/don't stop on entry to subs set as it currently is set.
+
+=head3 C<caller()> support
+
+If C<caller()> is called from the package C<DB>, it provides some
+additional data, in the following order:
+
+=over 4
+
+=item * C<$package>
+
+The package name the sub was in
+
+=item * C<$filename>
+
+The filename it was defined in
+
+=item * C<$line>
+
+The line number it was defined on
+
+=item * C<$subroutine>
+
+The subroutine name; C<(eval)> if an C<eval>().
+
+=item * C<$hasargs>
+
+1 if it has arguments, 0 if not
+
+=item * C<$wantarray>
+
+1 if array context, 0 if scalar context
+
+=item * C<$evaltext>
+
+The C<eval>() text, if any (undefined for C<eval BLOCK>)
+
+=item * C<$is_require>
+
+frame was created by a C<use> or C<require> statement
+
+=item * C<$hints>
+
+pragma information; subject to change between versions
+
+=item * C<$bitmask>
+
+pragma information; subject to change between versions
+
+=item * C<@DB::args>
+
+arguments with which the subroutine was invoked
+
+=back
+
+=cut
+
+sub sub {
+ # Do not use a regex in this subroutine -> results in corrupted memory
+ # See: [perl #66110]
+
+ # lock ourselves under threads
+ lock($DBGR);
+
+ # Whether or not the autoloader was running, a scalar to put the
+ # sub's return value in (if needed), and an array to put the sub's
+ # return value in (if needed).
+ my ( $al, $ret, @ret ) = "";
+ if ($sub eq 'threads::new' && $ENV{PERL5DB_THREADED}) {
+ print "creating new thread\n";
+ }
+
+ # If the last ten characters are '::AUTOLOAD', note we've traced
+ # into AUTOLOAD for $sub.
+ if ( length($sub) > 10 && substr( $sub, -10, 10 ) eq '::AUTOLOAD' ) {
+ $al = " for $$sub" if defined $$sub;
+ }
+
+ # We stack the stack pointer and then increment it to protect us
+ # from a situation that might unwind a whole bunch of call frames
+ # at once. Localizing the stack pointer means that it will automatically
+ # unwind the same amount when multiple stack frames are unwound.
+ local $stack_depth = $stack_depth + 1; # Protect from non-local exits
+
+ # Expand @stack.
+ $#stack = $stack_depth;
+
+ # Save current single-step setting.
+ $stack[-1] = $single;
+
+ # Turn off all flags except single-stepping.
+ $single &= 1;
+
+ # If we've gotten really deeply recursed, turn on the flag that will
+ # make us stop with the 'deep recursion' message.
+ $single |= 4 if $stack_depth == $deep;
+
+ # If frame messages are on ...
+ (
+ $frame & 4 # Extended frame entry message
+ ? (
+ print_lineinfo( ' ' x ( $stack_depth - 1 ), "in " ),
+
+ # Why -1? But it works! :-(
+ # Because print_trace will call add 1 to it and then call
+ # dump_trace; this results in our skipping -1+1 = 0 stack frames
+ # in dump_trace.
+ print_trace( $LINEINFO, -1, 1, 1, "$sub$al" )
+ )
+ : print_lineinfo( ' ' x ( $stack_depth - 1 ), "entering $sub$al\n" )
+
+ # standard frame entry message
+ )
+ if $frame;
+
+ # Determine the sub's return type,and capture approppriately.
+ if (wantarray) {
+
+ # Called in array context. call sub and capture output.
+ # DB::DB will recursively get control again if appropriate; we'll come
+ # back here when the sub is finished.
+ @ret = &$sub;
+
+ # Pop the single-step value back off the stack.
+ $single |= $stack[ $stack_depth-- ];
+
+ # Check for exit trace messages...
+ (
+ $frame & 4 # Extended exit message
+ ? (
+ print_lineinfo( ' ' x $stack_depth, "out " ),
+ print_trace( $LINEINFO, -1, 1, 1, "$sub$al" )
+ )
+ : print_lineinfo( ' ' x $stack_depth, "exited $sub$al\n" )
+
+ # Standard exit message
+ )
+ if $frame & 2;
+
+ # Print the return info if we need to.
+ if ( $doret eq $stack_depth or $frame & 16 ) {
+
+ # Turn off output record separator.
+ local $\ = '';
+ my $fh = ( $doret eq $stack_depth ? $OUT : $LINEINFO );
+
+ # Indent if we're printing because of $frame tracing.
+ print $fh ' ' x $stack_depth if $frame & 16;
+
+ # Print the return value.
+ print $fh "list context return from $sub:\n";
+ dumpit( $fh, \@ret );
+
+ # And don't print it again.
+ $doret = -2;
+ } ## end if ($doret eq $stack_depth...
+ # And we have to return the return value now.
+ @ret;
+ } ## end if (wantarray)
+
+ # Scalar context.
+ else {
+ if ( defined wantarray ) {
+
+ # Save the value if it's wanted at all.
+ $ret = &$sub;
+ }
+ else {
+
+ # Void return, explicitly.
+ &$sub;
+ undef $ret;
+ }
+
+ # Pop the single-step value off the stack.
+ $single |= $stack[ $stack_depth-- ];
+
+ # If we're doing exit messages...
+ (
+ $frame & 4 # Extended messsages
+ ? (
+ print_lineinfo( ' ' x $stack_depth, "out " ),
+ print_trace( $LINEINFO, -1, 1, 1, "$sub$al" )
+ )
+ : print_lineinfo( ' ' x $stack_depth, "exited $sub$al\n" )
+
+ # Standard messages
+ )
+ if $frame & 2;
+
+ # If we are supposed to show the return value... same as before.
+ if ( $doret eq $stack_depth or $frame & 16 and defined wantarray ) {
+ local $\ = '';
+ my $fh = ( $doret eq $stack_depth ? $OUT : $LINEINFO );
+ print $fh ( ' ' x $stack_depth ) if $frame & 16;
+ print $fh (
+ defined wantarray
+ ? "scalar context return from $sub: "
+ : "void context return from $sub\n"
+ );
+ dumpit( $fh, $ret ) if defined wantarray;
+ $doret = -2;
+ } ## end if ($doret eq $stack_depth...
+
+ # Return the appropriate scalar value.
+ $ret;
+ } ## end else [ if (wantarray)
+} ## end sub sub
+
+sub lsub : lvalue {
+
+ # lock ourselves under threads
+ lock($DBGR);
+
+ # Whether or not the autoloader was running, a scalar to put the
+ # sub's return value in (if needed), and an array to put the sub's
+ # return value in (if needed).
+ my ( $al, $ret, @ret ) = "";
+ if ($sub =~ /^threads::new$/ && $ENV{PERL5DB_THREADED}) {
+ print "creating new thread\n";
+ }
+
+ # If the last ten characters are C'::AUTOLOAD', note we've traced
+ # into AUTOLOAD for $sub.
+ if ( length($sub) > 10 && substr( $sub, -10, 10 ) eq '::AUTOLOAD' ) {
+ $al = " for $$sub";
+ }
+
+ # We stack the stack pointer and then increment it to protect us
+ # from a situation that might unwind a whole bunch of call frames
+ # at once. Localizing the stack pointer means that it will automatically
+ # unwind the same amount when multiple stack frames are unwound.
+ local $stack_depth = $stack_depth + 1; # Protect from non-local exits
+
+ # Expand @stack.
+ $#stack = $stack_depth;
+
+ # Save current single-step setting.
+ $stack[-1] = $single;
+
+ # Turn off all flags except single-stepping.
+ $single &= 1;
+
+ # If we've gotten really deeply recursed, turn on the flag that will
+ # make us stop with the 'deep recursion' message.
+ $single |= 4 if $stack_depth == $deep;
+
+ # If frame messages are on ...
+ (
+ $frame & 4 # Extended frame entry message
+ ? (
+ print_lineinfo( ' ' x ( $stack_depth - 1 ), "in " ),
+
+ # Why -1? But it works! :-(
+ # Because print_trace will call add 1 to it and then call
+ # dump_trace; this results in our skipping -1+1 = 0 stack frames
+ # in dump_trace.
+ print_trace( $LINEINFO, -1, 1, 1, "$sub$al" )
+ )
+ : print_lineinfo( ' ' x ( $stack_depth - 1 ), "entering $sub$al\n" )
+
+ # standard frame entry message
+ )
+ if $frame;
+
+ # Pop the single-step value back off the stack.
+ $single |= $stack[ $stack_depth-- ];
+
+ # call the original lvalue sub.
+ &$sub;
+}
+
+=head1 EXTENDED COMMAND HANDLING AND THE COMMAND API
+
+In Perl 5.8.0, there was a major realignment of the commands and what they did,
+Most of the changes were to systematize the command structure and to eliminate
+commands that threw away user input without checking.
+
+The following sections describe the code added to make it easy to support
+multiple command sets with conflicting command names. This section is a start
+at unifying all command processing to make it simpler to develop commands.
+
+Note that all the cmd_[a-zA-Z] subroutines require the command name, a line
+number, and C<$dbline> (the current line) as arguments.
+
+Support functions in this section which have multiple modes of failure C<die>
+on error; the rest simply return a false value.
+
+The user-interface functions (all of the C<cmd_*> functions) just output
+error messages.
+
+=head2 C<%set>
+
+The C<%set> hash defines the mapping from command letter to subroutine
+name suffix.
+
+C<%set> is a two-level hash, indexed by set name and then by command name.
+Note that trying to set the CommandSet to C<foobar> simply results in the
+5.8.0 command set being used, since there's no top-level entry for C<foobar>.
+
+=cut
+
+### The API section
+
+my %set = ( #
+ 'pre580' => {
+ 'a' => 'pre580_a',
+ 'A' => 'pre580_null',
+ 'b' => 'pre580_b',
+ 'B' => 'pre580_null',
+ 'd' => 'pre580_null',
+ 'D' => 'pre580_D',
+ 'h' => 'pre580_h',
+ 'M' => 'pre580_null',
+ 'O' => 'o',
+ 'o' => 'pre580_null',
+ 'v' => 'M',
+ 'w' => 'v',
+ 'W' => 'pre580_W',
+ },
+ 'pre590' => {
+ '<' => 'pre590_prepost',
+ '<<' => 'pre590_prepost',
+ '>' => 'pre590_prepost',
+ '>>' => 'pre590_prepost',
+ '{' => 'pre590_prepost',
+ '{{' => 'pre590_prepost',
+ },
+);
+
+=head2 C<cmd_wrapper()> (API)
+
+C<cmd_wrapper()> allows the debugger to switch command sets
+depending on the value of the C<CommandSet> option.
+
+It tries to look up the command in the C<%set> package-level I<lexical>
+(which means external entities can't fiddle with it) and create the name of
+the sub to call based on the value found in the hash (if it's there). I<All>
+of the commands to be handled in a set have to be added to C<%set>; if they
+aren't found, the 5.8.0 equivalent is called (if there is one).
+
+This code uses symbolic references.
+
+=cut
+
+sub cmd_wrapper {
+ my $cmd = shift;
+ my $line = shift;
+ my $dblineno = shift;
+
+ # Assemble the command subroutine's name by looking up the
+ # command set and command name in %set. If we can't find it,
+ # default to the older version of the command.
+ my $call = 'cmd_'
+ . ( $set{$CommandSet}{$cmd}
+ || ( $cmd =~ /^[<>{]+/o ? 'prepost' : $cmd ) );
+
+ # Call the command subroutine, call it by name.
+ return &$call( $cmd, $line, $dblineno );
+} ## end sub cmd_wrapper
+
+=head3 C<cmd_a> (command)
+
+The C<a> command handles pre-execution actions. These are associated with a
+particular line, so they're stored in C<%dbline>. We default to the current
+line if none is specified.
+
+=cut
+
+sub cmd_a {
+ my $cmd = shift;
+ my $line = shift || ''; # [.|line] expr
+ my $dbline = shift;
+
+ # If it's dot (here), or not all digits, use the current line.
+ $line =~ s/^(\.|(?:[^\d]))/$dbline/;
+
+ # Should be a line number followed by an expression.
+ if ( $line =~ /^\s*(\d*)\s*(\S.+)/ ) {
+ my ( $lineno, $expr ) = ( $1, $2 );
+
+ # If we have an expression ...
+ if ( length $expr ) {
+
+ # ... but the line isn't breakable, complain.
+ if ( $dbline[$lineno] == 0 ) {
+ print $OUT
+ "Line $lineno($dbline[$lineno]) does not have an action?\n";
+ }
+ else {
+
+ # It's executable. Record that the line has an action.
+ $had_breakpoints{$filename} |= 2;
+
+ # Remove any action, temp breakpoint, etc.
+ $dbline{$lineno} =~ s/\0[^\0]*//;
+
+ # Add the action to the line.
+ $dbline{$lineno} .= "\0" . action($expr);
+ }
+ } ## end if (length $expr)
+ } ## end if ($line =~ /^\s*(\d*)\s*(\S.+)/)
+ else {
+
+ # Syntax wrong.
+ print $OUT
+ "Adding an action requires an optional lineno and an expression\n"
+ ; # hint
+ }
+} ## end sub cmd_a
+
+=head3 C<cmd_A> (command)
+
+Delete actions. Similar to above, except the delete code is in a separate
+subroutine, C<delete_action>.
+
+=cut
+
+sub cmd_A {
+ my $cmd = shift;
+ my $line = shift || '';
+ my $dbline = shift;
+
+ # Dot is this line.
+ $line =~ s/^\./$dbline/;
+
+ # Call delete_action with a null param to delete them all.
+ # The '1' forces the eval to be true. It'll be false only
+ # if delete_action blows up for some reason, in which case
+ # we print $@ and get out.
+ if ( $line eq '*' ) {
+ eval { &delete_action(); 1 } or print $OUT $@ and return;
+ }
+
+ # There's a real line number. Pass it to delete_action.
+ # Error trapping is as above.
+ elsif ( $line =~ /^(\S.*)/ ) {
+ eval { &delete_action($1); 1 } or print $OUT $@ and return;
+ }
+
+ # Swing and a miss. Bad syntax.
+ else {
+ print $OUT
+ "Deleting an action requires a line number, or '*' for all\n" ; # hint
+ }
+} ## end sub cmd_A
+
+=head3 C<delete_action> (API)
+
+C<delete_action> accepts either a line number or C<undef>. If a line number
+is specified, we check for the line being executable (if it's not, it
+couldn't have had an action). If it is, we just take the action off (this
+will get any kind of an action, including breakpoints).
+
+=cut
+
+sub delete_action {
+ my $i = shift;
+ if ( defined($i) ) {
+
+ # Can there be one?
+ die "Line $i has no action .\n" if $dbline[$i] == 0;
+
+ # Nuke whatever's there.
+ $dbline{$i} =~ s/\0[^\0]*//; # \^a
+ delete $dbline{$i} if $dbline{$i} eq '';
+ }
+ else {
+ print $OUT "Deleting all actions...\n";
+ for my $file ( keys %had_breakpoints ) {
+ local *dbline = $main::{ '_<' . $file };
+ my $max = $#dbline;
+ my $was;
+ for ( $i = 1 ; $i <= $max ; $i++ ) {
+ if ( defined $dbline{$i} ) {
+ $dbline{$i} =~ s/\0[^\0]*//;
+ delete $dbline{$i} if $dbline{$i} eq '';
+ }
+ unless ( $had_breakpoints{$file} &= ~2 ) {
+ delete $had_breakpoints{$file};
+ }
+ } ## end for ($i = 1 ; $i <= $max...
+ } ## end for my $file (keys %had_breakpoints)
+ } ## end else [ if (defined($i))
+} ## end sub delete_action
+
+=head3 C<cmd_b> (command)
+
+Set breakpoints. Since breakpoints can be set in so many places, in so many
+ways, conditionally or not, the breakpoint code is kind of complex. Mostly,
+we try to parse the command type, and then shuttle it off to an appropriate
+subroutine to actually do the work of setting the breakpoint in the right
+place.
+
+=cut
+
+sub cmd_b {
+ my $cmd = shift;
+ my $line = shift; # [.|line] [cond]
+ my $dbline = shift;
+
+ # Make . the current line number if it's there..
+ $line =~ s/^\./$dbline/;
+
+ # No line number, no condition. Simple break on current line.
+ if ( $line =~ /^\s*$/ ) {
+ &cmd_b_line( $dbline, 1 );
+ }
+
+ # Break on load for a file.
+ elsif ( $line =~ /^load\b\s*(.*)/ ) {
+ my $file = $1;
+ $file =~ s/\s+$//;
+ &cmd_b_load($file);
+ }
+
+ # b compile|postpone <some sub> [<condition>]
+ # The interpreter actually traps this one for us; we just put the
+ # necessary condition in the %postponed hash.
+ elsif ( $line =~ /^(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ ) {
+
+ # Capture the condition if there is one. Make it true if none.
+ my $cond = length $3 ? $3 : '1';
+
+ # Save the sub name and set $break to 1 if $1 was 'postpone', 0
+ # if it was 'compile'.
+ my ( $subname, $break ) = ( $2, $1 eq 'postpone' );
+
+ # De-Perl4-ify the name - ' separators to ::.
+ $subname =~ s/\'/::/g;
+
+ # Qualify it into the current package unless it's already qualified.
+ $subname = "${'package'}::" . $subname unless $subname =~ /::/;
+
+ # Add main if it starts with ::.
+ $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
+
+ # Save the break type for this sub.
+ $postponed{$subname} = $break ? "break +0 if $cond" : "compile";
+ } ## end elsif ($line =~ ...
+
+ # b <sub name> [<condition>]
+ elsif ( $line =~ /^([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/ ) {
+
+ #
+ $subname = $1;
+ $cond = length $2 ? $2 : '1';
+ &cmd_b_sub( $subname, $cond );
+ }
+
+ # b <line> [<condition>].
+ elsif ( $line =~ /^(\d*)\s*(.*)/ ) {
+
+ # Capture the line. If none, it's the current line.
+ $line = $1 || $dbline;
+
+ # If there's no condition, make it '1'.
+ $cond = length $2 ? $2 : '1';
+
+ # Break on line.
+ &cmd_b_line( $line, $cond );
+ }
+
+ # Line didn't make sense.
+ else {
+ print "confused by line($line)?\n";
+ }
+} ## end sub cmd_b
+
+=head3 C<break_on_load> (API)
+
+We want to break when this file is loaded. Mark this file in the
+C<%break_on_load> hash, and note that it has a breakpoint in
+C<%had_breakpoints>.
+
+=cut
+
+sub break_on_load {
+ my $file = shift;
+ $break_on_load{$file} = 1;
+ $had_breakpoints{$file} |= 1;
+}
+
+=head3 C<report_break_on_load> (API)
+
+Gives us an array of filenames that are set to break on load. Note that
+only files with break-on-load are in here, so simply showing the keys
+suffices.
+
+=cut
+
+sub report_break_on_load {
+ sort keys %break_on_load;
+}
+
+=head3 C<cmd_b_load> (command)
+
+We take the file passed in and try to find it in C<%INC> (which maps modules
+to files they came from). We mark those files for break-on-load via
+C<break_on_load> and then report that it was done.
+
+=cut
+
+sub cmd_b_load {
+ my $file = shift;
+ my @files;
+
+ # This is a block because that way we can use a redo inside it
+ # even without there being any looping structure at all outside it.
+ {
+
+ # Save short name and full path if found.
+ push @files, $file;
+ push @files, $::INC{$file} if $::INC{$file};
+
+ # Tack on .pm and do it again unless there was a '.' in the name
+ # already.
+ $file .= '.pm', redo unless $file =~ /\./;
+ }
+
+ # Do the real work here.
+ break_on_load($_) for @files;
+
+ # All the files that have break-on-load breakpoints.
+ @files = report_break_on_load;
+
+ # Normalize for the purposes of our printing this.
+ local $\ = '';
+ local $" = ' ';
+ print $OUT "Will stop on load of `@files'.\n";
+} ## end sub cmd_b_load
+
+=head3 C<$filename_error> (API package global)
+
+Several of the functions we need to implement in the API need to work both
+on the current file and on other files. We don't want to duplicate code, so
+C<$filename_error> is used to contain the name of the file that's being
+worked on (if it's not the current one).
+
+We can now build functions in pairs: the basic function works on the current
+file, and uses C<$filename_error> as part of its error message. Since this is
+initialized to C<"">, no filename will appear when we are working on the
+current file.
+
+The second function is a wrapper which does the following:
+
+=over 4
+
+=item *
+
+Localizes C<$filename_error> and sets it to the name of the file to be processed.
+
+=item *
+
+Localizes the C<*dbline> glob and reassigns it to point to the file we want to process.
+
+=item *
+
+Calls the first function.
+
+The first function works on the I<current> file (i.e., the one we changed to),
+and prints C<$filename_error> in the error message (the name of the other file)
+if it needs to. When the functions return, C<*dbline> is restored to point
+to the actual current file (the one we're executing in) and
+C<$filename_error> is restored to C<"">. This restores everything to
+the way it was before the second function was called at all.
+
+See the comments in C<breakable_line> and C<breakable_line_in_file> for more
+details.
+
+=back
+
+=cut
+
+$filename_error = '';
+
+=head3 breakable_line(from, to) (API)
+
+The subroutine decides whether or not a line in the current file is breakable.
+It walks through C<@dbline> within the range of lines specified, looking for
+the first line that is breakable.
+
+If C<$to> is greater than C<$from>, the search moves forwards, finding the
+first line I<after> C<$to> that's breakable, if there is one.
+
+If C<$from> is greater than C<$to>, the search goes I<backwards>, finding the
+first line I<before> C<$to> that's breakable, if there is one.
+
+=cut
+
+sub breakable_line {
+
+ my ( $from, $to ) = @_;
+
+ # $i is the start point. (Where are the FORTRAN programs of yesteryear?)
+ my $i = $from;
+
+ # If there are at least 2 arguments, we're trying to search a range.
+ if ( @_ >= 2 ) {
+
+ # $delta is positive for a forward search, negative for a backward one.
+ my $delta = $from < $to ? +1 : -1;
+
+ # Keep us from running off the ends of the file.
+ my $limit = $delta > 0 ? $#dbline : 1;
+
+ # Clever test. If you're a mathematician, it's obvious why this
+ # test works. If not:
+ # If $delta is positive (going forward), $limit will be $#dbline.
+ # If $to is less than $limit, ($limit - $to) will be positive, times
+ # $delta of 1 (positive), so the result is > 0 and we should use $to
+ # as the stopping point.
+ #
+ # If $to is greater than $limit, ($limit - $to) is negative,
+ # times $delta of 1 (positive), so the result is < 0 and we should
+ # use $limit ($#dbline) as the stopping point.
+ #
+ # If $delta is negative (going backward), $limit will be 1.
+ # If $to is zero, ($limit - $to) will be 1, times $delta of -1
+ # (negative) so the result is > 0, and we use $to as the stopping
+ # point.
+ #
+ # If $to is less than zero, ($limit - $to) will be positive,
+ # times $delta of -1 (negative), so the result is not > 0, and
+ # we use $limit (1) as the stopping point.
+ #
+ # If $to is 1, ($limit - $to) will zero, times $delta of -1
+ # (negative), still giving zero; the result is not > 0, and
+ # we use $limit (1) as the stopping point.
+ #
+ # if $to is >1, ($limit - $to) will be negative, times $delta of -1
+ # (negative), giving a positive (>0) value, so we'll set $limit to
+ # $to.
+
+ $limit = $to if ( $limit - $to ) * $delta > 0;
+
+ # The real search loop.
+ # $i starts at $from (the point we want to start searching from).
+ # We move through @dbline in the appropriate direction (determined
+ # by $delta: either -1 (back) or +1 (ahead).
+ # We stay in as long as we haven't hit an executable line
+ # ($dbline[$i] == 0 means not executable) and we haven't reached
+ # the limit yet (test similar to the above).
+ $i += $delta while $dbline[$i] == 0 and ( $limit - $i ) * $delta > 0;
+
+ } ## end if (@_ >= 2)
+
+ # If $i points to a line that is executable, return that.
+ return $i unless $dbline[$i] == 0;
+
+ # Format the message and print it: no breakable lines in range.
+ my ( $pl, $upto ) = ( '', '' );
+ ( $pl, $upto ) = ( 's', "..$to" ) if @_ >= 2 and $from != $to;
+
+ # If there's a filename in filename_error, we'll see it.
+ # If not, not.
+ die "Line$pl $from$upto$filename_error not breakable\n";
+} ## end sub breakable_line
+
+=head3 breakable_line_in_filename(file, from, to) (API)
+
+Like C<breakable_line>, but look in another file.
+
+=cut
+
+sub breakable_line_in_filename {
+
+ # Capture the file name.
+ my ($f) = shift;
+
+ # Swap the magic line array over there temporarily.
+ local *dbline = $main::{ '_<' . $f };
+
+ # If there's an error, it's in this other file.
+ local $filename_error = " of `$f'";
+
+ # Find the breakable line.
+ breakable_line(@_);
+
+ # *dbline and $filename_error get restored when this block ends.
+
+} ## end sub breakable_line_in_filename
+
+=head3 break_on_line(lineno, [condition]) (API)
+
+Adds a breakpoint with the specified condition (or 1 if no condition was
+specified) to the specified line. Dies if it can't.
+
+=cut
+
+sub break_on_line {
+ my ( $i, $cond ) = @_;
+
+ # Always true if no condition supplied.
+ $cond = 1 unless @_ >= 2;
+
+ my $inii = $i;
+ my $after = '';
+ my $pl = '';
+
+ # Woops, not a breakable line. $filename_error allows us to say
+ # if it was in a different file.
+ die "Line $i$filename_error not breakable.\n" if $dbline[$i] == 0;
+
+ # Mark this file as having breakpoints in it.
+ $had_breakpoints{$filename} |= 1;
+
+ # If there is an action or condition here already ...
+ if ( $dbline{$i} ) {
+
+ # ... swap this condition for the existing one.
+ $dbline{$i} =~ s/^[^\0]*/$cond/;
+ }
+ else {
+
+ # Nothing here - just add the condition.
+ $dbline{$i} = $cond;
+ }
+} ## end sub break_on_line
+
+=head3 cmd_b_line(line, [condition]) (command)
+
+Wrapper for C<break_on_line>. Prints the failure message if it
+doesn't work.
+
+=cut
+
+sub cmd_b_line {
+ eval { break_on_line(@_); 1 } or do {
+ local $\ = '';
+ print $OUT $@ and return;
+ };
+} ## end sub cmd_b_line
+
+=head3 break_on_filename_line(file, line, [condition]) (API)
+
+Switches to the file specified and then calls C<break_on_line> to set
+the breakpoint.
+
+=cut
+
+sub break_on_filename_line {
+ my ( $f, $i, $cond ) = @_;
+
+ # Always true if condition left off.
+ $cond = 1 unless @_ >= 3;
+
+ # Switch the magical hash temporarily.
+ local *dbline = $main::{ '_<' . $f };
+
+ # Localize the variables that break_on_line uses to make its message.
+ local $filename_error = " of `$f'";
+ local $filename = $f;
+
+ # Add the breakpoint.
+ break_on_line( $i, $cond );
+} ## end sub break_on_filename_line
+
+=head3 break_on_filename_line_range(file, from, to, [condition]) (API)
+
+Switch to another file, search the range of lines specified for an
+executable one, and put a breakpoint on the first one you find.
+
+=cut
+
+sub break_on_filename_line_range {
+ my ( $f, $from, $to, $cond ) = @_;
+
+ # Find a breakable line if there is one.
+ my $i = breakable_line_in_filename( $f, $from, $to );
+
+ # Always true if missing.
+ $cond = 1 unless @_ >= 3;
+
+ # Add the breakpoint.
+ break_on_filename_line( $f, $i, $cond );
+} ## end sub break_on_filename_line_range
+
+=head3 subroutine_filename_lines(subname, [condition]) (API)
+
+Search for a subroutine within a given file. The condition is ignored.
+Uses C<find_sub> to locate the desired subroutine.
+
+=cut
+
+sub subroutine_filename_lines {
+ my ( $subname, $cond ) = @_;
+
+ # Returned value from find_sub() is fullpathname:startline-endline.
+ # The match creates the list (fullpathname, start, end). Falling off
+ # the end of the subroutine returns this implicitly.
+ find_sub($subname) =~ /^(.*):(\d+)-(\d+)$/;
+} ## end sub subroutine_filename_lines
+
+=head3 break_subroutine(subname) (API)
+
+Places a break on the first line possible in the specified subroutine. Uses
+C<subroutine_filename_lines> to find the subroutine, and
+C<break_on_filename_line_range> to place the break.
+
+=cut
+
+sub break_subroutine {
+ my $subname = shift;
+
+ # Get filename, start, and end.
+ my ( $file, $s, $e ) = subroutine_filename_lines($subname)
+ or die "Subroutine $subname not found.\n";
+
+ # Null condition changes to '1' (always true).
+ $cond = 1 unless @_ >= 2;
+
+ # Put a break the first place possible in the range of lines
+ # that make up this subroutine.
+ break_on_filename_line_range( $file, $s, $e, @_ );
+} ## end sub break_subroutine
+
+=head3 cmd_b_sub(subname, [condition]) (command)
+
+We take the incoming subroutine name and fully-qualify it as best we can.
+
+=over 4
+
+=item 1. If it's already fully-qualified, leave it alone.
+
+=item 2. Try putting it in the current package.
+
+=item 3. If it's not there, try putting it in CORE::GLOBAL if it exists there.
+
+=item 4. If it starts with '::', put it in 'main::'.
+
+=back
+
+After all this cleanup, we call C<break_subroutine> to try to set the
+breakpoint.
+
+=cut
+
+sub cmd_b_sub {
+ my ( $subname, $cond ) = @_;
+
+ # Add always-true condition if we have none.
+ $cond = 1 unless @_ >= 2;
+
+ # If the subname isn't a code reference, qualify it so that
+ # break_subroutine() will work right.
+ unless ( ref $subname eq 'CODE' ) {
+
+ # Not Perl4.
+ $subname =~ s/\'/::/g;
+ my $s = $subname;
+
+ # Put it in this package unless it's already qualified.
+ $subname = "${'package'}::" . $subname
+ unless $subname =~ /::/;
+
+ # Requalify it into CORE::GLOBAL if qualifying it into this
+ # package resulted in its not being defined, but only do so
+ # if it really is in CORE::GLOBAL.
+ $subname = "CORE::GLOBAL::$s"
+ if not defined &$subname
+ and $s !~ /::/
+ and defined &{"CORE::GLOBAL::$s"};
+
+ # Put it in package 'main' if it has a leading ::.
+ $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
+
+ } ## end unless (ref $subname eq 'CODE')
+
+ # Try to set the breakpoint.
+ eval { break_subroutine( $subname, $cond ); 1 } or do {
+ local $\ = '';
+ print $OUT $@ and return;
+ }
+} ## end sub cmd_b_sub
+
+=head3 C<cmd_B> - delete breakpoint(s) (command)
+
+The command mostly parses the command line and tries to turn the argument
+into a line spec. If it can't, it uses the current line. It then calls
+C<delete_breakpoint> to actually do the work.
+
+If C<*> is specified, C<cmd_B> calls C<delete_breakpoint> with no arguments,
+thereby deleting all the breakpoints.
+
+=cut
+
+sub cmd_B {
+ my $cmd = shift;
+
+ # No line spec? Use dbline.
+ # If there is one, use it if it's non-zero, or wipe it out if it is.
+ my $line = ( $_[0] =~ /^\./ ) ? $dbline : shift || '';
+ my $dbline = shift;
+
+ # If the line was dot, make the line the current one.
+ $line =~ s/^\./$dbline/;
+
+ # If it's * we're deleting all the breakpoints.
+ if ( $line eq '*' ) {
+ eval { &delete_breakpoint(); 1 } or print $OUT $@ and return;
+ }
+
+ # If there is a line spec, delete the breakpoint on that line.
+ elsif ( $line =~ /^(\S.*)/ ) {
+ eval { &delete_breakpoint( $line || $dbline ); 1 } or do {
+ local $\ = '';
+ print $OUT $@ and return;
+ };
+ } ## end elsif ($line =~ /^(\S.*)/)
+
+ # No line spec.
+ else {
+ print $OUT
+ "Deleting a breakpoint requires a line number, or '*' for all\n"
+ ; # hint
+ }
+} ## end sub cmd_B
+
+=head3 delete_breakpoint([line]) (API)
+
+This actually does the work of deleting either a single breakpoint, or all
+of them.
+
+For a single line, we look for it in C<@dbline>. If it's nonbreakable, we
+just drop out with a message saying so. If it is, we remove the condition
+part of the 'condition\0action' that says there's a breakpoint here. If,
+after we've done that, there's nothing left, we delete the corresponding
+line in C<%dbline> to signal that no action needs to be taken for this line.
+
+For all breakpoints, we iterate through the keys of C<%had_breakpoints>,
+which lists all currently-loaded files which have breakpoints. We then look
+at each line in each of these files, temporarily switching the C<%dbline>
+and C<@dbline> structures to point to the files in question, and do what
+we did in the single line case: delete the condition in C<@dbline>, and
+delete the key in C<%dbline> if nothing's left.
+
+We then wholesale delete C<%postponed>, C<%postponed_file>, and
+C<%break_on_load>, because these structures contain breakpoints for files
+and code that haven't been loaded yet. We can just kill these off because there
+are no magical debugger structures associated with them.
+
+=cut
+
+sub delete_breakpoint {
+ my $i = shift;
+
+ # If we got a line, delete just that one.
+ if ( defined($i) ) {
+
+ # Woops. This line wasn't breakable at all.
+ die "Line $i not breakable.\n" if $dbline[$i] == 0;
+
+ # Kill the condition, but leave any action.
+ $dbline{$i} =~ s/^[^\0]*//;
+
+ # Remove the entry entirely if there's no action left.
+ delete $dbline{$i} if $dbline{$i} eq '';
+ }
+
+ # No line; delete them all.
+ else {
+ print $OUT "Deleting all breakpoints...\n";
+
+ # %had_breakpoints lists every file that had at least one
+ # breakpoint in it.
+ for my $file ( keys %had_breakpoints ) {
+
+ # Switch to the desired file temporarily.
+ local *dbline = $main::{ '_<' . $file };
+
+ my $max = $#dbline;
+ my $was;
+
+ # For all lines in this file ...
+ for ( $i = 1 ; $i <= $max ; $i++ ) {
+
+ # If there's a breakpoint or action on this line ...
+ if ( defined $dbline{$i} ) {
+
+ # ... remove the breakpoint.
+ $dbline{$i} =~ s/^[^\0]+//;
+ if ( $dbline{$i} =~ s/^\0?$// ) {
+
+ # Remove the entry altogether if no action is there.
+ delete $dbline{$i};
+ }
+ } ## end if (defined $dbline{$i...
+ } ## end for ($i = 1 ; $i <= $max...
+
+ # If, after we turn off the "there were breakpoints in this file"
+ # bit, the entry in %had_breakpoints for this file is zero,
+ # we should remove this file from the hash.
+ if ( not $had_breakpoints{$file} &= ~1 ) {
+ delete $had_breakpoints{$file};
+ }
+ } ## end for my $file (keys %had_breakpoints)
+
+ # Kill off all the other breakpoints that are waiting for files that
+ # haven't been loaded yet.
+ undef %postponed;
+ undef %postponed_file;
+ undef %break_on_load;
+ } ## end else [ if (defined($i))
+} ## end sub delete_breakpoint
+
+=head3 cmd_stop (command)
+
+This is meant to be part of the new command API, but it isn't called or used
+anywhere else in the debugger. XXX It is probably meant for use in development
+of new commands.
+
+=cut
+
+sub cmd_stop { # As on ^C, but not signal-safy.
+ $signal = 1;
+}
+
+=head3 C<cmd_e> - threads
+
+Display the current thread id:
+
+ e
+
+This could be how (when implemented) to send commands to this thread id (e cmd)
+or that thread id (e tid cmd).
+
+=cut
+
+sub cmd_e {
+ my $cmd = shift;
+ my $line = shift;
+ unless (exists($INC{'threads.pm'})) {
+ print "threads not loaded($ENV{PERL5DB_THREADED})
+ please run the debugger with PERL5DB_THREADED=1 set in the environment\n";
+ } else {
+ my $tid = threads->tid;
+ print "thread id: $tid\n";
+ }
+} ## end sub cmd_e
+
+=head3 C<cmd_E> - list of thread ids
+
+Display the list of available thread ids:
+
+ E
+
+This could be used (when implemented) to send commands to all threads (E cmd).
+
+=cut
+
+sub cmd_E {
+ my $cmd = shift;
+ my $line = shift;
+ unless (exists($INC{'threads.pm'})) {
+ print "threads not loaded($ENV{PERL5DB_THREADED})
+ please run the debugger with PERL5DB_THREADED=1 set in the environment\n";
+ } else {
+ my $tid = threads->tid;
+ print "thread ids: ".join(', ',
+ map { ($tid == $_->tid ? '<'.$_->tid.'>' : $_->tid) } threads->list
+ )."\n";
+ }
+} ## end sub cmd_E
+
+=head3 C<cmd_h> - help command (command)
+
+Does the work of either
+
+=over 4
+
+=item *
+
+Showing all the debugger help
+
+=item *
+
+Showing help for a specific command
+
+=back
+
+=cut
+
+sub cmd_h {
+ my $cmd = shift;
+
+ # If we have no operand, assume null.
+ my $line = shift || '';
+
+ # 'h h'. Print the long-format help.
+ if ( $line =~ /^h\s*/ ) {
+ print_help($help);
+ }
+
+ # 'h <something>'. Search for the command and print only its help.
+ elsif ( $line =~ /^(\S.*)$/ ) {
+
+ # support long commands; otherwise bogus errors
+ # happen when you ask for h on <CR> for example
+ my $asked = $1; # the command requested
+ # (for proper error message)
+
+ my $qasked = quotemeta($asked); # for searching; we don't
+ # want to use it as a pattern.
+ # XXX: finds CR but not <CR>
+
+ # Search the help string for the command.
+ if (
+ $help =~ /^ # Start of a line
+ <? # Optional '<'
+ (?:[IB]<) # Optional markup
+ $qasked # The requested command
+ /mx
+ )
+ {
+
+ # It's there; pull it out and print it.
+ while (
+ $help =~ /^
+ (<? # Optional '<'
+ (?:[IB]<) # Optional markup
+ $qasked # The command
+ ([\s\S]*?) # Description line(s)
+ \n) # End of last description line
+ (?!\s) # Next line not starting with
+ # whitespace
+ /mgx
+ )
+ {
+ print_help($1);
+ }
+ }
+
+ # Not found; not a debugger command.
+ else {
+ print_help("B<$asked> is not a debugger command.\n");
+ }
+ } ## end elsif ($line =~ /^(\S.*)$/)
+
+ # 'h' - print the summary help.
+ else {
+ print_help($summary);
+ }
+} ## end sub cmd_h
+
+=head3 C<cmd_i> - inheritance display
+
+Display the (nested) parentage of the module or object given.
+
+=cut
+
+sub cmd_i {
+ my $cmd = shift;
+ my $line = shift;
+ eval { require Class::ISA };
+ if ($@) {
+ &warn( $@ =~ /locate/
+ ? "Class::ISA module not found - please install\n"
+ : $@ );
+ }
+ else {
+ ISA:
+ foreach my $isa ( split( /\s+/, $line ) ) {
+ $evalarg = $isa;
+ ($isa) = &eval;
+ no strict 'refs';
+ print join(
+ ', ',
+ map { # snaffled unceremoniously from Class::ISA
+ "$_"
+ . (
+ defined( ${"$_\::VERSION"} )
+ ? ' ' . ${"$_\::VERSION"}
+ : undef )
+ } Class::ISA::self_and_super_path(ref($isa) || $isa)
+ );
+ print "\n";
+ }
+ }
+} ## end sub cmd_i
+
+=head3 C<cmd_l> - list lines (command)
+
+Most of the command is taken up with transforming all the different line
+specification syntaxes into 'start-stop'. After that is done, the command
+runs a loop over C<@dbline> for the specified range of lines. It handles
+the printing of each line and any markers (C<==E<gt>> for current line,
+C<b> for break on this line, C<a> for action on this line, C<:> for this
+line breakable).
+
+We save the last line listed in the C<$start> global for further listing
+later.
+
+=cut
+
+sub cmd_l {
+ my $current_line = $line;
+ my $cmd = shift;
+ my $line = shift;
+
+ # If this is '-something', delete any spaces after the dash.
+ $line =~ s/^-\s*$/-/;
+
+ # If the line is '$something', assume this is a scalar containing a
+ # line number.
+ if ( $line =~ /^(\$.*)/s ) {
+
+ # Set up for DB::eval() - evaluate in *user* context.
+ $evalarg = $1;
+ # $evalarg = $2;
+ my ($s) = &eval;
+
+ # Ooops. Bad scalar.
+ print( $OUT "Error: $@\n" ), next CMD if $@;
+
+ # Good scalar. If it's a reference, find what it points to.
+ $s = CvGV_name($s);
+ print( $OUT "Interpreted as: $1 $s\n" );
+ $line = "$1 $s";
+
+ # Call self recursively to really do the command.
+ &cmd_l( 'l', $s );
+ } ## end if ($line =~ /^(\$.*)/s)
+
+ # l name. Try to find a sub by that name.
+ elsif ( $line =~ /^([\':A-Za-z_][\':\w]*(\[.*\])?)/s ) {
+ my $s = $subname = $1;
+
+ # De-Perl4.
+ $subname =~ s/\'/::/;
+
+ # Put it in this package unless it starts with ::.
+ $subname = $package . "::" . $subname unless $subname =~ /::/;
+
+ # Put it in CORE::GLOBAL if t doesn't start with :: and
+ # it doesn't live in this package and it lives in CORE::GLOBAL.
+ $subname = "CORE::GLOBAL::$s"
+ if not defined &$subname
+ and $s !~ /::/
+ and defined &{"CORE::GLOBAL::$s"};
+
+ # Put leading '::' names into 'main::'.
+ $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
+
+ # Get name:start-stop from find_sub, and break this up at
+ # colons.
+ @pieces = split( /:/, find_sub($subname) || $sub{$subname} );
+
+ # Pull off start-stop.
+ $subrange = pop @pieces;
+
+ # If the name contained colons, the split broke it up.
+ # Put it back together.
+ $file = join( ':', @pieces );
+
+ # If we're not in that file, switch over to it.
+ if ( $file ne $filename ) {
+ print $OUT "Switching to file '$file'.\n"
+ unless $slave_editor;
+
+ # Switch debugger's magic structures.
+ *dbline = $main::{ '_<' . $file };
+ $max = $#dbline;
+ $filename = $file;
+ } ## end if ($file ne $filename)
+
+ # Subrange is 'start-stop'. If this is less than a window full,
+ # swap it to 'start+', which will list a window from the start point.
+ if ($subrange) {
+ if ( eval($subrange) < -$window ) {
+ $subrange =~ s/-.*/+/;
+ }
+
+ # Call self recursively to list the range.
+ $line = $subrange;
+ &cmd_l( 'l', $subrange );
+ } ## end if ($subrange)
+
+ # Couldn't find it.
+ else {
+ print $OUT "Subroutine $subname not found.\n";
+ }
+ } ## end elsif ($line =~ /^([\':A-Za-z_][\':\w]*(\[.*\])?)/s)
+
+ # Bare 'l' command.
+ elsif ( $line =~ /^\s*$/ ) {
+
+ # Compute new range to list.
+ $incr = $window - 1;
+ $line = $start . '-' . ( $start + $incr );
+
+ # Recurse to do it.
+ &cmd_l( 'l', $line );
+ }
+
+ # l [start]+number_of_lines
+ elsif ( $line =~ /^(\d*)\+(\d*)$/ ) {
+
+ # Don't reset start for 'l +nnn'.
+ $start = $1 if $1;
+
+ # Increment for list. Use window size if not specified.
+ # (Allows 'l +' to work.)
+ $incr = $2;
+ $incr = $window - 1 unless $incr;
+
+ # Create a line range we'll understand, and recurse to do it.
+ $line = $start . '-' . ( $start + $incr );
+ &cmd_l( 'l', $line );
+ } ## end elsif ($line =~ /^(\d*)\+(\d*)$/)
+
+ # l start-stop or l start,stop
+ elsif ( $line =~ /^((-?[\d\$\.]+)([-,]([\d\$\.]+))?)?/ ) {
+
+ # Determine end point; use end of file if not specified.
+ $end = ( !defined $2 ) ? $max : ( $4 ? $4 : $2 );
+
+ # Go on to the end, and then stop.
+ $end = $max if $end > $max;
+
+ # Determine start line.
+ $i = $2;
+ $i = $line if $i eq '.';
+ $i = 1 if $i < 1;
+ $incr = $end - $i;
+
+ # If we're running under a slave editor, force it to show the lines.
+ if ($slave_editor) {
+ print $OUT "\032\032$filename:$i:0\n";
+ $i = $end;
+ }
+
+ # We're doing it ourselves. We want to show the line and special
+ # markers for:
+ # - the current line in execution
+ # - whether a line is breakable or not
+ # - whether a line has a break or not
+ # - whether a line has an action or not
+ else {
+ for ( ; $i <= $end ; $i++ ) {
+
+ # Check for breakpoints and actions.
+ my ( $stop, $action );
+ ( $stop, $action ) = split( /\0/, $dbline{$i} )
+ if $dbline{$i};
+
+ # ==> if this is the current line in execution,
+ # : if it's breakable.
+ $arrow =
+ ( $i == $current_line and $filename eq $filename_ini )
+ ? '==>'
+ : ( $dbline[$i] + 0 ? ':' : ' ' );
+
+ # Add break and action indicators.
+ $arrow .= 'b' if $stop;
+ $arrow .= 'a' if $action;
+
+ # Print the line.
+ print $OUT "$i$arrow\t", $dbline[$i];
+
+ # Move on to the next line. Drop out on an interrupt.
+ $i++, last if $signal;
+ } ## end for (; $i <= $end ; $i++)
+
+ # Line the prompt up; print a newline if the last line listed
+ # didn't have a newline.
+ print $OUT "\n" unless $dbline[ $i - 1 ] =~ /\n$/;
+ } ## end else [ if ($slave_editor)
+
+ # Save the point we last listed to in case another relative 'l'
+ # command is desired. Don't let it run off the end.
+ $start = $i;
+ $start = $max if $start > $max;
+ } ## end elsif ($line =~ /^((-?[\d\$\.]+)([-,]([\d\$\.]+))?)?/)
+} ## end sub cmd_l
+
+=head3 C<cmd_L> - list breakpoints, actions, and watch expressions (command)
+
+To list breakpoints, the command has to look determine where all of them are
+first. It starts a C<%had_breakpoints>, which tells us what all files have
+breakpoints and/or actions. For each file, we switch the C<*dbline> glob (the
+magic source and breakpoint data structures) to the file, and then look
+through C<%dbline> for lines with breakpoints and/or actions, listing them
+out. We look through C<%postponed> not-yet-compiled subroutines that have
+breakpoints, and through C<%postponed_file> for not-yet-C<require>'d files
+that have breakpoints.
+
+Watchpoints are simpler: we just list the entries in C<@to_watch>.
+
+=cut
+
+sub cmd_L {
+ my $cmd = shift;
+
+ # If no argument, list everything. Pre-5.8.0 version always lists
+ # everything
+ my $arg = shift || 'abw';
+ $arg = 'abw' unless $CommandSet eq '580'; # sigh...
+
+ # See what is wanted.
+ my $action_wanted = ( $arg =~ /a/ ) ? 1 : 0;
+ my $break_wanted = ( $arg =~ /b/ ) ? 1 : 0;
+ my $watch_wanted = ( $arg =~ /w/ ) ? 1 : 0;
+
+ # Breaks and actions are found together, so we look in the same place
+ # for both.
+ if ( $break_wanted or $action_wanted ) {
+
+ # Look in all the files with breakpoints...
+ for my $file ( keys %had_breakpoints ) {
+
+ # Temporary switch to this file.
+ local *dbline = $main::{ '_<' . $file };
+
+ # Set up to look through the whole file.
+ my $max = $#dbline;
+ my $was; # Flag: did we print something
+ # in this file?
+
+ # For each line in the file ...
+ for ( $i = 1 ; $i <= $max ; $i++ ) {
+
+ # We've got something on this line.
+ if ( defined $dbline{$i} ) {
+
+ # Print the header if we haven't.
+ print $OUT "$file:\n" unless $was++;
+
+ # Print the line.
+ print $OUT " $i:\t", $dbline[$i];
+
+ # Pull out the condition and the action.
+ ( $stop, $action ) = split( /\0/, $dbline{$i} );
+
+ # Print the break if there is one and it's wanted.
+ print $OUT " break if (", $stop, ")\n"
+ if $stop
+ and $break_wanted;
+
+ # Print the action if there is one and it's wanted.
+ print $OUT " action: ", $action, "\n"
+ if $action
+ and $action_wanted;
+
+ # Quit if the user hit interrupt.
+ last if $signal;
+ } ## end if (defined $dbline{$i...
+ } ## end for ($i = 1 ; $i <= $max...
+ } ## end for my $file (keys %had_breakpoints)
+ } ## end if ($break_wanted or $action_wanted)
+
+ # Look for breaks in not-yet-compiled subs:
+ if ( %postponed and $break_wanted ) {
+ print $OUT "Postponed breakpoints in subroutines:\n";
+ my $subname;
+ for $subname ( keys %postponed ) {
+ print $OUT " $subname\t$postponed{$subname}\n";
+ last if $signal;
+ }
+ } ## end if (%postponed and $break_wanted)
+
+ # Find files that have not-yet-loaded breaks:
+ my @have = map { # Combined keys
+ keys %{ $postponed_file{$_} }
+ } keys %postponed_file;
+
+ # If there are any, list them.
+ if ( @have and ( $break_wanted or $action_wanted ) ) {
+ print $OUT "Postponed breakpoints in files:\n";
+ my ( $file, $line );
+
+ for $file ( keys %postponed_file ) {
+ my $db = $postponed_file{$file};
+ print $OUT " $file:\n";
+ for $line ( sort { $a <=> $b } keys %$db ) {
+ print $OUT " $line:\n";
+ my ( $stop, $action ) = split( /\0/, $$db{$line} );
+ print $OUT " break if (", $stop, ")\n"
+ if $stop
+ and $break_wanted;
+ print $OUT " action: ", $action, "\n"
+ if $action
+ and $action_wanted;
+ last if $signal;
+ } ## end for $line (sort { $a <=>...
+ last if $signal;
+ } ## end for $file (keys %postponed_file)
+ } ## end if (@have and ($break_wanted...
+ if ( %break_on_load and $break_wanted ) {
+ print $OUT "Breakpoints on load:\n";
+ my $file;
+ for $file ( keys %break_on_load ) {
+ print $OUT " $file\n";
+ last if $signal;
+ }
+ } ## end if (%break_on_load and...
+ if ($watch_wanted) {
+ if ( $trace & 2 ) {
+ print $OUT "Watch-expressions:\n" if @to_watch;
+ for my $expr (@to_watch) {
+ print $OUT " $expr\n";
+ last if $signal;
+ }
+ } ## end if ($trace & 2)
+ } ## end if ($watch_wanted)
+} ## end sub cmd_L
+
+=head3 C<cmd_M> - list modules (command)
+
+Just call C<list_modules>.
+
+=cut
+
+sub cmd_M {
+ &list_modules();
+}
+
+=head3 C<cmd_o> - options (command)
+
+If this is just C<o> by itself, we list the current settings via
+C<dump_option>. If there's a nonblank value following it, we pass that on to
+C<parse_options> for processing.
+
+=cut
+
+sub cmd_o {
+ my $cmd = shift;
+ my $opt = shift || ''; # opt[=val]
+
+ # Nonblank. Try to parse and process.
+ if ( $opt =~ /^(\S.*)/ ) {
+ &parse_options($1);
+ }
+
+ # Blank. List the current option settings.
+ else {
+ for (@options) {
+ &dump_option($_);
+ }
+ }
+} ## end sub cmd_o
+
+=head3 C<cmd_O> - nonexistent in 5.8.x (command)
+
+Advises the user that the O command has been renamed.
+
+=cut
+
+sub cmd_O {
+ print $OUT "The old O command is now the o command.\n"; # hint
+ print $OUT "Use 'h' to get current command help synopsis or\n"; #
+ print $OUT "use 'o CommandSet=pre580' to revert to old usage\n"; #
+}
+
+=head3 C<cmd_v> - view window (command)
+
+Uses the C<$preview> variable set in the second C<BEGIN> block (q.v.) to
+move back a few lines to list the selected line in context. Uses C<cmd_l>
+to do the actual listing after figuring out the range of line to request.
+
+=cut
+
+sub cmd_v {
+ my $cmd = shift;
+ my $line = shift;
+
+ # Extract the line to list around. (Astute readers will have noted that
+ # this pattern will match whether or not a numeric line is specified,
+ # which means that we'll always enter this loop (though a non-numeric
+ # argument results in no action at all)).
+ if ( $line =~ /^(\d*)$/ ) {
+
+ # Total number of lines to list (a windowful).
+ $incr = $window - 1;
+
+ # Set the start to the argument given (if there was one).
+ $start = $1 if $1;
+
+ # Back up by the context amount.
+ $start -= $preview;
+
+ # Put together a linespec that cmd_l will like.
+ $line = $start . '-' . ( $start + $incr );
+
+ # List the lines.
+ &cmd_l( 'l', $line );
+ } ## end if ($line =~ /^(\d*)$/)
+} ## end sub cmd_v
+
+=head3 C<cmd_w> - add a watch expression (command)
+
+The 5.8 version of this command adds a watch expression if one is specified;
+it does nothing if entered with no operands.
+
+We extract the expression, save it, evaluate it in the user's context, and
+save the value. We'll re-evaluate it each time the debugger passes a line,
+and will stop (see the code at the top of the command loop) if the value
+of any of the expressions changes.
+
+=cut
+
+sub cmd_w {
+ my $cmd = shift;
+
+ # Null expression if no arguments.
+ my $expr = shift || '';
+
+ # If expression is not null ...
+ if ( $expr =~ /^(\S.*)/ ) {
+
+ # ... save it.
+ push @to_watch, $expr;
+
+ # Parameterize DB::eval and call it to get the expression's value
+ # in the user's context. This version can handle expressions which
+ # return a list value.
+ $evalarg = $expr;
+ my ($val) = join( ' ', &eval );
+ $val = ( defined $val ) ? "'$val'" : 'undef';
+
+ # Save the current value of the expression.
+ push @old_watch, $val;
+
+ # We are now watching expressions.
+ $trace |= 2;
+ } ## end if ($expr =~ /^(\S.*)/)
+
+ # You have to give one to get one.
+ else {
+ print $OUT "Adding a watch-expression requires an expression\n"; # hint
+ }
+} ## end sub cmd_w
+
+=head3 C<cmd_W> - delete watch expressions (command)
+
+This command accepts either a watch expression to be removed from the list
+of watch expressions, or C<*> to delete them all.
+
+If C<*> is specified, we simply empty the watch expression list and the
+watch expression value list. We also turn off the bit that says we've got
+watch expressions.
+
+If an expression (or partial expression) is specified, we pattern-match
+through the expressions and remove the ones that match. We also discard
+the corresponding values. If no watch expressions are left, we turn off
+the I<watching expressions> bit.
+
+=cut
+
+sub cmd_W {
+ my $cmd = shift;
+ my $expr = shift || '';
+
+ # Delete them all.
+ if ( $expr eq '*' ) {
+
+ # Not watching now.
+ $trace &= ~2;
+
+ print $OUT "Deleting all watch expressions ...\n";
+
+ # And all gone.
+ @to_watch = @old_watch = ();
+ }
+
+ # Delete one of them.
+ elsif ( $expr =~ /^(\S.*)/ ) {
+
+ # Where we are in the list.
+ my $i_cnt = 0;
+
+ # For each expression ...
+ foreach (@to_watch) {
+ my $val = $to_watch[$i_cnt];
+
+ # Does this one match the command argument?
+ if ( $val eq $expr ) { # =~ m/^\Q$i$/) {
+ # Yes. Turn it off, and its value too.
+ splice( @to_watch, $i_cnt, 1 );
+ splice( @old_watch, $i_cnt, 1 );
+ }
+ $i_cnt++;
+ } ## end foreach (@to_watch)
+
+ # We don't bother to turn watching off because
+ # a) we don't want to stop calling watchfunction() it it exists
+ # b) foreach over a null list doesn't do anything anyway
+
+ } ## end elsif ($expr =~ /^(\S.*)/)
+
+ # No command arguments entered.
+ else {
+ print $OUT
+ "Deleting a watch-expression requires an expression, or '*' for all\n"
+ ; # hint
+ }
+} ## end sub cmd_W
+
+### END of the API section
+
+=head1 SUPPORT ROUTINES
+
+These are general support routines that are used in a number of places
+throughout the debugger.
+
+=head2 save
+
+save() saves the user's versions of globals that would mess us up in C<@saved>,
+and installs the versions we like better.
+
+=cut
+
+sub save {
+
+ # Save eval failure, command failure, extended OS error, output field
+ # separator, input record separator, output record separator and
+ # the warning setting.
+ @saved = ( $@, $!, $^E, $,, $/, $\, $^W );
+
+ $, = ""; # output field separator is null string
+ $/ = "\n"; # input record separator is newline
+ $\ = ""; # output record separator is null string
+ $^W = 0; # warnings are off
+} ## end sub save
+
+=head2 C<print_lineinfo> - show where we are now
+
+print_lineinfo prints whatever it is that it is handed; it prints it to the
+C<$LINEINFO> filehandle instead of just printing it to STDOUT. This allows
+us to feed line information to a slave editor without messing up the
+debugger output.
+
+=cut
+
+sub print_lineinfo {
+
+ # Make the terminal sensible if we're not the primary debugger.
+ resetterm(1) if $LINEINFO eq $OUT and $term_pid != $$;
+ local $\ = '';
+ local $, = '';
+ print $LINEINFO @_;
+} ## end sub print_lineinfo
+
+=head2 C<postponed_sub>
+
+Handles setting postponed breakpoints in subroutines once they're compiled.
+For breakpoints, we use C<DB::find_sub> to locate the source file and line
+range for the subroutine, then mark the file as having a breakpoint,
+temporarily switch the C<*dbline> glob over to the source file, and then
+search the given range of lines to find a breakable line. If we find one,
+we set the breakpoint on it, deleting the breakpoint from C<%postponed>.
+
+=cut
+
+# The following takes its argument via $evalarg to preserve current @_
+
+sub postponed_sub {
+
+ # Get the subroutine name.
+ my $subname = shift;
+
+ # If this is a 'break +<n> if <condition>' ...
+ if ( $postponed{$subname} =~ s/^break\s([+-]?\d+)\s+if\s// ) {
+
+ # If there's no offset, use '+0'.
+ my $offset = $1 || 0;
+
+ # find_sub's value is 'fullpath-filename:start-stop'. It's
+ # possible that the filename might have colons in it too.
+ my ( $file, $i ) = ( find_sub($subname) =~ /^(.*):(\d+)-.*$/ );
+ if ($i) {
+
+ # We got the start line. Add the offset '+<n>' from
+ # $postponed{subname}.
+ $i += $offset;
+
+ # Switch to the file this sub is in, temporarily.
+ local *dbline = $main::{ '_<' . $file };
+
+ # No warnings, please.
+ local $^W = 0; # != 0 is magical below
+
+ # This file's got a breakpoint in it.
+ $had_breakpoints{$file} |= 1;
+
+ # Last line in file.
+ my $max = $#dbline;
+
+ # Search forward until we hit a breakable line or get to
+ # the end of the file.
+ ++$i until $dbline[$i] != 0 or $i >= $max;
+
+ # Copy the breakpoint in and delete it from %postponed.
+ $dbline{$i} = delete $postponed{$subname};
+ } ## end if ($i)
+
+ # find_sub didn't find the sub.
+ else {
+ local $\ = '';
+ print $OUT "Subroutine $subname not found.\n";
+ }
+ return;
+ } ## end if ($postponed{$subname...
+ elsif ( $postponed{$subname} eq 'compile' ) { $signal = 1 }
+
+ #print $OUT "In postponed_sub for `$subname'.\n";
+} ## end sub postponed_sub
+
+=head2 C<postponed>
+
+Called after each required file is compiled, but before it is executed;
+also called if the name of a just-compiled subroutine is a key of
+C<%postponed>. Propagates saved breakpoints (from C<b compile>, C<b load>,
+etc.) into the just-compiled code.
+
+If this is a C<require>'d file, the incoming parameter is the glob
+C<*{"_<$filename"}>, with C<$filename> the name of the C<require>'d file.
+
+If it's a subroutine, the incoming parameter is the subroutine name.
+
+=cut
+
+sub postponed {
+
+ # If there's a break, process it.
+ if ($ImmediateStop) {
+
+ # Right, we've stopped. Turn it off.
+ $ImmediateStop = 0;
+
+ # Enter the command loop when DB::DB gets called.
+ $signal = 1;
+ }
+
+ # If this is a subroutine, let postponed_sub() deal with it.
+ return &postponed_sub unless ref \$_[0] eq 'GLOB';
+
+ # Not a subroutine. Deal with the file.
+ local *dbline = shift;
+ my $filename = $dbline;
+ $filename =~ s/^_<//;
+ local $\ = '';
+ $signal = 1, print $OUT "'$filename' loaded...\n"
+ if $break_on_load{$filename};
+ print_lineinfo( ' ' x $stack_depth, "Package $filename.\n" ) if $frame;
+
+ # Do we have any breakpoints to put in this file?
+ return unless $postponed_file{$filename};
+
+ # Yes. Mark this file as having breakpoints.
+ $had_breakpoints{$filename} |= 1;
+
+ # "Cannot be done: unsufficient magic" - we can't just put the
+ # breakpoints saved in %postponed_file into %dbline by assigning
+ # the whole hash; we have to do it one item at a time for the
+ # breakpoints to be set properly.
+ #%dbline = %{$postponed_file{$filename}};
+
+ # Set the breakpoints, one at a time.
+ my $key;
+
+ for $key ( keys %{ $postponed_file{$filename} } ) {
+
+ # Stash the saved breakpoint into the current file's magic line array.
+ $dbline{$key} = ${ $postponed_file{$filename} }{$key};
+ }
+
+ # This file's been compiled; discard the stored breakpoints.
+ delete $postponed_file{$filename};
+
+} ## end sub postponed
+
+=head2 C<dumpit>
+
+C<dumpit> is the debugger's wrapper around dumpvar.pl.
+
+It gets a filehandle (to which C<dumpvar.pl>'s output will be directed) and
+a reference to a variable (the thing to be dumped) as its input.
+
+The incoming filehandle is selected for output (C<dumpvar.pl> is printing to
+the currently-selected filehandle, thank you very much). The current
+values of the package globals C<$single> and C<$trace> are backed up in
+lexicals, and they are turned off (this keeps the debugger from trying
+to single-step through C<dumpvar.pl> (I think.)). C<$frame> is localized to
+preserve its current value and it is set to zero to prevent entry/exit
+messages from printing, and C<$doret> is localized as well and set to -2 to
+prevent return values from being shown.
+
+C<dumpit()> then checks to see if it needs to load C<dumpvar.pl> and
+tries to load it (note: if you have a C<dumpvar.pl> ahead of the
+installed version in C<@INC>, yours will be used instead. Possible security
+problem?).
+
+It then checks to see if the subroutine C<main::dumpValue> is now defined
+(it should have been defined by C<dumpvar.pl>). If it has, C<dumpit()>
+localizes the globals necessary for things to be sane when C<main::dumpValue()>
+is called, and picks up the variable to be dumped from the parameter list.
+
+It checks the package global C<%options> to see if there's a C<dumpDepth>
+specified. If not, -1 is assumed; if so, the supplied value gets passed on to
+C<dumpvar.pl>. This tells C<dumpvar.pl> where to leave off when dumping a
+structure: -1 means dump everything.
+
+C<dumpValue()> is then called if possible; if not, C<dumpit()>just prints a
+warning.
+
+In either case, C<$single>, C<$trace>, C<$frame>, and C<$doret> are restored
+and we then return to the caller.
+
+=cut
+
+sub dumpit {
+
+ # Save the current output filehandle and switch to the one
+ # passed in as the first parameter.
+ local ($savout) = select(shift);
+
+ # Save current settings of $single and $trace, and then turn them off.
+ my $osingle = $single;
+ my $otrace = $trace;
+ $single = $trace = 0;
+
+ # XXX Okay, what do $frame and $doret do, again?
+ local $frame = 0;
+ local $doret = -2;
+
+ # Load dumpvar.pl unless we've already got the sub we need from it.
+ unless ( defined &main::dumpValue ) {
+ do 'dumpvar.pl' or die $@;
+ }
+
+ # If the load succeeded (or we already had dumpvalue()), go ahead
+ # and dump things.
+ if ( defined &main::dumpValue ) {
+ local $\ = '';
+ local $, = '';
+ local $" = ' ';
+ my $v = shift;
+ my $maxdepth = shift || $option{dumpDepth};
+ $maxdepth = -1 unless defined $maxdepth; # -1 means infinite depth
+ &main::dumpValue( $v, $maxdepth );
+ } ## end if (defined &main::dumpValue)
+
+ # Oops, couldn't load dumpvar.pl.
+ else {
+ local $\ = '';
+ print $OUT "dumpvar.pl not available.\n";
+ }
+
+ # Reset $single and $trace to their old values.
+ $single = $osingle;
+ $trace = $otrace;
+
+ # Restore the old filehandle.
+ select($savout);
+} ## end sub dumpit
+
+=head2 C<print_trace>
+
+C<print_trace>'s job is to print a stack trace. It does this via the
+C<dump_trace> routine, which actually does all the ferreting-out of the
+stack trace data. C<print_trace> takes care of formatting it nicely and
+printing it to the proper filehandle.
+
+Parameters:
+
+=over 4
+
+=item *
+
+The filehandle to print to.
+
+=item *
+
+How many frames to skip before starting trace.
+
+=item *
+
+How many frames to print.
+
+=item *
+
+A flag: if true, print a I<short> trace without filenames, line numbers, or arguments
+
+=back
+
+The original comment below seems to be noting that the traceback may not be
+correct if this routine is called in a tied method.
+
+=cut
+
+# Tied method do not create a context, so may get wrong message:
+
+sub print_trace {
+ local $\ = '';
+ my $fh = shift;
+
+ # If this is going to a slave editor, but we're not the primary
+ # debugger, reset it first.
+ resetterm(1)
+ if $fh eq $LINEINFO # slave editor
+ and $LINEINFO eq $OUT # normal output
+ and $term_pid != $$; # not the primary
+
+ # Collect the actual trace information to be formatted.
+ # This is an array of hashes of subroutine call info.
+ my @sub = dump_trace( $_[0] + 1, $_[1] );
+
+ # Grab the "short report" flag from @_.
+ my $short = $_[2]; # Print short report, next one for sub name
+
+ # Run through the traceback info, format it, and print it.
+ my $s;
+ for ( $i = 0 ; $i <= $#sub ; $i++ ) {
+
+ # Drop out if the user has lost interest and hit control-C.
+ last if $signal;
+
+ # Set the separator so arrys print nice.
+ local $" = ', ';
+
+ # Grab and stringify the arguments if they are there.
+ my $args =
+ defined $sub[$i]{args}
+ ? "(@{ $sub[$i]{args} })"
+ : '';
+
+ # Shorten them up if $maxtrace says they're too long.
+ $args = ( substr $args, 0, $maxtrace - 3 ) . '...'
+ if length $args > $maxtrace;
+
+ # Get the file name.
+ my $file = $sub[$i]{file};
+
+ # Put in a filename header if short is off.
+ $file = $file eq '-e' ? $file : "file `$file'" unless $short;
+
+ # Get the actual sub's name, and shorten to $maxtrace's requirement.
+ $s = $sub[$i]{sub};
+ $s = ( substr $s, 0, $maxtrace - 3 ) . '...' if length $s > $maxtrace;
+
+ # Short report uses trimmed file and sub names.
+ if ($short) {
+ my $sub = @_ >= 4 ? $_[3] : $s;
+ print $fh "$sub[$i]{context}=$sub$args from $file:$sub[$i]{line}\n";
+ } ## end if ($short)
+
+ # Non-short report includes full names.
+ else {
+ print $fh "$sub[$i]{context} = $s$args"
+ . " called from $file"
+ . " line $sub[$i]{line}\n";
+ }
+ } ## end for ($i = 0 ; $i <= $#sub...
+} ## end sub print_trace
+
+=head2 dump_trace(skip[,count])
+
+Actually collect the traceback information available via C<caller()>. It does
+some filtering and cleanup of the data, but mostly it just collects it to
+make C<print_trace()>'s job easier.
+
+C<skip> defines the number of stack frames to be skipped, working backwards
+from the most current. C<count> determines the total number of frames to
+be returned; all of them (well, the first 10^9) are returned if C<count>
+is omitted.
+
+This routine returns a list of hashes, from most-recent to least-recent
+stack frame. Each has the following keys and values:
+
+=over 4
+
+=item * C<context> - C<.> (null), C<$> (scalar), or C<@> (array)
+
+=item * C<sub> - subroutine name, or C<eval> information
+
+=item * C<args> - undef, or a reference to an array of arguments
+
+=item * C<file> - the file in which this item was defined (if any)
+
+=item * C<line> - the line on which it was defined
+
+=back
+
+=cut
+
+sub dump_trace {
+
+ # How many levels to skip.
+ my $skip = shift;
+
+ # How many levels to show. (1e9 is a cheap way of saying "all of them";
+ # it's unlikely that we'll have more than a billion stack frames. If you
+ # do, you've got an awfully big machine...)
+ my $count = shift || 1e9;
+
+ # We increment skip because caller(1) is the first level *back* from
+ # the current one. Add $skip to the count of frames so we have a
+ # simple stop criterion, counting from $skip to $count+$skip.
+ $skip++;
+ $count += $skip;
+
+ # These variables are used to capture output from caller();
+ my ( $p, $file, $line, $sub, $h, $context );
+
+ my ( $e, $r, @a, @sub, $args );
+
+ # XXX Okay... why'd we do that?
+ my $nothard = not $frame & 8;
+ local $frame = 0;
+
+ # Do not want to trace this.
+ my $otrace = $trace;
+ $trace = 0;
+
+ # Start out at the skip count.
+ # If we haven't reached the number of frames requested, and caller() is
+ # still returning something, stay in the loop. (If we pass the requested
+ # number of stack frames, or we run out - caller() returns nothing - we
+ # quit.
+ # Up the stack frame index to go back one more level each time.
+ for (
+ $i = $skip ;
+ $i < $count
+ and ( $p, $file, $line, $sub, $h, $context, $e, $r ) = caller($i) ;
+ $i++
+ )
+ {
+
+ # Go through the arguments and save them for later.
+ @a = ();
+ for $arg (@args) {
+ my $type;
+ if ( not defined $arg ) { # undefined parameter
+ push @a, "undef";
+ }
+
+ elsif ( $nothard and tied $arg ) { # tied parameter
+ push @a, "tied";
+ }
+ elsif ( $nothard and $type = ref $arg ) { # reference
+ push @a, "ref($type)";
+ }
+ else { # can be stringified
+ local $_ =
+ "$arg"; # Safe to stringify now - should not call f().
+
+ # Backslash any single-quotes or backslashes.
+ s/([\'\\])/\\$1/g;
+
+ # Single-quote it unless it's a number or a colon-separated
+ # name.
+ s/(.*)/'$1'/s
+ unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
+
+ # Turn high-bit characters into meta-whatever.
+ s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+
+ # Turn control characters into ^-whatever.
+ s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+
+ push( @a, $_ );
+ } ## end else [ if (not defined $arg)
+ } ## end for $arg (@args)
+
+ # If context is true, this is array (@)context.
+ # If context is false, this is scalar ($) context.
+ # If neither, context isn't defined. (This is apparently a 'can't
+ # happen' trap.)
+ $context = $context ? '@' : ( defined $context ? "\$" : '.' );
+
+ # if the sub has args ($h true), make an anonymous array of the
+ # dumped args.
+ $args = $h ? [@a] : undef;
+
+ # remove trailing newline-whitespace-semicolon-end of line sequence
+ # from the eval text, if any.
+ $e =~ s/\n\s*\;\s*\Z// if $e;
+
+ # Escape backslashed single-quotes again if necessary.
+ $e =~ s/([\\\'])/\\$1/g if $e;
+
+ # if the require flag is true, the eval text is from a require.
+ if ($r) {
+ $sub = "require '$e'";
+ }
+
+ # if it's false, the eval text is really from an eval.
+ elsif ( defined $r ) {
+ $sub = "eval '$e'";
+ }
+
+ # If the sub is '(eval)', this is a block eval, meaning we don't
+ # know what the eval'ed text actually was.
+ elsif ( $sub eq '(eval)' ) {
+ $sub = "eval {...}";
+ }
+
+ # Stick the collected information into @sub as an anonymous hash.
+ push(
+ @sub,
+ {
+ context => $context,
+ sub => $sub,
+ args => $args,
+ file => $file,
+ line => $line
+ }
+ );
+
+ # Stop processing frames if the user hit control-C.
+ last if $signal;
+ } ## end for ($i = $skip ; $i < ...
+
+ # Restore the trace value again.
+ $trace = $otrace;
+ @sub;
+} ## end sub dump_trace
+
+=head2 C<action()>
+
+C<action()> takes input provided as the argument to an add-action command,
+either pre- or post-, and makes sure it's a complete command. It doesn't do
+any fancy parsing; it just keeps reading input until it gets a string
+without a trailing backslash.
+
+=cut
+
+sub action {
+ my $action = shift;
+
+ while ( $action =~ s/\\$// ) {
+
+ # We have a backslash on the end. Read more.
+ $action .= &gets;
+ } ## end while ($action =~ s/\\$//)
+
+ # Return the assembled action.
+ $action;
+} ## end sub action
+
+=head2 unbalanced
+
+This routine mostly just packages up a regular expression to be used
+to check that the thing it's being matched against has properly-matched
+curly braces.
+
+Of note is the definition of the C<$balanced_brace_re> global via C<||=>, which
+speeds things up by only creating the qr//'ed expression once; if it's
+already defined, we don't try to define it again. A speed hack.
+
+=cut
+
+sub unbalanced {
+
+ # I hate using globals!
+ $balanced_brace_re ||= qr{
+ ^ \{
+ (?:
+ (?> [^{}] + ) # Non-parens without backtracking
+ |
+ (??{ $balanced_brace_re }) # Group with matching parens
+ ) *
+ \} $
+ }x;
+ return $_[0] !~ m/$balanced_brace_re/;
+} ## end sub unbalanced
+
+=head2 C<gets()>
+
+C<gets()> is a primitive (very primitive) routine to read continuations.
+It was devised for reading continuations for actions.
+it just reads more input with C<readline()> and returns it.
+
+=cut
+
+sub gets {
+ &readline("cont: ");
+}
+
+=head2 C<DB::system()> - handle calls to<system()> without messing up the debugger
+
+The C<system()> function assumes that it can just go ahead and use STDIN and
+STDOUT, but under the debugger, we want it to use the debugger's input and
+outout filehandles.
+
+C<DB::system()> socks away the program's STDIN and STDOUT, and then substitutes
+the debugger's IN and OUT filehandles for them. It does the C<system()> call,
+and then puts everything back again.
+
+=cut
+
+sub system {
+
+ # We save, change, then restore STDIN and STDOUT to avoid fork() since
+ # some non-Unix systems can do system() but have problems with fork().
+ open( SAVEIN, "<&STDIN" ) || &warn("Can't save STDIN");
+ open( SAVEOUT, ">&STDOUT" ) || &warn("Can't save STDOUT");
+ open( STDIN, "<&IN" ) || &warn("Can't redirect STDIN");
+ open( STDOUT, ">&OUT" ) || &warn("Can't redirect STDOUT");
+
+ # XXX: using csh or tcsh destroys sigint retvals!
+ system(@_);
+ open( STDIN, "<&SAVEIN" ) || &warn("Can't restore STDIN");
+ open( STDOUT, ">&SAVEOUT" ) || &warn("Can't restore STDOUT");
+ close(SAVEIN);
+ close(SAVEOUT);
+
+ # most of the $? crud was coping with broken cshisms
+ if ( $? >> 8 ) {
+ &warn( "(Command exited ", ( $? >> 8 ), ")\n" );
+ }
+ elsif ($?) {
+ &warn(
+ "(Command died of SIG#",
+ ( $? & 127 ),
+ ( ( $? & 128 ) ? " -- core dumped" : "" ),
+ ")", "\n"
+ );
+ } ## end elsif ($?)
+
+ return $?;
+
+} ## end sub system
+
+=head1 TTY MANAGEMENT
+
+The subs here do some of the terminal management for multiple debuggers.
+
+=head2 setterm
+
+Top-level function called when we want to set up a new terminal for use
+by the debugger.
+
+If the C<noTTY> debugger option was set, we'll either use the terminal
+supplied (the value of the C<noTTY> option), or we'll use C<Term::Rendezvous>
+to find one. If we're a forked debugger, we call C<resetterm> to try to
+get a whole new terminal if we can.
+
+In either case, we set up the terminal next. If the C<ReadLine> option was
+true, we'll get a C<Term::ReadLine> object for the current terminal and save
+the appropriate attributes. We then
+
+=cut
+
+sub setterm {
+
+ # Load Term::Readline, but quietly; don't debug it and don't trace it.
+ local $frame = 0;
+ local $doret = -2;
+ eval { require Term::ReadLine } or die $@;
+
+ # If noTTY is set, but we have a TTY name, go ahead and hook up to it.
+ if ($notty) {
+ if ($tty) {
+ my ( $i, $o ) = split $tty, /,/;
+ $o = $i unless defined $o;
+ open( IN, "<$i" ) or die "Cannot open TTY `$i' for read: $!";
+ open( OUT, ">$o" ) or die "Cannot open TTY `$o' for write: $!";
+ $IN = \*IN;
+ $OUT = \*OUT;
+ my $sel = select($OUT);
+ $| = 1;
+ select($sel);
+ } ## end if ($tty)
+
+ # We don't have a TTY - try to find one via Term::Rendezvous.
+ else {
+ eval "require Term::Rendezvous;" or die;
+
+ # See if we have anything to pass to Term::Rendezvous.
+ # Use $HOME/.perldbtty$$ if not.
+ my $rv = $ENV{PERLDB_NOTTY} || "$ENV{HOME}/.perldbtty$$";
+
+ # Rendezvous and get the filehandles.
+ my $term_rv = new Term::Rendezvous $rv;
+ $IN = $term_rv->IN;
+ $OUT = $term_rv->OUT;
+ } ## end else [ if ($tty)
+ } ## end if ($notty)
+
+ # We're a daughter debugger. Try to fork off another TTY.
+ if ( $term_pid eq '-1' ) { # In a TTY with another debugger
+ resetterm(2);
+ }
+
+ # If we shouldn't use Term::ReadLine, don't.
+ if ( !$rl ) {
+ $term = new Term::ReadLine::Stub 'perldb', $IN, $OUT;
+ }
+
+ # We're using Term::ReadLine. Get all the attributes for this terminal.
+ else {
+ $term = new Term::ReadLine 'perldb', $IN, $OUT;
+
+ $rl_attribs = $term->Attribs;
+ $rl_attribs->{basic_word_break_characters} .= '-:+/*,[])}'
+ if defined $rl_attribs->{basic_word_break_characters}
+ and index( $rl_attribs->{basic_word_break_characters}, ":" ) == -1;
+ $rl_attribs->{special_prefixes} = '$@&%';
+ $rl_attribs->{completer_word_break_characters} .= '$@&%';
+ $rl_attribs->{completion_function} = \&db_complete;
+ } ## end else [ if (!$rl)
+
+ # Set up the LINEINFO filehandle.
+ $LINEINFO = $OUT unless defined $LINEINFO;
+ $lineinfo = $console unless defined $lineinfo;
+
+ $term->MinLine(2);
+
+ &load_hist();
+
+ if ( $term->Features->{setHistory} and "@hist" ne "?" ) {
+ $term->SetHistory(@hist);
+ }
+
+ # XXX Ornaments are turned on unconditionally, which is not
+ # always a good thing.
+ ornaments($ornaments) if defined $ornaments;
+ $term_pid = $$;
+} ## end sub setterm
+
+sub load_hist {
+ $histfile //= option_val("HistFile", undef);
+ return unless defined $histfile;
+ open my $fh, "<", $histfile or return;
+ local $/ = "\n";
+ @hist = ();
+ while (<$fh>) {
+ chomp;
+ push @hist, $_;
+ }
+ close $fh;
+}
+
+sub save_hist {
+ return unless defined $histfile;
+ eval { require File::Path } or return;
+ eval { require File::Basename } or return;
+ File::Path::mkpath(File::Basename::dirname($histfile));
+ open my $fh, ">", $histfile or die "Could not open '$histfile': $!";
+ $histsize //= option_val("HistSize",100);
+ my @copy = grep { $_ ne '?' } @hist;
+ my $start = scalar(@copy) > $histsize ? scalar(@copy)-$histsize : 0;
+ for ($start .. $#copy) {
+ print $fh "$copy[$_]\n";
+ }
+ close $fh or die "Could not write '$histfile': $!";
+}
+
+=head1 GET_FORK_TTY EXAMPLE FUNCTIONS
+
+When the process being debugged forks, or the process invokes a command
+via C<system()> which starts a new debugger, we need to be able to get a new
+C<IN> and C<OUT> filehandle for the new debugger. Otherwise, the two processes
+fight over the terminal, and you can never quite be sure who's going to get the
+input you're typing.
+
+C<get_fork_TTY> is a glob-aliased function which calls the real function that
+is tasked with doing all the necessary operating system mojo to get a new
+TTY (and probably another window) and to direct the new debugger to read and
+write there.
+
+The debugger provides C<get_fork_TTY> functions which work for X Windows,
+OS/2, and Mac OS X. Other systems are not supported. You are encouraged
+to write C<get_fork_TTY> functions which work for I<your> platform
+and contribute them.
+
+=head3 C<xterm_get_fork_TTY>
+
+This function provides the C<get_fork_TTY> function for X windows. If a
+program running under the debugger forks, a new <xterm> window is opened and
+the subsidiary debugger is directed there.
+
+The C<open()> call is of particular note here. We have the new C<xterm>
+we're spawning route file number 3 to STDOUT, and then execute the C<tty>
+command (which prints the device name of the TTY we'll want to use for input
+and output to STDOUT, then C<sleep> for a very long time, routing this output
+to file number 3. This way we can simply read from the <XT> filehandle (which
+is STDOUT from the I<commands> we ran) to get the TTY we want to use.
+
+Only works if C<xterm> is in your path and C<$ENV{DISPLAY}>, etc. are
+properly set up.
+
+=cut
+
+sub xterm_get_fork_TTY {
+ ( my $name = $0 ) =~ s,^.*[/\\],,s;
+ open XT,
+qq[3>&1 xterm -title "Daughter Perl debugger $pids $name" -e sh -c 'tty 1>&3;\
+ sleep 10000000' |];
+
+ # Get the output from 'tty' and clean it up a little.
+ my $tty = <XT>;
+ chomp $tty;
+
+ $pidprompt = ''; # Shown anyway in titlebar
+
+ # We need $term defined or we can not switch to the newly created xterm
+ if ($tty ne '' && !defined $term) {
+ eval { require Term::ReadLine } or die $@;
+ if ( !$rl ) {
+ $term = new Term::ReadLine::Stub 'perldb', $IN, $OUT;
+ }
+ else {
+ $term = new Term::ReadLine 'perldb', $IN, $OUT;
+ }
+ }
+ # There's our new TTY.
+ return $tty;
+} ## end sub xterm_get_fork_TTY
+
+=head3 C<os2_get_fork_TTY>
+
+XXX It behooves an OS/2 expert to write the necessary documentation for this!
+
+=cut
+
+# This example function resets $IN, $OUT itself
+my $c_pipe = 0;
+sub os2_get_fork_TTY { # A simplification of the following (and works without):
+ local $\ = '';
+ ( my $name = $0 ) =~ s,^.*[/\\],,s;
+ my %opt = ( title => "Daughter Perl debugger $pids $name",
+ ($rl ? (read_by_key => 1) : ()) );
+ require OS2::Process;
+ my ($in, $out, $pid) = eval { OS2::Process::io_term(related => 0, %opt) }
+ or return;
+ $pidprompt = ''; # Shown anyway in titlebar
+ reset_IN_OUT($in, $out);
+ $tty = '*reset*';
+ return ''; # Indicate that reset_IN_OUT is called
+} ## end sub os2_get_fork_TTY
+
+=head3 C<macosx_get_fork_TTY>
+
+The Mac OS X version uses AppleScript to tell Terminal.app to create
+a new window.
+
+=cut
+
+# Notes about Terminal.app's AppleScript support,
+# (aka things that might break in future OS versions).
+#
+# The "do script" command doesn't return a reference to the new window
+# it creates, but since it appears frontmost and windows are enumerated
+# front to back, we can use "first window" === "window 1".
+#
+# Since "do script" is implemented by supplying the argument (plus a
+# return character) as terminal input, there's a potential race condition
+# where the debugger could beat the shell to reading the command.
+# To prevent this, we wait for the screen to clear before proceeding.
+#
+# 10.3 and 10.4:
+# There's no direct accessor for the tty device name, so we fiddle
+# with the window title options until it says what we want.
+#
+# 10.5:
+# There _is_ a direct accessor for the tty device name, _and_ there's
+# a new possible component of the window title (the name of the settings
+# set). A separate version is needed.
+
+my @script_versions=
+
+ ([237, <<'__LEOPARD__'],
+tell application "Terminal"
+ do script "clear;exec sleep 100000"
+ tell first tab of first window
+ copy tty to thetty
+ set custom title to "forked perl debugger"
+ set title displays custom title to true
+ repeat while (length of first paragraph of (get contents)) > 0
+ delay 0.1
+ end repeat
+ end tell
+end tell
+thetty
+__LEOPARD__
+
+ [100, <<'__JAGUAR_TIGER__'],
+tell application "Terminal"
+ do script "clear;exec sleep 100000"
+ tell first window
+ set title displays shell path to false
+ set title displays window size to false
+ set title displays file name to false
+ set title displays device name to true
+ set title displays custom title to true
+ set custom title to ""
+ copy "/dev/" & name to thetty
+ set custom title to "forked perl debugger"
+ repeat while (length of first paragraph of (get contents)) > 0
+ delay 0.1
+ end repeat
+ end tell
+end tell
+thetty
+__JAGUAR_TIGER__
+
+);
+
+sub macosx_get_fork_TTY
+{
+ my($version,$script,$pipe,$tty);
+
+ return unless $version=$ENV{TERM_PROGRAM_VERSION};
+ foreach my $entry (@script_versions) {
+ if ($version>=$entry->[0]) {
+ $script=$entry->[1];
+ last;
+ }
+ }
+ return unless defined($script);
+ return unless open($pipe,'-|','/usr/bin/osascript','-e',$script);
+ $tty=readline($pipe);
+ close($pipe);
+ return unless defined($tty) && $tty =~ m(^/dev/);
+ chomp $tty;
+ return $tty;
+}
+
+=head2 C<create_IN_OUT($flags)>
+
+Create a new pair of filehandles, pointing to a new TTY. If impossible,
+try to diagnose why.
+
+Flags are:
+
+=over 4
+
+=item * 1 - Don't know how to create a new TTY.
+
+=item * 2 - Debugger has forked, but we can't get a new TTY.
+
+=item * 4 - standard debugger startup is happening.
+
+=back
+
+=cut
+
+sub create_IN_OUT { # Create a window with IN/OUT handles redirected there
+
+ # If we know how to get a new TTY, do it! $in will have
+ # the TTY name if get_fork_TTY works.
+ my $in = &get_fork_TTY if defined &get_fork_TTY;
+
+ # It used to be that
+ $in = $fork_TTY if defined $fork_TTY; # Backward compatibility
+
+ if ( not defined $in ) {
+ my $why = shift;
+
+ # We don't know how.
+ print_help(<<EOP) if $why == 1;
+I<#########> Forked, but do not know how to create a new B<TTY>. I<#########>
+EOP
+
+ # Forked debugger.
+ print_help(<<EOP) if $why == 2;
+I<#########> Daughter session, do not know how to change a B<TTY>. I<#########>
+ This may be an asynchronous session, so the parent debugger may be active.
+EOP
+
+ # Note that both debuggers are fighting over the same input.
+ print_help(<<EOP) if $why != 4;
+ Since two debuggers fight for the same TTY, input is severely entangled.
+
+EOP
+ print_help(<<EOP);
+ I know how to switch the output to a different window in xterms, OS/2
+ consoles, and Mac OS X Terminal.app only. For a manual switch, put the name
+ of the created I<TTY> in B<\$DB::fork_TTY>, or define a function
+ B<DB::get_fork_TTY()> returning this.
+
+ On I<UNIX>-like systems one can get the name of a I<TTY> for the given window
+ by typing B<tty>, and disconnect the I<shell> from I<TTY> by B<sleep 1000000>.
+
+EOP
+ } ## end if (not defined $in)
+ elsif ( $in ne '' ) {
+ TTY($in);
+ }
+ else {
+ $console = ''; # Indicate no need to open-from-the-console
+ }
+ undef $fork_TTY;
+} ## end sub create_IN_OUT
+
+=head2 C<resetterm>
+
+Handles rejiggering the prompt when we've forked off a new debugger.
+
+If the new debugger happened because of a C<system()> that invoked a
+program under the debugger, the arrow between the old pid and the new
+in the prompt has I<two> dashes instead of one.
+
+We take the current list of pids and add this one to the end. If there
+isn't any list yet, we make one up out of the initial pid associated with
+the terminal and our new pid, sticking an arrow (either one-dashed or
+two dashed) in between them.
+
+If C<CreateTTY> is off, or C<resetterm> was called with no arguments,
+we don't try to create a new IN and OUT filehandle. Otherwise, we go ahead
+and try to do that.
+
+=cut
+
+sub resetterm { # We forked, so we need a different TTY
+
+ # Needs to be passed to create_IN_OUT() as well.
+ my $in = shift;
+
+ # resetterm(2): got in here because of a system() starting a debugger.
+ # resetterm(1): just forked.
+ my $systemed = $in > 1 ? '-' : '';
+
+ # If there's already a list of pids, add this to the end.
+ if ($pids) {
+ $pids =~ s/\]/$systemed->$$]/;
+ }
+
+ # No pid list. Time to make one.
+ else {
+ $pids = "[$term_pid->$$]";
+ }
+
+ # The prompt we're going to be using for this debugger.
+ $pidprompt = $pids;
+
+ # We now 0wnz this terminal.
+ $term_pid = $$;
+
+ # Just return if we're not supposed to try to create a new TTY.
+ return unless $CreateTTY & $in;
+
+ # Try to create a new IN/OUT pair.
+ create_IN_OUT($in);
+} ## end sub resetterm
+
+=head2 C<readline>
+
+First, we handle stuff in the typeahead buffer. If there is any, we shift off
+the next line, print a message saying we got it, add it to the terminal
+history (if possible), and return it.
+
+If there's nothing in the typeahead buffer, check the command filehandle stack.
+If there are any filehandles there, read from the last one, and return the line
+if we got one. If not, we pop the filehandle off and close it, and try the
+next one up the stack.
+
+If we've emptied the filehandle stack, we check to see if we've got a socket
+open, and we read that and return it if we do. If we don't, we just call the
+core C<readline()> and return its value.
+
+=cut
+
+sub readline {
+
+ # Localize to prevent it from being smashed in the program being debugged.
+ local $.;
+
+ # Pull a line out of the typeahead if there's stuff there.
+ if (@typeahead) {
+
+ # How many lines left.
+ my $left = @typeahead;
+
+ # Get the next line.
+ my $got = shift @typeahead;
+
+ # Print a message saying we got input from the typeahead.
+ local $\ = '';
+ print $OUT "auto(-$left)", shift, $got, "\n";
+
+ # Add it to the terminal history (if possible).
+ $term->AddHistory($got)
+ if length($got) > 1
+ and defined $term->Features->{addHistory};
+ return $got;
+ } ## end if (@typeahead)
+
+ # We really need to read some input. Turn off entry/exit trace and
+ # return value printing.
+ local $frame = 0;
+ local $doret = -2;
+
+ # If there are stacked filehandles to read from ...
+ while (@cmdfhs) {
+
+ # Read from the last one in the stack.
+ my $line = CORE::readline( $cmdfhs[-1] );
+
+ # If we got a line ...
+ defined $line
+ ? ( print $OUT ">> $line" and return $line ) # Echo and return
+ : close pop @cmdfhs; # Pop and close
+ } ## end while (@cmdfhs)
+
+ # Nothing on the filehandle stack. Socket?
+ if ( ref $OUT and UNIVERSAL::isa( $OUT, 'IO::Socket::INET' ) ) {
+
+ # Send anyting we have to send.
+ $OUT->write( join( '', @_ ) );
+
+ # Receive anything there is to receive.
+ $stuff;
+ my $stuff = '';
+ my $buf;
+ do {
+ $IN->recv( $buf = '', 2048 ); # XXX "what's wrong with sysread?"
+ # XXX Don't know. You tell me.
+ } while length $buf and ($stuff .= $buf) !~ /\n/;
+
+ # What we got.
+ $stuff;
+ } ## end if (ref $OUT and UNIVERSAL::isa...
+
+ # No socket. Just read from the terminal.
+ else {
+ $term->readline(@_);
+ }
+} ## end sub readline
+
+=head1 OPTIONS SUPPORT ROUTINES
+
+These routines handle listing and setting option values.
+
+=head2 C<dump_option> - list the current value of an option setting
+
+This routine uses C<option_val> to look up the value for an option.
+It cleans up escaped single-quotes and then displays the option and
+its value.
+
+=cut
+
+sub dump_option {
+ my ( $opt, $val ) = @_;
+ $val = option_val( $opt, 'N/A' );
+ $val =~ s/([\\\'])/\\$1/g;
+ printf $OUT "%20s = '%s'\n", $opt, $val;
+} ## end sub dump_option
+
+sub options2remember {
+ foreach my $k (@RememberOnROptions) {
+ $option{$k} = option_val( $k, 'N/A' );
+ }
+ return %option;
+}
+
+=head2 C<option_val> - find the current value of an option
+
+This can't just be a simple hash lookup because of the indirect way that
+the option values are stored. Some are retrieved by calling a subroutine,
+some are just variables.
+
+You must supply a default value to be used in case the option isn't set.
+
+=cut
+
+sub option_val {
+ my ( $opt, $default ) = @_;
+ my $val;
+
+ # Does this option exist, and is it a variable?
+ # If so, retrieve the value via the value in %optionVars.
+ if ( defined $optionVars{$opt}
+ and defined ${ $optionVars{$opt} } )
+ {
+ $val = ${ $optionVars{$opt} };
+ }
+
+ # Does this option exist, and it's a subroutine?
+ # If so, call the subroutine via the ref in %optionAction
+ # and capture the value.
+ elsif ( defined $optionAction{$opt}
+ and defined &{ $optionAction{$opt} } )
+ {
+ $val = &{ $optionAction{$opt} }();
+ }
+
+ # If there's an action or variable for the supplied option,
+ # but no value was set, use the default.
+ elsif (defined $optionAction{$opt} and not defined $option{$opt}
+ or defined $optionVars{$opt} and not defined ${ $optionVars{$opt} } )
+ {
+ $val = $default;
+ }
+
+ # Otherwise, do the simple hash lookup.
+ else {
+ $val = $option{$opt};
+ }
+
+ # If the value isn't defined, use the default.
+ # Then return whatever the value is.
+ $val = $default unless defined $val;
+ $val;
+} ## end sub option_val
+
+=head2 C<parse_options>
+
+Handles the parsing and execution of option setting/displaying commands.
+
+An option entered by itself is assumed to be I<set me to 1> (the default value)
+if the option is a boolean one. If not, the user is prompted to enter a valid
+value or to query the current value (via C<option? >).
+
+If C<option=value> is entered, we try to extract a quoted string from the
+value (if it is quoted). If it's not, we just use the whole value as-is.
+
+We load any modules required to service this option, and then we set it: if
+it just gets stuck in a variable, we do that; if there's a subroutine to
+handle setting the option, we call that.
+
+Finally, if we're running in interactive mode, we display the effect of the
+user's command back to the terminal, skipping this if we're setting things
+during initialization.
+
+=cut
+
+sub parse_options {
+ local ($_) = @_;
+ local $\ = '';
+
+ # These options need a value. Don't allow them to be clobbered by accident.
+ my %opt_needs_val = map { ( $_ => 1 ) } qw{
+ dumpDepth arrayDepth hashDepth LineInfo maxTraceLen ornaments windowSize
+ pager quote ReadLine recallCommand RemotePort ShellBang TTY CommandSet
+ };
+
+ while (length) {
+ my $val_defaulted;
+
+ # Clean off excess leading whitespace.
+ s/^\s+// && next;
+
+ # Options are always all word characters, followed by a non-word
+ # separator.
+ s/^(\w+)(\W?)// or print( $OUT "Invalid option `$_'\n" ), last;
+ my ( $opt, $sep ) = ( $1, $2 );
+
+ # Make sure that such an option exists.
+ my $matches = grep( /^\Q$opt/ && ( $option = $_ ), @options )
+ || grep( /^\Q$opt/i && ( $option = $_ ), @options );
+
+ print( $OUT "Unknown option `$opt'\n" ), next unless $matches;
+ print( $OUT "Ambiguous option `$opt'\n" ), next if $matches > 1;
+ my $val;
+
+ # '?' as separator means query, but must have whitespace after it.
+ if ( "?" eq $sep ) {
+ print( $OUT "Option query `$opt?' followed by non-space `$_'\n" ),
+ last
+ if /^\S/;
+
+ #&dump_option($opt);
+ } ## end if ("?" eq $sep)
+
+ # Separator is whitespace (or just a carriage return).
+ # They're going for a default, which we assume is 1.
+ elsif ( $sep !~ /\S/ ) {
+ $val_defaulted = 1;
+ $val = "1"; # this is an evil default; make 'em set it!
+ }
+
+ # Separator is =. Trying to set a value.
+ elsif ( $sep eq "=" ) {
+
+ # If quoted, extract a quoted string.
+ if (s/ (["']) ( (?: \\. | (?! \1 ) [^\\] )* ) \1 //x) {
+ my $quote = $1;
+ ( $val = $2 ) =~ s/\\([$quote\\])/$1/g;
+ }
+
+ # Not quoted. Use the whole thing. Warn about 'option='.
+ else {
+ s/^(\S*)//;
+ $val = $1;
+ print OUT qq(Option better cleared using $opt=""\n)
+ unless length $val;
+ } ## end else [ if (s/ (["']) ( (?: \\. | (?! \1 ) [^\\] )* ) \1 //x)
+
+ } ## end elsif ($sep eq "=")
+
+ # "Quoted" with [], <>, or {}.
+ else { #{ to "let some poor schmuck bounce on the % key in B<vi>."
+ my ($end) =
+ "\\" . substr( ")]>}$sep", index( "([<{", $sep ), 1 ); #}
+ s/^(([^\\$end]|\\[\\$end])*)$end($|\s+)//
+ or print( $OUT "Unclosed option value `$opt$sep$_'\n" ), last;
+ ( $val = $1 ) =~ s/\\([\\$end])/$1/g;
+ } ## end else [ if ("?" eq $sep)
+
+ # Exclude non-booleans from getting set to 1 by default.
+ if ( $opt_needs_val{$option} && $val_defaulted ) {
+ my $cmd = ( $CommandSet eq '580' ) ? 'o' : 'O';
+ print $OUT
+"Option `$opt' is non-boolean. Use `$cmd $option=VAL' to set, `$cmd $option?' to query\n";
+ next;
+ } ## end if ($opt_needs_val{$option...
+
+ # Save the option value.
+ $option{$option} = $val if defined $val;
+
+ # Load any module that this option requires.
+ eval qq{
+ local \$frame = 0;
+ local \$doret = -2;
+ require '$optionRequire{$option}';
+ 1;
+ } || die # XXX: shouldn't happen
+ if defined $optionRequire{$option}
+ && defined $val;
+
+ # Set it.
+ # Stick it in the proper variable if it goes in a variable.
+ ${ $optionVars{$option} } = $val
+ if defined $optionVars{$option}
+ && defined $val;
+
+ # Call the appropriate sub if it gets set via sub.
+ &{ $optionAction{$option} }($val)
+ if defined $optionAction{$option}
+ && defined &{ $optionAction{$option} }
+ && defined $val;
+
+ # Not initialization - echo the value we set it to.
+ dump_option($option) unless $OUT eq \*STDERR;
+ } ## end while (length)
+} ## end sub parse_options
+
+=head1 RESTART SUPPORT
+
+These routines are used to store (and restore) lists of items in environment
+variables during a restart.
+
+=head2 set_list
+
+Set_list packages up items to be stored in a set of environment variables
+(VAR_n, containing the number of items, and VAR_0, VAR_1, etc., containing
+the values). Values outside the standard ASCII charset are stored by encoding
+then as hexadecimal values.
+
+=cut
+
+sub set_list {
+ my ( $stem, @list ) = @_;
+ my $val;
+
+ # VAR_n: how many we have. Scalar assignment gets the number of items.
+ $ENV{"${stem}_n"} = @list;
+
+ # Grab each item in the list, escape the backslashes, encode the non-ASCII
+ # as hex, and then save in the appropriate VAR_0, VAR_1, etc.
+ for $i ( 0 .. $#list ) {
+ $val = $list[$i];
+ $val =~ s/\\/\\\\/g;
+ $val =~ s/([\0-\37\177\200-\377])/"\\0x" . unpack('H2',$1)/eg;
+ $ENV{"${stem}_$i"} = $val;
+ } ## end for $i (0 .. $#list)
+} ## end sub set_list
+
+=head2 get_list
+
+Reverse the set_list operation: grab VAR_n to see how many we should be getting
+back, and then pull VAR_0, VAR_1. etc. back out.
+
+=cut
+
+sub get_list {
+ my $stem = shift;
+ my @list;
+ my $n = delete $ENV{"${stem}_n"};
+ my $val;
+ for $i ( 0 .. $n - 1 ) {
+ $val = delete $ENV{"${stem}_$i"};
+ $val =~ s/\\((\\)|0x(..))/ $2 ? $2 : pack('H2', $3) /ge;
+ push @list, $val;
+ }
+ @list;
+} ## end sub get_list
+
+=head1 MISCELLANEOUS SIGNAL AND I/O MANAGEMENT
+
+=head2 catch()
+
+The C<catch()> subroutine is the essence of fast and low-impact. We simply
+set an already-existing global scalar variable to a constant value. This
+avoids allocating any memory possibly in the middle of something that will
+get all confused if we do, particularly under I<unsafe signals>.
+
+=cut
+
+sub catch {
+ $signal = 1;
+ return; # Put nothing on the stack - malloc/free land!
+}
+
+=head2 C<warn()>
+
+C<warn> emits a warning, by joining together its arguments and printing
+them, with couple of fillips.
+
+If the composited message I<doesn't> end with a newline, we automatically
+add C<$!> and a newline to the end of the message. The subroutine expects $OUT
+to be set to the filehandle to be used to output warnings; it makes no
+assumptions about what filehandles are available.
+
+=cut
+
+sub warn {
+ my ($msg) = join( "", @_ );
+ $msg .= ": $!\n" unless $msg =~ /\n$/;
+ local $\ = '';
+ print $OUT $msg;
+} ## end sub warn
+
+=head1 INITIALIZATION TTY SUPPORT
+
+=head2 C<reset_IN_OUT>
+
+This routine handles restoring the debugger's input and output filehandles
+after we've tried and failed to move them elsewhere. In addition, it assigns
+the debugger's output filehandle to $LINEINFO if it was already open there.
+
+=cut
+
+sub reset_IN_OUT {
+ my $switch_li = $LINEINFO eq $OUT;
+
+ # If there's a term and it's able to get a new tty, try to get one.
+ if ( $term and $term->Features->{newTTY} ) {
+ ( $IN, $OUT ) = ( shift, shift );
+ $term->newTTY( $IN, $OUT );
+ }
+
+ # This term can't get a new tty now. Better luck later.
+ elsif ($term) {
+ &warn("Too late to set IN/OUT filehandles, enabled on next `R'!\n");
+ }
+
+ # Set the filehndles up as they were.
+ else {
+ ( $IN, $OUT ) = ( shift, shift );
+ }
+
+ # Unbuffer the output filehandle.
+ my $o = select $OUT;
+ $| = 1;
+ select $o;
+
+ # Point LINEINFO to the same output filehandle if it was there before.
+ $LINEINFO = $OUT if $switch_li;
+} ## end sub reset_IN_OUT
+
+=head1 OPTION SUPPORT ROUTINES
+
+The following routines are used to process some of the more complicated
+debugger options.
+
+=head2 C<TTY>
+
+Sets the input and output filehandles to the specified files or pipes.
+If the terminal supports switching, we go ahead and do it. If not, and
+there's already a terminal in place, we save the information to take effect
+on restart.
+
+If there's no terminal yet (for instance, during debugger initialization),
+we go ahead and set C<$console> and C<$tty> to the file indicated.
+
+=cut
+
+sub TTY {
+
+ if ( @_ and $term and $term->Features->{newTTY} ) {
+
+ # This terminal supports switching to a new TTY.
+ # Can be a list of two files, or on string containing both names,
+ # comma-separated.
+ # XXX Should this perhaps be an assignment from @_?
+ my ( $in, $out ) = shift;
+ if ( $in =~ /,/ ) {
+
+ # Split list apart if supplied.
+ ( $in, $out ) = split /,/, $in, 2;
+ }
+ else {
+
+ # Use the same file for both input and output.
+ $out = $in;
+ }
+
+ # Open file onto the debugger's filehandles, if you can.
+ open IN, $in or die "cannot open `$in' for read: $!";
+ open OUT, ">$out" or die "cannot open `$out' for write: $!";
+
+ # Swap to the new filehandles.
+ reset_IN_OUT( \*IN, \*OUT );
+
+ # Save the setting for later.
+ return $tty = $in;
+ } ## end if (@_ and $term and $term...
+
+ # Terminal doesn't support new TTY, or doesn't support readline.
+ # Can't do it now, try restarting.
+ &warn("Too late to set TTY, enabled on next `R'!\n") if $term and @_;
+
+ # Useful if done through PERLDB_OPTS:
+ $console = $tty = shift if @_;
+
+ # Return whatever the TTY is.
+ $tty or $console;
+} ## end sub TTY
+
+=head2 C<noTTY>
+
+Sets the C<$notty> global, controlling whether or not the debugger tries to
+get a terminal to read from. If called after a terminal is already in place,
+we save the value to use it if we're restarted.
+
+=cut
+
+sub noTTY {
+ if ($term) {
+ &warn("Too late to set noTTY, enabled on next `R'!\n") if @_;
+ }
+ $notty = shift if @_;
+ $notty;
+} ## end sub noTTY
+
+=head2 C<ReadLine>
+
+Sets the C<$rl> option variable. If 0, we use C<Term::ReadLine::Stub>
+(essentially, no C<readline> processing on this I<terminal>). Otherwise, we
+use C<Term::ReadLine>. Can't be changed after a terminal's in place; we save
+the value in case a restart is done so we can change it then.
+
+=cut
+
+sub ReadLine {
+ if ($term) {
+ &warn("Too late to set ReadLine, enabled on next `R'!\n") if @_;
+ }
+ $rl = shift if @_;
+ $rl;
+} ## end sub ReadLine
+
+=head2 C<RemotePort>
+
+Sets the port that the debugger will try to connect to when starting up.
+If the terminal's already been set up, we can't do it, but we remember the
+setting in case the user does a restart.
+
+=cut
+
+sub RemotePort {
+ if ($term) {
+ &warn("Too late to set RemotePort, enabled on next 'R'!\n") if @_;
+ }
+ $remoteport = shift if @_;
+ $remoteport;
+} ## end sub RemotePort
+
+=head2 C<tkRunning>
+
+Checks with the terminal to see if C<Tk> is running, and returns true or
+false. Returns false if the current terminal doesn't support C<readline>.
+
+=cut
+
+sub tkRunning {
+ if ( ${ $term->Features }{tkRunning} ) {
+ return $term->tkRunning(@_);
+ }
+ else {
+ local $\ = '';
+ print $OUT "tkRunning not supported by current ReadLine package.\n";
+ 0;
+ }
+} ## end sub tkRunning
+
+=head2 C<NonStop>
+
+Sets nonstop mode. If a terminal's already been set up, it's too late; the
+debugger remembers the setting in case you restart, though.
+
+=cut
+
+sub NonStop {
+ if ($term) {
+ &warn("Too late to set up NonStop mode, enabled on next `R'!\n")
+ if @_;
+ }
+ $runnonstop = shift if @_;
+ $runnonstop;
+} ## end sub NonStop
+
+sub DollarCaretP {
+ if ($term) {
+ &warn("Some flag changes could not take effect until next 'R'!\n")
+ if @_;
+ }
+ $^P = parse_DollarCaretP_flags(shift) if @_;
+ expand_DollarCaretP_flags($^P);
+}
+
+=head2 C<pager>
+
+Set up the C<$pager> variable. Adds a pipe to the front unless there's one
+there already.
+
+=cut
+
+sub pager {
+ if (@_) {
+ $pager = shift;
+ $pager = "|" . $pager unless $pager =~ /^(\+?\>|\|)/;
+ }
+ $pager;
+} ## end sub pager
+
+=head2 C<shellBang>
+
+Sets the shell escape command, and generates a printable copy to be used
+in the help.
+
+=cut
+
+sub shellBang {
+
+ # If we got an argument, meta-quote it, and add '\b' if it
+ # ends in a word character.
+ if (@_) {
+ $sh = quotemeta shift;
+ $sh .= "\\b" if $sh =~ /\w$/;
+ }
+
+ # Generate the printable version for the help:
+ $psh = $sh; # copy it
+ $psh =~ s/\\b$//; # Take off trailing \b if any
+ $psh =~ s/\\(.)/$1/g; # De-escape
+ $psh; # return the printable version
+} ## end sub shellBang
+
+=head2 C<ornaments>
+
+If the terminal has its own ornaments, fetch them. Otherwise accept whatever
+was passed as the argument. (This means you can't override the terminal's
+ornaments.)
+
+=cut
+
+sub ornaments {
+ if ( defined $term ) {
+
+ # We don't want to show warning backtraces, but we do want die() ones.
+ local ( $warnLevel, $dieLevel ) = ( 0, 1 );
+
+ # No ornaments if the terminal doesn't support them.
+ return '' unless $term->Features->{ornaments};
+ eval { $term->ornaments(@_) } || '';
+ }
+
+ # Use what was passed in if we can't determine it ourselves.
+ else {
+ $ornaments = shift;
+ }
+} ## end sub ornaments
+
+=head2 C<recallCommand>
+
+Sets the recall command, and builds a printable version which will appear in
+the help text.
+
+=cut
+
+sub recallCommand {
+
+ # If there is input, metaquote it. Add '\b' if it ends with a word
+ # character.
+ if (@_) {
+ $rc = quotemeta shift;
+ $rc .= "\\b" if $rc =~ /\w$/;
+ }
+
+ # Build it into a printable version.
+ $prc = $rc; # Copy it
+ $prc =~ s/\\b$//; # Remove trailing \b
+ $prc =~ s/\\(.)/$1/g; # Remove escapes
+ $prc; # Return the printable version
+} ## end sub recallCommand
+
+=head2 C<LineInfo> - where the line number information goes
+
+Called with no arguments, returns the file or pipe that line info should go to.
+
+Called with an argument (a file or a pipe), it opens that onto the
+C<LINEINFO> filehandle, unbuffers the filehandle, and then returns the
+file or pipe again to the caller.
+
+=cut
+
+sub LineInfo {
+ return $lineinfo unless @_;
+ $lineinfo = shift;
+
+ # If this is a valid "thing to be opened for output", tack a
+ # '>' onto the front.
+ my $stream = ( $lineinfo =~ /^(\+?\>|\|)/ ) ? $lineinfo : ">$lineinfo";
+
+ # If this is a pipe, the stream points to a slave editor.
+ $slave_editor = ( $stream =~ /^\|/ );
+
+ # Open it up and unbuffer it.
+ open( LINEINFO, "$stream" ) || &warn("Cannot open `$stream' for write");
+ $LINEINFO = \*LINEINFO;
+ my $save = select($LINEINFO);
+ $| = 1;
+ select($save);
+
+ # Hand the file or pipe back again.
+ $lineinfo;
+} ## end sub LineInfo
+
+=head1 COMMAND SUPPORT ROUTINES
+
+These subroutines provide functionality for various commands.
+
+=head2 C<list_modules>
+
+For the C<M> command: list modules loaded and their versions.
+Essentially just runs through the keys in %INC, picks each package's
+C<$VERSION> variable, gets the file name, and formats the information
+for output.
+
+=cut
+
+sub list_modules { # versions
+ my %version;
+ my $file;
+
+ # keys are the "as-loaded" name, values are the fully-qualified path
+ # to the file itself.
+ for ( keys %INC ) {
+ $file = $_; # get the module name
+ s,\.p[lm]$,,i; # remove '.pl' or '.pm'
+ s,/,::,g; # change '/' to '::'
+ s/^perl5db$/DB/; # Special case: debugger
+ # moves to package DB
+ s/^Term::ReadLine::readline$/readline/; # simplify readline
+
+ # If the package has a $VERSION package global (as all good packages
+ # should!) decode it and save as partial message.
+ if ( defined ${ $_ . '::VERSION' } ) {
+ $version{$file} = "${ $_ . '::VERSION' } from ";
+ }
+
+ # Finish up the message with the file the package came from.
+ $version{$file} .= $INC{$file};
+ } ## end for (keys %INC)
+
+ # Hey, dumpit() formats a hash nicely, so why not use it?
+ dumpit( $OUT, \%version );
+} ## end sub list_modules
+
+=head2 C<sethelp()>
+
+Sets up the monster string used to format and print the help.
+
+=head3 HELP MESSAGE FORMAT
+
+The help message is a peculiar format unto itself; it mixes C<pod> I<ornaments>
+(C<< B<> >> C<< I<> >>) with tabs to come up with a format that's fairly
+easy to parse and portable, but which still allows the help to be a little
+nicer than just plain text.
+
+Essentially, you define the command name (usually marked up with C<< B<> >>
+and C<< I<> >>), followed by a tab, and then the descriptive text, ending in a
+newline. The descriptive text can also be marked up in the same way. If you
+need to continue the descriptive text to another line, start that line with
+just tabs and then enter the marked-up text.
+
+If you are modifying the help text, I<be careful>. The help-string parser is
+not very sophisticated, and if you don't follow these rules it will mangle the
+help beyond hope until you fix the string.
+
+=cut
+
+sub sethelp {
+
+ # XXX: make sure there are tabs between the command and explanation,
+ # or print_help will screw up your formatting if you have
+ # eeevil ornaments enabled. This is an insane mess.
+
+ $help = "
+Help is currently only available for the new 5.8 command set.
+No help is available for the old command set.
+We assume you know what you're doing if you switch to it.
+
+B<T> Stack trace.
+B<s> [I<expr>] Single step [in I<expr>].
+B<n> [I<expr>] Next, steps over subroutine calls [in I<expr>].
+<B<CR>> Repeat last B<n> or B<s> command.
+B<r> Return from current subroutine.
+B<c> [I<line>|I<sub>] Continue; optionally inserts a one-time-only breakpoint
+ at the specified position.
+B<l> I<min>B<+>I<incr> List I<incr>+1 lines starting at I<min>.
+B<l> I<min>B<->I<max> List lines I<min> through I<max>.
+B<l> I<line> List single I<line>.
+B<l> I<subname> List first window of lines from subroutine.
+B<l> I<\$var> List first window of lines from subroutine referenced by I<\$var>.
+B<l> List next window of lines.
+B<-> List previous window of lines.
+B<v> [I<line>] View window around I<line>.
+B<.> Return to the executed line.
+B<f> I<filename> Switch to viewing I<filename>. File must be already loaded.
+ I<filename> may be either the full name of the file, or a regular
+ expression matching the full file name:
+ B<f> I</home/me/foo.pl> and B<f> I<oo\\.> may access the same file.
+ Evals (with saved bodies) are considered to be filenames:
+ B<f> I<(eval 7)> and B<f> I<eval 7\\b> access the body of the 7th eval
+ (in the order of execution).
+B</>I<pattern>B</> Search forwards for I<pattern>; final B</> is optional.
+B<?>I<pattern>B<?> Search backwards for I<pattern>; final B<?> is optional.
+B<L> [I<a|b|w>] List actions and or breakpoints and or watch-expressions.
+B<S> [[B<!>]I<pattern>] List subroutine names [not] matching I<pattern>.
+B<t> Toggle trace mode.
+B<t> I<expr> Trace through execution of I<expr>.
+B<b> Sets breakpoint on current line)
+B<b> [I<line>] [I<condition>]
+ Set breakpoint; I<line> defaults to the current execution line;
+ I<condition> breaks if it evaluates to true, defaults to '1'.
+B<b> I<subname> [I<condition>]
+ Set breakpoint at first line of subroutine.
+B<b> I<\$var> Set breakpoint at first line of subroutine referenced by I<\$var>.
+B<b> B<load> I<filename> Set breakpoint on 'require'ing the given file.
+B<b> B<postpone> I<subname> [I<condition>]
+ Set breakpoint at first line of subroutine after
+ it is compiled.
+B<b> B<compile> I<subname>
+ Stop after the subroutine is compiled.
+B<B> [I<line>] Delete the breakpoint for I<line>.
+B<B> I<*> Delete all breakpoints.
+B<a> [I<line>] I<command>
+ Set an action to be done before the I<line> is executed;
+ I<line> defaults to the current execution line.
+ Sequence is: check for breakpoint/watchpoint, print line
+ if necessary, do action, prompt user if necessary,
+ execute line.
+B<a> Does nothing
+B<A> [I<line>] Delete the action for I<line>.
+B<A> I<*> Delete all actions.
+B<w> I<expr> Add a global watch-expression.
+B<w> Does nothing
+B<W> I<expr> Delete a global watch-expression.
+B<W> I<*> Delete all watch-expressions.
+B<V> [I<pkg> [I<vars>]] List some (default all) variables in package (default current).
+ Use B<~>I<pattern> and B<!>I<pattern> for positive and negative regexps.
+B<X> [I<vars>] Same as \"B<V> I<currentpackage> [I<vars>]\".
+B<x> I<expr> Evals expression in list context, dumps the result.
+B<m> I<expr> Evals expression in list context, prints methods callable
+ on the first element of the result.
+B<m> I<class> Prints methods callable via the given class.
+B<M> Show versions of loaded modules.
+B<i> I<class> Prints nested parents of given class.
+B<e> Display current thread id.
+B<E> Display all thread ids the current one will be identified: <n>.
+B<y> [I<n> [I<Vars>]] List lexicals in higher scope <n>. Vars same as B<V>.
+
+B<<> ? List Perl commands to run before each prompt.
+B<<> I<expr> Define Perl command to run before each prompt.
+B<<<> I<expr> Add to the list of Perl commands to run before each prompt.
+B<< *> Delete the list of perl commands to run before each prompt.
+B<>> ? List Perl commands to run after each prompt.
+B<>> I<expr> Define Perl command to run after each prompt.
+B<>>B<>> I<expr> Add to the list of Perl commands to run after each prompt.
+B<>>B< *> Delete the list of Perl commands to run after each prompt.
+B<{> I<db_command> Define debugger command to run before each prompt.
+B<{> ? List debugger commands to run before each prompt.
+B<{{> I<db_command> Add to the list of debugger commands to run before each prompt.
+B<{ *> Delete the list of debugger commands to run before each prompt.
+B<$prc> I<number> Redo a previous command (default previous command).
+B<$prc> I<-number> Redo number'th-to-last command.
+B<$prc> I<pattern> Redo last command that started with I<pattern>.
+ See 'B<O> I<recallCommand>' too.
+B<$psh$psh> I<cmd> Run cmd in a subprocess (reads from DB::IN, writes to DB::OUT)"
+ . (
+ $rc eq $sh
+ ? ""
+ : "
+B<$psh> [I<cmd>] Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")."
+ ) . "
+ See 'B<O> I<shellBang>' too.
+B<source> I<file> Execute I<file> containing debugger commands (may nest).
+B<save> I<file> Save current debugger session (actual history) to I<file>.
+B<rerun> Rerun session to current position.
+B<rerun> I<n> Rerun session to numbered command.
+B<rerun> I<-n> Rerun session to number'th-to-last command.
+B<H> I<-number> Display last number commands (default all).
+B<H> I<*> Delete complete history.
+B<p> I<expr> Same as \"I<print {DB::OUT} expr>\" in current package.
+B<|>I<dbcmd> Run debugger command, piping DB::OUT to current pager.
+B<||>I<dbcmd> Same as B<|>I<dbcmd> but DB::OUT is temporarilly select()ed as well.
+B<\=> [I<alias> I<value>] Define a command alias, or list current aliases.
+I<command> Execute as a perl statement in current package.
+B<R> Pure-man-restart of debugger, some of debugger state
+ and command-line options may be lost.
+ Currently the following settings are preserved:
+ history, breakpoints and actions, debugger B<O>ptions
+ and the following command-line options: I<-w>, I<-I>, I<-e>.
+
+B<o> [I<opt>] ... Set boolean option to true
+B<o> [I<opt>B<?>] Query options
+B<o> [I<opt>B<=>I<val>] [I<opt>=B<\">I<val>B<\">] ...
+ Set options. Use quotes if spaces in value.
+ I<recallCommand>, I<ShellBang> chars used to recall command or spawn shell;
+ I<pager> program for output of \"|cmd\";
+ I<tkRunning> run Tk while prompting (with ReadLine);
+ I<signalLevel> I<warnLevel> I<dieLevel> level of verbosity;
+ I<inhibit_exit> Allows stepping off the end of the script.
+ I<ImmediateStop> Debugger should stop as early as possible.
+ I<RemotePort> Remote hostname:port for remote debugging
+ The following options affect what happens with B<V>, B<X>, and B<x> commands:
+ I<arrayDepth>, I<hashDepth> print only first N elements ('' for all);
+ I<compactDump>, I<veryCompact> change style of array and hash dump;
+ I<globPrint> whether to print contents of globs;
+ I<DumpDBFiles> dump arrays holding debugged files;
+ I<DumpPackages> dump symbol tables of packages;
+ I<DumpReused> dump contents of \"reused\" addresses;
+ I<quote>, I<HighBit>, I<undefPrint> change style of string dump;
+ I<bareStringify> Do not print the overload-stringified value;
+ Other options include:
+ I<PrintRet> affects printing of return value after B<r> command,
+ I<frame> affects printing messages on subroutine entry/exit.
+ I<AutoTrace> affects printing messages on possible breaking points.
+ I<maxTraceLen> gives max length of evals/args listed in stack trace.
+ I<ornaments> affects screen appearance of the command line.
+ I<CreateTTY> bits control attempts to create a new TTY on events:
+ 1: on fork() 2: debugger is started inside debugger
+ 4: on startup
+ During startup options are initialized from \$ENV{PERLDB_OPTS}.
+ You can put additional initialization options I<TTY>, I<noTTY>,
+ I<ReadLine>, I<NonStop>, and I<RemotePort> there (or use
+ `B<R>' after you set them).
+
+B<q> or B<^D> Quit. Set B<\$DB::finished = 0> to debug global destruction.
+B<h> Summary of debugger commands.
+B<h> [I<db_command>] Get help [on a specific debugger command], enter B<|h> to page.
+B<h h> Long help for debugger commands
+B<$doccmd> I<manpage> Runs the external doc viewer B<$doccmd> command on the
+ named Perl I<manpage>, or on B<$doccmd> itself if omitted.
+ Set B<\$DB::doccmd> to change viewer.
+
+Type `|h h' for a paged display if this was too hard to read.
+
+"; # Fix balance of vi % matching: }}}}
+
+ # note: tabs in the following section are not-so-helpful
+ $summary = <<"END_SUM";
+I<List/search source lines:> I<Control script execution:>
+ B<l> [I<ln>|I<sub>] List source code B<T> Stack trace
+ B<-> or B<.> List previous/current line B<s> [I<expr>] Single step [in expr]
+ B<v> [I<line>] View around line B<n> [I<expr>] Next, steps over subs
+ B<f> I<filename> View source in file <B<CR>/B<Enter>> Repeat last B<n> or B<s>
+ B</>I<pattern>B</> B<?>I<patt>B<?> Search forw/backw B<r> Return from subroutine
+ B<M> Show module versions B<c> [I<ln>|I<sub>] Continue until position
+I<Debugger controls:> B<L> List break/watch/actions
+ B<o> [...] Set debugger options B<t> [I<expr>] Toggle trace [trace expr]
+ B<<>[B<<>]|B<{>[B<{>]|B<>>[B<>>] [I<cmd>] Do pre/post-prompt B<b> [I<ln>|I<event>|I<sub>] [I<cnd>] Set breakpoint
+ B<$prc> [I<N>|I<pat>] Redo a previous command B<B> I<ln|*> Delete a/all breakpoints
+ B<H> [I<-num>] Display last num commands B<a> [I<ln>] I<cmd> Do cmd before line
+ B<=> [I<a> I<val>] Define/list an alias B<A> I<ln|*> Delete a/all actions
+ B<h> [I<db_cmd>] Get help on command B<w> I<expr> Add a watch expression
+ B<h h> Complete help page B<W> I<expr|*> Delete a/all watch exprs
+ B<|>[B<|>]I<db_cmd> Send output to pager B<$psh>\[B<$psh>\] I<syscmd> Run cmd in a subprocess
+ B<q> or B<^D> Quit B<R> Attempt a restart
+I<Data Examination:> B<expr> Execute perl code, also see: B<s>,B<n>,B<t> I<expr>
+ B<x>|B<m> I<expr> Evals expr in list context, dumps the result or lists methods.
+ B<p> I<expr> Print expression (uses script's current package).
+ B<S> [[B<!>]I<pat>] List subroutine names [not] matching pattern
+ B<V> [I<Pk> [I<Vars>]] List Variables in Package. Vars can be ~pattern or !pattern.
+ B<X> [I<Vars>] Same as \"B<V> I<current_package> [I<Vars>]\". B<i> I<class> inheritance tree.
+ B<y> [I<n> [I<Vars>]] List lexicals in higher scope <n>. Vars same as B<V>.
+ B<e> Display thread id B<E> Display all thread ids.
+For more help, type B<h> I<cmd_letter>, or run B<$doccmd perldebug> for all docs.
+END_SUM
+
+ # ')}}; # Fix balance of vi % matching
+
+ # and this is really numb...
+ $pre580_help = "
+B<T> Stack trace.
+B<s> [I<expr>] Single step [in I<expr>].
+B<n> [I<expr>] Next, steps over subroutine calls [in I<expr>].
+B<CR>> Repeat last B<n> or B<s> command.
+B<r> Return from current subroutine.
+B<c> [I<line>|I<sub>] Continue; optionally inserts a one-time-only breakpoint
+ at the specified position.
+B<l> I<min>B<+>I<incr> List I<incr>+1 lines starting at I<min>.
+B<l> I<min>B<->I<max> List lines I<min> through I<max>.
+B<l> I<line> List single I<line>.
+B<l> I<subname> List first window of lines from subroutine.
+B<l> I<\$var> List first window of lines from subroutine referenced by I<\$var>.
+B<l> List next window of lines.
+B<-> List previous window of lines.
+B<w> [I<line>] List window around I<line>.
+B<.> Return to the executed line.
+B<f> I<filename> Switch to viewing I<filename>. File must be already loaded.
+ I<filename> may be either the full name of the file, or a regular
+ expression matching the full file name:
+ B<f> I</home/me/foo.pl> and B<f> I<oo\\.> may access the same file.
+ Evals (with saved bodies) are considered to be filenames:
+ B<f> I<(eval 7)> and B<f> I<eval 7\\b> access the body of the 7th eval
+ (in the order of execution).
+B</>I<pattern>B</> Search forwards for I<pattern>; final B</> is optional.
+B<?>I<pattern>B<?> Search backwards for I<pattern>; final B<?> is optional.
+B<L> List all breakpoints and actions.
+B<S> [[B<!>]I<pattern>] List subroutine names [not] matching I<pattern>.
+B<t> Toggle trace mode.
+B<t> I<expr> Trace through execution of I<expr>.
+B<b> [I<line>] [I<condition>]
+ Set breakpoint; I<line> defaults to the current execution line;
+ I<condition> breaks if it evaluates to true, defaults to '1'.
+B<b> I<subname> [I<condition>]
+ Set breakpoint at first line of subroutine.
+B<b> I<\$var> Set breakpoint at first line of subroutine referenced by I<\$var>.
+B<b> B<load> I<filename> Set breakpoint on `require'ing the given file.
+B<b> B<postpone> I<subname> [I<condition>]
+ Set breakpoint at first line of subroutine after
+ it is compiled.
+B<b> B<compile> I<subname>
+ Stop after the subroutine is compiled.
+B<d> [I<line>] Delete the breakpoint for I<line>.
+B<D> Delete all breakpoints.
+B<a> [I<line>] I<command>
+ Set an action to be done before the I<line> is executed;
+ I<line> defaults to the current execution line.
+ Sequence is: check for breakpoint/watchpoint, print line
+ if necessary, do action, prompt user if necessary,
+ execute line.
+B<a> [I<line>] Delete the action for I<line>.
+B<A> Delete all actions.
+B<W> I<expr> Add a global watch-expression.
+B<W> Delete all watch-expressions.
+B<V> [I<pkg> [I<vars>]] List some (default all) variables in package (default current).
+ Use B<~>I<pattern> and B<!>I<pattern> for positive and negative regexps.
+B<X> [I<vars>] Same as \"B<V> I<currentpackage> [I<vars>]\".
+B<x> I<expr> Evals expression in list context, dumps the result.
+B<m> I<expr> Evals expression in list context, prints methods callable
+ on the first element of the result.
+B<m> I<class> Prints methods callable via the given class.
+
+B<<> ? List Perl commands to run before each prompt.
+B<<> I<expr> Define Perl command to run before each prompt.
+B<<<> I<expr> Add to the list of Perl commands to run before each prompt.
+B<>> ? List Perl commands to run after each prompt.
+B<>> I<expr> Define Perl command to run after each prompt.
+B<>>B<>> I<expr> Add to the list of Perl commands to run after each prompt.
+B<{> I<db_command> Define debugger command to run before each prompt.
+B<{> ? List debugger commands to run before each prompt.
+B<{{> I<db_command> Add to the list of debugger commands to run before each prompt.
+B<$prc> I<number> Redo a previous command (default previous command).
+B<$prc> I<-number> Redo number'th-to-last command.
+B<$prc> I<pattern> Redo last command that started with I<pattern>.
+ See 'B<O> I<recallCommand>' too.
+B<$psh$psh> I<cmd> Run cmd in a subprocess (reads from DB::IN, writes to DB::OUT)"
+ . (
+ $rc eq $sh
+ ? ""
+ : "
+B<$psh> [I<cmd>] Run I<cmd> in subshell (forces \"\$SHELL -c 'cmd'\")."
+ ) . "
+ See 'B<O> I<shellBang>' too.
+B<source> I<file> Execute I<file> containing debugger commands (may nest).
+B<H> I<-number> Display last number commands (default all).
+B<p> I<expr> Same as \"I<print {DB::OUT} expr>\" in current package.
+B<|>I<dbcmd> Run debugger command, piping DB::OUT to current pager.
+B<||>I<dbcmd> Same as B<|>I<dbcmd> but DB::OUT is temporarilly select()ed as well.
+B<\=> [I<alias> I<value>] Define a command alias, or list current aliases.
+I<command> Execute as a perl statement in current package.
+B<v> Show versions of loaded modules.
+B<R> Pure-man-restart of debugger, some of debugger state
+ and command-line options may be lost.
+ Currently the following settings are preserved:
+ history, breakpoints and actions, debugger B<O>ptions
+ and the following command-line options: I<-w>, I<-I>, I<-e>.
+
+B<O> [I<opt>] ... Set boolean option to true
+B<O> [I<opt>B<?>] Query options
+B<O> [I<opt>B<=>I<val>] [I<opt>=B<\">I<val>B<\">] ...
+ Set options. Use quotes if spaces in value.
+ I<recallCommand>, I<ShellBang> chars used to recall command or spawn shell;
+ I<pager> program for output of \"|cmd\";
+ I<tkRunning> run Tk while prompting (with ReadLine);
+ I<signalLevel> I<warnLevel> I<dieLevel> level of verbosity;
+ I<inhibit_exit> Allows stepping off the end of the script.
+ I<ImmediateStop> Debugger should stop as early as possible.
+ I<RemotePort> Remote hostname:port for remote debugging
+ The following options affect what happens with B<V>, B<X>, and B<x> commands:
+ I<arrayDepth>, I<hashDepth> print only first N elements ('' for all);
+ I<compactDump>, I<veryCompact> change style of array and hash dump;
+ I<globPrint> whether to print contents of globs;
+ I<DumpDBFiles> dump arrays holding debugged files;
+ I<DumpPackages> dump symbol tables of packages;
+ I<DumpReused> dump contents of \"reused\" addresses;
+ I<quote>, I<HighBit>, I<undefPrint> change style of string dump;
+ I<bareStringify> Do not print the overload-stringified value;
+ Other options include:
+ I<PrintRet> affects printing of return value after B<r> command,
+ I<frame> affects printing messages on subroutine entry/exit.
+ I<AutoTrace> affects printing messages on possible breaking points.
+ I<maxTraceLen> gives max length of evals/args listed in stack trace.
+ I<ornaments> affects screen appearance of the command line.
+ I<CreateTTY> bits control attempts to create a new TTY on events:
+ 1: on fork() 2: debugger is started inside debugger
+ 4: on startup
+ During startup options are initialized from \$ENV{PERLDB_OPTS}.
+ You can put additional initialization options I<TTY>, I<noTTY>,
+ I<ReadLine>, I<NonStop>, and I<RemotePort> there (or use
+ `B<R>' after you set them).
+
+B<q> or B<^D> Quit. Set B<\$DB::finished = 0> to debug global destruction.
+B<h> [I<db_command>] Get help [on a specific debugger command], enter B<|h> to page.
+B<h h> Summary of debugger commands.
+B<$doccmd> I<manpage> Runs the external doc viewer B<$doccmd> command on the
+ named Perl I<manpage>, or on B<$doccmd> itself if omitted.
+ Set B<\$DB::doccmd> to change viewer.
+
+Type `|h' for a paged display if this was too hard to read.
+
+"; # Fix balance of vi % matching: }}}}
+
+ # note: tabs in the following section are not-so-helpful
+ $pre580_summary = <<"END_SUM";
+I<List/search source lines:> I<Control script execution:>
+ B<l> [I<ln>|I<sub>] List source code B<T> Stack trace
+ B<-> or B<.> List previous/current line B<s> [I<expr>] Single step [in expr]
+ B<w> [I<line>] List around line B<n> [I<expr>] Next, steps over subs
+ B<f> I<filename> View source in file <B<CR>/B<Enter>> Repeat last B<n> or B<s>
+ B</>I<pattern>B</> B<?>I<patt>B<?> Search forw/backw B<r> Return from subroutine
+ B<v> Show versions of modules B<c> [I<ln>|I<sub>] Continue until position
+I<Debugger controls:> B<L> List break/watch/actions
+ B<O> [...] Set debugger options B<t> [I<expr>] Toggle trace [trace expr]
+ B<<>[B<<>]|B<{>[B<{>]|B<>>[B<>>] [I<cmd>] Do pre/post-prompt B<b> [I<ln>|I<event>|I<sub>] [I<cnd>] Set breakpoint
+ B<$prc> [I<N>|I<pat>] Redo a previous command B<d> [I<ln>] or B<D> Delete a/all breakpoints
+ B<H> [I<-num>] Display last num commands B<a> [I<ln>] I<cmd> Do cmd before line
+ B<=> [I<a> I<val>] Define/list an alias B<W> I<expr> Add a watch expression
+ B<h> [I<db_cmd>] Get help on command B<A> or B<W> Delete all actions/watch
+ B<|>[B<|>]I<db_cmd> Send output to pager B<$psh>\[B<$psh>\] I<syscmd> Run cmd in a subprocess
+ B<q> or B<^D> Quit B<R> Attempt a restart
+I<Data Examination:> B<expr> Execute perl code, also see: B<s>,B<n>,B<t> I<expr>
+ B<x>|B<m> I<expr> Evals expr in list context, dumps the result or lists methods.
+ B<p> I<expr> Print expression (uses script's current package).
+ B<S> [[B<!>]I<pat>] List subroutine names [not] matching pattern
+ B<V> [I<Pk> [I<Vars>]] List Variables in Package. Vars can be ~pattern or !pattern.
+ B<X> [I<Vars>] Same as \"B<V> I<current_package> [I<Vars>]\".
+ B<y> [I<n> [I<Vars>]] List lexicals in higher scope <n>. Vars same as B<V>.
+For more help, type B<h> I<cmd_letter>, or run B<$doccmd perldebug> for all docs.
+END_SUM
+
+ # ')}}; # Fix balance of vi % matching
+
+} ## end sub sethelp
+
+=head2 C<print_help()>
+
+Most of what C<print_help> does is just text formatting. It finds the
+C<B> and C<I> ornaments, cleans them off, and substitutes the proper
+terminal control characters to simulate them (courtesy of
+C<Term::ReadLine::TermCap>).
+
+=cut
+
+sub print_help {
+ local $_ = shift;
+
+ # Restore proper alignment destroyed by eeevil I<> and B<>
+ # ornaments: A pox on both their houses!
+ #
+ # A help command will have everything up to and including
+ # the first tab sequence padded into a field 16 (or if indented 20)
+ # wide. If it's wider than that, an extra space will be added.
+ s{
+ ^ # only matters at start of line
+ ( \040{4} | \t )* # some subcommands are indented
+ ( < ? # so <CR> works
+ [BI] < [^\t\n] + ) # find an eeevil ornament
+ ( \t+ ) # original separation, discarded
+ ( .* ) # this will now start (no earlier) than
+ # column 16
+ } {
+ my($leadwhite, $command, $midwhite, $text) = ($1, $2, $3, $4);
+ my $clean = $command;
+ $clean =~ s/[BI]<([^>]*)>/$1/g;
+
+ # replace with this whole string:
+ ($leadwhite ? " " x 4 : "")
+ . $command
+ . ((" " x (16 + ($leadwhite ? 4 : 0) - length($clean))) || " ")
+ . $text;
+
+ }mgex;
+
+ s{ # handle bold ornaments
+ B < ( [^>] + | > ) >
+ } {
+ $Term::ReadLine::TermCap::rl_term_set[2]
+ . $1
+ . $Term::ReadLine::TermCap::rl_term_set[3]
+ }gex;
+
+ s{ # handle italic ornaments
+ I < ( [^>] + | > ) >
+ } {
+ $Term::ReadLine::TermCap::rl_term_set[0]
+ . $1
+ . $Term::ReadLine::TermCap::rl_term_set[1]
+ }gex;
+
+ local $\ = '';
+ print $OUT $_;
+} ## end sub print_help
+
+=head2 C<fix_less>
+
+This routine does a lot of gyrations to be sure that the pager is C<less>.
+It checks for C<less> masquerading as C<more> and records the result in
+C<$ENV{LESS}> so we don't have to go through doing the stats again.
+
+=cut
+
+sub fix_less {
+
+ # We already know if this is set.
+ return if defined $ENV{LESS} && $ENV{LESS} =~ /r/;
+
+ # Pager is less for sure.
+ my $is_less = $pager =~ /\bless\b/;
+ if ( $pager =~ /\bmore\b/ ) {
+
+ # Nope, set to more. See what's out there.
+ my @st_more = stat('/usr/bin/more');
+ my @st_less = stat('/usr/bin/less');
+
+ # is it really less, pretending to be more?
+ $is_less = @st_more
+ && @st_less
+ && $st_more[0] == $st_less[0]
+ && $st_more[1] == $st_less[1];
+ } ## end if ($pager =~ /\bmore\b/)
+
+ # changes environment!
+ # 'r' added so we don't do (slow) stats again.
+ $ENV{LESS} .= 'r' if $is_less;
+} ## end sub fix_less
+
+=head1 DIE AND WARN MANAGEMENT
+
+=head2 C<diesignal>
+
+C<diesignal> is a just-drop-dead C<die> handler. It's most useful when trying
+to debug a debugger problem.
+
+It does its best to report the error that occurred, and then forces the
+program, debugger, and everything to die.
+
+=cut
+
+sub diesignal {
+
+ # No entry/exit messages.
+ local $frame = 0;
+
+ # No return value prints.
+ local $doret = -2;
+
+ # set the abort signal handling to the default (just terminate).
+ $SIG{'ABRT'} = 'DEFAULT';
+
+ # If we enter the signal handler recursively, kill myself with an
+ # abort signal (so we just terminate).
+ kill 'ABRT', $$ if $panic++;
+
+ # If we can show detailed info, do so.
+ if ( defined &Carp::longmess ) {
+
+ # Don't recursively enter the warn handler, since we're carping.
+ local $SIG{__WARN__} = '';
+
+ # Skip two levels before reporting traceback: we're skipping
+ # mydie and confess.
+ local $Carp::CarpLevel = 2; # mydie + confess
+
+ # Tell us all about it.
+ &warn( Carp::longmess("Signal @_") );
+ }
+
+ # No Carp. Tell us about the signal as best we can.
+ else {
+ local $\ = '';
+ print $DB::OUT "Got signal @_\n";
+ }
+
+ # Drop dead.
+ kill 'ABRT', $$;
+} ## end sub diesignal
+
+=head2 C<dbwarn>
+
+The debugger's own default C<$SIG{__WARN__}> handler. We load C<Carp> to
+be able to get a stack trace, and output the warning message vi C<DB::dbwarn()>.
+
+=cut
+
+sub dbwarn {
+
+ # No entry/exit trace.
+ local $frame = 0;
+
+ # No return value printing.
+ local $doret = -2;
+
+ # Turn off warn and die handling to prevent recursive entries to this
+ # routine.
+ local $SIG{__WARN__} = '';
+ local $SIG{__DIE__} = '';
+
+ # Load Carp if we can. If $^S is false (current thing being compiled isn't
+ # done yet), we may not be able to do a require.
+ eval { require Carp }
+ if defined $^S; # If error/warning during compilation,
+ # require may be broken.
+
+ # Use the core warn() unless Carp loaded OK.
+ CORE::warn( @_,
+ "\nCannot print stack trace, load with -MCarp option to see stack" ),
+ return
+ unless defined &Carp::longmess;
+
+ # Save the current values of $single and $trace, and then turn them off.
+ my ( $mysingle, $mytrace ) = ( $single, $trace );
+ $single = 0;
+ $trace = 0;
+
+ # We can call Carp::longmess without its being "debugged" (which we
+ # don't want - we just want to use it!). Capture this for later.
+ my $mess = Carp::longmess(@_);
+
+ # Restore $single and $trace to their original values.
+ ( $single, $trace ) = ( $mysingle, $mytrace );
+
+ # Use the debugger's own special way of printing warnings to print
+ # the stack trace message.
+ &warn($mess);
+} ## end sub dbwarn
+
+=head2 C<dbdie>
+
+The debugger's own C<$SIG{__DIE__}> handler. Handles providing a stack trace
+by loading C<Carp> and calling C<Carp::longmess()> to get it. We turn off
+single stepping and tracing during the call to C<Carp::longmess> to avoid
+debugging it - we just want to use it.
+
+If C<dieLevel> is zero, we let the program being debugged handle the
+exceptions. If it's 1, you get backtraces for any exception. If it's 2,
+the debugger takes over all exception handling, printing a backtrace and
+displaying the exception via its C<dbwarn()> routine.
+
+=cut
+
+sub dbdie {
+ local $frame = 0;
+ local $doret = -2;
+ local $SIG{__DIE__} = '';
+ local $SIG{__WARN__} = '';
+ my $i = 0;
+ my $ineval = 0;
+ my $sub;
+ if ( $dieLevel > 2 ) {
+ local $SIG{__WARN__} = \&dbwarn;
+ &warn(@_); # Yell no matter what
+ return;
+ }
+ if ( $dieLevel < 2 ) {
+ die @_ if $^S; # in eval propagate
+ }
+
+ # The code used to check $^S to see if compiliation of the current thing
+ # hadn't finished. We don't do it anymore, figuring eval is pretty stable.
+ eval { require Carp };
+
+ die( @_,
+ "\nCannot print stack trace, load with -MCarp option to see stack" )
+ unless defined &Carp::longmess;
+
+ # We do not want to debug this chunk (automatic disabling works
+ # inside DB::DB, but not in Carp). Save $single and $trace, turn them off,
+ # get the stack trace from Carp::longmess (if possible), restore $signal
+ # and $trace, and then die with the stack trace.
+ my ( $mysingle, $mytrace ) = ( $single, $trace );
+ $single = 0;
+ $trace = 0;
+ my $mess = "@_";
+ {
+
+ package Carp; # Do not include us in the list
+ eval { $mess = Carp::longmess(@_); };
+ }
+ ( $single, $trace ) = ( $mysingle, $mytrace );
+ die $mess;
+} ## end sub dbdie
+
+=head2 C<warnlevel()>
+
+Set the C<$DB::warnLevel> variable that stores the value of the
+C<warnLevel> option. Calling C<warnLevel()> with a positive value
+results in the debugger taking over all warning handlers. Setting
+C<warnLevel> to zero leaves any warning handlers set up by the program
+being debugged in place.
+
+=cut
+
+sub warnLevel {
+ if (@_) {
+ $prevwarn = $SIG{__WARN__} unless $warnLevel;
+ $warnLevel = shift;
+ if ($warnLevel) {
+ $SIG{__WARN__} = \&DB::dbwarn;
+ }
+ elsif ($prevwarn) {
+ $SIG{__WARN__} = $prevwarn;
+ } else {
+ undef $SIG{__WARN__};
+ }
+ } ## end if (@_)
+ $warnLevel;
+} ## end sub warnLevel
+
+=head2 C<dielevel>
+
+Similar to C<warnLevel>. Non-zero values for C<dieLevel> result in the
+C<DB::dbdie()> function overriding any other C<die()> handler. Setting it to
+zero lets you use your own C<die()> handler.
+
+=cut
+
+sub dieLevel {
+ local $\ = '';
+ if (@_) {
+ $prevdie = $SIG{__DIE__} unless $dieLevel;
+ $dieLevel = shift;
+ if ($dieLevel) {
+
+ # Always set it to dbdie() for non-zero values.
+ $SIG{__DIE__} = \&DB::dbdie; # if $dieLevel < 2;
+
+ # No longer exists, so don't try to use it.
+ #$SIG{__DIE__} = \&DB::diehard if $dieLevel >= 2;
+
+ # If we've finished initialization, mention that stack dumps
+ # are enabled, If dieLevel is 1, we won't stack dump if we die
+ # in an eval().
+ print $OUT "Stack dump during die enabled",
+ ( $dieLevel == 1 ? " outside of evals" : "" ), ".\n"
+ if $I_m_init;
+
+ # XXX This is probably obsolete, given that diehard() is gone.
+ print $OUT "Dump printed too.\n" if $dieLevel > 2;
+ } ## end if ($dieLevel)
+
+ # Put the old one back if there was one.
+ elsif ($prevdie) {
+ $SIG{__DIE__} = $prevdie;
+ print $OUT "Default die handler restored.\n";
+ } else {
+ undef $SIG{__DIE__};
+ print $OUT "Die handler removed.\n";
+ }
+ } ## end if (@_)
+ $dieLevel;
+} ## end sub dieLevel
+
+=head2 C<signalLevel>
+
+Number three in a series: set C<signalLevel> to zero to keep your own
+signal handler for C<SIGSEGV> and/or C<SIGBUS>. Otherwise, the debugger
+takes over and handles them with C<DB::diesignal()>.
+
+=cut
+
+sub signalLevel {
+ if (@_) {
+ $prevsegv = $SIG{SEGV} unless $signalLevel;
+ $prevbus = $SIG{BUS} unless $signalLevel;
+ $signalLevel = shift;
+ if ($signalLevel) {
+ $SIG{SEGV} = \&DB::diesignal;
+ $SIG{BUS} = \&DB::diesignal;
+ }
+ else {
+ $SIG{SEGV} = $prevsegv;
+ $SIG{BUS} = $prevbus;
+ }
+ } ## end if (@_)
+ $signalLevel;
+} ## end sub signalLevel
+
+=head1 SUBROUTINE DECODING SUPPORT
+
+These subroutines are used during the C<x> and C<X> commands to try to
+produce as much information as possible about a code reference. They use
+L<Devel::Peek> to try to find the glob in which this code reference lives
+(if it does) - this allows us to actually code references which correspond
+to named subroutines (including those aliased via glob assignment).
+
+=head2 C<CvGV_name()>
+
+Wrapper for C<CvGV_name_or_bust>; tries to get the name of a reference
+via that routine. If this fails, return the reference again (when the
+reference is stringified, it'll come out as C<SOMETHING(0x...)>).
+
+=cut
+
+sub CvGV_name {
+ my $in = shift;
+ my $name = CvGV_name_or_bust($in);
+ defined $name ? $name : $in;
+}
+
+=head2 C<CvGV_name_or_bust> I<coderef>
+
+Calls L<Devel::Peek> to try to find the glob the ref lives in; returns
+C<undef> if L<Devel::Peek> can't be loaded, or if C<Devel::Peek::CvGV> can't
+find a glob for this ref.
+
+Returns C<< I<package>::I<glob name> >> if the code ref is found in a glob.
+
+=cut
+
+sub CvGV_name_or_bust {
+ my $in = shift;
+ return if $skipCvGV; # Backdoor to avoid problems if XS broken...
+ return unless ref $in;
+ $in = \&$in; # Hard reference...
+ eval { require Devel::Peek; 1 } or return;
+ my $gv = Devel::Peek::CvGV($in) or return;
+ *$gv{PACKAGE} . '::' . *$gv{NAME};
+} ## end sub CvGV_name_or_bust
+
+=head2 C<find_sub>
+
+A utility routine used in various places; finds the file where a subroutine
+was defined, and returns that filename and a line-number range.
+
+Tries to use C<@sub> first; if it can't find it there, it tries building a
+reference to the subroutine and uses C<CvGV_name_or_bust> to locate it,
+loading it into C<@sub> as a side effect (XXX I think). If it can't find it
+this way, it brute-force searches C<%sub>, checking for identical references.
+
+=cut
+
+sub find_sub {
+ my $subr = shift;
+ $sub{$subr} or do {
+ return unless defined &$subr;
+ my $name = CvGV_name_or_bust($subr);
+ my $data;
+ $data = $sub{$name} if defined $name;
+ return $data if defined $data;
+
+ # Old stupid way...
+ $subr = \&$subr; # Hard reference
+ my $s;
+ for ( keys %sub ) {
+ $s = $_, last if $subr eq \&$_;
+ }
+ $sub{$s} if $s;
+ } ## end do
+} ## end sub find_sub
+
+=head2 C<methods>
+
+A subroutine that uses the utility function C<methods_via> to find all the
+methods in the class corresponding to the current reference and in
+C<UNIVERSAL>.
+
+=cut
+
+sub methods {
+
+ # Figure out the class - either this is the class or it's a reference
+ # to something blessed into that class.
+ my $class = shift;
+ $class = ref $class if ref $class;
+
+ local %seen;
+
+ # Show the methods that this class has.
+ methods_via( $class, '', 1 );
+
+ # Show the methods that UNIVERSAL has.
+ methods_via( 'UNIVERSAL', 'UNIVERSAL', 0 );
+} ## end sub methods
+
+=head2 C<methods_via($class, $prefix, $crawl_upward)>
+
+C<methods_via> does the work of crawling up the C<@ISA> tree and reporting
+all the parent class methods. C<$class> is the name of the next class to
+try; C<$prefix> is the message prefix, which gets built up as we go up the
+C<@ISA> tree to show parentage; C<$crawl_upward> is 1 if we should try to go
+higher in the C<@ISA> tree, 0 if we should stop.
+
+=cut
+
+sub methods_via {
+
+ # If we've processed this class already, just quit.
+ my $class = shift;
+ return if $seen{$class}++;
+
+ # This is a package that is contributing the methods we're about to print.
+ my $prefix = shift;
+ my $prepend = $prefix ? "via $prefix: " : '';
+ my @to_print;
+
+ # Extract from all the symbols in this class.
+ while (my ($name, $glob) = each %{"${class}::"}) {
+ # references directly in the symbol table are Proxy Constant
+ # Subroutines, and are by their very nature defined
+ # Otherwise, check if the thing is a typeglob, and if it is, it decays
+ # to a subroutine reference, which can be tested by defined.
+ # $glob might also be the value -1 (from sub foo;)
+ # or (say) '$$' (from sub foo ($$);)
+ # \$glob will be SCALAR in both cases.
+ if ((ref $glob || ($glob && ref \$glob eq 'GLOB' && defined &$glob))
+ && !$seen{$name}++) {
+ push @to_print, "$prepend$name\n";
+ }
+ }
+
+ {
+ local $\ = '';
+ local $, = '';
+ print $DB::OUT $_ foreach sort @to_print;
+ }
+
+ # If the $crawl_upward argument is false, just quit here.
+ return unless shift;
+
+ # $crawl_upward true: keep going up the tree.
+ # Find all the classes this one is a subclass of.
+ for $name ( @{"${class}::ISA"} ) {
+
+ # Set up the new prefix.
+ $prepend = $prefix ? $prefix . " -> $name" : $name;
+
+ # Crawl up the tree and keep trying to crawl up.
+ methods_via( $name, $prepend, 1 );
+ }
+} ## end sub methods_via
+
+=head2 C<setman> - figure out which command to use to show documentation
+
+Just checks the contents of C<$^O> and sets the C<$doccmd> global accordingly.
+
+=cut
+
+sub setman {
+ $doccmd = $^O !~ /^(?:MSWin32|VMS|os2|dos|amigaos|riscos|MacOS|NetWare)\z/s
+ ? "man" # O Happy Day!
+ : "perldoc"; # Alas, poor unfortunates
+} ## end sub setman
+
+=head2 C<runman> - run the appropriate command to show documentation
+
+Accepts a man page name; runs the appropriate command to display it (set up
+during debugger initialization). Uses C<DB::system> to avoid mucking up the
+program's STDIN and STDOUT.
+
+=cut
+
+sub runman {
+ my $page = shift;
+ unless ($page) {
+ &system("$doccmd $doccmd");
+ return;
+ }
+
+ # this way user can override, like with $doccmd="man -Mwhatever"
+ # or even just "man " to disable the path check.
+ unless ( $doccmd eq 'man' ) {
+ &system("$doccmd $page");
+ return;
+ }
+
+ $page = 'perl' if lc($page) eq 'help';
+
+ require Config;
+ my $man1dir = $Config::Config{'man1dir'};
+ my $man3dir = $Config::Config{'man3dir'};
+ for ( $man1dir, $man3dir ) { s#/[^/]*\z## if /\S/ }
+ my $manpath = '';
+ $manpath .= "$man1dir:" if $man1dir =~ /\S/;
+ $manpath .= "$man3dir:" if $man3dir =~ /\S/ && $man1dir ne $man3dir;
+ chop $manpath if $manpath;
+
+ # harmless if missing, I figure
+ my $oldpath = $ENV{MANPATH};
+ $ENV{MANPATH} = $manpath if $manpath;
+ my $nopathopt = $^O =~ /dunno what goes here/;
+ if (
+ CORE::system(
+ $doccmd,
+
+ # I just *know* there are men without -M
+ ( ( $manpath && !$nopathopt ) ? ( "-M", $manpath ) : () ),
+ split ' ', $page
+ )
+ )
+ {
+ unless ( $page =~ /^perl\w/ ) {
+# do it this way because its easier to slurp in to keep up to date - clunky though.
+my @pods = qw(
+ 5004delta
+ 5005delta
+ 561delta
+ 56delta
+ 570delta
+ 571delta
+ 572delta
+ 573delta
+ 58delta
+ 581delta
+ 582delta
+ 583delta
+ 584delta
+ 590delta
+ 591delta
+ 592delta
+ aix
+ amiga
+ apio
+ api
+ apollo
+ artistic
+ beos
+ book
+ boot
+ bot
+ bs2000
+ call
+ ce
+ cheat
+ clib
+ cn
+ compile
+ cygwin
+ data
+ dbmfilter
+ debguts
+ debtut
+ debug
+ delta
+ dgux
+ diag
+ doc
+ dos
+ dsc
+ ebcdic
+ embed
+ epoc
+ faq1
+ faq2
+ faq3
+ faq4
+ faq5
+ faq6
+ faq7
+ faq8
+ faq9
+ faq
+ filter
+ fork
+ form
+ freebsd
+ func
+ gpl
+ guts
+ hack
+ hist
+ hpux
+ hurd
+ intern
+ intro
+ iol
+ ipc
+ irix
+ jp
+ ko
+ lexwarn
+ locale
+ lol
+ machten
+ macos
+ macosx
+ mint
+ modinstall
+ modlib
+ mod
+ modstyle
+ mpeix
+ netware
+ newmod
+ number
+ obj
+ opentut
+ op
+ os2
+ os390
+ os400
+ othrtut
+ packtut
+ plan9
+ pod
+ podspec
+ port
+ qnx
+ ref
+ reftut
+ re
+ requick
+ reref
+ retut
+ run
+ sec
+ solaris
+ style
+ sub
+ syn
+ thrtut
+ tie
+ toc
+ todo
+ tooc
+ toot
+ trap
+ tru64
+ tw
+ unicode
+ uniintro
+ util
+ uts
+ var
+ vmesa
+ vms
+ vos
+ win32
+ xs
+ xstut
+);
+ if (grep { $page eq $_ } @pods) {
+ $page =~ s/^/perl/;
+ CORE::system( $doccmd,
+ ( ( $manpath && !$nopathopt ) ? ( "-M", $manpath ) : () ),
+ $page );
+ } ## end if (grep { $page eq $_...
+ } ## end unless ($page =~ /^perl\w/)
+ } ## end if (CORE::system($doccmd...
+ if ( defined $oldpath ) {
+ $ENV{MANPATH} = $manpath;
+ }
+ else {
+ delete $ENV{MANPATH};
+ }
+} ## end sub runman
+
+#use Carp; # This did break, left for debugging
+
+=head1 DEBUGGER INITIALIZATION - THE SECOND BEGIN BLOCK
+
+Because of the way the debugger interface to the Perl core is designed, any
+debugger package globals that C<DB::sub()> requires have to be defined before
+any subroutines can be called. These are defined in the second C<BEGIN> block.
+
+This block sets things up so that (basically) the world is sane
+before the debugger starts executing. We set up various variables that the
+debugger has to have set up before the Perl core starts running:
+
+=over 4
+
+=item *
+
+The debugger's own filehandles (copies of STD and STDOUT for now).
+
+=item *
+
+Characters for shell escapes, the recall command, and the history command.
+
+=item *
+
+The maximum recursion depth.
+
+=item *
+
+The size of a C<w> command's window.
+
+=item *
+
+The before-this-line context to be printed in a C<v> (view a window around this line) command.
+
+=item *
+
+The fact that we're not in a sub at all right now.
+
+=item *
+
+The default SIGINT handler for the debugger.
+
+=item *
+
+The appropriate value of the flag in C<$^D> that says the debugger is running
+
+=item *
+
+The current debugger recursion level
+
+=item *
+
+The list of postponed items and the C<$single> stack (XXX define this)
+
+=item *
+
+That we want no return values and no subroutine entry/exit trace.
+
+=back
+
+=cut
+
+# The following BEGIN is very handy if debugger goes havoc, debugging debugger?
+
+BEGIN { # This does not compile, alas. (XXX eh?)
+ $IN = \*STDIN; # For bugs before DB::OUT has been opened
+ $OUT = \*STDERR; # For errors before DB::OUT has been opened
+
+ # Define characters used by command parsing.
+ $sh = '!'; # Shell escape (does not work)
+ $rc = ','; # Recall command (does not work)
+ @hist = ('?'); # Show history (does not work)
+ @truehist = (); # Can be saved for replay (per session)
+
+ # This defines the point at which you get the 'deep recursion'
+ # warning. It MUST be defined or the debugger will not load.
+ $deep = 100;
+
+ # Number of lines around the current one that are shown in the
+ # 'w' command.
+ $window = 10;
+
+ # How much before-the-current-line context the 'v' command should
+ # use in calculating the start of the window it will display.
+ $preview = 3;
+
+ # We're not in any sub yet, but we need this to be a defined value.
+ $sub = '';
+
+ # Set up the debugger's interrupt handler. It simply sets a flag
+ # ($signal) that DB::DB() will check before each command is executed.
+ $SIG{INT} = \&DB::catch;
+
+ # The following lines supposedly, if uncommented, allow the debugger to
+ # debug itself. Perhaps we can try that someday.
+ # This may be enabled to debug debugger:
+ #$warnLevel = 1 unless defined $warnLevel;
+ #$dieLevel = 1 unless defined $dieLevel;
+ #$signalLevel = 1 unless defined $signalLevel;
+
+ # This is the flag that says "a debugger is running, please call
+ # DB::DB and DB::sub". We will turn it on forcibly before we try to
+ # execute anything in the user's context, because we always want to
+ # get control back.
+ $db_stop = 0; # Compiler warning ...
+ $db_stop = 1 << 30; # ... because this is only used in an eval() later.
+
+ # This variable records how many levels we're nested in debugging. Used
+ # Used in the debugger prompt, and in determining whether it's all over or
+ # not.
+ $level = 0; # Level of recursive debugging
+
+ # "Triggers bug (?) in perl if we postpone this until runtime."
+ # XXX No details on this yet, or whether we should fix the bug instead
+ # of work around it. Stay tuned.
+ @postponed = @stack = (0);
+
+ # Used to track the current stack depth using the auto-stacked-variable
+ # trick.
+ $stack_depth = 0; # Localized repeatedly; simple way to track $#stack
+
+ # Don't print return values on exiting a subroutine.
+ $doret = -2;
+
+ # No extry/exit tracing.
+ $frame = 0;
+
+} ## end BEGIN
+
+BEGIN { $^W = $ini_warn; } # Switch warnings back
+
+=head1 READLINE SUPPORT - COMPLETION FUNCTION
+
+=head2 db_complete
+
+C<readline> support - adds command completion to basic C<readline>.
+
+Returns a list of possible completions to C<readline> when invoked. C<readline>
+will print the longest common substring following the text already entered.
+
+If there is only a single possible completion, C<readline> will use it in full.
+
+This code uses C<map> and C<grep> heavily to create lists of possible
+completion. Think LISP in this section.
+
+=cut
+
+sub db_complete {
+
+ # Specific code for b c l V m f O, &blah, $blah, @blah, %blah
+ # $text is the text to be completed.
+ # $line is the incoming line typed by the user.
+ # $start is the start of the text to be completed in the incoming line.
+ my ( $text, $line, $start ) = @_;
+
+ # Save the initial text.
+ # The search pattern is current package, ::, extract the next qualifier
+ # Prefix and pack are set to undef.
+ my ( $itext, $search, $prefix, $pack ) =
+ ( $text, "^\Q${'package'}::\E([^:]+)\$" );
+
+=head3 C<b postpone|compile>
+
+=over 4
+
+=item *
+
+Find all the subroutines that might match in this package
+
+=item *
+
+Add C<postpone>, C<load>, and C<compile> as possibles (we may be completing the keyword itself)
+
+=item *
+
+Include all the rest of the subs that are known
+
+=item *
+
+C<grep> out the ones that match the text we have so far
+
+=item *
+
+Return this as the list of possible completions
+
+=back
+
+=cut
+
+ return sort grep /^\Q$text/, ( keys %sub ),
+ qw(postpone load compile), # subroutines
+ ( map { /$search/ ? ($1) : () } keys %sub )
+ if ( substr $line, 0, $start ) =~ /^\|*[blc]\s+((postpone|compile)\s+)?$/;
+
+=head3 C<b load>
+
+Get all the possible files from C<@INC> as it currently stands and
+select the ones that match the text so far.
+
+=cut
+
+ return sort grep /^\Q$text/, values %INC # files
+ if ( substr $line, 0, $start ) =~ /^\|*b\s+load\s+$/;
+
+=head3 C<V> (list variable) and C<m> (list modules)
+
+There are two entry points for these commands:
+
+=head4 Unqualified package names
+
+Get the top-level packages and grab everything that matches the text
+so far. For each match, recursively complete the partial packages to
+get all possible matching packages. Return this sorted list.
+
+=cut
+
+ return sort map { ( $_, db_complete( $_ . "::", "V ", 2 ) ) }
+ grep /^\Q$text/, map { /^(.*)::$/ ? ($1) : () } keys %:: # top-packages
+ if ( substr $line, 0, $start ) =~ /^\|*[Vm]\s+$/ and $text =~ /^\w*$/;
+
+=head4 Qualified package names
+
+Take a partially-qualified package and find all subpackages for it
+by getting all the subpackages for the package so far, matching all
+the subpackages against the text, and discarding all of them which
+start with 'main::'. Return this list.
+
+=cut
+
+ return sort map { ( $_, db_complete( $_ . "::", "V ", 2 ) ) }
+ grep !/^main::/, grep /^\Q$text/,
+ map { /^(.*)::$/ ? ( $prefix . "::$1" ) : () } keys %{ $prefix . '::' }
+ if ( substr $line, 0, $start ) =~ /^\|*[Vm]\s+$/
+ and $text =~ /^(.*[^:])::?(\w*)$/
+ and $prefix = $1;
+
+=head3 C<f> - switch files
+
+Here, we want to get a fully-qualified filename for the C<f> command.
+Possibilities are:
+
+=over 4
+
+=item 1. The original source file itself
+
+=item 2. A file from C<@INC>
+
+=item 3. An C<eval> (the debugger gets a C<(eval N)> fake file for each C<eval>).
+
+=back
+
+=cut
+
+ if ( $line =~ /^\|*f\s+(.*)/ ) { # Loaded files
+ # We might possibly want to switch to an eval (which has a "filename"
+ # like '(eval 9)'), so we may need to clean up the completion text
+ # before proceeding.
+ $prefix = length($1) - length($text);
+ $text = $1;
+
+=pod
+
+Under the debugger, source files are represented as C<_E<lt>/fullpath/to/file>
+(C<eval>s are C<_E<lt>(eval NNN)>) keys in C<%main::>. We pull all of these
+out of C<%main::>, add the initial source file, and extract the ones that
+match the completion text so far.
+
+=cut
+
+ return sort
+ map { substr $_, 2 + $prefix } grep /^_<\Q$text/, ( keys %main:: ),
+ $0;
+ } ## end if ($line =~ /^\|*f\s+(.*)/)
+
+=head3 Subroutine name completion
+
+We look through all of the defined subs (the keys of C<%sub>) and
+return both all the possible matches to the subroutine name plus
+all the matches qualified to the current package.
+
+=cut
+
+ if ( ( substr $text, 0, 1 ) eq '&' ) { # subroutines
+ $text = substr $text, 1;
+ $prefix = "&";
+ return sort map "$prefix$_", grep /^\Q$text/, ( keys %sub ),
+ (
+ map { /$search/ ? ($1) : () }
+ keys %sub
+ );
+ } ## end if ((substr $text, 0, ...
+
+=head3 Scalar, array, and hash completion: partially qualified package
+
+Much like the above, except we have to do a little more cleanup:
+
+=cut
+
+ if ( $text =~ /^[\$@%](.*)::(.*)/ ) { # symbols in a package
+
+=pod
+
+=over 4
+
+=item *
+
+Determine the package that the symbol is in. Put it in C<::> (effectively C<main::>) if no package is specified.
+
+=cut
+
+ $pack = ( $1 eq 'main' ? '' : $1 ) . '::';
+
+=pod
+
+=item *
+
+Figure out the prefix vs. what needs completing.
+
+=cut
+
+ $prefix = ( substr $text, 0, 1 ) . $1 . '::';
+ $text = $2;
+
+=pod
+
+=item *
+
+Look through all the symbols in the package. C<grep> out all the possible hashes/arrays/scalars, and then C<grep> the possible matches out of those. C<map> the prefix onto all the possibilities.
+
+=cut
+
+ my @out = map "$prefix$_", grep /^\Q$text/, grep /^_?[a-zA-Z]/,
+ keys %$pack;
+
+=pod
+
+=item *
+
+If there's only one hit, and it's a package qualifier, and it's not equal to the initial text, re-complete it using the symbol we actually found.
+
+=cut
+
+ if ( @out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext ) {
+ return db_complete( $out[0], $line, $start );
+ }
+
+ # Return the list of possibles.
+ return sort @out;
+
+ } ## end if ($text =~ /^[\$@%](.*)::(.*)/)
+
+=pod
+
+=back
+
+=head3 Symbol completion: current package or package C<main>.
+
+=cut
+
+ if ( $text =~ /^[\$@%]/ ) { # symbols (in $package + packages in main)
+
+=pod
+
+=over 4
+
+=item *
+
+If it's C<main>, delete main to just get C<::> leading.
+
+=cut
+
+ $pack = ( $package eq 'main' ? '' : $package ) . '::';
+
+=pod
+
+=item *
+
+We set the prefix to the item's sigil, and trim off the sigil to get the text to be completed.
+
+=cut
+
+ $prefix = substr $text, 0, 1;
+ $text = substr $text, 1;
+
+=pod
+
+=item *
+
+If the package is C<::> (C<main>), create an empty list; if it's something else, create a list of all the packages known. Append whichever list to a list of all the possible symbols in the current package. C<grep> out the matches to the text entered so far, then C<map> the prefix back onto the symbols.
+
+=cut
+
+ my @out = map "$prefix$_", grep /^\Q$text/,
+ ( grep /^_?[a-zA-Z]/, keys %$pack ),
+ ( $pack eq '::' ? () : ( grep /::$/, keys %:: ) );
+
+=item *
+
+If there's only one hit, it's a package qualifier, and it's not equal to the initial text, recomplete using this symbol.
+
+=back
+
+=cut
+
+ if ( @out == 1 and $out[0] =~ /::$/ and $out[0] ne $itext ) {
+ return db_complete( $out[0], $line, $start );
+ }
+
+ # Return the list of possibles.
+ return sort @out;
+ } ## end if ($text =~ /^[\$@%]/)
+
+=head3 Options
+
+We use C<option_val()> to look up the current value of the option. If there's
+only a single value, we complete the command in such a way that it is a
+complete command for setting the option in question. If there are multiple
+possible values, we generate a command consisting of the option plus a trailing
+question mark, which, if executed, will list the current value of the option.
+
+=cut
+
+ if ( ( substr $line, 0, $start ) =~ /^\|*[oO]\b.*\s$/ )
+ { # Options after space
+ # We look for the text to be matched in the list of possible options,
+ # and fetch the current value.
+ my @out = grep /^\Q$text/, @options;
+ my $val = option_val( $out[0], undef );
+
+ # Set up a 'query option's value' command.
+ my $out = '? ';
+ if ( not defined $val or $val =~ /[\n\r]/ ) {
+
+ # There's really nothing else we can do.
+ }
+
+ # We have a value. Create a proper option-setting command.
+ elsif ( $val =~ /\s/ ) {
+
+ # XXX This may be an extraneous variable.
+ my $found;
+
+ # We'll want to quote the string (because of the embedded
+ # whtespace), but we want to make sure we don't end up with
+ # mismatched quote characters. We try several possibilities.
+ foreach $l ( split //, qq/\"\'\#\|/ ) {
+
+ # If we didn't find this quote character in the value,
+ # quote it using this quote character.
+ $out = "$l$val$l ", last if ( index $val, $l ) == -1;
+ }
+ } ## end elsif ($val =~ /\s/)
+
+ # Don't need any quotes.
+ else {
+ $out = "=$val ";
+ }
+
+ # If there were multiple possible values, return '? ', which
+ # makes the command into a query command. If there was just one,
+ # have readline append that.
+ $rl_attribs->{completer_terminator_character} =
+ ( @out == 1 ? $out : '? ' );
+
+ # Return list of possibilities.
+ return sort @out;
+ } ## end if ((substr $line, 0, ...
+
+=head3 Filename completion
+
+For entering filenames. We simply call C<readline>'s C<filename_list()>
+method with the completion text to get the possible completions.
+
+=cut
+
+ return $term->filename_list($text); # filenames
+
+} ## end sub db_complete
+
+=head1 MISCELLANEOUS SUPPORT FUNCTIONS
+
+Functions that possibly ought to be somewhere else.
+
+=head2 end_report
+
+Say we're done.
+
+=cut
+
+sub end_report {
+ local $\ = '';
+ print $OUT "Use `q' to quit or `R' to restart. `h q' for details.\n";
+}
+
+=head2 clean_ENV
+
+If we have $ini_pids, save it in the environment; else remove it from the
+environment. Used by the C<R> (restart) command.
+
+=cut
+
+sub clean_ENV {
+ if ( defined($ini_pids) ) {
+ $ENV{PERLDB_PIDS} = $ini_pids;
+ }
+ else {
+ delete( $ENV{PERLDB_PIDS} );
+ }
+} ## end sub clean_ENV
+
+# PERLDBf_... flag names from perl.h
+our ( %DollarCaretP_flags, %DollarCaretP_flags_r );
+
+BEGIN {
+ %DollarCaretP_flags = (
+ PERLDBf_SUB => 0x01, # Debug sub enter/exit
+ PERLDBf_LINE => 0x02, # Keep line #
+ PERLDBf_NOOPT => 0x04, # Switch off optimizations
+ PERLDBf_INTER => 0x08, # Preserve more data
+ PERLDBf_SUBLINE => 0x10, # Keep subr source lines
+ PERLDBf_SINGLE => 0x20, # Start with single-step on
+ PERLDBf_NONAME => 0x40, # For _SUB: no name of the subr
+ PERLDBf_GOTO => 0x80, # Report goto: call DB::goto
+ PERLDBf_NAMEEVAL => 0x100, # Informative names for evals
+ PERLDBf_NAMEANON => 0x200, # Informative names for anon subs
+ PERLDBf_SAVESRC => 0x400, # Save source lines into @{"_<$filename"}
+ PERLDB_ALL => 0x33f, # No _NONAME, _GOTO
+ );
+ # PERLDBf_LINE also enables the actions of PERLDBf_SAVESRC, so the debugger
+ # doesn't need to set it. It's provided for the benefit of profilers and
+ # other code analysers.
+
+ %DollarCaretP_flags_r = reverse %DollarCaretP_flags;
+}
+
+sub parse_DollarCaretP_flags {
+ my $flags = shift;
+ $flags =~ s/^\s+//;
+ $flags =~ s/\s+$//;
+ my $acu = 0;
+ foreach my $f ( split /\s*\|\s*/, $flags ) {
+ my $value;
+ if ( $f =~ /^0x([[:xdigit:]]+)$/ ) {
+ $value = hex $1;
+ }
+ elsif ( $f =~ /^(\d+)$/ ) {
+ $value = int $1;
+ }
+ elsif ( $f =~ /^DEFAULT$/i ) {
+ $value = $DollarCaretP_flags{PERLDB_ALL};
+ }
+ else {
+ $f =~ /^(?:PERLDBf_)?(.*)$/i;
+ $value = $DollarCaretP_flags{ 'PERLDBf_' . uc($1) };
+ unless ( defined $value ) {
+ print $OUT (
+ "Unrecognized \$^P flag '$f'!\n",
+ "Acceptable flags are: "
+ . join( ', ', sort keys %DollarCaretP_flags ),
+ ", and hexadecimal and decimal numbers.\n"
+ );
+ return undef;
+ }
+ }
+ $acu |= $value;
+ }
+ $acu;
+}
+
+sub expand_DollarCaretP_flags {
+ my $DollarCaretP = shift;
+ my @bits = (
+ map {
+ my $n = ( 1 << $_ );
+ ( $DollarCaretP & $n )
+ ? ( $DollarCaretP_flags_r{$n}
+ || sprintf( '0x%x', $n ) )
+ : ()
+ } 0 .. 31
+ );
+ return @bits ? join( '|', @bits ) : 0;
+}
+
+=over 4
+
+=item rerun
+
+Rerun the current session to:
+
+ rerun current position
+
+ rerun 4 command number 4
+
+ rerun -4 current command minus 4 (go back 4 steps)
+
+Whether this always makes sense, in the current context is unknowable, and is
+in part left as a useful exersize for the reader. This sub returns the
+appropriate arguments to rerun the current session.
+
+=cut
+
+sub rerun {
+ my $i = shift;
+ my @args;
+ pop(@truehist); # strim
+ unless (defined $truehist[$i]) {
+ print "Unable to return to non-existent command: $i\n";
+ } else {
+ $#truehist = ($i < 0 ? $#truehist + $i : $i > 0 ? $i : $#truehist);
+ my @temp = @truehist; # store
+ push(@DB::typeahead, @truehist); # saved
+ @truehist = @hist = (); # flush
+ @args = &restart(); # setup
+ &get_list("PERLDB_HIST"); # clean
+ &set_list("PERLDB_HIST", @temp); # reset
+ }
+ return @args;
+}
+
+=item restart
+
+Restarting the debugger is a complex operation that occurs in several phases.
+First, we try to reconstruct the command line that was used to invoke Perl
+and the debugger.
+
+=cut
+
+sub restart {
+ # I may not be able to resurrect you, but here goes ...
+ print $OUT
+"Warning: some settings and command-line options may be lost!\n";
+ my ( @script, @flags, $cl );
+
+ # If warn was on before, turn it on again.
+ push @flags, '-w' if $ini_warn;
+
+ # Rebuild the -I flags that were on the initial
+ # command line.
+ for (@ini_INC) {
+ push @flags, '-I', $_;
+ }
+
+ # Turn on taint if it was on before.
+ push @flags, '-T' if ${^TAINT};
+
+ # Arrange for setting the old INC:
+ # Save the current @init_INC in the environment.
+ set_list( "PERLDB_INC", @ini_INC );
+
+ # If this was a perl one-liner, go to the "file"
+ # corresponding to the one-liner read all the lines
+ # out of it (except for the first one, which is going
+ # to be added back on again when 'perl -d' runs: that's
+ # the 'require perl5db.pl;' line), and add them back on
+ # to the command line to be executed.
+ if ( $0 eq '-e' ) {
+ for ( 1 .. $#{'::_<-e'} ) { # The first line is PERL5DB
+ chomp( $cl = ${'::_<-e'}[$_] );
+ push @script, '-e', $cl;
+ }
+ } ## end if ($0 eq '-e')
+
+ # Otherwise we just reuse the original name we had
+ # before.
+ else {
+ @script = $0;
+ }
+
+=pod
+
+After the command line has been reconstructed, the next step is to save
+the debugger's status in environment variables. The C<DB::set_list> routine
+is used to save aggregate variables (both hashes and arrays); scalars are
+just popped into environment variables directly.
+
+=cut
+
+ # If the terminal supported history, grab it and
+ # save that in the environment.
+ set_list( "PERLDB_HIST",
+ $term->Features->{getHistory}
+ ? $term->GetHistory
+ : @hist );
+
+ # Find all the files that were visited during this
+ # session (i.e., the debugger had magic hashes
+ # corresponding to them) and stick them in the environment.
+ my @had_breakpoints = keys %had_breakpoints;
+ set_list( "PERLDB_VISITED", @had_breakpoints );
+
+ # Save the debugger options we chose.
+ set_list( "PERLDB_OPT", %option );
+ # set_list( "PERLDB_OPT", options2remember() );
+
+ # Save the break-on-loads.
+ set_list( "PERLDB_ON_LOAD", %break_on_load );
+
+=pod
+
+The most complex part of this is the saving of all of the breakpoints. They
+can live in an awful lot of places, and we have to go through all of them,
+find the breakpoints, and then save them in the appropriate environment
+variable via C<DB::set_list>.
+
+=cut
+
+ # Go through all the breakpoints and make sure they're
+ # still valid.
+ my @hard;
+ for ( 0 .. $#had_breakpoints ) {
+
+ # We were in this file.
+ my $file = $had_breakpoints[$_];
+
+ # Grab that file's magic line hash.
+ *dbline = $main::{ '_<' . $file };
+
+ # Skip out if it doesn't exist, or if the breakpoint
+ # is in a postponed file (we'll do postponed ones
+ # later).
+ next unless %dbline or $postponed_file{$file};
+
+ # In an eval. This is a little harder, so we'll
+ # do more processing on that below.
+ ( push @hard, $file ), next
+ if $file =~ /^\(\w*eval/;
+
+ # XXX I have no idea what this is doing. Yet.
+ my @add;
+ @add = %{ $postponed_file{$file} }
+ if $postponed_file{$file};
+
+ # Save the list of all the breakpoints for this file.
+ set_list( "PERLDB_FILE_$_", %dbline, @add );
+ } ## end for (0 .. $#had_breakpoints)
+
+ # The breakpoint was inside an eval. This is a little
+ # more difficult. XXX and I don't understand it.
+ for (@hard) {
+ # Get over to the eval in question.
+ *dbline = $main::{ '_<' . $_ };
+ my ( $quoted, $sub, %subs, $line ) = quotemeta $_;
+ for $sub ( keys %sub ) {
+ next unless $sub{$sub} =~ /^$quoted:(\d+)-(\d+)$/;
+ $subs{$sub} = [ $1, $2 ];
+ }
+ unless (%subs) {
+ print $OUT
+ "No subroutines in $_, ignoring breakpoints.\n";
+ next;
+ }
+ LINES: for $line ( keys %dbline ) {
+
+ # One breakpoint per sub only:
+ my ( $offset, $sub, $found );
+ SUBS: for $sub ( keys %subs ) {
+ if (
+ $subs{$sub}->[1] >=
+ $line # Not after the subroutine
+ and (
+ not defined $offset # Not caught
+ or $offset < 0
+ )
+ )
+ { # or badly caught
+ $found = $sub;
+ $offset = $line - $subs{$sub}->[0];
+ $offset = "+$offset", last SUBS
+ if $offset >= 0;
+ } ## end if ($subs{$sub}->[1] >=...
+ } ## end for $sub (keys %subs)
+ if ( defined $offset ) {
+ $postponed{$found} =
+ "break $offset if $dbline{$line}";
+ }
+ else {
+ print $OUT
+"Breakpoint in $_:$line ignored: after all the subroutines.\n";
+ }
+ } ## end for $line (keys %dbline)
+ } ## end for (@hard)
+
+ # Save the other things that don't need to be
+ # processed.
+ set_list( "PERLDB_POSTPONE", %postponed );
+ set_list( "PERLDB_PRETYPE", @$pretype );
+ set_list( "PERLDB_PRE", @$pre );
+ set_list( "PERLDB_POST", @$post );
+ set_list( "PERLDB_TYPEAHEAD", @typeahead );
+
+ # We are oficially restarting.
+ $ENV{PERLDB_RESTART} = 1;
+
+ # We are junking all child debuggers.
+ delete $ENV{PERLDB_PIDS}; # Restore ini state
+
+ # Set this back to the initial pid.
+ $ENV{PERLDB_PIDS} = $ini_pids if defined $ini_pids;
+
+=pod
+
+After all the debugger status has been saved, we take the command we built up
+and then return it, so we can C<exec()> it. The debugger will spot the
+C<PERLDB_RESTART> environment variable and realize it needs to reload its state
+from the environment.
+
+=cut
+
+ # And run Perl again. Add the "-d" flag, all the
+ # flags we built up, the script (whether a one-liner
+ # or a file), add on the -emacs flag for a slave editor,
+ # and then the old arguments.
+
+ return ($^X, '-d', @flags, @script, ($slave_editor ? '-emacs' : ()), @ARGS);
+
+}; # end restart
+
+=back
+
+=head1 END PROCESSING - THE C<END> BLOCK
+
+Come here at the very end of processing. We want to go into a
+loop where we allow the user to enter commands and interact with the
+debugger, but we don't want anything else to execute.
+
+First we set the C<$finished> variable, so that some commands that
+shouldn't be run after the end of program quit working.
+
+We then figure out whether we're truly done (as in the user entered a C<q>
+command, or we finished execution while running nonstop). If we aren't,
+we set C<$single> to 1 (causing the debugger to get control again).
+
+We then call C<DB::fake::at_exit()>, which returns the C<Use 'q' to quit ...>
+message and returns control to the debugger. Repeat.
+
+When the user finally enters a C<q> command, C<$fall_off_end> is set to
+1 and the C<END> block simply exits with C<$single> set to 0 (don't
+break, run to completion.).
+
+=cut
+
+END {
+ $finished = 1 if $inhibit_exit; # So that some commands may be disabled.
+ $fall_off_end = 1 unless $inhibit_exit;
+
+ # Do not stop in at_exit() and destructors on exit:
+ if ($fall_off_end or $runnonstop) {
+ &save_hist();
+ } else {
+ $DB::single = 1;
+ DB::fake::at_exit();
+ }
+} ## end END
+
+=head1 PRE-5.8 COMMANDS
+
+Some of the commands changed function quite a bit in the 5.8 command
+realignment, so much so that the old code had to be replaced completely.
+Because we wanted to retain the option of being able to go back to the
+former command set, we moved the old code off to this section.
+
+There's an awful lot of duplicated code here. We've duplicated the
+comments to keep things clear.
+
+=head2 Null command
+
+Does nothing. Used to I<turn off> commands.
+
+=cut
+
+sub cmd_pre580_null {
+
+ # do nothing...
+}
+
+=head2 Old C<a> command.
+
+This version added actions if you supplied them, and deleted them
+if you didn't.
+
+=cut
+
+sub cmd_pre580_a {
+ my $xcmd = shift;
+ my $cmd = shift;
+
+ # Argument supplied. Add the action.
+ if ( $cmd =~ /^(\d*)\s*(.*)/ ) {
+
+ # If the line isn't there, use the current line.
+ $i = $1 || $line;
+ $j = $2;
+
+ # If there is an action ...
+ if ( length $j ) {
+
+ # ... but the line isn't breakable, skip it.
+ if ( $dbline[$i] == 0 ) {
+ print $OUT "Line $i may not have an action.\n";
+ }
+ else {
+
+ # ... and the line is breakable:
+ # Mark that there's an action in this file.
+ $had_breakpoints{$filename} |= 2;
+
+ # Delete any current action.
+ $dbline{$i} =~ s/\0[^\0]*//;
+
+ # Add the new action, continuing the line as needed.
+ $dbline{$i} .= "\0" . action($j);
+ }
+ } ## end if (length $j)
+
+ # No action supplied.
+ else {
+
+ # Delete the action.
+ $dbline{$i} =~ s/\0[^\0]*//;
+
+ # Mark as having no break or action if nothing's left.
+ delete $dbline{$i} if $dbline{$i} eq '';
+ }
+ } ## end if ($cmd =~ /^(\d*)\s*(.*)/)
+} ## end sub cmd_pre580_a
+
+=head2 Old C<b> command
+
+Add breakpoints.
+
+=cut
+
+sub cmd_pre580_b {
+ my $xcmd = shift;
+ my $cmd = shift;
+ my $dbline = shift;
+
+ # Break on load.
+ if ( $cmd =~ /^load\b\s*(.*)/ ) {
+ my $file = $1;
+ $file =~ s/\s+$//;
+ &cmd_b_load($file);
+ }
+
+ # b compile|postpone <some sub> [<condition>]
+ # The interpreter actually traps this one for us; we just put the
+ # necessary condition in the %postponed hash.
+ elsif ( $cmd =~ /^(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ ) {
+
+ # Capture the condition if there is one. Make it true if none.
+ my $cond = length $3 ? $3 : '1';
+
+ # Save the sub name and set $break to 1 if $1 was 'postpone', 0
+ # if it was 'compile'.
+ my ( $subname, $break ) = ( $2, $1 eq 'postpone' );
+
+ # De-Perl4-ify the name - ' separators to ::.
+ $subname =~ s/\'/::/g;
+
+ # Qualify it into the current package unless it's already qualified.
+ $subname = "${'package'}::" . $subname
+ unless $subname =~ /::/;
+
+ # Add main if it starts with ::.
+ $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
+
+ # Save the break type for this sub.
+ $postponed{$subname} = $break ? "break +0 if $cond" : "compile";
+ } ## end elsif ($cmd =~ ...
+
+ # b <sub name> [<condition>]
+ elsif ( $cmd =~ /^([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/ ) {
+ my $subname = $1;
+ my $cond = length $2 ? $2 : '1';
+ &cmd_b_sub( $subname, $cond );
+ }
+
+ # b <line> [<condition>].
+ elsif ( $cmd =~ /^(\d*)\s*(.*)/ ) {
+ my $i = $1 || $dbline;
+ my $cond = length $2 ? $2 : '1';
+ &cmd_b_line( $i, $cond );
+ }
+} ## end sub cmd_pre580_b
+
+=head2 Old C<D> command.
+
+Delete all breakpoints unconditionally.
+
+=cut
+
+sub cmd_pre580_D {
+ my $xcmd = shift;
+ my $cmd = shift;
+ if ( $cmd =~ /^\s*$/ ) {
+ print $OUT "Deleting all breakpoints...\n";
+
+ # %had_breakpoints lists every file that had at least one
+ # breakpoint in it.
+ my $file;
+ for $file ( keys %had_breakpoints ) {
+
+ # Switch to the desired file temporarily.
+ local *dbline = $main::{ '_<' . $file };
+
+ my $max = $#dbline;
+ my $was;
+
+ # For all lines in this file ...
+ for ( $i = 1 ; $i <= $max ; $i++ ) {
+
+ # If there's a breakpoint or action on this line ...
+ if ( defined $dbline{$i} ) {
+
+ # ... remove the breakpoint.
+ $dbline{$i} =~ s/^[^\0]+//;
+ if ( $dbline{$i} =~ s/^\0?$// ) {
+
+ # Remove the entry altogether if no action is there.
+ delete $dbline{$i};
+ }
+ } ## end if (defined $dbline{$i...
+ } ## end for ($i = 1 ; $i <= $max...
+
+ # If, after we turn off the "there were breakpoints in this file"
+ # bit, the entry in %had_breakpoints for this file is zero,
+ # we should remove this file from the hash.
+ if ( not $had_breakpoints{$file} &= ~1 ) {
+ delete $had_breakpoints{$file};
+ }
+ } ## end for $file (keys %had_breakpoints)
+
+ # Kill off all the other breakpoints that are waiting for files that
+ # haven't been loaded yet.
+ undef %postponed;
+ undef %postponed_file;
+ undef %break_on_load;
+ } ## end if ($cmd =~ /^\s*$/)
+} ## end sub cmd_pre580_D
+
+=head2 Old C<h> command
+
+Print help. Defaults to printing the long-form help; the 5.8 version
+prints the summary by default.
+
+=cut
+
+sub cmd_pre580_h {
+ my $xcmd = shift;
+ my $cmd = shift;
+
+ # Print the *right* help, long format.
+ if ( $cmd =~ /^\s*$/ ) {
+ print_help($pre580_help);
+ }
+
+ # 'h h' - explicitly-requested summary.
+ elsif ( $cmd =~ /^h\s*/ ) {
+ print_help($pre580_summary);
+ }
+
+ # Find and print a command's help.
+ elsif ( $cmd =~ /^h\s+(\S.*)$/ ) {
+ my $asked = $1; # for proper errmsg
+ my $qasked = quotemeta($asked); # for searching
+ # XXX: finds CR but not <CR>
+ if (
+ $pre580_help =~ /^
+ <? # Optional '<'
+ (?:[IB]<) # Optional markup
+ $qasked # The command name
+ /mx
+ )
+ {
+
+ while (
+ $pre580_help =~ /^
+ ( # The command help:
+ <? # Optional '<'
+ (?:[IB]<) # Optional markup
+ $qasked # The command name
+ ([\s\S]*?) # Lines starting with tabs
+ \n # Final newline
+ )
+ (?!\s)/mgx
+ ) # Line not starting with space
+ # (Next command's help)
+ {
+ print_help($1);
+ }
+ } ## end if ($pre580_help =~ /^<?(?:[IB]<)$qasked/m)
+
+ # Help not found.
+ else {
+ print_help("B<$asked> is not a debugger command.\n");
+ }
+ } ## end elsif ($cmd =~ /^h\s+(\S.*)$/)
+} ## end sub cmd_pre580_h
+
+=head2 Old C<W> command
+
+C<W E<lt>exprE<gt>> adds a watch expression, C<W> deletes them all.
+
+=cut
+
+sub cmd_pre580_W {
+ my $xcmd = shift;
+ my $cmd = shift;
+
+ # Delete all watch expressions.
+ if ( $cmd =~ /^$/ ) {
+
+ # No watching is going on.
+ $trace &= ~2;
+
+ # Kill all the watch expressions and values.
+ @to_watch = @old_watch = ();
+ }
+
+ # Add a watch expression.
+ elsif ( $cmd =~ /^(.*)/s ) {
+
+ # add it to the list to be watched.
+ push @to_watch, $1;
+
+ # Get the current value of the expression.
+ # Doesn't handle expressions returning list values!
+ $evalarg = $1;
+ my ($val) = &eval;
+ $val = ( defined $val ) ? "'$val'" : 'undef';
+
+ # Save it.
+ push @old_watch, $val;
+
+ # We're watching stuff.
+ $trace |= 2;
+
+ } ## end elsif ($cmd =~ /^(.*)/s)
+} ## end sub cmd_pre580_W
+
+=head1 PRE-AND-POST-PROMPT COMMANDS AND ACTIONS
+
+The debugger used to have a bunch of nearly-identical code to handle
+the pre-and-post-prompt action commands. C<cmd_pre590_prepost> and
+C<cmd_prepost> unify all this into one set of code to handle the
+appropriate actions.
+
+=head2 C<cmd_pre590_prepost>
+
+A small wrapper around C<cmd_prepost>; it makes sure that the default doesn't
+do something destructive. In pre 5.8 debuggers, the default action was to
+delete all the actions.
+
+=cut
+
+sub cmd_pre590_prepost {
+ my $cmd = shift;
+ my $line = shift || '*';
+ my $dbline = shift;
+
+ return &cmd_prepost( $cmd, $line, $dbline );
+} ## end sub cmd_pre590_prepost
+
+=head2 C<cmd_prepost>
+
+Actually does all the handling for C<E<lt>>, C<E<gt>>, C<{{>, C<{>, etc.
+Since the lists of actions are all held in arrays that are pointed to by
+references anyway, all we have to do is pick the right array reference and
+then use generic code to all, delete, or list actions.
+
+=cut
+
+sub cmd_prepost {
+ my $cmd = shift;
+
+ # No action supplied defaults to 'list'.
+ my $line = shift || '?';
+
+ # Figure out what to put in the prompt.
+ my $which = '';
+
+ # Make sure we have some array or another to address later.
+ # This means that if ssome reason the tests fail, we won't be
+ # trying to stash actions or delete them from the wrong place.
+ my $aref = [];
+
+ # < - Perl code to run before prompt.
+ if ( $cmd =~ /^\</o ) {
+ $which = 'pre-perl';
+ $aref = $pre;
+ }
+
+ # > - Perl code to run after prompt.
+ elsif ( $cmd =~ /^\>/o ) {
+ $which = 'post-perl';
+ $aref = $post;
+ }
+
+ # { - first check for properly-balanced braces.
+ elsif ( $cmd =~ /^\{/o ) {
+ if ( $cmd =~ /^\{.*\}$/o && unbalanced( substr( $cmd, 1 ) ) ) {
+ print $OUT
+"$cmd is now a debugger command\nuse `;$cmd' if you mean Perl code\n";
+ }
+
+ # Properly balanced. Pre-prompt debugger actions.
+ else {
+ $which = 'pre-debugger';
+ $aref = $pretype;
+ }
+ } ## end elsif ( $cmd =~ /^\{/o )
+
+ # Did we find something that makes sense?
+ unless ($which) {
+ print $OUT "Confused by command: $cmd\n";
+ }
+
+ # Yes.
+ else {
+
+ # List actions.
+ if ( $line =~ /^\s*\?\s*$/o ) {
+ unless (@$aref) {
+
+ # Nothing there. Complain.
+ print $OUT "No $which actions.\n";
+ }
+ else {
+
+ # List the actions in the selected list.
+ print $OUT "$which commands:\n";
+ foreach my $action (@$aref) {
+ print $OUT "\t$cmd -- $action\n";
+ }
+ } ## end else
+ } ## end if ( $line =~ /^\s*\?\s*$/o)
+
+ # Might be a delete.
+ else {
+ if ( length($cmd) == 1 ) {
+ if ( $line =~ /^\s*\*\s*$/o ) {
+
+ # It's a delete. Get rid of the old actions in the
+ # selected list..
+ @$aref = ();
+ print $OUT "All $cmd actions cleared.\n";
+ }
+ else {
+
+ # Replace all the actions. (This is a <, >, or {).
+ @$aref = action($line);
+ }
+ } ## end if ( length($cmd) == 1)
+ elsif ( length($cmd) == 2 ) {
+
+ # Add the action to the line. (This is a <<, >>, or {{).
+ push @$aref, action($line);
+ }
+ else {
+
+ # <<<, >>>>, {{{{{{ ... something not a command.
+ print $OUT
+ "Confused by strange length of $which command($cmd)...\n";
+ }
+ } ## end else [ if ( $line =~ /^\s*\?\s*$/o)
+ } ## end else
+} ## end sub cmd_prepost
+
+=head1 C<DB::fake>
+
+Contains the C<at_exit> routine that the debugger uses to issue the
+C<Debugged program terminated ...> message after the program completes. See
+the C<END> block documentation for more details.
+
+=cut
+
+package DB::fake;
+
+sub at_exit {
+ "Debugged program terminated. Use `q' to quit or `R' to restart.";
+}
+
+package DB; # Do not trace this 1; below!
+
+1;
+
+
diff --git a/Perldl2/Makefile.PL b/Perldl2/Makefile.PL
new file mode 100644
index 0000000..0b1fe5f
--- /dev/null
+++ b/Perldl2/Makefile.PL
@@ -0,0 +1,61 @@
+use ExtUtils::MakeMaker;
+PDL::Core::Dev->import();
+
+my @podpms = map { $_.".pod", '$(INST_LIBDIR)/' . $_ .".pod"} qw/pdl2/;
+
+# Make sure we have the PDL CONFIG hash loaded, and try to load it
+# from perldl.conf if not.
+use File::Spec;
+unless (%PDL_CONFIG) {
+ do File::Spec->catfile('..', 'perldl.conf') ;
+ %PDL::Config = %PDL_CONFIG;
+}
+
+if (!defined $PDL::Config{WITH_DEVEL_REPL}) {
+ if (eval 'require Devel::REPL;') {
+ # Only generate Makefile if we have Devel::REPL
+ WriteMakefile(
+ 'NAME' => 'PDL::Perldl2',
+ 'VERSION' => '2.000',
+ 'EXE_FILES' => [ 'pdl2' ],
+ 'DIR' => [ qw(Profile Plugin) ],
+ 'PM' => { 'Script.pm' => '$(INST_LIBDIR)/Perldl2/Script.pm', @podpms },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+ );
+ } else {
+ # Devel::REPL was not found
+ $PDL::Config{WITH_DEVEL_REPL} = 0;
+ $msg = "Devel::REPL is not installed, will not build Perldl2 shell";
+ print STDERR "$msg\n";
+ write_dummy_make($msg);
+ }
+}
+elsif ($PDL::Config{WITH_DEVEL_REPL}) {
+ # They want it, so make it
+ WriteMakefile(
+ 'NAME' => 'PDL::Perldl2',
+ 'VERSION' => '2.000',
+ 'EXE_FILES' => [ 'pdl2' ],
+ 'DIR' => [ qw(Profile Plugin) ],
+ 'PM' => { 'Script.pm' => '$(INST_LIBDIR)/Perldl2/Script.pm', @podpms },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+ );
+}
+else {
+ # they don't want it, so generate a dummy
+ write_dummy_make('Not making or installing Perldl2 shell, per configuration');
+}
+# Extra build target to build the doc database
+sub MY::postamble {
+ my $text = '';
+
+ $text .= << "EOPS" ;
+
+pdl2.pod : pdl2 subdirs
+\t\$(PERLRUN) -MPod::Select -e "podselect('pdl2');" > pdl2.pod
+
+EOPS
+
+ return $text;
+
+}
diff --git a/Perldl2/Plugin/CleanErrors.pm b/Perldl2/Plugin/CleanErrors.pm
new file mode 100644
index 0000000..0b4d1c8
--- /dev/null
+++ b/Perldl2/Plugin/CleanErrors.pm
@@ -0,0 +1,59 @@
+package PDL::Perldl2::Plugin::CleanErrors;
+
+use Devel::REPL::Plugin;
+
+use namespace::clean -except => [ 'meta' ];
+
+around 'error_return' => sub {
+ my ($orig, $self) = (shift, shift);
+ my ($type, $error) = @_;
+
+ return $orig->($self, $type, clean_error_string($error));
+};
+
+# filter out the Devel::REPL, Class::MOP, ... from pdl2 errors
+sub clean_error_string {
+ my $bigerr = $_[0];
+ $bigerr =~ s/^\s+Devel::REPL.*$//ms;
+ $bigerr =~ s/^\s+Class::MOP.*$//ms;
+ $bigerr =~ s/^\s+Lexical::Persistence.*$//ms;
+ $bigerr =~ s/^\s+main::.*$//ms;
+ $bigerr =~ s/^\s+eval \{.*$//ms;
+ $bigerr =~ s/^\s+PDL::Core::barf.*$//ms;
+ return $bigerr;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+PDL::Perldl2::Plugin::CleanErrors - filter out Moose cruft
+
+=head1 DESCRIPTION
+
+Runtime errors in pdl2 are extremely verbose since they
+include the entire call chain from the start of the interactive
+Devel::REPL shell, through the Moose and Class::MOP stuff and
+including Lexical::Persistence as well. This plugin, which
+is loaded by default, strips out the non-PDL stuff to make the
+error messages much more concise.
+
+
+=head1 SEE ALSO
+
+C<Devel::REPL>
+
+=head1 AUTHOR
+
+Chris Marshall, C<< <chm at cpan dot org> >>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2011 by Christopher Marshall
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/Perldl2/Plugin/Makefile.PL b/Perldl2/Plugin/Makefile.PL
new file mode 100644
index 0000000..68b6ccb
--- /dev/null
+++ b/Perldl2/Plugin/Makefile.PL
@@ -0,0 +1,13 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'PDL::Perldl2::Plugin',
+ 'VERSION' => '2.001',
+ 'PM' => {
+ 'CleanErrors.pm' => '$(INST_LIBDIR)/Plugin/CleanErrors.pm',
+ 'NiceSlice.pm' => '$(INST_LIBDIR)/Plugin/NiceSlice.pm',
+ 'PDLCommands.pm' => '$(INST_LIBDIR)/Plugin/PDLCommands.pm',
+ 'PrintControl.pm' => '$(INST_LIBDIR)/Plugin/PrintControl.pm',
+ },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
diff --git a/Perldl2/Plugin/NiceSlice.pm b/Perldl2/Plugin/NiceSlice.pm
new file mode 100644
index 0000000..f0d2019
--- /dev/null
+++ b/Perldl2/Plugin/NiceSlice.pm
@@ -0,0 +1,75 @@
+package PDL::Perldl2::Plugin::NiceSlice;
+
+use Devel::REPL::Plugin;
+
+use namespace::clean -except => [ 'meta' ];
+
+use PDL::Lite;
+use PDL::NiceSlice;
+
+my $preproc = sub {
+ my ($txt) = @_;
+ my $new = PDL::NiceSlice::perldlpp('main',$txt);
+ return $new;
+};
+
+around 'compile' => sub {
+
+ my ($orig, $self) = (shift, shift);
+ my ($lines, @args) = @_;
+
+ no PDL::NiceSlice;
+ $lines = $preproc->($lines);
+
+ $self->$orig($lines, @args);
+};
+
+1;
+
+__END__
+
+=head1 NAME
+
+PDL::Perldl2::Plugin::NiceSlice - enable PDL NiceSlice syntax
+
+=head1 DESCRIPTION
+
+This plugin enables one to use the PDL::NiceSlice syntax in an
+instance of C<Devel::REPL> such as the new Perldl2 shell, C<pdl2>.
+Without the plugin, array slicing looks like this:
+
+ pdl> use PDL;
+
+ pdl> $a = sequence(10);
+ $PDL1 = [0 1 2 3 4 5 6 7 8 9];
+
+ pdl> $a->slice("2:9:2");
+ $PDL1 = [2 4 6 8];
+
+After the NiceSlice plugin has been loaded, you can use this:
+
+ pdl> $a(2:9:2)
+ $PDL1 = [2 4 6 8];
+
+=head1 CAVEATS
+
+C<PDL::NiceSlice> uses Perl source preprocessing.
+If you need 100% pure Perl compatibility, use the
+slice method instead.
+
+=head1 SEE ALSO
+
+C<PDL::NiceSlice>, C<Devel::REPL>, C<PDL::Perldl>
+
+=head1 AUTHOR
+
+Chris Marshall, C<< <chm at cpan dot org> >>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2010 by Christopher Marshall
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/Perldl2/Plugin/PDLCommands.pm b/Perldl2/Plugin/PDLCommands.pm
new file mode 100644
index 0000000..f0c4108
--- /dev/null
+++ b/Perldl2/Plugin/PDLCommands.pm
@@ -0,0 +1,107 @@
+package PDL::Perldl2::Plugin::PDLCommands;
+
+use Devel::REPL::Plugin;
+
+use namespace::clean -except => [ 'meta' ];
+
+# The atomic option---need to deconflict Turtle command injection
+# using qr{\#} and perldl's usage for command escapes. Just
+# exclude for now to get things working
+excludes 'Turtles';
+
+around 'read' => sub {
+
+ my $orig = shift;
+ my ($self, @args) = @_;
+
+ # using $lines here because that is the usage from perldl
+ # and I want to cut and paste existing code if possible
+ my $lines = $self->$orig(@args);
+
+ # Execute the list of auto-code (TODO)
+ ## for my $c (@PERLDL::AUTO) {
+ ## my $mess = eval_and_report($c);
+ ## warn $mess if $mess;
+ ## }
+
+ # Filter out PDL shell prefixes from cut-n-pasted lines
+ if ( defined($lines) and $lines =~ s/$PERLDL::PREFIX_RE// ) {
+ if ($PERLDL::TERM->can('GetHistory') and $PERLDL::TERM->can('SetHistory')) {
+ my @hist = $PERLDL::TERM->GetHistory();
+ foreach my $entry (@hist) { $entry =~ s/$PERLDL::PREFIX_RE//; }
+ $PERLDL::TERM->SetHistory(@hist);
+ }
+ }
+
+ return $lines unless defined $lines;
+
+ # print STDERR "PDLCommands: got '$lines'\n";
+ if ( lc $lines eq 'q' || lc $lines eq 'x' || lc $lines eq 'exit' ) { return "quit"; };
+
+ $lines =~ s/^\s*\?\?\s*/apropos /; # Make '??' = 'apropos'
+ $lines =~ s/^\s*\?\s*/help /; # Make lone '?' = 'help'
+
+ if ( $lines =~ /^\s*(help|usage|apropos|sig|badinfo|demo)\s+/) { # Allow help foo (no quotes)
+ my @t = split(/\s+/,$lines);
+ my $a;
+ foreach $a(@t) { $a=~s/^["']+//; $a=~s/['"]+$//; };
+ $t[1] = "'".$t[1]."'" if ($#t == 1 && !($t[1] =~ /^\$/));
+ $lines = join(' ', at t);
+ }
+
+ $PERLDL::ESCAPE = $PERLDL::ESCAPE if defined $PERLDL::ESCAPE;
+ if (substr($lines,0,1) eq substr($PERLDL::ESCAPE,0,1) and
+ substr($lines,0,2) ne '#!') { # Allow escapes, avoid shebang
+ my @lines = split /\n/, $lines;
+ system(substr(shift @lines,1)); # Shell escape
+ $lines = join("\n", at lines);
+ }
+
+ return $lines;
+};
+
+1;
+
+__END__
+
+=head1 NAME
+
+PDL::Perldl2::Plugin::PDLCommands - implement perldl aliases/escapes
+
+=head1 DESCRIPTION
+
+
+This plugin implements the various convenience features of the
+perldl shell which correspond, roughly, to aliases and some
+structured pre-processing of the command line entered:
+
+=over 4
+
+=item q|x|exit|quit as shortcuts to quit the shell
+
+=item ?? as an alias for apropos
+
+=item ? as an alias for help
+
+=item Autoquoting for arguments to help|usage|apropos|sig|badinfo|demo
+
+=item C<$PERLDL::ESCAPE> at the start of a command line to escape to the shell, defaults to C<#>
+
+=back
+
+=head1 SEE ALSO
+
+C<PDL::Perldl>, C<Devel::REPL>
+
+=head1 AUTHOR
+
+Chris Marshall, C<< <chm at cpan dot org> >>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2010 by Christopher Marshall
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/Perldl2/Plugin/PrintControl.pm b/Perldl2/Plugin/PrintControl.pm
new file mode 100644
index 0000000..89281b4
--- /dev/null
+++ b/Perldl2/Plugin/PrintControl.pm
@@ -0,0 +1,94 @@
+package PDL::Perldl2::Plugin::PrintControl;
+
+use Devel::REPL::Plugin;
+
+use namespace::clean -except => [ 'meta' ];
+
+has 'print_by_default' => (
+ is => 'rw',
+ default => 0,
+ );
+
+around 'format_result' => sub {
+
+ my ($orig, $self) = (shift, shift);
+ my ($lines, @args) = @_;
+
+ return $self->print_by_default ? $orig->($self, @_) : ();
+
+};
+
+# convenience method to set/toggle print default settings
+# sets like accessor if given a value, otherwise toggles status
+sub do_print {
+ my ($repl, $value) = @_;
+ $value = (defined $value) ? $value : ! $repl->print_by_default;
+ return $repl->print_by_default($value);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+PDL::Perldl2::Plugin::PrintControl - disable default print output
+
+=head1 SYNOPSIS
+
+ pdl> $a = 3;
+ 3
+ pdl> $_REPL->load_plugin('PDL::Perldl2::Plugin::PrintControl');
+
+ pdl> $a;
+
+ pdl> $_REPL->print_by_default(1);
+ 1
+ pdl> $a;
+ 3
+
+=head1 DESCRIPTION
+
+By default the Devel::REPL always prints the results of its
+evaluation. This is fine for small objects but for things
+like large data objects (e.g. a 100x100 matrix in PDL) the
+result can be hundreds of lines of output for each command.
+
+This plugin disables the default print output and adds an
+attribute with accessor method C<print_by_default> which can be
+used to toggle the print default on or off.
+
+=head1 METHODS
+
+=head2 print_by_default
+
+By default, the C<PrintControl> plugin sets C<print_by_default> to
+0 (false), which disables automatic printing of results.
+Call the print_by_default accessor with a 1 (true value) to enable
+default printing.
+
+=head2 do_print
+
+This is a convenience accessor for the print_by_default attribute.
+If you call this method without a value, it toggles the current
+setting. Otherwise, it just sets print_by_default to the value.
+
+It is also available in the C<pdl2> shell as the do_print sub
+with the same operation but with an implicit use of C<$_REPL>.
+
+=head1 SEE ALSO
+
+C<Devel::REPL>
+
+=head1 AUTHOR
+
+Chris Marshall, C<< <chm at cpan dot org> >>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2010 by Christopher Marshall
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/Perldl2/Profile/Makefile.PL b/Perldl2/Profile/Makefile.PL
new file mode 100644
index 0000000..ef5a06a
--- /dev/null
+++ b/Perldl2/Profile/Makefile.PL
@@ -0,0 +1,8 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'PDL::Perldl2::Profile',
+ 'VERSION' => '2.000',
+ 'PM' => { 'Perldl2.pm' => '$(INST_LIBDIR)/Profile/Perldl2.pm' },
+ (eval ($ExtUtils::MakeMaker::VERSION) >= 6.57_02 ? ('NO_MYMETA' => 1) : ()),
+);
diff --git a/Perldl2/Profile/Perldl2.pm b/Perldl2/Profile/Perldl2.pm
new file mode 100644
index 0000000..610745a
--- /dev/null
+++ b/Perldl2/Profile/Perldl2.pm
@@ -0,0 +1,290 @@
+package PDL::Perldl2::Profile::Perldl2;
+#
+# Created on: Sun 25 Apr 2010 03:09:34 PM
+# Last saved: Fri 16 Dec 2011 03:19:27 PM
+#
+
+use Moose;
+use namespace::clean -except => [ 'meta' ];
+
+$PDL::Perldl2::Profile::Perldl2::VERSION = 0.008;
+
+with 'Devel::REPL::Profile';
+
+sub plugins {
+ qw(
+ CleanErrors
+ Commands
+ Completion
+ CompletionDriver::INC
+ CompletionDriver::Keywords
+ CompletionDriver::LexEnv
+ CompletionDriver::Methods
+ DDS
+ History
+ LexEnv
+ MultiLine::PPI
+ Packages
+ NiceSlice
+ PrintControl
+ ReadLineHistory
+ PDLCommands
+ ); # CompletionDriver::Globals
+}
+
+sub apply_profile {
+ my ($self, $repl) = @_;
+
+ # check for Term::ReadLine::Stub
+ if ($repl->term->ReadLine =~ /Stub/) {
+ $repl->print("WARNING:\n Term::ReadLine::Stub does not support pdl2 features.\n");
+ $repl->print(" Please install either Term::ReadLine::Perl or Term::ReadLine::Gnu.\n");
+ $repl->print(" Falling back to perldl in the meantime...\n");
+ $repl->print("------------------------------------------\n\n");
+ exec 'perldl';
+ }
+
+ # add PDL::Perldl2 for plugin search
+ push @{$repl->_plugin_app_ns}, 'PDL::Perldl2';
+
+ foreach my $plug ($self->plugins) {
+ if ($plug =~ 'CompletionDriver::INC') {
+ eval 'use File::Next';
+ next if $@;
+ }
+ if ($plug =~ 'CompletionDriver::Keywords') {
+ eval 'use B::Keywords';
+ next if $@;
+ }
+ $repl->load_plugin($plug);
+ }
+
+ # these plugins don't work on win32
+ unless ($^O =~ m/win32/i) {
+ $repl->load_plugin('Interrupt');
+ }
+
+ # enable Term::ReadLine file expansion by default
+ $repl->do_readline_filename_completion(1) if $repl->can('do_readline_filename_completion');
+
+ # do perldl stuff here
+ $repl->eval('package main');
+
+ $repl->eval('use PDL');
+ $repl->eval('use PDL::Config');
+ $repl->eval('use PDL::Dbg');
+ $repl->eval('use PDL::Doc::Perldl');
+ $repl->eval('use PDL::IO::Dumper');
+ $repl->eval('use PDL::IO::FlexRaw');
+ $repl->eval('use PDL::IO::Pic');
+ $repl->eval('use PDL::Image2D');
+ $repl->eval('use PDL::AutoLoader');
+ $repl->eval('no strict qw(vars)');
+
+ # declare PERLDL package variables
+ # most are not used but they are here if needed
+ $repl->eval( q[
+ @PERLDL::AUTO = (); # code string/refs to run after user enters a new line
+ $PERLDL::ESCAPE = '#'; # Default shell escape character
+ $PERLDL::HISTFILESIZE = $ENV{PERLREPL_HISTLEN}; # Number of lines to keep in history
+ $PERLDL::MULTI = 1; # Enable multi-lines by default
+ $PERLDL::NO_EOF = 1; # Enable EOF protection by default
+ $PERLDL::PAGE = 0;
+ $PERLDL::PAGER = ((exists $ENV{PAGER}) ? $ENV{PAGER} : 'more');
+ $PERLDL::PAGING = 0;
+ $PERLDL::PROMPT = "pdl> "; # string or code reference
+ $PERLDL::PREFIX_RE = qr(^\s*(?:pdl|perldl)>\s*); # RE for shell prompts
+ $PERLDL::TERM = $_REPL->term;
+ ] );
+
+ #autoflush STDOUT
+ $repl->eval('$|=1;');
+ # p command (NOTE: this is not an alias for print)
+ $repl->eval('sub p { local $, = " "; print @_,"\n" };');
+
+ # list history command
+ $repl->eval('sub l {
+ my $n = $#_ > -1 ? shift : 20;
+ my @h = $_REPL->term->GetHistory();
+ my $min = $#h < $n-1 ? 0 : $#h-$n+1;
+ map { printf "%d: %s\n", $_+1, $h[$_] } ($min..$#h);
+ #map {print "$_: $h[$_]\n"} ($min..$#h);
+ };');
+
+ # preliminary support for PDL demos
+ $repl->eval( q{
+ sub demo {
+ local $_ = lc $_[0] ;
+ if(/^$/) {
+ print <<EOD;
+ Use:
+ demo pdl # general demo
+
+ demo 3d # 3d demo (requires TriD with OpenGL or Mesa)
+ demo 3d2 # 3d demo, part 2. (Somewhat memory-intensive)
+ demo 3dgal # the 3D gallery: make cool images with 3-line scripts
+
+ demo pgplot # PGPLOT graphics output (Req.: PGPLOT)
+ demo OOplot # PGPLOT OO interface (Req.: PGPLOT)
+
+ demo gnuplot # Gnuplot graphics (requires PDL::Graphics::Gnuplot)
+ demo prima # Prima graphics (requires PDL::Graphics::Prima)
+
+ demo transform # Coordinate transformations (Req.: PGPLOT)
+ demo cartography # Cartographic projections (Req.: PGPLOT)
+
+ demo bad # Bad-value demo (Req.: bad value support)
+ demo bad2 # Bad-values, part 2 (Req.: bad value support and PGPLOT)
+EOD
+ return;
+ } # if: /^$/
+
+ my %demos = (
+ 'pdl' => 'PDL::Demos::General', # have to protect pdl as it means something
+ '3d' => 'PDL::Demos::TriD1',
+ '3d2' => 'PDL::Demos::TriD2',
+ '3dgal' => 'PDL::Demos::TriDGallery',
+ 'pgplot' => 'PDL::Demos::PGPLOT_demo',
+ 'ooplot' => 'PDL::Demos::PGPLOT_OO_demo', # note: lowercase
+ 'bad' => 'PDL::Demos::BAD_demo',
+ 'bad2' => 'PDL::Demos::BAD2_demo',
+ 'transform' => 'PDL::Demos::Transform_demo',
+ 'cartography' => 'PDL::Demos::Cartography_demo',
+ 'gnuplot' => 'PDL::Demos::Gnuplot_demo',
+ 'prima' => 'PDL::Demos::Prima',
+ );
+
+ if ( exists $demos{$_} ) {
+ require PDL::Demos::Screen; # Get the routines for screen demos.
+ my $name = $demos{$_};
+ eval "require $name;"; # see docs on require for need for eval
+ $name .= "::run";
+ no strict 'refs';
+ &{$name}();
+ } else {
+ print "No such demo!\n";
+ }
+
+ } } );
+
+ if ($repl->can('do_print')) {
+ $repl->eval('sub do_print { $_REPL->do_print(@_) };');
+ }
+
+ if ($repl->can('exit_repl')) {
+ $repl->eval('sub quit { $_REPL->exit_repl(1) };');
+ } else {
+ $repl->eval('sub quit { $_REPL->print("Use Ctrl-D or exit to quit" };');
+ }
+
+ $repl->prompt($PERLDL::PROMPT); # new prompt
+
+ if ( defined $ENV{TERM} and $ENV{TERM} eq 'dumb' ) {
+ $repl->print("\n");
+ $repl->print("******************************************\n");
+ $repl->print("* Warning: TERM type is dumb! *\n");
+ $repl->print("* Limited ReadLine functionality will be *\n");
+ $repl->print("* available. Please unset TERM or use a *\n");
+ $repl->print("* different terminal type. *\n");
+ $repl->print("******************************************\n");
+ $repl->print("\n");
+ }
+
+ $repl->print("Perldl2 Shell v$PDL::Perldl2::Profile::Perldl2::VERSION
+ PDL comes with ABSOLUTELY NO WARRANTY. For details, see the file
+ 'COPYING' in the PDL distribution. This is free software and you
+ are welcome to redistribute it under certain conditions, see
+ the same file for details.\n");
+
+ $repl->print("Loaded plugins:\n");
+ {
+ my @plugins = ();
+ foreach my $pl ( $repl->_plugin_locator->plugins ) {
+ # print names of ones that have been loaded
+ my $plug = $pl;
+ $plug =~ s/^.*Plugin::/ /;
+ push @plugins, $plug if $repl->does($pl);
+ }
+ # Need smarter display of plugins, fill out the line
+ # and list CompletionDrivers under Completion
+ $repl->print(join "\n", sort(@plugins));
+ $repl->print("\n");
+ }
+
+ $repl->print("Type 'help' for online help\n");
+ $repl->print("Type Ctrl-D or quit to exit\n");
+ $repl->print("Loaded PDL v$PDL::VERSION\n");
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+PDL::Perldl2::Profile::Perldl2 - profile for Perldl2 shell
+
+=head1 SYNOPSIS
+
+ system> re.pl --profile=PDL::Perldl2::Profile::Perldl2 # unix-ish shell
+ system> re --profile=PDL::Perldl2::Profile::Perldl2 # win32 CMD shell
+
+ Perldl2 Shell v0.008
+ PDL comes with ABSOLUTELY NO WARRANTY. For details, see the file
+ 'COPYING' in the PDL distribution. This is free software and you
+ are welcome to redistribute it under certain conditions, see
+ the same file for details.
+
+ Loaded plugins:
+ CleanErrors
+ Commands
+ Completion
+ CompletionDriver::INC
+ CompletionDriver::Keywords
+ CompletionDriver::LexEnv
+ CompletionDriver::Methods
+ DDS
+ FindVariable
+ History
+ Interrupt
+ LexEnv
+ MultiLine::PPI
+ NiceSlice
+ PDLCommands
+ Packages
+ PrintControl
+ ReadLineHistory
+
+
+ Type 'help' for online help
+
+ Type Ctrl-D or quit to exit
+
+ Loaded PDL v2.006
+
+ pdl>
+
+
+=head1 DESCRIPTION
+
+This profile is for development of the new PDL shell (version 2).
+The preferred method to start the new shell is via the C<pdl2>
+command. This documentation is provided for C<Devel::REPL> coders
+that may wish to use this profile directly for their development.
+
+=head1 SEE ALSO
+
+C<Devel::REPL>, C<Devel::REPL::Profile>, and C<PDL::Perldl>.
+
+=head1 AUTHOR
+
+Chris Marshall, C<< <chm at cpan dot org> >>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2010 by Christopher Marshall
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/Perldl2/README b/Perldl2/README
new file mode 100644
index 0000000..5084b61
--- /dev/null
+++ b/Perldl2/README
@@ -0,0 +1,141 @@
+Created on: Thu 10 Dec 2009 10:32:58 PM
+Last saved: Tue 09 Jul 2013 08:51:39 AM
+
+
++-----------------------------------------------------------+
+| OS/Platforms supported: ALL |
++-----------------------------------------------------------+
+
+This directory contains development efforts for a new and
+improved perldl shell (Perldl2).
+
+You need to install the version 1.003011 of Devel::REPL
+and have installed either Term::ReadLine::Perl or
+Term::ReadLine::Gnu in order to use the new Perldl2 shell
+capabilities.
+
+
++-----------------------------------------------------------+
+| CONTENTS |
++-----------------------------------------------------------+
+
+ README
+ This file
+
+ TODO
+ Development list for Perldl2 shell
+
+ Makefile.PL
+ Perl configuration/build script for Perldl2
+
+ Plugin/
+ Profile/
+ Script.pm
+ Perl modules and directories with modules for Perldl2
+
+ pdl2
+ A perl script for starting the Perldl2 shell.
+ (Falls back to the original perldl if either Devel::REPL
+ or neither Term::ReadLine::Gnu nor Term::ReadLine::Perl
+ are installed.)
+
+
++-----------------------------------------------------------+
+| INSTALLATION |
++-----------------------------------------------------------+
+
+ By default, the Perldl2 shell is always built and the
+ pdl2 script installed. To disable this, edit the
+ WITH_DEVEL_REPL option in the perldl.conf file.
+
+ You will need to install Devel::REPL version 1.003011
+ or greater and either of Term::ReadLine::Gnu or
+ Term::ReadLine::Perl to access the new pdl2 capabilities.
+
+
++-----------------------------------------------------------+
+| USE |
++-----------------------------------------------------------+
+
+ To use the Perldl2 shell, from the PDL build directory
+ run the following:
+
+ perl -Mblib Perldl2/pdl2
+
+ If you have installed the just built PDL, you should
+ be able to run:
+
+ pdl2
+
+ To exit the Perldl2 shell from the 'pdl> ' prompt, type
+ Ctrl-D or quit, (q, x, and exit shortcuts are also
+ available). If Devel::REPL is not installed (or you
+ don't have either TR::Gnu or TR::Perl), pdl2 will use
+ perldl instead but the new Perldl2 features will not
+ be available.
+
+ The idea is that one just uses pdl2 where you used to
+ use perldl. At some point, the development will be
+ complete and there will be only one PDL shell.
+
+
++-----------------------------------------------------------+
+| NOTES |
++-----------------------------------------------------------+
+
+ Supported functionality from Devel::REPL and PDL:
+ * DDS (pretty prints output using Data::Dump::Streamer)
+ * History (redo commands with !-1 and !<num> syntax)
+ * Interrupt (interrupt with Ctrl-C; not on MSWin32)
+ * LexEnv (e.g., my $a = zeros(10) works)
+ * MultiLine::PPI (handles multiline input like perldl)
+ * NiceSlice (PDL::NiceSlice works too!)
+ * Packages (keeps track of current user package)
+ * PDLCommands (perldl shell v1 convenience routines)
+ * ReadLineHistory
+ * Save and restore command history to file
+ * CompletionDrivers
+ * Globals (completion for globals)
+ * INC (completion for use module::name)
+ * Keywords (completion for perl keywords)
+ * LexEnv (completion for lexical vars)
+ * Methods (completion of method names)
+
+ Default PDL modules loaded:
+ * PDL
+ * PDL::Dbg
+ * PDL::Doc::Perldl
+ * PDL::IO::Dumper
+ * PDL::IO::FlexRaw
+ * PDL::IO::Pic
+ * PDL::Image2D
+ * PDL::AutoLoader
+
+ ? and ?? are aliases for help and apropos
+
+ Arguments to help|usage|apropos|sig|badinfo|demo are autoquoted
+
+ Shell escapes start with $PERLDL::ESCAPE as the first character
+ of a line ('#' by default).
+
+ l <num> prints the last <num> lines of history, default 20.
+
+ p prints the following args separated by space (i.e., $,=' ')
+
+ demo as a command by itself lists the possible demos available.
+ Otherwise it runs the specified demo.
+
+ By default, leading patterns matching the pdl2 shell
+ prompt ('pdl> ' with possible surrounding white space)
+ are stripped from the input. That allows for easy
+ cut-and-paste of pdl2 sessions from examples, demos,
+ or docs.
+
+ The Perldl2 shell, pdl2, loads/saves from the same history
+ file as perldl.
+
+ The Perldl2 shell, pdl2, loads your .perldlrc file
+ from the same location as the perldl shell does. It also
+ accepts .pdlrc as the name---looking forward to the new
+ naming scheme for the interactive shell. A local.pdlrc
+ or local.perldlrc are run if present as well.
diff --git a/Perldl2/Script.pm b/Perldl2/Script.pm
new file mode 100644
index 0000000..12881f9
--- /dev/null
+++ b/Perldl2/Script.pm
@@ -0,0 +1,49 @@
+package PDL::Perldl2::Script;
+
+use Moose;
+
+use namespace::clean -except => [ qw(meta) ];
+
+extends 'Devel::REPL::Script';
+
+sub _startup_def {
+ return "PDL/default.pdl" if $^O =~ /win32/i;
+ return "PDL/default.perldlrc";
+}
+
+sub load_rcfile {
+ my ($self, $rc_file) = @_;
+
+ my $HOME = $ENV{HOME};
+ if ($^O =~ /win32/i and
+ (! defined($HOME)) or
+ (defined($HOME) and $HOME eq "")) {
+ $HOME = $ENV{USERPROFILE};
+ $HOME =~ s/\\/\//g;
+ }
+ print STDERR "load_rcfile: got \$HOME = $HOME\n";
+
+ # get rc file name
+ my $startup_file = _startup_def();
+ foreach my $startup_suffix (qw( .pdlrc .perldlrc )) {
+ if ( -e "$HOME/$startup_suffix" ) {
+ $startup_file = "$HOME/$startup_suffix";
+ last;
+ }
+ }
+ print STDERR "load_rcfile: loading $startup_file\n";
+ $self->apply_script($startup_file);
+
+ # load local.perldlrc if it exists
+ foreach my $local_startup_file (qw( local.pdlrc local.perldlrc )) {
+ if ( -e $local_startup_file ) {
+ print STDERR "load_rcfile: loading $local_startup_file\n";
+ $self->apply_script($local_startup_file);
+ last;
+ }
+ }
+}
+
+# Global and local startup
+
+1;
diff --git a/Perldl2/TODO b/Perldl2/TODO
new file mode 100644
index 0000000..fbdebd7
--- /dev/null
+++ b/Perldl2/TODO
@@ -0,0 +1,321 @@
+Created on: Thu 10 Dec 2009 10:32:58 PM
+Last saved: Tue 09 Jul 2013 09:05:18 AM
+
+
++-------------------------------------------------------------------+
+| TODO for Missing Perldl Functionality |
++-------------------------------------------------------------------+
+
+ Set readline_name to 'PDL Shell' instead of the
+ default 'Perl REPL' but need to figure how to do
+ so first (override default term?).
+
+ Add syntax highlighting to help ensure correct
+ entries (e.g., in matlab keywords are blue, strings
+ are purple, unterminated strings are maroon...)
+ We could also specifically color piddles and objects
+ from the current session space.
+
+ Add "blink to matching delimiter" for input or even
+ color highlight matching delimiters
+
+ Add Colors plugin support to the pdl2 p command.
+
+ Add enhanced filter support to remove leading prompt
+ strings (or other text) from input lines. Need to be
+ able to toggle on/off and set the regexp used.
+
+ Allow Ctrl-C to interrupt a line but keep the entry
+ in history for edit...
+
+ Fix q alias for quit which broke as a side effect of
+ a fix to the MultiLine::PPI handling. Perhaps using
+ around continue_reading_if_necessary would do the
+ trick. Need to sort out the Moose/Plugin/Roles issues
+ and document.
+
+ Implement ^C/^D to end PPI multiline if it makes sense.
+ E.g., make sure that Ctrl-C can exit an incomplete
+ block. Right now ^C does not interrupt a multiline
+ entry. Need to see about implementing the Ctrl-D option
+ to close all blocks as well. It would be nice to have
+ the prompt display the matching delims as in perldl.
+
+ Fix Term::ReadLine::Perl completion in win32 to use
+ the appropriate path separator character. It appears
+ to use / which is fine inside perl but not for system
+ command escapes. Need to detect the two cases. Maybe
+ we could autoquote the paths when using backslashes.
+
+ Add auto-quoting/close quotes to Term::ReadLine::Perl
+ expansion as does Term::ReadLine::Gnu.
+
+ Fix Term::ReadLine::Perl completion to not append
+ identifier characters on the inserted filenames:
+ e.g. it is ok to list file.exe* in the possible
+ completions part but the result should only insert
+ file.exe (the actual file name).
+
+ Fix Term::ReadLine::Perl TAB expansion for paths to work
+ with win32 paths (i.e. backslashes).
+
+ Add <TAB> expansion to the pdl2 help/? command.
+
+ Track pdl2 session variables for PDL, including: vars
+ (global and lexical), subs that were defined, modules
+ loaded, and plugins for the REPL. It should be possible
+ to <TAB> complete for these.
+
+ Add tracking and expansion for all graphics windows that
+ are open/active (PGPLOT, PLplot, Prima, GLUT/FreeGLUT...)
+ windows for reference. It would be nice to have a
+ list/table of currently active figures.
+
+ IDEA: Associate metadata with image or figure windows
+ (e.g., the commands that generated the figure).
+
+ Add SIGINT handler for pdl2 for win32. Also need to add
+ feature to ignore EOF to the read routine (around read
+ modifier should work here---need to decide where to put it)
+
+ Investigate why Ctrl-L on win32 is issuing a 'clear' command.
+
+ ANSWER: readline.pm from Term::ReadLine::Perl is doing a
+ qx{clear) to determine the escape sequence to clear the
+ screen. This doesn't work on win32 since there is no clear
+ command and the console does not support ANSI escape
+ sequences.
+
+ Plan to fix by calling the DOS cls command to clear the
+ screen or by using Win32::Console and Win32::Console::ANSI
+ to implement the missing ANSI support. Need to implement
+ a routine readline::F_ClearScreen() to override the default
+ function for win32 systems.
+
+ Add runtime PDL module load list so you know what has been
+ loaded with use/require. Maybe a pop-up info window would
+ work here (curses based or GUI based). Maybe there could
+ be a runtime list/variable in PDL::Config that is updated
+ as each module is loaded. Override '*CORE::GLOBAL::use'?
+ It would also be possible to use MOP features of Moose.
+
+ Review and integrate $PERLDL::XX parameters. Some are not
+ needed or useful for Perldl2. Others need code to tie in
+ with the new framework.
+
+ Implement perldl command line options:
+ -M <module> load module <module>
+ -m <module> unload module <module>
+ -I <dir> Add <dir> to include path.
+ -V print PDL version info (e.g. for a bug report)
+ -f <file> execute file <file> before starting perldl
+ -glut try to load OpenGL module (Enables readline event-loop processing).
+ -tk try to load Tk module (Enables readline event-loop processing).
+ -w run with warning messages turned-on
+ - Following arguments are files for input.
+
+ Add @PERLDL::AUTO processing to the PDLCommands plugin.
+ Should be able to just run the code after the line is read
+ but before it is eval'd.
+
+ Add ability to run $PERLDL::PROMPT if it is a code reference
+ and not a string. Use the same logic as in perldl but set
+ the prompt with the $_REPL->prompt(&$code) instead of using
+ $_REPL->prompt($string).
+
+ Implement support for @PERLDL::PREPROCESS filters.
+
+ Update perldl documentation to match Perldl2 capabilities.
+ Any way to transparently select the correct docs at runtime?
+
+ Fix the newline differences between new line handling for
+ TR::Perl (on win32 and cygwin and unix) and TR::Gnu (on
+ cygwin and unix). TR::Gnu seems to have an extra newline
+ inserted per command.
+
+ Is it possible to add support for Term::ReadLine::Zoid?
+ It would be nice if the most possible could be done using
+ the Term::ReadLine::Stub.
+
+ Add MultiLine prompt with continuation character marking
+ the open structures. (e.g. MultiLine::TextBalanced).
+
+ Add generic event loop support to Term::ReadLine::Perl and
+ Term::ReadLine::Gnu. Need to figure out a clean way to
+ map this into the original modules.
+
+ Skip command lines that are too short and don't put
+ quit/q/x/exit in the history log. Maybe remove duplicate
+ entries as well as list history commands. Don't put
+ history !-syntax into the history, put the actual command
+ that resulted. e.g., not !6 but 'p "Hello, world.\n";
+
+ Be sure to add a line to history if it closes out a
+ multi-line block. This should not be an issue once we
+ have multi-line history entries supported. It would
+ be nice if history entries were by blocks with the
+ ability to go by lines within if desired.
+
+ Make !-syntax history more restrictive so that it does
+ not conflict with perl usage for negation. Maybe it
+ should only be good for completion? At least if it is
+ the first char and do_print(0).
+
+ Add !<command>:p support to print history commands and
+ fix the problem where the !<num> command is different
+ then the one actually inserted by History...
+
+ Add runtime control options for NiceSlice: i.e., report,
+ trans, and notrans
+
+ Add a CompletionDriver for Plugins for load_plugin() as
+ well as the ability to toggle plugins on and off (or at
+ least enable and disable them). Would it simplify
+ PDL::NiceSlice if the implementation were migrated to
+ Filter::Simple?
+
+ Make pdl2 fall back cleanly to a basic Devel::REPL or
+ even perldl if requirements to run are not installed.
+ (falls back to perldl right now)
+
+ Fix glob pattern completion display for shell escapes in
+ pdl2 (e.g., file*<TAB><TAB> will list out tab.a tab.b and
+ tab.c if those are the valid expansions. It should act
+ just like bash directly from the command line---ideally).
+
+ Add documentation for the startup files for unix-en and win32
+ systems. Right now, the only doc is in the code.
+
+ Add startup checks for the various Devel::REPL plugins
+ loaded to be sure that they can run before the load_plugin
+ call to avoid nasty compile error traces.
+
+ Fix 'demo 3d' so that it shifts focus to the display window
+ at the start and returns focus to the CMD or shell window
+ at then end. This shouldn't be needed with GLUT event loop
+ support in readline.
+
+ Is there a way to fix the GNU readline where it doesn't
+ process the Ctrl-C interrupt until after <Enter> has been
+ typed? There are some hooks in GNU readline for handling
+ signals that may help here.
+
+ Add option for quiet startup for use when piping to the
+ shell or taking input from a file.
+
+ Add INPUT and OUTPUT handle args for PDL shells. How do
+ we add this to the default term from Devel::REPL?
+ NOTE: Also need to fix perldl v.1.x not to use STDIN/STDOUT.
+
+ Verify that input from terminal and/or files works
+ correctly and consistently with perldl. NOTE: This should
+ make it possible to implement some tests of the interactive
+ shell from file input.
+
+ It would be nice if variable completion followed by a
+ method call would collapse the extra space. E.g.,
+ the first <TAB> in line#1 completes to the $_REPL varible
+ followed by a space as seen in line#2. Then typing the
+ ->do_p<TAB> in line#3 triggers a method completion to
+ ->do_print followed by a space shown in line#4.
+
+ #1 PDL> $_RE<TAB>
+ #2 PDL> $_REPL _
+ #3 PDL> $_REPL ->do_p<TAB>
+ #4 PDL> $_REPL ->do_print _
+
+ What we would like is the trailing space in line#2 to be
+ collapsed once the -> is typed following the completion.
+ Similarly, we would like the space at the end of line#4
+ to be collapsed once a '(' is typed to start the arglist.
+
+ Enhance completion strategy for Perldl2: (1) sort and
+ prioritze completions to remove long lists of useless
+ options [see completion paper], (2) allow chained PDL method
+ completions by recognizing that the output of many (all?) PDL
+ methods is a pdl so we could do method completion again...
+
+ Make Perldl2 fail/degrade gracefully if various files and
+ configuration stuff is not available. Lines and lines of
+ backtrace isn't a help to anyone!
+
+ Improve the error returns from evaluations in pdl2 as they
+ seem to cut off the root error line for failures which makes
+ it very difficult to debug things, e.g. I was getting errors
+ from Core.pm instead of in my routine that had the failure.
+ When I looked at the entire call stack in the debugger, I
+ got the actual line with the bad code---of course I had to
+ give up the nice pdl2 environment.
+
+ Filter out error tracebacks from pdl2/perldl. It looks like
+ these are internal to Devel::REPL and not the code being
+ executed and could be filtered out:
+
+ + eval {...} # both pdl2 and perldl
+ + main::__ANON__ # both pdl2 and perldl
+
+ | main::process_input # perldl
+ | main::eval_and_report # perldl
+
+ - main::BEGIN # pdl2
+ - Lexical::Persistence:: # pdl2
+ - Devel::REPL:: # pdl2
+ - Class::MOP:: # pdl2
+
+
+
++-------------------------------------------------------------------+
+| Features perldl pdl2 |
++-------------------------------------------------------------------+
+
+ preproc_add/del yes TBD
+
+ ?,?? aliases yes yes
+
+ quit,x,exit aliases yes yes
+
+ User AUTO commands yes TBD
+
+ Autoquoting doc commands yes yes
+
+ Load user startup file yes yes
+
+ Load local.perldlrc yes yes
+
+ $_ preserved by line/block by session
+
+ User extendable rewrite/hard plugins/easy
+
+ History save/recall yes yes
+
+ !-history expansion yes/partial yes
+
+ Lexical variables yes/1-command only yes
+
+ Multiline expression entry yes/Text::Balanced yes/PPI based
+
+ NiceSlice syntax yes yes
+
+ package NAMESPACE support no yes
+
+ Readline editing yes/partial yes
+
+ TAB completion: @INC no yes
+
+ TAB completion: filename yes yes
+
+ TAB completion: globals no yes
+
+ TAB completion: keyword no yes
+
+ TAB completion: lexicals no yes
+
+ TAB completion: methods no yes
+
+ print p alias yes yes
+
+ list history yes yes
+
+ help vars (package) yes yes
+
+ help vars (lexical) no TBD
diff --git a/Perldl2/pdl2 b/Perldl2/pdl2
new file mode 100755
index 0000000..3728f5b
--- /dev/null
+++ b/Perldl2/pdl2
@@ -0,0 +1,118 @@
+#!/usr/bin/env perl
+
+BEGIN {
+ $ENV{DEVEL_REPL_PROFILE} = 'PDL::Perldl2::Profile::Perldl2';
+
+ # This should be based on
+ $HOME = $ENV{HOME}; # Useful in shell
+ if ($^O =~ /win32/i and
+ (! defined($HOME)) or
+ (defined($HOME) and $HOME eq "")) {
+ $HOME = $ENV{USERPROFILE};
+ $HOME =~ s/\\/\//g;
+ }
+
+ $ENV{PERLREPL_HISTFILE} = "$HOME/.perldl_hist";
+ $ENV{PERLREPL_HISTLEN} = 500;
+}
+
+BEGIN {
+ my $minversion = "1.003011";
+ eval " use Devel::REPL $minversion ";
+ if ($@) {
+ my ($perldl) = $0;
+ $perldl =~ s/pdl2$/perldl/;
+ warn "pdl2: Devel::REPL version $minversion not found, running '$perldl' instead...\n";
+ do $perldl;
+ warn "pdl2: could not 'do $perldl'\n";
+ $perldl =~ s{^[^/\\]*[/\\]}{};
+ do $perldl;
+ die "pdl2: could not 'do $perldl'\n";
+ }
+}
+
+use PDL::Perldl2::Script 'run';
+
+__END__
+
+=head1 NAME
+
+pdl2 - Simple shell (version 2) for PDL
+
+=head1 SYNOPSIS
+
+Use PDL interactively:
+
+ %> pdl2
+
+ pdl> $a = sequence(10) # or any other perl or PDL command
+
+ pdl> print "\$a = $a\n";
+ $a = [0 1 2 3 4 5 6 7 8 9]
+
+=head1 DESCRIPTION
+
+The C<pdl2> program, also known as the Perldl2 shell, is a second
+generation version of the original C<perldl> interactive PDL shell.
+It attempts to be backward compatible in usage while providing
+improved features, better support for Perl syntax, and an more
+easily extended framework based on the L<Devel::REPL|Devel::REPL> shell.
+
+If you have L<Devel::REPL|Devel::REPL> version 1.003011 or later, then C<pdl2>
+will start with full functionality. If L<Devel::REPL|Devel::REPL> is not
+installed or found then C<pdl2> will print a warning and run
+the legacy C<perldl> shell command instead.
+
+By default, command lines beginning with the default prompt
+of either C<pdl2> or C<perldl> (one of 'pdl> ', 'PDL> ', or
+'perldl> ') will have the prefix string and surrounding
+whitespace stripped. This allows for easy cut-and-paste
+from sample PDL shell sessions or other examples into another
+PDL shell session.
+
+=head1 FUNCTIONS
+
+=head2 do_print
+
+=for ref
+
+Toggle print-by-default on and off (default value: off)
+
+By default, C<pdl2> does not print the results of operations
+since the results can be very large (e.g., a small 640x480
+RGBA image is still more than 1_000_000 elements). However,
+for experimenting and debugging more complex structures,
+it helps to see the results of I<every> operation. The
+C<do_print> routine allows you to toggle between the default
+"quiet" operation and a full Read, Evaluate, Loop style.
+
+=for example
+
+ pdl> $a = pdl(3,2)
+
+ pdl> do_print
+ 1
+ pdl> $a = pdl(3,2)
+ $PDL1 = [3 2];
+ pdl> do_print
+
+ pdl> $a = pdl(3,2)
+
+=head1 VARIABLES
+
+=over 4
+
+=item $PDL::toolongtoprint
+
+The maximal size pdls to print (defaults to 10000 elements).
+This is not just a C<perldl> or C<pdl2> variable but it is
+something that is usually needed in an interactive debugging
+session.
+
+=back
+
+=head1 SEE ALSO
+
+L<perldl>, L<Devel::REPL>
+
+=cut
diff --git a/README b/README
new file mode 100644
index 0000000..4cfe276
--- /dev/null
+++ b/README
@@ -0,0 +1,144 @@
+++ WARNING: There is absolutely no warranty for this software ++
+++ package. See the file COPYING for details. ++
+
+Important reading
+
+Please check the following files for further information
+*BEFORE* sending us your questions:
+
+INSTALL Basic installation instructions
+
+INTERNATIONALIZATION Notes re PDL i18n issue and status
+
+DEPENDENCIES Other software that PDL relies on (and where to get it)
+
+Release_Notes A list of features or issues with regard to the
+ current version, always worth checking!
+
+Known_problems Check before you report problems
+
+BUGS.pod How to make a bug report, PDL::Bugs
+
+perldl.conf PDL configuration options
+
+Basic/Pod/FAQ.pod The FAQ in pod format
+ Try 'perldoc PDL::FAQ' after installation.
+
+Basic/Pod/QuickStart.pod
+ A quick overview of PDL
+ Try 'perldoc PDL::QuickStart' after installation.
+
+Basic/Pod/BadValues.pod
+ A discussion of the bad value support in PDL
+
+DEVELOPMENT How to participate in the development of PDL
+
+
+
+*NOTE* Most PDL documentation is available online within the PDL shell,
+ pdl2 (or perldl). Try the help command within either shell.
+
+
+
+PDL -- the package
+------------------
+The Perl Data Language (a.k.a. PerlDL or PDL) project aims to turn perl
+into an efficient numerical language for scientific computing. The PDL
+module gives standard perl the ability to COMPACTLY store and SPEEDILY
+manipulate the large N-dimensional data sets which are the bread and
+butter of scientific computing. e.g. $a=$b+$c can add two 2048x2048
+images in only a fraction of a second.
+
+The aim is to provide tons of useful functionality for scientific and
+numeric analysis.
+
+Check the pdl web site at http://pdl.perl.org for more information.
+
+
+
+Installation
+------------
+Please read the file INSTALL for information on how to
+configure and install PDL. The Release_Notes and Known_problems
+files contain important version specific information. Be *sure*
+to read Known_problems if you have any INSTALL issues.
+
+Once you have built PDL and either installed it or done
+'make doctest', try either
+
+ perl -Mblib Perldl2/pdl2
+
+from within the root of the PDL tree or just
+
+ pdl2
+
+if you have installed PDL already ('make install') to get the
+interactive PDL shell. In this shell, 'help' gives you
+access to PDL documentation for each function separately
+('help help' for more about this) and 'demo' gives you some
+basic examples of what you can do.
+
+
+
+Bug Reports
+-----------
+You can check the existing PDL bugs on sourceforge at
+
+ http://sourceforge.net/p/pdl/bugs/
+
+The mailing list archives can be searched/read at
+
+ http://mailman.jach.hawaii.edu/pipermail/perldl/
+ http://mailman.jach.hawaii.edu/pipermail/pdl-porters/
+
+Questions about problems and possible bugs can be discussed
+via the perldl mailing list. This is very useful if you are
+not sure what you have is a bug or not. For example, the list
+is the place to go for install problems.
+
+If you need to post a problem report, and after checking with
+the perldl list that it *is* a bug, please use the sourceforge.net
+tracker system following the guidance in the BUGS file:
+
+ http://sourceforge.net/p/pdl/bugs/
+
+
+
+Notes
+-----
+Directory structure:
+
+Basic/ - The stuff that PDL would be no use without
+Demos/ - Showcase for PDL, type demo at the perldl prompt.
+Doc/ - Modules for building/using the PDL documentation database
+Example/ - Sample programs using PDL
+Graphics/ - The stuff that PDL needs to make pictures
+IO/ - The stuff that PDL needs to write and read strange files
+Lib/ - The stuff that PDL would still be useful without but
+ which makes PDL even more useful
+Perldl2/ - The PDL shell version 2 source and development
+TestTools/ - Tools for testing PDL
+cygwin/ - Platform specific information
+debian/ - Platform specific information
+inc/ - Local module directory for PDL build process development
+macosx/ - Platform specific information
+t/ - PDL tests directory
+utils/ - Utilities relating to PDL
+win32/ - Platform specific information
+
+
+
+Comments are welcome - so are volunteers to write code and documentation!
+Please contact the developers mailing list pdl-porters at jach.hawaii.edu
+(subscription address: pdl-porters-request at jach.hawaii.edu) with ideas
+and suggestions.
+
+ The pdl-porters team.
+
+
+
+Compilation Reports:
+--------------------
+The CPAN Testers' result page provides a database showing the results
+of compiling PDL and many other CPAN packages on multiple platforms.
+See http://testers.cpan.org/
diff --git a/Release_Notes b/Release_Notes
new file mode 100644
index 0000000..f58c9c0
--- /dev/null
+++ b/Release_Notes
@@ -0,0 +1,1782 @@
+Release Notes for PDL 2.007 --------------------------
+
+ +---------------------------------------------------------------+
+ | BE WARNED: This release includes an update to the internal, |
+ | C-level PDL API for PDL versions 2.006 and earlier. This |
+ | will require that you re-build any PP or XS modules. Do not |
+ | upgrade or install over an existing PDL installation unless |
+ | you are prepared to do so!!! |
+ +---------------------------------------------------------------+
+
+General Notes:
+
+ * PDL computations now use 64bit indexing/addressing if
+ your platform supports it (i.e., your perl configuration
+ has $Config{ivsize} == 8).
+
+ - You can process with pdls with more then 2**32 elements.
+
+ - Memory mapped file IO supports up to 8TB files which
+ allows much simpler processing of large data files.
+ (See mapflex in PDL::IO::FlexRaw for details)
+
+ * PDL-2.007 has a new, unified slicing engine and syntax
+ that consolidates the multiple slicing variants into
+ a backward compatible but now 64bit aware slice. See
+ the PDL::Slices for the new syntax that is enabled.
+
+ * PDL::FFTW has moved to its own distribution on CPAN
+ and is no longer in the PDL core distribution. Look
+ for PDL::FFTW3 coming to CPAN soon.
+
+ * Some required dependencies have been update to more
+ recent versions:
+
+ - ExtUtils::MakeMaker now requires version 6.56 or
+ higher, the minimum version with CONFIGURE_REQUIRES
+ support.
+
+ - Perl OpenGL 0.6702 is now required for PDL::Graphics::TriD
+ to build. This fixes a number of critical bugs and should
+ be a seamless upgrade.
+
+ - File::Map version 0.57 is required. This fixes map_anonymous
+ support for the >2**32 sizes needed for 64bit support.
+ Legacy mmap support for unix platforms is no longer
+ supported. The distribution requires File::Map so you
+ should not notice the change.
+
+ * Incompatible Changes:
+
+ - PDL::FFT now uses the same sign convention as FFTW and
+ the rest of the world, -1/+1 for forward and reverse
+ FFT respectively.
+
+ - C/XS API of PDL-2.007 is incompatible with previous
+ PDL releases. If you upgrade to PDL-2.007, you *will*
+ need to re-install or upgrade *all* dependent XS or PP
+ based modules.
+
+ - PDL now auto-promotes array refs in many places that
+ previously required a piddle (so you can say, e.g.,
+ "$a->index([2,3])" instead of "$a->index(pdl(2,3))").
+
+ - String syntax for slice() specifications now ignore
+ white space.
+
+ * The clean up of the PDL core distribution continues and
+ PDL-2.007 is no exception. Many bug fixes, documentation
+ updates, code and implementation improvements make this
+ the best testing PDL release to date.
+
+
+Highlights:
+
+ * FITS IO improvements and fixes:
+
+ - Added 'afh" option to rfits to allow explicit use of
+ legacy hash parser for performance reasons.
+
+ - New multiple extension writing support for wfits.
+
+ * Added pp_deprecate_module() to PDL::PP
+
+ * New mode/modeover functions in PDL::Ufunc
+
+ * Made exception handling in slices more robust.
+
+ * PDL::CLONE_SKIP added for improved ithread support.
+
+ * Updated graticule() in PDL::Transform::Cartography to
+ support NaN-delimited output.
+
+ * Bugs fixes:
+
+ - Fix %hash randomization bugs in PDL tests
+
+ - Fix OpenBSD pthread build problem for non-threaded perls
+
+ - Fix PDL::shape to return vector for 1-D piddles
+
+ - Fix badvalue-on-truncate support for map and for interpND
+
+ - Fix for MSVC++ 6.0 to build on 32bit systems.
+ MSVC++ 6.0 cannot be used to build 64bit index support.
+
+ - Fix polyfit() handling of BAD values and various edge cases.
+
+ - Fix rare "Bizarre copy of HASH in scalar assignment"
+
+ - Fix rcols with colsep and $PDL::undefval
+
+ - Fix sf.net bug #331 "uniq does not always return proper object"
+
+ - Fix sf.net bug #338 PDL::FFT uses backwards sign convention from FFTW
+
+ - Make PDL::NiceSlice preserve line numbering (sf.net feature #75)
+
+ - PDL::IO::GD->new() is now less picky about it args, and no longer crashes
+
+ - Two bug fixes to transform.pd, and an augmentation
+
+
+
+Release Notes for PDL 2.006 --------------------------
+
+ +---------------------------------------------------------------+
+ | BE WARNED: This release includes an update to the internal, |
+ | C-level PDL API for PDL versions 2.4.10 and earlier. This |
+ | will require that you re-build any PP or XS modules. Do not |
+ | upgrade or install over an existing PDL installation unless |
+ | you are prepared to do so!!! |
+ +---------------------------------------------------------------+
+
+General Notes:
+
+ * Change to the version number scheme used for PDL
+ from the dotted-integers format back to plain old
+ decimal numbers.
+
+ Unfortunately, PDL has used both alternatives before
+ and in an inconsistent, out-of-order way. With this
+ release, the current version will also be the most
+ recent version with respect to both numbering schemes.
+
+ For more details see David Goldens blob post on
+ the topic and the pdl-porters list discussion:
+
+ http://www.dagolden.com/index.php/369/version-numbers-should-be-boring/
+ http://mailman.jach.hawaii.edu/pipermail//pdl-porters/2013-February/005343.html
+
+
+ * PDL-2.006 also showcases the demos of two new PDL graphics
+ modules in the perldl/pdl2 shells:
+
+ - PDL::Graphics::Gnuplot
+ http://search.cpan.org/~zowie/PDL-Graphics-Gnuplot-1.4/
+
+ - PDL::Graphics::Prima
+ http://search.cpan.org/~dcmertens/PDL-Graphics-Prima-0.13/
+
+ Both modules install on all supported PDL platforms. A
+ recent addition is PDL::Graphics::Simple which provides
+ a uniform presentation to the variety off available PDL
+ plot/view/print options.
+
+ - PDL::Graphics::Simple
+ http://search.cpan.org/~zowie/PDL-Graphics-Simple-1.004/README.pod
+
+ Let us know how they work for you. As they are
+ relatively "young" contributions your feedback and
+ questions are always welcome.
+
+
+ * PDL Distribution related updates:
+
+ - Fixes a build issue for PDL at ASPerl
+
+ - Many fixes for debian distributions.
+
+ - PDL::IO::NDF has been moved to its own
+ distribution on CPAN. This could affect
+ upgrades from older PDL installs.
+
+
+Highlights:
+
+ * New support for reading IDL format files via PDL::IO::IDL.
+
+ * Added an unpdl method which is (roughly) the inverse
+ operation of pdl (Joel Berger).
+
+ * Updated polyfill and polyfillv routines to the algorithm
+ from pnpoly: more accurate on edge pixels and faster due
+ to its PP implementation (Tim Haines).
+
+ * Added Boundary=>'Replicate' option to conv2d and med2d (chm).
+
+ * Support for new additional random number generators to
+ PDL::GSL (John Lapeyre).
+
+ * Add lgamma support for MinGW-built perls with tests
+ to match (sisyphus).
+
+ * Many improvments to docs and their generation from
+ PDL sources. Specific new functionality support:
+
+ - Newly refactored docs engine using core perl
+ modules rather than PDL-only ones (Joel Berger)
+
+ - New FullDoc key added to PDL::PP makes writing CPAN
+ friendly .pd files much, much easier (David Mertens).
+
+ - New PDL::Doc::add_module() routine to add an external
+ module's POD (with PDL::Doc conventions) to the PDL
+ docs on-line database (Craig DeForest).
+
+ * Many bugs fixed, some even before a ticket could be opened!
+
+ - Sf.net bug #3607936: Fixed a bug causing crashes
+ due to using inplace with a duplicate argument.
+
+ - Sf.net bug #3603249: AutoLoader leaks $_ into local
+ context, reported and fixed by Craig.
+
+ - Sf.net bug #3588182: Fixed hist() handling of the case
+ of fractional steps in integral input data types.
+
+ - Sf.net bug #3563903: Fixed bug in PNG format detection
+ on win32 platforms.
+
+ - Sf.net bug #3544682: Fixed error report bug in perldl
+ that resulted from a change in the way perl handles
+ eval exception reporting.
+
+ - Sf.net bug #3539760: qsort[vec] are now inplace aware.
+
+ - Sf.net bug #3518190: Potential fix for t/gd_oo_tests.t
+ test crashes.
+
+ - Sf.net bug #3515759: Work around for PDL::GIS::Proj
+ build failures with proj-4.8.0.
+
+ - Sf.net bug #3479009: Fixed dummy() to generate a
+ valid syntax for the underlying call to slice().
+
+ - Sf.net bug #3475075: Fixed 16-bit PNM raw format handling.
+
+ - Added warning if conv1d is used on a piddle with
+ the badflag set.
+
+ - Fix NaN sign issues as reported (and fixed!) by
+ Matthew McGillis with contributions by Sisyphus.
+
+ - Fix rim() 3-arg form. Added tests to support and
+ verify the development.
+
+ - Fixed a problem with multiple windows and imag2d
+ and imag2d_update.
+
+ * The PDL shells keep getting better:
+
+ - New feature in perldl and pdl2 where a pattern matching
+ the PDL shell prompt (in $PERLDL::PREFIX_RE) will get
+ stripped off of input lines before eval. This makes it
+ easier to cut-and-paste example text from PDL shell
+ sessions or from the PDL Book into an active session.
+
+ - Added a demo for PDL::Graphics::Prima to the PDL shells.
+
+ - Added a demo for gnuplot to the PDL shells.
+
+ - The p shortcut to display output in the PDL shells has
+ been reverted to its previous 2.4.10 behavior. If you
+ wish it to be an exact alias for print just override
+ in your .perldlrc or local.perldlrc file.
+
+
+
+Release Notes for PDL 2.4.11 -----------------------------
+
+General Notes:
+
+ * This is a point release of PDL to support the coming perl
+ 5.16.0 release.
+
+ +---------------------------------------------------------------+
+ | BE WARNED: This release includes an update to the internal, |
+ | C-level PDL API and will require that you re-build any PP or |
+ | XS modules. Do not upgrade or install over an existing PDL |
+ | installation unless you are prepared to do so!!! |
+ +---------------------------------------------------------------+
+
+
+Highlights:
+
+ * A new implementation mapflex and mapfraw routines provides
+ memory-mapped IO for all platforms including win32 systems.
+
+ * The new memory mapped IO support is implemented using
+ File::Map so version 0.47 has been added as a required
+ dependency to force automated testing so an automated build
+ will need this dependency installed.
+
+ NOTE: For systems having POSIX mmap, a manual build of
+ PDL will automatically use the legacy implementation.
+
+ * Various cleanup to existing code to fix warnings generated
+ by perl versions 5.15.x and higher.
+
+ Remove deprecation warning in PGPLOT/Window/Window.pm
+ complex.pd - fix attempts to overload '<=>=' and '=>'
+
+ * Sf.net bugs fixed:
+
+ 3518253 Make PDL::flat work under perl 5.16 (thanks sprout!)
+ 3516600 pdl_from_string.t fails w/ BADVAL_USENAN=1
+ 3487569 PDL::IO::Misc : rcols problem (thanks bperret!)
+ 3476648 PDL build of HTML docs fails on recent bleed Perl
+
+ * Other bugs fixed:
+
+ Fix check for glutRunning logic for imag2d
+ Fixed a bug in cat's error reporting.
+ Added lvalue awareness to whereND
+
+ * New and improved tests have been added to the test suite.
+
+ Tests t/gd_oo_tests.t and t/inline-comment-test.t are
+ skipped for BSD platforms (see sf.net bugs #3518190 and
+ #3524081 to track their issues).
+
+ * New support for multi-line comments in PP code. See docs for
+ PDL::PP for details (e.g., pdldoc PP).
+
+ * Various enhancements to barf/croak output and messages to make
+ error reports and stack traces more useful and readable.
+
+ * There is a new changes (or Changes) target for the PDL Makefile
+ which is a convenience target that allows one to regenerate the
+ Changes file from git.
+
+
+
+Release Notes for PDL 2.4.10 --------------------------
+
+General Notes:
+
+ New Stuff:
+
+ * PDL::Constants module provides E, PI, I (or J) and more.
+
+ * PDL::NiceSlice has a new engine based on Filter::Simple
+ which is more selective about where the PDL::NiceSlice
+ sourcefilter is applied.
+
+ * pdl() constructor now accepts a string argument which
+ can include MATLAB-style [ ; ] syntax, bad values,
+ inf values, and nan values. This makes it much easier
+ to specify pdl values in programs and scripts.
+
+ * PDL now supports pthreads on all platforms as well
+ as a new, auto-parallelization capability for PDL
+ threadloops across multiple processors using the
+ PDL::ParallelCPU module.
+
+ * Many(!) bug fixes.
+
+
+ Incompatible Changes:
+
+ * List output from whichND is now deprecated.
+
+ * The default.perldlrc uses PDL::Constants to
+ provide E and PI.
+
+ * perldl.conf has new fields so be sure to update
+ any local versions you use with the new fields.
+
+ * rcols and wcols always use dim0 for the data
+ dimension and dim1 for the column dimension.
+ This only matters if you use the support for
+ reading multiple columns into a 2D pdl.
+
+ * Makefile.PL now requires at least version 6.31
+ of ExtUtils::MakeMaker to support the new standard
+ INSTALL_BASE option matching Module::Build usage.
+
+ * Prerequisite Text::Balanced minimum version is
+ now 1.89 although this is not expected to be an
+ issue because it is provided in the perl core
+ since 5.8.0.
+
+
+Highlights:
+
+ * General cleanup of code, including restructuring for clarity.
+
+ * List output from whichND() is now deprecated. whichND() now returns
+ a piddle of coordinates in all cases with a warning when a list
+ context is detected. See the docs for work-arounds to your code.
+
+ * PDL::IO::Misc now has better support for handles that are not
+ files (e.g., pipes or standard input) for rgrep(), rcols(),...
+
+ * Added bad value support to pctover() and oddpctover().
+ This was sf.net feature #3328001.
+
+ * New whereND() routine provides the same functionality as where
+ but with support for multi-dimensional masks and implicit
+ threading over higher dimensions. This was sf.net feature
+ request #3390043.
+
+ * Many bugs fixed.
+
+ 3059083 Problems with FITS header handling
+ 3080505 PLplot segfaults on plshades call on OS X
+ 3285520 status message from gslmroot_fsolver
+ 3294808 sever on Empty piddle causes segfault
+ 3295544 NiceSlice parsing bug
+ 3299611 FITS I/O obscure bug
+ 3300467 NiceSlice asterisk parsing issue
+ 3307121 wmpeg sometimes kills perldl if file already exists
+ 3307613 indexND of Empty pdls can segfault
+ 3368883 t/opengl.t fails if display type not available
+ 3375837 _read_flexhdr state machine fails
+ 3388862 tiny bug in PDL-2.4.3. May apply to 2.4.9
+ 3391645 bad printf formats in pdlapi.c and others
+ 3394327 PDL::IO::FITS::wfits corrupting FITS image
+ 3396738 PDL::Core::convert default return type
+ 3410905 t/pgplot.t hangs test harness for PDL
+ 3415115 whereND fails to handle all zero mask case
+ 3428356 PDL::Transform::map output FITS header is slightly wrong
+ 3434842 Error in definition of gsl_sf_laguerre_n function
+
+ * PDL::Constants now provides: E, PI, I and J and is loaded by the
+ default.perldlrc. It is not yet part of 'use PDL' so you'll need
+ to 'use PDL::Constants ...' by hand for now.
+
+ * default.perldlrc sets $PDL::IO::FlexRaw::writeflexhdr=1 by
+ default so that writeflex() to a filename automatically writes
+ the header file. This is different from the previous behavior
+ but it seems to "do what you mean". Feedback welcome!
+
+ * PDL::NiceSlice now has a new engine based on Filter::Simple which
+ is smarter about only applying the slicing source filter to syntax
+ occurring outside of POD, comments, and quotelike strings. The
+ new implementation is available for *files* by setting the
+ PDL_NICESLICE_ENGINE environment variable to 'Filter::Simple'.
+
+ Work is underway to port the new niceslice filter implementation
+ to perldl/pdl2. Once this task is completed, the new engine will
+ become the default source filter and the PDL_NICESLICE_ENGINE
+ environment variable will be removed.
+
+ * There is experimental support for PDL::NiceSlice syntax in the
+ perl debugger (i.e., perl -d). Just set the PERL5DB environment
+ variable to 'BEGIN { require "PDLdb.pl" }' to use niceslice
+ from the debugger command line. If PERL5DB is already set,
+ you'll need to adjust the above recipe accordingly.
+
+ * Better handling of build configuration options from perldl.conf
+ as well as improvements in the detection of external dependencies.
+
+ * perldl.conf has some new fields added:
+ - POSIX_THREADS_INC and POSIX_THREADS_LIBS to specify
+ locations of your pthread header file and library
+ - PDL_CONFIG_VERSION to track the perldl.conf VERSION
+ - PDLDOC_IGNORE_AUTOLOADER to control pdldoc behavior
+ - PDL_BUILD_DIR provides the build directory path
+ - PDL_BUILD_VERSION provides the PDL build version
+ (to help with ambiguity from multiple PDL installs)
+
+ NOTE: If you are using a private or customized perldl.conf
+ file, please be sure to update with these additional fields
+ as the perl Makefile.PL doesn't yet detect version skew
+ automatically.
+
+ * PDL::IO::Browser now builds in many cases (but not all).
+ If you try it, please let us know how it goes. Just edit
+ the value of WITH_IO_BROWSER in your perldl.conf before
+ configuring the build (i.e., perl Makefile.PL).
+
+ * PDL::PP has seen some significant improvements including
+ code cleanup, improved documentation, and code refactoring
+ for comprehension. There is a new PDL::PP::pp_line_numbers()
+ routine which enables line # traceback for errors and warnings
+ from PP code.
+
+ * Improved error output from the pdl2 shell via the new
+ CleanErrors plugin which filters out the non-PDL part
+ of the error output leading to *much* more concise and
+ helpful reports.
+
+ * The pdl() constructor now accepts a string argument which
+ allows for writing pdls using a matlab/octave style
+ syntax as well as cutting and pasting from interactive
+ session output to create pdls initializations for scripts
+ and program files.
+
+ The new constructor also allows for inf, nan, and bad to
+ generate the appropriate values (case insensitive), e.g.,
+
+ $bad = pdl q[1 2 3 bad 5 6]; # Set fourth element to the bad value
+ $bad = pdl q[1 2 3 BAD 5 6]; # ditto
+ $bad = pdl q[1 2 inf bad 5]; # now third element is IEEE infinite value
+ $bad = pdl q[nan 2 inf -inf]; # first value is IEEE nan value
+
+ This is new functionality so feedback and problem reports
+ are welcome.
+
+ * PDL::Image2D has new routines: pnpoly() to determine the points
+ in a polygon from the sequence of vertex coordinates, and
+ cc4compt() for 4-component labeling of a binary image.
+
+ * PDL now supports pdls larger than 2GiB. The element count
+ is still an int type internally so the total number of elements
+ per-piddle must be less than 2**31.
+
+ * POSIX threads (pthreads) are supported for win32 and cygwin
+ platforms. Pthreads are now available for all PDL platforms.
+
+ * New PDL::ParallelCPU module provides automatic distribution
+ of implicit thread loops across a number of processors. Now
+ you can watch your PDL computations maximize the load on
+ *all* your processors. See the docs for how to configure this
+ feature and how to adjust your calculations to best take
+ advantage of this feature.
+
+ * PDL::Graphics::PLplot now works with the latest release of the
+ PLplot library and has improved configuration and build
+ handling. Feedback welcome.
+
+ * rcols() and wcols() now use the same convention for multi-column
+ input and output: dim0 is *always* the data dimension and
+ dim1 corresponds to the columns in the file. This adjustment
+ makes them their inverse operations.
+
+ * The ADEV calculation in statsover has been corrected along
+ with the documentation.
+
+ * PDL::Graphics::TriD changes:
+ - PDL::Graphics::TriD now builds using the perl OpenGL
+ module (POGL) when configured on cygwin with the
+ interface=W32API option. By default, POGL used
+ interface=GLX on cygwin which does software rendering
+ via Mesa/X11 (slower!). If you reinstall POGL with
+ the W32API setting, you will need to rebuild PDL and
+ PDL::Graphics::TriD to pick up the new configuration.
+ - A new 4-line graphics demo contributed by Mark Baker has
+ been added to 'demo 3dgal'. Take a look.
+
+ * Various enhancements to FITS handling, including:
+ - add map() fix for nonlinear FITS headers
+ - Enable hdrpcy() in rfits() for Rice-compressed images
+
+ * Test suite improvements to provide better diagnostics from
+ failures and to make tests more correct avoiding "false fails"
+ in the test reports. Various tests have been migrated to use
+ File::Temp::tempdir and File::Temp::tempfile to improve the
+ robustness for temporary files and directories naming and
+ creation during tests.
+
+ * Update ExtUtils::MakeMaker required version to 6.31 to support
+ the new standard of INSTALL_BASE to configure for a local
+ perl/PDL module installation.
+
+ * Update Text::Balanced required version to 1.89. This is the
+ version present in perl 5.8.0 (the minimum required for PDL)
+ so this change in requirement is not expected to affect any
+ PDL users.
+
+ * pdldoc now searches your PDLLIB path for PDL::AutoLoader docs
+ in addition to the pre-extracted documentation database. This
+ makes pdldoc give the same output as the help command in the
+ PDL shells.
+
+ * Many updates and additions to the PDL documentation.
+
+ * Devel::CheckLib is being used in more places during the
+ PDL configuration stage. We plan to make this the standard
+ baseline for dependency library detection going forwards.
+ The included copy of Devel::CheckLib has been updated to 0.95.
+
+ * A new unified implementation of barf()/warn() for PDL removes
+ code duplication. barf() is now defined in both PDL::Core and
+ the PDL packages. PDL::cluck is added as an analog of Carp::cluck
+ (as PDL::barf is an analog of Carp::confess). barf() now
+ generates its stack trace by hooking into Carp::confess on
+ both the Perl and C sides.
+
+ * Various fixes for PDL::Transform
+ - fix inverse in perspective()
+ - fix t_cubic() parameter parsing
+ - fix handling of multiple PCi_j systems in the piddle header
+
+ * Added SIGPIPE handlers to cases where PDL uses pipes to/from
+ external processes (such as ffmpeg or some NetPBM image
+ converter programs). This should make PDL "SIGPIPE safe" by not
+ exiting when a PDL piped IO output process quits (e.g., as when
+ called from within the perldl/pdl2 shell).
+
+
+
+Release Notes for PDL 2.4.9 --------------------------
+
+General Notes:
+
+ * Fixes a couple of surprise bugs that were discovered
+ immediately with the PDL-2.4.8 release.
+
+ * See Also: the Release Notes for PDL-2.4.8 below
+
+
+Highlights:
+
+ * Fix sf.net bug #3267408 "t/slice.t crashes in tests 68-70 for BSD"
+
+ * Fix sf.net bug #3190227 "PDL build fails with parallel GNU make -j3 -j3"
+
+ * Fixed various tempfile name generation problems by switching
+ to File::Temp instead of hand rolled solutions. This is the
+ recommended approach going forward.
+
+ * Force Convert::UU usage for BSD to work around a t/dumper.t
+ failure on MirBSD.
+
+
+
+Release Notes for PDL 2.4.8 --------------------------
+
+General Notes:
+
+ * The deprecated Karma imaging library support code
+ has been removed from the PDL distribution.
+
+ * Perl OpenGL (POGL) is now the only build option for
+ 3-D graphics support in PDL. The POGL build has
+ proven to be portable and reliable. This prepares
+ TriD graphics development for the next stage of
+ re-factoring for support and new features.
+
+ * Many improvements to the PDL configuration, build
+ and test process make this the most robust PDL yet.
+
+ * PDL::IO::FlexRaw now supports automatic header file
+ creation when writeflex() is given a filename argument
+ for writing. readflex/writeflex/mapflex now support
+ reading and writing piddles with bad values in them.
+
+ * New PDL::Constants module provides PI and E.
+
+ * PDL::Complex now supports in-place operations.
+
+ * Added $PDL::toolongtoprint to set the maximum piddle
+ size allowed to print as a string. This was added
+ to the default.perldlrc to make it easier to discover
+ by users.
+
+ * wmpeg() from PDL::IO::Pic uses the new ffmpeg back-end
+ and can create many additional file formats beyond MPEG
+ alone, including MP4 and animated GIF. See the
+ documentation for details.
+
+ * Lots of improvements to the documentation, overall
+ usability and many bugs fixed!
+
+Highlights:
+
+ Build and Test Enhancements:
+
+ * Karma support code has been *removed* from the PDL
+ distribution The last stable PDL distribution with
+ Karma code was be PDL-2.4.7.
+
+ * You must use the Perl OpenGL module to build the
+ PDL 3-D graphics module, PDL::Graphics::TriD.
+ OPENGL_LIBS, OPENGL_INC and OPENGL_DEFINE are no
+ longer used by perldl.conf for the configuration
+ process.
+
+ * Added a check for mis-installed PROJ4 libraries. If
+ the library does not initialize (even if present) then
+ PDL will not build the PROJ4 modules. This is sf.net
+ feature #3045456.
+
+ * GD, HDF, PROJ4, OpenGL, and GSL tests will not be run
+ unless the corresponding module was configured to be
+ built. This addresses the possibly mysterious test
+ failures caused by previous PDL installations in the
+ perl path at build time.
+
+ * Use of the Test::More TODO {} blocks allows tests for
+ known bugs to be added to the test suite without
+ causing the suite to fail. This replaces the previous
+ SKIP_KNOWN_PROBLEMS option and should better enable
+ test first development and debugging.
+
+ * utils/perldlpp.pl is a new script for off-line source
+ filtering to pre-filter PDL source files with NiceSlice
+ constructs. This allows PDL to use NiceSlice constructs
+ in the core functionality while still allowing PDL to
+ work in environments where source filters are not supported.
+
+ * The 'perl Makefile.PL' response to detecting another PDL
+ in the build path has changed. If such a pre-existing PDL
+ installation is detected, the user is warned *but*
+ configuration and build will proceed nonetheless.
+
+ * Clean-up and fixes to demos and tests for reliability and
+ portability.
+
+ Documentation:
+
+ * Added INTERNATIONALIZATION file with i18n notes. PDL
+ does yet not have internationalization support beyond
+ that provided by perl itself.
+
+ * Cleared up the documentation on when to use lu_decomp
+ and versus lu_decomp2. Now that lu_decomp is threaded,
+ it is the preferred implementation.
+
+ * wmpeg() with the ffmpeg converter supports generation of
+ many different output video file formats including MPEG,
+ MP4, and animated GIF. Documentation on these uses were
+ added.
+
+ * New example code refresh.pdl in Example/PLplot to
+ provide for PLplot, some of the same functionality
+ as in PDL::Graphics::PGPLOT.
+
+ * Other documentation updates for clarity and correctness.
+
+ New Features or Functionality:
+
+ * New PDL::Constants module providing PI and E (so far)
+
+ * Inplace support added for PDL::Complex operations
+
+ * pdldoc and the pdl2/perldl help commands now print all
+ matches by default when multiple matches are found.
+
+ * A do_print command was added to the pdl2 shell which
+ toggles the input mode between printing and not
+ printing the return value of each command.
+
+ * readflex/writeflex/mapflex now support reading and writing
+ piddles with bad values in them. This was sf.net feature
+ request #3028127, "add badvalue support to FlexRaw".
+
+ * writeflex now supports automatically calling the
+ writeflexhdr() routine if you have set the variable
+ $PDL::FlexRaw::writeflexhdr to a true value and are
+ writing to a file given by filename as argument.
+
+ * Updated the error handling for GSL::INTERP to match other
+ GSL module usages.
+
+ * Applied sf.net patch #3209075 IO::HDF square sds
+
+ * New binary blob support in PDL::IO::GD::OO
+
+ Bugs Fixed:
+
+ * Applied Christian Soeller's patch for FFTW on 64-bit
+ systems. This resolves bug #3203480 "t/fftw.t fails
+ on 64-bit systems".
+
+ * Fixed sf.net bug #3172882 re broken threading in inv().
+ inv() and lu_backsub() now handle threading. Updated
+ documentation for lu_decomp, lu_deomp2, and lu_backsub.
+
+ * Fixed sf.net bug #3171702 "missing podselect command
+ breaks PDL build"
+
+ * Fixed sf.net bug #3185864 (bad adev in statsover)
+
+ * Fixed sf.net bug #3139697: fixed imag2d() to work better
+ with Mac OS X GLUT and not just FreeGLUT.
+
+ * Fixed uniqind bug #3076570
+
+ * Fixed SF bug #3057542: wmpeg doesn't error on missing
+ ffmpeg program. Now wmpeg returns 1 on success and
+ undef on error. If ffmpeg is not in PATH, it just fails
+ immediately....
+
+ * Fixed SF bug #3056142: pdl2 fallback to perldl broken
+ on win32
+
+ * Fixed SF bug #3042201: t/dumper.t fails mysteriously
+
+ * Fixed SF bug #3031068: PDL::IO::FlexRaw mapflex memory
+ mapping fails
+
+ * Fixed SF bug #3011879, "pdl() constructor crashes perl for
+ mixed ref/piddle args" and #3080505, and #3139088. This
+ fix also includes a larger and more complete set of tests.
+
+ * Fixed segfault in plplot.t with a work-around.
+
+ * Fixed bug in readenvi.pdl header list value processing
+ and added support for embedded file headers.
+
+ * Fixed bug in FlexRaw.pm support for headers with Type
+ passed as string.
+
+ * Fixed imag2d() in PDL::Graphics2D. It no longer calls
+ exit on ESC if run within the pdl2/perldl shell. Also
+ did some clean up of key controls and module mechanics.
+
+ * Fixed upstream bug in Devel::REPL for MultiLine
+ continuation. Now incomplete q[] and qq[] constructs
+ continue reading until properly closed. See the
+ Known_problems file for details.
+
+
+
+Release notes for PDL 2.4.7 --------------------------
+
+General Notes:
+
+ * New requirements:
+ - perl version 5.8.x and higher
+ - Convert::UU
+
+ * PDL::Graphics::TriD now requires OpenGL-0.63
+
+ * New 2-D image display routine: imag2d()
+
+ * pdl() constructor, a.k.a. PDL->new(), now
+ takes string arguments with either MATLAB type
+ concatenation syntax or PDL print output (for
+ easier cut-and-paste from PDL shell sessions).
+
+ * Improved text and comma separated value file
+ input via rcols(): faster and more flexible.
+
+ * A new PDL shell based on Devel::REPL (i.e.,
+ Moose technology). The new shell supports
+ more perl syntax (lexical variables and
+ packages), is more extensible (via a system
+ of plugins), and supports many forms of file
+ and variable completion.
+
+ Install Devel::REPL and give it a try!
+ User feedback welcome.
+
+ * More portability (builds on more platforms
+ with more features than ever).
+
+ * Many bugs fixed...
+
+
+Highlights:
+
+ * General
+
+ OpenGL-0.63 is required for PDL::Graphics::TriD.
+
+ Convert::UU is required for PDL.
+
+ Karma is DEPRECATED and NOT SUPPORTED. Set
+ USE_KARMA=>1 in perldl.conf to force a build.
+
+
+ * New 2D Image Display Feature: imag2d()
+
+ See PDL::Graphics2D for documentation.
+
+ Add image pixel value display on mouse
+ click in imag2d window
+
+ Add keyboard command shortcuts for imag2d
+ (with placeholders)
+
+ Fix a number of imag2d() usabiilty bugs
+
+
+ * pdl() Constructor Can Take String Input
+
+ Allows use of MATLAB-style [ ; ] syntax
+
+ Allows cut-and-paste of printed pdl values
+ as input args for pdl()
+
+
+ * rcols/wcols Improvements
+
+ Much faster read times
+
+ Multiple columns can read into a single
+ pdl varible
+
+ Symmetric handling of perl and pdl
+ column data
+
+ Improved format support for CSV file input
+
+
+ * Enhanced PDL Shell (Version 2)
+
+ Based on Devel::REPL which must be installed
+ along with either Term::ReadLine::Perl or
+ Term::ReadLine::Gnu to use the pdl2 features.
+
+ Supports Term::ReadLine::Perl and Term::ReadLine::Gnu.
+
+ Upward compatable with the original PDL shell, perldl.
+
+ Adds completion and command line editing support
+ across all PDL platforms.
+
+ Adds support for current package and lexical variables.
+
+ Toggle default print output via the do_print attribute.
+
+ Default prompt for perldl and pdl2 is now 'pdl> '
+
+ help vars now shows results alphabetically
+
+ pdl2 now runs (falls back to) perldl if Devel::REPL
+ is not installed or if Term::ReadLine::(Perl|Gnu) is
+ not installed.
+
+
+ * Other Features
+
+ Fix wmpeg() to use ffmpeg to generate the
+ video (sf.net feature request #3010984).
+
+ Added tiled compressed image handling to rfits
+
+ Faster matrix multiply
+
+ Preliminary support for ENVI file format data
+ in PDL/IO/ENVI/readenvi.pdl
+
+
+ * Build Improvements:
+
+ PDL build process now detects multiple PDL installs
+ and warns of possible conflicts.
+
+ 'use PDL' now loads PDL::Config by default.
+
+ PDL "as built" configuration is now saved to %PDL::Config
+
+ Changes file is automatically updated each release
+
+ Add SKIP_KNOWN_PROBLEMS support for build
+
+ Add checks to prevent warnings from access to $HOME
+ when it is not defined.
+
+
+ * Portability Fixes
+
+ Multiple build improvements for debian platforms
+
+ Improved portability across perl and compiler versions
+
+ Reduced number of fortran dependencies
+
+ Improved support for win32 platforms
+ - PDL::GIS::Proj builds for win32
+ - PDL::Transform::Proj4 builds for win32
+ - PDL::Graphics::PLplot builds for win32
+ - PDL::IO::Dumper builds for win32
+
+
+ * 3-D Graphics
+
+ Improved PDL::Graphics::TriD demos and examples
+
+ Fixed problems with VRML support for many platforms.
+
+ Better dependency searches for OpenGL during PDL build
+
+ Removed warnings "noise" when used with perl -w
+
+ New spheres3d routine added to PDL::Graphics::TriD
+
+
+ * Bugs Fixed
+
+ Fix PDL::AutoLoader to handle win32 PDLLIB path
+ syntax with ; as separator.
+
+ Fix PDL::Complex::string and sum and sumover
+ (sf.net bug #1176614)
+
+ Fix PDL::Config does not match actual build
+ configuration (sf.net bug #3030998).
+
+ Fix dimension numbering in PDL::Transform::t_fits
+
+ Fix jpegtopnm problem in proj_transform.t
+
+ Fix rt.cpan.org bug #53815 in IO/HDF/SD/SD.pd
+
+ Fix rt.cpan.org bug #59126 in isempty pod
+
+ Fix sf.net bug #2901170 re overly verbose warnings when
+ running TriD with perl -w
+
+ Fix sf.net bug #3011143 re whitespace in perl path
+
+ Fix sf.net bug #3021578 re missing xtra dummy dims
+
+ Fix threading with lu_decomp and lu_backsub
+ (sf.net bug #3021567)
+
+ Fix uniq and uniqind NaN and BAD value handling
+ (sf.net bug #3011659)
+
+ Fix uniqvec bug where it did not return a 2-D result
+ (sf.net bug #2978576)
+
+ Fix uuencode/uudecode detection logic in PDL::IO::Dumper
+ to include Convert::UU check
+
+ Make PDL prompt/warn if space in build path
+ (sf.net bug #2924854).
+
+ Fix up code to not crash on non-lazy linking systems.
+
+ Work arounds for perl-d lvalue temp bug introduced
+ in recent perls.
+
+ t/lvalue.t is skipped if run under the debugger.
+
+ Fix format string attack errors in GSL, PGPLOT,
+ and Transform.
+
+
+ * Many Documentation Improvements
+
+ Completely reworked PDL web site
+ - Clearer and more helpful to new PDL users.
+ - See http://pdl.perl.org for the latest!
+
+ New documentation:
+ - Migration guide for MATLAB users.
+ - Migration guide for Scilab users.
+ - Threading tutorial.
+
+ Major reorganization of documentation to better
+ help new users
+ - A guide to PDL's tutorial documentation.
+ - A guide to PDL's module reference documentation.
+ - A study course through all of PDL's documentation.
+ - Removed PDL::Intro
+
+ POD cleanup across many PDL modules and functions.
+
+ Update to copyright statements throughout PDL
+ to clarify licenses.
+
+ Improved on-line help and apropos features in
+ the PDL shell
+
+ Updated FAQ
+
+ Improved POD to HTML translation
+
+ DEPENDENCIES for PDL updated and checked
+ for applicability.
+
+ INSTALL guides improved in the distribution
+ and on the web site.
+
+
+
+Release notes for PDL 2.4.6 --------------------------
+
+General Notes:
+
+ * Mainly a bug fix and polishing release
+
+
+Highlights:
+
+ * Improved 3D graphics and OpenGL functionality
+
+ * imag2d() routine for multi-image (photo) display
+
+ * Many fixes for Debian package release
+
+ * Several little bugs fixed since PDL-2.4.5
+
+ * Fixed some issues with PDL convolution routines
+
+ * Improved documentation and release notes and files
+
+ * Padre and enhanced perldl shell integration begun
+
+
+Summary of Changes:
+
+ * Improved 3D graphics and OpenGL functionality
+
+ Perl OpenGL 0.62 is the minimum required version
+ for PDL::Graphics::TriD to build.
+
+ TriD now builds correctly for Mac OS X systems
+ without X11 installed.
+
+ Autoprobe for build of 3D graphics and the use
+ of the Perl OpenGL library has been implemented.
+ The default perldl.conf setting is to check.
+
+ Improved multi-window support for PDL::Graphics::TriD
+ display windows: the GLUT window ID is now part of
+ the default window title for convenience, and redraws
+ with multiple open TriD windows are handled correctly.
+
+ * imag2d() routine for multi-image (photo) display
+
+ REQUIRES: The Perl OpenGL TriD interface and FreeGLUT.
+
+ IMPORTANT: Legacy X11 TriD is *not* supported!
+
+ It is implemented in the imag2d.pdl file for autoloading
+ via PDL::AutoLoader. To use, copy the imag2d.pdl file
+ to somewhere in your PDLLIB path or add the location to
+ your PDLLIB environment variable.
+
+ It works with multiple, simultaneous, image windows
+ and appears to work side-by-side with TriD graphics
+ windows.
+
+ After you have imag2d.pdl in your @PDLLIB list,
+ you can use 'help imag2d' to get usage instructions
+ and documentation.
+
+ This implements the basic functionality planned regarding
+ an improved imagrgb() routine.
+
+ * Many fixes for Debian package release
+
+ This should allow PDL-2.4.6 to be more readily released
+ as a Debian packages. The general clean up involved
+ improves PDL portability and robustness generally.
+
+ * Several little bugs fixed since PDL-2.4.5
+
+ The number of history lines when you use Term::ReadLine::Perl
+ with perldl are now set correctly to $PERLDL::HISTFILESIZE.
+ The default value is 500.
+
+ A number of minor internal fixes for portability and
+ implementation improvements:
+
+ - Add comment re fix for defined(%hash) usage
+ - Fix annoying PGPLOT::HANDLE warning message
+ - Replace GIMME by GIMME_V in Core.xs
+ - Update to v3.14 of ppport.h portability
+
+ Fixed MINUIT build problem where non-standard code was
+ being generated which caused problems with rigorous compiler
+ settings. This was SF bug #2524068.
+
+ * Fixed a number of issues with PDL convolution routines
+
+ conv1d() algorithm adjusted to match conv2D() and convolutionND().
+ Documentation on the exact computation being performed in conv1d()
+ was added.
+
+ Fixes bug #2630369 with fftconvolve(). It now gives the same results
+ as conv1d(), conv2d(),.., except perhaps with respect to the boundary
+ condition handling.
+
+ * Improved documentation and release notes and files
+
+ Updated PDL::FAQ.
+
+ Lots of little changes to bring documentation in line
+ with current PDL functionality. Volunteer editors and
+ contributors always welcome!
+
+ * Padre and enhanced perldl shell integration begun
+
+ There is a new PDL-2.4.6/Padre/ subdirectory in the PDL
+ source tree which contains work towards Padre integration
+ and a 2nd generation, enhanced perldl shell for PDL.
+
+ E.g. an *experimental* plug-in giving PDL::NiceSlice support
+ to the Devel::REPL shell is included. See the Padre/README
+ file for instructions to get you started.
+
+
+
+Release notes for PDL 2.4.5 ------------------------------
+
+Highlights:
+
+ * 3D graphics modules now run on win32 and Mac OS X
+ systems without requiring X11 be installed. The
+ only prerequisites are OpenGL and FreeGLUT/GLUT.
+
+ * Release documentation and FAQ have been updated
+ to be more useful (and more accurate).
+
+ * PDL build, test, and run time diagnostic messages
+ have been make clearer and more helpful.
+
+ * Many bugs have been fixed since PDL-2.4.4 so this
+ is the most reliable PDL ever.
+
+ * PDL now requires perl 5.6.2 or greater and has
+ updated DEPENDENCIES information and code. This
+ should improve the buildability of PDL
+
+
+General Notes:
+
+ This is the first PDL release supporting the new build
+ strategy for the PDL::Graphics::TriD modules. The result
+ is it now builds on more platforms than ever. You'll
+ need to install the OpenGL module and have FreeGLUT or
+ GLUT (for Mac OS X) on your system.
+
+ If you have problems with the new TriD build (that you
+ did not have before), edit perldl.conf and set USE_POGL
+ to 0. That should enable you to build the legacy TriD
+ code but you *will* want to submit a bug report, see the
+ next point....
+
+ IMPORTANT: Given the increased portability and generality
+ of the new TriD interface approach, it is expected that
+ the legacy TriD build interface (based on X11) will be
+ deprecated soon (almost immediately) and removed after that.
+ (N.B. It has been effectively unsupported for some time)
+
+ If you are new to PDL, we recommend joining the perldl
+ mailing list for discussion and questions. See
+
+ http://pdl.perl.org/?page=mailing-lists
+
+ for how to sign up and links and searches of the list
+ archive discussions.
+
+
+Summary of Changes:
+
+ New perldl.conf configuration parameters controlling
+ build of TriD with perl OpenGL (a.k.a. POGL) with the
+ follow default values:
+
+ USE_POGL:
+ 1 -- build using POGL
+ 0 -- build using legacy build process
+ undef -- build with POGL if possible
+
+ POGL_VERSION:
+ 0.60 -- minimum required version of OpenGL
+
+ POGL_WINDOW_TYPE:
+ 'glut' -- use a GLUT GUI for window creation
+ 'x11' -- use GLX and X11 for the GUI (this is a "compatibility
+ mode" to support PDL::Graphics::TriD::Tk widgets)
+
+ NOTE: Set WITH_3D => 0 in perldl.conf to disable the
+ TriD build completely. Just setting USE_POGL => 0 is
+ not enough.
+
+ The OpenGL tests in t/opengl.t now respects the interactive
+ setting from the PDL_INT environment variable.
+
+ Two TriD check programs, 3dtest.pl and line3d.pl, are added to the
+ main PDL build directory. They can be run as quick checks of the
+ new functionality and are short enough run under the perl debugger
+ if needed. e.g.
+
+ perl -Mblib 3dtest.pl OR perl -Mblib line3d.pl
+
+
+ OpenGL (a.k.a. GL) is the default TriD output device on all
+ platforms. VRML does not work at the moment. GLpic is not
+ tested but may work.
+
+ Closed SF bug #1476324 by adding FAQ entry on clean installs
+
+ Fix qsorti(null()) crash bug from SF bug #2110074. Make
+ qsorti() return quietly when given a null() piddle input
+
+ Fix broken PP typemap finding code, thanks to CS for the
+ final code and many testers!
+
+ Fix t/autoload.t tilde expansion bugs and test failures.
+ tilde expansion seems to work consistently with bash now
+
+ Partial fix implemented for PDL::IO::Browser. The code has
+ only been tested with cygwin but it should work on systems
+ with ncurses in the "right place". This is **not tested**
+ but set WITH_IO_BROWSER => 1 if you wish to try.
+
+ If the perldl shell is unable to load PDL for some reason
+ and defaults to basic perl support, the prompt now changes
+ to perl> reflecting that fact.
+
+ readflex() now works with File::LinearRaid.
+
+ Many win32 fixes to tests and build process which make
+ things work more smoothly on win32 platforms.
+
+ See the Changes file or run 'git log --stat' for the detailed
+ list of changes.
+
+
+
+Release notes for PDL 2.4.4 ------------------------------
+
+General Notes:
+
+ - Bad value support is now enabled by default for
+ PDL builds. This feature allows simpler handling
+ of missing or invalid data during processing.
+
+ For example, missing pixels could be interpolated
+ across. Calculations could be skipped for
+ missing data points...
+
+ Edit the perldl.conf file to turn off bad value
+ support before compiling if needed.
+
+ - This release includes significant improvments
+ in portability, enhancements in functionality,
+ and *many* bugs fixed.
+
+ - PDL::Graphics::TriD modules for 3-D and image
+ visualization are being refactored for improved
+ portability and performance. Preliminary hooks
+ are in PDL-2.4.4 to support the new functionality.
+
+ Announcements to the perldl mailing list will be
+ made when the PDL::Graphics::OpenGL::Perl and
+ Term::ReadLine::FreeGLUT suport is on CPAN.
+
+ - Builds out-of-the-box on cygwin and win32
+
+ - perl 5.6.x is explicitly required to configure and
+ will go away in future versions. 5.8.x and above
+ are the recommended versions
+
+
+Summary of Changes:
+
+ - Improve uuencode support in Dumper for additional OSes
+ such as *BSD varieties that may need additional options
+ to prevent stripping of the leading slash in pathnames
+ including: darwin, netbsd, openbsd, freebsd, and dragonfly.
+
+ - Updated more PDL tests to use the recommended Test::More
+
+ - Updated PDL::Graphics::PLplot build support for more 5.9.0
+ specific features
+
+ - AutoLoader ~ expansion has been updated to conform more
+ closely to the ~ expansion in the bash shell
+
+ - Better checks for a valid PROJ4 build environment are now
+ performed before attempting to compile PDL modules using it
+
+ - PDL now builds and runs on perl-5.10.x
+
+ - The perldl shell has added support for using FreeGLUT for
+ display in analogy with the existing Tk event loop support.
+ This enables refactoring of the TriD modules to use the
+ Perl OpenGL module (a.k.a. POGL) instead of the internal,
+ and deprecated, PDL::Graphics::OpenGL et. al.
+
+ - The perldl acquire/filter/execute loop is now $_-safe by
+ using $lines instead of $_ for all the central modifications.
+ Avoids problems with some AUTOLOAD functions that leaked $_.
+
+ - Removed ExtUtils::F77 from the required prerequisites for
+ PDL to improve the buildability on platforms without an
+ available fortran compiler. If you have a fortran compiler
+ and EU::F77 installed, PDL::Slatec will be built.
+
+ - zeros function added as an alias for the zeroes function
+
+ - Many warning messages that were not actually problems have
+ been quieted, especially many pointer to int conversion messages
+
+ - Added $PERLDL::HISTFILESIZE to allow configuration of the number
+ of lines of history to be saved by the interactive PDL shell.
+
+ - Fixed implementation of the pctover() function to address bug
+ #2019651 on sf.net. Added explicit documentation in the code
+ on the algorithm being used.
+
+ - Various updates to the PDL FAQ
+
+ - Implemented a PDL interface to the Minuit minimization library
+ from CERN
+
+ - Removed circular dependency in PDL Makefile.PL Makefile generation
+ process which caused builds with some versions of make to fail
+
+ - Multiple fixes to enhance configuration and build for win32
+
+ - Added basic table-inversion to t_lookup for PDL::Transform
+
+ - Fixed problem in uniqvec() where it failed to generate a correct
+ result if all the input vectors were the same, fixed bug #1869760
+
+ - Add improved 16-bit image support for IO with rpic() and wpic()
+ provided you have a recent version of the NetPBM library that
+ supports 16-bit images
+
+ - Enabled building of GSL on Win32.
+
+
+
+Release notes for PDL 2.4.3 ------------------------------
+
+General Notes:
+
+ - again, mainly a bugfix and polishing release.
+
+ - builds out-of-the-box on cygwin and win32 build environment
+ has been significantly improved
+
+ - perl 5.6.x is now deprecated; 5.8.x is recommended. Support
+ for 5.6.x may go away in future versions.
+
+
+Summary of Changes:
+
+ - PDL now builds under cygwin on windows PC including
+ TriD(OpenGL) 3D graphics and PGPLOT and PLplot 2D graphics
+ support. See PDL/cygwin/ and files README and INSTALL for
+ details and how to build/install external dependencies.
+
+ - The win32 build has been improved. See PDL/win32/INSTALL
+ for details.
+
+ - Many fixes from the Debian build patches have been
+ incorporated. See PDL/debian for specifics.
+
+ - 64bit platform build has been improved.
+
+ - New functionality, functions and modules:
+
+ * Bad value support has been extended to per-PDL bad
+ values as an experimental feature. To use, configure
+ WITH_BADVAL => 1 and BADVAL_PER_PDL => 1 in perldl.conf
+ before building.
+
+ * PDL::GSL::INTEG now supports the calculation of
+ nested integrals
+
+ * New function tcircle (threaded circle) added to
+ PDL::Graphics::PGPLOT This draws multiple circles in
+ one go (see also tpoints and tline)
+
+ * Added set operation routines for pdls treated as sets
+ (help setops).
+
+ * PDL::IO::GD module interface to the GD runtime image
+ libaray (http://www.boutell.com/gd/) has been integrated.
+
+ * The PDL::GIS::Proj and PDL::Transform::Proj4 modules
+ to interface to the PROJ4 Cartographic Projections
+ Library (http://proj.maptools.org/) have been added.
+
+ * PDL::IO::HDF provides an interface to the HDF4
+ library (http://hdf.ncsa.uiuc.edu/).
+
+
+ - The PDL test suite (i.e. tests in in PDL/t) has been
+ enhanced. Coverage has improved and output diagnostic
+ messages are more useful. Test::More is becoming the
+ preferred test module. The vanilla Test and Test::Simple
+ may be deprecated in the future.
+
+ - PDL core code has been fixed to address valgrind-detected
+ errors and to enable better bad value support including the
+ new experimental per-PDL bad values. These changes will
+ require a re-build/install of any external modules using
+ the C interface of PDL. See perldl.conf to configure the
+ new bad value support.
+
+ - Several TriD graphics build problems have been resolved.
+ The TriD rotation bug has been fixed.
+
+ - Many other bug fixes too numerous to mention. See the
+ PDL/Changes file for details.
+
+ - Multiple fixes and additions to PDL documentation as well
+ as the PDL::FAQ.
+
+
+
+Release notes for PDL 2.4.2 ------------------------------
+
+General Notes:
+
+ - again, mainly a bugfix and polishing release.
+
+ - perl 5.6.x is now deprecated; 5.8.x is recommended. Support
+ for 5.6.x may go away in future versions.
+
+ - a little too late for Christmas; but happy new year 2005!
+
+
+Summary of Changes:
+
+ - Overhaul of FITS I/O. FITS binary tables are now supported,
+ for both reading and writing.
+
+ - Many improvements to PLplot handling
+
+ - New Graphics::Limits package determines display range for multiple
+ concurrent data sets
+
+ - Better PDL::reduce function
+
+ - Improvements to PDL::Transform
+
+ - pdl() constructor is more permissive -- you can feed it PDLs and
+ it does the Right Thing most of the time.
+
+ - Cleaner handling of config files
+
+ - Improvements to multi-line parsing in the perldl shell
+
+ - New 'pdl' command-line entry to perldl shell allows #!-style
+ scripting (so you can re-use your journal files verbatim)
+
+ - Several fixes for Microsoft Windows operation
+
+ - PDL::undefval works properly, also has warning tripwires
+
+ - statsover finally seems to produce meaningful, consistent RMS values
+
+ - Several 64-bit compatibility issues (this work is probably not yet
+ complete).
+
+- Many small bug-fixes too numerous to list (see the Changes file).
+
+
+
+
+Release notes for PDL 2.4.1 -------------------------------
+
+General Notes:
+
+ - mainly a bugfix and polishing release
+
+
+Summary of Changes:
+
+ - Fixed warnings with perl 5.8.2
+
+ - Replace original m51.fits with freely distributable image
+
+ - Upgrade PLplot interface for plplot-5.2.1 and perl 5.8.2
+
+ - Improvement to documentation of autoloaded routines
+
+ - Added more universal `whatis' function to perldl
+
+ - Numerous small fixes/additions to docs/functions
+
+ - Improved handling of empty piddles
+
+ - Fixed most reported bugs
+
+
+Release notes for PDL 2.4.0 -------------------------------
+
+General Notes:
+
+ - Perl 5.6.0 or later is now required, along with the modules
+ Filter and Text::Balanced.
+
+ - After installing PDL 2.4.0 external PDL modules will need to re-built.
+ (any such modules will refuse to load until they have been re-built)
+
+ - New demos of the PDL::Transform and PDL::Transform::Cartography
+ modules have been added to perldl.
+ Type 'demo transform' or 'demo cartography' in the perldl shell.
+ ( Note that PGPLOT is required to run )
+
+Summary of Changes:
+
+ - The NiceSlice syntax comes of age
+ (Nice slicing has been around a while, but really needs to be
+ acknowledged as the main way of slicing PDLs...)
+
+ - New GSL functionality: greatly improved access to the Gnu Scientific
+ Library, including interpolation, finite-difference, random
+ variable, and other routines.
+
+ - New, very powerful indexing and slicing operators allow boundary
+ conditions (range, indexND)
+
+ - N-dimensional indexing (indexND) and selection (whichND) methods
+
+ - Powerful syntax for coordinate transformation and arbitrary image
+ resampling and coordinate transformations -- including high powered
+ spatially-variable filtering (PDL::Transform module)
+
+ - Support for major cartographic transformations
+ (PDL::Transform::Cartography module)
+
+ - New PLPlot graphics interface ( cleaner and faster than PGPLOT )
+
+ - Many improvements to the PGPlot interface:
+ * Strong FITS support (easy display of images, vectors, & contours in
+ science coordinates)
+ * Better vector graphic support [including improvements to line() and
+ a new routine, lines()]
+ * Much cleanup of errors and bugs
+ * Spinlocks prevent interrupt-related PGPLOT crashes (requires Perl 5.8)
+ * RGB output to truecolor devices (requires PGPLOT-5.3devel)
+
+ - Improvements to the perldl shell:
+ * Many bug fixes
+ * Multi-line inputs to the perldl shell for easier cut-n-paste
+ * ^D blocking on demand (controlled by perl variable or command-line
+ switch)
+ * Autoloading detects error conditions on compile
+ * New demos
+
+ - Header copying is now explicit rather than by reference -- so that,
+ e.g., FITS file manipulation is more intuitive and natural.
+
+ - Improved support for Astro::FITS::Header
+
+ - Bad value support is improved
+
+ - Several new utility routines, including glue(), zcheck(), and ndcoords().
+
+ - Better matrix operation support: matrix operations are now in
+ PDL::MatrixOps, and are all threadable. Singular value decomposition,
+ determinant, linear equation solving, matrix inversion,
+ eigenvalue decomposition, and LU-decomposition.
+
+Release notes for PDL 2.3.4 -------------------------------
+
+ - Now should compile using perl 5.8.0
+ - Improved speed for generating PDL's from a perl array ref
+ - Added PDL::IO::Storable, which enables PDL storage/retrieval
+ using the Storable package.
+ - Added PDL::GSL::SF (Gnu Scientific Library, Special Functions) hierarchy
+ - New % operator follows (mathematically correct) perl % operator behavior
+ - Numerous Bug Fixes
+
+ See the Changes file for a detailed list of changes.
+
+Release notes for PDL 2.3.3 -------------------------------
+
+ Mainly a bugfix release with some nice little additions:
+ - PDL::IO::Dumper: Cleanly save and restore complex
+ data structures including PDLs.
+ - Support for the new Astro::FITS::Header module
+ (availiable on CPAN).
+
+ See the Changes file for a detailed list of changes.
+
+Release notes for PDL 2.3.2 ------------------------------
+
+A pure bugfix release to fix compilation problems with gimp-perl
+(part of the gimp distribution). The following notes from
+2.3 and 2.3.1 still apply:
+
+Release notes for PDL 2.3.1 ------------------------------
+
+A bugfix release to fix some compilation problems seen with
+2.3. The following notes from 2.3 still apply:
+
+Release notes for PDL 2.3 -------------------------------
+
+ Summary of Changes
+ - A nicer slicing syntax for PDL added via the new
+ PDL::NiceSlice module.
+ - Inline::Pdlpp module added, which enables in-line
+ PDL::PP definitions. (i.e. no Makefiles, building
+ hassles for creating PP code)
+ - A Multitude of bug fixes, doc updates, and other
+ changes.
+
+ Note:Support for perl version 5.005 and previous is
+ limited in this release. Perl 5.6.0 or greater is
+ recommended for full PDL functionality.
+
+ See the Changes file for a detailed list of changes.
+
+Release notes for PDL 2.2.1 -------------------------------
+
+ Summary of Changes
+ Bugs Fixed:
+ - 'pow' function fixed in math.pd
+ - Misc memory leaks fixed.
+ - PGPLOT 'undefined window size'
+ bug fixed.
+ - Test failures with opengl.t fixed.
+ - Error in output of 'minimum_n_ind' function
+ fixed.
+
+ Misc Changes:
+ - Documentation updates.
+ - Updates to work with perl5.6.1
+
+ See the Changes file for a detailed list of changes.
+
+Release notes for PDL 2.2 -------------------------------
+
+Major Changes:
+
+ - 'Bad' Value Support added. With this option compiled-in, certain
+ values in a PDL can be designated as 'Bad' (i.e. missing, empty,
+ etc). With this designation, most PDL functions will properly
+ ignore the 'Bad' values. See PDL::BadValues for details.
+
+ - PGPLOT interface rewritten. New Features:
+ - Interactive cursors (cursor)
+ - Text on plots (text)
+ - Legends (legend)
+ - Circles, Rectangles, Ellipses
+ - Multiple plot windows, one can jump from panel to panel when
+ the window is divided in several.
+ - More control over options - see PDL::Graphics::PGPLOTOptions for
+ details.
+ - New Examples in Example/PGPLOT.
+
+ - Major updates to the Tri-D Code. Now requires perl 5.6 for TriD.
+
+ - 'Reduce' function added. This provides a consistent interface to the
+ projection routines (sumover, average, etc). See PDL::Reduce.
+
+ - Improved OpenGL detection during 'perl Makefile.PL
+
+ - pdldoc command added. This allows you to look up PDL
+ documentation similar to the perldoc command.
+
+ - Perl 5.6 is now recommended for PDL 2.2. It will still work
+ with perl 5.005, but some of the extra libs won't be compiled
+ ( like Graphics/TriD).
+
+Many other changes. See the Changes file for a detailed list of changes.
+
+Release notes for PDL 2.1 -------------------------------
+
+Major Changes:
+ - Speed Increase. Most PDL functions are now done totally
+ in C-code, without any perl wrapper functions as was done
+ with previous versions. The speedup will be most noticeable
+ for operations on many small PDL arrays.
+ - Mem Leaks Fixed.
+ - Added a consistent, Object-Oriented interface to the
+ various interpolate functions in PDL. (PDL::Func,
+ See Lib/Func.pm).
+
+See the Changes file for a detailed list of changes.
+
+
+
+Release notes for PDL 2.005 -----------------------------
+
+A bugfix release to fix 2.004 problems with PGPLOT changes
+and perl 5.6.0.
+
+The following notes from 2.004 still apply:
+
+*IMPORTANT NOTE*: Due to changes to the PGPLOT module, 'use
+PDL::Graphics::PGPLOT' has been removed from PDL.pm (i.e. in scripts
+and within perldl you now need to explicitly say 'use
+PDL::Graphics::PGPLOT'). Additionally, it needs Karl's new 2.16
+release of the PGPLOT module (available from CPAN).
+
+Notable additions are a module for operations on complex piddles
+(PDL::Complex), a subtype of PDL which allows manipulation of byte
+type PDLs as N dimensional arrays of fixed length strings (PDL::Char)
+and a Levenberg-Marquardt fitting module (PDL::Fit::LM).
+
+Bug reports and patches to the relevant places on sourceforge, please.
+
diff --git a/TODO b/TODO
new file mode 100644
index 0000000..f9907ff
--- /dev/null
+++ b/TODO
@@ -0,0 +1,525 @@
+What follows is that task list and description of
+the work planned for the future PDL-2.x releases.
+
+The main goal we are working towards is to have a
+baseline PDL working on *all* PDL OS platforms:
+win32/cygwin, macosx, and linux/unix/bsd systems with
+support for 2-D graphics (via PLplot) and 3-D graphics
+(via OpenGL/TriD).
+
+
++-------------------------------------------------------+
+| Candidate Tasks for PDL-2.x Development |
++-------------------------------------------------------+
+
+ This section documents the top level tasks from
+ the more detailed list below. The first column
+ of the line indicates the priority of that item
+ (and those below it) for the PDL-2.x release:
+
+ T -- TBD
+ R -- required for release to occur
+ N -- nice to have but not mandatory
+ no mark means same as super bullet or FYI
+ D -- done
+
+ Each item has some task description based on the
+ current status.
+
+ Update task list after PDL-2.x release.
+
+
+
++-------------------------------------------------------+
+| |
+| PDL-2.x BULLET TASK LISTING |
+| ( BY CATEGORY ) |
+| |
++-------------------------------------------------------+
+
+
+
++-------------------------------------------------------+
+| TESTING |
++-------------------------------------------------------+
+
+
+ Refactor to use Test::More
+ * aaa_load.t
+ * argtest.t
+ * bool.t
+ * clump.t
+ * croak.t
+ * familyfree.t
+ * flow.t
+ * foo.t
+ * gauss.t
+ * hdrs.t
+ * howbig.t
+ * ica.t
+ * imagend.t
+ * imagergb.t
+ * interp.t
+ * interp_slatec.t
+ * interpol.t
+ * limits_normalize_dsets.t
+ * linfit.t
+ * magic.t
+ * matmult.t
+ * ones.t
+ * ops.t
+ * pdlchar.t
+ * physical.t
+ * picnorgb.t
+ * picrgb.t
+ * pnm.t
+ * poly.t
+ * polyroots.t
+ * primitive2.t
+ * pthread.t
+ * pthread_auto.t
+ * reduce.t
+ * refs.t
+ * scope.t
+ * segfault.t
+ * thread.t
+ * thread_def.t
+ * vaffine.t
+
+ Convert from Test to Test::More
+ * bess.t
+ * callext.t
+ * conv.t
+ * diskcache.t
+ * erf.t
+ * erfi.t
+ * fft.t
+ * func.t
+ * hist.t
+ * image2d.t
+ * lut.t
+ * lvalue.t
+ * matrix.t
+ * matrixops.t
+ * niceslice.t
+ * nsdatahandle.t
+ * requiredmods.t
+ * round.t
+ * simplex.t
+ * transform.t
+ * trig.t
+ * xvals.t
+
+
+ Need to test PDL build from scratch both WITH_BADVAL and without
+ * Find a way to automate this process for release testing
+ * Unix/Linux/BSD
+ * Windows
+ - cygwin
+ - activestate perl
+ - strawberry perl
+ * Mac OS X
+
+
+ Verify dependency detection across all major PDL platforms
+ * Unix/Linux/BSD, Windows(ASPerl/Strawberry)/Cygwin, Mac OS X
+ * Check completely clean build each platform
+ * Confirm that dependencies for each platform
+ are correctly detected and reported.
+ * Add any issues to Known_problems
+
+
+ These modules aren't tested by CPAN Testers because of dependencies:
+ * PDL::FFTW
+ - Deprecate PDL::FFTW since it is largely out-of-date and
+ has unresolved bugs with wisdom
+ - Alien::FFTW3 and add PDL::FFTW3
+ * PDL::Slatec
+ * PDL::Minuit
+ - need Fortran compilter and ExtUtils::F77
+ * PDL::IO::GD
+ - needs libgd
+ - Alien::GD
+ * PDL::IO::HDF
+ - based on HDF4
+ - Alien::HDF
+ - Alien::HDF5
+ - add binding to libhdf5
+ * PDL::GSL::XXX
+ - need more complete libgsl bindings
+ - Alien::GSL
+ * PDL::GIS::Proj
+ * PDL::Transform::Proj4
+ - Alien::Proj4
+ * PDL::Graphics::TriD
+ - Alien::OpenGL, GLU, GLEW, GLUT, GLUI...
+ - test with pixel buffer context(?)
+ * PDL::Graphics::PGPLOT
+ - needs portable driver (OpenGL)
+ - Alien::PGPLOT
+ - apply/update RGB color patches to current
+ * PDL::Graphics::PLplot
+ - need portable driver (OpenGL)
+ - Alien::PLplot
+ - need low-level PLplot interface
+ * PDL::IO::Browser
+ - need curses/ncurses
+ - Alien::Curses
+ - maybe OpenGL terminal or widget
+ - need something lightweight
+ - add support for pdls having >2 dims
+
+
+ Add support for Known_problems to tests
+ * Use skip for tests with segfault fails
+ * All bug reports should have a test in PDL/t
+
+
+ Clean up and triage for tickets prior to release.
+ * Bugs
+ * Feature requests
+ * Patches
+
+
+
++-------------------------------------------------------+
+| DEPENDENCIES |
++-------------------------------------------------------+
+
+ Alien modules for the external PDL dependencies
+ * Alien::PLplot
+ * Alien::PROJ4
+
+
+ Define standard paths for external dependency libraries for PDL
+ * See File::ShareDir::Install and File::ShareDir
+ * Can skip install if system-wide is available
+ * Relocatable with package-config or Alien info
+ * Document any PDL-specific install locations
+ * This should allow for a devel-PDL install for win32
+
+
+ List and obtain module owners and developers for existing PDL modules
+ * Revisit each module's status by platform
+ * Regarding portability
+ * Review external dependency handling
+ * Update plan for development
+
+
+ Fix/document FORTRAN code requirements
+ * Add a USE_FORTRAN option to perldl.conf
+ * Add check for ExtUtils:F77
+ * Convert PDL::Slatec to use C with f2c of source
+ * Convert PDL::Minuit to use C with f2c of source
+
+
+ Fix IO/Browser build to properly check for the curses
+ library and build if available.
+
+
++-------------------------------------------------------+
+| DOCUMENTATION |
++-------------------------------------------------------+
+
+ Update PDL web site pages
+
+
+ Review current documentation (underway)
+ * Verify correctness and consistency with PDL-2.x
+ * Update documentation where needed.
+ * Add web searchable versions of the docs.
+ * Maybe a wiki format could be used to improve docs
+
+
+ Add/update platform install notes to PDL wiki
+ * Complete build-from-scratch installs
+ * Soup to nuts via the cpan shell
+ * Build issues and their fixes
+ * How to get needed dependencies
+ * Other platform details
+ * Mac OS X
+ * Linux (by distribution and version)
+ * BSD
+ * Solaris
+ * Windows
+ * Cygwin
+ * Other
+
+
+ Add CPAN shell start-up info to PDL wiki or web page
+ * CPANminus/perlbrew seems to be best approach
+ - Basic CPAN more complicated
+
+
+ Add CPAN Testers start up info to PDL wiki
+ * Test::Reporter
+ * CPAN Testers version 2
+ * Easy/basic install and usage
+
+ The new CPAN Testers version 2.0 has been
+ released. It uses a web-based interface to
+ send reports rather than email. As a result
+ is is much easier to configure than the old
+ interface. As such, we would get better PDL
+ feedback if we have a quick-start for that.
+
+ Add info for PERL_CPAN_REPORTER_DIR variable.
+
+
+ Document how to set up a local sandbox for PDL build
+ * INSTALL_BASE for EU::MM > 6.31 and --install_base for M:B
+ * Need to cover adding bin to paths and any library issues
+ * Build with CPAN shell or cpanm
+ * Check out brewperl
+
+ A number of PDL users are configuring their
+ own local library, perl, and PDL installations.
+ It would be nice if clear directions were
+ written down so everyone doesn't have to
+ reinvent the same wheel.
+
+
+ Add docs/support for users of other software
+ * IDL, Matlab, NumPy
+ * Add help for equivalent PDL constructs
+
+
+ Update PDL Book (in progress)
+ * Needs updating to match PDL-2.x
+ * make a web version available on-line if possible
+
+
+ Better document the PDL help system
+ * Requirements and usage
+ * Quick start
+ * Add custom/user key word search support
+ * Is there a way to fetch all the functions/keywords
+ the PDL help system supports?
+
+
+
++-------------------------------------------------------+
+| USABILITY |
++-------------------------------------------------------+
+
+ Improve PDL usability for first time users
+ * Work out-of-the-box via cpan[m] shell
+ * Fully automatic
+ * Semi-manual
+ * Easy install via 1-click or package managers
+ * PAR for distribution
+ * Should be able to upgrade PDL ppd install on win32
+
+ A simple cpan or platform package install should
+ work out of the box. Maybe not all dependencies
+ will build but PDL should build with 2D and 3D
+ graphics support for most/all platforms.
+
+
+ Implement "1-click" installs by platform and document in wiki
+ * Mac OS X: SciKarl, verify support by OS versions
+ * Windows: Strawberry Perl Professional, ActivePerl
+ * Unix OSes: Various package managers
+
+
+ Replace inconsistent minimum and maximum subs in Ufunc
+ by maxover and minover which is consistent with all the
+ other usages:
+
+ average -> avgover
+ daverage -> davgover
+ maximum -> maxover
+ maximum_ind -> maxover_ind
+ maximum_n_ind -> maxover_n_ind
+ minimum -> minover
+ minimum_ind -> minover_ind
+ minimum_n_ind -> minover_n_ind
+ minmaximum -> minmaxover
+
+
++-------------------------------------------------------+
+| INSTALLATION |
++-------------------------------------------------------+
+
+ Switch from ExtUtils::MakeMaker to Module::Build
+ * May be better to go with Module::Install
+ * More flexible
+ * More familiar
+ * Builds faster
+ * Removes portability problems from shell and make
+ * Easier to extend
+
+
+ Fix the test problems with preexisting PDL installs
+ * Add warning if binary api has changed or if there
+ are other dependent PDL modules that would need
+ to be updated.
+ * Develop test methodology
+ * Add PDL::Core::Dev utility to perform check
+ * Automate detection/test skip if not built logic
+
+
+ Check/set perldl.conf options before the build
+ * Add WITH_CORE_ONLY to perldl.conf
+ * Add WITH_FORTRAN to perldl.conf
+ * Interactive option view prompt() in Makefile.PL
+ * GUI version
+
+
+
++-------------------------------------------------------+
+| NEW FEATURES |
++-------------------------------------------------------+
+
+ Finish PDL::IO::ENVI module
+ * Implement basic writeenvi() routine
+ * Add tests and reimplement as a module
+ * Add to PDL distribution
+
+
+ Need PLplot and PDL::Graphics::PLplot to build all platforms
+ * MS Windows
+ * Cygwin
+ * Linux/unix
+ * Mac OS X
+
+
+ Complete Perldl2 shell:
+ * Implement remaining perldl features for pdl2
+ * Fix Ctrl-C handling for win32 systems
+ * Update documentation
+ * See Perldl2/TODO for the pdl2-specific list.
+
+
+ Add support for 64bit data:
+ * Add safe pdl allocation option to prevent OOM death
+ D Update allocation and types to support 64bit data
+ * Add info in PDL::Config for level of 64bit support
+ (e.g. STRLEN size vs ptrsize...)
+
+
+ Add support for improved 2-D image display using OpenGL
+ * Add threaded 2-D image tiled display to imag2d
+ * Enable REPL and GUI simultaneous operations and event loops
+ * perldl via ReadLine and FreeGLUT
+ * REPL via ReadLine and FreeGLUT
+ * Maybe for wxWidgets for Padre support
+ * Implement some tests
+
+
+ New pdl() constructor with matlab [] syntax for string arguments
+ * Needs more testing and verification
+ * Does it work for MATLAB and PDL users' purposes?
+ * Handle complex numbers (with i,j for sqrt(-1))
+ * Handle cut and paste of printed piddles
+ * Better error checking for invalid values
+
+ Ideally we should be able to cut-n-paste the print
+ output of a piddle into the constructor as a
+ string and get the piddle back (within float eps).
+
+
+ Finish spheres3d implementation
+ * Add color (RGB+A) support
+ * Add per-sphere radius (support threading)
+ * Add surface normals for smooth shading
+ * Extend to arbitrary objects with constructors
+
+
+ Refactor TriD/PDL for better animation
+ * interoperate better with OpenGL display
+ * clean up OO structure and document (use Moo[se])
+ * implement pipeline stream to wmpeg
+ * stream PDL slice (with no make-physical)
+ * add dataflow callback to support display updates
+
+
+ NiceSlice cleanup
+ * refactor to use Module::Compile / Filter::Simple
+ * implement string processing version for REPL use
+ - .pmc generation via Module::Compile
+ - Smarter parsing via Filter::Simple
+ - Optimize sourcecode filter for speed
+ * document nslice
+ * implement a niceslice method
+ * enhance nslice() to handle CODE refs
+ * Done but it doesn't buy much since it only
+ works if the CODE ref is a blessed object
+ so that a UNIVERSAL::nslice method can be
+ called on it.
+ * maybe defer/lazy source filtering
+ * check if valid subref args good for slicing
+ * can use string eval with notrans
+
+
+
++-------------------------------------------------------+
+| LATER |
++-------------------------------------------------------+
+
+ PDL::Constants
+ * Transition into 'use PDL;'
+ * Add other constants of interest
+ * Units
+ D Complex i,j
+ * Inf
+ * To import or not to import
+
+
+ PDL::Matlab helper module
+ * Implement key set of basic Matlab functions
+ * MATLAB "expand" to PDL syntax?
+ * Document PDL equivalents
+ * Add who/whos refs or links to pdl2 'help vars'
+
+
+ Fix external dependency processing
+ * Implement Alien::Base::CheckLib
+ - provides detection part of Alien manifesto
+ - based on Devel::CheckLib to detect headers and libraries
+ - need to be fully cross-platform
+ * Remove dependencies on external commands (e.g. clear in Demos)
+ * Make missing functionality detectable at run time
+ * Could use warning/error stubs if functionality not available
+ * Alien modules for the external PDL dependencies
+ * Alien::Curses
+ * Alien::FFTW
+ * Alien::FFTW3
+ * Alien::GSL
+ * Alien::GD
+ * Alien::GLUI
+ * Alien::HDF
+ * Alien::HDF5
+ * Alien::JPEG
+ * Alien::NetPBM
+ * Alien::OpenGL, Alien::GLUT, Alien::GLX, Alien::GLEW
+ * Alien::PGPLOT
+ * Alien::PNG
+ * Alien::TIFF
+
+
+ Full GSL bindings for PDL
+ * Alien::GSL to install and something else to check
+ * Prioritize GSL functionality to add
+ * Convert GSL documentation to PDL usable form
+ * Automate code conversion
+ * Can we use Math::GSL as a starting point?
+ * What about an PDL::PP version using GSL configure info for thread support?
+ * Slatec compatibility wrappers
+
+
+ Clean and unify the FFT and FFTW in PDL
+ * FFT is the default implementation
+ * Add FFTW acceleration for the default FFT
+ * Add cleaner use of complex values to FFT routines
+ * Make non-inplace versions of FFT
+ * Make default FFT library match FFTW calling conventions
+ * Document FFT/FFTW
+ * The computational algorithms
+ * The input/output locations
+
+
+ Update HDF docs
+ * HDF5 and HDF4 are entirely different beasts (and totally incompatible)
+ * The PDL::IO::HDF library uses HDF4.
+ * Portability issues especially re. Installs
diff --git a/TestTools/Mem/foobar b/TestTools/Mem/foobar
new file mode 100644
index 0000000..5af142c
--- /dev/null
+++ b/TestTools/Mem/foobar
@@ -0,0 +1,7 @@
+BEGIN{print `pwd`;};$|=1; use blib '../..'; use PDL; {
+ my $a = zeroes(100,100);
+ my $b = $a + 1;
+ print "GOINGTOFIN\n";
+}
+;print "FINISHED\n";
+
\ No newline at end of file
diff --git a/TestTools/Mem/tmem.pl b/TestTools/Mem/tmem.pl
new file mode 100644
index 0000000..65a6790
--- /dev/null
+++ b/TestTools/Mem/tmem.pl
@@ -0,0 +1,68 @@
+# Scripts to test PDL memory handling for leaks.
+
+# Replace DPERL by the name of your debugging perl (built with MSTATS)
+# executable.
+
+$DPERL = "/usr/bin/dperl";
+
+sub memtest;
+
+memtest "JUSTPERL",<<'END';
+{
+ my $a = "sljslfsjeflsejflisejflseijfljesfjsefs" x 10;
+ my $b = $a . "foo";
+}
+END
+
+memtest "ALLOCONE",<<'END';
+ my $a = zeroes(100,100);
+END
+
+memtest "ADDSAME",<<'END';
+ my $a = zeroes(100,100);
+ my $b = $a + $a;
+END
+
+memtest "ADDONE",<<'END';
+ my $a = zeroes(100,100);
+ my $b = $a + 1;
+END
+
+memtest "ADDONE+AT",<<'END';
+ my $a = zeroes(50,50);
+ my $b = $a + 1;
+ my $c = $b->at(5,5);
+END
+
+sub memtest {
+ my($name,$scr) = @_;
+ my @res;
+ for(1,51,101) {
+ my $res;
+ print "$name ROUND $_\n";
+ open FILE, ">tmpscript";
+ print FILE "BEGIN{print `pwd`;};\$|=1; use blib '../..'; use PDL;
+ for(\$i = 0; \$i < $_; \$i++) { $scr } print \"FINISHED\\n\";
+ ";
+ close FILE;
+ $ENV{PERL_DEBUG_MSTATS}=2;
+ open(PIPE,"dperl tmpscript 2>&1 |")
+ or die "Couldn't open pipe";
+ { local $_; while(<PIPE>) { $res .= $_ }; }
+ close PIPE;
+# print "RESULT: $res ENDRESULT\n";;
+ $res =~ /FINISHED/ or die "Couldn't run script!";
+ push @res,$res;
+ }
+ my $tres = join '',
+ map {
+ /(Memory allocation statistics after execu.*Total sb[^\n]*$)/s
+ or die "Output $_ doesn't match pattern\n";
+ my $str = $1;
+ $str =~ /\n([^\n]*used[^\n]*\n)/m
+ or die "Output $str doesn't match pattern2\n";
+ $1;
+ } @res;
+ print "-----------------------\nRES $name:\n$tres\n";
+}
+
diff --git a/cygwin/INSTALL b/cygwin/INSTALL
new file mode 100644
index 0000000..f953bdd
--- /dev/null
+++ b/cygwin/INSTALL
@@ -0,0 +1,440 @@
+Created on: Thu 27 Jul 2006 09:43:26 PM
+Last saved: Tue 11 Oct 2011 12:53:55 PM
+
+
+
+=================================================================
+ GENERAL NOTES
+=================================================================
+NOTE: These install notes have been partially reviewed
+for the PDL-2.4.9 release. It is recommended that you
+build and install PDL based on a full cygwin 1.7.17 or
+later install. Please post to the perldl mailing list
+for help or questions regarding a cygwin install.
+
+By default, Cygwin has an ~300MB process memory limit.
+If you work with large data sets, you may wish to
+use the native win32 PDL with either ActiveState Perl
+or Strawberry Perl. Otherwise, you'll want to set the
+value of heap_chunk_in_mb to allow for bigger data as
+described in the Cygwin Users Guide:
+http://www.cygwin.com/cygwin-ug-net/setup-maxmem.html
+
+Work is underway to improve the native win32 perl PDL
+support for external dependencies so that it may be
+used, feature for feature, instead of the cygwin port.
+
+WARNING: There is a known problem with windows DLL base
+addresses being scrambled causing mysterious failures
+for cygwin builds. See the REBASEALL directions below
+for the current work around. Development for recent
+cygwins appear to be making progress towards fixing
+this problem.
+
+
+
+
+
+=================================================================
+ Installing with CPAN on Cygwin
+=================================================================
+If you already have a full cygwin install on your PC, the
+simplest way to get a basic PDL is to use the cpan shell.
+
+This will get you all the functionality that is supported
+by existing cygwin package functionality (i.e. available
+from the standard Setup.exe installs).
+
+!! NOTE: you will be asked to answer some configuration
+!! questions the first time you use cpan on your system.
+!! Most should be self-explanatory.
+
+Just start up an xterm and run cpan from the bash prompt:
+
+ bash$ cpan
+ cpan> install ExtUtils::F77
+ cpan> install OpenGL
+ cpan> force install Inline
+ cpan> install PDL
+
+This installs the Perl OpenGL (a.k.a POGL) module, ExtUtils::F77,
+and Inline (the force here is necessary to work around a taint
+bug in the current release---should be no problem unless you
+need to run Inline programs with taint enabled), and should pull
+in installs for the following dependencies:
+
+ Astro::FITS::Header
+ Convert::UU
+ Data::Dumper
+ File::Spec
+ Filter::Util::Call
+ Pod::Parser
+ Pod::Select
+ Storable
+ Text::Balanced
+
+if they are not already installed or of a recent enough version.
+
+You should finish with a PDL having the following functionality:
+
+ - base PDL modules
+
+ - PDL::IO::GD
+ - PDL::GIS::Proj
+ - PDL::Graphics::TriD
+ - PDL::GSL::*
+ - PDL::Minuit
+ - PDL::Slatec
+ - PDL::Transform::Proj4
+
+
+
+=================================================================
+ Manual Configuration and Install
+=================================================================
+In general, the standard install process for perl modules
+should work on cygwin. If you don't want to accept the
+default build options for PDL, edit the perldl.conf file.
+You'll find that file in the top level PDL folder/directory.
+
+The remaining PDL functionality depends on external libraries
+and packages that must be pre-installed before installing PDL.
+
+If you want to use other modules with external dependencies
+not available through the Setup.exe from http://www.cygwin.com
+then you'll need to get, build, and install the desired
+libraries yourself (see the HOW-TO notes below).
+
+The manual configure/build/install process is:
+
+ Edit the PDL/perldl.conf file as desired
+
+ From the bash$ prompt in the top level PDL/ directory:
+
+ perl Makefile.PL # configures all the Makefile
+
+ make # builds/compiles everything
+
+ make test # run test suite
+
+ make doctest # builds online documentation
+ # and html docs
+
+
+ If any tests fail (rather than skipped) you can run them
+ by hand for more detailed diagnostic messages. For
+ example:
+
+ perl -Mblib t/plplot.t
+ 1..27
+ ok 1 - use PDL::Graphics::PLplot;
+ # Looks like you planned 27 tests but only ran 1.
+
+ perl -Mblib t/proj_transform.t
+ 1..4
+ # Looks like your test died before it could output anything.
+
+ These test failures with the number of planned tests not
+ equal to the number of tests run (1) or if a test died
+ before it could output anything usually indicates a problem
+ with the DLL base addresses. See the instructions for
+ REBASEALL below.
+
+
+ If PDL built ok and passed tests, you can test the interactive
+ PDL shell before actually installing PDL by running from the
+ PDL/ top level directory:
+
+ perl -Mblib Perldl2/pdl2 # type quit to exit the PDL shell
+
+
+ To finally install the PDL into your system run:
+
+ make install
+
+
+
+=================================================================
+ FFTW
+=================================================================
+!! You'll need to build *version 2* of the FFTW library for PDL.
+!! Version 3 has a new API and is not compatible with this PDL.
+
+ # download the source code if needed, I used wget
+ wget http://www.fftw.org/fftw-2.1.5.tar.gz
+
+ # extract the source files
+ tar xzf fftw-2.1.5.tar.gz
+
+ # change to the source directory
+ cd fftw-2.1.5/
+
+ # this is the standard GNU build process
+ ./configure
+ make
+ make check
+ make install
+
+The FFTW library built without a hitch and installed in
+/usr/local as the default (/usr/local/lib, /usr/local/include,
+and /usr/local/info). A clean build of PDL should pick it up.
+
+NOTE: if problems see REBASEALL below.
+
+
+
+=================================================================
+ PGPLOT
+=================================================================
+NOTE: cygwin 1.7.9 has new include locations so the following
+ will not work without changing the various paths!!
+
+1. build the pgplot library and install.
+
+ Download from http://astro.caltech.edu/~tjp/pgplot
+
+ # Extract the archive file into a source location, I used ~/
+ $ tar xzf pgplot5.2.tar.gz
+ $ cd ~/pgplot
+
+ # Make an install directory, this is a typical default location
+ $ mkdir /usr/local/pgplot
+
+ $ cp drivers.list /usr/local/pgplot/
+ $ cd /usr/local/pgplot
+ $ vi drivers.list
+
+ Edit drivers.list to enable the drivers you wish but
+ uncommenting desired drivers by removing the leading ! on the
+ line. Here are the ones I used (see PDL/cygwin/driver.list):
+
+ $ grep -v '^!' drivers.list
+ LXDRIV 0 /LATEX LaTeX picture environment
+ NUDRIV 0 /NULL Null device (no output) Std F77
+ PPDRIV 1 /PPM Portable Pixel Map file, landscape
+ PPDRIV 2 /VPPM Portable PIxel Map file, portrait
+ PSDRIV 1 /PS PostScript printers, monochrome, landscape Std F77
+ PSDRIV 2 /VPS Postscript printers, monochrome, portrait Std F77
+ PSDRIV 3 /CPS PostScript printers, color, landscape Std F77
+ PSDRIV 4 /VCPS PostScript printers, color, portrait Std F77
+ TTDRIV 5 /XTERM XTERM Tektronix terminal emulator Std F77
+ WDDRIV 1 /WD X Window dump file, landscape
+ WDDRIV 2 /VWD X Window dump file, portrait
+ XWDRIV 1 /XWINDOW Workstations running X Window System C
+ XWDRIV 2 /XSERVE Persistent window on X Window System C
+
+ Edit the sys_cygwin configuration file to work with the
+ current version of cygwin. (TBD, update this file and pass on
+ to pgplot distribution for inclusion, for now see
+ PDL/cygwin/g77_gcc.conf)
+
+ $ vi sys_cygwin/g77_gcc.conf
+
+ # This diff command shows the lines that need changing
+ $ diff g77_gcc.conf*
+ 12c12
+ < XINCL="-I/usr/X11R6/include"
+ ---
+ > XINCL="-I/usr/X11R6.4/include"
+ 48c48
+ < FFLAGD="-fno-backslash -I/usr/include"
+ ---
+ > FFLAGD="-fno-backslash"
+ 58c58
+ < CFLAGC="-DPG_PPU -O2 -DNOMALLOCH -I. -I/usr/include"
+ ---
+ > CFLAGC="-DPG_PPU -O2 -DNOMALLOCH -I."
+ 75c75
+ < LIBS="-L/usr/X11R6/lib -lX11 -lpng -lz"
+ ---
+ > LIBS="-L/usr/X11R6.4/lib -lX11"
+
+ $ ~/pgplot/makemake ~/pgplot cygwin
+ $ make
+ $ make clean
+ $ make cpg
+ $ PGPLOT_DIR="/usr/local/pgplot/"; export PGPLOT_DIR
+
+ Be sure to add PGPLOT_DIR to your environment and add it to
+ your PATH as well. Now we can build the PGPLOT module for
+ perl. Download from www.cpan.org if needed.
+
+2. Now install the PGPLOT perl module. This is used by
+ PDL::Graphics::PGPLOT.
+
+ $ tar xzf PGPLOT-2.19.tar.gz
+ $ cd PGPLOT-2.19
+
+ # Be sure to set the environment!
+ $ export PGPLOT_DIR=/usr/local/pgplot
+ $ export PATH=$PGPLOT_DIR:$PATH
+
+ $ perl Makefile.PL
+
+ Hand edit the Makefile generated by Makefile.PL and correct
+ the link line (TBD: fix the Makefile.PL build process and
+ propagate cygwin fixes back to the module author. Sorry,
+ you'll have to edit this one).
+
+ $ vi Makefile
+
+ Edit the EXTRALIBS = ... and LDLOADLIBS = ... lines to change
+ "-lpgplot -lcpgplot" to "-lcpgplot -lpgplot -lpng -lz"
+
+ The first part of the modified lines look like this:
+
+ EXTRALIBS = -L/usr/X11R6/lib -L/usr/local/pgplot -lcpgplot -lpgplot -lpng -lz -lX11 ...
+ LDLOADLIBS = -L/usr/X11R6/lib -L/usr/local/pgplot -lcpgplot -lpgplot -lpng -lz -lX11 ...
+
+ Build it now:
+
+ $ make
+
+ # Lots of tests!
+ $ make test
+
+ $ make install
+
+ pgplot library is installed and working. PGPLOT module is
+ installed and working.
+
+3. Build PDL configured to use PGPLOT (in perldl.conf file).
+ If your pgplot installation worked, it should be picked up
+ automatically.
+
+NOTE: if problems see REBASEALL below.
+
+
+
+=================================================================
+ FFMPEG
+=================================================================
+ffmpeg later than 0.6.1 (i.e, gotten by git clone of
+the ffmpeg.git repository) builds out-of-the-box with
+the standard directions on cygwin 1.7.7+. You'll need
+the latest version because of a namespace conflict with
+the bswap_16, bswap_32, and bswap_64 macros. See
+this page for the git clone information:
+
+ http://ffmpeg.org/download.html
+
+An alternative is to download the latest GIT snapshot
+following these directions. You'll need to have the
+various dependencies for ffmpeg install to build
+successfully. A full cygwin install should work.
+
+(1) Download the git snapshot of the ffmpeg tree from:
+ http://git.videolan.org/?p=ffmpeg.git;a=snapshot;h=HEAD;sf=tgz
+
+(2) The file will be named something like ffmpeg-HEAD-xxxxxxx.tar.gz
+ where the xxxxxxx is a hexadecimal number related to the commit.
+ Extract the tar file and change to that directory:
+
+ bash$ tar xzf ffmpeg-HEAD-xxxxxxx.tar.gz
+ bash$ cd ffmpeg-HEAD-xxxxxxx/
+
+(3) Configure, build, and install ffmpeg:
+
+ bash$ ./configure --enable-static --disable-shared
+ bash$ make # build
+ bash$ make check # test
+ bash$ make install # install
+
+ bash$ type ffmpeg # check install
+ ffmpeg is /usr/local/bin/ffmpeg
+
+(4) Now you should be able to run the wmpeg.pl demo
+ in Example/IO of the PDL source distribution
+ directory. If the check install does not work,
+ check that /usr/local/bin (or wherever the ffmpeg
+ installed) is in the PATH.
+
+NOTE: wmpeg('file.gif') can be used to generate
+an uncompressed GIF animation (BIG!). You can
+build/install gifsicle on cygwin with the default
+instructions to use to optimize the memory usage of
+the GIF animations. See the gifsicle site for the
+source and build instructions:
+
+ http://www.lcdf.org/gifsicle/
+
+
+
+=================================================================
+ REBASEALL
+=================================================================
+There is a known issue on cygwin where DLLs have to have their
+base addresses fixed so that runtime conflicts do not occur. The
+problems occur for the external modules and their interfaces using
+DLLs. Specifically, the DLLs in /usr/lib/perl5 and the DLLs in
+the PLplot bin directory at least. The usual sign for this is
+that some tests fail mysteriously. If you run the failing test
+by hand (for example):
+
+ perl -Mblib t/plplot.t
+
+You may see no error but only 1 test run or even a message saying
+that the test failed before generating any output. If so, you'll
+need to run rebaseall:
+
+ 0. Generate a list of additional DLLs to check:
+
+ find /usr/lib/perl5 /usr/bin /usr/local /pdl_build_dir/blib -iname '*.dll' > /bin/fixit.list
+
+ 1. Exit all cygwin processes, windows, shells, X server,...
+
+ 2. Start up a windows CMD shell window (Start->Run cmd)
+
+ 3. cd to the cygwin /bin directory (cd c:\cygwin\bin by default)
+
+ 4. Run ash in that directory (ash)
+
+ 5. Run rebaseall (./rebaseall -T fixit.list)
+
+ Note that we created the fixit.list file in the c:\cygwin\bin
+ folder to begin with. If you put it elsewhere, you'll need
+ to use the appropriate pathnames.
+
+ 6. Run peflagsall (./peflagsall -T fixit.list)
+
+ 7. Restart cygwin
+
+After the rebaseall command has completed, you should be able to
+start up X windows and rerun the failed tests (perl -Mblib t/testname.t)
+or all tests (make test).
+
+NOTE: From the cygwin-xfree mailing list:
+
+> Also, I've found that using a different base address with rebaseall
+> seems to help with some X problems:
+>
+> dash -c "rebaseall -b 0x77000000"
+>
+> http://cygwin.com/ml/cygwin/2011-04/msg00306.html
+>
+> cgf
+
+
+
+
+=================================================================
+ PLplot
+=================================================================
+TBD
+
+
+
+=================================================================
+ HDF
+=================================================================
+TBD
+
+
+
+=================================================================
+ NDF
+=================================================================
+TBD
+
+
+
diff --git a/cygwin/README b/cygwin/README
new file mode 100644
index 0000000..ace0fc2
--- /dev/null
+++ b/cygwin/README
@@ -0,0 +1,119 @@
+Created on: Thu 27 Jul 2006 09:43:26 PM
+Last saved: Mon 09 Jan 2012 09:44:26 AM
+
+=================================================================
+ Overview
+=================================================================
+This directory contains supplemental build information to
+configure and install PDL on a windows system with the cygwin
+toolset (http://www.cygwin.com).
+
+The cygwin library provides the missing unix/posix functionality
+to allow unix applications to be more easily ported to windows.
+A windows PC with cygwin looks like different flavor of unix.
+Since cygwin looks like a unix, [almost] all of the standard
+perl functionality works and PDL can build pretty much as it
+does on other unix systems.
+
+See the INSTALL file for instructions on building and
+installing PDL on cygwin and for notes on building the external
+dependencies.
+
+See the PDL/win32 subdirectory for instructions on building a
+native windows PDL.
+
+
+
+=================================================================
+ WORKING
+=================================================================
+The cygwin PDL includes all the base PDL functionality
+including bad values support (if configured) as well as the
+following modules which depend on the presence of various
+external dependencies:
+
+ PDL::FFTW
+ (Builds if FFTW version 2 has been hand built and installed,
+ cygwin Setup.exe only provides FFTW version 3).
+
+ PDL::Graphics::PGPLOT
+ (Builds if the FORTRAN pgplot library has been hand built
+ and installed, and if the *Perl* PGPLOT module is installed
+ and FORTRAN)
+
+ PDL::Graphics::TriD
+ (Builds automatically if you have X11 and OpenGL + FreeGLUT
+ installed).
+
+ PDL::GSL::*
+ PDL::GSLSF::*
+ (Builds if GSL is installed via cygwin Setup.exe)
+
+ PDL::IO::GD
+ (Builds if the gd lib is installed via cygwin Setup.exe)
+
+ PDL::GIS::Proj
+ PDL::Transform::Proj4
+ (Builds if the PROJ4 lib is installed via cygwin Setup.exe)
+
+ PDL::Minuit
+ (Builds if ExtUtils::F77 has been installed and FORTRAN)
+
+ PDL::Slatec
+ (Builds if ExtUtils::F77 has been installed.
+ Needs a FORTRAN compiler.)
+
+ PDL::IO::Browser
+ (Build may pass if enabled, disabled by default for all OSes)
+
+ pdl2
+ (Installed by default. To use the new features, you
+ will need to install Devel::REPL and one of either
+ Term::ReadLine::Perl or Term::ReadLine::Gnu. The Gnu
+ flavor is currently recommended for cygwin.)
+
+and also
+
+ PDL::ParallelCPU
+ (Parallel pthread support will build and install by default
+ since the cygwin DLL includes POSIX threads)
+
+
+
+=================================================================
+ GRAPHICS (non-CORE DISTRIBUTION)
+=================================================================
+These graphics modules are known to work but are not in the
+core PDL distribution. You'll need to install from CPAN
+separately:
+
+ PDL::Graphics::Gnuplot Needs the gnuplot executable
+
+ PDL::Graphics::Prima Install Prima and PDL::Graphics::Prima
+ via the cpan shells cpan, cpanm...
+ Give interactive plotting support and
+ a full GUI toolkit that can be used to
+ implement graphical perl/PDL/Prima apps.
+
+
+
+=================================================================
+ NOT WORKING
+=================================================================
+These modules with external dependencies are not yet available
+for cygwin:
+
+ PDL::Graphics::IIS
+
+ PDL::Graphics::PLplot (PLplot and the PDL module support
+ is not working out of the box. If
+ you get plplot built and installed
+ for cygwin with PDL, let us know!)
+
+ PDL::IO::HDF (HDF4 has not been ported to cygwin
+ but HDF5 is available via the cygwin
+ setup program. PDL::IO::HDF5 fails
+ to build due to unix/linux specific
+ library detection for libhdf5)
+
+ PDL::IO::NDF (NDF has not been ported to cygwin)
diff --git a/cygwin/drivers.list b/cygwin/drivers.list
new file mode 100644
index 0000000..614dba4
--- /dev/null
+++ b/cygwin/drivers.list
@@ -0,0 +1,114 @@
+! PGPLOT drivers.
+!------------------------------------------------------------------------------
+! To configure PGPLOT, ensure that drivers you do not want are
+! commented out (place ! in column 1). N.B. Many device-drivers are
+! available on selected operating systems only.
+!------------------------------------------------------------------------------
+! File Code Description Restrictions
+! BCDRIV 0 /BCANON Canon Laser printer (bitmap version), landscape
+! CADRIV 0 /CANON Canon Laser printer, LBP-8/A2, landscape
+! CCDRIV 0 /CCP DEC LJ250 Color Companion printer
+! CGDRIV 1 /CGM CGM metafile, indexed colour selection C
+! CGDRIV 2 /CGMD CGM metafile, direct colour selection C
+! CWDRIV 0 /CW6320 Gould/Bryans Colourwriter 6320 pen plotter Std F77
+! EPDRIV 0 /EPSON Epson FX100 dot matrix printer
+! EXDRIV 1 /EXCL Talaris/EXCL printers, landscape
+! EXDRIV 2 /EXCL Talaris/EXCL printers, portrait
+! GCDRIV 0 /GENICOM Genicom 4410 dot-matrix printer, landscape
+! Caution: use of GIDRIV may require a license from Unisys:
+! GIDRIV 1 /GIF GIF-format file, landscape
+! GIDRIV 2 /VGIF GIF-format file, portrait
+! GLDRIV 1 /HPGL Hewlett-Packard HP-GL plotters, landscape Std F77
+! GLDRIV 2 /VHPGL Hewlett-Packard HP-GL plotters, portrait Std F77
+! GODRIV 0 /GOC GOC Sigma T5670 terminal VMS
+! GVDRIV 0 /GVENICOM Genicom 4410 dot-matrix printer, portrait
+! HGDRIV 0 /HPGL2 Hewlett-Packard graphics language
+! HIDRIV 0 /HIDMP Houston Instruments HIDMP pen plotter
+! HJDRIV 0 /HJ Hewlett-Packard Desk/Laserjet printer
+! HPDRIV 0 /HP7221 Hewlett-Packard HP7221 pen plotter Std F77
+! LADRIV 0 /LA50 Dec LA50 and other sixel printers
+! LJDRIV 0 /LJ Hewlett-Packard LaserJet printers VMS
+! LSDRIV 1 /LIPS2 Canon LaserShot printer (landscape)
+! LSDRIV 2 /VLIPS2 Canon LaserShot printer (portrait)
+! LNDRIV 0 /LN03 Dec LN03-PLUS Laser printer (landscape) VMS
+! LVDRIV 0 /LVN03 Dec LN03-PLUS Laser printer (portrait) VMS
+ LXDRIV 0 /LATEX LaTeX picture environment
+! MFDRIV 0 /FILE PGPLOT graphics metafile
+! NEDRIV 0 /NEXT Computers running NeXTstep operating system
+ NUDRIV 0 /NULL Null device (no output) Std F77
+! PGDRIV 0 /PGMF PGPLOT metafile (new format, experimental) Std F77
+! PNDRIV 1 /PNG Portable Network Graphics file C
+! PNDRIV 2 /TPNG Portable Network Graphics file - transparent background C
+ PPDRIV 1 /PPM Portable Pixel Map file, landscape
+ PPDRIV 2 /VPPM Portable PIxel Map file, portrait
+ PSDRIV 1 /PS PostScript printers, monochrome, landscape Std F77
+ PSDRIV 2 /VPS Postscript printers, monochrome, portrait Std F77
+ PSDRIV 3 /CPS PostScript printers, color, landscape Std F77
+ PSDRIV 4 /VCPS PostScript printers, color, portrait Std F77
+! PXDRIV 0 /PRINTRONI Printronix P300 or P600 dot-matrix printer
+! QMDRIV 1 /QMS QUIC devices (QMS and Talaris), landscape Std F77
+! QMDRIV 2 /VQMS QUIC devices (QMS and Talaris), portrait Std F77
+! TFDRIV 0 /TFILE Tektronix-format disk file VMS
+! TODRIV 0 /TOSHIBA Toshiba "3-in-one" printer, model P351
+! TTDRIV 1 /TEK4010 Tektronix 4006/4010 storage-tube terminal Std F77
+! TTDRIV 2 /GF GraphOn terminal Std F77
+! TTDRIV 3 /RETRO RetroGraphics terminal Std F77
+! TTDRIV 4 /GTERM GTERM Tektronix terminal emulator Std F77
+ TTDRIV 5 /XTERM XTERM Tektronix terminal emulator Std F77
+! TTDRIV 6 /ZSTEM ZSTEM terminal emulator Std F77
+! TTDRIV 7 /V603 Visual 603 terminal Std F77
+! TTDRIV 8 /KRM3 Kermit 3 on IBM-PC Std F77
+! TTDRIV 9 /TK4100 Tektronix 4100-series terminals Std F77
+! TTDRIV 10 /VMAC Macintosh VersaTerm-PRO Tektronix-4105 emulator Std F77
+! TXDRIV 0 /TX TeX PK Font Output files
+! VADRIV 0 /VCANON Canon Laser printer, LBP-8/A2, portrait
+! VBDRIV 0 /VBCANON Canon Laser printer (bitmap version), portrait
+! VTDRIV 0 /VT125 Dec Regis terminals (VT125 etc.) Std F77
+ WDDRIV 1 /WD X Window dump file, landscape
+ WDDRIV 2 /VWD X Window dump file, portrait
+! WSDRIV 0 /WS VAX workstations running VWS software VMS
+! X2DRIV 0 /XDISP PGDISP or FIGDISP server for X workstations C
+ XWDRIV 1 /XWINDOW Workstations running X Window System C
+ XWDRIV 2 /XSERVE Persistent window on X Window System C
+! ZEDRIV 0 /ZETA Zeta 8 Digital Plotter
+!
+! The following drivers can only be used in PGPLOT installations on MS-DOS
+! systems with appropriate hardware and software. Do not select these
+! on UNIX or VMS systems.
+!
+! LHDRIV 0 /LH IBM PCs and clones, Lahey F77 32-bit Fortran v5.0
+! MSDRIV 0 /MSOFT IBM PCs and clones running Microsoft Fortran 5.0
+! SSDRIV 0 /SS IBM PCs and clones, MS-DOS, Salford Software FTN
+!
+! The following driver can only be used in PGPLOT installations on Acorn
+! Archimedes systems with appropriate hardware and software.
+!
+! ACDRIV 0 /ARC Acorn Archimedes computer
+!
+! Selection of the XMOTIF driver causes a stub driver to be placed in
+! the main PGPLOT library. The real driver is placed in libXmPgplot.a.
+! Applications that need the Motif driver should link with libXmPgplot.a
+! before the PGPLOT library. This treatment means that only Motif
+! applications have to be linked with Motif libraries.
+!
+! XMDRIV 0 /XMOTIF Motif applications containing XmPgplot widgets. C
+!
+! Selection of the XATHENA driver causes a stub driver to be placed in
+! the main PGPLOT library. The real driver is placed in libXawPgplot.a.
+! Applications that need the Athena driver should link with libXawPgplot.a
+! before the PGPLOT library. This treatment means that only Athena
+! applications have to be linked with Xaw libraries.
+!
+! XADRIV 0 /XATHENA Motif applications containing XaPgplot widgets. C
+!
+! Selection of the TK driver causes a stub driver to be placed in
+! the main PGPLOT library. The real driver is placed in libtkpgplot.a.
+! Applications that need the Tk driver should link with libtkpgplot.a
+! before the PGPLOT library. This treatment means that only Tcl/Tk
+! applications have to be linked with the Tcl and Tk libraries.
+!
+! TKDRIV 0 /XTK X-window Tcl/Tk programs with pgplot widgets. C
+!
+! The following driver is included solely for use by the aips++ team.
+!
+! RVDRIV 0 /XRV X-window Rivet/Tk programs with pgplot widgets. C
diff --git a/cygwin/g77_gcc.conf b/cygwin/g77_gcc.conf
new file mode 100644
index 0000000..3f42f4f
--- /dev/null
+++ b/cygwin/g77_gcc.conf
@@ -0,0 +1,135 @@
+# Cygnus cygwin32 b19 using
+# GNU g77 FORTRAN compiler
+# Gnu gcc C compiler.
+#
+# David Billinghurst (David.Billinghurst at riotinto.com.au)
+#-----------------------------------------------------------------------
+
+# Optional: Needed by XWDRIV (/xwindow and /xserve) and
+# X2DRIV (/xdisp and /figdisp).
+# The arguments needed by the C compiler to locate X-window include files.
+
+ XINCL="-I/usr/X11R6/include"
+
+# Optional: Needed by XMDRIV (/xmotif).
+# The arguments needed by the C compiler to locate Motif, Xt and
+# X-window include files.
+
+ MOTIF_INCL="$XINCL"
+
+# Optional: Needed by TKDRIV (/xtk).
+# The arguments needed by the C compiler to locate Tcl, Tk and
+# X-window include files.
+
+ TK_INCL="$XINCL "
+
+# Optional: Needed by RVDRIV (/xrv).
+# The arguments needed by the C compiler to locate Rivet, Tcl, Tk and
+# X-window include files.
+
+ RV_INCL=""
+
+# Mandatory.
+# The FORTRAN compiler to use.
+
+ FCOMPL="g77"
+
+# Mandatory.
+# The FORTRAN compiler flags to use when compiling the pgplot library.
+# (NB. makemake prepends -c to $FFLAGC where needed)
+
+ FFLAGC="-Wall -O2"
+
+# Mandatory.
+# The FORTRAN compiler flags to use when compiling fortran demo programs.
+# This may need to include a flag to tell the compiler not to treat
+# backslash characters as C-style escape sequences
+
+ FFLAGD="-fno-backslash -I/usr/include"
+
+# Mandatory.
+# The C compiler to use.
+
+ CCOMPL="gcc"
+
+# Mandatory.
+# The C compiler flags to use when compiling the pgplot library.
+
+ CFLAGC="-DPG_PPU -O2 -DNOMALLOCH -I. -I/usr/include"
+
+# Mandatory.
+# The C compiler flags to use when compiling C demo programs.
+
+ CFLAGD="-Wall -O2"
+
+# Optional: Only needed if the cpgplot library is to be compiled.
+# The flags to use when running pgbind to create the C pgplot wrapper
+# library. (See pgplot/cpg/pgbind.usage)
+
+ PGBIND_FLAGS="bsd"
+
+# Mandatory.
+# The library-specification flags to use when linking normal pgplot
+# demo programs.
+
+ LIBS="-L/usr/X11R6/lib -lX11 -lpng -lz"
+
+# Optional: Needed by XMDRIV (/xmotif).
+# The library-specification flags to use when linking motif
+# demo programs.
+
+ MOTIF_LIBS="-lXm -lXt "
+
+# Optional: Needed by TKDRIV (/xtk).
+# The library-specification flags to use when linking Tk demo programs.
+# Note that you may need to append version numbers to -ltk and -ltcl.
+
+ TK_LIBS="-ltk -ltcl -ldl"
+
+# Mandatory.
+# On systems that have a ranlib utility, put "ranlib" here. On other
+# systems put ":" here (Colon is the Bourne-shell do-nothing command).
+
+ RANLIB="ranlib"
+
+# Optional: Needed on systems that support shared libraries.
+# The name to give the shared pgplot library.
+
+ SHARED_LIB=""
+
+# Optional: Needed if SHARED_LIB is set.
+# How to create a shared library from a trailing list of object files.
+
+ SHARED_LD=""
+
+# Optional:
+# On systems such as Solaris 2.x, that allow specification of the
+# libraries that a shared library needs to be linked with when a
+# program that uses it is run, this variable should contain the
+# library-specification flags used to specify these libraries to
+# $SHARED_LD
+
+ SHARED_LIB_LIBS=""
+
+# Optional:
+# Compiler name used on Next systems to compile objective-C files.
+
+ MCOMPL=""
+
+# Optional:
+# Compiler flags used with MCOMPL when compiling objective-C files.
+
+ MFLAGC=""
+
+# Optional: (Actually mandatory, but already defined by makemake).
+# Where to look for any system-specific versions of the files in
+# pgplot/sys. Before evaluating this script, makemake sets SYSDIR to
+# /wherever/pgplot/sys_$OS, where $OS is the operating-system name
+# given by the second command-line argument of makemake. If the
+# present configuration is one of many for this OS, and it needs
+# different modifications to files in pgplot/sys than the other
+# configurations, then you should create a subdirectory of SYSDIR,
+# place the modified files in it and change the following line to
+# $SYSDIR="$SYSDIR/subdirectory_name".
+
+ SYSDIR="$SYSDIR"
diff --git a/debian/README.Debian b/debian/README.Debian
new file mode 100644
index 0000000..d0af062
--- /dev/null
+++ b/debian/README.Debian
@@ -0,0 +1,16 @@
+pdl for Debian
+--------------
+
+ pdl or perlDL
+ pdl is the perl data language. Try "man PDL", or , for more man pages,
+ "man -k PDL". Html documents are found in /usr/share/doc/pdl/html/.
+
+ For some examples on how to use PDL::Graphics::PLplot for plotting, install
+ libplplot-dev and take a look at the perl/pdl examples in
+ /usr/share/doc/libplplot-dev/examples/perl
+
+ More information can be found at:
+ http://pdl.perl.org/
+
+ -- John Lapeyre <lapeyre at homey.physics.arizona.edu>, Fri, 16 Jan 1998 02:56:53 -0700
+ -- Henning Glawe <glaweh at debian.org>, Sun, 9 Jan 2005 15:34:57 +0100
diff --git a/debian/changelog b/debian/changelog
new file mode 100644
index 0000000..998cee5
--- /dev/null
+++ b/debian/changelog
@@ -0,0 +1,680 @@
+pdl (1:2.4.11-4) unstable; urgency=low
+
+ * fix pdl versioned dep in dh_pdl
+
+ -- Henning Glawe <glaweh at debian.org> Wed, 30 May 2012 16:06:03 +0200
+
+pdl (1:2.4.11-3) unstable; urgency=low
+
+ * fix the building of pdl wrapper
+ * set -fPIC when compiling fortran extensions
+
+ -- Henning Glawe <glaweh at debian.org> Mon, 28 May 2012 20:44:46 +0200
+
+pdl (1:2.4.11-2) unstable; urgency=low
+
+ * fix calls to croak in Lib/GIS/Proj/Proj.pd and IO/GD/GD.pd (croak was
+ not called with a format string literal, causing
+ -Werror=format-security to abort the compilation)
+
+ -- Henning Glawe <glaweh at debian.org> Sun, 27 May 2012 16:01:22 +0200
+
+pdl (1:2.4.11-1) unstable; urgency=low
+
+ * new upstream release
+ * acknowledge NMU (closes: #670693), thanks to Jari Aalto
+ * switch to 3.0 quilt packaging format, the +dfsg repackaging
+ of upstream source is not needed anymore
+ * provide pdlapi-$version virtual package to keep binary extension
+ modules from breaking silently
+ * introduce dh_pdl providing ${pdl:Depends} for extension packages
+ * use dpkg-buildflags in debian/rules to determine flags
+ * link with --as-needed to avoid spurious dependencies
+ * switch to dh_auto_configure to call EU::MM with the proper flags
+ * read LDFLAGS and FFLAGS in f77conf.pl from env
+ * depend on newer dpkg-dev due to buildflags options
+
+ -- Henning Glawe <glaweh at debian.org> Sat, 26 May 2012 10:30:55 +0200
+
+pdl (1:2.4.10+dfsg-1.1) unstable; urgency=low
+
+ * Non-maintainer upload.
+ * Remove deprecated dpatch and upgrade to packaging format "3.0 quilt".
+ * Update to Standards-Version to 3.9.3 and debhelper to 9.
+ * Add build-arch and build-indep targets; use dh_prep in rules file.
+ * Fix copyright-refers-to-symlink-license (Lintian).
+ * Fix duplicate-in-relation-field libastro-fits-header-perl (Lintian).
+ * Fix unused-override (Lintian).
+
+ -- Jari Aalto <jari.aalto at cante.net> Sat, 28 Apr 2012 08:44:59 +0300
+
+pdl (1:2.4.10+dfsg-1) unstable; urgency=low
+
+ * new upstream release
+ * sync debian/perldl.conf with perldl.conf
+
+ -- Henning Glawe <glaweh at debian.org> Sun, 19 Feb 2012 10:42:56 +0100
+
+pdl (1:2.4.7+dfsg-2) unstable; urgency=low
+
+ * remove left-over file 'test.log', which slipped into the 1:2.4.7+dfsg-1
+ debian diff
+ * include upstream release notes in deb
+ * fix Pod of PDL::IO::FastRaw
+ * add lintian override: it is OK to have dpatch dependency with an empty
+ patch list. Usually I am adding fixes as dpatch patches, and it is useless
+ to add/remove the dpatch support in case there are no patches for one
+ particular revision.
+ * add a lintian override for a long code line in a manpage, which cannot be
+ easily broken
+
+ -- Henning Glawe <glaweh at debian.org> Sun, 22 Aug 2010 21:19:32 +0200
+
+pdl (1:2.4.7+dfsg-1) unstable; urgency=low
+
+ * new upstream version
+ - much improved documentation (closes: #132900)
+ * build-depend on netpbm (improves testsuite runs)
+ * build-depend on proj-bin (alternatively with proj) to have 'proj'
+ command available
+ * build-depend and suggest libdevel-repl-perl (for new pdl2 shell)
+ * update debian standards-version to 3.9.1 (no further changes needed)
+ * improve test suite run output in build log
+
+ -- Henning Glawe <glaweh at debian.org> Thu, 19 Aug 2010 11:40:22 +0200
+
+pdl (1:2.4.6+dfsg-2) unstable; urgency=low
+
+ * pgperl is back in debian, name changed to libpgplot-perl; changed the
+ pdl recommends to reflect that (closes: #407463)
+
+ -- Henning Glawe <glaweh at debian.org> Tue, 11 May 2010 07:56:50 +0200
+
+pdl (1:2.4.6+dfsg-1) unstable; urgency=low
+
+ * fix paths in generated HTML docs
+ * add dpkg trigger for documentation index and HTML documentation updates
+ * add ${misc:Depends} to pdl's Depends (recommended by lintian due to
+ debhelper usage)
+ * use DESTDIR instead of PREFIX when installing (recommended by lintian,
+ as this works only due to a debian-specific MakeMake extension)
+ * bump (build-)dependency on libopengl-perl to 0.62
+ * update to standards-version 3.8.4
+ * build-depend on libhdf4-alt-dev (closes: #540404)
+ * modify hdf support build scripts to autodetect the 'alt'-flavour
+ * build-depend on libproj-dev (closes: #521822)
+ * move Homepage to Homepage control field and improve description
+ (closes: #574372)
+
+ -- Henning Glawe <glaweh at debian.org> Sat, 08 May 2010 17:10:16 +0200
+
+pdl (1:2.4.5+dfsg-2) unstable; urgency=low
+
+ * switch TriD from X11 to freeglut
+ * patch test suite to give more meaningful results
+ * repair f77config, link against libgfortran.so
+ * run testsuite in verbose mode to get more information
+ * build-depend and suggest ExtUtils::F77
+ * suggest Astro::FITS::Header
+
+ -- Henning Glawe <glaweh at debian.org> Mon, 09 Nov 2009 12:32:34 +0100
+
+pdl (1:2.4.5+dfsg-1) unstable; urgency=low
+
+ * new upstream release
+ * repacked upstream source without debian dir
+ * build-depend on sharutils to have uuencode/uudecode available for
+ test suite
+ * build-depend on libraries needed for the reworked TriD module
+ * remove maintainer script postrm, it was actually empty
+ * bump standards-version to 3.8.3
+ * bump debhelper compatibility level to 7
+ * generate html docs and doc index in /var/lib/pdl
+ * put symlink to files in /var/lib/pdl into /usr/lib/perl5/PDL
+
+ -- Henning Glawe <glaweh at debian.org> Fri, 06 Nov 2009 21:45:44 +0000
+
+pdl (1:2.4.3-8) unstable; urgency=low
+
+ * add proper description to the dpatch pathes (6 lintian warnings)
+ * backport documentation 'apropos' search function from upstream cvs
+ (closes: #499758)
+ * remove empty manpage /usr/share/man/man3/PDL::PP.3pm (lintian warning)
+ * update standarts version to 3.8.0 (lintian warning)
+ * build-depend on x11proto-core-dev instead of x-dev (lintian error)
+ * remove libgl1 from Suggests; there is no 3d support presently
+ * bump readline Suggests: to Recommends:, as users are lost in
+ interactive mode without it
+ * Fix doc-base entry (Science/Mathematics instead of Apps/Math)
+ * suggest doc-base
+
+ -- Henning Glawe <glaweh at debian.org> Mon, 22 Sep 2008 09:42:25 +0200
+
+pdl (1:2.4.3-7) unstable; urgency=low
+
+ * patch upstream IO/Makefile.PL to also install Dicom IO module
+ (closes: #474751)
+ * disable opengl based PDL::Graphics::TriD, it is not working
+ with perl 5.10. this considerably lowers PDL's dependencies,
+ upstream does not yet have a solution for this problem
+ (closes: #495379)
+ * apply upstream patch for the pct() problem (closes: #488092)
+
+ -- Henning Glawe <glaweh at debian.org> Sat, 20 Sep 2008 13:44:57 +0200
+
+pdl (1:2.4.3-6) unstable; urgency=low
+
+ [ Rafael Laboissiere ]
+ * Switch from g77 to gfortran
+
+ [ Henning Glawe ]
+ * apply Rafael's patch (closes: #468637)
+
+ -- Henning Glawe <glaweh at debian.org> Tue, 4 Mar 2008 09:05:08 +0100
+
+pdl (1:2.4.3-4) unstable; urgency=low
+
+ * clean up leftover files not caught by pdl's distclean target
+ (closes: #424345)
+ * clearly state in PDL::Fit::Gaussian synopsis that PDL has to be loaded
+ first (closes: #379932)
+ * apply patch for uniqvec/qsortvec from upstream BTS (closes: #415426)
+ * encode Latin1 characters in POD documentation as roff
+ * postprocess the "reduce" manpage's NAME section to remove roff macros
+ (closes: #304217)
+ * remove misplaced whitespace characters from changelog
+ * fix the menu entry to reflect current menu policy
+ * add lintian override to ignore the missing html files; they are
+ generated in the postinst script, so lintian can not see them
+ * fix the gsl version check
+ * comment out the dump() calls in t/xvals.t test, as this seems to confuse
+ the test result parser
+ * rebuild for the ldbl128 transition (closes: #430319)
+
+ -- Henning Glawe <glaweh at debian.org> Tue, 16 Oct 2007 10:25:18 +0200
+
+pdl (1:2.4.3-3) unstable; urgency=low
+
+ * add -DGLvoid=void in the cpp call for setting up the OpenGL typemaps in
+ order to make PDL build with newer mesa versions (closes: #390122)
+
+ -- Henning Glawe <glaweh at debian.org> Mon, 9 Oct 2006 18:07:41 +0200
+
+pdl (1:2.4.3-2) unstable; urgency=low
+
+ * upstream: enhance the 64bit-excludelist for the flexraw-test
+ * let the build continue anyways if problems are found in the
+ testsuite, so its output is only informational
+
+ -- Henning Glawe <glaweh at debian.org> Mon, 25 Sep 2006 10:43:58 +0200
+
+pdl (1:2.4.3-1) unstable; urgency=low
+
+ * new upstream
+ * enable gd, proj and HDF support
+ * force-enable WITH_3D, as on debian autobuilders, there is no
+ $DISPLAY and therefore the autodetection does not work
+
+ -- Henning Glawe <glaweh at debian.org> Thu, 17 Aug 2006 12:27:03 +0200
+
+pdl (1:2.4.2-6) unstable; urgency=low
+
+ * Graphics::TriD did not compile anymore. Backport this module from HEAD.
+ * update standarts-version to 3.7.2
+ * build-depend on libxext-dev, as the TriD GL needs it
+ * incorporate OpenGL build fix from upstream BTS 1505132
+
+ -- Henning Glawe <glaweh at debian.org> Tue, 13 Jun 2006 10:14:39 +0200
+
+pdl (1:2.4.2-5) unstable; urgency=low
+
+ * add workaround for broken ExtUtils::MakeMaker in perl 5.8.8
+ (closes: #356975):
+ - as EU::MM generated Makefiles reference PERLRUN instead of PERLRUNINST,
+ explicitly "use blib;" in the BAD{,2}_demo.pm.PL
+
+ -- Henning Glawe <glaweh at debian.org> Fri, 2 Jun 2006 10:17:39 +0200
+
+pdl (1:2.4.2-4) unstable; urgency=low
+
+ * make the xlibs-dev transition for x.org 6.9 (closes: #346926):
+ - build-depending on x-dev should be enough according to
+ http://www.inutil.org/jmm/xlibs/xlibs-split-2005-11-15.tar-bz2
+ * Suggest libplplot-dev and tell about the PDL::Graphics::PLplot
+ examples it contains in pdl's README.Debian
+
+ -- Henning Glawe <glaweh at debian.org> Mon, 9 Jan 2006 09:15:31 +0100
+
+pdl (1:2.4.2-3) unstable; urgency=low
+
+ * change Build-dependencies to build with xorg (closes: #318258)
+ * add libinline-perl to suggests
+ * add perl readline modules to suggests
+
+ -- Henning Glawe <glaweh at debian.org> Thu, 14 Jul 2005 14:49:42 +0000
+
+pdl (1:2.4.2-2) unstable; urgency=low
+
+ * use dpatch for patch management
+ * split out Makefile clean target patch
+ * split out patch preventing the generation of an empty manpage pdl.1p
+ * get fix for transform.pd from cvs (problem reported on pdl mailing list)
+ * fix a second problem with PDL_Double used not in C code in transform.pd
+ * patch mkhtmldoc.pl to generate relative links instead of absolute ones;
+ absolute pathnames confused dhelp sometimes.
+ * move debhelper template in prerm up, so the doc-base remove call is done
+ before the dynamically generated html files are removed
+ * patch remove obsolete upstream debian files until these changes are
+ checked in.
+ * mention new pdl htmldoc location in README.Debian
+
+ -- Henning Glawe <glaweh at debian.org> Sun, 16 Jan 2005 18:42:29 +0100
+
+pdl (1:2.4.2-1) unstable; urgency=low
+
+ * new upstream release
+ * remove comment about not including m51.fits from debian/copyright
+ * re-import COPYING to debian/copyright
+ * include perldl.conf used in "official" package as debian/perldl.conf
+ * install Known_problems to docdir
+ * fix clean target in upstream makefiles
+ * use upstream makefile distclean target in debian/rules clean target
+ * fix description+synopsis
+ * remove references to obsolete websites from README
+ * rework packaging with debhelper
+ * build html docs in /usr/share/doc/pdl/html/PDL and install doc-base
+ entry for this
+ * remove lintian override, slatec is now built with -fPIC
+ * disable building of pdl.1p from pdl.PL, so the correct pdl.1p from
+ Basic/Pod/Intro.pod is included
+
+ -- Henning Glawe <glaweh at debian.org> Mon, 10 Jan 2005 15:59:25 +0100
+
+pdl (1:2.4.1-1) unstable; urgency=low
+
+ * new upstream release
+ * don't print debug info in preinst (Closes: #69978)
+ * enable bad value support, the impact should be minimal on modern
+ hardware (Closes: #113607)
+ * took plplot from PDL HEAD
+ * clean up doc index and html docs in prerm (Closes: #160034)
+
+ -- Henning Glawe <glaweh at debian.org> Thu, 22 Jul 2004 19:16:24 +0200
+
+pdl (1:2.4.0-1) unstable; urgency=low
+
+ * new maintainer (Closes: #215543)
+ * acknowlege NMU (Closes: #141117, #104630, #140104, #170182)
+ * new upstream release.
+ * enable plplot support (Closes: #196185)
+ * enable gsl support
+ * enable fftw support
+ * swap out m51.fits and COPYING, taken from PDL CVS HEAD (Closes: #223793)
+
+ -- Henning Glawe <glaweh at debian.org> Sat, 13 Dec 2003 22:25:41 +0100
+
+pdl (1:2.3.2-0.6) unstable; urgency=low
+
+ * NMU for xlib6g-dev dependency (Closes: #170182)
+
+ -- Joshua Kwan <joshk at triplehelix.org> Sat, 15 Mar 2003 16:55:39 -0800
+
+pdl (1:2.3.2-0.5) unstable; urgency=low
+
+ * NMU for perl 5.8. Set build-dependency to perl 5.8.
+ * debian/rules: moved prefix selection to installation time.
+
+ -- Josselin Mouette <joss at debian.org> Wed, 21 Aug 2002 22:39:24 +0200
+
+pdl (1:2.3.2-0.2) unstable; urgency=low
+
+ * Non-Maintainer Upload
+ * In postinst, specify path to /usr/bin/perl so that users with a conflicting
+ perl in /usr/local/bin do not get a blow-up. (Closes: #141117)
+ * (Note that the above change was made in debian/rules, NOT debian/postinst,
+ because of the very strange way the original maintainer made the
+ debian/postinst be auto-generated..)
+
+ -- Ben Gertzfield <che at debian.org> Mon, 8 Apr 2002 18:47:16 +0900
+
+pdl (1:2.3.2-0.1) unstable; urgency=low
+
+ * Non-Maintainer Upload
+ * Newest version needed to fix gimp-perl build problems (perl
+ segfaults on alpha otherwise).
+ * Use F77CONF=debian/f77conf.pl, signify hppa needed changes in
+ there instead of hacking Lib/Slatec/Makefile.PL .
+ * Include small patch to change $(INST_LIBDIR)/PDL to
+ $(INST_LIBDIR) in Basic/Gen/Makefile.PL (debian/rules has
+ a very long, strange find command that barfs if there are
+ multiple directories named PDL, and this looks like a typo
+ anyway)
+ * debian/rules was writing to file called "substvers", and
+ was missing a $ anyway when writing Perl depends substvars.
+ Commented out, added a call to dh_perl and tightened Build-Depends
+ on debhelper to (>= 3.0.18).
+ * Add call to dh_clean to clean up debhelper-generated files.
+
+ -- Ben Gertzfield <che at debian.org> Tue, 2 Apr 2002 22:07:56 +0900
+
+pdl (1:2.2.1-7.1) unstable; urgency=low
+
+ * Non-Maintainer Upload
+ * Fix to build on hppa, patch in BTS. Closes: #104630
+
+ -- Matt Taggart <taggart at debian.org> Wed, 5 Dec 2001 19:42:37 -0700
+
+pdl (1:2.2.1-7) unstable; urgency=low
+
+ * rebuild with dh_gencontrol instead of dpkg-gencontrol, new
+ perl policy seems to need this.
+ * include lintian override for non-pic code in Slatec.so
+ * include debian/all (build/check script) in source
+
+ -- Raul Miller <moth at debian.org> Sun, 26 Aug 2001 21:44:51 -0400
+
+pdl (1:2.2.1-6) unstable; urgency=low
+
+ * Introduced a build-depends on libextutils-f77-perl. [Which
+ breaks cross compilation since I've not released that package yet --
+ waiting on DFSG copyright, but allows building with slatec.]
+
+ -- Raul Miller <moth at debian.org> Sat, 9 Jun 2001 22:54:30 -0400
+
+pdl (1:2.2.1-5) unstable; urgency=low
+
+ * fix postinst.base -- postinst was missing set -e
+
+ -- Raul Miller <moth at debian.org> Fri, 25 May 2001 11:09:44 -0400
+
+pdl (1:2.2.1-4) unstable; urgency=low
+
+ * Ok, found out how to resolve $Config{version}.
+
+ -- Raul Miller <moth at debian.org> Fri, 25 May 2001 01:04:12 -0400
+
+pdl (1:2.2.1-3) unstable; urgency=low
+
+ * changed INSTALLDIRS=perl to INSTALLDIRS=vendor in debian/rules,
+ for the new perl policy, changed Build-Depends to match.
+ (fixes #95423)
+ * made other changes to debian/rules and debian/control as indicated
+ by this new policy. I hope the OPTIMIZE attribute doesn't hose PDL...
+ * FIXME: I've backed out compliance with 3.4.2 of the new perl policy:
+ "Binary modules must specify a dependency on either perl or
+ perl-base with a minimum version of the perl package used to
+ build the module, and must additionally depend on the expansion of
+ perlapi-$Config{version}."
+ This fails to indicate what context to use for that expansion. In
+ my initial tests, this broke the package, and `apt-cache search
+ perlapi` turns up nothing.
+
+ -- Raul Miller <moth at debian.org> Thu, 24 May 2001 14:01:33 -0400
+
+pdl (1:2.2.1-2) unstable; urgency=low
+
+ * replaced mesag-dev with xlibmesa-dev in build depends. (fixes #97508)
+ replaced mesag3 with libgl1 in depends.
+ * Rant: [None of this rant is immediately relevant to this version
+ of PDL, except through examining the implications of bug #97508.]
+ This whole "trash the old i/o-library interface" thing strikes
+ me as *really bad*. Interfaces should be treated as sacred,
+ and maintaining backwards compatibility is important for long term
+ system survivability. Basically, what we're saying here is that
+ these interfaces are immature, and people who built code against
+ the earlier (obsolete) libraries acted prematurely. Either that,
+ or we're saying that distributing binary packages for debian is
+ a mistake on the part of anyone outside of debian.
+ * I'm leaving the Build-Depends for libncurses-dev in the control file,
+ even though it's now a virutal package, to see if I get any bug
+ reports filed against pdl because of it (for the record, I'm using
+ version 5.2.20010318-1 of libncurses5-dev to build this instance).
+ * updated debian/rules (added prerm, minor cleanups)
+
+ -- Raul Miller <moth at debian.org> Mon, 21 May 2001 10:18:55 -0400
+
+pdl (1:2.2.1-1) unstable; urgency=low
+
+ * renamed directory from PDL-2.2.1 to pdl-2.2.1, and chmod +x debian/rules
+ (required so that dpkg-buildpackage works).
+ * changed Source-Depends: to Build-Depends: in control file, and restored
+ build dependency for libncurses-dev.
+ * restored debian/postinst.base and debian/prerm from debian 2.2
+
+ -- Raul Miller <moth at debian.org> Sun, 20 May 2001 22:14:49 -0400
+
+pdl (1:2.2.1-0) unstable; urgency=low
+
+ * new upstream release
+
+ -- PDL Porters <pdl-porters at jach.hawaii.edu> Tue, 24 Apr 2001 15:01:23 -0400
+
+pdl (1:2.2-2) unstable; urgency=low
+
+ * delete bogus debian.orig directory
+
+ -- Raul Miller <moth at debian.org> Wed, 14 Mar 2001 15:15:59 -0500
+
+pdl (1:2.2-1) unstable; urgency=medium
+
+ * new upstream release
+ * turned off make test because it has problems:
+ 1. requires an active X session (bad for autobuilders), and
+ 2. requires slatec (or linfit fails). [Can't support
+ slatec until ExtUtils::F77 is a debian package]
+ * bumped up urgency because old pdl doesn't support newest
+ perl, and some people consider that serious.
+
+ -- Raul Miller <moth at debian.org> Mon, 12 Mar 2001 20:51:12 -0500
+
+pdl (1:2.1.1-1) unstable; urgency=low
+
+ * reintroduced scantree.pl and mkhtmldoc to postinst (fixes
+ problem reported in private email by Dav Clark and Gordon Haverland
+ -- thanks).
+ * note: this version won't purge cleanly, as it creates a couple
+ files a postinst time which aren't removed even at purge time.
+ * got rid of bashisms from debian/rules
+ * translated /usr/doc to /usr/share/doc and /usr/man to /usr/share/man
+ * never released -- ignore epoch
+
+ -- Raul Miller <moth at debian.org> Mon, 20 Nov 2000 01:17:43 -0500
+
+pdl (2.1.1-0pre1) unstable; urgency=low
+
+ * new upstream version
+ * this is a pre-release, among other things, I'm waiting for xlib6g-dev
+ to stabilize. Please email me, personally, with any bug reports.
+ This is not an official release. Changes from the 2.1.1 sources on
+ sourceforge for this prerelease:
+ + chmod +x debian/rules
+ + this entry in debian/changelog
+ + editted copy of perldl.conf as debian/.perldl.conf (no -lMesa*)
+ + HOME=`pwd`/debian added to Makefile.PL part of debian/rules
+
+ -- Raul Miller <moth at debian.org> Sun, 19 Nov 2000 14:46:31 -0500
+
+pdl (2.005-2) frozen; urgency=medium
+
+ * Argh, forgot to fix t/gauss.t -- this is required
+ for Bug#55268 to really be fixed.
+
+ -- Raul Miller <moth at debian.org> Tue, 25 Apr 2000 13:45:28 -0400
+
+pdl (2.005-1) frozen; urgency=medium
+
+ * new bugfix upstream version
+ * two hacks: (1) disable #ifdef in Basic/Math/mconf.h which includes
+ <nan.h> on our linux alpha, (2) disable test which shows that guassian
+ doesn't work properly on our linux alpha. (Fixes Bug#55268)
+
+ -- Raul Miller <moth at debian.org> Mon, 17 Apr 2000 08:17:18 -0400
+
+pdl (2.003-1) unstable; urgency=low
+
+ * new upstream version
+
+ -- Raul Miller <moth at debian.org> Mon, 1 Nov 1999 07:16:55 -0500
+
+pdl (2.002-3) unstable; urgency=low
+
+ * new maintainer
+ * recreated source package, unpack in pdl-2.002 instead of PDL-2.002
+ [this oddity in source package accounts for earlier diff problems].
+ (Fixes #45771).
+ * do "make test" at build time
+ * removed suggests jpeg-progs, I can't find any such package
+ * removed suggests pgperl, there's a well labeled demo that fails
+ and that should be enough of a suggestion for people who would want
+ this non-free support. If there's demand, and if special compilation
+ support turns out to be needed, I supposed I'll have to create
+ a pdl-nonfree...
+
+ -- Raul Miller <moth at debian.org> Sun, 10 Oct 1999 19:20:09 -0400
+
+pdl (2.002-2) unstable; urgency=low
+
+ * added depends on libterm-readkey-perl
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Sun, 8 Aug 1999 14:25:39 -0700
+
+pdl (2.002-1) unstable; urgency=low
+
+ * New upstream
+ * Build with new perl 5.005 package
+ * fixes #40433 with workaround for error in Bessel functions in
+ libc6 2.1
+ * Fixes #36402, docs are now made at build time and are purged
+ with dpkg --purge. Also previous cruft from old versions is purged
+ in preinst.
+ * Fixes #38429, typo in Depends
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Fri, 25 Jun 1999 17:52:33 -0700
+
+pdl (2.001-1) unstable; urgency=low
+
+ * New upstream
+ * Add r-pdl code (merging r-pdl package)
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Wed, 21 Apr 1999 14:47:54 -0700
+
+pdl (2.0-2) unstable; urgency=low
+
+ * link with glibc 2.1.1
+ * add menu entry
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Thu, 25 Mar 1999 01:52:12 -0700
+
+pdl (2.0-1) unstable; urgency=low
+
+ * new upstream version
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Mon, 25 Jan 1999 16:59:48 -0700
+
+pdl (1.99988-5) unstable frozen; urgency=low
+
+ * html docs were put in wrong place.
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Tue, 8 Dec 1998 03:39:42 -0700
+
+pdl (1.99988-4) unstable frozen; urgency=low
+
+ * Some package (mesa?) change and broke the build
+ Add X11 include path by hand.
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Fri, 6 Nov 1998 22:03:17 -0700
+
+pdl (1.99988-3) unstable; urgency=low
+
+ * link against mesag3.
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Sun, 25 Oct 1998 01:32:34 -0700
+
+pdl (1.99988-2) unstable; urgency=low
+
+ * Make rules less i386-centric
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Tue, 6 Oct 1998 11:44:39 -0700
+
+pdl (1.99988-1) unstable; urgency=low
+
+ * New minor revision
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Fri, 2 Oct 1998 00:00:03 -0700
+
+pdl (1.99985-1) unstable; urgency=low
+
+ * New minor revision
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Fri, 31 Jul 1998 14:24:09 -0700
+
+pdl (1.9906-1) frozen unstable; urgency=low
+
+ * New minor revision
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Fri, 1 May 1998 15:29:16 -0700
+
+pdl (1.9905-1) unstable; urgency=low
+
+ * New minor revision
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Fri, 24 Apr 1998 16:17:42 -0700
+
+pdl (1.9904-1) unstable; urgency=low
+
+ * New minor revision
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Mon, 13 Apr 1998 13:45:34 -0700
+
+pdl (1.9902-2) unstable; urgency=low
+
+ * suggests mesag2 not mesa2
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Mon, 13 Apr 1998 13:45:34 -0700
+
+pdl (1.9902-1) unstable; urgency=low
+
+ * Upstream minor revision.
+ * Note doc lookup was still broken in 1.9901
+ * Changed architecture from i386 to any
+ * Fixed doc lookup, I hope
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Mon, 23 Mar 1998 15:31:34 -0700
+
+pdl (1.9901-2) unstable; urgency=low
+
+ * Fixed online doc lookup.
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Sat, 14 Mar 1998 18:21:28 -0700
+
+pdl (1.9901-1) unstable; urgency=low
+
+ * New upstream minor version including ...
+ * New Free license.
+ * Bug fixes, doc improvements
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Mon, 9 Mar 1998 12:53:32 -0700
+
+pdl (1.9900-1) non-free; urgency=low
+
+ * New upstream release
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Fri, 27 Feb 1998 16:42:27 -0700
+
+pdl (1.95.07-3) non-free; urgency=low
+
+ * removed perllocal.pod; only for local build
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Fri, 23 Jan 1998 22:04:49 -0700
+
+pdl (1.95.07-2) non-free; urgency=low
+
+ * existed a debstd bug; upgraded debstd and repackaged.
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Fri, 23 Jan 1998 21:09:05 -0700
+
+pdl (1.95.07-1) non-free; urgency=low
+
+ * Initial Release.
+
+ -- John Lapeyre <lapeyre at physics.arizona.edu> Fri, 16 Jan 1998 19:32:22 -0700
diff --git a/debian/compat b/debian/compat
new file mode 100644
index 0000000..ec63514
--- /dev/null
+++ b/debian/compat
@@ -0,0 +1 @@
+9
diff --git a/debian/control b/debian/control
new file mode 100644
index 0000000..a316ee4
--- /dev/null
+++ b/debian/control
@@ -0,0 +1,71 @@
+Source: pdl
+Section: math
+Priority: optional
+Maintainer: Henning Glawe <glaweh at debian.org>
+Standards-Version: 3.9.3
+Build-Depends:
+ gfortran,
+ dpkg-dev (>= 1.16.1~),
+ x11proto-core-dev,
+ libncurses-dev,
+ perl (>= 5.8.0-3),
+ debhelper (>= 9),
+ libplplot-dev,
+ libinline-perl (>= 0.43),
+ libgsl0-dev,
+ fftw-dev,
+ libxext-dev,
+ libhdf4-alt-dev | libhdf4g-dev,
+ libproj-dev | proj,
+ proj-bin | proj,
+ libgd2-xpm-dev,
+ libastro-fits-header-perl,
+ sharutils,
+ libopengl-perl (>= 0.65),
+ libxi-dev,
+ libxmu-dev,
+ freeglut3-dev,
+ libextutils-f77-perl,
+ netpbm,
+ libdevel-repl-perl (>=1.003011),
+ libtest-warn-perl
+Homepage: http://pdl.perl.org/
+
+Package: pdl
+Architecture: any
+Depends:
+ ${perl:Depends},
+ libterm-readkey-perl,
+ ${shlibs:Depends},
+ libopengl-perl (>=0.62),
+ ${misc:Depends}
+Recommends:
+ libterm-readline-gnu-perl | libterm-readline-perl-perl
+Suggests:
+ libpgplot-perl,
+ netpbm | imagemagick,
+ libastro-fits-header-perl,
+ libinline-perl,
+ libplplot-dev,
+ doc-base,
+ libextutils-f77-perl,
+ proj-bin | proj,
+ libdevel-repl-perl (>=1.003011)
+Conflicts: r-pdl
+Replaces: r-pdl
+Provides:
+ ${pdlapi:Provides}
+Description: perl data language: Perl extensions for numerics
+ PDL gives standard perl the ability to COMPACTLY
+ store and SPEEDILY manipulate the large N-dimensional data arrays
+ which are the bread and butter of scientific computing. The idea
+ is to turn perl in to a free, array-oriented, numerical language
+ in the same sense as commercial packages like IDL and MatLab. One
+ can write simple perl expressions to manipulate entire numerical arrays
+ all at once. For example, using PDL the perl variable $a can hold a
+ 1024x1024 floating point image, it only takes 4Mb of memory to store
+ it and expressions like $a=sqrt($a)+2 would manipulate the whole image
+ in a few seconds.
+ .
+ A simple interactive shell (perldl) is provided for command line use
+ together with a module (PDL) for use in perl scripts.
diff --git a/debian/copyright b/debian/copyright
new file mode 100644
index 0000000..09cfd2a
--- /dev/null
+++ b/debian/copyright
@@ -0,0 +1,75 @@
+This package was debianized by John Lapeyre lapeyre at physics.arizona.edu on
+Fri, 16 Jan 1998 02:56:53 -0700.
+
+Pdl source and information is available at
+http://pdl.perl.org/
+
+Following is the PDL copyright:
+
+ Copyright (c) 1997-2004 by the contributors named in the individual files.
+ All rights reserved. This distribution is free software; you can
+ redistribute it and/or modify it under the same terms as Perl itself.
+
+ The demonstration image m51.fits is derived from the Hubble Heritage
+ project archival images; its creation was funded in part by a grant
+ from NASA. The image is in the public domain.
+
+ Inline documentation in any module files (pod format) and documentation
+ files (.pod files) in this distribution are additionally protected by
+ the following statement:
+
+ Permission is granted for verbatim copying (and formatting) of this
+ documentation as part of the PDL distribution. Permission is granted to
+ freely distribute verbatim copies of this documentation only if
+ the following conditions are met: 1. that the copyright notice remains
+ intact 2. the original authors' names are clearly displayed, 3. that
+ any changes made to the documentation outside the official PDL
+ distribution (as released by the current release manager) are clearly
+ marked as such and 4. That this copyright notice is distributed with
+ the copied version so that it may be easily found.
+
+ All the files in the distribution should have a copyright notice
+ according to the following template:
+
+ Copyright (C) 199X Author1, Author2.
+ All rights reserved. There is no warranty. You are allowed
+ to redistribute this software / documentation as described
+ in the file COPYING in the PDL distribution.
+
+ In addition, the following disclaimers apply:
+
+ THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+ OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ ARE DISCLAIMED. IN NO EVENT SHALL THE CONTRIBUTORS BE LIABLE FOR ANY
+ DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+ IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
+ BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+ FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+ OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+ PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
+ EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+ THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS
+ WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+ WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+ REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR
+ DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL
+ DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM
+ (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED
+ INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF
+ THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER
+ OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+ On Debian GNU/Linux systems, the complete text of the GNU General
+ Public License can be found in `/usr/share/common-licenses/GPL-2' and
+ the Artistic Licence in `/usr/share/common-licenses/Artistic'.
diff --git a/debian/dh_pdl b/debian/dh_pdl
new file mode 100755
index 0000000..358f6cd
--- /dev/null
+++ b/debian/dh_pdl
@@ -0,0 +1,127 @@
+#!/usr/bin/perl -w
+
+=head1 NAME
+
+dh_pdl - calculates pdl dependencies
+
+=cut
+
+use strict;
+use Config;
+use File::Find;
+use Debian::Debhelper::Dh_Lib;
+use PDL::Config::Debian;
+
+=head1 SYNOPSIS
+
+B<dh_pdl> [S<I<debhelper options>>] [B<-d>] [S<I<library dirs ...>>]
+
+=head1 DESCRIPTION
+
+dh_pdl is a debhelper program that is responsible for generating
+the ${pdl:Depends} substitutions and adding them to substvars files.
+
+The program will look at perl scripts and modules in your package,
+and will use this information to generate a dependency on pdl or
+pdlapi. The dependency will be substituted into your package's control
+file wherever you place the token "${pdl:Depends}".
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-V>
+
+By default, scripts and architecture independent modules don't depend
+on any specific version of pdl. The -V option causes the current
+version of the pdl package to be specified.
+
+=item I<library dirs>
+
+If your package installs perl modules in non-standard
+directories, you can make dh_perl check those directories by passing their
+names on the command line. It will only check the vendorlib and vendorarch
+directories by default.
+
+=back
+
+=head1 CONFORMS TO
+
+Debian policy, version 3.8.3
+
+=cut
+
+init();
+
+my $vendorlib = substr $Config{vendorlib}, 1;
+my $vendorarch = substr $Config{vendorarch}, 1;
+
+# Cleaning the paths given on the command line
+foreach (@ARGV) {
+ s#/$##;
+ s#^/##;
+}
+
+my $pdl = 'pdl';
+my $version;
+
+# dependency types
+use constant PROGRAM => 1;
+use constant PM_MODULE => 2;
+use constant XS_MODULE => 4;
+
+foreach my $package (@{$dh{DOPACKAGES}}) {
+ my $tmp=tmpdir($package);
+
+ # Check also for alternate locations given on the command line
+ my @dirs = grep -d, map "$tmp/$_", $vendorlib, $vendorarch, @ARGV;
+
+ # Look for perl modules and check where they are installed
+ my $deps = 0;
+ find sub {
+ return unless -f;
+ $deps |= PM_MODULE if /\.pm$/;
+ $deps |= XS_MODULE if /\.so$/;
+ }, @dirs if @dirs;
+
+ # find scripts
+ find sub {
+ return unless -f and (-x or /\.pl$/);
+ return if $File::Find::dir=~/\/usr\/share\/doc\//;
+
+ local *F;
+ return unless open F, $_;
+ if (read F, local $_, 32 and m%^#!\s*(/usr/bin/perl|/usr/bin/env\s+perl)\s%) {
+ $deps |= PROGRAM;
+ }
+ close F;
+ }, $tmp;
+
+ if ($deps) {
+ my $version="";
+ if ($deps & XS_MODULE or $dh{V_FLAG_SET}) {
+ ($version) = `dpkg -s $pdl` =~ /^Version:\s*(\S+)/m
+ unless $version;
+ $version = ">= $version";
+ }
+
+ addsubstvar($package, "pdl:Depends", $pdl, $version);
+
+ # add pdlapi-<ver> for XS modules
+ addsubstvar($package, "pdl:Depends",
+ "pdlapi-$PDL::Config::Debian::pdl_core_version")
+ if $deps & XS_MODULE;
+ }
+}
+
+=head1 SEE ALSO
+
+L<debhelper(7)>
+
+=head1 AUTHOR
+
+Henning Glawe <glaweh at debian.org>
+
+Based on dh_perl by Brendan O'Dea <bod at debian.org>
+
+=cut
diff --git a/debian/f77conf.pl b/debian/f77conf.pl
new file mode 100644
index 0000000..d27f9ae
--- /dev/null
+++ b/debian/f77conf.pl
@@ -0,0 +1,67 @@
+package F77Conf;
+# a minimal hardcoded config designed for debian so that we don't need
+# ExtUtils::F77 when building PDL
+
+print "Config ",__PACKAGE__->config(),"\n";
+print "Compiler ",__PACKAGE__->compiler(),"\n";
+print "Runtime ",__PACKAGE__->runtime(),"\n";
+print "Trail_ ",__PACKAGE__->trail_() ? "yes" : "no", "\n";
+print "Cflags ",__PACKAGE__->cflags(),"\n";
+
+
+sub config {
+ return 'debian';
+}
+
+sub runtime {
+ my $libpath = `gfortran -print-libgcc-file-name`;
+ $libpath =~ s/libgcc[.]a$//;
+ chomp $libpath;
+ my $ldflags = '';
+ $ldflags .= $ENV{LDFLAGS} if (defined $ENV{LDFLAGS});
+ $ldflags .= " -L$libpath -lgcc -lgfortran";
+ return($ldflags);
+}
+
+sub trail_ {
+ return 1;
+}
+
+sub compiler {
+ return 'gfortran';
+}
+
+sub cflags {
+ my $fflags = '';
+ $fflags = $ENV{FFLAGS} if (defined $ENV{FFLAGS});
+ $fflags.=' -fPIC';
+ return($fflags);
+}
+
+sub testcompiler {
+ my ($this) = @_;
+ my $file = "/tmp/testf77$$";
+ my $ret;
+ open(OUT,">$file.f");
+ print OUT " print *, 'Hello World'\n";
+ print OUT " end\n";
+ close(OUT);
+ print "Compiling the test Fortran program...\n";
+ my ($compiler,$cflags) = ($this->compiler,$this->cflags);
+ system "$compiler $cflags $file.f -o ${file}_exe";
+ print "Executing the test program...\n";
+ if (`${file}_exe` ne " Hello World\n") {
+ print "Test of Fortran Compiler FAILED. \n";
+ print "Do not know how to compile Fortran on your system\n";
+ $ret=0;
+ }
+ else{
+ print "Congratulations you seem to have a working f77!\n";
+ $ret=1;
+ }
+ unlink("${file}_exe"); unlink("$file.f"); unlink("$file.o") if -e "$file.o";
+ return $ret;
+}
+
+1;
+
diff --git a/debian/fix_man_encoding.sed b/debian/fix_man_encoding.sed
new file mode 100644
index 0000000..cae6a0d
--- /dev/null
+++ b/debian/fix_man_encoding.sed
@@ -0,0 +1,2 @@
+s/Gr�gory/Gr\\['e]gory/g
+s/Halld�r/Halld\\['o]r/g
diff --git a/debian/fix_man_name.sed b/debian/fix_man_name.sed
new file mode 100644
index 0000000..dee57e4
--- /dev/null
+++ b/debian/fix_man_name.sed
@@ -0,0 +1,5 @@
+# HG: remove *roff special syntax from manpage's NAME section
+/.SH \"NAME\"/,+1 {
+s/\\f(CW\\\*(C`/"/g
+s/\\\*(C'\\fR/"/g
+}
diff --git a/debian/patches/series b/debian/patches/series
new file mode 100644
index 0000000..8b13789
--- /dev/null
+++ b/debian/patches/series
@@ -0,0 +1 @@
+
diff --git a/debian/pdl.dirs b/debian/pdl.dirs
new file mode 100644
index 0000000..921fdee
--- /dev/null
+++ b/debian/pdl.dirs
@@ -0,0 +1,3 @@
+usr/bin
+usr/share/lintian/overrides
+var/lib/pdl
diff --git a/debian/pdl.doc-base b/debian/pdl.doc-base
new file mode 100644
index 0000000..27d23ed
--- /dev/null
+++ b/debian/pdl.doc-base
@@ -0,0 +1,14 @@
+Document: pdl
+Title: PDL online manual
+Author: Various
+Abstract: Perl Data Language is an extension to perl for numerics.
+ It allows high-speed manipulation of multidimensional data arrays
+ and includes bindings to a lot of external libraries for data
+ processing and representation (plotting). This manual includes
+ both introductory documents and a command reference.
+Section: Science/Mathematics
+
+Format: HTML
+Index: /var/lib/pdl/html/Index.html
+Files: /var/lib/pdl/html/*.html
+
diff --git a/debian/pdl.docs b/debian/pdl.docs
new file mode 100644
index 0000000..6141f0b
--- /dev/null
+++ b/debian/pdl.docs
@@ -0,0 +1,5 @@
+BUGS
+Known_problems
+README
+TODO
+Release_Notes
diff --git a/debian/pdl.install b/debian/pdl.install
new file mode 100644
index 0000000..1c7dbb9
--- /dev/null
+++ b/debian/pdl.install
@@ -0,0 +1,3 @@
+Doc/scantree.pl usr/lib/perl5/PDL/Doc/
+Doc/mkhtmldoc.pl usr/lib/perl5/PDL/Doc/
+debian/dh_pdl usr/bin
diff --git a/debian/pdl.links b/debian/pdl.links
new file mode 100644
index 0000000..0b8548f
--- /dev/null
+++ b/debian/pdl.links
@@ -0,0 +1,4 @@
+/var/lib/pdl/Index.pod /usr/lib/perl5/PDL/Index.pod
+/var/lib/pdl/pdldoc.db /usr/lib/perl5/PDL/pdldoc.db
+/var/lib/pdl/html /usr/share/doc/pdl/html
+/usr/share/man/man3/PDL.3pm.gz /usr/share/man/man1/pdl.1.gz
diff --git a/debian/pdl.lintian-overrides b/debian/pdl.lintian-overrides
new file mode 100644
index 0000000..717e38d
--- /dev/null
+++ b/debian/pdl.lintian-overrides
@@ -0,0 +1,9 @@
+# HG: the html doc is generated in the postinst maintainer script, so lintian
+# just does not see it
+pdl: doc-base-file-references-missing-file pdl:12 /var/lib/pdl/html/Index.html
+pdl: doc-base-file-references-missing-file pdl:13 /var/lib/pdl/html/*.html
+# there is one long code line in the manpage, which cannot be broken
+pdl: manpage-has-errors-from-man usr/share/man/man3/PDL::FFT.3pm.gz 215: warning [p 2, 2.0i]: can't break line
+# these two images neeed to be in usr/lib
+pdl: image-file-in-usr-lib usr/lib/perl5/PDL/Transform/Cartography/earth_day.jpg
+pdl: image-file-in-usr-lib usr/lib/perl5/PDL/Transform/Cartography/earth_night.jpg
diff --git a/debian/pdl.manpages b/debian/pdl.manpages
new file mode 100644
index 0000000..251b200
--- /dev/null
+++ b/debian/pdl.manpages
@@ -0,0 +1 @@
+debian/dh_pdl.1
diff --git a/debian/pdl.menu b/debian/pdl.menu
new file mode 100644
index 0000000..63fc25b
--- /dev/null
+++ b/debian/pdl.menu
@@ -0,0 +1,5 @@
+?package(pdl):\
+ needs="text"\
+ section="Applications/Science/Mathematics"\
+ title="PerlDl"\
+ command="/usr/bin/perldl"
diff --git a/debian/pdl.postinst b/debian/pdl.postinst
new file mode 100644
index 0000000..594f51e
--- /dev/null
+++ b/debian/pdl.postinst
@@ -0,0 +1,43 @@
+#! /bin/sh
+# postinst script for pdl
+#
+# see: dh_installdeb(1)
+
+set -e
+
+# summary of how this script can be called:
+# * <postinst> `configure' <most-recently-configured-version>
+# * <old-postinst> `abort-upgrade' <new version>
+# * <conflictor's-postinst> `abort-remove' `in-favour' <package>
+# <new-version>
+# * <deconfigured's-postinst> `abort-deconfigure' `in-favour'
+# <failed-install-package> <version> `removing'
+# <conflicting-package> <version>
+# for details, see http://www.debian.org/doc/debian-policy/ or
+# the debian-policy package
+#
+
+case "$1" in
+ configure|triggered)
+ perl /usr/lib/perl5/PDL/Doc/scantree.pl /usr/lib/perl5/ /var/lib/pdl/pdldoc.db /var/lib/pdl/Index.pod >/dev/null 2>&1
+ perl /usr/lib/perl5/PDL/Doc/mkhtmldoc.pl -s "PDL/" /usr/lib/perl5/PDL /var/lib/pdl/html >/dev/null 2>&1
+ ;;
+
+ abort-upgrade|abort-remove|abort-deconfigure)
+
+ ;;
+
+ *)
+ echo "postinst called with unknown argument \`$1'" >&2
+ exit 1
+ ;;
+esac
+
+# dh_installdeb will replace this with shell code automatically
+# generated by other debhelper scripts.
+
+#DEBHELPER#
+
+exit 0
+
+
diff --git a/debian/pdl.prerm b/debian/pdl.prerm
new file mode 100644
index 0000000..5f57674
--- /dev/null
+++ b/debian/pdl.prerm
@@ -0,0 +1,40 @@
+#! /bin/sh
+# prerm script for pdl
+#
+# see: dh_installdeb(1)
+
+set -e
+
+# summary of how this script can be called:
+# * <prerm> `remove'
+# * <old-prerm> `upgrade' <new-version>
+# * <new-prerm> `failed-upgrade' <old-version>
+# * <conflictor's-prerm> `remove' `in-favour' <package> <new-version>
+# * <deconfigured's-prerm> `deconfigure' `in-favour'
+# <package-being-installed> <version> `removing'
+# <conflicting-package> <version>
+# for details, see http://www.debian.org/doc/debian-policy/ or
+# the debian-policy package
+
+
+# dh_installdeb will replace this with shell code automatically
+# generated by other debhelper scripts.
+
+#DEBHELPER#
+
+case "$1" in
+ remove|upgrade|deconfigure)
+ rm -rf /var/lib/pdl/html
+ rm -f /var/lib/pdl/pdldoc.db /var/lib/pdl/Index.pod
+ ;;
+ failed-upgrade)
+ ;;
+ *)
+ echo "prerm called with unknown argument \`$1'" >&2
+ exit 1
+ ;;
+esac
+
+exit 0
+
+
diff --git a/debian/pdl.remove b/debian/pdl.remove
new file mode 100644
index 0000000..2529376
--- /dev/null
+++ b/debian/pdl.remove
@@ -0,0 +1,5 @@
+usr/share/man/man3/PDL::BAD_demo.3pm
+usr/share/man/man3/PDL::BAD2_demo.3pm
+usr/share/man/man3/PDL::Config.3pm
+usr/share/man/man3/PDL::Doc::Config.3pm
+usr/share/man/man3/PDL::PP.3pm
diff --git a/debian/pdl.triggers b/debian/pdl.triggers
new file mode 100644
index 0000000..696b750
--- /dev/null
+++ b/debian/pdl.triggers
@@ -0,0 +1 @@
+interest /usr/lib/perl5/PDL
diff --git a/debian/perldl.conf b/debian/perldl.conf
new file mode 100644
index 0000000..1d1809d
--- /dev/null
+++ b/debian/perldl.conf
@@ -0,0 +1,255 @@
+#!/usr/bin/perl
+# -*-perl-*-
+
+# PDL Configuration options
+
+# You can edit this here or say 'perl Makefile.PL PDLCONF=file'
+# or use ~/.perldl.conf
+
+# Note in general "0" means False, "1" means "True" and "undef"
+# means "Try if possible (e.g. because the library is found)"
+#
+# You can also use a string that matches /^y/i to mean True or
+# one that matches /^n/i to mean False. It will be automatically
+# converted to 1 or 0 before being loaded into the Config.pm module.
+#
+
+%PDL_CONFIG = (
+#
+# Version of the perldl.conf file. This should be incremented
+# in the units for any PDL visible changes to the file (i.e.,
+# the non-comment ones). Other changes may be indicated by
+# the fractional part but are more for informational purposes.
+#
+ PDL_CONFIG_VERSION => 0.005,
+ PDL_BUILD_VERSION => undef, # filled in by Makefile.PL
+ PDL_BUILD_DIR => undef, # filled in by Makefile.PL
+
+#
+# Do we generate HTML documentation? This is normally a good idea,
+# as it's nice to browse -- but many folks don't use it, preferring
+# the man page and/or help versions of the documentation. Undef or 1
+# causes the HTML documentation to be built; 0 turns it off.
+#
+ HTML_DOCS => 1,
+
+# Location of directory for temporary files created during the
+# build/test process. See the getpdl_config() routine in Makefile.PL
+# for the choice made if TEMPDIR is left as 'undef': it boils down to
+# the first value that is defined from
+# $TEMP, $TMP, or "/tmp" [a TEMP directory for MSWin users]
+#
+
+ TEMPDIR => undef,
+
+# Decides if the output of attempts to link various function
+# during 'perl Makefile.PL' will be hidden when building PDL
+# should only be set to 0 for debugging purposes
+# see also L<trylink|PDL::Core::Dev/trylink>
+
+ HIDE_TRYLINK => 1,
+
+# you can set machine specific optimizations here the settings will be
+# passed to the toplevel Makefile.PL which *should* pass it to any
+# recursively invoked ones. Add -O0 to turn off compiler
+# optimization, and -g to produce debugging information that GDB and
+# other debuggers can use.
+
+ OPTIMIZE => undef, # '-O0 -g',
+
+# Use posix threading to make use of multiprocessor machines
+# undef -> try if possible
+# 0 -> don't use
+# true -> force use
+
+ WITH_POSIX_THREADS => undef,
+
+ POSIX_THREADS_INC => undef, # '-I/usr/pthread/include'
+ POSIX_THREADS_LIBS => undef, # '-L/usr/pthread -lpthreadGC2'
+
+ MALLOCDBG => undef,
+# {
+# include => '-I/home/csoelle/tmp',
+# libs => '-L/home/csoelle/tmp -lmymalloc',
+# define => << 'EOD',
+##define malloc(n) dbgmalloc(n,__FILE__,__LINE__)
+##define free(p) dbgfree(p)
+#EOD
+# include => '',
+# libs => '-lefence',
+# define => '',
+# },
+
+# Do we want routines to handle bad values?
+# saying no will make PDL a bit faster
+# true -> yes
+# false -> no, undef -> no
+#
+# WITH_BADVAL => 0,
+ WITH_BADVAL => 1,
+
+# if WITH_BADVAL == 1, do we use NaN/Inf to represent badvalues
+# (not convinced setting this results in faster code)
+#
+ BADVAL_USENAN => 0,
+# BADVAL_USENAN => 1,
+
+# The original BADVAL implementation assigned bad-values on pdl-types,
+# not per pdl, setting the following to one will make it a pdl-variable
+# THIS IS AN EXPERIMENTAL FEATURE -- BEWARE...
+
+ BADVAL_PER_PDL => 0,
+# BADVAL_PER_PDL => 1,
+
+# Try to build Graphics/TriD
+#
+# true -> force build of PDL::Graphics:::TriD
+# false -> skip build of PDL::Graphics:::TriD
+# undef -> let PDL build decide based on dependencies present
+#
+ WITH_3D => undef,
+
+# Build Graphics/TriD using Perl OpenGL
+#
+# true -> use new Perl OpenGL bindings
+# false -> use legacy, deprecated X11 only bindings
+# undef -> let PDL build decide (check if Perl OpenGL is present)
+#
+ USE_POGL => undef,
+# USE_POGL => 0,
+#
+ POGL_VERSION => 0.65, # minimum compatible OpenGL version
+
+# POGL_WINDOW_TYPE => 'x11', # use X11+GLX for windows
+ POGL_WINDOW_TYPE => 'glut', # use GLUT for windows
+
+## Whether or not to build the PLplot interface module
+#
+# default settings (let PDL build decide whether to build PLPLOT)
+#
+ WITH_PLPLOT => 0, # Leave it up to PDL to decide
+ WHERE_PLPLOT_LIBS => undef, # let PDL search for plplot installation
+ WHERE_PLPLOT_INCLUDE => undef, # let PDL search for plplot installation
+
+# Example manual settings:
+# WITH_PLPLOT => 1, # Build PLPLOT interface
+# WHERE_PLPLOT_LIBS => '/usr/local/plplot/lib', # PLplot lib dir
+# WHERE_PLPLOT_INCLUDE => '/usr/local/plplot/include', # PLplot include dir
+
+
+# Whether or not to build the PDL::Slatec module
+# false -> don't use
+# true -> force use
+
+ WITH_SLATEC => undef, # Leave it up to PDL to decide
+
+# Whether or not to build the PDL::Minuit module
+# false -> don't use
+# true -> force use
+
+ WITH_MINUIT => undef, # Leave it up to PDL to decide
+
+# If MINUIT_LIB is undef a standalone version of Minuit will be compiled
+# and PDL::Minuit will link to this library (fortran code can be found
+# at Lib/Minuit/minuitlib)
+# If you want to try to link directly to the Minuit present
+# in the CERN library libpacklib.a, include the full path to the library
+# here, e.g., MINUIT_LIB => '/usr/local/lib/libpacklib.a',
+
+ MINUIT_LIB => undef,
+
+# Whether or not to build the PDL::GSL module
+# false -> don't use
+# true -> force use
+
+ WITH_GSL => undef, # Leave it up to PDL to decide
+
+# Link flags for the GSL libs, e.g. '-L/usr/local/lib -lgsl -lm'
+ GSL_LIBS => undef, # use gsl-config
+
+# Location to find GSL includes:
+ GSL_INC => undef, # use gsl-config
+
+# Whether or not to build the PDL::FFTW module
+# false -> don't use
+# true -> force use
+
+ WITH_FFTW => undef, # Leave it up to PDL to decide
+
+# Location to search for the FFTW libs
+ FFTW_LIBS => [ '/lib','/usr/lib','/usr/local/lib'],
+
+# Location to find FFTW includes:
+ FFTW_INC => ['/usr/include/','/usr/local/include'],
+
+# FFTW Numeric Precision Type to link in: (double or single precision)
+ FFTW_TYPE => 'double',
+
+# Whether or not to build the PDL::IO::HDF module
+# false -> don't use
+# true -> force use
+
+ WITH_HDF => undef, # Leave it up to PDL to decide
+ HDF_LIBS => undef,
+ HDF_INC => ['/usr/include/hdf'],
+
+# Whether or not to build the PDL::IO::GD module
+# false -> don't use
+# true -> force use
+
+ WITH_GD => undef, # Leave it up to PDL to decide
+ GD_LIBS => undef,
+ GD_INC => undef,
+
+# Whether or not to build the PDL::GIS::Proj module
+# false -> don't use
+# true -> force use
+#
+ WITH_PROJ => undef, # Leave it up to PDL to decide
+ PROJ_LIBS => undef,
+ PROJ_INC => undef,
+
+# N.B. These are array ref values and *not* strings
+#
+# PROJ_LIBS => [ 'C:/_32/msys/1.0/local/lib'],
+# PROJ_INC => [ 'C:/_32/msys/1.0/local/include'],
+
+# Do we build PDL::IO::Browser?
+# default -> do not build
+#
+ WITH_IO_BROWSER => 0,
+
+# Quiet Astro::FITS::Header warnings for PDL build process by default
+# Eventually would be better to set undef by default, and have the
+# Makefile.PL change the value after it has been found missing once.
+# TBD after PDL 2.4.3 release...
+#
+ FITS_LEGACY => 1,
+
+# Whether or not to enable the new Devel::REPL based PDL shell
+# Given the large numbers of dependencies for Devel::REPL, we
+# don't want to have that as a required dependency for PDL.
+# Still, if it is there already, we could use it...
+#
+# false -> don't install pdl2 support
+# true -> force pdl2 install (default)
+
+ WITH_DEVEL_REPL => 1,
+
+# Set this for official CPAN releases of PDL since these
+# tests will always fail until they are fixed. It can also
+# be set from the value of the environment variable of the
+# same name.
+#
+ SKIP_KNOWN_PROBLEMS => 0,
+#
+# Set this to make the pdldoc command ignore PDL::AutoLoader
+# routines (*.pdl files in your @PDLLIB path). While most
+# users will want the new behavior, the performance impact
+# could be noticable. Setting this to 1 will turn off the
+# new feature.
+#
+ PDLDOC_IGNORE_AUTOLOADER => 0,
+);
+
+1; # Return OK status on 'require'
diff --git a/debian/rules b/debian/rules
new file mode 100755
index 0000000..3b0cc0f
--- /dev/null
+++ b/debian/rules
@@ -0,0 +1,128 @@
+#!/usr/bin/make -f
+# -*- makefile -*-
+# PDL debian/rules that uses debhelper.
+# much of it is based on the original debmake-based one.
+# This file was originally written by Joey Hess and Craig Small.
+# As a special exception, when this file is copied by dh-make into a
+# dh-make output file, you may use that output file without restriction.
+# This special exception was added by Craig Small in version 0.37 of dh-make.
+
+# Uncomment this to turn on verbose mode.
+#export DH_VERBOSE=1
+
+unexport DISPLAY
+
+
+ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS)))
+ export DEB_CFLAGS_MAINT_APPEND:=-Wall
+else
+ export DEB_CFLAGS_MAINT_APPEND:=-Wall -ffunction-sections
+endif
+
+export DEB_LDFLAGS_MAINT_APPEND:=-Wl,--as-needed
+
+DPKG_EXPORT_BUILDFLAGS = 1
+include /usr/share/dpkg/buildflags.mk
+
+subst_pdlapi = -Vpdlapi:Provides="`perl -Mblib -MPDL::Config::Debian -e 'print \"pdlapi-$$PDL::Config::Debian::pdl_core_version\n\"'`"
+
+configure: configure-stamp
+configure-stamp:
+ dh_testdir
+ # Add here commands to configure the package
+ dh_auto_configure -- F77CONF=debian/f77conf.pl PDLCONF=debian/perldl.conf
+
+ touch configure-stamp
+
+
+
+build-arch: build
+build-indep: build
+
+build: build-stamp
+build-stamp: configure-stamp
+ dh_testdir
+
+ # Add here commands to compile the package.
+ $(MAKE) LD_RUN_PATH=""
+ mkdir -p blib/lib/PDL/Config
+ perl -Mblib debian/write_config_debian.pl > blib/lib/PDL/Config/Debian.pm
+ pod2man debian/dh_pdl > debian/dh_pdl.1
+
+ touch build-stamp
+
+test: test-stamp
+test-stamp: build-stamp
+ dh_testdir
+ @echo "BEGIN test normal"
+ -$(MAKE) TEST_VERBOSE=0 LC_ALL=C test | perl debian/filter-test.pl
+ @echo "END test normal"
+ @echo "BEGIN test verbose"
+ -$(MAKE) TEST_VERBOSE=1 LC_ALL=C test | perl debian/filter-test.pl
+ @echo "END test verbose"
+ touch test-stamp
+
+clean:
+ dh_testdir
+ dh_testroot
+ rm -f build-stamp configure-stamp test-stamp
+
+ dh_clean
+
+ # Add here commands to clean up after the build process.
+ [ ! -f Makefile ] || $(MAKE) distclean
+ rm -f t/callext.o t/callext.so Graphics/TriD/OpenGL/tmp*.h-out \
+ Perldl2/pdl2.pod debian/dh_pdl.1
+
+install: build test
+ dh_testdir
+ dh_testroot
+ dh_prep
+ dh_installdirs
+
+ # Add here commands to install the package into debian/pdl.
+ $(MAKE) install DESTDIR=$(CURDIR)/debian/pdl
+ cd debian/pdl/usr/share/man/man3 ; mv PDL\:\:Reduce.3pm old.3pm ; sed -f $(CURDIR)/debian/fix_man_name.sed old.3pm > PDL\:\:Reduce.3pm ; rm old.3pm
+ cd debian/pdl/usr/share/man/man3 ; mv PDL\:\:Func.3pm old.3pm ; sed -f $(CURDIR)/debian/fix_man_encoding.sed old.3pm > PDL\:\:Func.3pm ; rm old.3pm
+ cd debian/pdl/usr/share/man/man3 ; mv PDL\:\:Complex.3pm old.3pm ; sed -f $(CURDIR)/debian/fix_man_encoding.sed old.3pm > PDL\:\:Complex.3pm ; rm old.3pm
+ cd debian/pdl; while read f ; do rm -f "$$f" ; done < ../pdl.remove
+
+
+# Build architecture-independent files here.
+binary-indep: build install
+# We have nothing to do by default.
+
+# Build architecture-dependent files here.
+binary-arch: build install
+ dh_testdir
+ dh_testroot
+ dh_installchangelogs
+ dh_installdocs
+ dh_installexamples
+ dh_install
+ dh_installmenu
+ dh_lintian
+# dh_installdebconf
+# dh_installlogrotate
+# dh_installemacsen
+# dh_installpam
+# dh_installmime
+# dh_installinit
+# dh_installcron
+# dh_installinfo
+ dh_installman
+ dh_link
+ dh_strip
+ dh_compress
+ dh_fixperms
+ dh_perl
+# dh_python
+# dh_makeshlibs
+ dh_installdeb
+ dh_shlibdeps
+ dh_gencontrol -- $(subst_pdlapi)
+ dh_md5sums
+ dh_builddeb
+
+binary: binary-indep binary-arch
+.PHONY: build clean binary-indep binary-arch binary install configure
diff --git a/debian/source/format b/debian/source/format
new file mode 100644
index 0000000..163aaf8
--- /dev/null
+++ b/debian/source/format
@@ -0,0 +1 @@
+3.0 (quilt)
diff --git a/debian/write_config_debian.pl b/debian/write_config_debian.pl
new file mode 100755
index 0000000..1179af5
--- /dev/null
+++ b/debian/write_config_debian.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use PDL;
+use Inline qw{Pdlpp};
+
+my $v = pdl(1)->pdl_core_version()->at(0);
+
+print <<"EOPM";
+package PDL::Config::Debian;
+our \$pdl_core_version = $v;
+1;
+EOPM
+
+__DATA__
+
+__Pdlpp__
+
+pp_def('pdl_core_version',
+ Pars => 'dummy(); int [o] pcv();',
+ Code => '$pcv() = PDL_CORE_VERSION;');
+
+pp_done;
diff --git a/inc/Carp.pm b/inc/Carp.pm
new file mode 100644
index 0000000..9544274
--- /dev/null
+++ b/inc/Carp.pm
@@ -0,0 +1,581 @@
+package Carp;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.20';
+$VERSION = eval $VERSION;
+
+our $MaxEvalLen = 0;
+our $Verbose = 0;
+our $CarpLevel = 0;
+our $MaxArgLen = 64; # How much of each argument to print. 0 = all.
+our $MaxArgNums = 8; # How many arguments to print. 0 = all.
+
+require Exporter;
+our @ISA = ('Exporter');
+our @EXPORT = qw(confess croak carp);
+our @EXPORT_OK = qw(cluck verbose longmess shortmess);
+our @EXPORT_FAIL = qw(verbose); # hook to enable verbose mode
+
+# The members of %Internal are packages that are internal to perl.
+# Carp will not report errors from within these packages if it
+# can. The members of %CarpInternal are internal to Perl's warning
+# system. Carp will not report errors from within these packages
+# either, and will not report calls *to* these packages for carp and
+# croak. They replace $CarpLevel, which is deprecated. The
+# $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
+# text and function arguments should be formatted when printed.
+
+our %CarpInternal;
+our %Internal;
+
+# disable these by default, so they can live w/o require Carp
+$CarpInternal{Carp}++;
+$CarpInternal{warnings}++;
+$Internal{Exporter}++;
+$Internal{'Exporter::Heavy'}++;
+
+# if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
+# then the following method will be called by the Exporter which knows
+# to do this thanks to @EXPORT_FAIL, above. $_[1] will contain the word
+# 'verbose'.
+
+sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ }
+
+sub _cgc {
+ no strict 'refs';
+ return \&{"CORE::GLOBAL::caller"} if defined &{"CORE::GLOBAL::caller"};
+ return;
+}
+
+sub longmess {
+ # Icky backwards compatibility wrapper. :-(
+ #
+ # The story is that the original implementation hard-coded the
+ # number of call levels to go back, so calls to longmess were off
+ # by one. Other code began calling longmess and expecting this
+ # behaviour, so the replacement has to emulate that behaviour.
+ my $cgc = _cgc();
+ my $call_pack = $cgc ? $cgc->() : caller();
+ if ( $Internal{$call_pack} or $CarpInternal{$call_pack} ) {
+ return longmess_heavy(@_);
+ }
+ else {
+ local $CarpLevel = $CarpLevel + 1;
+ return longmess_heavy(@_);
+ }
+}
+
+our @CARP_NOT;
+
+sub shortmess {
+ my $cgc = _cgc();
+
+ # Icky backwards compatibility wrapper. :-(
+ local @CARP_NOT = $cgc ? $cgc->() : caller();
+ shortmess_heavy(@_);
+}
+
+sub croak { die shortmess @_ }
+sub confess { die longmess @_ }
+sub carp { warn shortmess @_ }
+sub cluck { warn longmess @_ }
+
+sub caller_info {
+ my $i = shift(@_) + 1;
+ my %call_info;
+ my $cgc = _cgc();
+ {
+ package DB;
+ @DB::args = \$i; # A sentinel, which no-one else has the address of
+ @call_info{
+ qw(pack file line sub has_args wantarray evaltext is_require) }
+ = $cgc ? $cgc->($i) : caller($i);
+ }
+
+ unless ( defined $call_info{pack} ) {
+ return ();
+ }
+
+ my $sub_name = Carp::get_subname( \%call_info );
+ if ( $call_info{has_args} ) {
+ my @args;
+ if ( @DB::args == 1
+ && ref $DB::args[0] eq ref \$i
+ && $DB::args[0] == \$i ) {
+ @DB::args = (); # Don't let anyone see the address of $i
+ local $@;
+ my $where = eval {
+ my $func = $cgc or return '';
+ my $gv = B::svref_2object($func)->GV;
+ my $package = $gv->STASH->NAME;
+ my $subname = $gv->NAME;
+ return unless defined $package && defined $subname;
+
+ # returning CORE::GLOBAL::caller isn't useful for tracing the cause:
+ return if $package eq 'CORE::GLOBAL' && $subname eq 'caller';
+ " in &${package}::$subname";
+ };
+ $where = defined($where) ? $where : '';
+ @args
+ = "** Incomplete caller override detected$where; \@DB::args were not set **";
+ }
+ else {
+ ## @args = map { Carp::format_arg($_) } @DB::args;
+ for my $db_arg (@DB::args) { push @args, Carp::format_arg($db_arg) };
+ }
+ if ( $MaxArgNums and @args > $MaxArgNums )
+ { # More than we want to show?
+ $#args = $MaxArgNums;
+ push @args, '...';
+ }
+
+ # Push the args onto the subroutine
+ $sub_name .= '(' . join( ', ', @args ) . ')';
+ }
+ $call_info{sub_name} = $sub_name;
+ return wantarray() ? %call_info : \%call_info;
+}
+
+# Transform an argument to a function into a string.
+sub format_arg {
+ my $arg = shift;
+ if ( ref($arg) ) {
+ $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
+ }
+ if ( defined($arg) ) {
+ $arg =~ s/'/\\'/g;
+ $arg = str_len_trim( $arg, $MaxArgLen );
+
+ # Quote it?
+ $arg = "'$arg'" unless $arg =~ /^-?[0-9.]+\z/;
+ } # 0-9, not \d, as \d will try to
+ else { # load Unicode tables
+ $arg = 'undef';
+ }
+
+ # The following handling of "control chars" is direct from
+ # the original code - it is broken on Unicode though.
+ # Suggestions?
+ utf8::is_utf8($arg)
+ or $arg =~ s/([[:cntrl:]]|[[:^ascii:]])/sprintf("\\x{%x}",ord($1))/eg;
+ return $arg;
+}
+
+# Takes an inheritance cache and a package and returns
+# an anon hash of known inheritances and anon array of
+# inheritances which consequences have not been figured
+# for.
+sub get_status {
+ my $cache = shift;
+ my $pkg = shift;
+ $cache->{$pkg} ||= [ { $pkg => $pkg }, [ trusts_directly($pkg) ] ];
+ return @{ $cache->{$pkg} };
+}
+
+# Takes the info from caller() and figures out the name of
+# the sub/require/eval
+sub get_subname {
+ my $info = shift;
+ if ( defined( $info->{evaltext} ) ) {
+ my $eval = $info->{evaltext};
+ if ( $info->{is_require} ) {
+ return "require $eval";
+ }
+ else {
+ $eval =~ s/([\\\'])/\\$1/g;
+ return "eval '" . str_len_trim( $eval, $MaxEvalLen ) . "'";
+ }
+ }
+
+ return ( $info->{sub} eq '(eval)' ) ? 'eval {...}' : $info->{sub};
+}
+
+# Figures out what call (from the point of view of the caller)
+# the long error backtrace should start at.
+sub long_error_loc {
+ my $i;
+ my $lvl = $CarpLevel;
+ {
+ ++$i;
+ my $cgc = _cgc();
+ my $pkg = $cgc ? $cgc->($i) : caller($i);
+ unless ( defined($pkg) ) {
+
+ # This *shouldn't* happen.
+ if (%Internal) {
+ local %Internal;
+ $i = long_error_loc();
+ last;
+ }
+ else {
+
+ # OK, now I am irritated.
+ return 2;
+ }
+ }
+ redo if $CarpInternal{$pkg};
+ redo unless 0 > --$lvl;
+ redo if $Internal{$pkg};
+ }
+ return $i - 1;
+}
+
+sub longmess_heavy {
+ return @_ if ref( $_[0] ); # don't break references as exceptions
+ my $i = long_error_loc();
+ return ret_backtrace( $i, @_ );
+}
+
+# Returns a full stack backtrace starting from where it is
+# told.
+sub ret_backtrace {
+ my ( $i, @error ) = @_;
+ my $mess;
+ my $err = join '', @error;
+ $i++;
+
+ my $tid_msg = '';
+ if ( defined &threads::tid ) {
+ my $tid = threads->tid;
+ $tid_msg = " thread $tid" if $tid;
+ }
+
+ my %i = caller_info($i);
+ $mess = "$err at $i{file} line $i{line}$tid_msg\n";
+
+ while ( my %i = caller_info( ++$i ) ) {
+ $mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
+ }
+
+ return $mess;
+}
+
+sub ret_summary {
+ my ( $i, @error ) = @_;
+ my $err = join '', @error;
+ $i++;
+
+ my $tid_msg = '';
+ if ( defined &threads::tid ) {
+ my $tid = threads->tid;
+ $tid_msg = " thread $tid" if $tid;
+ }
+
+ my %i = caller_info($i);
+ return "$err at $i{file} line $i{line}$tid_msg\n";
+}
+
+sub short_error_loc {
+ # You have to create your (hash)ref out here, rather than defaulting it
+ # inside trusts *on a lexical*, as you want it to persist across calls.
+ # (You can default it on $_[2], but that gets messy)
+ my $cache = {};
+ my $i = 1;
+ my $lvl = $CarpLevel;
+ {
+ my $cgc = _cgc();
+ my $called = $cgc ? $cgc->($i) : caller($i);
+ $i++;
+ my $caller = $cgc ? $cgc->($i) : caller($i);
+
+ return 0 unless defined($caller); # What happened?
+ redo if $Internal{$caller};
+ redo if $CarpInternal{$caller};
+ redo if $CarpInternal{$called};
+ redo if trusts( $called, $caller, $cache );
+ redo if trusts( $caller, $called, $cache );
+ redo unless 0 > --$lvl;
+ }
+ return $i - 1;
+}
+
+sub shortmess_heavy {
+ return longmess_heavy(@_) if $Verbose;
+ return @_ if ref( $_[0] ); # don't break references as exceptions
+ my $i = short_error_loc();
+ if ($i) {
+ ret_summary( $i, @_ );
+ }
+ else {
+ longmess_heavy(@_);
+ }
+}
+
+# If a string is too long, trims it with ...
+sub str_len_trim {
+ my $str = shift;
+ my $max = shift || 0;
+ if ( 2 < $max and $max < length($str) ) {
+ substr( $str, $max - 3 ) = '...';
+ }
+ return $str;
+}
+
+# Takes two packages and an optional cache. Says whether the
+# first inherits from the second.
+#
+# Recursive versions of this have to work to avoid certain
+# possible endless loops, and when following long chains of
+# inheritance are less efficient.
+sub trusts {
+ my $child = shift;
+ my $parent = shift;
+ my $cache = shift;
+ my ( $known, $partial ) = get_status( $cache, $child );
+
+ # Figure out consequences until we have an answer
+ while ( @$partial and not exists $known->{$parent} ) {
+ my $anc = shift @$partial;
+ next if exists $known->{$anc};
+ $known->{$anc}++;
+ my ( $anc_knows, $anc_partial ) = get_status( $cache, $anc );
+ my @found = keys %$anc_knows;
+ @$known{@found} = ();
+ push @$partial, @$anc_partial;
+ }
+ return exists $known->{$parent};
+}
+
+# Takes a package and gives a list of those trusted directly
+sub trusts_directly {
+ my $class = shift;
+ no strict 'refs';
+ no warnings 'once';
+ return @{"$class\::CARP_NOT"}
+ ? @{"$class\::CARP_NOT"}
+ : @{"$class\::ISA"};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Carp - alternative warn and die for modules
+
+=head1 SYNOPSIS
+
+ use Carp;
+
+ # warn user (from perspective of caller)
+ carp "string trimmed to 80 chars";
+
+ # die of errors (from perspective of caller)
+ croak "We're outta here!";
+
+ # die of errors with stack backtrace
+ confess "not implemented";
+
+ # cluck not exported by default
+ use Carp qw(cluck);
+ cluck "This is how we got here!";
+
+=head1 DESCRIPTION
+
+The Carp routines are useful in your own modules because
+they act like die() or warn(), but with a message which is more
+likely to be useful to a user of your module. In the case of
+cluck, confess, and longmess that context is a summary of every
+call in the call-stack. For a shorter message you can use C<carp>
+or C<croak> which report the error as being from where your module
+was called. There is no guarantee that that is where the error
+was, but it is a good educated guess.
+
+You can also alter the way the output and logic of C<Carp> works, by
+changing some global variables in the C<Carp> namespace. See the
+section on C<GLOBAL VARIABLES> below.
+
+Here is a more complete description of how C<carp> and C<croak> work.
+What they do is search the call-stack for a function call stack where
+they have not been told that there shouldn't be an error. If every
+call is marked safe, they give up and give a full stack backtrace
+instead. In other words they presume that the first likely looking
+potential suspect is guilty. Their rules for telling whether
+a call shouldn't generate errors work as follows:
+
+=over 4
+
+=item 1.
+
+Any call from a package to itself is safe.
+
+=item 2.
+
+Packages claim that there won't be errors on calls to or from
+packages explicitly marked as safe by inclusion in C<@CARP_NOT>, or
+(if that array is empty) C<@ISA>. The ability to override what
+ at ISA says is new in 5.8.
+
+=item 3.
+
+The trust in item 2 is transitive. If A trusts B, and B
+trusts C, then A trusts C. So if you do not override C<@ISA>
+with C<@CARP_NOT>, then this trust relationship is identical to,
+"inherits from".
+
+=item 4.
+
+Any call from an internal Perl module is safe. (Nothing keeps
+user modules from marking themselves as internal to Perl, but
+this practice is discouraged.)
+
+=item 5.
+
+Any call to Perl's warning system (eg Carp itself) is safe.
+(This rule is what keeps it from reporting the error at the
+point where you call C<carp> or C<croak>.)
+
+=item 6.
+
+C<$Carp::CarpLevel> can be set to skip a fixed number of additional
+call levels. Using this is not recommended because it is very
+difficult to get it to behave correctly.
+
+=back
+
+=head2 Forcing a Stack Trace
+
+As a debugging aid, you can force Carp to treat a croak as a confess
+and a carp as a cluck across I<all> modules. In other words, force a
+detailed stack trace to be given. This can be very helpful when trying
+to understand why, or from where, a warning or error is being generated.
+
+This feature is enabled by 'importing' the non-existent symbol
+'verbose'. You would typically enable it by saying
+
+ perl -MCarp=verbose script.pl
+
+or by including the string C<-MCarp=verbose> in the PERL5OPT
+environment variable.
+
+Alternately, you can set the global variable C<$Carp::Verbose> to true.
+See the C<GLOBAL VARIABLES> section below.
+
+=head1 GLOBAL VARIABLES
+
+=head2 $Carp::MaxEvalLen
+
+This variable determines how many characters of a string-eval are to
+be shown in the output. Use a value of C<0> to show all text.
+
+Defaults to C<0>.
+
+=head2 $Carp::MaxArgLen
+
+This variable determines how many characters of each argument to a
+function to print. Use a value of C<0> to show the full length of the
+argument.
+
+Defaults to C<64>.
+
+=head2 $Carp::MaxArgNums
+
+This variable determines how many arguments to each function to show.
+Use a value of C<0> to show all arguments to a function call.
+
+Defaults to C<8>.
+
+=head2 $Carp::Verbose
+
+This variable makes C<carp> and C<croak> generate stack backtraces
+just like C<cluck> and C<confess>. This is how C<use Carp 'verbose'>
+is implemented internally.
+
+Defaults to C<0>.
+
+=head2 @CARP_NOT
+
+This variable, I<in your package>, says which packages are I<not> to be
+considered as the location of an error. The C<carp()> and C<cluck()>
+functions will skip over callers when reporting where an error occurred.
+
+NB: This variable must be in the package's symbol table, thus:
+
+ # These work
+ our @CARP_NOT; # file scope
+ use vars qw(@CARP_NOT); # package scope
+ @My::Package::CARP_NOT = ... ; # explicit package variable
+
+ # These don't work
+ sub xyz { ... @CARP_NOT = ... } # w/o declarations above
+ my @CARP_NOT; # even at top-level
+
+Example of use:
+
+ package My::Carping::Package;
+ use Carp;
+ our @CARP_NOT;
+ sub bar { .... or _error('Wrong input') }
+ sub _error {
+ # temporary control of where'ness, __PACKAGE__ is implicit
+ local @CARP_NOT = qw(My::Friendly::Caller);
+ carp(@_)
+ }
+
+This would make C<Carp> report the error as coming from a caller not
+in C<My::Carping::Package>, nor from C<My::Friendly::Caller>.
+
+Also read the L</DESCRIPTION> section above, about how C<Carp> decides
+where the error is reported from.
+
+Use C<@CARP_NOT>, instead of C<$Carp::CarpLevel>.
+
+Overrides C<Carp>'s use of C<@ISA>.
+
+=head2 %Carp::Internal
+
+This says what packages are internal to Perl. C<Carp> will never
+report an error as being from a line in a package that is internal to
+Perl. For example:
+
+ $Carp::Internal{ (__PACKAGE__) }++;
+ # time passes...
+ sub foo { ... or confess("whatever") };
+
+would give a full stack backtrace starting from the first caller
+outside of __PACKAGE__. (Unless that package was also internal to
+Perl.)
+
+=head2 %Carp::CarpInternal
+
+This says which packages are internal to Perl's warning system. For
+generating a full stack backtrace this is the same as being internal
+to Perl, the stack backtrace will not start inside packages that are
+listed in C<%Carp::CarpInternal>. But it is slightly different for
+the summary message generated by C<carp> or C<croak>. There errors
+will not be reported on any lines that are calling packages in
+C<%Carp::CarpInternal>.
+
+For example C<Carp> itself is listed in C<%Carp::CarpInternal>.
+Therefore the full stack backtrace from C<confess> will not start
+inside of C<Carp>, and the short message from calling C<croak> is
+not placed on the line where C<croak> was called.
+
+=head2 $Carp::CarpLevel
+
+This variable determines how many additional call frames are to be
+skipped that would not otherwise be when reporting where an error
+occurred on a call to one of C<Carp>'s functions. It is fairly easy
+to count these call frames on calls that generate a full stack
+backtrace. However it is much harder to do this accounting for calls
+that generate a short message. Usually people skip too many call
+frames. If they are lucky they skip enough that C<Carp> goes all of
+the way through the call stack, realizes that something is wrong, and
+then generates a full stack backtrace. If they are unlucky then the
+error is reported from somewhere misleading very high in the call
+stack.
+
+Therefore it is best to avoid C<$Carp::CarpLevel>. Instead use
+C<@CARP_NOT>, C<%Carp::Internal> and C<%Carp::CarpInternal>.
+
+Defaults to C<0>.
+
+=head1 BUGS
+
+The Carp routines don't handle exception objects currently.
+If called with a first argument that is a reference, they simply
+call die() or warn(), as appropriate.
+
diff --git a/inc/Carp/Heavy.pm b/inc/Carp/Heavy.pm
new file mode 100644
index 0000000..38f95d8
--- /dev/null
+++ b/inc/Carp/Heavy.pm
@@ -0,0 +1,10 @@
+package Carp;
+
+# On one line so MakeMaker will see it.
+use Carp; our $VERSION = $Carp::VERSION;
+
+1;
+
+# Most of the machinery of Carp used to be there.
+# It has been moved in Carp.pm now, but this placeholder remains for
+# the benefit of modules that like to preload Carp::Heavy directly.
diff --git a/inc/Devel/CheckLib.pm b/inc/Devel/CheckLib.pm
new file mode 100644
index 0000000..4f1b6a1
--- /dev/null
+++ b/inc/Devel/CheckLib.pm
@@ -0,0 +1,487 @@
+# $Id: CheckLib.pm,v 1.25 2008/10/27 12:16:23 drhyde Exp $
+
+package #
+Devel::CheckLib;
+
+use 5.00405; #postfix foreach
+use strict;
+use vars qw($VERSION @ISA @EXPORT);
+$VERSION = '0.98';
+$VERSION = eval $VERSION;
+use Config qw(%Config);
+use Text::ParseWords 'quotewords';
+
+use File::Spec;
+use File::Temp;
+
+require Exporter;
+ at ISA = qw(Exporter);
+ at EXPORT = qw(assert_lib check_lib_or_exit check_lib);
+
+# localising prevents the warningness leaking out of this module
+local $^W = 1; # use warnings is a 5.6-ism
+
+_findcc(); # bomb out early if there's no compiler
+
+=head1 NAME
+
+Devel::CheckLib - check that a library is available
+
+=head1 DESCRIPTION
+
+Devel::CheckLib is a perl module that checks whether a particular C
+library and its headers are available.
+
+=head1 SYNOPSIS
+
+ use Devel::CheckLib;
+
+ check_lib_or_exit( lib => 'jpeg', header => 'jpeglib.h' );
+ check_lib_or_exit( lib => [ 'iconv', 'jpeg' ] );
+
+ # or prompt for path to library and then do this:
+ check_lib_or_exit( lib => 'jpeg', libpath => $additional_path );
+
+=head1 USING IT IN Makefile.PL or Build.PL
+
+If you want to use this from Makefile.PL or Build.PL, do
+not simply copy the module into your distribution as this may cause
+problems when PAUSE and search.cpan.org index the distro. Instead, use
+the use-devel-checklib script.
+
+=head1 HOW IT WORKS
+
+You pass named parameters to a function, describing to it how to build
+and link to the libraries.
+
+It works by trying to compile some code - which defaults to this:
+
+ int main(void) { return 0; }
+
+and linking it to the specified libraries. If something pops out the end
+which looks executable, it gets executed, and if main() returns 0 we know
+that it worked. That tiny program is
+built once for each library that you specify, and (without linking) once
+for each header file.
+
+If you want to check for the presence of particular functions in a
+library, or even that those functions return particular results, then
+you can pass your own function body for main() thus:
+
+ check_lib_or_exit(
+ function => 'foo();if(libversion() > 5) return 0; else return 1;'
+ incpath => ...
+ libpath => ...
+ lib => ...
+ header => ...
+ );
+
+In that case, it will fail to build if either foo() or libversion() don't
+exist, and main() will return the wrong value if libversion()'s return
+value isn't what you want.
+
+=head1 FUNCTIONS
+
+All of these take the same named parameters and are exported by default.
+To avoid exporting them, C<use Devel::CheckLib ()>.
+
+=head2 assert_lib
+
+This takes several named parameters, all of which are optional, and dies
+with an error message if any of the libraries listed can
+not be found. B<Note>: dying in a Makefile.PL or Build.PL may provoke
+a 'FAIL' report from CPAN Testers' automated smoke testers. Use
+C<check_lib_or_exit> instead.
+
+The named parameters are:
+
+=over
+
+=item lib
+
+Must be either a string with the name of a single
+library or a reference to an array of strings of library names. Depending
+on the compiler found, library names will be fed to the compiler either as
+C<-l> arguments or as C<.lib> file names. (E.g. C<-ljpeg> or C<jpeg.lib>)
+
+=item libpath
+
+a string or an array of strings
+representing additional paths to search for libraries.
+
+=item LIBS
+
+a C<ExtUtils::MakeMaker>-style space-seperated list of
+libraries (each preceded by '-l') and directories (preceded by '-L').
+
+This can also be supplied on the command-line.
+
+=back
+
+And libraries are no use without header files, so ...
+
+=over
+
+=item header
+
+Must be either a string with the name of a single
+header file or a reference to an array of strings of header file names.
+
+=item incpath
+
+a string or an array of strings
+representing additional paths to search for headers.
+
+=item INC
+
+a C<ExtUtils::MakeMaker>-style space-seperated list of
+incpaths, each preceded by '-I'.
+
+This can also be supplied on the command-line.
+
+=back
+
+=head2 check_lib_or_exit
+
+This behaves exactly the same as C<assert_lib()> except that instead of
+dieing, it warns (with exactly the same error message) and exits.
+This is intended for use in Makefile.PL / Build.PL
+when you might want to prompt the user for various paths and
+things before checking that what they've told you is sane.
+
+If any library or header is missing, it exits with an exit value of 0 to avoid
+causing a CPAN Testers 'FAIL' report. CPAN Testers should ignore this
+result -- which is what you want if an external library dependency is not
+available.
+
+=head2 check_lib
+
+This behaves exactly the same as C<assert_lib()> except that it is silent,
+returning false instead of dieing, or true otherwise.
+
+=cut
+
+sub check_lib_or_exit {
+ eval 'assert_lib(@_)';
+ if($@) {
+ warn $@;
+ exit;
+ }
+}
+
+sub check_lib {
+ eval 'assert_lib(@_)';
+ return $@ ? 0 : 1;
+}
+
+sub assert_lib {
+ my %args = @_;
+ my (@libs, @libpaths, @headers, @incpaths);
+
+ # FIXME: these four just SCREAM "refactor" at me
+ @libs = (ref($args{lib}) ? @{$args{lib}} : $args{lib})
+ if $args{lib};
+ @libpaths = (ref($args{libpath}) ? @{$args{libpath}} : $args{libpath})
+ if $args{libpath};
+ @headers = (ref($args{header}) ? @{$args{header}} : $args{header})
+ if $args{header};
+ @incpaths = (ref($args{incpath}) ? @{$args{incpath}} : $args{incpath})
+ if $args{incpath};
+
+ # work-a-like for Makefile.PL's LIBS and INC arguments
+ # if given as command-line argument, append to %args
+ for my $arg (@ARGV) {
+ for my $mm_attr_key (qw(LIBS INC)) {
+ if (my ($mm_attr_value) = $arg =~ /\A $mm_attr_key = (.*)/x) {
+ # it is tempting to put some \s* into the expression, but the
+ # MM command-line parser only accepts LIBS etc. followed by =,
+ # so we should not be any more lenient with whitespace than that
+ $args{$mm_attr_key} .= " $mm_attr_value";
+ }
+ }
+ }
+
+ # using special form of split to trim whitespace
+ if(defined($args{LIBS})) {
+ foreach my $arg (split(' ', $args{LIBS})) {
+ die("LIBS argument badly-formed: $arg\n") unless($arg =~ /^-l/i);
+ push @{$arg =~ /^-l/ ? \@libs : \@libpaths}, substr($arg, 2);
+ }
+ }
+ if(defined($args{INC})) {
+ foreach my $arg (split(' ', $args{INC})) {
+ die("INC argument badly-formed: $arg\n") unless($arg =~ /^-I/);
+ push @incpaths, substr($arg, 2);
+ }
+ }
+
+ my ($cc, $ld) = _findcc();
+ my @missing;
+ my @wrongresult;
+ my @use_headers;
+
+ # first figure out which headers we can't find ...
+ for my $header (@headers) {
+ push @use_headers, $header;
+ my($ch, $cfile) = File::Temp::tempfile(
+ 'assertlibXXXXXXXX', SUFFIX => '.c'
+ );
+ my $ofile = $cfile;
+ $ofile =~ s/\.c$/$Config{_o}/;
+ print $ch qq{#include <$_>\n} for @use_headers;
+ print $ch qq{int main(void) { return 0; }\n};
+ close($ch);
+ my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe};
+ my @sys_cmd;
+ # FIXME: re-factor - almost identical code later when linking
+ if ( $Config{cc} eq 'cl' ) { # Microsoft compiler
+ require Win32;
+ @sys_cmd = (
+ @$cc,
+ $cfile,
+ "/Fe$exefile",
+ (map { '/I'.Win32::GetShortPathName($_) } @incpaths),
+ "/link",
+ @$ld
+ );
+ } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland
+ @sys_cmd = (
+ @$cc,
+ @$ld,
+ (map { "-I$_" } @incpaths),
+ "-o$exefile",
+ $cfile
+ );
+ } else { # Unix-ish: gcc, Sun, AIX (gcc, cc), ...
+ @sys_cmd = (
+ @$cc,
+ @$ld,
+ $cfile,
+ (map { "-I$_" } @incpaths),
+ "-o", "$exefile"
+ );
+ }
+ warn "# @sys_cmd\n" if $args{debug};
+ my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd);
+ push @missing, $header if $rv != 0 || ! -x $exefile;
+ _cleanup_exe($exefile);
+ unlink $ofile if -e $ofile;
+ unlink $cfile;
+ }
+
+ # now do each library in turn with headers
+ my($ch, $cfile) = File::Temp::tempfile(
+ 'assertlibXXXXXXXX', SUFFIX => '.c'
+ );
+ my $ofile = $cfile;
+ $ofile =~ s/\.c$/$Config{_o}/;
+ print $ch qq{#include <$_>\n} foreach (@headers);
+ print $ch "int main(void) { ".($args{function} || 'return 0;')." }\n";
+ close($ch);
+ for my $lib ( @libs ) {
+ my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe};
+ my @sys_cmd;
+ if ( $Config{cc} eq 'cl' ) { # Microsoft compiler
+ require Win32;
+ my @libpath = map {
+ q{/libpath:} . Win32::GetShortPathName($_)
+ } @libpaths;
+ # this is horribly sensitive to the order of arguments
+ @sys_cmd = (
+ @$cc,
+ $cfile,
+ "${lib}.lib",
+ "/Fe$exefile",
+ (map { '/I'.Win32::GetShortPathName($_) } @incpaths),
+ "/link",
+ @$ld,
+ (map {'/libpath:'.Win32::GetShortPathName($_)} @libpaths),
+ );
+ } elsif($Config{cc} eq 'CC/DECC') { # VMS
+ } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland
+ @sys_cmd = (
+ @$cc,
+ @$ld,
+ "-o$exefile",
+ (map { "-I$_" } @incpaths),
+ (map { "-L$_" } @libpaths),
+ "-l$lib",
+ $cfile);
+ } else { # Unix-ish
+ # gcc, Sun, AIX (gcc, cc)
+ @sys_cmd = (
+ @$cc,
+ @$ld,
+ $cfile,
+ "-o", "$exefile",
+ (map { "-I$_" } @incpaths),
+ (map { "-L$_" } @libpaths),
+ "-l$lib",
+ );
+ }
+ warn "# @sys_cmd\n" if $args{debug};
+ my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd);
+ push @missing, $lib if $rv != 0 || ! -x $exefile;
+ my $absexefile = File::Spec->rel2abs($exefile);
+ $absexefile = '"'.$absexefile.'"' if $absexefile =~ m/\s/;
+ push @wrongresult, $lib if $rv == 0 && -x $exefile && system($absexefile) != 0;
+ unlink $ofile if -e $ofile;
+ _cleanup_exe($exefile);
+ }
+ unlink $cfile;
+
+ my $miss_string = join( q{, }, map { qq{'$_'} } @missing );
+ die("Can't link/include C library $miss_string, aborting.\n") if @missing;
+ my $wrong_string = join( q{, }, map { qq{'$_'} } @wrongresult);
+ die("wrong result: $wrong_string\n") if @wrongresult;
+}
+
+sub _cleanup_exe {
+ my ($exefile) = @_;
+ my $ofile = $exefile;
+ $ofile =~ s/$Config{_exe}$/$Config{_o}/;
+ unlink $exefile if -f $exefile;
+ unlink $ofile if -f $ofile;
+ unlink "$exefile\.manifest" if -f "$exefile\.manifest";
+ if ( $Config{cc} eq 'cl' ) {
+ # MSVC also creates foo.ilk and foo.pdb
+ my $ilkfile = $exefile;
+ $ilkfile =~ s/$Config{_exe}$/.ilk/;
+ my $pdbfile = $exefile;
+ $pdbfile =~ s/$Config{_exe}$/.pdb/;
+ unlink $ilkfile if -f $ilkfile;
+ unlink $pdbfile if -f $pdbfile;
+ }
+ return
+}
+
+# return ($cc, $ld)
+# where $cc is an array ref of compiler name, compiler flags
+# where $ld is an array ref of linker flags
+sub _findcc {
+ # Need to use $keep=1 to work with MSWin32 backslashes and quotes
+ my $Config_ccflags = $Config{ccflags}; # use copy so ASPerl will compile
+ my @Config_ldflags = ();
+ for my $config_val ( @Config{qw(ldflags perllibs)} ){
+ push @Config_ldflags, $config_val if ( $config_val =~ /\S/ );
+ }
+ my @ccflags = grep { length } quotewords('\s+', 1, $Config_ccflags||'');
+ my @ldflags = grep { length } quotewords('\s+', 1, @Config_ldflags);
+ my @paths = split(/$Config{path_sep}/, $ENV{PATH});
+ my @cc = split(/\s+/, $Config{cc});
+ return ( [ @cc, @ccflags ], \@ldflags ) if -x $cc[0];
+ foreach my $path (@paths) {
+ my $compiler = File::Spec->catfile($path, $cc[0]) . $Config{_exe};
+ return ([ $compiler, @cc[1 .. $#cc], @ccflags ], \@ldflags)
+ if -x $compiler;
+ }
+ die("Couldn't find your C compiler\n");
+}
+
+# code substantially borrowed from IPC::Run3
+sub _quiet_system {
+ my (@cmd) = @_;
+
+ # save handles
+ local *STDOUT_SAVE;
+ local *STDERR_SAVE;
+ open STDOUT_SAVE, ">&STDOUT" or die "CheckLib: $! saving STDOUT";
+ open STDERR_SAVE, ">&STDERR" or die "CheckLib: $! saving STDERR";
+
+ # redirect to nowhere
+ local *DEV_NULL;
+ open DEV_NULL, ">" . File::Spec->devnull
+ or die "CheckLib: $! opening handle to null device";
+ open STDOUT, ">&" . fileno DEV_NULL
+ or die "CheckLib: $! redirecting STDOUT to null handle";
+ open STDERR, ">&" . fileno DEV_NULL
+ or die "CheckLib: $! redirecting STDERR to null handle";
+
+ # run system command
+ my $rv = system(@cmd);
+
+ # restore handles
+ open STDOUT, ">&" . fileno STDOUT_SAVE
+ or die "CheckLib: $! restoring STDOUT handle";
+ open STDERR, ">&" . fileno STDERR_SAVE
+ or die "CheckLib: $! restoring STDERR handle";
+
+ return $rv;
+}
+
+=head1 PLATFORMS SUPPORTED
+
+You must have a C compiler installed. We check for C<$Config{cc}>,
+both literally as it is in Config.pm and also in the $PATH.
+
+It has been tested with varying degrees on rigourousness on:
+
+=over
+
+=item gcc (on Linux, *BSD, Mac OS X, Solaris, Cygwin)
+
+=item Sun's compiler tools on Solaris
+
+=item IBM's tools on AIX
+
+=item SGI's tools on Irix 6.5
+
+=item Microsoft's tools on Windows
+
+=item MinGW on Windows (with Strawberry Perl)
+
+=item Borland's tools on Windows
+
+=item QNX
+
+=back
+
+=head1 WARNINGS, BUGS and FEEDBACK
+
+This is a very early release intended primarily for feedback from
+people who have discussed it. The interface may change and it has
+not been adequately tested.
+
+Feedback is most welcome, including constructive criticism.
+Bug reports should be made using L<http://rt.cpan.org/> or by email.
+
+When submitting a bug report, please include the output from running:
+
+ perl -V
+ perl -MDevel::CheckLib -e0
+
+=head1 SEE ALSO
+
+L<Devel::CheckOS>
+
+L<Probe::Perl>
+
+=head1 AUTHORS
+
+David Cantrell E<lt>david at cantrell.org.ukE<gt>
+
+David Golden E<lt>dagolden at cpan.orgE<gt>
+
+Yasuhiro Matsumoto E<lt>mattn at cpan.orgE<gt>
+
+Thanks to the cpan-testers-discuss mailing list for prompting us to write it
+in the first place;
+
+to Chris Williams for help with Borland support;
+
+to Tony Cook for help with Microsoft compiler command-line options
+
+=head1 COPYRIGHT and LICENCE
+
+Copyright 2007 David Cantrell. Portions copyright 2007 David Golden.
+
+This module is free-as-in-speech software, and may be used, distributed,
+and modified under the same conditions as perl itself.
+
+=head1 CONSPIRACY
+
+This module is also free-as-in-mason software.
+
+=cut
+
+1;
diff --git a/m51.fits b/m51.fits
new file mode 100644
index 0000000..27bbd07
Binary files /dev/null and b/m51.fits differ
diff --git a/macosx/README b/macosx/README
new file mode 100644
index 0000000..087c547
--- /dev/null
+++ b/macosx/README
@@ -0,0 +1,7 @@
+NOTE: The PDL::Graphics::TriD window controls are based on
+having a mouse with 2 or more buttons.
+
+For Macs with one button, you can use Ctrl+Click to generate
+the needed Right-click. It is also possible to configure
+the Macbook tracpad to generate a secondary click via the
+control panel.
diff --git a/pdl.PL b/pdl.PL
new file mode 100644
index 0000000..13f1a21
--- /dev/null
+++ b/pdl.PL
@@ -0,0 +1,94 @@
+if($^O =~ /mswin32/i) {exit}
+open(FOO,">pdl.c");
+print FOO <<'nosubs';
+
+/******************************
+ * pdl.c - perldl spawner
+ * Works around a problem with many unices that you can't use an interpreter
+ * to run an interpreter -- so "#!/usr/bin/perldl" won't work.
+ * This is a compiled piece of code that launches perldl "directly",
+ * so that the poor kernel's mind isn't blown.
+ *
+ * If you feed in a single non-switch argument it gets prepended with a
+ * "-" to let perldl know that it's an input file. That way you can be lazy
+ * and say "#!/usr/bin/pdl" at the top of your script.
+ *
+ * Don't modify this .c code -- modify the generator, pdl.PL, instead.
+ *
+ * CED 21-Jul-2004
+ */
+
+
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/wait.h>
+
+int main(int argc, char **argv) {
+ char perldl[BUFSIZ];
+ int pipes[2];
+ int pid,i;
+ int status;
+
+ if(pipe(pipes)) {perror("pdl (perldl spawn wrapper)"); exit(1);}
+ pid = fork();
+ if(pid==0) {
+ dup2(pipes[1],1);
+ dup2(pipes[1],2);
+ system("which perldl");
+ exit(0);
+ }
+ read(pipes[0],perldl,BUFSIZ);
+ pid = wait(&status);
+ if(! WIFEXITED(status) ) {
+ fprintf(stderr,"Hmmm... couldn't seem to find perldl anywhere. Quitting.\n");
+ goto exit;
+ }
+
+ /* Remove trailing newline */
+ for(i=0;i<BUFSIZ && perldl[i]; i++)
+ if(perldl[i]=='\n' || perldl[i]=='\r')
+ perldl[i]='\0';
+
+ if(argc==2) {
+ if(argv[1][0]!='-') {
+ char **argv2 = malloc((argc+2)*sizeof(char *));
+ int i;
+
+ if(!argv2)
+ goto exit;
+
+ for(i=0;i<argc;i++)
+ argv2[i+1]=argv[i];
+
+ argv2[1]="-";
+ argv2[0]="perldl";
+ argv2[argc+1]=0;
+
+ execv(perldl,argv2);
+ fprintf(stderr,"couldn't execv %s\n",perldl);
+ goto exit;
+ }
+ }
+
+ argv[0]="perldl";
+ execv(perldl,argv);
+ fprintf(stderr,"couldn't execv %s (%d args)\n",perldl,argc);
+ goto exit;
+
+exit:
+ perror("pdl (perldl trampoline)");
+ exit(-1);
+}
+nosubs
+ ;
+
+use Config;
+my $dir = 'blib/bin';
+#manually create directory. Older versions of EU::MM (at least as late
+#as 6.17 which ships with perl 5.8.6) don't automatically create it.
+mkdir $dir unless -e $dir && -d $dir;
+`$Config{cc} -o $dir/pdl pdl.c`;
+
+exit 0;
diff --git a/pdldoc.PL b/pdldoc.PL
new file mode 100644
index 0000000..59b640c
--- /dev/null
+++ b/pdldoc.PL
@@ -0,0 +1,221 @@
+
+use strict;
+
+use Config;
+use File::Basename qw(&basename &dirname);
+use IO::File;
+
+# List explicitly here the variables you want Configure to
+# generate. Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries. Thus you write
+# $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+my $file;
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
+
+unlink $file if -f $file;
+my $fh = new IO::File "> $file" or die "Can't create $file: $!";
+
+# check for bad value support
+use vars qw( $bvalflag );
+use File::Spec;
+require File::Spec->catfile( "Basic", "Core", "badsupport.p" );
+
+my $usage_info;
+if ( $bvalflag ) {
+ print "Extracting $file (WITH bad value support)\n";
+ $usage_info = "[-a] [-b] [-h] [-s] [-u] <string>";
+} else {
+ print "Extracting $file (NO bad value support)\n";
+ $usage_info = "[-a] [-h] [-s] [-u] <string>";
+}
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print $fh <<"!GROK!THIS!";
+$Config{'startperl'}
+ eval 'exec perl -S \$0 "\$@"'
+ if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print $fh <<'!NO!SUBS!';
+
+use strict;
+$|++;
+
+use PDL::Config;
+
+BEGIN {
+ if ( not $PDL::Config{PDLDOC_IGNORE_AUTOLOADER} ) {
+ require PDL::AutoLoader;
+ }
+}
+
+use PDL::Doc::Perldl;
+use File::Basename;
+
+use vars qw( $VERSION );
+$VERSION = '0.3';
+
+my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
+
+my %options =
+ ( a => \&apropos,
+!NO!SUBS!
+
+ print $fh ' b => \&badinfo,' . "\n" if $bvalflag;
+
+print $fh <<'!NO!SUBS!';
+ h => \&help, s => \&sig, u => \&usage );
+
+my $name = basename( $0 );
+my $usage = <<"EOH";
+!NO!SUBS!
+
+ print $fh "Usage: \$name $usage_info\n";
+
+print $fh <<'!NO!SUBS!';
+
+This program provides command-line access to the PDL documentation.
+If no flag is specified, -h is assumed.
+
+ -a (apropos) searches the documentation for the string
+!NO!SUBS!
+
+print $fh " -b (badinfo) does the function support bad values?\n"
+ if $bvalflag;
+
+print $fh <<'!NO!SUBS!';
+ -h (help) prints the help for the function/module/document
+ -s (sig) prints the signature of the function
+ -u (usage) gives usage information on the function
+
+EOH
+
+my $oflag = $#ARGV > -1 ? substr($ARGV[0],0,1) eq "-" : 0;
+die $usage unless ($#ARGV == 0 and not $oflag) or ($#ARGV == 1 and $oflag);
+
+my $option = "h";
+if ( $oflag ) {
+ $option = substr($ARGV[0],1,1);
+ die $usage unless exists $options{$option};
+ shift @ARGV;
+}
+
+&{$options{$option}}( $ARGV[0] );
+
+exit;
+
+__END__
+
+=head1 NAME
+
+pdldoc - shell interface to PDL documentation
+
+=head1 SYNOPSIS
+
+B<pdldoc> <text>
+
+=cut
+
+!NO!SUBS!
+
+ if ( $bvalflag ) {
+ print $fh <<'!NO!SUBS!';
+B<pdldoc> [B<-a>] [B<-b>] [B<-h>] [B<-s>] [B<-u>] <text>
+!NO!SUBS!
+} else {
+ print $fh <<'!NO!SUBS!';
+B<pdldoc> [B<-a>] [B<-h>] [B<-s>] [B<-u>] <text>
+!NO!SUBS!
+}
+
+print $fh <<'!NO!SUBS!';
+
+=head1 DESCRIPTION
+
+The aim of B<pdldoc> is to provide the same functionality
+as the C<apropos>, C<help>, C<sig>,
+
+=cut
+
+!NO!SUBS!
+
+ print $fh "C<badinfo>, \n" if $bvalflag;
+
+print $fh <<'!NO!SUBS!';
+and C<usage> commands available in the L<perldl|PDL::perldl>
+and L<pdl2|pdl2> shells.
+
+Think of it as the PDL equivalent of C<perldoc -f>.
+
+=head1 OPTIONS
+
+=over 5
+
+=item B<-h> help
+
+print documentation about a PDL function or module or show a PDL manual.
+This is the default option.
+
+=item B<-a> apropos
+
+Regex search PDL documentation database.
+
+=cut
+
+!NO!SUBS!
+
+print $fh <<'!NO!SUBS!' if $bvalflag;
+=item B<-b> badinfo
+
+Information on the support for bad values provided by the function.
+
+=cut
+
+!NO!SUBS!
+
+print $fh <<'!NO!SUBS!';
+=item B<-s> sig
+
+prints signature of PDL function.
+
+=item B<-u> usage
+
+Prints usage information for a PDL function.
+
+=item C<$PDL::Config{PDLDOC_IGNORE_AUTOLOADER}>
+
+This PDL configuration variable may be set in the perldl.conf
+file to disable runtime search for documentation in
+L<PDL::AutoLoader|PDL::AutoLoader> files.
+
+=back
+
+=head1 VERSION
+
+This is pdldoc version 0.3.
+
+=head1 AUTHOR
+
+Doug Burke <burke at ifa dot hawaii dot edu>.
+Chris Marshall <chm at cpan dot org>.
+
+=cut
+
+!NO!SUBS!
+
+$fh->close;
+chmod 0555, $file;
+
+# end
diff --git a/perldl.PL b/perldl.PL
new file mode 100644
index 0000000..4ac5cfd
--- /dev/null
+++ b/perldl.PL
@@ -0,0 +1,1386 @@
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# List explicitly here the variables you want Configure to
+# generate. Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries. Thus you write
+# $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+ if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
+
+unlink $file if -f $file;
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{'startperl'}
+ eval 'exec perl -S \$0 "\$@"'
+ if 0;
+!GROK!THIS!
+
+# In the following, perl variables are not expanded during extraction.
+
+print OUT <<'!NO!SUBS!';
+
+##########################################################################
+# Here starts the actual script
+
+# Simple shell for PDL
+
+use vars qw($VERSION $HOME $Modules);
+
+$VERSION = '1.357';
+
+print "perlDL shell v$VERSION
+ PDL comes with ABSOLUTELY NO WARRANTY. For details, see the file
+ 'COPYING' in the PDL distribution. This is free software and you
+ are welcome to redistribute it under certain conditions, see
+ the same file for details.\n";
+
+# Useful shell variables
+
+$PERLDL::ESCAPE = '#'; # Default shell escape
+$PERLDL::HISTFILESIZE = 500; # Number of lines to keep in history
+$PERLDL::MULTI = 1; # Enable multi-lines by default
+$PERLDL::NO_EOF = 0; # Disable EOF protection by default
+$PERLDL::NO_EOF = 1 if $^O =~ 'MSWin'; # ...but enable for windows
+$PERLDL::PROMPT = "pdl> ";
+$PERLDL::PREFIX_RE = qr(^\s*(?:pdl|perldl)>\s*); # RE for shell prompts
+$PERLDL::PAGER = (exists $ENV{PAGER} ? $ENV{PAGER} : 'more');
+ # Default output paging program
+$PERLDL::PAGE = 0;
+$PERLDL::PAGING = 0;
+ at PERLDL::AUTO = ();
+$PERLDL::PREPROCESS = undef; # old interface -- disabled
+ at PERLDL::PREPROCESS = (); # new preprocessor pipeline
+$HOME = $ENV{HOME}; # Useful in shell
+
+if ($^O =~ /win32/i and $HOME eq ""){
+ $HOME = $ENV{USERPROFILE};
+ $HOME =~ s/\\/\//g;
+ }
+
+$,=" "; # Default
+
+$Modules = $Modules = ""; # pacify -w
+
+sub mypdlconfig {
+ require Config; # pick up perl version info
+ eval 'require PDL::Version' if not defined $PDL::Version::VERSION;
+ eval 'require PDL::Config';
+ eval "use Data::Dumper";
+ my $hasdumper = $@ eq "" ? 1 : 0;
+ eval "use PDL::Bad;";
+ my $bflag = defined($PDL::Bad::Status) && $PDL::Bad::Status;
+
+ my $txt = "\nSummary of my PDL configuration\n\n";
+ $txt .= "VERSION: PDL v$PDL::Version::VERSION";
+ $txt .= " (supports bad values)" if $bflag;
+ $txt .= "\n\n";
+ if ($hasdumper && %PDL::Config) {
+ $txt .= Data::Dumper->Dump([{%PDL::Config}],['%PDL::Config']);
+ } else {
+ $txt .= "Could not obtain \%PDL::Config\n";
+ }
+ $txt .= Config::myconfig(); # append perl config info
+}
+
+sub preproc_registered ($) {
+ my ($sub) = @_;
+ die "preprocessors must be code references"
+ unless ref $sub eq 'CODE';
+ return grep ($_ == $sub, @PERLDL::PREPROCESS) > 0;
+}
+
+sub preproc_add ($) {
+ my ($sub) = @_;
+ die "preprocessors must be code references"
+ unless ref $sub eq 'CODE';
+ push @PERLDL::PREPROCESS, $sub;
+ return $sub;
+}
+
+sub preproc_del ($) {
+ my ($sub) = @_;
+ die "preprocessors must be code references"
+ unless ref $sub eq 'CODE';
+ die "preprocessor can't be deleted: not installed"
+ unless preproc_registered $sub;
+ @PERLDL::PREPROCESS = grep ($_ != $sub, @PERLDL::PREPROCESS);
+ return $sub;
+}
+
+# Parse ARGV
+my $read_from_file;
+
+while(defined($_ = shift @ARGV)) {
+ if($_ eq "-tk") {
+ if ($^O eq 'MSWin32') {
+ print "-tk option not supported for windows\n";
+ next;
+ }
+ print "Using Tk";
+ eval "use Tk;";
+ if ($@ eq "") {
+ print " v$Tk::VERSION\n"
+ if defined $Tk::VERSION; # make -w happy
+ } else {
+ print ", sorry can't load module Tk\n";
+ }
+ next;
+ } elsif($_ eq "-glut") {
+ if ($^O eq 'MSWin32') {
+ print "-glut option not supported for windows\n";
+ next;
+ }
+ print "Using OpenGL for GLUT support";
+ eval "use OpenGL;";
+ if ($@ eq "") {
+ print " v$OpenGL::VERSION\n"
+ if defined $OpenGL::VERSION; # make -w happy
+ } else {
+ print ", sorry can't load module OpenGL\n";
+ }
+ OpenGL::glutInit() unless OpenGL::done_glutInit();
+ next;
+ } elsif(/^-f(.*)/) {
+ my $file = $1;
+ if(0 == length $1) {
+ $file = shift @ARGV;
+ }
+ print "Doing '$file'\n";
+ do $file;
+ if($@) {
+ die "Initialization error: $@";
+ }
+ next;
+ } elsif(/^-w$/){
+ $^W = 1;
+ next;
+ } elsif (/^-(M|m)([\w:]+)(\=\w+)?$/x) {
+ my ($way,$m, at im) = ($1,$2,$3?substr($3,1):());
+ eval "require $m";
+ warn, next if $@;
+ if ($way eq 'M') {
+ $m->import(@im);
+ } else {
+ $m->unimport(@im);
+ }
+ } elsif (/^-I (\S*) $/x) {
+ my $dir = $1;
+ $dir = $ARGV[++$arg]
+ if !$dir;
+ if ($dir =~ m{^ \/ }x) {
+ unshift(@INC, $dir);
+ } else {
+ require FindBin;
+ die "Error: can't find myself" if ! $FindBin::Bin;
+ unshift(@INC, "$FindBin::Bin/$dir");
+ }
+
+ } elsif (/^-V\s*$/) {
+ print mypdlconfig();
+ exit 0;
+ } elsif( /^-\s*$/) {
+
+ $read_from_file = 1;
+ last;
+
+ } else {
+ print << 'EOP';
+Usage: perldl [options]
+ -glut try to load OpenGL module (Enables
+ readline event-loop processing).
+ -tk try to load Tk module (Enables
+ readline event-loop processing).
+ -f <file> execute file <file> before starting perldl
+ -w run with warning messages turned-on
+ -m <module> unload module <module>
+ -M <module> load module <module>
+ -I <dir> Add <dir> to include path.
+ -V print PDL version info (e.g. for a bug report)
+ - Following arguments are files for input.
+
+EOP
+ die("Unknown argument $_");
+ }
+
+}
+
+my $readlines;
+if(!$read_from_file and -t STDIN) {
+ eval "use Term::ReadLine";
+ $readlines = ($@ eq "");
+} else {
+ $readlines=0;
+}
+
+my @enabled = ();
+push @enabled, "ReadLines" if $readlines;
+
+eval 'use PDL::NiceSlice';
+unless ($@) {
+ my $report = 0;
+ sub report {
+ my $ret = $report;
+ $report = $_[0] if $#_ > -1;
+ return $ret;
+ }
+ my $preproc = sub { my ($txt) = @_;
+ my $new = PDL::NiceSlice::perldlpp('main',$txt);
+ print STDERR "processed $new\n" if report && $new ne $txt;
+ return $new;
+ };
+ sub trans {
+ preproc_add $preproc unless preproc_registered $preproc;
+ preproc_del $preproc if $#_ > -1 && !$_[0] &&
+ preproc_registered $preproc;
+ }
+ sub notrans { trans 0 }
+ trans; # switch on by default
+ push @enabled, "NiceSlice";
+}
+
+eval "use Text::Balanced";
+my $multi_ok = ($@ eq "");
+$PERLDL::MULTI = 0 unless($multi_ok);
+push @enabled,"MultiLines" if $multi_ok;
+
+
+print join(', ', at enabled)," enabled\n" if @enabled > 0;
+
+if ( $readlines ){
+
+ $PERLDL::TERM = Term::ReadLine->new('perlDL', \*STDIN, \*STDOUT);
+
+ if (defined &OpenGL::done_glutInit ) {
+ # Attempt to use with FreeGLUT
+ if ($PERLDL::TERM->can('event_loop')) {
+ print "Using FreeGLUT event loop\n";
+ # Presumably, if you're using this loop, you're also selecting on other
+ # fileno's. It is up to you to add that in to the wait callback (first
+ # one passed to event_loop) and deal with those file handles.
+
+ $PERLDL::TERM->event_loop(
+ sub {
+ # This callback is called every time T::RL wants to
+ # read something from its input. The parameter is
+ # the return from the other callback.
+ my $fileno = shift;
+ my $rvec = '';
+ vec($rvec, $fileno, 1) = 1;
+ while(1) {
+ select my $rout = $rvec, undef, undef, 0;
+ last if vec($rout, $fileno, 1);
+ OpenGL::glutMainLoopEvent();
+ }
+ },
+ sub {
+ # This callback is called as the T::RL is starting up
+ # readline the first time. The parameter is the file
+ # handle that we need to monitor. The return value
+ # is used as input to the previous callback.
+
+ # We return the fileno that we will use later.
+
+ # cygwin/TRL::Gnu seems to use some other object here
+ # that doesn't respond to a fileno method call (rt#81344)
+ fileno($_[0]);
+ }
+ ) unless $Term::ReadLine::toloop;
+ } else {
+ warn("Sorry, cannot use FreeGLUT with this version of ReadLine\n");
+ }
+ }
+ if(defined &Tk::DoOneEvent and not ref $Term::ReadLine::toloop) {
+ # Attempt to use with Tk
+ if(${$PERLDL::TERM->Features}{tkRunning}) {
+ print "Using Tk event loop\n";
+ $PERLDL::TERM->tkRunning(1);
+ } else {
+ warn("Sorry, cannot use Tk with this version of ReadLine\n");
+ }
+ }
+ if ( ( -e "$HOME/.perldl_hist" )
+ && ( open HIST, "<$HOME/.perldl_hist" ) ) {
+ my @allhist = <HIST>;
+ close HIST;
+ map s/\n//g , @allhist ;
+ foreach (@allhist) {
+ $PERLDL::TERM->addhistory($_);
+ }
+ }
+ eval <<'EOEND';
+sub END {
+
+ # Save History in $ENV{'HOME'}/.perldl_hist
+ # GetHistory doesn't work on all versions...
+ my @a= $PERLDL::TERM->GetHistory() if $PERLDL::TERM->can('GetHistory');
+
+ $#a-- if $a[-1] =~ /^(q$|x$|\s*exit\b|\s*quit\b)/; # chop off the exit command
+ @a= @a[($#a-$PERLDL::HISTFILESIZE+1)..($#a)] if $#a > $PERLDL::HISTFILESIZE-1 ;
+ if( open HIST, ">$HOME/.perldl_hist" ) {
+ print HIST join("\n", at a);
+ close HIST;
+ } else {
+ print " Unable to open \"$HOME/.perldl_hist\"\n";
+ }
+}
+EOEND
+}
+
+sub l {
+ if ($readlines) {
+ my $n = $#_ > -1 ? shift : 20;
+ my @h = $PERLDL::TERM->GetHistory();
+ my $min = $#h < $n-1 ? 0 : $#h-$n+1;
+ map {print "$_: $h[$_]\n"} ($min..$#h);
+ }
+}
+
+sub page {
+ $PERLDL::PAGE = (defined $_[0] ? $_[0] : 1);
+}
+sub nopage {
+ page(0);
+}
+sub startpage {
+ if ($PERLDL::PAGE) {
+ open(SAVEOUT, '>&STDOUT');
+ open(STDOUT, "| $PERLDL::PAGER");
+ $PERLDL::PAGING = 1;
+ }
+}
+sub endpage {
+ if ($PERLDL::PAGING) {
+ close(STDOUT);
+ open(STDOUT, '>&SAVEOUT');
+ $PERLDL::PAGING = 0;
+ }
+}
+
+
+sub startup_def {
+ return "PDL/default.pdl" if $^O =~ /win32/i;
+ return "PDL/default.perldlrc";
+}
+
+
+# Global and local startup
+
+my $startup_file = -e "$HOME/.perldlrc" ? "$HOME/.perldlrc" : startup_def();
+
+print "Reading $startup_file...\n";
+
+eval 'require "'.$startup_file.'"';
+my $PDL_OK = ($@ eq "");
+if ($PDL_OK) {
+ require PDL::Version if not defined $PDL::Version::VERSION;
+ print "Type 'demo' for online demos\n";
+ eval "use PDL::Bad;";
+ my $bflag = defined($PDL::Bad::Status) && $PDL::Bad::Status;
+ if ( $bflag ) {
+ print "Loaded PDL v$PDL::Version::VERSION (supports bad values)\n";
+ } else {
+ print "Loaded PDL v$PDL::Version::VERSION\n";
+ }
+}else{
+ warn "WARNING: Error loading PDL: '$@' - trying blib. \n";
+ eval "use blib";
+ delete $INC{$startup_file}; # so require will try again!
+ eval 'require "'.$startup_file.'"';
+ $PDL_OK = ($@ eq "");
+ if ($PDL_OK) {
+ require PDL::Version if not defined $PDL::Version::VERSION;
+ print "Loaded PDL v$PDL::Version::VERSION\n";
+ }else{
+ warn "WARNING: PDL startup not found only plain perl available\n";
+ $PERLDL::PROMPT = 'perl> '; # so there is visual indication of no PDL
+
+ eval << 'EOD'; # Fallback eval routine - proper one defined in PDL::Core
+
+sub eval_and_report {
+ my $__code = shift; # Can be code ref or string
+ my $__string;
+ $__string = (ref $__code eq "CODE") ? '&$__code()' : $__code;
+ eval $__string; # Use boring eval() which misses some errors
+ return $@;
+}
+EOD
+
+ }
+}
+
+print "\nNote: AutoLoader not enabled ('use PDL::AutoLoader' recommended)\n\n"
+ unless defined($PDL::AutoLoader::Rescan);
+
+if (-e 'local.perldlrc') {
+ print "Reading local.perldlrc ...\n";
+ require 'local.perldlrc' ;
+}
+
+# Short hand for some stuff
+
+sub p { local $^W=0; print(@_); } # suppress possible undefined var message
+ # (dirty)
+
+my %demos =
+ (
+ 'pdl' => 'PDL::Demos::General', # have to protect pdl as it means something
+ '3d' => 'PDL::Demos::TriD1',
+ '3d2' => 'PDL::Demos::TriD2',
+ '3dgal' => 'PDL::Demos::TriDGallery',
+ 'pgplot' => 'PDL::Demos::PGPLOT_demo',
+ 'ooplot' => 'PDL::Demos::PGPLOT_OO_demo', # note: lowercase
+ 'bad' => 'PDL::Demos::BAD_demo',
+ 'bad2' => 'PDL::Demos::BAD2_demo',
+ 'transform' => 'PDL::Demos::Transform_demo',
+ 'cartography' => 'PDL::Demos::Cartography_demo',
+ 'gnuplot' => 'PDL::Demos::Gnuplot_demo',
+ 'prima' => 'PDL::Demos::Prima',
+ );
+
+sub demo {
+ local $_ = lc $_[0] ;
+ if(/^$/) {
+ print <<EOD;
+Use:
+ demo pdl # general demo
+
+ demo 3d # 3d demo (requires TriD with OpenGL or Mesa)
+ demo 3d2 # 3d demo, part 2. (Somewhat memory-intensive)
+ demo 3dgal # the 3D gallery: make cool images with 3-line scripts
+
+ demo pgplot # PGPLOT graphics output (Req.: PGPLOT)
+ demo OOplot # PGPLOT OO interface (Req.: PGPLOT)
+
+ demo gnuplot # Gnuplot graphics (requires PDL::Graphics::Gnuplot)
+ demo prima # Prima graphics (requires PDL::Graphics::Prima)
+
+ demo transform # Coordinate transformations (Req.: PGPLOT)
+ demo cartography # Cartographic projections (Req.: PGPLOT)
+
+ demo bad # Bad-value demo (Req.: bad value support)
+ demo bad2 # Bad-values, part 2 (Req.: bad value support and PGPLOT)
+
+EOD
+ return;
+ } # if: /^$/
+
+ if ( exists $demos{$_} ) {
+ require PDL::Demos::Screen; # Get the routines for screen demos.
+ my $name = $demos{$_};
+ eval "require $name;"; # see docs on require for need for eval
+ $name .= "::run";
+ &{$name}();
+ } else {
+ print "No such demo!\n";
+ }
+
+} # sub: demo
+
+$SIG{'INT'} = sub { die "Ctrl-C detected\n" }; # Ctrl-C handler
+
+
+my $preproc_warned = 0;
+sub preproc_oldwarn {
+ warn << 'EOW';
+
+ Deprecated usage: $PERLDL::PREPROCESS was set.
+ Usage of this variable is now strongly deprecated.
+ To enable preprocessing with recent versions of perldl
+ you should use the 'preproc_add' function. For details
+ check the perldl manpage.
+
+EOW
+ $preproc_warned = 1; # warn only once
+}
+
+
+
+#
+# count_tags: Return a string containing (in order) the open brackets
+# and strings in the string that is passed in. Used for multi-line parsing.
+#
+# Works by analysing the error message returned by Text::Balanced -- this
+# is sort of fragile against changes in Text::Balanced, but what the heck.
+# --CED 18-Mar-2003
+#
+sub count_tags {
+ my $s = shift;
+
+ $s =~ s/\\.//g; # Ignore all escaped characters
+
+ return undef unless($s =~ m/[^\s]/);
+
+ # [Ignore quotelike operators: they cause more trouble than they're worth!]
+
+ our($prefix,$delim,%closers);
+ unless(defined $prefix) {
+ $delim = '{[(`\'")]}';
+ %closers = ('{'=>'}','['=>']','('=>')');
+ }
+
+ # Run Text::Balanced on the string with a '{' in front of it, to
+ # make sure that all quoted strings are "embedded" in the outermost "{".
+ # The whitespace works around a short-string bug in extract_bracketed.
+ my $a;
+ my @result;
+ $s =~ s/^\s*\#.*$//mg; # Eliminate comment lines before extract.
+
+ eval { @result =
+ Text::Balanced::extract_bracketed("{".$s, $delim, $prefix);
+ $a = $@;
+ };
+
+ print "a = $a\nreturn = '",join("','", at result),"'\n"
+ if($PERLDL::debug);
+
+ if($a =~ m/^Did not find/) {
+ # No quotes -- this should never happen and is a syntax error.
+ print STDERR "[Error in parsing: this should never happen!]\n"
+ if($PERLDL::debug);
+ return undef;
+ }
+ elsif($a =~ m/^Unmatched emb\w+ quote \((.)\), de\w+ at offset (\d+)/) {
+ # Embedded quote: try to close it and reparse.
+ $a = $1;
+ return count_tags($s.$1) . $a;
+ }
+ elsif($a =~ m/^Mismatched closing bracket/) {
+ # This is an error condition - return false and let perl parse it
+ return undef;
+ }
+ elsif($a =~ m/^Unmatched opening bracket\(s\)\: \{\.\.(.\.\.)+/) {
+ $a = $1;
+ $a=~ s/\.\.//g;
+ return count_tags($s.$closers{$a}) . $a;
+ }
+ elsif($a =~ m/^Unmatched opening bracket\(s\)\: \{\.\.\,/) {
+ # Should have exactly one unmatched opening bracket.
+ return undef;
+ }
+ elsif(!$a) {
+ return undef;
+ }
+
+ print STDERR "Unknown error message '$a' from parser...\n"
+ if($PERLDL::debug);
+ return undef;
+}
+
+
+
+#
+# process_input -- this is the central grab-some-input-and-execute it loop.
+#
+sub process_input {
+ my $lines;
+
+
+ if($PERLDL::MULTI && !$multi_ok) {
+ $PERLDL::MULTI = 0;
+ print STDERR "WARNING: Text::Balanced not present; disabling multi-line parsing.\n";
+ }
+
+ # The {} around the do let us get out with 'last' in the EOF case.
+ multiline: {
+ my $cont;
+ $lines = "";
+
+
+ do {
+ local $, = "";
+
+ my $prompt = $cont ? "..$cont".(" "x(5-length($cont)))."> " :
+ ((ref $PERLDL::PROMPT) ? &$PERLDL::PROMPT : $PERLDL::PROMPT);
+
+ if ($readlines) {
+ $_ = $PERLDL::TERM->readline($prompt);
+ }else{
+ print $prompt if(-t ARGV); # Don't print prompt in pipes
+ $_ = <>;
+ }
+
+ if(!defined $_) {
+ if($cont) {
+ if( $PERLDL::NO_EOF > 1 && -t STDIN ) {
+ print STDERR "\nEOF ignored. (Close delimiters to end block. \$PERLDL::NO_EOF = $PERLDL::NO_EOF)\n";
+ } else {
+ last multiline;
+ }
+ } else {
+ if($PERLDL::NO_EOF && -t STDIN ) {
+ print STDERR "EOF ignored. ('q' or 'exit' to quit. \$PERLDL::NO_EOF = $PERLDL::NO_EOF)\n";
+ } else {
+ print STDERR "EOF detected, exiting shell.\n";
+ exit 0;
+ }
+ }
+ }
+
+ $lines .= "\n" if($cont); # Make multi-line strings work right.
+ $lines .= $_;
+ print "lines = $lines\n" if($PERLDL::debug);
+ } while( $PERLDL::MULTI && ($cont = count_tags($lines)) );
+
+ }
+
+ # Execute the list of auto-code
+
+ for my $c (@PERLDL::AUTO) {
+ my $mess = eval_and_report($c);
+ warn $mess if $mess;
+ }
+
+ # Filter out PDL shell prefixes from cut-n-pasted lines
+ if ( $lines =~ s/$PERLDL::PREFIX_RE// and $readlines ) {
+ my @hist = $PERLDL::TERM->GetHistory();
+ foreach my $entry (@hist) { $entry =~ s/$PERLDL::PREFIX_RE//; }
+ $PERLDL::TERM->SetHistory(@hist);
+ }
+
+ if(!defined $lines || lc $lines eq 'q' || lc $lines eq 'x' || lc $lines eq 'quit') {exit};
+ next if $lines =~/^\s*$/; # Blank line - do nothing
+
+ $lines =~ s/^\s*\?\?\s*/apropos /; # Make '??' = 'apropos'
+ $lines =~ s/^\s*\?\s*/help /; # Make lone '?' = 'help'
+
+ if ( $lines =~ /^\s*(help|usage|apropos|sig|badinfo|demo)\s+/) { # Allow help foo (no quotes)
+ my @t = split(/\s+/,$lines);
+ my $a;
+ foreach $a(@t) { $a=~s/^["']+//; $a=~s/['"]+$//; };
+ $t[1] = "'".$t[1]."'" if ($#t == 1 && !($t[1] =~ /^\$/));
+ $lines = join(' ', at t);
+ }
+
+ if (substr($lines,0,1) eq substr($PERLDL::ESCAPE,0,1) and
+ substr($lines,0,2) ne '#!') { # Allow escapes, avoid shebang
+ my @lines = split /\n/, $lines;
+ system(substr(shift @lines,1)); # Shell escape
+ $lines = join("\n", at lines);
+ next;
+ } else {
+ # Send code to pre-processor filters if defined
+ for my $filter (@PERLDL::PREPROCESS) {
+ $lines = $filter->($lines);
+ }
+
+ # honor the deprecated interface for now
+ if (defined $PERLDL::PREPROCESS &&
+ ref($PERLDL::PREPROCESS) eq 'CODE') {
+ preproc_oldwarn() unless $preproc_warned;
+ $lines = &$PERLDL::PREPROCESS($_);
+ }
+
+ startpage;
+ my $mess = eval_and_report($lines);
+ warn $mess if $mess;
+ endpage;
+ }
+ print "\n";
+}
+
+
+######################################################################
+######################################################################
+#####
+##### Main loop is here! (Commands not inside any sub!)
+
+# check for old usage of PERLDL::PREPROCESS
+if (defined $PERLDL::PREPROCESS) {
+ preproc_oldwarn() unless $preproc_warned;
+}
+
+$|=1;
+while(1) {
+ eval {process_input()};
+ if ($@) {
+ if ($@ =~ /Ctrl-C detected/) {
+ print "Ctrl-C detected\n";
+ next;
+ } else {
+ print "Unknown error: $@\n exiting...\n";
+ last;
+ }
+ }
+}
+
+#####
+#####
+######################################################################
+######################################################################
+
+# Work routine to eval code and post-process messages
+# Currently used by 'perldl' shell
+
+sub eval_and_report {
+ my $__code = shift; # Can be code ref or string
+
+ $@ = ""; # clear $@ since we might not execute the eval below
+
+
+ ## Compile the code ref to execute. The code gets put inside {} braces
+ ## so that there is a trivial loop (the simple block) for 'last' and 'next'
+ ## to escape from. (Otherwise perl 5.6.1 and 5.8 do a little fandango
+ ## on stack if you type "last" at the shell). --CED 18-Mar-2003
+
+ my $__coderef = (ref $__code eq "CODE") ? $__code : eval << "EOD"
+
+ sub {
+ {
+ $__code;
+ }
+ }
+EOD
+;
+
+ %@ = (); # Workaround to prevent spurious loss of $@ in early (pre-5.14 anyway) versions of perl
+
+ if( (!$@) and (ref $__coderef eq 'CODE')) {
+ eval { &$__coderef(); die $@ if($@); };
+ }
+
+ if ($@) {
+ my $mess = $@;
+
+ # Remove surplus parts
+
+ $mess =~ s/^\s*\(in cleanup\)\s+//; # 'cleanup ...' from Usage:...
+ $mess =~ s/\n\s*\(in cleanup\).*$//; # 'cleanup...'s at end
+ $mess =~ s/\s+at \(eval \d+\) line \d+\.?$//; # at eval ?? line ??.
+
+ return $mess; # Report error
+ }
+ return "";
+}
+
+
+
+__END__
+
+=head1 NAME
+
+perldl - Simple shell for PDL (see also L<pdl2>)
+
+=head1 SYNOPSIS
+
+Use PDL interactively:
+
+ bash$ perldl
+ pdl> $a = sequence(10) # or any other perl or PDL command
+
+ bash$ pdl
+ pdl> print "Hello, world!\n";
+
+Run a script:
+
+ bash$ cat > pdlscript
+ #!/usr/bin/pdl
+ print "Hello, world!\n";
+ ...
+
+
+=head1 DESCRIPTION
+
+The program B<perldl> is a simple shell (written in perl) for
+interactive use of PDL. It consists of a command-line interface that
+supports immediate interpretation of perl commands and expressions.
+Perl expressions, including PDL constructs, can be entered directly at
+the keyboard and are compiled and executed immediately. The syntax is
+not exactly identical to Perl, in that under most circumstances ending
+a line causes immediate execution of the command entered so far (no
+trailing ';' is required).
+
+The synonym B<pdl> is a compiled executable that is useful as a script
+interpreter using UNIX shebang (C<#!>) syntax. This is useful for generating
+and re-executing command-journal files from B<perldl>.
+
+The B<perldl> shell runs an initial startup file (C<~/.perldlrc>) that can
+be used to pre-load perl modules or configure the global perl environment. It
+features a path mechanism for autoloading perl subroutines. There is a
+command-history mechanism, and several other useful features such as command
+preprocessing, shortcuts for commonly used commands such as "print",
+and the ability to execute arbitrary code whenever a prompt is printed.
+
+Depending on your configuration settings, B<perldl> can be set to
+honor or ignore the ^D (end-of-file) character when sent from a
+terminal, or to attempt to do the Right Thing when a block construct
+spanning multiple lines is encountered.
+
+B<perldl> and B<pdl> support several command-line options, which are
+discussed near the end of this document.
+
+=head2 Reference manual & online help
+
+The PDL reference manual and online help are available from within
+B<perldl>, using the B<help> and B<apropos> commands (which may also
+be abbreviated B<?> and B<??>.) The B<help> command alone prints a summary of
+help syntax, and B<< help <module-name> >> will print POD documentation
+from the module you mention (POD is the Perl format for embedding
+documentation in your perl code; see L<perlpod> for details).
+
+If you include POD documentation in your autoload subroutines (see
+B<path mechanism> below), then both B<help> and B<apropos> will find it
+and be able to format and display it on demand.
+
+=head2 History mechanism
+
+If you have the perl modules ReadLines and ReadKeys installed, then
+B<perldl> supports a history and line-editing mechanism using editing
+keys similar to L<emacs>. The last 500 commands are always stored in
+the file F<.perldl_hist> in your home directory between sessions.
+Set C<$PERLDL::HISTFILESIZE> to change the number of lines saved.
+The command C<l [number]> shows you the last C<number> commands you
+typed where C<number> defaults to 20.
+
+e.g.:
+
+ bash$ perldl
+ ReadLines enabled
+ pdl> $a = rfits "foo.fits"
+ BITPIX = -32 size = 88504 pixels
+ Reading 354016 bytes
+ BSCALE = && BZERO =
+
+ pdl> imag log($a+400)
+ Displaying 299 x 296 image from 4.6939525604248 to 9.67116928100586 ...
+
+=head2 Command execution
+
+If you enter a simple command at the B<perldl> command line, it is
+immediately executed in a Perl C<eval()>. The environment is almost
+identical to that within a perl script, with some important exceptions:
+
+=over 3
+
+=item * $_ is not preserved across lines
+
+$_ is used to hold the command line for initial processing, so at the
+beginning of processing of each command line, $_ contains the command itself.
+Use variables other than $_ to store values across lines.
+
+=item * Scope is not preserved across lines
+
+Each command line is executed in a separate C<eval> block within perl,
+so scoping commands such as C<my> and C<local> may not perform exactly
+as expected -- in particular, if you declare a variable with C<my>, it
+is local to the particular command line on which you typed the C<my>
+command, which means that it will evaporate before the next prompt is printed.
+(You can use C<my> variables in a multi-line block or to isolate values within
+a single command line, of course).
+
+ NOTE: pdl2 preserves lexical scope between lines.
+
+=item * Execution is immediate
+
+Under most circumstances, as soon as you end a line of input the line
+is parsed and executed. This breaks Perl's normal dependence on
+semicolons as command delimiters. For example, the two-line expression
+
+ print "Hello ",
+ "world";
+
+prints the phrase C<Hello world> in Perl, but (under most circumstances)
+C<Hello > in B<perldl>.
+
+=item * Multi-line execution
+
+In multiline mode (which is enabled by default, see B<Shell
+variables>, below), B<perldl> searches for searches for block-like
+constructs with curly braces, parentheses, quotes, and related
+delimiters. If you leave such a construct open, B<perldl> accepts more
+lines of input until you close the construct or explictly end the multi-line
+expression with ^D. Following the example above, the phrase
+
+ { print "Hello ",
+ "world"; }
+
+will print "Hello world" from either Perl or (in multi-line mode)
+B<perldl>.
+
+B<Warning>: The multi-line parsing uses Damian Conway's
+L<Text::Balanced> module, which contains some flaws -- so it can be
+fooled by quote-like operators such as C<q/.../>, included POD
+documentation, multi-line C<E<lt>E<lt>> quotes, and some
+particularly bizarre-but-valid C<m/.../> matches and C<s/.../.../>
+substitutions. In such cases, use ^D to close out the multi-line construct and
+force compilation-and-execution.
+
+=back
+
+If you want to preserve this behavior in a script (for example to replay a command
+journal file; see below on how to create one), you can use B<pdl> instead of B<perl>
+as the interpreter in the script's initial shebang line.
+
+
+=head2 Terminating C<perldl>
+
+A C<perldl> session can be terminated with any of the commands
+C<quit>, C<exit> or the shorthands C<x> or C<q>. If EOF handling is
+switched on (the default) you can also type ^D at the command prompt.
+
+If the command input is NOT a terminal (for example if you are running
+from a command journal file), then EOF will always terminate B<perldl>.
+
+=head2 Terminating commands (Ctrl-C handling)
+
+Commands executed within C<perldl> can be terminated prematurely
+using C<Ctrl-C> (or whichever key sequence sends an INT signal
+to the process on your terminal). Provided your PDL code does not
+ignore C<sigint>s this should throw you back at the C<perldl>
+command prompt:
+
+ pdl> $result = start_lengthy_computation()
+ <Ctrl-C>
+ Ctrl-C detected
+
+ pdl>
+
+=head2 Shortcuts and aliases
+
+=over
+
+=item *
+
+The shell aliases C<p> to be a convenient short form of C<print>, e.g.
+
+ pdl> p ones 5,3
+
+ [
+ [1 1 1 1 1]
+ [1 1 1 1 1]
+ [1 1 1 1 1]
+ ]
+
+=item *
+
+C<q> and C<x> are short-hand for C<quit>.
+
+=item *
+
+C<l> lists the history buffer
+
+ pdl> l # list last 20 commands
+
+ pdl> l 40 # list last 40 commands
+
+=item *
+
+C<?> is an alias for L<help|PDL::Doc::Perldl/help>
+
+ pdl> ? pdl2 # get help for new pdl2 shell
+
+=item *
+
+C<??> is an alias for L<apropos|PDL::Doc::Perldl/apropos>
+
+ pdl> ?? PDL::Doc
+
+=item *
+
+L<help|PDL::Doc::Perldl/help>, L<apropos|PDL::Doc::Perldl/apropos>,
+L<usage|PDL::Doc::Perldl/usage> and L<sig|PDL::Doc::Perldl/sig>:
+all words after these commands are used verbatim and not evaluated
+by perl. So you can write, e.g.,
+
+ pdl> help help
+
+instead of
+
+ pdl> help 'help'
+
+=back
+
+
+=head2 Command-line options
+
+B<perldl> and B<pdl> support several command-line options to adjust the behavior of the
+session. Most of them are equivalent to commands that can be entered at the B<pdlE<gt>>
+prompt. They are:
+
+=over 4
+
+=item -glut
+
+Load OpenGL when starting the shell (the perl OpenGL module,
+which is available from CPAN must be installed). This enables
+readline event loop processing. Don't use with -tk.
+
+=item -tk
+
+Load Tk when starting the shell (the perl Tk module, which is
+available from CPAN must be installed). This enables readline
+event loop processing. Don't use with -glut.
+
+=item -f file
+
+Loads the file before processing any user input. Any errors
+during the execution of the file are fatal.
+
+=item -w
+
+Runs with warning messages (i.e. the normal perl C<-w> warnings)
+turned-on.
+
+=item -M module
+
+Loads the module before processing any user input.
+Compare corresponding C<perl> switch.
+
+=item -m module
+
+Unloads the module before processing any user input.
+
+=item -I directory
+
+Adds directory to the include path. (i.e. the @INC array)
+Compare corresponding C<perl> switch.
+
+=item -V
+
+Prints a summary of PDL config. This information should
+be included with any PDL bug report. Compare corresponding
+C<perl> switch.
+
+=back
+
+=head2 The startup file F<~/.perldlrc>
+
+If the file F<~/.perldlrc> is found it is sourced at start-up to load default
+modules, set shell variables, etc. If it is NOT found the distribution file
+F<PDL/default.perldlrc> is read instead. This loads various modules
+considered useful by default, and which ensure compatibility with
+v1.11. If you don't like this and want a more streamlined set of your
+own favourite modules simple create your own F<~/.perldlrc>. You may
+wish to start from the existing F<PDL/default.perldlrc> as a template
+since it will not be sourced once you replace it with your own version.
+
+To set even more local defaults the file F<local.perldlrc> (in the current
+directory) is sourced if found. This lets you load modules and define
+subroutines for the project in the current directory.
+
+The name is chosen specfically because it was found hidden files were
+NOT wanted in these circumstances.
+
+The startup file should normally include "use PDL::AutoLoader;", as
+many of the nicer interactive features won't work without it.
+
+=head2 Shell variables
+
+Shell variables: (I<Note>: if you don't like the defaults change
+them in F<~/.perldlrc>)
+
+=over
+
+=item *
+
+$PERLDL::ESCAPE - default value '#'
+
+Any line starting with this character is treated as a shell
+escape. The default value is chosen because it escapes the
+code from the standard perl interpreter.
+
+=item *
+
+$PERLDL::HISTFILESIZE - default value 500
+
+This is the number of lines of perldl shell command history
+to keep.
+
+=item *
+
+$PERLDL::PAGER - default value C<more>
+
+External program to filter the output of commands. Using C<more>
+prints output one screenful at a time. On Unix, setting C<page(1)>
+and $PERLDL::PAGER to C<tee -a outfile> will keep a record of the
+output generated by subsequent perldl commands (without paging).
+
+=item *
+
+$PERLDL::PROMPT - default value 'pdl> '
+
+Enough said But can also be set to a subroutine reference, e.g.
+$PERLDL::PROMPT = sub {join(':',(gmtime)[2,1,0]).'> '} puts the
+current time into the prompt.
+
+=item *
+
+$PERLDL::MULTI - default value 1
+
+If this is set to a true value, then perldl will parse multi-line
+perl blocks: your input will not be executed until you finish a line
+with no outstanding group operators (such as quotes, blocks, parenthesis, or
+brackets) still active. Continuation lines have a different prompt that
+shows you what delimiters are still active.
+
+Note that this is not (yet!) a complete perl parser. In particular,
+Text::Balanced appears to be able to ignore quoting operatores
+like C<q/ ... /> within a line, but not to be able to extend them across
+lines. Likewise, there is no support for the '<<' operator.
+
+Multiline conventional strings and {}, [], and () groupings are well
+supported.
+
+=item *
+
+$PERLDL::NO_EOF - default value 0 / 1 on MSWin32
+
+Protects against accidental use of "^D" from the terminal. If this is
+set to a true value, then you can't accidentally exit perldl by typing
+"^D". If you set it to a value larger than 1 (and PERLDL::MULTI is
+set), then you can't use "^D" to exit multiline commands either. If
+you're piping commands in from a file or pipe, this variable has no
+effect.
+
+
+=item *
+
+$HOME
+
+The user's home directory
+
+=item *
+
+$PERLDL::TERM
+
+This is the Term::ReadLine object associated with the perldl
+shell. It can be used by routines called from perldl if your
+command is interactive.
+
+=item *
+
+$PDL::toolongtoprint
+
+The maximal size pdls to print (defaults to 10,000 elements).
+This is not just a C<perldl> or C<pdl2> variable but it is
+something that is usually needed in an interactive debugging
+session.
+
+=back
+
+=head2 Executing scripts from the C<perldl> prompt
+
+A useful idiom for developing perldl scripts or editing functions
+on-line is
+
+ pdl> # emacs script &
+ -- add perldl code to script and save the file
+
+ pdl> do 'script'
+
+-- substitute your favourite window-based editor for 'emacs' (you may
+also need to change the '&' on non-Unix systems).
+
+Running "do 'script'" again updates any variables and function
+definitions from the current version of 'script'.
+
+=head2 Executing perldl scripts from the command line
+
+PDL scripts are just perl scripts that happen to use PDL (and
+possibly PDL::NiceSlice). But for the truly lazy, perldl can be
+invokes as a script interpreter. Because perldl is itself an interpreted
+perl script, most unices won't allow you to say "#!/usr/bin/perldl"
+at the top of your script.
+
+Instead, say "#!/usr/bin/pdl" and your script will be executed exactly
+as if you typed it, line-by-line, into the perldl shell.
+
+=head2 Command preprocessing
+
+NOTE: This feature is used by default by L<PDL::NiceSlice|PDL::NiceSlice>.
+See below for more about slicing at the C<perldl> prompt
+
+In some cases, it is convenient to process commands before they are
+sent to perl for execution. For example, this is the case where the
+shell is being presented to people unfamiliar with perl but who wish
+to take advantage of commands added locally (eg by automatically
+quoting arguments to certain commands).
+
+*I<NOTE>*: The preprocessing interface has changed from earlier
+versions! The old way using C<$PERLDL::PREPROCESS> will still
+work but is strongly deprecated and might go away in the future.
+
+You can enable preprocessing by registering a filter with the
+C<preproc_add> function. C<preproc_add> takes one argument which
+is the filter to be installed. A filter is a Perl code reference (usually
+set in a local configuration file) that will be called, with the
+current command string as argument, just prior to the string being
+executed by the shell. The modified string should be returned. Note
+that you can make C<perldl> completely unusable if you fail to
+return the modified string; quitting is then your only option.
+
+Filters can be removed from the preprocessing pipeline by calling
+C<preproc_del> with the filter to be removed as argument. To find out
+if a filter is currently installed in the preprocessing pipeline use
+C<preproc_registered>:
+
+ pdl> preproc_add $myfilter unless preproc_registered $myfilter;
+
+Previous versions of C<perldl> used the variable C<$PERLDL::PREPROCESS>.
+This will still work but should be avoided. Please change your scripts
+to use the C<preproc_add> etc functions.
+
+The following code would check for a call to function 'mysub'
+and bracket arguments with qw.
+
+ $filter = preproc_add sub {
+ my $str = shift;
+ $str =~ s/^\s+//; # Strip leading space
+ if ($str =~ /^mysub/) {
+ my ($command, $arguments) = split(/\s+/,$str, 2);
+ $str = "$command qw( $arguments )"
+ if (defined $arguments && $arguments !~ /^qw/);
+ };
+ # Return the input string, modified as required
+ return $str;
+ };
+
+This would convert:
+
+ pdl> mysub arg1 arg2
+
+to
+
+ pdl> mysub qw( arg1 arg2 )
+
+which Perl will understand as a list. Obviously, a little more effort
+is required to check for cases where the caller has supplied a normal
+list (and so does not require automatic quoting) or variable
+interpolation is required.
+
+You can remove this preprocessor using the C<preproc_del> function
+which takes one argument (the filter to be removed, it must be the
+same coderef that was returned from a previous C<preproc_add> call):
+
+ pdl> preproc_del $filter;
+
+An example of actual usage can be found in the C<perldl> script. Look
+at the function C<trans> to see how the niceslicing preprocessor is
+enabled/disabled.
+
+=head2 C<perldl> and L<PDL::NiceSlice|PDL::NiceSlice>
+
+L<PDL::NiceSlice|PDL::NiceSlice> introduces a more convenient
+slicing syntax for piddles. In current versions of C<perldl> and
+C<pdl2> niceslicing is enabled by default (if the required CPAN
+modules are installed on your machine).
+
+At startup C<perldl> will let you
+know if niceslicing is enabled. The startup message will contain
+info to this end, something like this:
+
+ perlDL shell v1.XX
+ PDL comes with ABSOLUTELY NO WARRANTY. For details, see the file
+ 'COPYING' in the PDL distribution. This is free software and you
+ are welcome to redistribute it under certain conditions, see
+ the same file for details.
+ ReadLines, NiceSlice enabled
+ Reading /home/csoelle/.perldlrc...
+ Type 'demo' for online demos
+ Loaded PDL v2.XX
+
+When you get such a message that indicates C<NiceSlice> is enabled
+you can use the enhanced slicing syntax:
+
+ pdl> $a = sequence 10;
+ pdl> p $a(3:8:2)
+
+For details consult L<PDL::NiceSlice>.
+
+L<PDL::NiceSlice|PDL::NiceSlice> installs a filter in the
+preprocessing pipeline (see above) to enable the enhanced slicing
+syntax. You can use a few commands in the C<perldl> shell to
+switch this preprocessing on or off and also explicitly check
+the substitutions that the NiceSlice filter makes.
+
+You can switch the L<PDL::NiceSlice|PDL::NiceSlice> filter on and off
+by typing
+
+ pdl> trans # switch niceslicing on
+
+and
+
+ pdl> notrans # switch niceslicing off
+
+respectively. The filter is on by default.
+
+To see how your commands are translated
+switch reporting on:
+
+ pdl> report 1;
+ pdl> p $a(3:8:2)
+ processed p $a->nslice([3,8,2])
+ [3 5 7]
+
+Similarly, switch reporting off as needed
+
+ pdl> report 0;
+ pdl> p $a(3:8:2)
+ [3 5 7]
+
+Reporting is off by default.
+
+=head2 Automatically execute your own hooks
+
+The variable @PERLDL::AUTO is a simple list of perl code strings
+and/or code reference. It is used to define code to be
+executed automatically every time the user enters a new line.
+
+A simple example would be to print the time of each command:
+
+ pdl> push @PERLDL::AUTO,'print scalar(gmtime),"\n"'
+
+ pdl> print zeroes(3,3)
+ Sun May 3 04:49:05 1998
+
+ [
+ [0 0 0]
+ [0 0 0]
+ [0 0 0]
+ ]
+
+ pdl> print "Boo"
+ Sun May 3 04:49:18 1998
+ Boo
+ pdl>
+
+Or to make sure any changes in the file 'local.perldlrc' are
+always picked up :-
+
+ pdl> push @PERLDL::AUTO,"do 'local.perldlrc'"
+
+This code can of course be put *in* 'local.perldlrc', but
+be careful :-) [Hint: add C<unless ($started++)> to above
+to ensure it only gets done once!]
+
+Another example application is as a hook for Autoloaders
+(e.g. PDL::AutoLoader) to add code too which allows them to
+automatically re-scan their files for changes. This is
+extremely convenient at the interactive command line. Since
+this hook is only in the shell it imposes no inefficiency on
+PDL scripts.
+
+Finally note this is a very powerful facility - which means
+it should be used with caution!
+
+
+
+=cut
+
+!NO!SUBS!
+
+close OUT;
+chmod 0555, $file;
diff --git a/perldl.conf b/perldl.conf
new file mode 100755
index 0000000..f8a0d55
--- /dev/null
+++ b/perldl.conf
@@ -0,0 +1,250 @@
+#!/usr/bin/perl
+# -*-perl-*-
+
+# PDL Configuration options
+
+# You can edit this here or say 'perl Makefile.PL PDLCONF=file'
+# or use ~/.perldl.conf
+
+# Note in general "0" means False, "1" means "True" and "undef"
+# means "Try if possible (e.g. because the library is found)"
+#
+# You can also use a string that matches /^y/i to mean True or
+# one that matches /^n/i to mean False. It will be automatically
+# converted to 1 or 0 before being loaded into the Config.pm module.
+#
+
+%PDL_CONFIG = (
+#
+# Version of the perldl.conf file. This should be incremented
+# in the units for any PDL visible changes to the file (i.e.,
+# the non-comment ones). Other changes may be indicated by
+# the fractional part but are more for informational purposes.
+#
+ PDL_CONFIG_VERSION => 0.005,
+ PDL_BUILD_VERSION => undef, # filled in by Makefile.PL
+ PDL_BUILD_DIR => undef, # filled in by Makefile.PL
+
+#
+# Do we generate HTML documentation? This is normally a good idea,
+# as it's nice to browse -- but many folks don't use it, preferring
+# the man page and/or help versions of the documentation. Undef or 1
+# causes the HTML documentation to be built; 0 turns it off.
+#
+ HTML_DOCS => 1,
+
+# Location of directory for temporary files created during the
+# build/test process. See the getpdl_config() routine in Makefile.PL
+# for the choice made if TEMPDIR is left as 'undef': it boils down to
+# the first value that is defined from
+# $TEMP, $TMP, or "/tmp" [a TEMP directory for MSWin users]
+#
+
+ TEMPDIR => undef,
+
+# Decides if the output of attempts to link various function
+# during 'perl Makefile.PL' will be hidden when building PDL
+# should only be set to 0 for debugging purposes
+# see also L<trylink|PDL::Core::Dev/trylink>
+
+ HIDE_TRYLINK => 1,
+
+# you can set machine specific optimizations here the settings will be
+# passed to the toplevel Makefile.PL which *should* pass it to any
+# recursively invoked ones. Add -O0 to turn off compiler
+# optimization, and -g to produce debugging information that GDB and
+# other debuggers can use.
+
+ OPTIMIZE => undef, # '-O0 -g',
+
+# Use posix threading to make use of multiprocessor machines
+# undef -> try if possible
+# 0 -> don't use
+# true -> force use
+
+ WITH_POSIX_THREADS => undef,
+
+ POSIX_THREADS_INC => undef, # '-I/usr/pthread/include'
+ POSIX_THREADS_LIBS => undef, # '-L/usr/pthread -lpthreadGC2'
+
+ MALLOCDBG => undef,
+# {
+# include => '-I/home/csoelle/tmp',
+# libs => '-L/home/csoelle/tmp -lmymalloc',
+# define => << 'EOD',
+##define malloc(n) dbgmalloc(n,__FILE__,__LINE__)
+##define free(p) dbgfree(p)
+#EOD
+# include => '',
+# libs => '-lefence',
+# define => '',
+# },
+
+# Do we want routines to handle bad values?
+# saying no will make PDL a bit faster
+# true -> yes
+# false -> no, undef -> no
+#
+# WITH_BADVAL => 0,
+ WITH_BADVAL => 1,
+
+# if WITH_BADVAL == 1, do we use NaN/Inf to represent badvalues
+# (not convinced setting this results in faster code)
+#
+ BADVAL_USENAN => 0,
+# BADVAL_USENAN => 1,
+
+# The original BADVAL implementation assigned bad-values on pdl-types,
+# not per pdl, setting the following to one will make it a pdl-variable
+# THIS IS AN EXPERIMENTAL FEATURE -- BEWARE...
+
+ BADVAL_PER_PDL => 0,
+# BADVAL_PER_PDL => 1,
+
+# Try to build Graphics/TriD
+#
+# true -> force build of PDL::Graphics:::TriD
+# false -> skip build of PDL::Graphics:::TriD
+# undef -> let PDL build decide based on dependencies present
+#
+ WITH_3D => undef,
+
+# Build Graphics/TriD using Perl OpenGL
+#
+# true -> use new Perl OpenGL bindings
+# false -> use legacy, deprecated X11 only bindings
+# undef -> let PDL build decide (check if Perl OpenGL is present)
+#
+ USE_POGL => undef,
+# USE_POGL => 0,
+#
+ POGL_VERSION => 0.6702, # minimum compatible OpenGL version
+
+# POGL_WINDOW_TYPE => 'x11', # use X11+GLX for windows
+ POGL_WINDOW_TYPE => 'glut', # use GLUT for windows
+
+## Whether or not to build the PLplot interface module
+#
+# default settings (let PDL build decide whether to build PLPLOT)
+#
+ WITH_PLPLOT => 0, # Leave it up to PDL to decide
+ WHERE_PLPLOT_LIBS => undef, # let PDL search for plplot installation
+ WHERE_PLPLOT_INCLUDE => undef, # let PDL search for plplot installation
+
+# Example manual settings:
+# WITH_PLPLOT => 1, # Build PLPLOT interface
+# WHERE_PLPLOT_LIBS => '/usr/local/plplot/lib', # PLplot lib dir
+# WHERE_PLPLOT_INCLUDE => '/usr/local/plplot/include', # PLplot include dir
+
+
+# Whether or not to build the PDL::Slatec module
+# false -> don't use
+# true -> force use
+
+ WITH_SLATEC => undef, # Leave it up to PDL to decide
+
+# Whether or not to build the PDL::Minuit module
+# false -> don't use
+# true -> force use
+
+ WITH_MINUIT => undef, # Leave it up to PDL to decide
+
+# If MINUIT_LIB is undef a standalone version of Minuit will be compiled
+# and PDL::Minuit will link to this library (fortran code can be found
+# at Lib/Minuit/minuitlib)
+# If you want to try to link directly to the Minuit present
+# in the CERN library libpacklib.a, include the full path to the library
+# here, e.g., MINUIT_LIB => '/usr/local/lib/libpacklib.a',
+
+ MINUIT_LIB => undef,
+
+# Whether or not to build the PDL::GSL module
+# false -> don't use
+# true -> force use
+
+ WITH_GSL => undef, # Leave it up to PDL to decide
+
+# Link flags for the GSL libs, e.g. '-L/usr/local/lib -lgsl -lm'
+ GSL_LIBS => undef, # use gsl-config
+
+# Location to find GSL includes:
+ GSL_INC => undef, # use gsl-config
+
+# Whether or not to build the PDL::FFTW module
+# NOTE: PDL::FFTW has been moved to its own CPAN
+# distribution and has been deprecated.
+# Please install from CPAN.
+
+ WITH_FFTW => 0, # Don't build PDL::FFTW
+ FFTW_LIBS => undef, # [ '/lib','/usr/lib','/usr/local/lib'],
+ FFTW_INC => undef, # ['/usr/include/','/usr/local/include'],
+ FFTW_TYPE => 'double',
+
+# Whether or not to build the PDL::IO::HDF module
+# false -> don't use
+# true -> force use
+
+ WITH_HDF => undef, # Leave it up to PDL to decide
+ HDF_LIBS => undef,
+ HDF_INC => undef,
+
+# Whether or not to build the PDL::IO::GD module
+# false -> don't use
+# true -> force use
+
+ WITH_GD => undef, # Leave it up to PDL to decide
+ GD_LIBS => undef,
+ GD_INC => undef,
+
+# Whether or not to build the PDL::GIS::Proj module
+# false -> don't use
+# true -> force use
+#
+ WITH_PROJ => undef, # Leave it up to PDL to decide
+ PROJ_LIBS => undef,
+ PROJ_INC => undef,
+
+# N.B. These are array ref values and *not* strings
+#
+# PROJ_LIBS => [ 'C:/_32/msys/1.0/local/lib'],
+# PROJ_INC => [ 'C:/_32/msys/1.0/local/include'],
+
+# Do we build PDL::IO::Browser?
+# default -> do not build
+#
+ WITH_IO_BROWSER => 0,
+
+# Quiet Astro::FITS::Header warnings for PDL build process by default
+# Eventually would be better to set undef by default, and have the
+# Makefile.PL change the value after it has been found missing once.
+# TBD after PDL 2.4.3 release...
+#
+ FITS_LEGACY => 1,
+
+# Whether or not to enable the new Devel::REPL based PDL shell
+# Given the large numbers of dependencies for Devel::REPL, we
+# don't want to have that as a required dependency for PDL.
+# Still, if it is there already, we could use it...
+#
+# false -> don't install pdl2 support
+# true -> force pdl2 install (default)
+
+ WITH_DEVEL_REPL => 1,
+
+# Set this for official CPAN releases of PDL since these
+# tests will always fail until they are fixed. It can also
+# be set from the value of the environment variable of the
+# same name.
+#
+ SKIP_KNOWN_PROBLEMS => 0,
+#
+# Set this to make the pdldoc command ignore PDL::AutoLoader
+# routines (*.pdl files in your @PDLLIB path). While most
+# users will want the new behavior, the performance impact
+# could be noticable. Setting this to 1 will turn off the
+# new feature.
+#
+ PDLDOC_IGNORE_AUTOLOADER => 0,
+);
+
+1; # Return OK status on 'require'
diff --git a/t/aaa_load.t b/t/aaa_load.t
new file mode 100644
index 0000000..b71db8d
--- /dev/null
+++ b/t/aaa_load.t
@@ -0,0 +1,6 @@
+# Test whether the system loads at all.
+
+BEGIN{print "1..1\n";}
+use PDL::LiteF;
+
+print "ok 1\n";
diff --git a/t/argtest.t b/t/argtest.t
new file mode 100644
index 0000000..cf14a46
--- /dev/null
+++ b/t/argtest.t
@@ -0,0 +1,54 @@
+# tests for error checking of input args to PP compiled function
+#
+use PDL::LiteF;
+use vars qw/$a $b/;
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+# sub tapprox {
+# my($a,$b,$c,$d) = @_;
+# $c = abs($a-$b);
+# $d = max($c);
+# return $d < 0.01;
+# }
+
+
+sub eprint {
+ print "EXPECT ERROR NEXT:\n-----\n";
+ print $_[0];
+ print "-----\n";
+}
+
+print "1..4\n";
+
+$b=pdl([1,2,3])->long;
+$a=[1,2,3];
+eval 'PDL::Ufunc::sumover($a,$b)';
+
+ok(1,!$@);
+
+$aa=3;
+$a=\$aa;
+eval 'PDL::Ufunc::sumover($a,$b)';
+eprint $@;
+ok(2,$@ =~ /Error - tried to use an unknown/);
+
+eval { PDL::Ufunc::sumover({}) };
+eprint $@;
+
+ok 3, $@ =~ /Hash given as a pdl - but not \{PDL} key/;
+
+
+$c = 0;
+eval { PDL::Ufunc::sumover(\$c) };
+eprint $@;
+
+ok 4, $@ =~ /Error - tried to use an unknown/;
+
+
diff --git a/t/autoload.t b/t/autoload.t
new file mode 100644
index 0000000..e5a0989
--- /dev/null
+++ b/t/autoload.t
@@ -0,0 +1,48 @@
+# -*-perl-*-
+
+# Test PDL::AutoLoader
+
+use strict;
+
+use Test::More;
+
+use PDL::LiteF;
+
+BEGIN {
+
+ if ( ! -f 't/func.pdl' ) {
+ plan skip_all => 'This test must be run from ../t';
+ }
+ else {
+ plan tests => 3;
+ }
+
+ use_ok('PDL::AutoLoader');
+
+}
+
+use vars qw( @PDLLIB );
+$PDL::debug = 1;
+
+ at PDLLIB = ("t/"); # this means you have to run the test from ../t
+
+my $x = long(2 + ones(2,2));
+
+my $y = func($x);
+
+ok( (sum($y) == 4*29), 'Check autoload of func.pdl' );
+
+#check that tilde expansion works (not applicable on MS Windows)
+SKIP: {
+ skip "Inapplicable to MS Windows", 1 if $^O =~ /MSWin/i;
+ my $tilde = (PDL::AutoLoader::expand_path('~'))[0];
+ my $get = $ENV{'HOME'} || (getpwnam( getlogin || getpwuid($<) ))[7];
+ my $echo = qx(echo ~);
+ chomp $echo;
+
+ if ($echo !~ /^~/) {
+ is($tilde, $echo, "Check tilde expansion (Got '$get' from (getpwnam(getpwuid(\$<)))[7] )");
+ } else {
+ is($tilde, $get, "Check tilde expansion (Got '$echo' from echo ~");
+ }
+}
diff --git a/t/bad.t b/t/bad.t
new file mode 100644
index 0000000..3dd9527
--- /dev/null
+++ b/t/bad.t
@@ -0,0 +1,512 @@
+# -*-perl-*-
+#
+# test bad value handling in PDL
+# - as it's a compile-time option we
+# skip unless $PDL::Config{WITH_BADVAL}
+#
+
+use strict;
+use Test::More;
+
+# although approx() caches the tolerance value, we
+# use it in every call just to document things
+#
+use constant ABSTOL => 1.0e-4;
+
+use File::Temp qw( tempfile );
+my $fname;
+{
+ local $^W = 0;
+ (undef, $fname) = tempfile( 'delmeXXXXX', SUFFIX => '.fits', OPEN => 0 );
+}
+
+END {
+ unlink $fname if -e $fname;
+}
+
+use PDL::LiteF;
+$| = 1;
+
+use PDL::Config;
+if ( $PDL::Config{WITH_BADVAL} ) {
+ plan tests => 79;
+} else {
+ # reduced testing
+ plan tests => 10;
+
+ my $a = pdl(1,2,3);
+ is( $a->badflag(), 0 ); # 1
+
+ my $b = pdl(4,5,6);
+ my $c = $a + $b;
+ is( $c->badflag(), 0 ); # 2
+ is( $c->sum(), 21 ); # 3
+
+ # can not set the bad flag
+ $a->badflag(1);
+ is( $a->badflag(), 0 );
+
+ # and piddles do not have a bad value
+ ok( ! defined $a->badvalue );
+
+ # can not change a piddle to include bad values
+ ok( all( ($a->setbadif( $a == 2 ) - pdl(1,2,3)) == 0 ) );
+
+ $a = ones(3,2,4);
+ $b = zeroes(2,4);
+ $c = ones(2,4) * 3;
+ is( $a->nbad, 0 );
+ is( $a->ngood, 24 );
+ ok( all( ($a->nbadover - $b) == 0 ) );
+ ok( all( ($a->ngoodover - $c) == 0 ) );
+
+ exit;
+}
+
+my $usenan = $PDL::Config{BADVAL_USENAN} || 0;
+my $perpdl = $PDL::Config{BADVAL_PER_PDL} || 0;
+
+# check default behaviour (ie no bad data)
+# - probably overkill
+#
+my $a = pdl(1,2,3);
+is( $a->badflag(), 0, "no badflag" );
+
+my $b = pdl(4,5,6);
+my $c = $a + $b;
+is( $c->badflag(), 0, "badflag not set in a copy" );
+is( $c->sum(), 21, "sum() works on non bad-flag piddles" );
+
+# is the flag propogated?
+$a->badflag(1);
+ok( $a->badflag(), "bad flag is now set" );
+
+$c = $a + $b;
+ok( $c->badflag(), "bad flag is propogated" );
+is( $c->sum(), 21, "sum is still 21 with badflag set" );
+
+$a->badflag(0);
+$b->badflag(1);
+$c = $a + $b;
+ok( $c->badflag(), "badflag propogates on rhs of 'a+b'" );
+
+# how about copies/vaffines/whatever
+$a = rvals( long, 7, 7, {Centre=>[2,2]} );
+$b = $a;
+is( $b->badflag, 0, "badflag not set in a copy" );
+
+$a->badflag(1);
+$b = $a;
+ok( $b->badflag, "badflag is now set in a copy" );
+
+$a->badflag(0);
+$b = $a->slice('2:5,3:4');
+$c = $b->slice('0:1,(0)');
+is( $b->badflag, 0, "slice handling okay with no badflag" );
+
+$a->badflag(1);
+
+my $i = "Type: %T Dim: %-15D State: %5S Dataflow: %F";
+print "Info: a = ", $a->info($i), "\n";
+print "Info: b = ", $b->info($i), "\n";
+print "Info: c = ", $b->info($i), "\n";
+
+# let's check that it gets through to a child of a child
+ok( $c->badflag, "badflag propogated throufh to a child" );
+
+# can we change bad values
+is( byte->badvalue, byte->orig_badvalue, "byte bad value is set to the default value" );
+byte->badvalue(23);
+is( byte->badvalue, 23, "changed bad value for byte" );
+byte->badvalue( byte->orig_badvalue );
+
+# check setbadat()
+$a = pdl(1,2,3,4,5);
+$a->setbadat(2);
+is( PDL::Core::string($a), "[1 2 BAD 4 5]", "setbadat worked" );
+
+# now check that badvalue() changes the piddle
+# (only for integer types)
+$a = convert($a,ushort);
+my $badval = $a->badvalue;
+$a->badvalue(44);
+is( PDL::Core::string($a), "[1 2 BAD 4 5]", "changed badvalue" );
+$a->badflag(0);
+is( PDL::Core::string($a), "[1 2 44 4 5]", "can remove the bad value setting" );
+
+# restore the bad value
+$a->badvalue($badval);
+
+$a = byte(1,2,3);
+$b = byte(1,byte->badvalue,3);
+$a->badflag(1);
+$b->badflag(1);
+
+# does string work?
+# (this has implicitly been tested just above)
+#
+is( PDL::Core::string($b), "[1 BAD 3]", "can convert bad values to a string" );
+
+# does addition work
+$c = $a + $b;
+is( sum($c), 8, "addition propogates the bad value" );
+
+# does conversion of bad types work
+$c = float($b);
+ok( $c->badflag, "type conversion retains bad flag" );
+is( PDL::Core::string($c), "[1 BAD 3]", " and the value" );
+is( sum($c), 4, " and the sum" );
+
+$a = byte(1,2,byte->badvalue,byte->badvalue,5,6,byte->badvalue,8,9);
+$a->badflag(1);
+
+is( PDL::Core::string($a->isbad), "[0 0 1 1 0 0 1 0 0]", "isbad() works" );
+is( PDL::Core::string($a->isgood), "[1 1 0 0 1 1 0 1 1]", "isgood() works" );
+
+is( $a->nbad, 3, "nbad() works" );
+is( $a->ngood, 6, "ngood() works" );
+
+$a = byte( [255,255], [0,255], [0,0] );
+$a->badflag(1);
+
+is( PDL::Core::string($a->nbadover), "[2 1 0]", "nbadover() works" );
+is( PDL::Core::string($a->ngoodover), "[0 1 2]", "ngoodover() works" );
+
+# check dataflow (or vaffine or whatever it's called)
+$a = byte( [1,2,byte->badvalue,4,5], [byte->badvalue,0,1,2,byte->badvalue] );
+$a->badflag(1);
+$b = $a->slice(',(1)');
+is( sum($b), 3, "sum of slice works" );
+$b++;
+is( PDL::Core::string($a),
+ "\n[\n [ 1 2 BAD 4 5]\n [BAD 1 2 3 BAD]\n]\n",
+ "inplace addition of slice flows back to parent"
+ );
+
+$a = byte->badvalue * ones(byte,3,2);
+is( $a->get_datatype, 0, "datatype remains a byte" );
+$a->badflag(1);
+is( PDL::Core::string( zcover($a) ), "[BAD BAD]", "zcover() okay" );
+$a->set(1,1,1);
+$a->set(2,1,1);
+is( PDL::Core::string( zcover($a) ), "[BAD 0]", " and still okay" );
+
+# 255 is the default bad value for a byte array
+#
+$a = byte(1,2,255,4,5);
+is( $a->median, 4, "median() works on good piddle" );
+$a->badflag(1);
+is( $a->median, 3, "median() works on bad biddle" );
+
+# as random() creates numbers between 0 and 1 it won't
+# accidentally create a bad value by chance (the default
+# bad value for a double is either a very negative
+# number or NaN).
+#
+$a = random(20);
+$a->badflag(1);
+is( $a->check_badflag, 0, "check_badflag did not find a bad value" );
+
+$i = "Type: %T Dim: %-15D State: %5S Dataflow: %F";
+
+# check out stats, since it uses several routines
+# and setbadif
+$a = pdl( qw(42 47 98 13 22 96 74 41 79 76 96 3 32 76 25 59 5 96 32 6) );
+$b = $a->setbadif( $a < 20 );
+my @s = $b->stats();
+ok( approx( $s[0], 61.9375, ABSTOL ), "setbadif/stats test 1" );
+ok( approx( $s[1], 27.6079, ABSTOL ), "setbadif/stats test 2" );
+is( $s[2], 66.5, "setbadif/stats test 3" );
+is( $s[3], 22, "setbadif/stats test 4" );
+is( $s[4], 98, "setbadif/stats test 5" );
+ok( approx( $s[6], 26.7312, ABSTOL ), "setbadif/stats test 6" );
+
+# how about setbadtoval (was replacebad)
+$a = $b->setbadtoval(20) - pdl(qw(42 47 98 20 22 96 74 41 79 76 96 20 32 76 25 59 20 96 32 20));
+ok( all($a == 0), "setbadtoval() worked" );
+
+# and inplace?
+$a = pdl( qw(42 47 98 13 22 96 74 41 79 76 96 3 32 76 25 59 5 96 32 6) );
+$b = $a->setbadif( $a < 20 );
+$b->inplace->setbadtoval(20);
+$a = $b - pdl(qw(42 47 98 20 22 96 74 41 79 76 96 20 32 76 25 59 20 96 32 20));
+ok( all($a == 0), " and inplace" );
+
+# ditto for copybad
+$a = pdl( qw(42 47 98 13 22 96 74 41 79 76 96 3 32 76 25 59 5 96 32 6) );
+$b = $a->setbadif( $a < 20 );
+$c = copybad( $a, $b );
+is( PDL::Core::string( $c->isbad ),
+ "[0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1]",
+ "isbad() worked" );
+
+$a = pdl( qw(42 47 98 13 22 96 74 41 79 76 96 3 32 76 25 59 5 96 32 6) );
+$b = $a->setbadif( $a < 20 );
+$a->inplace->copybad( $b );
+is( PDL::Core::string( $a->isbad ),
+ "[0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 1 0 0 1]",
+ " and inplace" );
+
+## $a->inplace->setbadif( $a % 2 ) does NOT work because
+## ($a % 2) is performed inplace - ie the flag is set for
+## that function
+#
+##$a = sequence(3,3);
+##$a->inplace->setbadif( $a % 2 );
+###$a = $a->setbadif( $a % 2 ); # for when not bothered about inplace
+##ok( PDL::Core::string( $a->clump(-1) ),
+## "[0 BAD 2 BAD 4 BAD 6 BAD 8]" ); #
+
+## look at propogation of bad flag using inplace routines...
+$a = sequence( byte, 2, 3 );
+$a = $a->setbadif( $a == 3 );
+$b = $a->slice("(1),:");
+$a->inplace->setbadtoval(3);
+is( $b->badflag, 0, "badflag cleared using inplace setbadtoval()" );
+
+$a = sequence( byte, 2, 3 );
+$b = $a->slice("(1),:");
+my $mask = sequence( byte, 2, 3 );
+$mask = $mask->setbadif( ($mask % 3) == 2 );
+print "a,b == ", $a->badflag, ",", $b->badflag, "\n";
+$a->inplace->copybad( $mask );
+print "a,b == ", $a->badflag, ",", $b->badflag, "\n";
+print "$a $b\n";
+is( $b->badflag, 1, "badflag propogated using inplace copybad()" );
+
+# test some of the qsort functions
+$a = pdl( qw(42 47 98 13 22 96 74 41 79 76 96 3 32 76 25 59 5 96 32 6) );
+$b = $a->setbadif( $a < 20 );
+my $ix = qsorti( $b );
+is( PDL::Core::string( $b->index($ix) ),
+ "[22 25 32 32 41 42 47 59 74 76 76 79 96 96 96 98 BAD BAD BAD BAD]",
+ "qsorti() okay"
+ ); #
+
+# check comparison/bit operators in ops.pd
+
+$a = pdl( 2, 4, double->badvalue );
+$a->badflag(1);
+$b = abs( $a - pdl(2.001,3.9999,234e23) ) > 0.01;
+is( PDL::Core::string( $b ), "[0 0 BAD]", "abs() and >" );
+
+$b = byte(1,2,byte->badvalue,4);
+$b->badflag(1);
+is( PDL::Core::string( $b << 2 ), "[4 8 BAD 16]", "<<" );
+
+$a = pdl([1,2,3]);
+$a->badflag(1);
+$b = $a->assgn;
+is( $b->badflag, 1, "assgn propogated badflag");
+$a->badflag(0);
+is( $b->badflag, 1, "assgn is not a deep copy for the badflag");
+
+# quick look at math.pd
+use PDL::Math;
+
+$a = pdl(0.5,double->badvalue,0);
+$a->badflag(1);
+$b = bessj0($a);
+is( PDL::Core::string( isbad($b) ), "[0 1 0]", "bessj0()" );
+
+$a = pdl(double->badvalue,0.8);
+$a->badflag(1);
+$b = bessjn($a,3); # thread over n()
+is( PDL::Core::string( isbad($b) ), "[1 0]", "thread over bessjn()" );
+ok( abs($b->at(1)-0.010) < 0.001 );
+
+$a = pdl( 0.01, 0.0 );
+$a->badflag(1);
+ok( all( abs(erfi($a)-pdl(0.00886,0)) < 0.001 ), "erfi()" );
+
+# I haven't changed rotate, but it should work anyway
+$a = byte( 0, 1, 2, 4, 5 );
+$a->setbadat(2);
+is( PDL::Core::string( $a->rotate(2) ), "[4 5 0 1 BAD]", "rotate()" );
+
+# check norm
+$a = float( 2, 0, 2, 2 )->setvaltobad(0.0);
+$b = $a->norm;
+$c = $a/sqrt(sum($a*$a));
+ok( all( approx( $b, $c, ABSTOL ) ), "norm()" );
+
+# Image2D
+my $ans = pdl(
+ [ 3, 7, 11, 21, 27, 33, 39, 45, 51, 27],
+ [ 3, 5, 13, 21, 27, 33, 39, 45, 51, 27],
+ [ 3, 9, 15, 21, 27, 33, 39, 45, 51, 27]
+);
+
+$a = xvals zeroes 10,3;
+$a->setbadat(2,1);
+
+$b = pdl [1,2],[2,1];
+
+use PDL::Image2D;
+$c = conv2d($a, $b);
+
+is( int(at(sum($c-$ans))), 0, "conv2d()" );
+
+$a = zeroes(5,5);
+$a->badflag(1);
+my $t = $a->slice("1:3,1:3");
+$t .= ones(3,3);
+$a->setbadat(2,2);
+
+$b = sequence(3,3);
+$ans = pdl ( [0,0,0,0,0],[0,0,2,0,0],[0,1,5,2,0],[0,0,4,0,0],[0,0,0,0,0]);
+is( int(at(sum(med2d($a,$b)-$ans))), 0, "med2d()" );
+
+# propogation of badflag using inplace ops (ops.pd)
+
+# test biop fns
+$a = sequence(3,3);
+$c = $a->slice(',(1)');
+$b = $a->setbadif( $a % 2 );
+$a->inplace->plus($b,0);
+print $a;
+print "$c\n";
+is( PDL::Core::string($c), "[BAD 8 BAD]", "inplace biop - plus()" );
+
+# test bifunc fns
+$a = sequence(3,3);
+$c = $a->slice(',(1)');
+$b = $a->setbadif( $a % 3 != 0 );
+$a->inplace->power($b,0);
+print $a;
+print "$c\n";
+is( PDL::Core::string($c), "[27 BAD BAD]", "inplace bifunc - power()" );
+
+# test histogram (using hist)
+$a = pdl( qw/1 2 3 4 5 4 3 2 2 1/ );
+$a->setbadat(1);
+$b = hist $a, 0, 6, 1;
+print "values: $a\n";
+print "histogram: $b\n";
+is( PDL::Core::string($b), "[0 2 2 2 2 1]", "hist()" );
+
+#$b = $a->isfinite;
+#print "isfinite(A): datatype = [",$b->get_datatype,"]\n";
+
+$a->inplace->isfinite;
+#print "A: datatype = [",$a->get_datatype,"]\n";
+is( PDL::Core::string($a), "[1 0 1 1 1 1 1 1 1 1]", "isfinite()" );
+#print "A: datatype = [",$a->get_datatype,"]\n";
+
+# histogram2d
+$a = long(1,1,1,2,2);
+$b = long(2,1,1,1,1);
+$b->setbadat(0);
+my @c = ( 1,0,3 );
+$c = histogram2d($a,$b, at c, at c);
+is( PDL::Core::string($c->clump(-1)),
+ "[0 0 0 0 2 2 0 0 0]",
+ "histogram2d()" );
+
+# weird propogation of bad values
+# - or is it?
+#
+#$a = sequence( byte, 2, 3 );
+#$a = $a->setbadif( $a == 3 );
+#$b = $a->slice("(1),:");
+#$a .= $a->setbadtoval(3);
+#ok( $a->badflag, 0 ); # this fails
+#ok( $b->badflag, 0 ); # as does this
+
+# badmask: inplace
+$a = sequence(5);
+$a->setbadat(2);
+$a->inplace->badmask(0);
+is( PDL::Core::string($a), "[0 1 0 3 4]", "inplace badmask()" );
+
+# setvaltobad
+$a = sequence(10) % 4;
+$a->inplace->setvaltobad( 1 );
+like( PDL::Core::string( $a->clump(-1) ),
+ qr{^\[-?0 BAD 2 3 -?0 BAD 2 3 -?0 BAD]$}, "inplace setvaltobad()" );
+
+# check setvaltobad for non-double piddles
+my $fa = pdl( float, 1..4) / 3;
+my $da = pdl( double, 1..4) / 3;
+ok( all($fa->setvaltobad(2/3)->isbad == $da->setvaltobad(2/3)->isbad), "setvaltobad for float piddle");
+
+# simple test for setnantobad
+# - could have a 1D FITS image containing
+# NaN's and then a simple version of rfits
+# (can't use rfits as does conversion!)
+$a->inplace->setnantobad;
+like( PDL::Core::string( $a->clump(-1) ),
+ qr{^\[-?0 BAD 2 3 -?0 BAD 2 3 -?0 BAD]$}, "inplace setnantobad()" );
+
+# test r/wfits
+use PDL::IO::FITS;
+
+$a = sequence(10)->setbadat(0);
+print "Writing to fits: $a type = (", $a->get_datatype, ")\n";
+$a->wfits($fname);
+$b = rfits($fname);
+print "Read from fits: $b type = (", $b->get_datatype, ")\n";
+
+ok( $b->slice('0:0')->isbad, "rfits/wfits propogated bad flag" );
+ok( sum(abs($a-$b)) < 1.0e-5, " and values" );
+
+# now force to integer
+$a->wfits($fname,16);
+$b = rfits($fname);
+print "BITPIX 16: datatype == ", $b->get_datatype, " badvalue == ", $b->badvalue(), "\n";
+ok( $b->slice('0:0')->isbad, "wfits coerced bad flag with integer datatype" );
+ok( sum(abs(convert($a,short)-$b)) < 1.0e-5, " and the values" );
+
+# check that we can change the value used to represent
+# missing elements for floating points (earlier tests only did integer types)
+# IF we are not using NaN's
+#
+SKIP: {
+ skip( "Skipped: test only valid when not using NaN's as bad values", 2 )
+ if $usenan;
+
+ # perhaps should check that the value can't be changed when NaN's are
+ # being used.
+ #
+
+ is( float->badvalue, float->orig_badvalue, "default bad value for floats matches" );
+ is( float->badvalue(23), 23, "changed floating-point bad value" );
+ float->badvalue( float->orig_badvalue );
+}
+
+SKIP: {
+
+ skip ("Skipped: test only valid when enabling bad values per pdl", 3)
+ unless $perpdl;
+
+ $a = sequence(4);
+ $a->badvalue(3);
+ $a->badflag(1);
+ $b = $a->slice('2:3');
+ is( $b->badvalue, 3, "can propogate per-piddle bad value");
+ is( $b->sum, 2, "and the propogated value is recognised as bad");
+
+ $a = sequence(4);
+ is ($a->badvalue, double->orig_badvalue, "no long-term affects of per-piddle changes [1]");
+
+}
+
+SKIP: {
+ skip ("Skipped: test not valid if per-piddle bad values are used", 1)
+ if $perpdl;
+
+ $a = double(4);
+ double->badvalue(3);
+ is($a->badvalue, double->badvalue, "no long-term affects of per-piddle changes [2]");
+ double->badvalue(double->orig_badvalue);
+
+}
+
+# At the moment we do not allow per-piddle bad values
+# and the use of NaN's.
+#TODO: {
+# local $TODO = "Need to work out whan NaN and per-piddle bad values means";
+# is (0, 1);
+#}
+
+# end
diff --git a/t/basic.t b/t/basic.t
new file mode 100644
index 0000000..7134923
--- /dev/null
+++ b/t/basic.t
@@ -0,0 +1,72 @@
+# -*-perl-*-
+
+use strict;
+use Test::More;
+
+BEGIN {
+ plan tests => 19;
+}
+
+use PDL::LiteF;
+
+sub tapprox {
+ my($a,$b) = @_;
+ my $d = max( abs($a-$b) );
+ $d < 1.0e-6;
+}
+
+# test rvals
+# synonym for centre/center
+# squared option
+# (x|y|z)(lin|log)vals, axisvals
+
+my $x0 = pdl( [ 2, 1, 2 ], [ 1, 0, 1 ], [ 2, 1, 2 ] );
+
+my $a1 = rvals(3,3);
+#print "\na1: $a1\n";
+ok( tapprox( $x0->sqrt, $a1 ), "centered rvals" ); # 1
+
+my $a2 = rvals(3,3,{squared=>1});
+#print "\na2: $a2\n";
+ok( tapprox( $x0, $a2 ), "centered rvals squared" ); # 2
+
+my $x1 = pdl( [ 8, 5, 4 ], [ 5, 2, 1 ], [ 4, 1, 0 ] );
+
+my $a3 = rvals(3,3,{centre=>[2,2]});
+#print "\na3: $a3\n";
+ok( tapprox( $x1->sqrt, $a3 ), "non-centered rvals" ); # 3
+
+my $a4 = rvals(3,3,{center=>[2,2]});
+#print "\na4: $a4\n";
+ok( tapprox( $x1->sqrt, $a4 ), "centre/center synonyms" ); # 4
+
+ok( tapprox( $x1->sqrt, rvals(3,3,{ceNteR=>[2,2]}) ), "ceNteR option capitalization" ); # 5
+
+ok( tapprox( $x1, rvals(3,3,{center=>[2,2],squared=>1}) ), "both center and squared options" ); # 6
+
+# test (x|y|z)(lin|log)vals: shape and values
+my $a=zeroes(101,51,26);
+my $x = $a->xlinvals(0.5,1.5);
+my $y = $a->ylinvals(-2,-1);
+my $z = $a->zlinvals(-3,2);
+ok(all($a->shape==$x->shape), "xlinvals shape"); #7
+ok(all($a->shape==$y->shape), "ylinvals shape"); #8
+ok(all($a->shape==$z->shape), "zlinvals shape"); #9
+ok(tapprox($x->uniqvec->flat,pdl(50..150)/100),"xlinvals values"); #10
+ok(tapprox($y->mv(1,0)->uniqvec->flat,pdl(-100..-50)/50),"ylinvals values"); #11
+ok(tapprox($z->mv(2,0)->uniqvec->flat,pdl(0..25)/5-3),"zlinvals values"); #12
+
+my $a = zeroes(11,6,8);
+my $xl = $a->xlogvals(1e2,1e12);
+my $yl = $a->ylogvals(1e-3,1e2);
+my $zl = $a->zlogvals(1e-10,1e-3);
+ok(all($a->shape==$xl->shape),"xlogvals shape"); #13
+ok(all($a->shape==$yl->shape),"ylogvals shape"); #14
+ok(all($a->shape==$zl->shape),"zlogvals shape"); #15
+ok(tapprox($xl->uniqvec->flat->log10,pdl(2..12)),"xlogvals values"); #16
+ok(tapprox($yl->mv(1,0)->uniqvec->flat->log10,pdl(-3..2)),"ylogvals values"); #17
+ok(tapprox($zl->mv(2,0)->uniqvec->flat->log10,pdl(-10..-3)),"zlogvals values");#18
+
+#test axisvals
+my $z = axisvals(zeroes(3,4,5,6),3);
+ok(all($z==pdl(0..5)->dummy(0,5)->dummy(0,4)->dummy(0,3)),"4-dimensional axisvals");#19
diff --git a/t/bess.t b/t/bess.t
new file mode 100644
index 0000000..04d4603
--- /dev/null
+++ b/t/bess.t
@@ -0,0 +1,32 @@
+# -*-perl-*-
+
+use Test;
+
+BEGIN { plan tests => 6; }
+
+use PDL::LiteF;
+use PDL::Math;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub tapprox {
+ my($a,$b) = @_;
+ $c = abs($a-$b);
+ $d = max($c);
+ $d < 0.01;
+}
+
+ok( tapprox(bessj0(0.5),0.9384) && tapprox(bessj0(0),1) );
+ok( tapprox(bessj1(0.1),0.0499) && tapprox(bessj1(0),0) );
+ok( tapprox(bessjn(0.8,3),0.010) && tapprox(bessyn(0.2,2),-32.15714) );
+
+# test inplace
+$a = pdl(0.5,0.0);
+$a->inplace->bessj0;
+ok( tapprox($a,pdl(0.9384,1)) );
+
+$a = pdl(0.2);
+$a->inplace->bessyn(2);
+ok( tapprox( $a, -32.15714 ) ); # 5
+
+ok( tapprox( pow(2,3),8)); # test for the pow bug
diff --git a/t/bool.t b/t/bool.t
new file mode 100644
index 0000000..df73c48
--- /dev/null
+++ b/t/bool.t
@@ -0,0 +1,37 @@
+use PDL::LiteF;
+
+$|=1;
+
+# PDL::Core::set_debugging(1);
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+sub pok { print "ok $_[0]\n" }
+
+print "1..5\n";
+
+$a = zeroes 1,1,1;
+if ($a) { print "not " }
+pok 1;
+
+$a = ones 3;
+eval {print "oops\n" if $a};
+print "ERROR WAS: '$@'\n";
+ok(2,$@ =~ /multielement/);
+
+unless (all $a) { print "not " };
+pok 3;
+
+$a = pdl byte, [ 0, 0, 1 ];
+unless (any $a > 0) { print "not " };
+pok 4;
+
+$a = ones 3;
+$b = $a + 1e-4;
+ok(5, all PDL::approx $a, $b, 1e-3);
diff --git a/t/callext.c b/t/callext.c
new file mode 100644
index 0000000..e455542
--- /dev/null
+++ b/t/callext.c
@@ -0,0 +1,81 @@
+
+/*
+
+ Example C routine for how to use callext() in PDL
+ - return log x to base y vector.
+
+ E.g. on Solaris this would be compiled:
+
+ cc -o callext.so -G -Kpic callext.c
+
+ to generate dynamically loadable code. For other systems
+ see the man pages on your C compiler or the Perl config
+ information.
+
+*/
+
+#include <stdio.h>
+#include <math.h>
+
+/* For WindowsNT you have to make sure that the relevant routine
+ is exported by the dll otherwise it will not be loadable even if it
+ can be linked. In this example we use the __declspec declaration.
+ The same effect can be achieved with .def files although currently
+ CallExt.pm does not know to use them */
+#ifdef WIN32
+#define DLLEXPORT __declspec(dllexport)
+#else
+#define DLLEXPORT
+#endif
+
+#include "pdlsimple.h"
+
+/* This is the action routine */
+
+void loglog_doit( float *x, float *y, int nvals) {
+
+ int i;
+
+ for (i=0; i<nvals; i++)
+ x[i] = log((float)x[i])/log((float)y[i]);
+}
+
+/*
+ This is the hook routine - nargs is the number of
+ arguments and *args is an array of pdl structures
+*/
+
+DLLEXPORT int loglog_ext(int nargs, pdlsimple **args) {
+
+ pdlsimple* x;
+ pdlsimple* y;
+
+ /* Check args */
+
+ printf("\nExecuting the C external routine\n\n");
+
+ if (nargs != 2) {
+ fprintf(stderr, "Error in number of arguments\n");
+ return (0); /* Failure */
+ }
+
+ x = args[0]; y = args[1];
+
+ if (x->datatype != PDL_F || y->datatype != PDL_F) {
+ fprintf(stderr, "Error in data type of arguments %d %d\n",
+ x->datatype, y->datatype);
+ return (0); /* Failure */
+ }
+
+ if (x->nvals != y->nvals) {
+ fprintf(stderr, "Number of data values unequal in arguments\n");
+ return(0); /* Failure */
+ }
+
+ /* Now do the buisness! */
+
+ loglog_doit( (float*) x->data, (float*) y->data, (int) x->nvals);
+
+ return(1); /* Success! */
+}
+
diff --git a/t/callext.t b/t/callext.t
new file mode 100644
index 0000000..e0c8ebe
--- /dev/null
+++ b/t/callext.t
@@ -0,0 +1,77 @@
+#!/usr/local/bin/perl
+
+END { unlink 't/callext.pdb';}; # In case we build a 2nd time,
+ # but using a different Microsoft compiler
+
+# Example of how to use callext() - also see callext.c
+
+use strict;
+use Test;
+use Config;
+
+BEGIN { plan tests => 1;
+}
+use PDL;
+use PDL::CallExt;
+
+use PDL::Core ':Internal'; # For topdl()
+use Config;
+use File::Spec;
+
+kill 'INT',$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub tapprox {
+ my($a,$b) = @_;
+ my $c = abs($a-$b);
+ my $d = max($c);
+ $d < 0.01;
+}
+
+# Create the filenames
+my $cfile = File::Spec->catfile('t', 'callext.c');
+# include the pdlsimple.h that's in blib.
+my $inc = File::Spec->catdir('blib', 'lib', 'PDL', 'Core');
+my $out = File::Spec->catfile('t', 'callext.'.$Config{dlext});
+
+# Compile the code
+
+callext_cc($cfile, "-I$inc", '', $out);
+
+my $y = sequence(5,4)+2; # Create PDL
+my $x = $y*20+100; # Another
+
+my $try = loglog($x,$y);
+my $correct = log(float($x))/log(float($y));
+
+print "Try = $try\n";
+print "Correct = $correct\n";
+ok( tapprox($try, $correct) );
+
+# Return log $x to base $y using callext() routine -
+# perl wrapper makes this nice and easy to use.
+
+sub loglog {
+
+ die 'Usage: loglog($x,$y)' if scalar(@_)!=2;
+
+ # Tips:
+ #
+ # (i) topdl() forces arguments to be pdl vars even
+ # if ordinary numbers are passed
+ #
+ # (ii) float() forces the pdl vars to be float precision
+ # thus matching the C routine.
+
+ my $x = float(topdl(shift));
+ my $y = float(topdl(shift));
+
+ my $ret = $x->copy; # Make copy of $x to return
+
+ print "X = $x\n";
+ print "Y = $y\n";
+
+ my $ldfile =
+ callext($out, "loglog_ext", $ret, $y);
+
+ return $ret;
+}
diff --git a/t/clump.t b/t/clump.t
new file mode 100644
index 0000000..7acada8
--- /dev/null
+++ b/t/clump.t
@@ -0,0 +1,102 @@
+# Test ->clump(). This is not yet good enough: we need
+# nasty test cases
+
+use PDL::LiteF;
+
+$|=1;
+
+# PDL::Core::set_debugging(1);
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+
+#$a = zeroes(4,4) * zeroes(4,4);
+# $a = zeroes(4,4) ;
+
+#print $a;
+#
+#print $a->at(3,3);
+#
+#exit 4;
+
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+sub tapprox {
+ my($a,$b) = @_;
+ my $c = abs($a-$b);
+ my $d = max($c);
+ print "C AND D: $a,$b,$c,$d\n";
+ $d < 0.01;
+}
+
+if(0) {
+ $a0 = zeroes(3,3);
+ print $a0;
+ $b0 = 10 * $a0;
+ print $b0;
+}
+
+$a0 = zeroes(3,3);
+# $a = $a0->PDL::Core::new_or_inplace($a0);
+$a = $a0->copy;
+$b = $a->xchg(0,1);
+print $a;
+# PDL::Primitive::axisvalues($b);
+# print $a;
+
+print "1..3\n";
+
+$a0 = xvals(zeroes(3,3));
+
+print $a0;
+
+$a1 = yvals(zeroes(3,3));
+
+print $a1;
+
+$a2 = 10*$a1;
+
+print $a2;
+
+$a3 = $a0 + $a1;
+
+print $a3;
+
+$a = xvals(zeroes(3,3)) + 10*yvals(zeroes(3,3));
+
+ print $a;
+
+$b = $a->clump(-1);
+
+# $b->make_physical();
+
+# $a->jdump();
+# $b->jdump();
+
+print $b;
+
+ok(1,tapprox($b,pdl [0,1,2,10,11,12,20,21,22]));
+
+# print $b;
+
+$c = $a->slice('0:2:2,:');
+
+$d = $c->clump(-1);
+
+$e = $d->slice("2:4");
+
+$f = ""; # Warning eater
+
+$f= $e->copy();;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+# ok(2,$@ =~ /^clump: Increments do not match/);
+# Clump supports this now.
+ok(2,tapprox($d,pdl [0,2,10,12,20,22]));
+
+ok(3,tapprox($e,pdl [10,12,20]));
diff --git a/t/complex.t b/t/complex.t
new file mode 100644
index 0000000..1c1467b
--- /dev/null
+++ b/t/complex.t
@@ -0,0 +1,82 @@
+use PDL::LiteF;
+use PDL::Complex;
+use PDL::Config;
+
+BEGIN {
+ use Test::More tests => 17;
+}
+
+sub tapprox {
+ my($a,$b) = @_;
+ my $c = abs($a-$b);
+ my $d = max($c);
+ $d < 0.0001;
+}
+
+$ref = pdl([[-2,1],[-3,1]]);
+$a = i - pdl(2,3);
+
+ok(ref $a eq PDL::Complex, 'type promotion i - piddle');
+ok(tapprox($a->real,$ref), 'value from i - piddle');
+
+$a = pdl(2,3) - i;
+ok(ref $a eq PDL::Complex, 'type promption piddle - i');
+ok(tapprox($a->real,-$ref), 'value from piddle - i');
+
+# dataflow from complex to real
+$ar = $a->real;
+$ar++;
+ok(tapprox($a->real, -$ref+1), 'complex to real dataflow');
+
+# Check that converting from re/im to mag/ang and
+# back we get the same thing
+$a = cplx($ref);
+my $b = $a->Cr2p()->Cp2r();
+ok(tapprox($a-$b, 0), 'check re/im and mag/ang equivalence');
+
+# to test Cabs, Cabs2, Carg (ref PDL)
+# Catan, Csinh, Ccosh, Catanh, Croots
+
+$cabs = sqrt($a->re**2+$a->im**2);
+
+ok(ref Cabs $a eq 'PDL', 'Cabs type');
+ok(ref Cabs2 $a eq 'PDL', 'Cabs2 type');
+ok(ref Carg $a eq 'PDL', 'Carg type');
+ok(tapprox($cabs, Cabs $a), 'Cabs value');
+ok(tapprox($cabs**2, Cabs2 $a), 'Cabs2 value');
+
+# Check cat'ing of PDL::Complex
+$b = $a->copy + 1;
+my $bigArray = $a->cat($b);
+ok(abs($bigArray->sum() + 8 - 4*i) < .0001, 'check cat for PDL::Complex');
+
+my $z = pdl(0) + i*pdl(0);
+$z **= 2;
+
+ok($z->at(0) == 0 && $z->at(1) == 0, 'check that 0 +0i exponentiates correctly'); # Wasn't always so.
+
+my $zz = $z ** 0;
+
+ok($zz->at(0) == 1 && $zz->at(1) == 0, 'check that 0+0i ** 0 is 1+0i');
+
+$z **= $z;
+
+ok($z->at(0) == 1 && $z->at(1) == 0, 'check that 0+0i ** 0+0i is 1+0i');
+
+my $r = pdl(-10) + i*pdl(0);
+$r **= 2;
+
+ok($r->at(0) < 100.000000001 && $r->at(0) > 99.999999999 && $r->at(1) == 0,
+ 'check that imaginary part is exactly zero'); # Wasn't always so
+
+TODO: {
+ local $TODO = "Known_problems sf.net bug #1176614" if ($PDL::Config{SKIP_KNOWN_PROBLEMS} or exists $ENV{SKIP_KNOWN_PROBLEMS} );
+
+
+ # Check stringification of complex piddle
+ # This is sf.net bug #1176614
+ my $c = 9.1234 + 4.1234*i;
+ my $c211 = $c->dummy(2,1);
+ my $c211str = "$c211";
+ ok($c211str=~/(9.123|4.123)/, 'sf.net bug #1176614');
+}
diff --git a/t/config.t b/t/config.t
new file mode 100644
index 0000000..78e058f
--- /dev/null
+++ b/t/config.t
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+#
+# Verify that the Config.pm values were updated from the
+# actual build process. Quick placeholder tests for now.
+# Eventually need to check that the configuration matches
+# the result of use_ok or some such.
+
+BEGIN {
+ use Test::More tests => 14; # 13 WITH_ keys and 1 use_ok test
+}
+
+BEGIN {
+ use_ok( 'PDL::Config' );
+}
+
+TODO: {
+ # This is Known_problems bug sf.net #3030998
+ # PDL::Config does not match actual build configuration
+ local $TODO = 'Known_problem sf.net bug #3030998' if ($PDL::Config{SKIP_KNOWN_PROBLEMS} or exists $ENV{SKIP_KNOWN_PROBLEMS} );
+
+ # generate list of WITH_* keys from PDL::Config
+ my @keys = grep { /^WITH_/ } keys %PDL::Config;
+ foreach my $key ( @keys ) {
+ # there should be no undef values
+ ok( defined $PDL::Config{$key} , "check $key in Config.pm" );
+ }
+}
+
+# done_testing();
diff --git a/t/constants.t b/t/constants.t
new file mode 100644
index 0000000..f34c4b4
--- /dev/null
+++ b/t/constants.t
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+#
+# Simple tests for PDL::Constants
+#
+BEGIN {
+ use Test::More tests => 3;
+}
+
+BEGIN {
+ use_ok( 'PDL::Constants', qw(PI E) );
+}
+
+# just checks values, assumes constant part is ok
+ok( abs( PI - 3.14159265358979 ) < 0.0001, 'PI is defined');
+ok( abs( E - 2.71828182845905 ) < 0.0001, 'E is defined');
+
+# need to add tests for imaginary units (TODO)
+
+# done_testing();
diff --git a/t/constructor.t b/t/constructor.t
new file mode 100644
index 0000000..785defd
--- /dev/null
+++ b/t/constructor.t
@@ -0,0 +1,202 @@
+#!/usr/bin/perl
+#
+# Test for bug in the pdl constructor for mixed arguments.
+# Separate from core.t because the problem crashes perl
+# and I'd like to keep the granularity of the core.t tests
+#
+use Test::More tests => 80;
+use PDL::LiteF;
+use PDL::Config;
+
+my $scalar = 1;
+my $pdl_e = pdl([]);
+my $pdl_s = pdl(2);
+my $pdl_v = pdl(3,4);
+my $pdl_vec2 = pdl([9,10]);
+my $pdl_m = pdl([5,6],[7,8]);
+my $pdl_row = pdl([[10,11]]);
+my $pdl_col = pdl([[12],[13]]);
+
+
+##############################
+# Test the basics (21 tests)
+isa_ok($pdl_s, 'PDL');
+
+is $pdl_s->ndims(), 0, "scalar goes to scalar PDL";
+is $pdl_s, 2, "PDL gets assigned scalar value";
+
+is $pdl_v->ndims(), 1, "vector dims";
+is $pdl_v->dim(0), 2, "vector size is 2";
+is !!($pdl_v->at(0)==3 && $pdl_v->at(1)==4), 1, "vector contents";
+
+is $pdl_vec2->ndims(), 1, "vector2 dims";
+is $pdl_vec2->dim(0),2, "vector2 size is 2";
+is !!($pdl_vec2->at(0)==9 && $pdl_vec2->at(1)==10), 1, "vector2 contents";
+
+is $pdl_m->ndims(), 2, "matrix dims";
+is $pdl_m->dim(0), 2, "matrix is 2 wide";
+is $pdl_m->dim(1), 2, "matrix is 2 high";
+is !!($pdl_m->at(0,0)==5 && $pdl_m->at(1,0)==6 && $pdl_m->at(0,1)==7 && $pdl_m->at(1,1)==8), 1, "matrix contents";
+
+is $pdl_row->ndims(), 2, "row dims";
+is $pdl_row->dim(0), 2, "row is 2 wide";
+is $pdl_row->dim(1), 1, "row is 1 tall";
+is !!($pdl_row->at(0,0)==10 && $pdl_row->at(1,0)==11), 1, "row contents";
+
+is $pdl_col->ndims(), 2, "col dims";
+is $pdl_col->dim(0), 1, "col is 1 wide";
+is $pdl_col->dim(1), 2, "col is 2 tall";
+is !!($pdl_col->at(0,0)==12 && $pdl_col->at(0,1)==13), 1, "col contents";
+
+##############################
+# Test more complex array-ingestion case (6 tests) with padding
+my @a = (1,[2,3],[[4,5],[6,7]]);
+my $pdl_a = pdl(@a);
+my @testvals = ( [ [0,0,0], 1 ],
+ [ [1,0,0], 0 ],
+ [ [0,1,0], 0 ],
+ [ [1,1,0], 0 ],
+ [ [0,0,1], 2 ],
+ [ [1,0,1], 0 ],
+ [ [0,1,1], 3 ],
+ [ [1,1,1], 0 ],
+ [ [0,0,2], 4 ],
+ [ [1,0,2], 5 ],
+ [ [0,1,2], 6 ],
+ [ [1,1,2], 7 ]
+ );
+
+is $pdl_a->ndims(), 3, 'complex array case dims';
+is $pdl_a->dim(0), 2, 'complex dim 0';
+is $pdl_a->dim(1), 2, 'complex dim 1';
+is $pdl_a->dim(2), 3, 'complex dim 2';
+
+my $test_ok = 1;
+for my $i(0..$#testvals) {
+ $test_ok *= $pdl_a->at( @{$testvals[$i]->[0]} ) == $testvals[$i]->[1];
+}
+is $test_ok, 1, "contents of complex array-ingestion case";
+
+{
+ local $PDL::undefval = 99;
+ $pdl_a = pdl(@a);
+ $test_ok = 1;
+ for my $i(0..$#testvals) {
+ $test_ok *= $pdl_a->at( @{$testvals[$i]->[0]} ) == ($testvals[$i]->[1] || 99);
+ }
+ is $test_ok, 1, "complex array-ingestion with variant padding";
+}
+
+##############################
+# Test some basic PDL-as-PDL cases
+
+## Ingest a scalar PDL
+my $p = pdl($pdl_s);
+isa_ok($p, 'PDL');
+is $p->ndims(), 0, "scalar PDL goes to scalar PDL";
+is $p, $pdl_s, "pdl(pdl(2)) same as pdl(2)";
+
+## Ingest five scalar PDLs -- should make a 1-D array
+$p = pdl($pdl_s, $pdl_s, $pdl_s, $pdl_s, $pdl_s);
+isa_ok($p, 'PDL');
+is $p->ndims(), 1, "two scalar PDLs -> a vector";
+is $p->dim(0), 5, "5-vector";
+is $p->at(0), $pdl_s, 'vector element 0 ok';
+is $p->at(1), $pdl_s, 'vector element 1 ok';
+is $p->at(2), $pdl_s, 'vector element 2 ok';
+is $p->at(3), $pdl_s, 'vector element 3 ok';
+is $p->at(4), $pdl_s, 'vector element 4 ok';
+
+## Ingest a vector PDL and a scalar PDL - should make a 2-D array
+$p = pdl($pdl_v, $pdl_s);
+isa_ok($p, 'PDL');
+is $p->ndims(), 2, 'pdl($pdl_v, $pdl_s) -> 2x2 matrix';
+is $p->dim(0), 2, '2 wide';
+is $p->dim(1), 2, '2 high';
+is $p->at(0,0), $pdl_v->at(0), "vector element 0 got copied OK";
+is $p->at(1,0), $pdl_v->at(1), "vector element 1 got copied OK";
+is $p->at(0,1), $pdl_s, "scalar copied OK";
+is $p->at(1,1), $PDL::undefval, "scalar got padded OK";
+
+## Ingest a scalar PDL and a vector PDL - should make a 2-D array
+$p = pdl($pdl_s, $pdl_v);
+isa_ok($p, 'PDL');
+is $p->ndims(), 2, 'pdl($pdl_s, $pdl_v) -> 2x2 matrix';
+is $p->dim(0), 2, '2 wide';
+is $p->dim(1), 2, '2 high';
+is $p->at(0,0), $pdl_s, "scalar copied OK";
+is $p->at(1,0), $PDL::undefval, "scalar got padded OK";
+is $p->at(0,1), $pdl_v->at(0), "vector element 0 got copied OK";
+is $p->at(1,1), $pdl_v->at(1), "vector element 1 got copied OK";
+
+## A more complicated case
+$p = pdl($pdl_s, 5, $pdl_v, $pdl_m, [$pdl_v, $pdl_v]);
+isa_ok($p,'PDL');
+is $p->ndims(), 3, 'complicated case -> 3-d PDL';
+is $p->dim(0), 2, 'complicated case -> dim 0 is 2';
+is $p->dim(1), 2, 'complicated case -> dim 1 is 2';
+is $p->dim(2), 5, 'complicated case -> dim 1 is 5';
+ at testvals = ([ [0,0,0], 2 ], [ [1,0,0], 0 ], [ [0,1,0], 0 ], [ [1,1,0], 0 ],
+ [ [0,0,1], 5 ], [ [1,0,1], 0 ], [ [0,1,1], 0 ], [ [1,1,1], 0 ],
+ [ [0,0,2], 3 ], [ [1,0,2], 0 ], [ [0,1,2], 4 ], [ [1,1,2], 0 ],
+ [ [0,0,3], 5 ], [ [1,0,3], 6 ], [ [0,1,3], 7 ], [ [1,1,3], 8 ],
+ [ [0,0,4], 3 ], [ [1,0,4], 4 ], [ [0,1,4], 3 ], [ [1,1,4], 4 ]
+ );
+$test_ok = 1;
+for my $i(0..$#testvals) {
+ $test_ok *= $p->at(@{$testvals[$i]->[0]}) == $testvals[$i]->[1];
+}
+is $test_ok, 1, "contents of complicated case";
+
+##############################
+# test empty PDLs.
+$p = pdl($pdl_e);
+is $p->nelem, 0, "piddlifying an empty piddle yields 0 elements";
+
+$p = pdl($pdl_e, $pdl_e);
+is $p->ndims, 2, "piddlifying two 0-PDLs makes a 2D-PDL";
+is $p->dim(0),0, "piddlifying two empty piddles makes a 0x2-PDL";
+is $p->dim(1),2, "piddlifying two empty piddles makes a 0x2-PDL";
+eval { $p->at(0,0) };
+ok( $@ =~ m/^Position out of range/ , "can't index an empty PDL with at" );
+
+$p = pdl(pdl([4]),5);
+is $p->ndims, 2, "catenating a 1-PDL and a scalar yields a 2D PDL";
+is $p->dim(0), 1, "catenating a 1-PDL and a scalar yields a 1x2-PDL";
+is $p->dim(1), 2, "catenating a 1-PDL and a scalar yields a 1x2-PDL";
+is $p->at(0,0), 4, "catenating a 1-PDL and a scalar does the Right Thing";
+is $p->at(0,1), 5, "catenating a 1-PDL and a scalar does the Right Thing, redux";
+
+$p = pdl($pdl_e, 5);
+is $p->ndims, 2, "catenating an empty and a scalar yields a 2D PDL";
+is $p->dim(0), 1, "catenating an empty and a scalar yields a 1x2-PDL";
+is $p->dim(1), 2, "catenating an empty and a scalar yields a 1x2-PDL";
+is $p->at(0,0), $PDL::undefval, "padding OK for empty & scalar case";
+is $p->at(0,1), 5, "scalar OK for empty & scalar";
+
+
+$p = pdl(5, $pdl_e);
+is $p->ndims, 2, "catenating a scalar and an empty yields a 2D PDL";
+is $p->dim(0), 1, "catenating a scalar and an empty yields a 1x2-PDL";
+is $p->dim(1), 2, "catenating a scalar and an empty yields a 1x2-PDL";
+is $p->at(0,0), 5, "scalar OK for scalar & empty";
+is $p->at(0,1), $PDL::undefval, "padding OK for scalar & empty";
+
+
+
+
+
+
+# This is from sf.net bug #3011879
+my @c;
+$c[0][0]=pdl(0,4,2,1);
+$c[1][0]=pdl(0,0,1,1);
+$c[2][0]=pdl(0,0,0,1);
+$c[0][1]=pdl(0,0,3,1);
+$c[1][1]=pdl(0,0,2,1);
+$c[2][1]=pdl(5,1,1,1);
+my $d = pdl(@c);
+
+
+
+
diff --git a/t/conv.t b/t/conv.t
new file mode 100644
index 0000000..c351d2f
--- /dev/null
+++ b/t/conv.t
@@ -0,0 +1,47 @@
+# Test conversions. This is not yet good enough: we need
+# nasty test cases,
+
+# 1.9901 - converted to new type semantics + extra test
+
+use Test;
+BEGIN { plan tests => 7 }
+
+use PDL::LiteF;
+use PDL::Types;
+
+# sub tapprox {
+# my($a,$b) = @_;
+# my $c = abs($a-$b);
+# my $d = max($c);
+# ok($d < 0.01);
+# }
+
+$a = pdl 42.4;
+print "A is $a\n";
+
+ok($a->get_datatype,$PDL_D);
+
+$b = byte $a;
+print "B (byte $a) is $b\n";
+
+ok($b->get_datatype,$PDL_B);
+ok($b->at(),42);
+
+$c = $b * 3;
+ok($c->get_datatype, $PDL_B); # $c is the same
+print "C ($b * 3) is $c\n";
+
+$d = $b * 600.0;
+ok($d->get_datatype, $PDL_F); # $d is promoted to float
+print "D ($b * 600) is $d\n";
+
+$pi = 4*atan2(1,1);
+
+$e = $b * $pi;
+ok($e->get_datatype, $PDL_D); # $e needs to be double to represent result
+print "E ($b * $pi) is $e\n";
+
+$f = $b * "-2.2";
+ok($f->get_datatype, $PDL_D); # $e check strings are handled ok
+print "F ($b * string(-2.2)) is $f\n";
+
diff --git a/t/core.t b/t/core.t
new file mode 100644
index 0000000..f588ad7
--- /dev/null
+++ b/t/core.t
@@ -0,0 +1,214 @@
+# -*-perl-*-
+#
+# test some PDL core routines
+#
+
+use strict;
+use Test::More tests => 56;
+
+BEGIN {
+ # if we've got this far in the tests then
+ # we can probably assume PDL::LiteF works!
+ #
+ use_ok( "PDL::LiteF" );
+}
+$| = 1;
+
+sub tapprox ($$) {
+ my ( $a, $b ) = @_;
+ my $d = abs( $a - $b );
+ print "diff = [$d]\n";
+ return $d <= 0.0001;
+}
+
+my $a_long = sequence long, 10;
+my $a_dbl = sequence 10;
+
+my $b_long = $a_long->slice('5');
+my $b_dbl = $a_dbl->slice('5');
+
+my $c_long = $a_long->slice('4:7');
+my $c_dbl = $a_dbl->slice('4:7');
+
+# test 'sclr' method
+#
+is $b_long->sclr, 5, "sclr test of 1-elem pdl (long)";
+is $c_long->sclr, 4, "sclr test of 3-elem pdl (long)";
+
+ok tapprox( $b_dbl->sclr, 5 ), "sclr test of 1-elem pdl (dbl)";
+ok tapprox( $c_dbl->sclr, 4 ), "sclr test of 3-elem pdl (dbl)";
+
+# switch multielement check on
+is( PDL->sclr({Check=>'barf'}), 2, "changed error mode of sclr" );
+
+eval '$c_long->sclr';
+like $@, qr/multielement piddle in 'sclr' call/, "sclr failed on multi-element piddle (long)";
+
+eval '$c_dbl->sclr';
+like $@, qr/multielement piddle in 'sclr' call/, "sclr failed on multi-element piddle (dbl)";
+
+# test reshape barfing with negative args
+#
+eval 'my $d_long = $a_long->reshape(0,-3);';
+like $@, qr/invalid dim size/, "reshape() failed with negative args (long)";
+
+eval 'my $d_dbl = $a_dbl->reshape(0,-3);';
+like $@, qr/invalid dim size/, "reshape() failed with negative args (dbl)";
+
+# test reshape with no args
+my ( $a, $b, $c );
+
+$a = ones 3,1,4;
+$b = $a->reshape;
+ok eq_array( [ $b->dims ], [3,4] ), "reshape()";
+
+# test reshape(-1) and squeeze
+$a = ones 3,1,4;
+$b = $a->reshape(-1);
+$c = $a->squeeze;
+ok eq_array( [ $b->dims ], [3,4] ), "reshape(-1)";
+ok all( $b == $c ), "squeeze";
+
+$c++; # check dataflow
+ok all( $b == $c ), "dataflow"; # should flow back to b
+ok all( $a == 2 ), "dataflow";
+
+# test topdl
+
+isa_ok( PDL->topdl(1), "PDL", "topdl(1) returns a piddle" );
+isa_ok( PDL->topdl([1,2,3]), "PDL", "topdl([1,2,3]) returns a piddle" );
+isa_ok( PDL->topdl(1,2,3), "PDL", "topdl(1,2,3) returns a piddle" );
+$a=PDL->topdl(1,2,3);
+ok (($a->nelem == 3 and all($a == pdl(1,2,3))), "topdl(1,2,3) returns a 3-piddle containing (1,2,3)");
+
+
+# test $PDL::undefval support in pdl (bug #886263)
+#
+is $PDL::undefval, 0, "default value of $PDL::undefval is 0";
+
+$a = [ [ 2, undef ], [3, 4 ] ];
+$b = pdl( $a );
+$c = pdl( [ 2, 0, 3, 4 ] )->reshape(2,2);
+ok all( $b == $c ), "undef converted to 0 (dbl)";
+ok eq_array( $a, [[2,undef],[3,4]] ), "pdl() has not changed input array";
+
+$b = pdl( long, $a );
+$c = pdl( long, [ 2, 0, 3, 4 ] )->reshape(2,2);
+ok all( $b == $c ), "undef converted to 0 (long)";
+
+do {
+ local($PDL::undefval) = -999;
+ $a = [ [ 2, undef ], [3, 4 ] ];
+ $b = pdl( $a );
+ $c = pdl( [ 2, -999, 3, 4 ] )->reshape(2,2);
+ ok all( $b == $c ), "undef converted to -999 (dbl)";
+
+ $b = pdl( long, $a );
+ $c = pdl( long, [ 2, -999, 3, 4 ] )->reshape(2,2);
+ ok all( $b == $c ), "undef converted to -999 (long)";
+} while(0);
+
+##############
+# Funky constructor cases
+
+# pdl of a pdl
+$a = pdl(pdl(5));
+ok all( $a== pdl(5)), "pdl() can piddlify a piddle";
+
+TODO: {
+ local $TODO = 'Known_problems bug sf.net #3011879' if ($PDL::Config{SKIP_KNOWN_PROBLEMS} or exists $ENV{SKIP_KNOWN_PROBLEMS});
+
+ # pdl of mixed-dim pdls: pad within a dimension
+ $a = pdl( zeroes(5), ones(3) );
+ ok all($a == pdl([0,0,0,0,0],[1,1,1,0,0])),"Piddlifying two piddles catenates them and pads to length" or diag("a=$a\n");
+}
+
+# pdl of mixed-dim pdls: pad a whole dimension
+$a = pdl( [[9,9],[8,8]], xvals(3)+1 );
+ok all($a == pdl([[[9,9],[8,8],[0,0]] , [[1,0],[2,0],[3,0]] ])),"can catenate mixed-dim piddles" or diag("a=$a\n");
+
+# pdl of mixed-dim pdls: a hairier case
+$c = pdl [1], pdl[2,3,4], pdl[5];
+ok all($c == pdl([[[1,0,0],[0,0,0]],[[2,3,4],[5,0,0]]])),"Can catenate mixed-dim piddles: hairy case" or diag("c=$c\n");
+
+# same thing, with undefval set differently
+do {
+ local($PDL::undefval) = 99;
+ $c = pdl [1], pdl[2,3,4], pdl[5];
+ ok all($c == pdl([[[1,99,99],[99,99,99]],[[2,3,4],[5,99,99]]])), "undefval works for padding" or diag("c=$c\n");;
+} while(0);
+
+# empty pdl cases
+eval {$a = zeroes(2,0,1);};
+ok(!$@,"zeroes accepts empty PDL specification");
+
+eval { $b = pdl($a,sequence(2,0,1)); };
+ok((!$@ and all(pdl($b->dims) == pdl(2,0,1,2))), "catenating two empties gives an empty");
+
+eval { $b = pdl($a,sequence(2,1,1)); };
+ok((!$@ and all(pdl($b->dims) == pdl(2,1,1,2))), "catenating an empty and a nonempty treats the empty as a filler");
+
+eval { $b = pdl($a,5) };
+ok((!$@ and all(pdl($b->dims)==pdl(2,1,1,2))), "catenating an empty and a scalar on the right works");
+ok( all($b==pdl([[[0,0]]],[[[5,0]]])), "catenating an empty and a scalar on the right gives the right answer");
+
+eval { $b = pdl(5,$a) };
+ok((!$@ and all(pdl($b->dims)==pdl(2,1,1,2))), "catenating an empty and a scalar on the left works");
+ok( all($b==pdl([[[5,0]]],[[[0,0]]])), "catenating an empty and a scalar on the left gives the right answer");
+
+# end
+
+# cat problems
+eval {cat(1, pdl(1,2,3), {}, 6)};
+ok ($@ ne '', 'cat barfs on non-piddle arguments');
+like ($@, qr/Arguments 0, 2 and 3 are not piddles/, 'cat correctly identifies non-piddle arguments');
+$@ = '';
+eval {cat(1, pdl(1,2,3))};
+like($@, qr/Argument 0 is not a piddle/, 'cat uses good grammar when discussing non-piddles');
+$@ = '';
+
+my $two_dim_array = cat(pdl(1,2), pdl(1,2));
+eval {cat(pdl(1,2,3,4,5), $two_dim_array, pdl(1,2,3,4,5), pdl(1,2,3))};
+ok ($@ ne '', 'cat barfs on mismatched piddles');
+like($@, qr/The dimensions of arguments 1 and 3 do not match/
+ , 'cat identifies all piddles with differing dimensions');
+like ($@, qr/\(argument 0\)/, 'cat identifies the first actual piddle in the arg list');
+$@ = '';
+eval {cat(pdl(1,2,3), pdl(1,2))};
+like($@, qr/The dimensions of argument 1 do not match/
+ , 'cat uses good grammar when discussing piddle dimension mismatches');
+$@ = '';
+eval {cat(1, pdl(1,2,3), $two_dim_array, 4, {}, pdl(4,5,6), pdl(7))};
+ok ($@ ne '', 'cat barfs combined screw-ups');
+like($@, qr/Arguments 0, 3 and 4 are not piddles/
+ , 'cat properly identifies non-piddles in combined screw-ups');
+like($@, qr/arguments 2 and 6 do not match/
+ , 'cat properly identifies piddles with mismatched dimensions in combined screw-ups');
+like($@, qr/\(argument 1\)/,
+ 'cat properly identifies the first actual piddle in combined screw-ups');
+$@ = '';
+
+eval {$a = cat(pdl(1),pdl(2,3));};
+ok(!$@, 'cat(pdl(1),pdl(2,3)) succeeds');
+ok( ($a->ndims==2 and $a->dim(0)==2 and $a->dim(1)==2), 'weird cat case has the right shape');
+ok( all( $a == pdl([1,1],[2,3]) ), "cat does the right thing with catting a 0-pdl and 2-pdl together");
+$@='';
+
+# new_or_inplace
+$a = sequence(byte,5);
+
+
+$b = $a->new_or_inplace;
+ok( all($b==$a) && ($b->get_datatype == $a->get_datatype), "new_or_inplace with no pref returns something like the orig.");
+
+$b++;
+ok(all($b!=$a),"new_or_inplace with no inplace flag returns something disconnected from the orig.");
+
+$b = $a->new_or_inplace("float,long");
+ok($b->type eq 'float',"new_or_inplace returns the first type in case of no match");
+
+$b = $a->inplace->new_or_inplace;
+$b++;
+ok(all($b==$a),"new_or_inplace returns the original thing if inplace is set");
+ok(!($b->is_inplace),"new_or_inplace clears the inplace flag");
+
diff --git a/t/croak.t b/t/croak.t
new file mode 100644
index 0000000..242e6e9
--- /dev/null
+++ b/t/croak.t
@@ -0,0 +1,54 @@
+use PDL::LiteF;
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+# sub tapprox {
+# my($a,$b) = @_;
+# $c = abs($a-$b);
+# $d = max($c);
+# $d < 0.01;
+# }
+
+if($^O !~ /mswin32/i) {$SIG{BUS} = \¬_ok}
+$SIG{SEGV} = \¬_ok;
+
+sub not_ok {
+ print STDERR "\ngot fatal signal\n";
+ print "not ok ".$::i."\n";
+ exit;
+}
+
+print "1..4\n";
+
+# PDL::Core::set_debugging(1);
+$b = pdl [[1,1,1],[2,2,2]];
+
+# we are using more dims than are available
+$i = 1;
+eval {$c = $b->slice(':,:,:,(1)'); $c->make_physical();};
+print "ERROR WAS: '$@'\n";
+ok(1,$@ =~ /too many dims/i);
+
+$i++;
+# now see if we survive the destruction of this invalid trans
+$b = zeroes(5,3,3);
+$c = $b->slice(":,:,1");
+ok(2,1); # if we're here we survived
+
+$i++;
+$b = pdl [[1,1,1],[2,2,2]];
+eval {$c = $b->dummy(5,1); $c->make_physical();};
+ok(3,!$@);
+
+$i++;
+$b = zeroes(5,3,3);
+$c = $b->slice(":,:,1");
+ok(4,1);
+
+# if we're here we survived
+
+
diff --git a/t/diskcache.t b/t/diskcache.t
new file mode 100644
index 0000000..b6f5ce8
--- /dev/null
+++ b/t/diskcache.t
@@ -0,0 +1,48 @@
+
+use strict;
+
+use PDL;
+use PDL::Config;
+use File::Temp 'tempdir';
+use File::Spec;
+
+# Temp directory name. The catfile() call adds a trailing dir
+# separator (e.g. "/" on POSIX).
+my $d = File::Spec->catfile(tempdir(CLEANUP=>1),"");
+
+use Test;
+BEGIN { plan tests => 4; }
+
+##1 Make sure the library loads
+
+eval 'use PDL::DiskCache;';
+if($@) {print $@,"\n";}
+ok( !$@ );
+
+##2 Make a DiskCache object
+
+
+eval <<'BAR'
+ do {
+ my($a) = diskcache(["${d}1","${d}2","${d}3"],{verbose=>1});
+ $a->[0] = zeroes(10,10);
+ $a->[1] = xvals(10,10);
+ $a->[2] = yvals(10,10);
+ } while(0);
+BAR
+ ;
+ok( !$@ );
+
+ok( (-e "${d}1") && (-e "${d}2") && (-e "${d}3") );
+
+eval <<'BAZ'
+ do {
+ my($b) = diskcache(["${d}1","${d}2","${d}3"],{ro=>1});
+ ok( ($b->[0]->sum == 0) && ($b->[1]->sum == xvals(10,10)->sum) );
+ }
+BAZ
+ ;
+
+
+# end
+
diff --git a/t/dumper.t b/t/dumper.t
new file mode 100644
index 0000000..3cfb87a
--- /dev/null
+++ b/t/dumper.t
@@ -0,0 +1,92 @@
+
+use strict;
+
+use Test::More;
+
+BEGIN {
+
+ sub inpath {
+ my ($prog) = @_;
+ my $pathsep = $^O =~ /win32/i ? ';' : ':';
+ my $exe = $^O =~ /win32/i ? '.exe' : '';
+ for ( split $pathsep,$ENV{PATH} ) {
+ return 1 if -x "$_/$prog$exe"
+ }
+ return;
+ }
+
+ eval "use Convert::UU;";
+ my $hasuuencode = !$@ || (inpath('uuencode') && inpath('uudecode'));
+
+ if ($hasuuencode) {
+ plan tests => 16;
+ }
+ else {
+ plan skip_all => "Skip neither uuencode/decode nor Convert:UU is available\n";
+ }
+
+ use PDL;
+}
+
+########### First test the load...
+use_ok('PDL::IO::Dumper');
+
+########### Dump several items and make sure we get 'em back...
+# a: trivial
+# b: 0-d
+# c: inline
+# d: advanced expr
+
+my ( $s, $a );
+
+eval '$s = sdump({a=>3,b=>pdl(4),c=>xvals(3,3),d=>xvals(4,4)});';
+ok(!$@, 'Call sdump()')
+ or diag("Call sdump() output string:\n$s\n");
+$a = eval $s;
+ok(!$@, 'Can eval dumped data code') or diag("The output string was '$s'\n");
+ok(ref $a eq 'HASH', 'HASH was restored');
+ok(($a->{a}==3), 'SCALAR value restored ok');
+ok(((ref $a->{b} eq 'PDL') && ($a->{b}==4)), '0-d PDL restored ok');
+ok(((ref $a->{c} eq 'PDL') && ($a->{c}->nelem == 9)
+ && (sum(abs(($a->{c} - xvals(3,3))))<0.0000001)), '3x3 PDL restored ok');
+ok(((ref $a->{d} eq 'PDL') && ($a->{d}->nelem == 16)
+ && (sum(abs(($a->{d} - xvals(4,4))))<0.0000001)), '4x4 PDL restored ok');
+
+########## Dump a uuencoded expr and try to get it back...
+# e: uuencoded expr
+eval '$s = sdump({e=>xvals(25,25)});';
+ok(!$@, 'sdump() of 25x25 PDL to test uuencode dumps');
+
+#diag $s,"\n";
+
+$a = eval $s;
+ok(!$@, 'Can eval dumped 25x25 PDL');
+
+# $s and $@ can be long so try and make things a bit clearer in the
+# output
+#
+if ( $@ ) {
+ diag "--- ERROR ---\n";
+ diag "--Error message start:\n";
+ diag $@;
+ diag "\n--Error message end:\n";
+ diag "String was:\n$s\n";
+ diag "--- ERROR (end) ---\n";
+}
+
+ok((ref $a eq 'HASH'), 'HASH structure for uuencoded 25x25 PDL restored');
+ok(((ref $a->{e} eq 'PDL')
+ && ($a->{e}->nelem==625)
+ && (sum(abs(($a->{e} - xvals(25,25))))<0.0000001)), 'Verify 25x25 PDL restored data');
+
+########## Check header dumping...
+eval '$a = xvals(2,2); $a->sethdr({ok=>1}); $a->hdrcpy(1); $b = xvals(25,25); $b->sethdr({ok=>2}); $b->hdrcpy(0); $s = sdump([$a,$b,yvals(25,25)]);';
+ok(!$@, 'Check header dumping');
+
+$a = eval $s;
+ok((!$@ && (ref $a eq 'ARRAY')), 'ARRAY can restore');
+
+ok(eval('$a->[0]->hdrcpy() == 1 && $a->[1]->hdrcpy() == 0'), 'Check hdrcpy()\'s persist');
+ok(eval('($a->[0]->gethdr()->{ok}==1) && ($a->[1]->gethdr()->{ok}==2)'), 'Check gethdr() values persist');
+
+# end
diff --git a/t/erf.t b/t/erf.t
new file mode 100644
index 0000000..7555258
--- /dev/null
+++ b/t/erf.t
@@ -0,0 +1,30 @@
+# -*-perl-*-
+
+use Test;
+
+BEGIN { plan tests => 5; }
+
+use PDL::LiteF;
+use PDL::Math;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub tapprox {
+ my($a,$b) = @_;
+ $c = abs($a-$b);
+ $d = max($c);
+ $d < 0.01;
+}
+
+ok( tapprox(erf(0.),0.) && tapprox(erf(30.),1.) );
+ok( tapprox(erf(0.5),1.-erfc(0.5)) );
+ok( tapprox(erf(erfi(0.5)),0.5) && tapprox(erfi(erf(0.5)),0.5) );
+
+# now test inplace
+$a = pdl(0.0,30.0);
+$a->inplace->erf;
+ok( tapprox( $a, pdl(0.0,1.0) ) );
+
+$a = pdl(0.5);
+$a->inplace->erfc;
+ok( tapprox( 1.0-$a, erf(0.5) ) );
diff --git a/t/erfi.t b/t/erfi.t
new file mode 100644
index 0000000..64c0597
--- /dev/null
+++ b/t/erfi.t
@@ -0,0 +1,24 @@
+# -*-perl-*-
+
+use Test;
+
+BEGIN { plan tests => 2; }
+
+use PDL::LiteF;
+use PDL::Math;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub tapprox {
+ my($a,$b) = @_;
+ $c = abs($a-$b);
+ $d = max($c);
+ $d < 0.01;
+}
+
+$a = pdl( 0.01, 0.0 );
+ok( tapprox( erfi($a), pdl(0.00886,0.0) ) );
+
+# inplace
+$a->inplace->erfi;
+ok( tapprox( $a, pdl(0.00886,0.0) ) );
diff --git a/t/familyfree.t b/t/familyfree.t
new file mode 100644
index 0000000..f333fc3
--- /dev/null
+++ b/t/familyfree.t
@@ -0,0 +1,31 @@
+use PDL::LiteF;
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+# sub tapprox {
+# my($a,$b,$c,$d) = @_;
+# $c = abs($a-$b);
+# $d = max($c);
+# return $d < 0.01;
+# }
+
+print "1..1\n";
+
+# This is something that would cause an exception on 1.91_00:
+# when the original was undef'd, xchghashes would barf.
+
+$a = xvals zeroes(5,5);
+
+$b = $a->slice(':,2:3');
+
+$a = 1; # Undefine orig. a
+
+$b += 1;
+
+ok(1,1);
diff --git a/t/fastraw.t b/t/fastraw.t
new file mode 100644
index 0000000..d3405a3
--- /dev/null
+++ b/t/fastraw.t
@@ -0,0 +1,118 @@
+
+use PDL::LiteF;
+# PDL::Core::set_debugging(1);
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+use strict;
+use warnings;
+
+# Load the testing harness and PDL
+use Test::More tests => 10;
+use PDL;
+
+# Get a temporary directory and file name, which obviously we'll need for testing
+# saving and reading of data.
+use PDL::Config;
+use File::Temp qw(tempdir);
+
+my $tmpdir = tempdir( CLEANUP=>1 );
+my $name = $tmpdir . "/tmp0";
+my $header = $tmpdir . "/headerfile" . $$;
+unlink $name, $name . '.hdr', $header; # just to be absolutely sure
+
+# A function that tells us if two piddles are approximately the same
+sub tapprox {
+ my($a,$b) = @_;
+ my $c = abs($a-$b);
+ return (max($c) < 0.01);
+}
+
+# **TEST 1** make sure FastRaw loads
+BEGIN { use_ok( 'PDL::IO::FastRaw' ); }
+
+# Set up the working filename and make sure we're working with a clean slate:
+
+# **TEST 2** save a piddle to disk
+my $a = pdl [2,3],[4,5],[6,7];
+writefraw($a,$name);
+ok((-f $name and -f ($name . '.hdr')), "Writing should create a file and header file");
+
+# **TEST 3** read it back, and make sure it gives the same piddle
+my $b = readfraw($name);
+ok(tapprox($a,$b), "A piddle and it's saved copy should be about equal");
+
+# some mapfraw tests
+SKIP:
+{
+ my $c = eval { mapfraw($name) };
+ if ($@) {
+ diag("$@");
+ if ($@ =~ m/mmap not supported/) {
+ skip('no mmap support', 4);
+ }
+ }
+
+ # **TEST 4** compare mapfraw piddle with original piddle
+ ok(tapprox($a,$c), "A piddle and it's mapfraw representation should be about equal");
+
+ # **TEST 5** modifications should be saved when $c goes out of scope
+ $c += 1;
+ undef $c;
+ $b = readfraw($name);
+ ok(tapprox($a+1,$b), "Modifications to mapfraw should be saved to disk no later than when the piddle ceases to exist");
+
+ # We're starting a new test, so we'll remove the files we've created so far
+ # and clean up the memory, just to be super-safe
+ unlink $name, $name . '.hdr';
+ undef $a;
+ undef $b;
+
+ # **TEST 6** test creating a pdl via mapfraw
+ # First create and modify the piddle
+ $a = mapfraw($name, {Creat => 1, Datatype => &float, Dims => [3,2]});
+ $a += xvals $a;
+ $a += 0.1 * yvals $a;
+ # save the contents
+ undef $a;
+ # Load it back up and see if the values are what we expect
+ $b = readfraw($name);
+ ok(tapprox($b, PDL->pdl([[0,1,2],[0.1,1.1,2.1]])),
+ "mapfraw should be able to create new piddles");
+
+ # **TEST 7** test the created type
+ ok($b->type->[0] == (&float)->[0], 'type should be of the type we specified (float)');
+}
+
+# Clean things up a bit
+unlink $name, $name . '.hdr', $header;
+undef $a;
+undef $b;
+
+# Test the file header options:
+
+# **TEST 8** test the use of a custom header for writing
+$a = pdl [2,3],[4,5],[6,7];
+writefraw($a,$name,{Header => $header});
+ok(-f $header, "writefraw should create the special header file when specified");
+
+# **TEST 9** test the use of a custom header for reading
+$b = readfraw($name,{Header => $header});
+ok(tapprox($a,$b), "Should be able to read given a specified header");
+
+# mapfraw custom header tests
+SKIP:
+{
+ my $c = eval { mapfraw($name,{Header => $header}) };
+ if ($@) {
+ diag("$@");
+ if ($@ =~ m/mmap not supported/) {
+ skip('no mmap support', 1);
+ }
+ }
+
+ # **TEST 10** test custom headers for mapfraw
+ ok(tapprox($a,$c), "mapfraw should be able to work with a specified header");
+}
+
+# Clean things up for exit
+unlink $name, $header;
diff --git a/t/fft.t b/t/fft.t
new file mode 100644
index 0000000..42dfbf9
--- /dev/null
+++ b/t/fft.t
@@ -0,0 +1,97 @@
+
+use strict;
+
+use PDL;
+use PDL::Image2D;
+use PDL::FFT;
+
+use Test;
+BEGIN { plan tests => 17; }
+
+sub tapprox {
+ my($a,$b) = @_;
+ my ($c) = abs($a-$b);
+ my $d = max($c);
+ $d < 0.01;
+}
+
+my ( $a, $b, $c, $i, $k, $kk );
+
+foreach my $type(double,float){
+ $a = pdl($type,1,-1,1,-1);
+ $b = zeroes($type,$a->dims);
+ fft($a,$b);
+ ok(all($a==pdl($type,0,0,4,0))); #1,3
+ ifft($a,$b);
+ ok(all($a==pdl($type,1,-1,1,-1))); #2,4
+}
+
+$k = ones(5,5);
+$a = rfits("m51.fits");
+
+$b = $a->copy;
+$c = $b->zeroes;
+fft($b,$c);
+ifft($b,$c);
+ok (tapprox($c,0)); #5
+
+#print "\n",$c->info("Type: %T Dim: %-15D State: %S"),"\n";
+#print "Max: ",$c->max,"\n";
+#print "Min: ",$c->min,"\n";
+
+ok (tapprox($a,$b)); #6
+
+$b = $a->copy;
+$c = $b->zeroes; fftnd($b,$c); ifftnd($b,$c);
+ok ( tapprox($c,0) ); #7
+ok ( tapprox($a,$b) );#8
+
+$b = $a->slice("1:35,1:69");
+$c = $b->copy; fftnd($b,$c); ifftnd($b,$c);
+ok ( tapprox($c,$b) );#9
+ok ( tapprox($a->slice("1:35,1:69"),$b) );#10
+
+# Now compare fft convolutions with direct method
+
+$b = conv2d($a,$k);
+$kk = kernctr($a,$k);
+fftconvolve( $i=$a->copy, $kk );
+
+ok ( tapprox($kk,0) );#11
+ok ( tapprox($i,$b) );#12
+
+$k = pdl[
+ [ 0.51385498, 0.17572021, 0.30862427],
+ [ 0.53451538, 0.94760132, 0.17172241],
+ [ 0.70220947, 0.22640991, 0.49475098],
+ [ 0.12469482, 0.083892822, 0.38961792],
+ [ 0.27722168, 0.36804199, 0.98342896],
+ [ 0.53536987, 0.76565552, 0.64645386],
+ [ 0.76712036, 0.7802124, 0.82293701]
+];
+$b = conv2d($a,$k);
+
+$kk = kernctr($a,$k);
+fftconvolve( $i=$a->copy, $kk );
+
+ok ( tapprox($kk,0) );#13
+ok ( tapprox($i,$b) );#14
+
+$b = $a->copy;
+
+# Test real ffts
+realfft($b);
+realifft($b);
+ok( tapprox($a,$b) );#15
+
+# Test that errors are properly caught
+eval {fft(sequence(10))};
+ok( $@, qr/Did you forget/, 'fft offers helpful message when only one argument is supplied'); #16
+$@ = '';
+
+
+eval {ifft(sequence(10))};
+ok( $@, qr/Did you forget/, 'ifft offers helpful message when only one argument is supplied'); #17
+$@ = '';
+
+# End
diff --git a/t/fits.t b/t/fits.t
new file mode 100644
index 0000000..b8625f4
--- /dev/null
+++ b/t/fits.t
@@ -0,0 +1,302 @@
+
+# Test routine for PDL::IO::FITS module
+
+use strict;
+
+use PDL::LiteF;
+
+use PDL::Core ':Internal'; # For howbig()
+use PDL::Config;
+
+##use PDL::Complex; # currently not supported
+
+kill 'INT',$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+use Test::More tests => 90;
+
+BEGIN {
+ use_ok( "PDL::IO::FITS" ); #1
+}
+
+require File::Spec;
+my $fs = 'File::Spec';
+sub cdir { return $fs->catdir(@_)}
+sub cfile { return $fs->catfile(@_)}
+
+my $tempd = $PDL::Config{TEMPDIR} or
+ die "TEMPDIR not found in %PDL::Config";
+my $file = cfile $tempd, "iotest$$";
+
+END {
+ unlink $file if defined $file and -e $file;
+}
+
+################ Test rfits/wfits ########################
+
+my $t = long xvals(zeroes(11,20))-5;
+
+# note: keywords are converted to uppercase
+my %hdr = ('Foo'=>'foo', 'Bar'=>42, 'NUM'=>'0123',NUMSTR=>['0123']);
+$t->sethdr(\%hdr);
+
+wfits($t, $file);
+print "#file is $file\n";
+my $t2 = rfits $file;
+
+is( sum($t->slice('0:4,:')), -sum($t2->slice('5:-1,:')),
+ "r/wfits: slice check" ); #2
+
+my $h = $t2->gethdr;
+ok( $$h{'FOO'} eq "foo" && $$h{'BAR'} == 42,
+ "header check on FOO/BAR" ); #3
+
+ok( $$h{'NUM'}+1 == 124 && $$h{'NUMSTR'} eq '0123',
+ "header check on NUM/NUMSTR" ); #4
+
+unlink $file;
+
+SKIP: {
+ eval { require Astro::FITS::Header };
+
+ skip "Astro::FITS::Header not installed", 79 if $@;
+
+########### Rudimentary table tests ################
+
+# note:
+# the tests do not directly test the output file,
+# instead they write out a file, read it back in, and
+# compare to the data used to create the file.
+# So it is more of a "self consistent" test.
+#
+sub compare_piddles ($$$) {
+ my $orig = shift;
+ my $new = shift;
+ my $label = shift;
+
+ TODO: {
+ local $TODO = "Need to fix alias between PDL_IND and PDL_L or PDL_LL";
+
+ is( $new->type->symbol, $orig->type->symbol, "$label has the correct type" );
+ }
+ is( $new->nelem, $orig->nelem, " and the right number of elements" );
+ is( $new->ndims, $orig->ndims, " and the right number of dimensions" );
+
+ my $flag;
+ if ( $orig->type() < float() ) {
+ $flag = all( $new == $orig );
+ } else {
+ $flag = all( approx( $orig, $new ) );
+ }
+ ok( $flag, " and all the values agree" );
+}
+
+unless($PDL::Astro_FITS_Header) {
+ # Astro::FITS::Header is not present, ignore table tests
+ for(1..59){ok(1,"Test skipped (no binary table support without Astro::FITS::Header)");}
+} else { # Astro::FITS::Header exists
+
+ my $a = long( 1, 4, 9, 32 );
+ my $b = double( 2.3, 4.3, -999.0, 42 );
+ my $table = { COLA => $a, COLB => $b };
+ wfits $table, $file;
+
+ my $table2 = rfits $file;
+ unlink $file;
+
+ ok( defined $table2, "Read of table returned something" ); #5
+ is( ref($table2), "HASH", "which is a hash reference" ); #6
+ is( $$table2{tbl}, "binary", "and appears to be a binary TABLE" );#7
+
+ ok( exists $$table2{COLA} && exists $$table2{COLB}, "columns COLA and COLB exist" ); #8
+ is( $$table2{hdr}{TTYPE1}, "COLA", "column #1 is COLA" ); #9
+ is( $$table2{hdr}{TFORM1}, "1J", " stored as 1J" ); #10
+ is( $$table2{hdr}{TTYPE2}, "COLB", "column #2 is COLB" ); #11
+ is( $$table2{hdr}{TFORM2}, "1D", " stored as 1D" ); #12
+
+ compare_piddles $a, $$table2{COLA}, "COLA"; #13-16
+ compare_piddles $b, $$table2{COLB}, "COLB"; #17-20
+
+ $table = { BAR => $a, FOO => $b,
+ hdr => { TTYPE1 => 'FOO', TTYPE2 => 'BAR' } };
+ $table2 = {};
+
+ wfits $table, $file;
+ $table2 = rfits $file;
+
+ ok( defined $table2 && ref($table2) eq "HASH" && $$table2{tbl} eq "binary",
+ "Read in the second binary table" ); #21
+ is( $$table2{hdr}{TTYPE1}, "FOO", "column #1 is FOO" ); #22
+ is( $$table2{hdr}{TFORM1}, "1D", " stored as 1D" ); #23
+ is( $$table2{hdr}{TTYPE2}, "BAR", "column #2 is BAR" ); #24
+ is( $$table2{hdr}{TFORM2}, "1J", " stored as 1J" ); #25
+
+ compare_piddles $a, $$table2{BAR}, "BAR"; #26-29
+ compare_piddles $b, $$table2{FOO}, "FOO"; #30-33
+
+ # try out more "exotic" data types
+
+ $a = byte(12,45,23,0);
+ $b = short(-99,100,0,32767);
+ my $c = ushort(99,32768,65535,0);
+ my $d = [ "A string", "b", "", "The last string" ];
+ my $e = float(-999.0,0,0,12.3);
+ ##my $f = float(1,0,-1,2) + i * float( 0,1,2,-1 );
+ $table = {
+ ACOL => $a, BCOL => $b, CCOL => $c, DCOL => $d, ECOL => $e,
+ ## FCOL => $f,
+ };
+ $table2 = {};
+
+ wfits $table, $file;
+ $table2 = rfits $file;
+ #unlink $file;
+
+ ok( defined $table2 && ref($table2) eq "HASH" && $$table2{tbl} eq "binary",
+ "Read in the third binary table" ); #34
+ my @elem = sort keys %$table2;
+ ##my @expected = sort( qw( ACOL BCOL CCOL DCOL ECOL FCOL hdr tbl ) );
+ ##is ( $#elem+1, 8, "hash contains 8 elements" );
+ my @expected = sort( qw( ACOL BCOL CCOL DCOL ECOL hdr tbl ) );
+ is ( $#elem+1, 7, "hash contains 7 elements" ); #35
+ ok( eq_array( \@elem, \@expected ), "hash contains expected
+ keys" ); #36
+
+ # convert the string array so that each element has the same length
+ # (and calculate the maximum length to use in the check below)
+ #
+ my $dlen = 0;
+ foreach my $str ( @$d ) {
+ my $len = length($str);
+ $dlen = $len > $dlen ? $len : $dlen;
+ }
+ foreach my $str ( @$d ) {
+ $str .= ' ' x ($dlen-length($str));
+ }
+
+ # note that, for now, ushort data is written out as a long (Int4)
+ # instead of being written out as an Int2 using TSCALE/TZERO
+ #
+ my $i = 1;
+ foreach my $colinfo ( ( ["ACOL","1B",$a],
+ ["BCOL","1I",$b],
+ ["CCOL","1J",$c->long],
+ ["DCOL","${dlen}A",$d],
+ ["ECOL","1E",$e],
+ ## ["FCOL","1M",$f]
+ ) ) {
+ is( $$table2{hdr}{"TTYPE$i"}, $$colinfo[0], "column $i is $$colinfo[0]" ); #37,43,49,55,58
+ is( $$table2{hdr}{"TFORM$i"}, $$colinfo[1], " and is stored as $$colinfo[1]" ); #38,44,50,56,59
+ my $col = $$table2{$$colinfo[0]};
+ if ( UNIVERSAL::isa($col,"PDL") ) {
+ compare_piddles $col, $$colinfo[2], $$colinfo[0]; #39-42,45-48,51-54,60-63
+ } else {
+ # Need to somehow handle the arrays since the data read in from the
+ # file all have 15-character length strings (or whatever the length is)
+ #
+ ok( eq_array($col, $$colinfo[2]),
+ " $$colinfo[0] values agree (as an array reference)" );#57
+ }
+ $i++;
+ }
+}
+########### Check if r/wfits bugs are fixed ################
+
+{
+ local $| = 1;
+ my $a1 = [1,2];
+ my $a2 = [[1,2],[1,2]];
+ my $p;
+ my $q;
+ for my $cref ( \(&byte, &short, &long, &float, &double) ) {
+ for my $a ($a1,$a2) {
+ $p = &$cref($a);
+ $p->wfits('x.fits');
+ $q = PDL->rfits('x.fits');
+ my $flag = 1;
+ if ( ${$p->get_dataref} ne ${$q->get_dataref} ) {
+ $flag = 0;
+ { local $, = " ";
+ print "\tnelem=",$p->nelem,"datatype=",$p->get_datatype,"\n";
+ print "\tp:", unpack("c" x ($p->nelem*howbig($p->get_datatype)), ${$p->get_dataref}),"\n";
+ print "\tq:", unpack("c" x ($q->nelem*howbig($q->get_datatype)), ${$q->get_dataref}),"\n";
+ }
+ }
+ ok($flag,"hash reference - type check: " . &$cref ); #64-73
+ }
+ }
+ unlink 'x.fits';
+}
+
+{
+ local $| = 1;
+ my $p1= pdl [1,2];
+ my $p2= pdl [[1,2],[1,2]];
+ my $q;
+ my @s;
+ for my $i (8,16,32,-32,-64) {
+ for my $p ($p2, $p1) {
+ $p->wfits('x.fits',$i);
+ $q = PDL->rfits('x.fits');
+ @s = $q->stats;
+ my $flag;
+ print "s=@s\n";
+ if ($s[0] == 1.5 and $s[1] < 0.7072 and $s[1]>0.577) {
+ $flag = 1;
+ } else {
+ $flag = 0;
+ print "\tBITPIX=$i, nelem=", $p->nelem, "\n";
+ print "\tbug: $s[0] == 1.5 and $s[1] == 0.5\n";
+ { local $, = " ";
+ print "\tp:", unpack("c8" x $p->nelem, ${$p->get_dataref}),"\n";
+ print "\tq:", unpack("c" x abs($i/8*$q->nelem), ${$q->get_dataref}),"\n";
+ }
+ }
+ ok($flag,"piddle - bitpix=$i" ); #74-83
+ }
+ }
+ unlink 'x.fits';
+};
+
+}; # end of SKIP block
+
+#### Check that discontinuous data (e.g. from fftnd) get written correctly.
+#### (Sourceforge bug 3299611) it is possible to store data in a PDL non-contiguously
+#### through the C API, by manipulating dimincs; fft uses this technique, which
+#### used to hose up fits output.
+
+SKIP:{
+ eval "use PDL::FFT";
+ skip "PDL::FFT not installed", 79 if $@;
+
+ my $a = sequence(10,10,10);
+ my $ai = zeroes($a);
+ fftnd($a,$ai);
+ wfits($a,$file);
+ my $b = rfits($file);
+ ok(all($a==$b),"fftnd output (non-contiguous in memory) is written correctly");
+ unlink $file;
+}
+
+##############################
+# Check multi-HDU read/write
+
+$a = sequence(5,5);
+$b = rvals(5,5);
+
+our @aa;
+
+eval { wfits([$a,$b],$file); };
+ok(!$@, "wfits with multiple HDUs didn't fail");
+
+eval { @aa = rfits($file); };
+ok(!$@, "rfits in list context didn't fail");
+
+ok( $aa[0]->ndims == $a->ndims && all($aa[0]->shape == $a->shape), "first element has right shape");
+ok( all($aa[0] == $a), "first element reproduces written one");
+
+ok( $aa[1]->ndims == $b->ndims && all($aa[1]->shape == $b->shape), "second element has right shape");
+ok( all($aa[1] == $b), "Second element reproduces written one");
+
+unlink $file;
+
+1;
diff --git a/t/flexraw.t b/t/flexraw.t
new file mode 100644
index 0000000..9a9201f
--- /dev/null
+++ b/t/flexraw.t
@@ -0,0 +1,128 @@
+# flexraw's read/write tests, copied from fastraw's tests.
+# There are still many tests to write; see the notes at the bottom
+# of this document.
+
+use PDL::LiteF;
+# PDL::Core::set_debugging(1);
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+use strict;
+use warnings;
+
+# Load the testing harness and PDL
+use Test::More tests => 12;
+use PDL;
+use File::Temp qw(tempdir);
+
+$PDL::debug = 0;
+
+# Get a temporary directory and file name, which obviously we'll need for testing
+# saving and reading of data.
+use PDL::Config;
+my $tmpdir = tempdir( CLEANUP=>1 );
+my $name = $tmpdir . "/tmp0";
+unlink $name, $name . '.hdr'; # just to be absolutely sure
+
+# **TEST 1** make sure FastRaw loads
+BEGIN { use_ok( 'PDL::IO::FlexRaw' ); }
+
+# Set up the working filename and make sure we're working with a clean slate:
+
+# **TEST 2** save a piddle to disk
+my $a = pdl [2,3],[4,5],[6,7];
+my $header = eval { writeflex($name, $a) };
+ok((-f $name), "writeflex should create a file");
+
+# **TEST 3** save a header to disk
+eval { writeflexhdr($name, $header) };
+ok(-f "$name.hdr", "writeflexhdr should create a header file");
+
+# **TEST 4** read it back, and make sure it gives the same piddle
+my $b = eval { readflex($name) };
+ok(all(approx($a,$b)), "A piddle and it's saved copy should be about equal");
+
+# **TEST 5** save two piddles to disk
+my $c = pdl [[0,0,0,0],[0,0,0,0]];
+my $d = pdl [1,1,1];
+my $cdname = $name . 'cd';
+$header = eval { writeflex($cdname, $c, $d) };
+ok((-f $cdname), "writeflex saves 2 pdls to a file");
+
+# **TEST 6** save a header to disk
+eval { writeflexhdr($cdname, $header) };
+ok(-f "$cdname.hdr", "writeflexhdr create a header file");
+
+# **TEST 7** read it back, and make sure it gives the same piddle
+# This is sf.net bug #3375837 "_read_flexhdr state machine fails"
+my (@cd) = eval { no warnings; readflex($cdname) };
+ok( (scalar(@cd)==2 and all(approx($cd[0],$c)) and all(approx($cd[1],$d)) ), 'sf.net bug 3375837');
+
+# Clean up for another test
+unlink $cdname, $cdname . '.hdr'; # just to be absolutely sure
+
+# some mapflex tests
+SKIP: {
+
+ my $c = eval { mapflex($name) };
+ if ($@) {
+ diag("$@");
+ if ($@ =~ m/mmap not supported/) {
+ skip('no mmap support', 5);
+ }
+ }
+
+ # **TEST 8** compare mapfraw piddle with original piddle
+ ok(all(approx($a,$c)), "A piddle and it's mapflex representation should be about equal");
+
+ # **TEST 9** modifications should be saved when $c goes out of scope
+ # THIS TEST FAILS.
+ # This failure is recorded in sf.net bug 3031068.
+ # Presently, making $c go out of scope does not free the memory
+ # mapping associated with mapflex, so this modification is never
+ # saved to the file (or at least it's not saved immediately).
+ $c += 1;
+ undef $c;
+ $b = readflex($name);
+ ok(all(approx($a+1,$b)), "Modifications to mapfraw should be saved to disk no later than when the piddle ceases to exist");
+
+ # We're starting a new test, so we'll remove the files we've created so far
+ # and clean up the memory, just to be super-safe
+ unlink $name, $name . '.hdr';
+ undef $a;
+ undef $b;
+
+ # **TEST 10** test creating a pdl via mapfraw
+ # First create and modify the piddle
+ $header = [{NDims => 2, Dims => [3,2], Type => 'float'}];
+ # Fix this specification.
+ $a = mapflex($name, $header, {Creat => 1});
+ writeflexhdr($name, $header);
+ ok(defined($a), 'mapflex create piddle');
+
+ skip('no mapflex piddle to check', 2) unless defined $a;
+ $a += xvals $a;
+ $a += 0.1 * yvals $a;
+ # save the contents
+ undef $a;
+ # Load it back up and see if the values are what we expect
+ $b = readflex($name);
+ # **TEST 11**
+ ok(all(approx($b, PDL->pdl([[0,1,2],[0.1,1.1,2.1]]))),
+ "mapfraw should be able to create new piddles");
+
+ # **TEST 12** test the created type
+ ok($b->type->[0] == (&float)->[0], 'type should be of the type we specified (float)');
+
+}
+
+# Clean things up a bit
+unlink $name, $name . '.hdr';
+undef $a;
+undef $b;
+
+# Test the file header options:
+
+# Tests to write still:
+# Test using file handles instead of file names
+# test read_flexhdr
+# test gzip stuff
diff --git a/t/flexraw_fortran.t b/t/flexraw_fortran.t
new file mode 100644
index 0000000..6f5cef4
--- /dev/null
+++ b/t/flexraw_fortran.t
@@ -0,0 +1,680 @@
+use PDL::LiteF;
+use PDL::IO::FlexRaw;
+use PDL::Config;
+use Config;
+
+use strict;
+
+use Test::More;
+use File::Temp qw(tempfile);
+use File::Spec;
+
+my ($data,$head,$hdr);
+
+BEGIN {
+ (undef, $data) = tempfile("rawXXXX", SUFFIX=>'_data', TMPDIR=>1);
+ $data =~ s/\\/\//g if $^O =~ /MSWin32/;
+ $hdr = $data . '.hdr';
+ ($head = $data) =~ s/_data$//;
+}
+
+$|=1;
+
+my $ndata = 10;
+my $Verbose = 0;
+my $DEBUG = 0;
+$PDL::Verbose = 0;
+$Verbose |= $PDL::Verbose;
+
+my $exec = $^O =~ /win32/i ? '.exe' : '';
+my $null = $^O =~ /win32/i ? ' 2>nul' : ' 2>/dev/null';
+
+BEGIN{
+
+ my $ntests = 29;
+ my $datalen;
+ $datalen = length($data);
+
+ eval " use PDL::Slatec; ";
+ my $loaded = ($@ ? 0 : 1);
+ unless ( $loaded ) {
+ plan skip_all => "Skipped tests as F77 compiler not found";
+ } elsif ($Config{archname} =~ /(x86_64|ia64)/) {
+ plan skip_all => "Skipped tests for 64 bit architecture: $1";
+ } elsif ($datalen > 70) {
+ plan skip_all => "TEMPDIR path too long for f77 ($datalen chars), skipping all tests";
+ } else {
+ eval " use ExtUtils::F77; ";
+ if ( $@ ) {
+ plan skip_all => "Skip all tests as ExtUtils::F77 not found";
+ exit 0;
+ } else {
+ plan tests => $ntests;
+ }
+ }
+
+ # Configuration
+ # Get ExtUtils::F77 if run in either PDL/t/ or PDL/
+ #
+ if(-e 'flexraw.t') {
+ unshift @INC, '../Lib/Slatec/' if -e 'flexraw.t';
+ } elsif(-e 'INTERNATIONALIZATION') {
+ unshift @INC, 'Lib/Slatec/' if -e 'INTERNATIONALIZATION';
+ } else {
+ print "I'm not in PDL now, right? Still trying\n";
+ }
+
+}
+
+# use ExtUtils::F77;
+
+my $F77;
+my $F77flags;
+
+if ($ExtUtils::F77::VERSION > 1.03) {
+ $F77 = ExtUtils::F77::compiler();
+ $F77flags = ExtUtils::F77::cflags();
+} else {
+ $F77 = 'f77';
+ $F77flags = '';
+}
+
+sub tapprox {
+ my ($a,$b) = @_;
+ my $c = abs($a->clump(-1)-$b->clump(-1));
+ my $d = max($c);
+ $d < 0.01;
+}
+
+sub byte4swap {
+ my ($file) = @_;
+ my ($ofile) = $file.'~';
+ my ($word);
+
+ my $ifh = IO::File->new( "<$file" )
+ or die "Can't open $file to read";
+ my $ofh = IO::File->new( ">$ofile" )
+ or die "Can't open $ofile to write";
+ binmode $ifh;
+ binmode $ofh;
+ while ( !$ifh->eof ) {
+ $ifh->read( $word, 4 );
+ $word = pack 'c4',reverse unpack 'c4',$word;
+ $ofh->print( $word );
+ }
+ $ofh->close;
+ $ifh->close;
+ rename $ofile, $file;
+}
+
+sub byte8swap {
+ my ($file) = @_;
+ my ($ofile) = $file.'~';
+ my ($word);
+
+ my $ifh = IO::File->new( "<$file" )
+ or die "Can't open $file to read";
+ my $ofh = IO::File->new( ">$ofile" )
+ or die "Can't open $ofile to write";
+ binmode $ifh;
+ binmode $ofh;
+ while ( !$ifh->eof ) {
+ $ifh->read( $word, 8 );
+ $word = pack 'c8',reverse unpack 'c8',$word;
+ $ofh->print( $word );
+ }
+ $ofh->close;
+ $ifh->close;
+ rename $ofile, $file;
+}
+
+# utility to fold long lines preventing problems with 72
+# char limit and long text parameters (e.g. filenames)
+sub codefold {
+ my $oldcode = shift;
+ my $newcode = '';
+
+ eval {
+ # to simplify loop processing, introduces dependence
+ require IO::String;
+
+ my $in = IO::String->new($oldcode);
+ my $out = IO::String->new($newcode);
+
+ # find non-comment lines longer than 72 columns and fold
+ my $line = '';
+ while ($line = <$in>) {
+
+ # clean off line-feed stuff
+ chomp $line;
+
+ # pass comments to output
+ print $out "$line\n" if $line =~ /^\S/;
+
+ # output code lines (by 72-char chunks if needed)
+ while ($line ne '') {
+
+ # output first 72 columns of the line
+ print $out substr($line,0,72) . "\n"; # print first 72 cols
+
+ if ( length($line) > 72 ) {
+ # make continuation line of the rest of the line
+ substr($line,0,72) = ' $';
+ } else {
+ $line = '';
+ }
+
+ }
+ }
+
+ # close "files" and return folded code
+ close($in);
+ close($out);
+ };
+
+ $newcode = $oldcode if $@;
+ return $newcode;
+}
+
+sub inpath {
+ my ($prog) = @_;
+ my $pathsep = $^O =~ /win32/i ? ';' : ':';
+ my $exe = $^O =~ /win32/i ? '.exe' : '';
+ for (split $pathsep, $ENV{PATH}) { return 1 if -x "$_/$prog$exe" }
+ return 0;
+}
+
+# createData $head, $code
+#
+# given a F77 program (in $code), compile and run it.
+# It is expected to create a data file called
+# "${head}data"
+# The executable and code are cleaned up but NOT the
+# data file.
+#
+# Requires the global variables
+# $F77
+# $F77flags
+# $Verbose
+# $DEBUG
+#
+sub createData {
+ my $head = shift;
+ my $code = shift;
+
+ # try and provide a modicum of safety, since we call
+ # system with $head as the argument
+ #
+ if($^O =~ /mswin32/i) {
+ die '$head [' . $head . '] should match /^[A-Z]:\//'
+ unless $head =~ /^[A-Z]:\//;
+ }
+ else {
+ die '$head [' . $head . '] must start with a / or ./'
+ unless $head =~ /^(\/|\.\/)/;
+ }
+
+ my $file = ${head} . '.f';
+ my $prog = $head;
+
+ my $fh = IO::File->new( "> $file" )
+ or die "ERROR: Unable to write F77 code to $file\n";
+ $fh->print( $code );
+ $fh->close;
+
+ system("$F77 $F77flags -o $prog$exec $file".
+ (($Verbose || $DEBUG)?'': $null));
+
+ unlink $data if -f $data;
+ system( $prog );
+
+ die "ERROR: code did not create data file $data\n"
+ unless -e $data;
+
+ unlink $prog.$exec, $file;
+
+} # sub: createData()
+
+# Types to test the translation for, perl + f77 forms
+my %types = ( 'float' => 'real*4', 'double' => 'real*8', 'long' => 'integer*4',
+ 'short' => 'integer*2', 'byte' => 'character' );
+
+# Perl and f77 functions should be have the same net effect...
+my $exprf = '100.*sin(0.01* i)';
+my $exprp = '100.*sin(0.01*$i)';
+#$exprf = 'i';
+#$exprp = '$i';
+
+# Two dimensional functions
+my $expr2f = '100.*sin(0.01* i)*cos(0.01* j)';
+# no output autocreation means have this mess...
+my $expr2p = '(outer(sin(0.01*$i),cos(0.01*$j),$c=null),$c*100.)';
+
+# need to define/declare variables used in the expressions above
+my $j = sequence($ndata)+1;
+my $i = $j;
+my $c;
+# 1 dimensional --
+
+#
+# f77, implied & explicit swapping for 4 byte types, with 2 separate
+# writes; and header array as well as header file
+#
+foreach my $pdltype ('float', 'long') {
+ print STDERR "Type $pdltype swapped\n" if $Verbose;
+ my $f77type = $types{$pdltype};
+ my $val = $exprf;
+ $val = "char(int($val))" if $pdltype eq 'byte';
+
+ my $code = <<"EOT";
+
+c Program to test i/o of F77 unformatted files
+ program rawtest
+ implicit none
+ integer i
+ $f77type a($ndata)
+ do i = 1, $ndata
+ a(i) = $val
+ enddo
+
+ open(8,file=
+ \$'$data'
+ \$,status='new',form='unformatted')
+ i = $ndata
+ write (8) i
+ write (8) a
+ close(8)
+ end
+
+EOT
+
+ createData $head, codefold($code);
+ byte4swap($data);
+ open(FILE, "> $hdr");
+ print FILE <<"EOT";
+# FlexRaw file header
+f77
+long 1 1
+# Data
+$pdltype 1 $ndata
+EOT
+ close(FILE);
+
+ my @a = readflex($data);
+ # print "@a\n";
+ my $ok = ($a[0]->at(0) == $ndata);
+ my $res = eval "$pdltype $exprp";
+ ok( $ok && tapprox($res,$a[1]), "readflex $pdltype w hdr file" );
+
+ open(FILE,">$hdr");
+ print FILE <<"EOT";
+# FlexRaw file header
+swap
+f77
+# now for data specifiers
+long 1 1
+# Data
+$pdltype 1 $ndata
+EOT
+ close(FILE);
+
+ @a = readflex($data);
+ #print "@a\n";
+
+ unlink $hdr;
+
+ $ok = ($a[0]->at(0) == $ndata);
+ $res = eval "$pdltype $exprp";
+ ok( $ok && tapprox($res,$a[1]), "readflex $pdltype w hdr file (explicit swap)" );
+
+# Now try header array
+ $ok = 1;
+ my $header = [ {Type => 'f77'},
+ {Type => 'long', NDims => 1, Dims => [ 1 ] },
+ {Type => $pdltype, NDims => 1, Dims => [ $ndata ] } ];
+ @a = readflex($data,$header);
+ unlink $data;
+ $ok = ($a[0]->at(0) == $ndata);
+ $res = eval "$pdltype $exprp";
+ ok( $ok && tapprox($res,$a[1]), "readflex $pdltype w hdr array" );
+ # print $a[1]->getndims()," [",$a[1]->dims,"]\n";
+
+} # foreach: $pdltype == 'float', 'double'
+
+# 1d, all types, normal way round, f77 specifier
+foreach my $pdltype (keys %types) {
+ print STDERR "Type $pdltype\n" if $Verbose;
+ my $f77type = $types{$pdltype};
+ my $val = $exprf;
+ $val = "char(int($val))" if $pdltype eq 'byte';
+
+ my $code = <<"EOT";
+
+c Program to test i/o of F77 unformatted files
+ program rawtest
+ implicit none
+ integer i
+ $f77type a($ndata)
+ do i = 1, $ndata
+ a(i) = $val
+ enddo
+ open(8,file=
+ \$'$data'
+ \$,status='new',form='unformatted')
+ i = $ndata
+ write (8) i,a
+ close(8)
+ end
+
+EOT
+
+ createData $head, codefold($code);
+
+ open(FILE, ">$hdr" );
+ print FILE <<"EOT";
+# FlexRaw file header
+f77
+long 1 1
+# Data
+$pdltype 1 $ndata
+EOT
+ close(FILE);
+
+ my @a = readflex($data);
+ # print "@a\n";
+ unlink $data, $hdr;
+
+ my $ok = ($a[0]->at(0) == $ndata);
+ my $res = eval "$pdltype $exprp";
+ ok($ok && tapprox($res,$a[1]), "f77 1D $pdltype data");
+ # print $a[1]->getndims()," [",$a[1]->dims,"]\n";
+
+} # foreach: $pdltype ( keys %types )
+
+# 1 dimensional, no f77 specifier (format words explicitly ignored)
+foreach my $pdltype (keys %types) {
+ print STDERR "Type $pdltype\n" if $Verbose;
+ my $f77type = $types{$pdltype};
+ my $val = $exprf;
+ $val = "char(int($val))" if $pdltype eq 'byte';
+
+ my $code = <<"EOT";
+
+c Program to test i/o of F77 unformatted files
+ program rawtest
+ implicit none
+ integer i
+ $f77type a($ndata)
+ do i = 1, $ndata
+ a(i) = $val
+ enddo
+ open(8,file=
+ \$'$data'
+ \$,status='new',form='unformatted')
+ i = $ndata
+ write (8) i,a
+ close(8)
+ end
+
+EOT
+
+ createData $head, codefold($code);
+
+ open(FILE,">$hdr");
+ print FILE <<"EOT";
+# FlexRaw header file
+byte 1 4
+long 1 # Test comments
+1 Tricky comment
+# Data
+$pdltype 1 $ndata
+byte 1 4
+# and hanging EOF
+
+
+EOT
+ close(FILE);
+
+ my @a = readflex($data);
+ # print "@a\n";
+ unlink $data, $hdr;
+
+ my $ok = ($a[1]->at(0) == $ndata);
+ my $res = eval "$pdltype $exprp";
+ ok( $ok && tapprox($res,$a[2]), "no f77, 1D $pdltype data");
+ # print $a[2]->getndims()," [",$a[2]->dims,"]\n";
+}
+
+# 2 dimensional
+foreach my $pdltype (keys %types) {
+ print STDERR "Type $pdltype\n" if $Verbose;
+ my $f77type = $types{$pdltype};
+ my $val = $expr2f;
+ $val = "char(int($val))" if $pdltype eq 'byte';
+
+ my $code = <<"EOT";
+
+c Program to test i/o of F77 unformatted files
+ program rawtest
+ implicit none
+ integer i, j
+ $f77type a($ndata, $ndata)
+ do i = 1, $ndata
+ do j = 1, $ndata
+ a(i,j) = $val
+ enddo
+ enddo
+ open(8,file=
+ \$'$data'
+ \$,status='new',form='unformatted')
+ i = $ndata
+ write (8) i,a
+ close(8)
+ end
+
+EOT
+
+ createData $head, codefold($code);
+
+ open(FILE,">$hdr");
+ print FILE <<"EOT";
+# FlexRaw file header
+f77
+long 1 1
+# Data
+$pdltype 2 $ndata $ndata
+EOT
+ close(FILE);
+ my @a = readflex($data);
+# if ($pdltype eq 'byte') {
+# print "$pdltype @a\n";
+# system("ls -l $data");
+# }
+ unlink $data, $hdr;
+
+ my $ok = ($a[0]->at(0) == $ndata);
+ my $res = eval "$pdltype $expr2p";
+ ok( $ok && tapprox($res,$a[1]), "f77 format 2D $pdltype data");
+ # print $a[1]->getndims()," [",$a[1]->dims,"]\n";
+}
+
+print STDERR "Combined types case\n" if $Verbose;
+
+my $code = <<"EOT";
+
+c Program to test i/o of F77 unformatted files
+ program rawtest
+ implicit none
+ character a
+ integer*2 i
+ integer*4 l
+ real*4 f
+ real*8 d
+ d = 4*atan(1.)
+ f = d
+ l = 10**d
+ i = l
+ a = ' '
+ open(8,file=
+ \$'$data'
+ \$,status='new',form='unformatted')
+c Choose bad boundaries...
+ write (8) a,i,l,f,d
+ close(8)
+ end
+
+EOT
+
+ createData $head, codefold($code);
+
+open(FILE,">$hdr");
+print FILE <<"EOT";
+# FlexRaw file header
+byte 1 4
+byte 0
+short 0
+long 0
+float 0
+double 0
+byte 1 4
+EOT
+close(FILE);
+
+my @a = readflex($data);
+#print "@a\n";
+shift @a;
+
+my $d = double pdl (4*atan2(1,1));
+my $f = float ($d);
+my $l = long (10**$f);
+$i = short ($l);
+my $a = byte (32);
+my @req = ($a,$i,$l,$f,$d);
+my $ok = 1;
+foreach (@req) {
+ my $h = shift @a;
+ $ok &&= tapprox($_,$h);
+}
+ok( $ok, "readflex combined types" );
+
+SKIP: {
+ my $compress = inpath('compress') ? 'compress' : 'gzip'; # some linuxes don't have compress
+ $compress = 'gzip' if $^O eq 'cygwin'; # fix bogus compress script prob
+
+ if ( $^O eq 'MSWin32' ) { # fix for ASPerl + MinGW, needs to be more general
+ skip "No compress or gzip command on MSWin32", 1 unless inpath($compress) and $^O;
+ }
+
+# Try compressed data
+ $ok = 1;
+ 0 == system "$compress -c $data > ${data}.Z" or diag "system $compress -c $data >${data}.Z failed: $?";
+ unlink( $data );
+ @a = readflex($data);
+ $ok &&= $#a==6;
+ @a = readflex("${data}.Z");
+ $ok &&= $#a==6;
+ my $NULL = File::Spec->devnull();
+ 0 == system "gunzip -q ${data}.Z >$NULL 2>&1" or diag "system gunzip -q ${data}.Z failed: $?";
+ 0 == system "gzip -q $data >$NULL 2>&1" or diag "system gzip -q $data failed: $?";
+ @a = readflex($data);
+ $ok &&= $#a==6;
+ @a = readflex("${data}.gz");
+ $ok &&= $#a==6;
+ shift @a;
+ unlink "${data}.gz", $hdr;
+ $d = double pdl (4*atan2(1,1));
+ $f = float ($d);
+ $l = long (10**$f);
+ $i = short ($l);
+ $a = byte (32);
+ @req = ($a,$i,$l,$f,$d);
+ foreach (@req) {
+ my $h = shift @a;
+ $ok &&= tapprox($_,$h);
+ }
+ ok( $ok, "readflex compressed data" );
+}
+
+# Try writing data
+my $flexhdr = writeflex($data, at req);
+writeflexhdr($data,$flexhdr) unless $PDL::IO::FlexRaw::writeflexhdr;
+ at a = readflex($data);
+unlink $hdr;
+$ok = 1;
+foreach (@req) {
+ # print "$_ vs ", at a[0],"\n";
+ $ok &&= tapprox($_,shift @a);
+}
+ok( $ok, "writeflex combined data types, hdr file" );
+ at a = readflex($data, $flexhdr);
+$ok = 1;
+foreach (@req) {
+ # print "$_ vs ", at a[0],"\n";
+ $ok &&= tapprox($_,shift @a);
+}
+ok( $ok, "writeflex combined data types, readflex hdr array" );
+unlink $data;
+
+$#a = -1;
+foreach (@req) {
+ push @a,$_->dummy(0,10);
+}
+$flexhdr = writeflex($data, at a);
+$flexhdr = [ {Type => 'byte', NDims => 1, Dims => 10},
+ {Type => 'short', NDims => 1, Dims => 10},
+ {Type => 'long', NDims => 1, Dims => 10},
+ {Type => 'float', NDims => 1, Dims => 10},
+ {Type => 'double', NDims => 1, Dims => 10} ];
+ at a = readflex($data, $flexhdr);
+unlink $data;
+$ok = 1;
+foreach (@req) {
+ # print "$_ vs ", at a[0],"\n";
+ $ok &&= tapprox($_,slice(shift @a,"(0)"));
+}
+ok( $ok, "writeflex combined types[10], readflex explicit hdr array");
+
+# Writing multidimensional data
+map {$_ = $_->dummy(0,10)} @req;
+$flexhdr = writeflex($data, at req);
+writeflexhdr($data,$flexhdr) unless $PDL::IO::FlexRaw::writeflexhdr;
+ at a = readflex($data);
+unlink $data;
+unlink $hdr;
+$ok = 1;
+foreach (@req) {
+ # print "$_ vs ", at a[0],"\n";
+ $ok &&= tapprox($_,shift @a);
+}
+ok( $ok, "multidimensional data" );
+
+# Use readflex with an open file handle
+ at req = (byte(1..3),
+ long(5..10),
+ float(10..15)->reshape(3,2)/100,
+ double(0..99)/1e8);
+$flexhdr = writeflex($data, @req);
+
+open(IN, $data);
+ at a = readflex(\*IN, $flexhdr);
+$ok = 1;
+foreach (@req) {
+ # print "$_ vs ", at a[0],"\n";
+ $ok &&= tapprox($_,shift @a);
+}
+close(IN);
+unlink $data;
+ok( $ok, "readflex with file handle" );
+
+# use writeflex with an open file handle
+open(OUT, ">$data");
+$flexhdr = writeflex(\*OUT, @req);
+close(OUT);
+ at a = readflex($data, $flexhdr);
+$ok = 1;
+foreach (@req) {
+ # print "$_ vs ", at a[0],"\n";
+ $ok &&= tapprox($_,shift @a);
+}
+unlink $data;
+ok( $ok, "writeflex with file handle" );
diff --git a/t/flow.t b/t/flow.t
new file mode 100644
index 0000000..772f6a5
--- /dev/null
+++ b/t/flow.t
@@ -0,0 +1,438 @@
+# XXX SOME TESTS DISABLED
+
+use PDL::LiteF;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ if($ENV{PDL_T}) {
+ if($result) { print "ok $no\n";return }
+ my ($p,$f,$l) = caller;
+ print "FAILED TEST $no AT $p $f $l\n";
+ } else {
+ print "not " unless $result ;
+ print "ok $no\n" ;
+ }
+}
+
+# XXX
+
+print "1..33\n";
+
+if(1) {
+
+{my ($a,$b,$c);
+
+# 1. Test that changes do flow
+
+$a = pdl 2,3,4;
+
+$a->doflow;
+
+$b = $a + $a;
+
+ok(1,($b->at(0) == 4));
+ok(2,($b->at(1) == 6));
+
+$a->set(0,50);
+
+ok(3,($b->at(0) == 100));
+ok(4,($b->at(1) == 6));
+
+# 2. If we don't want flow, we mustn't have it.
+
+$a = pdl 2,3,4;
+
+$b = $a + $a;
+
+ok(5,($b->at(0) == 4));
+ok(6,($b->at(1) == 6));
+
+$a->set(0,50);
+
+ok(7,($b->at(0) == 4));
+ok(8,($b->at(1) == 6));
+
+$ind = 9;
+
+# 3. Test what happens when we assign to $b. (no coredumps allowed)
+
+$a = pdl 2,3,4;
+
+$a->doflow;
+
+$b = $a + $a;
+
+ok($ind++,($b->at(0) == 4));
+ok($ind++,($b->at(1) == 6));
+
+$b->set(0,50); # This must break the dataflow completely
+
+ok($ind++,($b->at(0) == 50));
+ok($ind++,($b->at(1) == 6));
+ok($ind++,($a->at(0) == 2));
+ok($ind++,($a->at(1) == 3));
+
+$a->set(0,33);
+
+ok($ind++,($b->at(0) == 50));
+ok($ind++,($b->at(1) == 6));
+ok($ind++,($a->at(0) == 33));
+ok($ind++,($a->at(1) == 3));
+
+# 4. Now a basic slice test. Once Incs etc. are back, need
+# to do this also with other kinds of slices.
+
+# This gets so hairy that we want to use strings for testing.
+
+$a = pdl [2,3,4],[5,6,7];
+
+ok($ind++, ("$a" eq <<END));
+
+[
+ [2 3 4]
+ [5 6 7]
+]
+END
+
+$b = $a->slice('1:2,:');
+ok($ind++, ("$b" eq <<END));
+
+[
+ [3 4]
+ [6 7]
+]
+END
+
+$a->set(1,1,9);
+ok($ind++, ("$a" eq <<END));
+
+[
+ [2 3 4]
+ [5 9 7]
+]
+END
+
+ok($ind++, ("$b" eq <<END));
+
+[
+ [3 4]
+ [9 7]
+]
+END
+
+$c = $a->slice('0:1,:');
+ok($ind++, ("$c" eq <<END));
+
+[
+ [2 3]
+ [5 9]
+]
+END
+
+$b->set(0,0,8);
+
+ok($ind++, ("$a" eq <<END));
+
+[
+ [2 8 4]
+ [5 9 7]
+]
+END
+
+ok($ind++, ("$b" eq <<END));
+
+[
+ [8 4]
+ [9 7]
+]
+END
+
+ok($ind++, ("$c" eq <<END));
+
+[
+ [2 8]
+ [5 9]
+]
+END
+}
+
+# 5. Now, to the hairy stuff of generations and progenitors.
+
+# XXX DISABLED
+if(0) {my($a,$a2,$b,$c,$d,$e,$f,$g, at ps);
+
+# We set up the following dependency graph:
+#
+# c
+# ^
+# |
+# a -> b . . . > b' -> f
+# | |
+# V V
+# d - - - > d'
+# | |
+# V V
+# e . . . > e' -> g
+#
+# which, although it does not exercise *every* code path, still
+# does a lot.
+
+$a = pdl [2,3,4],[5,6,7];
+$a->doflow;
+
+$b = $a + 1;
+
+ok($ind++, ("$b" eq <<END));
+
+[
+ [3 4 5]
+ [6 7 8]
+]
+END
+
+
+#print $b;
+
+# $foo2 = pdl 2;
+
+$c = $b * 2; # This should stay the same flowed structure.
+
+ok($ind++, ("$c" eq <<END));
+
+[
+ [ 6 8 10]
+ [12 14 16]
+]
+END
+
+# print $c;
+
+$d = $b->slice('1:2,:');
+$e = $d->slice('1,:');
+
+# NOW
+
+#print "DDUMP1\n";
+# $d->jdump();
+
+$d += 0.5;
+
+#print "DDUMP2\n";
+# $d->jdump();
+
+# print $d;
+# $d->jdump();
+
+$f = $b * 2;
+
+# This checks whether the system realizes to look for the new $e.
+$g = $e - 15;
+
+# print $a,$b,$c,$d,$e,$f,$g;
+
+$a->set(0,0,8);
+$a->set(1,0,9);
+$a->set(2,0,10);
+ at ps = ($a,$b,$c,$d,$e,$f,$g);
+
+# print "PRINTS\n"; $b->jdump;
+# $c->jdump;
+
+#map {if($_) {# $_->jdump;
+# print $_} else {print "FOO\n";}} @ps;
+
+undef @ps;
+
+ok($ind++, ("$a" eq <<END));
+
+[
+ [ 8 9 10]
+ [ 5 6 7]
+]
+END
+
+ok($ind++, ("$b" eq <<END));
+
+[
+ [ 9 10.5 11.5]
+ [ 6 7.5 8.5]
+]
+END
+
+ok($ind++, ("$c" eq <<END));
+
+[
+ [18 20 22]
+ [12 14 16]
+]
+END
+
+ok($ind++, ("$d" eq <<END));
+
+[
+ [10.5 11.5]
+ [ 7.5 8.5]
+]
+END
+
+ok($ind++, ("$e" eq <<END));
+
+[
+ [11.5]
+ [ 8.5]
+]
+END
+
+ok($ind++, ("$f" eq <<END));
+
+[
+ [18 21 23]
+ [12 15 17]
+]
+END
+
+ok($ind++, ("$g" eq <<END));
+
+[
+ [-3.5]
+ [-6.5]
+]
+END
+
+
+}
+}
+
+# 6. Now, what if the mutated one is actually the parent.
+if(0) { # XXX DISABLED
+ my($a,$b,$c,$d);
+ $a = pdl 2,3,4;
+ $a->doflow;
+ $a2 = pdl 2;
+ $b = $a * $a2;
+
+# print $b;
+
+ok($ind++, ("$b" eq "[4 6 8]"));
+
+# $b->jdump;
+
+ $c = pdl 1;
+ $b += $c;
+# $b->jdump;
+# $c->jdump;
+
+# print $b;
+ok($ind++, ("$b" eq "[5 7 9]"));
+# $b->jdump;
+
+# print "TOSETA\n";
+ $a->set(1,5);
+# print "TODUMPA\n";
+# $a->jdump();
+# $b->jdump();
+# print "TOPRINTB\n";
+# print $b;
+ok($ind++, ("$b" eq "[5 11 9]"));
+
+# print "EXITING SCOPE\n";
+
+}
+#print "EXITED SCOPE\n";
+
+# 7. What about axisvals:
+{
+ my($a,$b);
+ $a = zeroes 5,3;
+
+# print $a;
+
+ok($ind++, ("$a" eq <<END));
+
+[
+ [0 0 0 0 0]
+ [0 0 0 0 0]
+ [0 0 0 0 0]
+]
+END
+
+
+# print "NEW_OR_INPLACE_NOW\n";
+ $b = PDL::Core::new_or_inplace($a);
+# print "NEW_OR_INPLACE_DONE\n";
+# $b->jdump();
+ $c = $b->xchg(0,1);
+
+# $c->jdump();
+ $c->make_physical();
+# $c->jdump();
+
+ axisvalues($c);
+
+# print $c;
+
+ok($ind++, ("$c" eq <<END));
+
+[
+ [0 1 2]
+ [0 1 2]
+ [0 1 2]
+ [0 1 2]
+ [0 1 2]
+]
+END
+
+
+
+# print $b;
+
+ok($ind++, ("$b" eq <<END));
+
+[
+ [0 0 0 0 0]
+ [1 1 1 1 1]
+ [2 2 2 2 2]
+]
+END
+
+# print $a;
+
+ok($ind++, ("$a" eq <<END));
+
+[
+ [0 0 0 0 0]
+ [0 0 0 0 0]
+ [0 0 0 0 0]
+]
+END
+
+
+# $b->jdump;
+# print $b;
+#
+# $b = axisvalues($a);
+#
+# print $b;
+
+# warn "Two tests disabled (31-32) as do not work\n";
+
+ if(1) { # These tests diaabled (do not work) XXX Do
+
+ $a = zeroes 5,5;
+ $b = $a->slice("1:3,1:3");
+ my $c = $b->slice("(1),(1)");
+ ok($ind++,($c->at() == 0));
+ $a .= 1;
+ ok($ind++,($c->at() == 1));
+ $a .= 2;
+ ok($ind++,($c->at() == 2));
+ }
+
+}
+
+exit 0;
+
+# print "DONE\n";
diff --git a/t/foo.t b/t/foo.t
new file mode 100644
index 0000000..92aa3c4
--- /dev/null
+++ b/t/foo.t
@@ -0,0 +1,74 @@
+
+
+use PDL::LiteF;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ if($ENV{PDL_T}) {
+ if($result) { print "ok $no\n";return }
+ my ($p,$f,$l) = caller;
+ print "FAILED TEST $no AT $p $f $l\n";
+ } else {
+ print "not " unless $result ;
+ print "ok $no\n" ;
+ }
+}
+
+print "1..3\n";
+
+# PDL::Core::set_debugging(1);
+
+# Test basic use of foomethod.
+
+$a = zvals zeroes 2,2,50;
+
+$b = $a->oneslice(2,10,2,5);
+
+ok(1,$b->at(0,0,0) == 10);
+ok(2,$b->at(0,0,1) == 12);
+ok(3,$b->at(0,0,4) == 18);
+
+# we don't test the foomethod
+# had to disable some code that
+# is required for foomethod since
+# it caused another bug in more important code (see pdl_changed in pdlapi.c)
+exit(0);
+
+$t = $b->get_trans;
+
+$t->call_trans_foomethod(11,3,6);
+
+$b->make_physical();
+
+ok(4,$b->at(0,0,0) == 11);
+ok(5,$b->at(0,0,1) == 14);
+ok(6,$b->at(0,0,2) == 17);
+ok(7,$b->at(0,0,3) == 20);
+ok(8,$b->at(0,0,4) == 23);
+ok(9,$b->at(0,0,5) == 26);
+
+# Now, start making affine stuffs...
+# not yet.
+exit(0);
+
+print $a->slice("(0),(0)"),"\n";
+$a0 = $a->slice("(0),(0)")->copy;
+
+print $b;
+$b->dump;
+$b += 1;
+$b->dump;
+print $b;
+
+print $a->slice("(0),(0)"),"\n";
+$a1 = $a->slice("(0),(0)")->copy;
+
+print $a1-$a0,"\n";
+
+$t->call_trans_foomethod(11,6,6);
+
+print $b->slice("(0),(0)"),"\n";
+print $a->slice("(0),(0)"),"\n";
diff --git a/t/func.pdl b/t/func.pdl
new file mode 100644
index 0000000..2fefa1b
--- /dev/null
+++ b/t/func.pdl
@@ -0,0 +1,13 @@
+
+# Test file for autoloader.t
+
+sub func {
+
+ my $x = shift;
+
+ return ($x**3 + 2);
+
+};
+
+1; # OK status
+
diff --git a/t/func.t b/t/func.t
new file mode 100644
index 0000000..1a4f8d1
--- /dev/null
+++ b/t/func.t
@@ -0,0 +1,92 @@
+# -*-perl-*-
+#
+use Test;
+use PDL::LiteF;
+
+BEGIN {
+ $loaded = 0; $slatec = 0;
+ # Must load slatec before Func since Func loads slatec itself
+ # and this line will be a no-op (and so we will not be able to
+ # spot that Slatec has failed)
+ eval "use PDL::Slatec";
+ $slatec = ($@ ? 0 : 1);
+
+ eval "use PDL::Func;";
+ $loaded = ($@ ? 0 : 1);
+
+ plan tests => $slatec ? 16 : 5;
+}
+
+##########################################################
+
+my $x = float( 1, 2, 3, 4, 5, 6, 8, 10 );
+my $y = ($x * 3) * ($x - 2);
+
+my $obj = init PDL::Func ( x => $x, y => $y );
+ok( $obj->scheme() eq "Linear" ); # 1
+
+my $xi = $x - 0.5;
+my $yi = $obj->interpolate( $xi );
+ok( $obj->status == -1 );
+
+# compare to direct version
+my ( $ans, $err ) = PDL::Primitive::interpolate( $xi, $x, $y );
+my $d = abs( $ans - $yi );
+ok( all $d < 1.0e-5 );
+
+my $oerr = $obj->get( 'err' );
+ok( all ($oerr-$err) == 0 );
+
+# check we trap a call to an unavailable method
+eval { $obj->gradient( $xi ); };
+ok( $@ ne "" ); # 5
+
+## Test: Hermite
+#
+exit unless $slatec;
+
+$x = sequence(float,10);
+$y = $x*$x + 0.5;
+#$obj->set( Interpolate => "Hermite", x => $x, y => $y, bc => "simple" );
+$obj->set( Interpolate => "Hermite", x => $x, y => $y );
+
+print "bc for Hermite interpolation: " . $obj->get('bc') . "\n";
+ok( $obj->scheme() eq "Hermite" );
+ok( $obj->get('bc') eq "simple" );
+ok( $obj->status == 1 );
+
+my $gi;
+
+$xi = sequence(float,5) + 2.3;
+$yi = $obj->interpolate( $xi );
+ok( $obj->status == 1 );
+
+$ans = $xi*$xi + 0.5;
+$d = abs( $ans - $yi );
+ok( all $d <= 0.03 );
+
+$gi = $obj->gradient( $xi );
+ok( $obj->status == 1 );
+
+$ans = 2*$xi;
+$d = abs( $ans - $gi );
+ok( all $d <= 0.04 );
+
+# see how they cope with threading
+#
+$y = cat( $x*$x+43.3, $x*$x*$x-23 );
+
+$obj->set( x => $x, y => $y );
+ok( $obj->status == 1 );
+
+$yi = $obj->interpolate( $xi );
+ok( $obj->status == 1 );
+ok( ( (dims($yi) == 2) & ($yi->getdim(0) == $xi->getdim(0))) & ($yi->getdim(1) == 2) );
+
+$ans = cat( $xi*$xi+43.3, $xi*$xi*$xi-23 );
+$d = abs( $ans - $yi );
+ok( all $d <= 6 );
+
+# end
+
+
diff --git a/t/gauss.t b/t/gauss.t
new file mode 100644
index 0000000..96973d1
--- /dev/null
+++ b/t/gauss.t
@@ -0,0 +1,49 @@
+# Test routine for PDL::Fit::Gaussian module
+
+use PDL;
+use PDL::Fit::Gaussian;
+
+
+print "1..2\n";
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+$count=1;
+sub ok {
+ my $no = $count++ ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+sub nint{int($_[0]->at+0.5)};
+
+$g1 = pdl qw[ 2.1990459 1.9464173 2.1565406 2.1672124 2.2701938
+1.82992 1.914893 2.1466146 1.8822749 2.0293979 2.0101469 2.210302
+2.6183602 4.3191846 7.8333737 11.525845 13.069404 11.364827 7.2853706
+4.3667506 2.2601078 2.0051197 1.802916 2.1735853 1.7985277 1.9498281
+1.7745239 1.7534224 2.6137111 1.8443813 2.0064845 2.1981632 2.0572412
+1.8928303 2.0703847 2.0121833 1.9967828 2.3846479 1.8907906 2.1486651];
+
+$g2 = pdl qw[ 13.013418 11.397573 7.4494489 4.5594057 2.5728955
+2.0687907 2.1953927 2.2819689 1.7046446 2.3276816 2.0130417 1.72691
+1.8260466 2.0842572 2.2455532 1.9223378 1.695866 1.5893454 1.9787549
+1.6941413 1.8576307 2.3780392 2.2588472 2.2080773 1.8754143 2.019966
+1.9363813 2.1414206 2.0062853 2.0867273 2.0158617 1.6481802 1.9686077
+2.2979197 2.2963699 2.1171346 1.8859732 2.1277667 2.0716804 1.9251175];
+
+
+my ($xc, $pk, $fwhm, $back, $err, $fit) = fitgauss1d(xvals($g1), $g1);
+
+
+#points $g1; hold; line $fit; rel;
+
+ok( nint($xc)==16 && nint($pk)==11 && nint($fwhm)==4 && nint($back)==2
+ && nint($err)==0 && sum(abs($g1-$fit))<10);
+
+($pk, $fwhm, $back, $err, $fit) = fitgauss1dr(xvals($g2),$g2);
+
+#points $g2; hold; line $fit; rel;
+
+ok(nint($pk)==11 && nint($fwhm)==4 && nint($back)==2
+ && nint($err)==0 && sum(abs($g2-$fit))<10);
+
diff --git a/t/gd_oo_tests.t b/t/gd_oo_tests.t
new file mode 100644
index 0000000..c59a541
--- /dev/null
+++ b/t/gd_oo_tests.t
@@ -0,0 +1,547 @@
+#!/usr/bin/perl
+
+#
+# Tests for the OO interface of PDL::IO::GD.
+#
+# Judd Taylor, Orbital Sytstems, Ltd.
+# 07 Apr 2006
+#
+
+use strict;
+use PDL;
+use Test::More;
+
+BEGIN
+{
+ my $Ntests = 32;
+
+ use PDL::Config;
+ if ( $PDL::Config{WITH_GD} )
+ {
+ eval( " use PDL::IO::GD; " );
+ if( $@ )
+ {
+ plan skip_all => "PDL::IO::GD requires the gd image library.";
+ }
+# elsif( $^O =~ /bsd$/i or $^O =~ /dragonfly/i )
+# {
+# if ( $ENV{AUTOMATED_TESTING} )
+# {
+# plan skip_all => "Known problem: sf.net bug #3518190, t/gd_oo_tests.t fails for BSD AMD64";
+# }
+# else
+# {
+# diag "Known problem: sf.net bug #3518190, t/gd_oo_tests.t fails for BSD AMD64";
+# plan tests => $Ntests;
+# }
+# }
+ else
+ {
+ plan tests => $Ntests;
+ }
+ }
+ else
+ {
+ plan skip_all => "PDL::IO::GD not compiled.";
+ }
+}
+
+use ExtUtils::testlib;
+
+use PDL::IO::GD;
+use PDL::Config;
+
+
+sub tapprox
+{
+ my $a = shift;
+ my $b = shift;
+ my $d = abs($a - $b);
+ #ok( all($d < 1.0e-5) );
+ return all($d < 1.0e-5);
+}
+
+#TODO:
+#{
+
+# local $TODO = 'gd_oo_tests.t fail for AMD64, sf.net #3518190';
+ # Test files:
+ #
+ my $tempdir = $PDL::Config{TEMPDIR} || "/tmp";
+
+ my $lutfile = "$tempdir/default.rcols";
+ my $testfile1 = "$tempdir/test.png";
+ my $testfile2 = "$tempdir/test2.png";
+ my $testfile3 = "$tempdir/test3.png";
+
+ # Write out the lutfile below, so we don't have to include it in the distro:
+ write_lut($lutfile);
+
+ # Start the tests:
+ #
+
+ #diag "Test writing byte (8bit) PNG image...\n";
+ my $pdl = sequence(byte, 30, 30);
+
+ # TEST 1:
+ # Load a lut from an ASCII file:
+ #diag "\$pdl:\n$pdl\n";
+ my $lut = load_lut( $lutfile );
+ #diag "\$lut info(): " . $lut->info() . "\n";
+ #diag "\$lut:\n$lut\n";
+ ok( ($lut->dim(0) == 3 && $lut->dim(1) == 256), 'Load a lut from an ASCII file' );
+
+ # TEST 2:
+ # write a PNG with the old interface:
+ write_png( $pdl, $lut, $testfile1 );
+ ok(1,'write a PNG with the old interface');
+
+ # TEST 3:
+ # write a truecolor PNG with the old interface:
+ #diag "Testing writing true color (32 bit) PNG image...\n";
+ write_true_png(sequence(100, 100, 3), $testfile3);
+ ok(1, 'write a truecolor PNG with the old interface');
+
+
+ #
+ # Open the file:
+ #
+ # TEST 4:
+ # Create a new object:
+ my $gd = PDL::IO::GD->new( { filename => $testfile1 } );
+ #diag "Object created!\n";
+ ok( defined( $gd ), 'Object created' );
+
+ # TEST 5 & 6:
+ # Query the dims:
+ my $x = $gd->gdImageSX();
+ ok( $x, 'query X dim' );
+ my $y = $gd->gdImageSY();
+ ok( $y, 'query Y dim' );
+ #diag "\$x = $x\t\$y = $y\n";
+
+ # TEST 7:
+ # Read it into a PDL, and make sure it matches:
+ my $pdl2 = $gd->to_pdl();
+ ok( tapprox( $pdl, $pdl2 ), 'image matches original pdl' );
+
+ # TEST 8:
+ # Kill it:
+ $gd->DESTROY();
+ #diag "Object destroyed!\n";
+ ok( 1, 'Object destroyed' );
+
+ #
+ # Create a new object:
+ #
+ # TEST 9:
+ # Create a new image from scratch:
+ my $im = PDL::IO::GD->new( { x => 300, y => 300 } );
+ ok( defined( $im ), 'creat new image from scratch' );
+
+ #
+ # Allocate some colors:
+ #
+ # TEST 10:
+ $im->apply_lut( $lut );
+ ok( 1, 'allocate some colors' );
+
+ # TESTS 11-14:
+ # Resolve some colors:
+ my $black = $im->ColorResolve( 0, 0, 0 );
+ ok( defined( $black ), 'resolve color black' );
+ my $red = $im->ColorResolve( 255, 0, 0 );
+ ok( defined( $red ), 'resolve color red' );
+ my $green = $im->ColorResolve( 0, 255, 0 );
+ ok( defined( $green ), 'resolve color green' );
+ my $blue = $im->ColorResolve( 0, 0, 255 );
+ ok( defined( $blue ), 'resolve color blue' );
+
+ # TEST 15:
+ # Draw a rectangle:
+ $im->Rectangle( 5, 5, 295, 295, $red );
+ ok( 1, 'draw a rectangle' );
+
+ # TEST 16:
+ # Add some text:
+ $im->String( gdFontGetLarge(), 10, 10, "Test Large Font!", $green );
+ ok( 1, 'add some text' );
+
+ # TEST 17:
+ # Generate a color bar:
+ my $x1 = zeroes( long, 256 ) + 50;
+ my $y1 = sequence( long, 256 ) + 30;
+ my $color = sequence(long, 256);
+ $im->Lines( $x1, $y1, $x1 + 100, $y1, $color );
+ ok( 1, 'generate a color bar' );
+
+ # TEST 18:
+ # Write the output file:
+ $im->write_Png( $testfile2 );
+ ok( 1, 'write the output file' );
+ $im->DESTROY(); $im = undef;
+
+ #
+ # New tests on object creation:
+ #
+
+ # TEST 19:
+ # Create from a 2d PDL without a LUT:
+ my $pic = sequence(100, 100);
+ $im = PDL::IO::GD->new({ pdl => $pic });
+ ok( defined( $im ), 'create from 2d PDL without a LUT' );
+ $im->DESTROY(); $im = undef;
+
+ # TEST 20:
+ # Create from a 2d PDL and a LUT:
+ $im = PDL::IO::GD->new({ pdl => $pic, lut => $lut });
+ ok( defined( $im ), 'create from 2d PDL and a LUT' );
+ $im->DESTROY(); $im = undef;
+
+ # TEST 21:
+ # Create from a RGB PDL:
+ my $pic3d = $pic->dummy(2,3);
+ $im = PDL::IO::GD->new({ pdl => $pic3d });
+ ok( defined( $im ), 'create from a RGB PDL' );
+ $im->DESTROY(); $im = undef;
+
+ # TEST 22:
+ # Create an RGB from scratch:
+ $im = PDL::IO::GD->new({ x => 100, y => 100, true_color => 1 });
+ ok( defined( $im ), 'create an RGB from scratch' );
+ $im->DESTROY(); $im = undef;
+
+ # TEST 23-24:
+ # Create from a 2d PNG data glob:
+ my $rc = open( TF1, $testfile1 );
+ ok( $rc, 'opened test file and handle' );
+ binmode( TF1 );
+ $/ = undef;
+ my $blob = <TF1>;
+ close( TF1 );
+ $im = PDL::IO::GD->new({ data => $blob });
+ ok( defined( $im ), 'create from a 2d PNG data glob' );
+ $im->DESTROY(); $im = undef;
+
+ # TEST 25:
+ # Create from a 2d PNG data glob, with the type given:
+ $im = PDL::IO::GD->new({ data => $blob, type => 'png' });
+ ok( defined( $im ), 'create from glob with type given' );
+ $im->DESTROY(); $im = undef;
+
+ # TEST 26-27:
+ # Create from a 3d PNG data glob:
+ $rc = open( TF3, $testfile3 );
+ ok( $rc , 'testfile3 successfully opened');
+ binmode( TF3 );
+ $/ = undef;
+ my $blob3d = <TF3>;
+ close( TF3 );
+ $im = PDL::IO::GD->new({ data => $blob3d });
+ ok( defined( $im ), 'create from a 3d PNG data glob' );
+
+ # TEST 28:
+ # Get a PNG data glob from a created
+ my $png_blob = $im->get_Png_data();
+ ok( $blob3d eq $png_blob, 'get a PNG data glob' );
+ $im->DESTROY(); $im = undef;
+
+ # TEST 29:
+ # Try a nicer way to make an object. Just pass in a filename:
+ my $gd_new_just_filename = PDL::IO::GD->new( $testfile1 );
+ ok( defined( $gd_new_just_filename ), 'initialize an object from JUST the filename' );
+
+ # TEST 30:
+ # Try another nicer way to make an object: Pass in an inline hash:
+ my $gd_new_inline_hash = PDL::IO::GD->new( filename => $testfile1 );
+ ok( defined( $gd_new_inline_hash ), 'initialize an object from an inline hash' );
+
+ # TEST 31:
+ # Make sure bogus inline hashes generate complaints. First, give an odd
+ # number of args
+ my $gd_new_inline_hash_broken1;
+ eval { $gd_new_inline_hash_broken1 = PDL::IO::GD->new( filename => $testfile1, 34 ) };
+ ok( $@ && !defined( $gd_new_inline_hash_broken1 ), 'incorrectly initialize an object from an inline hash: odd Nargs' );
+ # TEST 32:
+ # Make sure bogus inline hashes generate complaints. Give a non-string key
+ my $gd_new_inline_hash_broken2;
+ eval { $gd_new_inline_hash_broken2 = PDL::IO::GD->new( filename => $testfile1, [34] => 12 ) };
+ ok( $@ && !defined( $gd_new_inline_hash_broken2 ), 'incorrectly initialize an object from an inline hash: non-string key' );
+
+
+ # Remove our test files:
+ #
+ unlink( $lutfile );
+ unlink( $testfile1 );
+ unlink( $testfile2 );
+ unlink( $testfile3 );
+
+#}
+
+exit (0);
+#
+sub write_lut
+{
+ my $filename = shift;
+ open( LUT, ">$filename" );
+ print LUT <<'ENDLUT';
+ 2 0 4
+ 9 0 7
+ 22 0 19
+ 36 0 32
+ 50 0 48
+ 61 0 63
+ 69 0 77
+ 77 0 91
+ 82 0 104
+ 84 0 118
+ 88 0 132
+ 87 0 145
+ 84 0 159
+ 83 0 173
+ 77 0 186
+ 70 0 200
+ 60 0 214
+ 53 0 227
+ 40 0 241
+ 25 0 255
+ 12 0 255
+ 0 4 255
+ 0 21 255
+ 0 38 255
+ 0 55 255
+ 0 72 255
+ 0 89 255
+ 0 106 255
+ 0 119 255
+ 0 135 255
+ 0 152 255
+ 0 165 255
+ 0 187 255
+ 0 195 255
+ 0 203 255
+ 0 208 255
+ 0 220 255
+ 0 225 255
+ 0 233 255
+ 0 242 255
+ 0 250 255
+ 0 255 255
+ 0 255 242
+ 0 255 238
+ 0 255 225
+ 0 255 220
+ 0 255 212
+ 0 255 203
+ 0 255 195
+ 0 255 187
+ 0 255 174
+ 0 255 165
+ 0 255 152
+ 0 255 144
+ 0 255 131
+ 0 255 114
+ 0 255 102
+ 0 255 84
+ 0 255 67
+ 0 255 55
+ 0 255 38
+ 0 255 21
+ 0 255 8
+ 8 255 0
+ 25 255 0
+ 42 255 0
+ 55 255 0
+ 76 255 0
+ 97 255 0
+119 255 0
+140 255 0
+161 255 0
+182 255 0
+203 255 0
+225 255 0
+246 255 0
+255 242 0
+255 242 0
+255 242 0
+255 242 0
+255 238 0
+255 238 0
+255 238 0
+255 233 0
+255 233 0
+255 233 0
+255 233 0
+255 229 0
+255 229 0
+255 229 0
+255 221 0
+255 221 0
+255 221 0
+255 221 0
+255 216 0
+255 216 0
+255 216 0
+255 212 0
+255 212 0
+255 212 0
+255 208 0
+255 208 0
+255 199 0
+255 199 0
+255 199 0
+255 195 0
+255 195 0
+255 191 0
+255 191 0
+255 191 0
+255 187 0
+255 187 0
+255 178 0
+255 178 0
+255 178 0
+255 174 0
+255 174 0
+255 170 0
+255 170 0
+255 165 0
+255 165 0
+255 165 0
+255 161 0
+255 161 0
+255 153 0
+255 153 0
+255 153 0
+255 148 0
+255 148 0
+255 144 0
+255 144 0
+255 144 0
+255 140 0
+255 140 0
+255 131 0
+255 131 0
+255 127 0
+255 127 0
+255 127 0
+255 123 0
+255 123 0
+255 123 0
+255 119 0
+255 119 0
+255 110 0
+255 110 0
+255 110 0
+255 106 0
+255 106 0
+255 106 0
+255 102 0
+255 102 0
+255 97 0
+255 97 0
+255 97 0
+255 89 0
+255 89 0
+255 85 0
+255 85 0
+255 85 0
+255 80 0
+255 80 0
+255 76 0
+255 76 0
+255 72 0
+255 72 0
+255 72 0
+255 63 0
+255 63 0
+255 59 0
+255 59 0
+255 55 0
+255 55 0
+255 51 0
+255 51 0
+255 42 0
+255 42 0
+255 38 0
+255 38 0
+255 34 0
+255 34 0
+255 29 0
+255 29 0
+255 21 0
+255 21 0
+255 17 0
+255 17 0
+255 17 0
+255 17 0
+255 17 0
+255 17 0
+255 17 0
+255 17 0
+255 12 0
+255 12 0
+255 12 0
+255 12 0
+255 12 0
+255 12 0
+255 12 0
+255 12 0
+255 8 0
+255 8 0
+255 8 0
+255 8 0
+255 8 0
+255 8 0
+255 8 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 29 0
+170 170 170
+ 0 255 0
+255 250 0
+ 0 0 0
+255 255 255
+ENDLUT
+ close( LUT );
+} # End of write_lut()...
+
diff --git a/t/gd_tests.t b/t/gd_tests.t
new file mode 100644
index 0000000..93a9032
--- /dev/null
+++ b/t/gd_tests.t
@@ -0,0 +1,397 @@
+#!/usr/bin/perl
+
+#
+# t/gd_tests.t - tests functions in the PDL::IO::GD module
+#
+# Judd Taylor, USF IMaRS
+# 13 March 2003
+#
+
+use strict;
+use PDL;
+use PDL::Config;
+use Test::More;
+use File::Temp qw(tempdir);
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_GD} )
+ {
+ eval( " use PDL::IO::GD; " );
+ if( $@ )
+ {
+ plan skip_all => "PDL::IO::GD requires the gd image library.";
+ }
+ else
+ {
+ plan tests => 13;
+ }
+ }
+ else
+ {
+ plan skip_all => "PDL::IO::GD not compiled.";
+ }
+}
+
+sub tapprox
+{
+ my $a = shift;
+ my $b = shift;
+ my $d = abs($a - $b);
+ #ok( all($d < 1.0e-5) );
+ return all($d < 1.0e-5);
+}
+
+use ExtUtils::testlib;
+
+use PDL::IO::GD;
+
+# Test Files:
+my $tempdir = tempdir( CLEANUP=>1 );
+
+my $lutfile = "$tempdir/default.rcols";
+my $testfile1 = "$tempdir/test.png";
+my $testfile2 = "$tempdir/test_true.png";
+my $testfile3 = "$tempdir/test_comp.png";
+my $testfile4 = "$tempdir/test_nocomp.png";
+
+# Write out the lutfile below, so we don't have to include it in the distro:
+write_lut($lutfile);
+
+# Start the tests:
+#
+
+# TEST 1:
+# Load the lutfile from the ascii file we just created:
+my $lut = load_lut( $lutfile );
+print "Dims of loaded lut: " . join(", ", $lut->dims()) . "\n";
+ok( ($lut->dim(0) == 3 && $lut->dim(1) == 256) );
+
+# TEST 2:
+print "Test writing byte (8bit) PNG image...\n";
+my $pdl = sequence(byte, 30, 30);
+write_png( $pdl, $lut, $testfile1 );
+ok( 1 );
+
+# TEST 3:
+print "Testing writing true color (32 bit) PNG image...\n";
+my $tc_pdl = sequence(byte, 100, 100, 3);
+write_true_png( $tc_pdl, $testfile2 );
+ok( 1 );
+
+# TEST 4:
+print "Test reading byte (8bit) PNG image...\n";
+my $image = read_png($testfile1);
+ok( tapprox( $pdl, $image ) );
+$image = null;
+
+# TEST 5:
+print "Test reading true color PNG image...\n";
+$image = read_true_png( $testfile2 );
+ok( tapprox( $image, $tc_pdl ) );
+
+# TEST 6:
+print "Test reading byte (8bit) PNG Color Table...\n";
+my $lut2 = read_png_lut( $testfile1 );
+ok( tapprox( $lut, $lut2 ) );
+
+# TESTS 7-9:
+# Test the compression level stuff:
+print "Test writing byte (8bit) PNG image with various compression levels...\n";
+$pdl = sequence(byte, 30, 30);
+write_png_ex($pdl, $lut, $testfile3, 0);
+ok( 1 );
+write_png_ex($pdl, $lut, $testfile3, 9);
+ok( 1 );
+write_png_best($pdl, $lut, $testfile3);
+ok( 1 );
+
+# TESTS 10-12:
+print "Testing writing true color (32 bit) PNG image with various compression levels...\n";
+$pdl = sequence(100, 100, 3);
+write_true_png_ex($pdl, $testfile4, 0);
+ok( 1 );
+write_true_png_ex($pdl, $testfile3, 9);
+ok( 1 );
+write_true_png_best($pdl, $testfile3 );
+ok( 1 );
+
+# TEST 13:
+print "Testing recompressiong PNG image recompress_png_best()...\n";
+recompress_png_best( $testfile3 );
+ok( tapprox( read_png( $testfile4 ), read_png( $testfile3 ) ) );
+
+# Remove the testfiles:
+#
+for ( $lutfile, $testfile1, $testfile2, $testfile3, $testfile4 )
+ { unlink( $_ ); }
+
+exit(0);
+
+sub write_lut
+{
+ my $filename = shift;
+ open( LUT, ">$filename" )
+ or die "Can't write $filename: $!\n";
+ print LUT <<'ENDLUT';
+ 2 0 4
+ 9 0 7
+ 22 0 19
+ 36 0 32
+ 50 0 48
+ 61 0 63
+ 69 0 77
+ 77 0 91
+ 82 0 104
+ 84 0 118
+ 88 0 132
+ 87 0 145
+ 84 0 159
+ 83 0 173
+ 77 0 186
+ 70 0 200
+ 60 0 214
+ 53 0 227
+ 40 0 241
+ 25 0 255
+ 12 0 255
+ 0 4 255
+ 0 21 255
+ 0 38 255
+ 0 55 255
+ 0 72 255
+ 0 89 255
+ 0 106 255
+ 0 119 255
+ 0 135 255
+ 0 152 255
+ 0 165 255
+ 0 187 255
+ 0 195 255
+ 0 203 255
+ 0 208 255
+ 0 220 255
+ 0 225 255
+ 0 233 255
+ 0 242 255
+ 0 250 255
+ 0 255 255
+ 0 255 242
+ 0 255 238
+ 0 255 225
+ 0 255 220
+ 0 255 212
+ 0 255 203
+ 0 255 195
+ 0 255 187
+ 0 255 174
+ 0 255 165
+ 0 255 152
+ 0 255 144
+ 0 255 131
+ 0 255 114
+ 0 255 102
+ 0 255 84
+ 0 255 67
+ 0 255 55
+ 0 255 38
+ 0 255 21
+ 0 255 8
+ 8 255 0
+ 25 255 0
+ 42 255 0
+ 55 255 0
+ 76 255 0
+ 97 255 0
+119 255 0
+140 255 0
+161 255 0
+182 255 0
+203 255 0
+225 255 0
+246 255 0
+255 242 0
+255 242 0
+255 242 0
+255 242 0
+255 238 0
+255 238 0
+255 238 0
+255 233 0
+255 233 0
+255 233 0
+255 233 0
+255 229 0
+255 229 0
+255 229 0
+255 221 0
+255 221 0
+255 221 0
+255 221 0
+255 216 0
+255 216 0
+255 216 0
+255 212 0
+255 212 0
+255 212 0
+255 208 0
+255 208 0
+255 199 0
+255 199 0
+255 199 0
+255 195 0
+255 195 0
+255 191 0
+255 191 0
+255 191 0
+255 187 0
+255 187 0
+255 178 0
+255 178 0
+255 178 0
+255 174 0
+255 174 0
+255 170 0
+255 170 0
+255 165 0
+255 165 0
+255 165 0
+255 161 0
+255 161 0
+255 153 0
+255 153 0
+255 153 0
+255 148 0
+255 148 0
+255 144 0
+255 144 0
+255 144 0
+255 140 0
+255 140 0
+255 131 0
+255 131 0
+255 127 0
+255 127 0
+255 127 0
+255 123 0
+255 123 0
+255 123 0
+255 119 0
+255 119 0
+255 110 0
+255 110 0
+255 110 0
+255 106 0
+255 106 0
+255 106 0
+255 102 0
+255 102 0
+255 97 0
+255 97 0
+255 97 0
+255 89 0
+255 89 0
+255 85 0
+255 85 0
+255 85 0
+255 80 0
+255 80 0
+255 76 0
+255 76 0
+255 72 0
+255 72 0
+255 72 0
+255 63 0
+255 63 0
+255 59 0
+255 59 0
+255 55 0
+255 55 0
+255 51 0
+255 51 0
+255 42 0
+255 42 0
+255 38 0
+255 38 0
+255 34 0
+255 34 0
+255 29 0
+255 29 0
+255 21 0
+255 21 0
+255 17 0
+255 17 0
+255 17 0
+255 17 0
+255 17 0
+255 17 0
+255 17 0
+255 17 0
+255 12 0
+255 12 0
+255 12 0
+255 12 0
+255 12 0
+255 12 0
+255 12 0
+255 12 0
+255 8 0
+255 8 0
+255 8 0
+255 8 0
+255 8 0
+255 8 0
+255 8 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 0 0
+255 29 0
+170 170 170
+ 0 255 0
+255 250 0
+ 0 0 0
+255 255 255
+ENDLUT
+ close( LUT );
+} # End of write_lut()...
+
diff --git a/t/gis_proj.t b/t/gis_proj.t
new file mode 100644
index 0000000..76a58e5
--- /dev/null
+++ b/t/gis_proj.t
@@ -0,0 +1,187 @@
+#!/usr/bin/perl
+
+#
+# t/gis_proj.t
+#
+# Test program for the PDL::GIS::Proj library
+#
+# Judd Taylor, Orbital Systems, Ltd.
+# 18 March 2003
+#
+
+use strict;
+use PDL;
+use Test::More;
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_PROJ} )
+ {
+ eval( " use PDL::GIS::Proj; " );
+ if( $@ )
+ {
+ plan skip_all => "PDL::GIS::Proj compiled, but not available.";
+ }
+ else
+ {
+ plan tests => 15;
+ }
+ }
+ else
+ {
+ plan skip_all => "PDL::GIS::Proj module not compiled.";
+ }
+}
+
+sub tapprox
+{
+ my $a = shift;
+ my $b = shift;
+ my $d = abs($a - $b);
+ #ok( all($d < 1.0e-5) );
+ return all($d < 1.0e-5);
+}
+
+use PDL::GIS::Proj;
+
+print "Testing forward transformation...\n";
+my $proj = "+proj=merc +ellps=WGS72 +lon_0=80.25w +lat_0=30n";
+print "Perl level params: \'$proj\'\n";
+
+my $lon = double [-90.0, -95.0, -86.0];
+my $lat = double [ 0.0, 33.0, 77.0];
+# Expected results:
+my $x_exp = double [-1085364.69489521, -1641961.97432865, -640086.87134846];
+my $y_exp = double [7.0811523e-10, 3872032.73513601, 13812394.85701733];
+
+# TEST 1 & 2:
+my ($x, $y) = fwd_transform($lon, $lat, $proj);
+print "Inputs:\n\t\$lon = $lon\n\t\$lat = $lat\n";
+print "Result:\n\t\$x = $x\n\t\$y = $y\n";
+#print_hi_prec( "x", $x );
+#print_hi_prec( "y", $y );
+ok( sub { tapprox( $x, $x_exp ) } );
+ok( sub { tapprox( $y, $y_exp ) } );
+
+# TEST 3 & 4:
+print "\nTesting inverse transformation...\n";
+print "Perl level params: \'$proj\'\n";
+my ($lon2, $lat2) = inv_transform($x, $y, $proj);
+print "Inputs:\n\t\$x = $x\n\t\$y = $y\n";
+print "Results:\n\t\$lon2 = $lon2\n\t\$lat2 = $lat2\n";
+ok( sub { tapprox( $lon2, $lon ) } );
+ok( sub { tapprox( $lat2, $lat ) } );
+
+# Do the corners of a cyl eq map, and see what we get...
+print "\nCorners of a cylindrical equidistant projection:\n";
+my $cyl_eq = "+proj=eqc +lon_0=0";
+print "Perl level params: \'$cyl_eq\'\n";
+my $lon3 = double [-180.0, -180.0, 180.0, 180.0];
+my $lat3 = double [ 90.0, -90.0, 90.0, -90.0];
+# Expexted results:
+my $x3_exp = double [ -20037508.34278924, -20037508.34278924, 20037508.34278924, 20037508.34278924 ];
+my $y3_exp = double [ 10018754.17139462, -10018754.17139462, 10018754.17139462, -10018754.17139462 ];
+
+# TEST 5 & 6:
+my ($x3, $y3) = fwd_transform($lon3, $lat3, $cyl_eq);
+print "Inputs:\n\t\$lon3 = $lon3\n\t\$lat3 = $lat3\n";
+print "Result:\n\t\$x3 = $x3\n\t\$y3 = $y3\n";
+ok( sub { tapprox( $x3, $x3_exp ) } );
+ok( sub { tapprox( $y3, $y3_exp ) } );
+
+#print_hi_prec( "x3", $x3 );
+#print_hi_prec( "y3", $y3 );
+
+($lat, $lon) = undef;
+
+# TEST 7 & 8:
+$lon = float [-90.0, -95.0, -86.0];
+$lat = float [ 0.0, 33.0, 77.0];
+
+# Convert the previous expexted results to float:
+my $tmp = $x_exp->sever();
+$x_exp = float( $tmp );
+$tmp = $y_exp->sever();
+$y_exp = float( $tmp );
+
+print "\nTesting inplace operation...\nForward:\n";
+#my $format = "\tType: %T\n\tDim: %-15D\n\tState: %S\n\tFlow: %F\n\tClass: %C\n\tAddress: %A\n\tMem: %M\n";
+print "Inputs:\n\t\$lon = $lon\n\t\$lat = $lat\n";
+#print "\$lon INFO:\n" . $lon->info($format) . "\n";
+#print "\$lat INFO:\n" . $lat->info($format) . "\n";
+
+fwd_trans_inplace($lon, $lat, $proj);
+print "Result:\n\t\$lon = $lon\n\t\$lat = $lat\n";
+#print "\$lon INFO:\n" . $lon->info($format) . "\n";
+#print "\$lat INFO:\n" . $lat->info($format) . "\n";
+#print_hi_prec("lon", $lon);
+#print_hi_prec("lat", $lat);
+ok( sub { tapprox( $lon, $x_exp ) } );
+ok( sub { tapprox( $lat, $y_exp ) } );
+
+# TEST 9 & 10:
+print "\nInverse:\n";
+print "Inputs:\n\t\$lon = $lon\n\t\$lat = $lat\n";
+# Expexted results:
+my $lon_exp = float [-90.0, -95.0, -86.0];
+my $lat_exp = float [ 0.0, 33.0, 77.0];
+
+inv_trans_inplace($lon, $lat, $proj);
+print "Result:\n\t\$lon = $lon\n\t\$lat = $lat\n";
+ok( sub { tapprox( $lon, $lon_exp ) } );
+ok( sub { tapprox( $lat, $lat_exp ) } );
+
+# TEST 11:
+print "\nTesting get_proj_info()...\n";
+print "PROJ INFO: \n" . get_proj_info($proj) . "\n";
+ok( 1 );
+
+# TEST 12 & 13:
+
+print "\nTesting 2d inplace operation...\n";
+$lat = (yvals( double, 35, 17 ) - 8.0) * 10.0;
+$lon = (xvals( double, 35, 17 ) - 17.0) * 10.0;
+print "Inputs:\n\t\$lon = $lon\n\t\$lat = $lat\n";
+fwd_trans_inplace($lon, $lat, $proj);
+print "Result:\n\t\$lon = $lon\n\t\$lat = $lat\n";
+
+ok(1);
+ok(1);
+
+# TEST 14:
+# Get projection descriptions:
+my $projections = load_projection_descriptions();
+#use Data::Dumper;
+#my $dd = Data::Dumper->new( [$projections], ['projections'] );
+#$dd->Indent(1);
+#print STDERR $dd->Dump();
+ok(1);
+
+# TEST 15:
+# Get full projection information:
+my $info = load_projection_information();
+#use Data::Dumper;
+#foreach ( sort keys %$info )
+#{
+# my $dd2 = Data::Dumper->new( [ $info->{$_} ], [ $_ ] );
+# $dd2->Indent(1);
+# print STDERR $dd2->Dump() . "\n";
+#}
+ok(1);
+
+
+exit(0);
+
+sub print_hi_prec
+{
+ my $name = shift;
+ my $pdl = shift;
+ my $type = $pdl->type();
+ my $last = $pdl->dim(0) - 1;
+ print "\$$name = $type [ ";
+ foreach my $i ( 0 .. $last - 1 )
+ { printf("%.8f, ", $pdl->at($i) ); }
+ printf("%.8f ];\n", $pdl->at( $last ));
+ return;
+}
diff --git a/t/gsl_diff.t b/t/gsl_diff.t
new file mode 100644
index 0000000..654c308
--- /dev/null
+++ b/t/gsl_diff.t
@@ -0,0 +1,46 @@
+
+# Test Script for the PDL interface to the GSL library
+# This tests mainly that the interface is working, i.e. that the
+# functions can be called.
+# The GSL library already has a extensive test suite, and we
+# do not want to duplicate that effort here.
+
+use PDL;
+use Test::More;
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_GSL} ) {
+ eval " use PDL::GSL::DIFF; ";
+ unless ($@) {
+ plan tests => 4;
+ } else {
+ plan skip_all => "PDL::GSL::DIFF not installed.";
+ }
+ } else {
+ plan skip_all => "PDL::GSL::DIFF not compiled.";
+ }
+}
+
+ at res = gsldiff(\&myf,1.5);
+
+ok(abs($res[0]- 28.4632075095177) < 1e-6 );
+
+ at res = gsldiff(\&myf,1.5,{Method => 'central'});
+
+ok(abs($res[0]- 28.4632075095177) < 1e-6 );
+
+ at res = gsldiff(\&myf,1.5,{Method => 'forward'});
+
+ok(abs($res[0]- 28.4632852673531) < 1e-6 );
+
+ at res = gsldiff(\&myf,1.5,{Method => 'backward'});
+
+ok(abs($res[0]-28.4631297516823 ) < 1e-6 );
+
+
+sub myf{
+ my ($x) = @_;
+ return exp($x**2);
+}
diff --git a/t/gsl_integ.t b/t/gsl_integ.t
new file mode 100644
index 0000000..41460f8
--- /dev/null
+++ b/t/gsl_integ.t
@@ -0,0 +1,145 @@
+
+# Test Script for the PDL interface to the GSL library
+# This tests mainly that the interface is working, i.e. that the
+# functions can be called.
+# The GSL library already has a extensive test suite, and we
+# do not want to duplicate that effort here.
+
+use PDL;
+use Test::More;
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_GSL} ) {
+ eval " use PDL::GSL::INTEG; ";
+ unless ($@) {
+ plan tests => 22;
+ } else {
+ plan skip_all => "PDL::GSL::INTEG not installed.";
+ }
+ } else {
+ plan skip_all => "PDL::GSL::INTEG not compiled.";
+ }
+}
+
+my $alfa = 2.6;
+
+my ($res,$abserr,$neval,$ierr) = gslinteg_qng(\&f1,0,1,0,1e-9);
+ok(abs($res - 0.0771604938270651) < 1e-6);
+($res,$abserr,$neval,$ierr) = gslinteg_qng(\&f1,0,1,0,1e-9,{Warn => 'y'});
+ok(abs($res - 0.0771604938270651) < 1e-6);
+
+($res,$abserr,$ierr) = gslinteg_qag(\&f1,0,1,0,1e-10,1000,1);
+ok(abs($res - 0.0771604938271586) < 1e-6);
+($res,$abserr,$ierr) = gslinteg_qag(\&f1,0,1,0,1e-10,1000,1,{Warn => 'y'});
+ok(abs($res - 0.0771604938271586) < 1e-6);
+
+($res,$abserr,$ierr) = gslinteg_qags(\&f1,0,1,0,1e-10,1000);
+ok(abs($res - 0.0771604938271579) < 1e-6);
+($res,$abserr,$ierr) = gslinteg_qags(\&f1,0,1,0,1e-10,1000,{Warn => 'y'});
+ok(abs($res - 0.0771604938271579) < 1e-6);
+
+my $points = pdl(0,1,sqrt(2),3);
+($res,$abserr,$ierr) = gslinteg_qagp(\&f454,$points,0,1e-3,1000);
+ok(abs($res - 52.7408061167272) < 1e-6);
+($res,$abserr,$ierr) = gslinteg_qagp(\&f454,$points,0,1e-3,1000,{Warn => 'y'});
+ok(abs($res - 52.7408061167272) < 1e-6);
+
+($res,$abserr,$ierr) = gslinteg_qagi(\&myfn1,1e-7,0,1000);
+ok(abs($res -2.27587579446875 ) < 1e-6);
+($res,$abserr,$ierr) = gslinteg_qagi(\&myfn1,1e-7,0,1000,{Warn => 'y'});
+ok(abs($res -2.27587579446875 ) < 1e-6);
+
+$alfa = 1;
+($res,$abserr,$ierr) = gslinteg_qagiu(\&f16,99.9,1e-7,0,1000);
+ok(abs($res -0.000100000000000671) < 1e-6);
+($res,$abserr,$ierr) = gslinteg_qagiu(\&f16,99.9,1e-7,0,1000,{Warn => 'y'});
+ok(abs($res -0.000100000000000671) < 1e-6);
+
+($res,$abserr,$ierr) = gslinteg_qagil(\&myfn2,1.0,1e-7,0,1000);
+ok(abs($res -2.71828182845905) < 1e-6);
+($res,$abserr,$ierr) = gslinteg_qagil(\&myfn2,1.0,1e-7,0,1000,{Warn => 'y'});
+ok(abs($res -2.71828182845905) < 1e-6);
+
+
+($res,$abserr,$ierr) = gslinteg_qawc(\&f459,-1,5,0,0,1e-3,1000);
+ok(abs($res + 0.08994400695837) < 1e-6);
+($res,$abserr,$ierr) = gslinteg_qawc(\&f459,-1,5,0,0,1e-3,1000,{Warn => 'y'});
+ok(abs($res + 0.08994400695837) < 1e-6);
+
+
+($res,$abserr,$ierr) = gslinteg_qaws(\&f458,0,0,1,0,0,1,0,1e-7,1000);
+ok(abs($res + 0.18927518534894) < 1e-6);
+($res,$abserr,$ierr) = gslinteg_qaws(\&f458,0,0,1,0,0,1,0,1e-7,1000,{Warn => 'y'});
+ok(abs($res + 0.18927518534894) < 1e-6);
+
+
+my $PI = 3.14159265358979323846264338328;
+($res,$abserr,$ierr) = gslinteg_qawo(\&f456,10*$PI,'sin',0,1,0,1e-7,1000);
+ok(abs($res + 0.128136848399167) < 1e-6);
+($res,$abserr,$ierr) = gslinteg_qawo(\&f456,10*$PI,'sin',0,1,0,1e-7,1000,{Warn => 'y'});
+ok(abs($res + 0.128136848399167) < 1e-6);
+
+
+($res,$abserr,$ierr) = gslinteg_qawf(\&f457,$PI/2.0,'cos',0,1e-7,1000);
+ok(abs($res -0.999999999927978) < 1e-6);
+($res,$abserr,$ierr) = gslinteg_qawf(\&f457,$PI/2.0,'cos',0,1e-7,1000,{Warn => 'y'});
+ok(abs($res -0.999999999927978) < 1e-6);
+
+
+sub f1{
+ my ($x) = @_;
+ return ($x**$alfa)*log(1.0/$x);
+}
+
+sub f454{
+ my ($x) = @_;
+ my $x2 = $x**2;
+ my $x3 = $x**3;
+ return $x3 * log(abs(($x2-1.0)*($x2-2.0)));
+}
+
+sub myfn1{
+ my ($x) = @_;
+ return exp(-$x - $x*$x) ;
+}
+
+sub f16 {
+ my ($x) = @_;
+ if (($x==0) && ($alfa == 1)) {return 1;}
+ if (($x==0) && ($alfa > 1)) {return 0;}
+ return ($x**($alfa-1))/((1+10*$x)**2);
+}
+
+sub myfn2{
+ my ($x) = @_;
+ return exp($alfa*$x);
+}
+
+sub f459{
+ my ($x) = @_;
+ return 1.0 / (5.0 * $x * $x * $x + 6.0) ;
+}
+
+sub f458{
+ my ($x) = @_;
+ if($x==0){return 0;}
+ else{
+ my $u = log($x);
+ my $v = 1 + $u*$u;
+ return 1.0/($v*$v);
+ }
+}
+
+sub f456{
+ my ($x) = @_;
+ if($x==0){return 0;}
+ else{ return log($x);}
+}
+
+sub f457{
+ my ($x) = @_;
+ if ($x == 0){return 0;}
+ return 1.0/sqrt($x)
+}
diff --git a/t/gsl_interp.t b/t/gsl_interp.t
new file mode 100644
index 0000000..b754968
--- /dev/null
+++ b/t/gsl_interp.t
@@ -0,0 +1,58 @@
+
+# Test Script for the PDL interface to the GSL library
+# This tests mainly that the interface is working, i.e. that the
+# functions can be called.
+# The GSL library already has a extensive test suite, and we
+# do not want to duplicate that effort here.
+
+use PDL;
+use PDL::Config;
+use Test::More;
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_GSL} ) {
+ eval " use PDL::GSL::INTERP; ";
+ unless ($@) {
+ plan tests => 12;
+ } else {
+ plan skip_all => "PDL::GSL::INTERP not installed";
+ }
+ } else {
+ plan skip_all => "PDL::GSL::INTERP not compiled.";
+ }
+}
+
+my $x = sequence(10);
+my $y = exp($x);
+my $spl = PDL::GSL::INTERP->init('cspline',$x,$y);
+
+ok(defined $spl, 'create cspline');
+
+my $spl2 = PDL::GSL::INTERP->init('cspline',$x,$y,{Sort => 0});
+
+ok(defined $spl2, 'create cspline no sort');
+
+ok(abs($spl->eval(5.5)-237.641810667697) < 1e-6, 'eval 5.5' );
+ok(abs($spl->deriv(5.5)-237.669424604497) < 1e-6, 'deriv 5.5' );
+ok(abs($spl->deriv2(5.5)-306.23332503967) < 1e-6, 'deriv2 5.5' );
+ok(abs($spl->integ(3.2,8.5)-4925.23555581654) < 1e-6, 'integ 3.2 to 8.5' );
+ok(abs($spl->eval(5.5,{Extrapolate => 1})-237.641810667697) < 1e-6, 'eval 5.5 w Extrapolate' );
+ok(abs($spl->deriv(5.5,{Extrapolate => 1})-237.669424604497) < 1e-6, 'deriv 5.5 w Extrapolate' );
+ok(abs($spl->deriv2(5.5,{Extrapolate => 1})-306.23332503967) < 1e-6, 'deriv2 5.5 w Extrapolate' );
+ok(abs($spl->integ(3.2,8.5,{Extrapolate => 1})-4925.23555581654) < 1e-6, 'integ 3.2 to 8.5 w Extrapolate' );
+
+# Bad value test added 5/31/2005 D. Hunt
+
+SKIP: {
+ skip "Test not valid without bad value support", 1 unless $PDL::Bad::Status;
+ ok ($spl->eval(pdl(0)->setbadat(0))->isbad, 'cspline eval w badvalue');
+}
+
+# Exception handling test added 10/18/2010 Jason Lin
+
+my $nx = ($x)*($x<=3) + ($x-1)*($x>3); # x value not monotonically increasing
+my $i; eval { $i = PDL::GSL::INTERP->init('cspline',$nx, $y) };
+
+like($@,qr/invalid argument supplied by user/,"module exception handling");
diff --git a/t/gsl_mroot.t b/t/gsl_mroot.t
new file mode 100644
index 0000000..a1683bf
--- /dev/null
+++ b/t/gsl_mroot.t
@@ -0,0 +1,47 @@
+
+# Test Script for the PDL interface to the GSL library
+# This tests mainly that the interface is working, i.e. that the
+# functions can be called.
+# The GSL library already has a extensive test suite, and we
+# do not want to duplicate that effort here.
+
+use PDL;
+use Test::More;
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_GSL} ) {
+ eval " use PDL::GSL::MROOT; ";
+ unless ($@) {
+ ## plan tests => 2;
+ plan skip_all => "PDL::GSL::MROOT doesn't work with PDL_Index, yet";
+ } else {
+ plan skip_all => "PDL::GSL::MROOT not installed";
+ }
+ } else {
+ plan skip_all => "PDL::GSL::MROOT not compiled.";
+ }
+}
+
+my $init = pdl (-10.00, -5.0);
+my $epsabs = 1e-7;
+
+$res = gslmroot_fsolver($init, \&rosenbrock,{Method => 0, EpsAbs => $epsabs});
+
+my @res = list ($res);
+
+ok(abs($res[0]- 1) < 1e-6 );
+ok(abs($res[1]- 1) < 1e-6 );
+
+
+sub rosenbrock{
+ my ($x) = @_;
+ my $a = 1;
+ my $b = 10;
+ my $y = zeroes($x);
+ my $tmp; # work around perl -d "feature"
+ ($tmp = $y->slice(0)) .= $a * (1 - $x->slice(0));
+ ($tmp = $y->slice(1)) .= $b * ($x->slice(1) - $x->slice(0)**2);
+ return $y;
+}
diff --git a/t/gsl_rng.t b/t/gsl_rng.t
new file mode 100644
index 0000000..b59e5cf
--- /dev/null
+++ b/t/gsl_rng.t
@@ -0,0 +1,142 @@
+
+
+# Test Script for the PDL interface to the GSL library
+# This tests only that the interface is working, i.e. that the
+# functions can be called. The actual return values are not
+# checked.
+# The GSL library already has a extensive test suite, and we
+# do not want to duplicate that effort here.
+
+use PDL;
+use Test::More;
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_GSL} ) {
+ eval " use PDL::GSL::RNG; ";
+ unless ($@) {
+ plan tests => 18;
+ } else {
+ plan skip_all => "PDL::GSL::RNG not installed.";
+ }
+ } else {
+ plan skip_all => "PDL::GSL::RNG not compiled.";
+ }
+}
+
+$image = zeroes(10,10);
+$ndim = 2;
+$name = '';
+$sigma = 1;
+
+# new() function Test:
+$rng = PDL::GSL::RNG->new('taus');
+
+ok(1,'new() function');
+
+# set_seed(); function Test:
+$rng->set_seed(666);
+
+ok(1,'set_seed(); function');
+
+# min() function Test:
+$min = $rng->min(); $max = $rng->max();
+
+ok(1,'min() function');
+
+# rmax() function Test:
+$min = $rng->min(); $max = $rng->max();
+
+ok(1,'rmax() function');
+
+# name() function Test:
+$name = $rng->name();
+
+ok(1,'name() function');
+
+# get_uniform() function Test:
+$a = zeroes 5,6; $max=100;
+
+$o = $rng->get_uniform(10,10); $rng->get_uniform($a);
+
+ok(1,'get_uniform() function');
+
+# get_uniform_pos() function Test:
+$a = zeroes 5,6;
+
+$o = $rng->get_uniform_pos(10,10); $rng->get_uniform_pos($a);
+
+ok(1,'get_uniform_pos() function');
+
+# get() function Test:
+$a = zeroes 5,6;
+
+$o = $rng->get(10,10); $rng->get($a);
+
+ok(1,'get() function');
+
+# get_int() function Test:
+$a = zeroes 5,6; $max=100;
+
+$o = $rng->get(10,10); $rng->get($a);
+
+ok(1,'get_int() function');
+
+# ran_gaussian() function Test:
+$o = $rng->ran_gaussian($sigma,10,10);
+
+$rng->ran_gaussian($sigma,$a);
+
+
+ok(1,'ran_gaussian() function');
+
+# $rng->ran_gaussian_var() function Test:
+$sigma_pdl = rvals zeroes 11,11; $o = $rng->ran_gaussian_var($sigma_pdl);
+
+
+ok(1,'ran_gaussian_var() method');
+
+# ran_additive_gaussian() function Test:
+$rng->ran_additive_gaussian(1,$image);
+
+ok(1,'ran_additive_gaussian() method');
+
+# ran_additive_poisson() function Test:
+$rng->ran_additive_poisson(1,$image);
+
+ok(1,'ran_additive_poisson() method');
+
+# ran_feed_poisson() function Test:
+$rng->ran_feed_poisson($image);
+
+ok(1,'ran_feed_poisson() method');
+
+# ran_bivariate_gaussian() function Test:
+$o = $rng->ran_bivariate_gaussian(1,2,0.5,1000);
+
+ok(1,'ran_bivariate_gaussian() method');
+
+# ran_dir() function Test:
+$o = $rng->ran_dir($ndim,12);
+
+ok(1,'ran_dir() method');
+
+# ran_discrete_preproc() function Test:
+$prob = pdl [0.1,0.3,0.6];
+
+$discrete_dist_handle = $rng->ran_discrete_preproc($prob);
+
+$o = $rng->ran_discrete($discrete_dist_handle,100);
+
+ok(1,'ran_discrete_preproc() method');
+
+# ran_discrete() function Test:
+$prob = pdl [0.1,0.3,0.6];
+
+$discrete_dist_handle = $rng->ran_discrete_preproc($prob);
+
+$o = $rng->ran_discrete($discrete_dist_handle,100);
+
+ok(1,'ran_discrete() method');
+
diff --git a/t/gsl_sf.t b/t/gsl_sf.t
new file mode 100644
index 0000000..b540715
--- /dev/null
+++ b/t/gsl_sf.t
@@ -0,0 +1,35 @@
+
+
+# Test Script for the PDL interface to the GSL library
+# This tests only that the interface is working, i.e. that the
+# functions can be called. The actual return values are not
+# checked.
+# The GSL library already has a extensive test suite, and we
+# do not want to duplicate that effort here.
+
+use PDL::LiteF;
+use Test::More;
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_GSL} ) {
+ eval " use PDL::GSLSF::BESSEL; ";
+ unless ($@) {
+ plan tests => 1;
+ } else {
+ plan skip_all => "PDL::GSLSF::BESSEL not installed.";
+ }
+ } else {
+ plan skip_all => "PDL::GSLSF::BESSEL not compiled.";
+ }
+}
+
+$arg = 5.0;
+$expected = -0.17759677131433830434739701;
+
+($y,$err) = gsl_sf_bessel_Jn $arg, 0;
+
+print "got $y +- $err\n";
+
+ok abs($y-$expected) < 1e-6;
diff --git a/t/hdf_sd.t b/t/hdf_sd.t
new file mode 100644
index 0000000..e5e86fd
--- /dev/null
+++ b/t/hdf_sd.t
@@ -0,0 +1,356 @@
+#!/usr/bin/perl -w
+#
+# t/hdf_sd.t
+#
+# Tests the SD interface to the HDF library.
+#
+# Judd Taylor, Orbital Systems, Ltd.
+# 29 March 2006
+#
+use strict;
+use PDL;
+use Test::More;
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_HDF} )
+ {
+ eval( " use PDL::IO::HDF; " );
+ if( $@ )
+ {
+ plan skip_all => "PDL::IO::HDF module compiled, but not available.";
+ }
+ else
+ {
+ plan tests => 36;
+ }
+ }
+ else
+ {
+ plan skip_all => "PDL::IO::HDF module not compiled.";
+ }
+}
+
+use ExtUtils::testlib;
+
+sub tapprox
+{
+ my $a = shift;
+ my $b = shift;
+ my $d = abs($a - $b);
+ #ok( all($d < 1.0e-5) );
+ return all($d < 1.0e-5);
+}
+
+use PDL::Config;
+my $tmpdir = $PDL::Config{TEMPDIR};
+
+my $testfile = "$tmpdir/sdtest.hdf";
+
+use PDL::IO::HDF::SD;
+
+### Creating and writing to a HDF file
+
+#Create an HDF file
+my $SDobj = PDL::IO::HDF::SD->new( "-$testfile" );
+
+#Define some data
+my $data = sequence(short, 500, 5);
+my $square_data = sequence(short, 50, 50);
+
+# TEST 1:
+#Put data in file as 'myData' dataset
+#with the names of dimensions ('dim1' and 'dim2')
+ok( $SDobj->SDput("myData", $data , ['dim1','dim2']), 'SDput()' );
+
+# TEST 2:
+#Put some local attributs in 'myData'
+#Set the fill value as 0
+ok( $SDobj->SDsetfillvalue("myData", 0), 'SDsetfillvalue()' );
+
+# TEST 3:
+#Set the valid range from 0 to 2000
+ok( $SDobj->SDsetrange("myData", [0, 2000]), 'SDsetrange()' );
+
+# TEST 4:
+#Set the default calibration for 'myData' (scale factor = 1, other = 0)
+ok( $SDobj->SDsetcal("myData"), 'SDsetcal()' );
+
+# TEST 5:
+#Set a global text attribut
+ok( $SDobj->SDsettextattr('This is a global text test!!', "myGText" ), 'SDsettextattr() (global)' );
+
+# TEST 6:
+#Set a local text attribut for 'myData'
+ok( $SDobj->SDsettextattr('This is a local text testl!!', "myLText", "myData" ), 'SDsettextattr() (local)' );
+
+# TEST 7:
+#Set a global value attribut (you can put all values you want)
+ok( $SDobj->SDsetvalueattr( PDL::short( 20 ), "myGValue"), 'SDSetvalueattr() (global)' );
+
+# TEST 8:
+#Set a local value attribut (you can put all values you want)
+ok( $SDobj->SDsetvalueattr( PDL::long( [20, 15, 36] ), "myLValues", "myData" ), 'SDSetvalueattr() (local)' );
+
+# TEST 9:
+#Put square_data in file as 'mySquareData' dataset
+#with the names of dimensions ('square_dim' and 'square_dim')
+ok( $SDobj->SDput("mySquareData", $square_data , ['square_dim','square_dim']), 'SDput()' );
+
+#Close the file
+$SDobj->close;
+
+# TEST 10:
+# Test Hishdf:
+ok( PDL::IO::HDF::SD::Hishdf( $testfile ), 'Hishdf()' );
+
+### Reading from a HDF file
+
+#Open an HDF file in read only mode
+my $SDobj2 = PDL::IO::HDF::SD->new( $testfile );
+
+# TEST 11:
+#Get a list of all datasets
+my @dataset_list = $SDobj2->SDgetvariablenames();
+ok( $#dataset_list+1, 'SDgetvariablenames()' );
+
+# TEST 12:
+#Get a list of all global attributes name
+my @globattr_list = $SDobj2->SDgetattributenames();
+ok( $#globattr_list+1, 'SDgetattributenames() (global)' );
+
+# TEST 13:
+#Get a list of local attributes name for a dataset
+my @locattr_list = $SDobj2->SDgetattributenames( "myData" );
+#print "\@locattr_list = " . join(", ", @locattr_list ) . "\n";
+ok( $#locattr_list+1, 'SDgetattributenames() (local)' );
+
+# TEST 14:
+#Get the value of local attribute for a dataset
+my $value = $SDobj2->SDgetattribute( "myLText", "myData" );
+ok( defined($value), 'SDgetattribute() (local)' );
+
+# TEST 15:
+#Get the all dataset 'myData'
+$data = $SDobj2->SDget("myData");
+ok( $data->nelem() > 0, 'SDget()' );
+#print "info : ".$data->info."\n";
+
+# TEST 16:
+#Get dimension name of dataset 'myData'
+my @dim = $SDobj2->SDgetdimnames("myData");
+ok( ($dim[0] eq "dim1") && ($dim[1] eq "dim2") , 'SDgetdimnames()' );
+
+# TEST 17:
+#Get dimension size of dataset 'myData'
+my @dim_square = $SDobj2->SDgetdimsize("myData");
+ok( ($dim_square[0] == 5) && ($dim_square[1] == 500), 'SDgetdimsize()' );
+
+# TEST 18:
+#Get dimension name of dataset 'mySquareData'
+ at dim_square = $SDobj2->SDgetdimnames("mySquareData");
+ok( ($dim_square[0] eq "square_dim") && ($dim_square[1] eq "square_dim"), 'SDgetdimnames()' );
+
+# TEST 19:
+# Get dimension size of dataset 'mySquareData'
+ at dim_square = $SDobj2->SDgetdimsize("mySquareData");
+ok( ($dim_square[0] == 50) && ($dim_square[1] == 50), 'SDgetdimsize()' );
+
+# TEST 20:
+#Get the all dataset 'mySquareData'
+my $square_data_get = $SDobj2->SDget("mySquareData");
+ok( $square_data_get->nelem() > 0, 'SDget()' );
+#print "info : ".$data->info."\n";
+
+
+# TEST 21:
+#Apply the scale factor of 'myData'
+my $res = $SDobj2->SDgetscalefactor("myData");
+ok( defined($res), 'SDgetscalefactor()' );
+
+# TEST 22:
+#Get the fill value
+#The fill value corresponding to the BAD value in pdl
+$res = $SDobj2->SDgetfillvalue("myData");
+ok( defined($res), 'SDgetfillvalue()' );
+
+# TEST 23:
+#Get the valid range of datas
+my @range = $SDobj2->SDgetrange("myData");
+ok( $#range+1, 'SDgetrange()' );
+
+#print Data::Dumper->Dump([$SDobj2],[qw(SDobj2)]);
+
+#Now you can do what you want with your data
+$SDobj2->close;
+
+#
+# These are from the old sdcompress.t test file:
+#
+undef($data);
+my $HDFobj = PDL::IO::HDF::SD->new("-$testfile");
+
+# TEST 24:
+#Define some data
+$data = ones( short, 5000, 5);
+#Put data in file as 'myData' dataset
+#with the names of dimensions ('dim1' and 'dim2')
+ok( $HDFobj->SDput("myData", $data , ['dim1','dim2']), 'SDput()' );
+
+# TEST 25:
+$HDFobj->SDput("myData", $data , ['dim1','dim2']);
+$data = $HDFobj->SDget("myData");
+ok( $data->nelem(), 'SDget()' );
+
+$HDFobj->close();
+
+#
+# These tests are from the old 11sdchunk.t test file:
+#
+my $hdf = PDL::IO::HDF::SD->new( "-$testfile" );
+
+# TEST 26:
+# Make sure chunking is on by default:
+ok( $hdf->Chunking(), 'Chunking()' );
+
+# Turn off chunking:
+$hdf->Chunking(0);
+
+# TEST 27:
+# Make sure it's really off:
+ok( !$hdf->Chunking(), 'Chunking(0)' );
+
+# Write out a normal dataset:
+my $dataset = sequence( byte, 10, 10 );
+$res = $hdf->SDput( "NO_CHUNK", $dataset );
+
+# TEST 28:
+# Make sure we can write unchunked SDs:
+ok( $res, 'SDput() (unchunked)' );
+
+$hdf->close();
+undef($hdf);
+
+# TEST 29 & 30:
+# Make sure we can read it properly:
+$hdf = PDL::IO::HDF::SD->new( $testfile );
+
+my $dataset_test = $hdf->SDget( "NO_CHUNK" );
+my $good = ($dataset_test->nelem() > 0) ? 1 : 0;
+ok( $good, 'SDget() (unchunked)' );
+my $do_skip = $good ? '' : 'Skip if failed previous test!';
+SKIP: {
+ skip( "Previous test failed!", 1 ) if $do_skip;
+ ok( tapprox( $dataset, $dataset_test ), 'comparing datasets written out and read in (unchunked)' );
+}
+
+$hdf->close();
+undef($hdf);
+unlink( $testfile );
+
+# Reopen to write out the chunked portion:
+$hdf = PDL::IO::HDF::SD->new( "-$testfile" );
+
+my $dataset2d = sequence( long, 200, 200 );
+
+# TEST 31:
+# Make sure the chunked write works:
+$res = $hdf->SDput( "CHUNK_2D", $dataset2d );
+ok( $res, 'SDput() (chunked, 2D)' );
+
+# TEST 32:
+# Make sure it works with more than 2 dims:
+my $dataset3d = sequence( long, 200, 200, 10 );
+$res = $hdf->SDput( "CHUNK_3D", $dataset3d );
+ok( $res, 'SDput() (chunked, 3D)');
+
+$hdf->close();
+undef($hdf);
+
+# Verify the datasets we just wrote:
+$hdf = PDL::IO::HDF::SD->new( $testfile );
+
+# TEST 33 & 34:
+my $dataset2d_test = $hdf->SDget( "CHUNK_2D" );
+$good = $dataset2d_test->nelem() > 0;
+ok( $good, 'SDget() (chunked, 2D)' );
+$do_skip = $good ? '' : 'Skip if failed previous test!';
+SKIP: {
+ skip( "Previous test failed!", 1 ) if $do_skip;
+ ok( tapprox( $dataset2d, $dataset2d_test ), 'comparing datasets written out and read in (chunked, 2D)' );
+}
+
+# TEST 35 & 36:
+my $dataset3d_test = $hdf->SDget( "CHUNK_3D" );
+$good = $dataset3d_test->nelem() > 0;
+ok( $good, 'SDget() (chunked, 3D)' );
+$do_skip = $good ? '' : 'Skip if failed previous test!';
+SKIP: {
+ skip( "Previous test failed!", 1 ) if $do_skip;
+ ok( tapprox( $dataset3d, $dataset3d_test ), 'comparing datasets written out and read in (chunked, 3D)' );
+}
+
+$hdf->close();
+undef($hdf);
+
+#
+# These tests are from the old 07hdfdump.t test file:
+#
+my $H = PDL::IO::HDF->new( $testfile );
+
+print ">>Global attributes :\n";
+foreach my $attr ( $$H{SD}->SDgetattributenames() )
+{
+ my $curattr = $$H{SD}->SDgetattribute( $attr );
+ print "\t$attr = \n";
+ foreach ( split("\n", $curattr) )
+ { print "\t\t$_\n"; }
+}
+
+print ">>Datasets :\n";
+foreach my $dataset ( $$H{SD}->SDgetvariablenames() )
+{
+ print "\t$dataset\n";
+ print "\t\tdimensions : \n";
+ my @dimname = $$H{SD}->SDgetdimname( $dataset );
+ my @dimsize = $$H{SD}->SDgetdimsize( $dataset );
+ my @dimsizeU = $$H{SD}->SDgetunlimiteddimsize( $dataset );
+ foreach ( my $i = 0; $i <= $#dimsize; $i++ )
+ {
+ print "\t\t\t$dataset:$dimname[$i] = "
+ . ( (!$dimsize[$i]) ? "$dimsizeU[$i] (UNLIMITED)\n" : "$dimsize[$i]\n");
+ }
+
+ print "\t\tlocal attributes : \n";
+ foreach my $locattr ( $$H{SD}->SDgetattributenames( $dataset ) )
+ {
+ my $curattr = $$H{SD}->SDgetattribute( $locattr, $dataset );
+ print "\t\t\t$dataset:$locattr = $curattr\n";
+ }
+}
+
+print ">>VData :\n";
+foreach my $Vname ( $$H{VS}->VSgetnames() )
+{
+ if( !$$H{VS}->VSisattr($Vname) )
+ {
+ print "\t$Vname\n";
+ foreach my $Vfieldname ( $$H{VS}->VSgetfieldnames( $Vname ) )
+ {
+ my $val = $$H{VS}->VSread( $Vname, $Vfieldname);
+ print "\t\t$Vfieldname "
+ . ( ( $val->nelem > 10 ) ? ": too many values!\n" : "= $val\n" );
+
+ print "**** $val\n"
+ if( $Vfieldname eq 'attach_flag' );
+ }
+ }
+}
+
+$H->close();
+
+# Remove the testfile:
+unlink( $testfile );
+
+exit(0);
diff --git a/t/hdf_vdata.t b/t/hdf_vdata.t
new file mode 100644
index 0000000..40d2ceb
--- /dev/null
+++ b/t/hdf_vdata.t
@@ -0,0 +1,180 @@
+#!/usr/bin/perl -w
+#
+# t/hdf_vdata.t
+#
+# Tests Vdata features of the HDF library.
+#
+# 29 March 2006
+# Judd Taylor, USF IMaRS
+#
+use strict;
+use PDL;
+use Test::More;
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_HDF} )
+ {
+ eval( " use PDL::IO::HDF; " );
+ if( $@ )
+ {
+ plan skip_all => "PDL::IO::HDF module compiled, but not available.";
+ }
+ else
+ {
+ plan tests => 21;
+ }
+ }
+ else
+ {
+ plan skip_all => "PDL::IO::HDF module not compiled.";
+ }
+}
+
+sub tapprox
+{
+ my $a = shift;
+ my $b = shift;
+ my $d = abs($a - $b);
+ #ok( all($d < 1.0e-5) );
+ return all($d < 1.0e-5);
+}
+
+use PDL::IO::HDF;
+use PDL::IO::HDF::VS;
+
+# Vdata test suite
+use PDL::Config;
+my $tmpdir = $PDL::Config{TEMPDIR};
+
+my $testfile = "$tmpdir/vdata.hdf";
+
+# creating
+
+# TEST 1:
+my $Hid = PDL::IO::HDF::VS::_Hopen( $testfile, PDL::IO::HDF->DFACC_CREATE, 2);
+ok( $Hid != PDL::IO::HDF->FAIL );
+
+PDL::IO::HDF::VS::_Vstart( $Hid );
+my $vdata_id = PDL::IO::HDF::VS::_VSattach( $Hid, -1, "w" );
+PDL::IO::HDF::VS::_VSsetname( $vdata_id, 'vdata_name' );
+PDL::IO::HDF::VS::_VSsetclass( $vdata_id, 'vdata_class' );
+
+# TEST 2:
+my $vdata_ref = PDL::IO::HDF::VS::_VSgetid( $Hid, -1 );
+ok( $vdata_ref != PDL::IO::HDF->FAIL );
+
+# TEST 3:
+my $name = "";
+PDL::IO::HDF::VS::_VSgetname( $vdata_id, $name );
+ok( $name eq "vdata_name" );
+
+# TEST 4:
+my $class = "";
+PDL::IO::HDF::VS::_VSgetclass( $vdata_id, $class );
+ok( $class eq "vdata_class" );
+
+my $data = PDL::float sequence(10);
+my $HDFtype = $PDL::IO::HDF::SDtypeTMAP->{$data->get_datatype()};
+
+# TEST 5:
+ok( PDL::IO::HDF::VS::_VSfdefine( $vdata_id, 'PX', $HDFtype, 1) );
+
+# TEST 6:
+ok( PDL::IO::HDF::VS::_VSsetfields( $vdata_id, 'PX') );
+
+# TEST 7:
+ok( PDL::IO::HDF::VS::_VSwrite( $vdata_id, $data, 10, PDL::IO::HDF->FULL_INTERLACE ) );
+
+PDL::IO::HDF::VS::_VSdetach( $vdata_id );
+PDL::IO::HDF::VS::_Vend( $Hid );
+
+# TEST 8:
+ok( PDL::IO::HDF::VS::_Hclose( $Hid ) );
+
+# TEST 9:
+undef( $Hid );
+$Hid = PDL::IO::HDF::VS::_Hopen( $testfile, PDL::IO::HDF->DFACC_READ, 2 );
+ok( $Hid != PDL::IO::HDF->FAIL );
+
+PDL::IO::HDF::VS::_Vstart( $Hid );
+
+# TEST 10:
+$vdata_ref = PDL::IO::HDF::VS::_VSfind( $Hid, 'vdata_name' );
+ok( $vdata_ref != PDL::IO::HDF->FAIL );
+
+# TEST 11:
+$vdata_id = PDL::IO::HDF::VS::_VSattach( $Hid, $vdata_ref, "r" );
+ok( $vdata_id != PDL::IO::HDF->FAIL );
+
+# TEST 12:
+my $vdata_size = 0;
+my $n_records = 0;
+my $interlace = 0;
+my $fields = "";
+my $vdata_name = "";
+ok( PDL::IO::HDF::VS::_VSinquire( $vdata_id, $n_records, $interlace, $fields, $vdata_size, $vdata_name) );
+
+# TEST 13:
+my @tfields = split(",",$fields);
+my $data_type = PDL::IO::HDF::VS::_VFfieldtype( $vdata_id, 0 );
+$data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, 10 );
+ok( PDL::IO::HDF::VS::_VSread( $vdata_id, $data, $n_records, $interlace ) );
+
+# TEST 14:
+my $expected_data = sequence(10);
+ok( sub { tapprox( $data, $expected_data ) } );
+
+PDL::IO::HDF::VS::_VSdetach( $vdata_id );
+PDL::IO::HDF::VS::_Vend( $Hid );
+
+# TEST 15:
+ok( PDL::IO::HDF::VS::_Hclose( $Hid ) );
+
+# TEST 16:
+my $vdataOBJ = PDL::IO::HDF::VS->new( $testfile );
+ok( defined( $vdataOBJ ) );
+
+# TEST 17:
+my @vnames = $vdataOBJ->VSgetnames();
+ok( scalar( @vnames ) > 0 );
+
+foreach my $name ( @vnames )
+{
+ # TEST 18:
+ my @fields = $vdataOBJ->VSgetfieldnames( $name );
+ ok( scalar( @fields ) > 0 );
+
+ foreach my $field ( @fields )
+ {
+ # TEST 19:
+ my $data = $vdataOBJ->VSread( $name, $field );
+ ok( defined( $data ) );
+ }
+}
+
+# TEST 20:
+ok( $vdataOBJ->close() );
+undef( $vdataOBJ );
+
+# TEST 21:
+$vdataOBJ=PDL::IO::HDF::VS->new( $testfile );
+foreach my $name ( $vdataOBJ->VSgetnames() )
+{
+ print "name: $name\n";
+ foreach my $field ( $vdataOBJ->VSgetfieldsnames( $name ) )
+ {
+ print " $field\n";
+ my $data = $vdataOBJ->VSread( $name, $field );
+ print " " . $data->info() . "\n";
+ print " $data\n";
+ }
+}
+ok( 1 );
+
+# Remove the testfile:
+unlink( $testfile );
+
+exit(0);
+
diff --git a/t/hdf_vgroup.t b/t/hdf_vgroup.t
new file mode 100644
index 0000000..84a5bbf
--- /dev/null
+++ b/t/hdf_vgroup.t
@@ -0,0 +1,107 @@
+#!/usr/bin/perl -w
+#
+# t/hdf_vgroup.t
+#
+# Tests Vgroup features of the HDF library.
+#
+# 29 March 2006
+# Judd Taylor, USF IMaRS
+#
+use strict;
+use PDL;
+use Test::More;
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_HDF} )
+ {
+ eval( " use PDL::IO::HDF; " );
+ if( $@ )
+ {
+ plan skip_all => "PDL::IO::HDF module compiled, but not available.";
+ }
+ else
+ {
+ plan tests => 10;
+ }
+ }
+ else
+ {
+ plan skip_all => "PDL::IO::HDF module not compiled.";
+ }
+}
+
+use PDL::IO::HDF::VS;
+
+use PDL::Config;
+my $tmpdir = $PDL::Config{TEMPDIR};
+
+my $testfile = "$tmpdir/vgroup.hdf";
+
+# Vgroup test suite
+
+# TEST 1:
+my $Hid = PDL::IO::HDF::VS::_Hopen( $testfile, PDL::IO::HDF->DFACC_CREATE, 2 );
+ok( $Hid != -1 );
+
+PDL::IO::HDF::VS::_Vstart( $Hid );
+
+my $vgroup_id = PDL::IO::HDF::VS::_Vattach( $Hid, -1, "w" );
+PDL::IO::HDF::VS::_Vsetname( $vgroup_id, 'vgroup_name' );
+PDL::IO::HDF::VS::_Vsetclass( $vgroup_id, 'vgroup_class' );
+
+# TEST 2:
+my $vgroup_ref = PDL::IO::HDF::VS::_Vgetid( $Hid, -1 );
+ok( $vgroup_ref != PDL::IO::HDF->FAIL );
+
+# TEST 3:
+my $name = "";
+PDL::IO::HDF::VS::_Vgetname( $vgroup_id, $name);
+ok( $name eq "vgroup_name" );
+
+# TEST 4:
+my $class = "";
+PDL::IO::HDF::VS::_Vgetclass( $vgroup_id, $class);
+ok( $class eq "vgroup_class" );
+
+PDL::IO::HDF::VS::_Vdetach( $vgroup_id );
+
+PDL::IO::HDF::VS::_Vend( $Hid );
+
+# TEST 5:
+ok( PDL::IO::HDF::VS::_Hclose( $Hid ) );
+
+# TEST 6:
+my $vOBJ = PDL::IO::HDF::VS->new( "+$testfile" );
+ok( defined($vOBJ) );
+
+# TEST 7:
+ok( $vOBJ->Vcreate('10vgroup','vgroup_class2','vgroup_name') );
+
+# TEST 8:
+my @mains = $vOBJ->Vgetmains();
+ok( scalar( @mains ) > 0 );
+
+foreach my $Vmain ( @mains )
+{
+ # TEST 9:
+ my @Vchildren = $vOBJ->Vgetchildren( $Vmain );
+ ok( scalar( @Vchildren ) > 0 );
+
+ if( defined $Vchildren[0] )
+ {
+ foreach ( @Vchildren )
+ { print "\tchild : $_\n"; }
+ }
+}
+
+# TEST 10:
+ok( $vOBJ->close() );
+
+# Remove the test file:
+# NOTE: This is needed by test 10
+unlink( $testfile );
+
+exit(0);
+
diff --git a/t/hdrs.t b/t/hdrs.t
new file mode 100644
index 0000000..893edcf
--- /dev/null
+++ b/t/hdrs.t
@@ -0,0 +1,56 @@
+use PDL::LiteF;
+
+$|=1;
+
+# PDL::Core::set_debugging(1);
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+sub hdrcmp {
+ my ($ah,$bh) = map {$_->gethdr} @_;
+# Copy-by-reference test is obsolete; check contents instead (CED 12-Apr-2003)
+# return $ah==$bh
+ my %ahh = %{$ah};
+ my (@ahhkeys) = sort keys %ahh;
+ my %bhh = %{$bh};
+ my (@bhhkeys) = sort keys %bhh;
+ return join("", at bhh{@bhhkeys}) eq join("", at ahh{@ahhkeys});
+}
+
+print "1..9\n";
+
+$a = zeroes(20);
+$a->hdrcpy(1);
+$a->dump;
+$a->sethdr( {Field1=>'arg1',
+ Field2=>'arg2'});
+print "a: ",$a->gethdr(),"\n";
+ok(1,$a->hdrcpy);
+
+$b = $a+1;
+print "b: ",$b->gethdr(),"\n";
+ok(2, defined($b->gethdr));
+ok(3,hdrcmp($a,$b));
+
+$b = ones(20) + $a;
+print "b: ",$b->gethdr(),"\n";
+ok(4, defined($b->gethdr));
+ok(5,hdrcmp($a,$b));
+
+$c = $a->slice('0:5');
+print "c: ",$c->gethdr(),"\n";
+ok(6,hdrcmp($a,$c));
+
+$d = $a->copy;
+print "d: ",$d->gethdr(),"\n";
+ok(7,hdrcmp($a,$d));
+
+$a->hdrcpy(0);
+ok(8,defined($a->slice('3')->hdr) && !( keys (%{$a->slice('3')->hdr})));
+ok(9,!defined($a->slice('3')->gethdr));
diff --git a/t/hist.t b/t/hist.t
new file mode 100644
index 0000000..a209500
--- /dev/null
+++ b/t/hist.t
@@ -0,0 +1,50 @@
+
+# Test hist() and related functions
+
+use Test;
+
+plan tests => 4;
+
+use PDL::LiteF;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub tapprox {
+ my($a,$b) = @_;
+ $c = abs($a-$b);
+ $d = max($c);
+ $d < 0.01;
+}
+
+$x = pdl [15.4,15.8,16.01,16.9,16.1,15.2,15.4,16.2,15.4,16.2,16.4];
+($hx,$h)= hist ($x,15,17,0.1);
+
+ok( tapprox($hx, pdl(qw/15.05 15.15 15.25 15.35 15.45 15.55 15.65
+ 15.75 15.85 15.95 16.05 16.15 16.25 16.35 16.45 16.55 16.65
+ 16.75 16.85 16.95/)) );
+
+ok( tapprox($h, pdl(qw/0 1 0 0 3 0 0 0 1 0 1 3 0 1 0 0 0 0 1 0/)) );
+
+
+$x = pdl( qw{ 13 10 13 10 9 13 9 12 11 10 10 13 7 6 8 10 11 7 12 9
+ 11 11 12 6 12 7} );
+
+$wt = pdl( qw{ -7.4733817 -3.0945993 -1.7320649 -0.92823577 -0.34618392
+ -1.3326057 -1.3267382 -0.032047153 0.067103333 -0.11446796
+ -0.72841944 0.95928255 1.4888114 0.17143622 0.14107419
+ -1.6368404 0.72917 -2.0766962 -0.66708236 -0.52959271
+ 1.1551274 0.079184 1.4068289 0.038689811 0.87947996
+ -0.88373274 } );
+
+( $hx, $h ) = whist ($x, $wt, 0, 20, 1 );
+
+ok( tapprox($hx,
+ pdl(qw{ 0.5 1.5 2.5 3.5 4.5 5.5 6.5 7.5 8.5 9.5 10.5
+ 11.5 12.5 13.5 14.5 15.5 16.5 17.5 18.5 19.5 }) ) );
+
+ok( tapprox($h,
+ pdl(qw{ 0 0 0 0 0 0 0.21012603 -1.4716175 0.14107419 -2.2025149
+ -6.5025629 2.0305847 1.5871794 -9.5787698 0 0 0 0 0 0 }) ));
+
+## end of tests
+
diff --git a/t/howbig.t b/t/howbig.t
new file mode 100644
index 0000000..12050af
--- /dev/null
+++ b/t/howbig.t
@@ -0,0 +1,21 @@
+# Test datatype sizes in bytes are correct
+
+use PDL::LiteF;
+use PDL::Core ':Internal'; # For howbig()
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+print "1..6\n";
+
+ok(1, howbig(byte(42)->get_datatype)==1);
+ok(2, howbig(short(42)->get_datatype)==2);
+ok(3, howbig(ushort(42)->get_datatype)==2);
+ok(4, howbig(long(42)->get_datatype)==4);
+ok(5, howbig(float(42)->get_datatype)==4);
+ok(6, howbig(double(42)->get_datatype)==8);
+
diff --git a/t/ica.t b/t/ica.t
new file mode 100644
index 0000000..e2127a7
--- /dev/null
+++ b/t/ica.t
@@ -0,0 +1,126 @@
+
+use PDL::LiteF;
+
+BEGIN {
+ eval " use PDL::Slatec; ";
+ $loaded = ($@ ? 0 : 1);
+ eval " use PDL::ICA; ";
+ $loaded++ unless $@;
+}
+
+# use PDL::Graphics::PG;
+# dev "/XSERVE",2,2;
+
+$|=1;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+use Carp;
+
+$SIG{__DIE__} = sub {print Carp::longmess(@_); die FOO;};
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+# sub tapprox {
+# my($a,$b,$c,$d) = @_;
+# $c = abs($a-$b);
+# $d = max($c);
+# # print "APR: $a,$b,$c,$d;\n";
+# $d < 0.001;
+# }
+
+print "1..1\n";
+unless ($loaded) {
+ #print STDERR "PDL::Slatec not installed. Skipping all tests.\n";
+ for (1..1) {
+ print "ok $_ # Skipped: PDL::Slatec not available\n";
+ }
+ exit;
+}
+ok(1,$loaded);
+
+#DEFERRED
+
+if(0) {
+
+# Generate data: oblique lattice
+
+$pars = pdl 2,3,4;
+$rot = PDL::LinICA::_cayleygen({NVars=>3},$pars);
+
+print $rot;
+
+$inv = inv($rot);
+print $inv;
+
+if(0) {
+
+if(0) {
+$data = long zeroes(2,36);
+axisvalues($data->xchg(0,1));
+($xx = $data->slice('(0)')) %= 6;
+($xx = $data->slice('(1)')) /= 6;
+print $data;
+$data = float $data;
+} else {
+$data = long zeroes(2,9);
+axisvalues($data->xchg(0,1));
+($xx = $data->slice('(0)')) %= 3;
+($xx = $data->slice('(1)')) /= 3;
+print $data;
+$data = float $data;
+}
+
+$data *= 0.1;
+($xx = $data->slice('(0)')) *= 2;
+($xx = $data->slice('(0)')) += $data->slice('(1)') * 0.3;
+
+$ica = new PDL::LinICA($data,4,{Accuracy => 0.001});
+
+$newdata = $ica->get_newdata();
+
+$pcadata = $ica->transform_pca($ica->{Data});
+
+sub pdata {
+ my($newdata) = @_;
+ print $newdata;
+
+# points $newdata->slice('(0)'),
+# $newdata->slice('(1)');
+}
+
+print "PRINTOUT\n";
+
+pdata($data);
+pdata($pcadata);
+pdata($newdata);
+
+# Then, try some similar 3D lattice data.
+}
+
+print "NEWLATT\n";
+
+$data0 = zeroes(3,4,4,4);
+axisvalues($data0->slice('(0)'));
+axisvalues($data0->slice('(1)')->xchg(1,0));
+axisvalues($data0->slice('(2)')->xchg(2,0));
+
+$data = $data0->xchg(0,3)->clump(3)->xchg(0,1);
+
+print("DATA: $data\n");
+
+$ica = new PDL::LinICA($data,4,{Accuracy => 0.001});
+
+$newdata = $ica->get_newdata();
+
+print $newdata;
+
+# points $newdata->slice('(0)'),$newdata->slice('(1)');
+
+}
+
diff --git a/t/image2d.t b/t/image2d.t
new file mode 100644
index 0000000..d2881ff
--- /dev/null
+++ b/t/image2d.t
@@ -0,0 +1,177 @@
+# -*-perl-*-
+#
+
+use Test;
+BEGIN {
+ plan tests => 26;
+}
+
+use PDL;
+use PDL::Image2D;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+use strict;
+
+sub tapprox {
+ my $a = shift;
+ my $b = shift;
+ my $d = abs($a - $b);
+ ok( all($d < 1.0e-5) );
+}
+
+# Right answer
+
+my $ans = pdl(
+ [ 3, 9, 15, 21, 27, 33, 39, 45, 51, 27],
+ [ 3, 9, 15, 21, 27, 33, 39, 45, 51, 27],
+ [ 3, 9, 15, 21, 27, 33, 39, 45, 51, 27]
+);
+
+# conv2d
+my $a = xvals zeroes 10,3;
+my $b = pdl [1,2],[2,1];
+my $c = conv2d ($a, $b);
+tapprox( $c, $ans ); # 1
+
+# conv2d
+$a=zeroes(3,3);
+$a->set(1,1,1);
+$b = sequence(3,3);
+tapprox( conv2d($a,$b), $b ); # 2
+
+# conv2d: boundary => reflect
+$a=ones(3,3);
+$ans = pdl ([12,18,24],[30,36,42],[48,54,60]);
+tapprox( conv2d($b,$a,{Boundary => 'Reflect'}), $ans ); #3
+
+# conv2d: boundary => replicate
+$ans = pdl ([12,18,24],[30,36,42],[48,54,60]);
+tapprox( conv2d($b,$a,{Boundary => 'Replicate'}), $ans ); #4
+
+# conv2d: boundary => truncate
+$ans = pdl ([8,15,12],[21,36,27],[20,33,24]);
+tapprox( conv2d($b,$a,{Boundary => 'Truncate'}), $ans ); #5
+
+# max2d_ind
+$a = 100 / (1.0 + rvals(5,5));
+$a = $a * ( $a < 90 );
+my @ans = $a->max2d_ind();
+print "max2d_ind: " . join( ',', @ans ) . "\n";
+ok( ($ans[0] == 50) & ($ans[1] == 1) & ($ans[2] == 2) );
+
+# centroid2d
+$a = 100.0 / rvals( 20, 20, { Centre => [ 8, 12.5 ] } );
+$a = $a * ( $a >= 9 );
+ at ans = $a->centroid2d( 10, 10, 20 );
+tapprox( $ans[0], 8.432946 ); # numbers calculated by an independent program
+tapprox( $ans[1], 11.756724 );
+
+# med2d
+my $t;
+$a = zeroes(5,5);
+$t = $a->slice("1:3,1:3");
+$t .= ones(3,3);
+$b = sequence(3,3);
+$ans = pdl ( [0,0,0,0,0],[0,0,1,0,0],[0,1,4,2,0],[0,0,4,0,0],[0,0,0,0,0]);
+tapprox( med2d($a,$b), $ans );
+
+# patch2d
+$a = ones(5,5);
+my $mask = zeroes(5,5);
+$mask->set(2,2,1);
+tapprox( patch2d($a,$mask), $a ); # 6
+
+# note:
+# with no bad values, any bad pixel which has no good neighbours
+# has its value copied
+#
+my $m = $mask->slice('1:3,1:3');
+$m .= 1;
+$ans = $a->copy;
+print $a, $mask, patch2d($a,$mask);
+tapprox( patch2d($a,$mask), $ans ); # 7
+
+if ( $PDL::Bad::Status ) {
+ # patchbad2d: bad data
+ $m = $a->slice('1:3,1:3');
+ $m .= $a->badvalue;
+ $a->badflag(1); # should sort out propogation of badflag
+
+ $ans = ones(5,5);
+ $ans->set(2,2,$ans->badvalue);
+ $ans->badflag(1);
+
+ #print $a, patchbad2d($a);
+ tapprox( patchbad2d($a), $ans ); # 8
+
+ # patchbad2d: good data
+ $a = sequence(5,5);
+ #print $a, patchbad2d($a);
+ tapprox( patchbad2d($a), $a ); # 9
+
+ # max2d_ind
+ $a = 100 / (1.0 + rvals(5,5));
+ $a = $a->setbadif( $a > 90 );
+ my @ans = $a->max2d_ind();
+ print "max2d_ind: " . join( ',', @ans ) . "\n";
+ ok( ($ans[0] == 50) & ($ans[1] == 1) & ($ans[2] == 2) );
+
+ # centroid2d
+ $a = 100.0 / rvals( 20, 20, { Centre => [ 8, 12.5 ] } );
+ $a = $a->setbadif( $a < 9 );
+ @ans = $a->centroid2d( 10, 10, 20 );
+ tapprox( $ans[0], 8.432946 ); # numbers should be same as when set < 9 to 0
+ tapprox( $ans[1], 11.756724 );
+
+} else {
+ my $msg = "PDL::Bad support not available.";
+ for (0..4) { skip($msg,1,1) } # skip 5 tests
+}
+# box2d bug test
+my $one = random(10,10);
+my $box = cat $one,$one,$one;
+
+my $bav = $one->box2d(3,3,0);
+my $boxav = $box->box2d(3,3,0);
+
+# all 2D averages should be the same
+tapprox($bav->sum,$boxav->clump(2)->sumover);
+
+# cc8compt & cc4compt
+$a = pdl([0,1,1,0,1],[1,0,1,0,0],[0,0,0,1,0],[1,0,0,0,0],[0,1,0,1,1]);
+ok(cc8compt($a)->max == 4);
+ok(cc4compt($a)->max == 7);
+eval 'ccNcompt($a,5)';
+ok($@ ne '');
+eval 'ccNcompt($a,8)';
+ok($@ eq '');
+
+# pnpoly
+my $px = pdl(0,3,1);
+my $py = pdl(0,1,4);
+my $im = zeros(5,5);
+my $im2 = zeroes(5,5);
+my $x = $im->xvals;
+my $y = $im->yvals;
+my $ps = $px->cat($py)->xchg(0,1);
+my $im_mask = pnpoly($x,$y,$px,$py);
+ok(sum($im_mask) == 5);
+my $inpixels = pdl q[ 1 1 ; 1 2 ; 1 3 ; 2 1 ; 2 2 ];
+ok(sum($inpixels - qsortvec(scalar whichND($im_mask))) == 0);
+
+# Make sure the PDL pnpoly and the PP pnpoly give the same result
+ok(all($im_mask == $im->pnpoly($ps)));
+
+# Trivial test to make sure the polyfills using the pnpoly algorithm are working
+$im .= 0;
+polyfillv($im2,$ps,{'Method'=>'pnpoly'}) .= 22;
+ok(all(polyfill($im,$ps,22,{'Method'=>'pnpoly'}) == $im2));
+
+
+# Trivial test to make sure the polyfills are working
+$im .= 0;
+$im2 .= 0;
+polyfillv($im2,$ps) .= 25;
+polyfill($im,$ps,25);
+ok(all($im == $im2));
diff --git a/t/imagend.t b/t/imagend.t
new file mode 100644
index 0000000..4df245e
--- /dev/null
+++ b/t/imagend.t
@@ -0,0 +1,90 @@
+use PDL;
+use PDL::ImageND;
+use PDL::NiceSlice;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+print "1..7\n";
+
+# Right answer
+
+my $ans = pdl(
+ [ 3, 9, 15, 21, 27, 33, 39, 45, 51, 27],
+ [ 3, 9, 15, 21, 27, 33, 39, 45, 51, 27],
+ [ 3, 9, 15, 21, 27, 33, 39, 45, 51, 27]
+);
+
+my $a = xvals zeroes 10,3;
+
+my $b = pdl [1,2],[2,1];
+
+my $c=convolve ($a, $b);
+
+ok( 1, int(at(sum($c-$ans)))==0 );
+
+
+$a = zeroes(6,6);
+
+my $ta;
+
+($ta = $a(4,:)) .= 1;
+($ta = $a(5,:)) .= 1;
+($ta = $a(1,2)) .= 1;
+($ta = $a(0,4)) .= 1;
+($ta = $a(2,0)) .= 1;
+
+$b = pdl( [-1,0],[0,1] );
+
+
+my $ans_e = pdl(
+ [ 0, 0, 1, -1, 0, 0],
+ [-1, 0, 0, -1, 0, 0],
+ [ 0, 1, 0, -1, 0, 0],
+ [ 0, 0, 0, -1, 0, 0],
+ [ 1, 0, 0, -1, 0, 0],
+ [ 0, 0, 0, -1, 0, 0]
+ );
+$c = convolveND($a,$b,{m=>'d',b=>'e'});
+ok( 2, all( abs($c - $ans_e) < 1e-15 ) );
+
+$c = convolveND($a,$b,{m=>'f',b=>'e'});
+ok( 3, all( abs($c - $ans_e) < 1e-15 ) );
+
+$ans_p = pdl(
+ [ 0, 0, 1, -1, 0, 1],
+ [-1, 0, 0, -1, 0, 1],
+ [ 0, 1, 0, -1, 0, 1],
+ [ 0, 0, 0, -1, 0, 0],
+ [ 1, 0, 0, -1, 0, 1],
+ [ 0, -1, 0, -1, 0, 1]
+ );
+$c = convolveND($a,$b,{m=>'d',b=>'p'});
+ok( 4, all( abs($c - $ans_p) < 1e-15 ) );
+
+$c = convolveND($a,$b,{m=>'f',b=>'p'});
+ok( 5, all( abs($c - $ans_p) < 1e-15 ) );
+
+
+$ans_t = pdl(
+ [ 0, 0, 1, -1, 0, 1],
+ [-1, 0, 0, -1, 0, 1],
+ [ 0, 1, 0, -1, 0, 1],
+ [ 0, 0, 0, -1, 0, 1],
+ [ 1, 0, 0, -1, 0, 1],
+ [ 0, 0, 0, 0, 1, 1]
+ );
+$c = convolveND($a,$b,{m=>'d',b=>'t'});
+ok( 6, all( abs($c - $ans_t) < 1e-15 ) );
+
+$c = convolveND($a,$b,{m=>'f',b=>'t'});
+ok( 7, all( abs($c - $ans_t) < 1e-15 ) );
+
+
+
diff --git a/t/imagergb.t b/t/imagergb.t
new file mode 100644
index 0000000..12e5261
--- /dev/null
+++ b/t/imagergb.t
@@ -0,0 +1,71 @@
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+sub tapprox {
+ my($a,$b,$mdiff) = @_;
+ $mdiff = 0.01 unless defined($mdiff);
+ $c = abs($a-$b);
+ $d = max($c);
+ $d < $mdiff;
+}
+
+sub vars_ipv {
+ PDL::Dbg::vars if $PDL::debug;
+}
+
+sub p {
+ print @_ if $PDL::debug;
+}
+
+use PDL::LiteF;
+use PDL::ImageRGB;
+use PDL::Dbg;
+
+$PDL::debug = 0;
+
+print "1..6\n";
+
+$im = float [1,2,3,4,5];
+
+vars_ipv;
+
+$out = bytescl($im,100);
+ok(1,tapprox($im,bytescl($im,100)));
+ok(2,$out->get_datatype == $PDL::Types::PDL_B);
+$out = bytescl($im,-100);
+ok(3,tapprox(pdl([0,25,50,75,100]),$out));
+
+p "$out\n";
+
+$rgb = double [[1,1,1],[1,0.5,0.7],[0.1,0.2,0.1]];
+$out = rgbtogr($rgb);
+ok(4,tapprox($out,pdl([1,0.67,0.16])));
+ok(5,$out->get_datatype == $PDL::Types::PDL_D);
+
+vars_ipv;
+p $out;
+
+$im = byte [[1,2,3],[0,3,0]];
+$lut = byte [[0,0,0],
+ [10,1,10],
+ [2,20,20],
+ [30,30,3]
+ ];
+# do the interlacing the lengthy way
+$interl = zeroes(byte,3,$im->dims);
+for $i (0..($im->dims)[0]-1) {
+ for $j (0..($im->dims)[1]-1) {
+ $pos = $im->at($i,$j);
+ ($tmp = $interl->slice(":,($i),($j)")) .= $lut->slice(":,($pos)");
+ }
+}
+$tmp = 0; # -w shut up!
+
+$out = interlrgb($im,$lut);
+vars_ipv;
+p $out;
+ok(6,tapprox($out,$interl));
diff --git a/t/inline-comment-test.t b/t/inline-comment-test.t
new file mode 100644
index 0000000..6ceb690
--- /dev/null
+++ b/t/inline-comment-test.t
@@ -0,0 +1,110 @@
+# This test checks that multiline comments in user code does not cause
+# compilation errors. Strictly speaking, this is not really an Inline test,
+# but Inline happens to provide the simplest framework for performing these
+# tests. :-)
+# -- DCM, April 16, 2012
+
+use strict;
+use Test::More;
+use blib; # otherwise possible error on virgin systems not finding PDL::Core
+
+use PDL::LiteF;
+
+# First some Inline administivia.
+BEGIN {
+ # Check for BSD platforms
+ plan skip_all => 'Known problem: sf.net bug #3518190, t/inline-comment-test.t fails for BSD'
+ if $^O =~ /(bsd|dragonfly)$/i;
+
+ # Test for Inline and set options
+ my $inline_test_dir = './.inlinepdlpp';
+ mkdir $inline_test_dir unless -d $inline_test_dir;
+
+ # See if Inline loads without trouble, or bail out
+ eval {
+ require Inline;
+ Inline->import (Config => DIRECTORY => $inline_test_dir , FORCE_BUILD => 1);
+ 1;
+ } or do {
+ plan skip_all => "Skipped: Inline not installed";
+ };
+
+ # Make sure we have a recent enough version of Inline
+ eval q{
+ use Inline 0.43;
+ 1;
+ } or do {
+ plan skip_all => 'Unable to load a new enough version of Inline';
+ };
+
+ # All clear, so declare the three tests
+ plan tests => 3;
+}
+
+# use Inline 'INFO'; # use to generate lots of info
+use Inline 'Pdlpp';
+
+print "Inline Version: $Inline::VERSION\n";
+ok(1, 'Everything seems to have compiled');
+
+$a = sequence(3,3);
+
+$b = $a->testinc;
+
+ok(all ($b == $a+1), 'Sanity check runs correctly');
+
+# Test the inability to comment-out a threadloop. This is documented on the
+# 11th page of the PDL::PP chapter of the PDL book. If somebody ever fixes this
+# wart, this test will fail, in which case the book's text should be updated.
+$b = $a->testinc2;
+TODO: {
+ # Note: This test appears to fail on Cygwin and some flavors of Linux.
+ local $TODO = 'This test inexplicably passes on some machines';
+ ok(not (all $b == $a + 1), 'WART: commenting out a threadloop does not work')
+ or diag("\$a is $a and \$b is $b");
+}
+
+__DATA__
+
+__Pdlpp__
+
+# simple PP definition with user irritation tests :-)
+
+pp_def('testinc',
+ Pars => 'a(); [o] b()',
+ Code => q{
+ /* emulate user debugging */
+
+ /* Why doesn't this work???!!!! */
+ threadloop %{
+ /* printf(" %f, %f\r", $a(), $b());
+ printf(" Here\n");
+ */
+
+ /* Sanity check */
+ $b() = $a() + 1;
+
+ %}
+
+ },
+);
+
+# make sure that if the word "threadloop" appears, later automatic threadloops
+# will not be generated, even if the original threadloop was commented-out
+
+pp_def('testinc2',
+ Pars => 'a(); [o] b()',
+ Code => q{
+ /* emulate user debugging */
+
+ /* Why doesn't this work???!!!! */
+ /* threadloop %{
+ printf(" %f, %f\r", $a(), $b());
+ printf(" Here\n");
+ %}
+ */
+ /* Sanity check */
+ $b() = $a() + 1;
+
+ },
+);
diff --git a/t/inlinepdlpp.t b/t/inlinepdlpp.t
new file mode 100644
index 0000000..8a3f785
--- /dev/null
+++ b/t/inlinepdlpp.t
@@ -0,0 +1,56 @@
+use strict;
+use Test::More;
+use blib; # otherwise possible error on virgin systems not finding PDL::Core
+
+use PDL::LiteF;
+
+BEGIN {
+ # clean out the _Inline directory on every test
+ # (may be OTT but ensures that we're always testing the latest code)
+ #
+ # require File::Path;
+ # File::Path::rmtree (["_Inline", ".Inline"], 0, 0);
+
+ # Test for Inline and set options
+ my $inline_test_dir = './.inlinepdlpp';
+ mkdir $inline_test_dir unless -d $inline_test_dir;
+ eval 'use Inline (Config => DIRECTORY => $inline_test_dir , FORCE_BUILD => 1)';
+ if ( ! $@ ) { # have Inline
+ eval 'use Inline 0.43';
+ if ( ! $@ ) {
+ plan tests => 3;
+ }
+ }
+ else {
+ plan skip_all => "Skipped: Inline not installed";
+ }
+}
+
+sub myshape { join ',', $_[0]->dims }
+
+# use Inline 'INFO'; # use to generate lots of info
+use Inline 'Pdlpp';
+
+print "Inline Version: $Inline::VERSION\n";
+ok(1); # ok, we made it so far
+
+$a = sequence(3,3);
+
+$b = $a->testinc;
+
+ok(myshape($a) eq myshape($b));
+
+ok(all $b == $a+1);
+
+__DATA__
+
+__Pdlpp__
+
+# simple PP definition
+
+pp_def('testinc',
+ Pars => 'a(); [o] b()',
+ Code => '$b() = $a() + 1;' # wow, that's complicated
+);
+
+# this tests the bug with a trailing comment and *no* newline
diff --git a/t/interp.t b/t/interp.t
new file mode 100644
index 0000000..9b2e9f6
--- /dev/null
+++ b/t/interp.t
@@ -0,0 +1,51 @@
+# NOTE:
+# currently not in use anymore
+# - see PDL::Func (in Lib/) and t/func.t
+print "1..1\nok 1 # Skipped: see PDL::Func\n";
+exit;
+
+use PDL::LiteF;
+
+use strict;
+
+my $ctr = 0;
+sub ok {
+ $ctr++;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $ctr\n" ;
+}
+
+print "1..5\n";
+
+##########################################################
+
+eval "use PDL::Interpolate;";
+
+my $x = float( 1, 2, 3, 4, 5, 6, 8, 10 );
+my $y = ($x * 3) * ($x - 2);
+
+my $obj = new PDL::Interpolate( x => $x, y => $y );
+ok( UNIVERSAL::isa( $obj, 'PDL::Interpolate' ) );
+ok( $obj->library eq "PDL" );
+
+my $xi = $x - 0.5;
+my $yi = $obj->interpolate( $xi );
+ok( $obj->status == -1 );
+
+# compare to direct version
+my ( $ans, $err ) = PDL::Primitive::interpolate( $xi, $x, $y );
+my $d = abs( $ans - $yi );
+ok( all $d < 1.0e-5 );
+
+my $oerr = $obj->get( 'err' );
+ok( all ($oerr-$err) == 0 );
+
+#print "x: ", $x, "\n";
+#print "xi: ", $xi, "\n";
+#print "$oerr\n";
+
+# end
+
+
+
diff --git a/t/interp_slatec.t b/t/interp_slatec.t
new file mode 100644
index 0000000..f7ad459
--- /dev/null
+++ b/t/interp_slatec.t
@@ -0,0 +1,80 @@
+# NOTE:
+# currently not in use anymore
+# - see PDL::Func (in Lib/) and t/func.t
+print "1..1\nok 1 # Skipped: see PDL::Func\n";
+exit;
+
+use PDL::LiteF;
+
+my $ctr = 0;
+sub ok {
+ $ctr++;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $ctr\n" ;
+}
+
+BEGIN {
+ eval "use PDL::Slatec;";
+ $loaded = ($@ ? 0 : 1);
+}
+
+my $ntests = 11;
+print "1..$ntests\n";
+unless ($loaded) {
+ for (1..$ntests) {
+ print "ok $_ # Skipped: PDL::Slatec not available.\n";
+ }
+ exit;
+}
+
+use strict;
+
+eval "use PDL::Interpolate::Slatec";
+
+########### First test normal subclassing ###########
+
+my $x = sequence(float,10);
+my $y = $x*$x + 0.5;
+
+my $obj = new PDL::Interpolate::Slatec( x => $x, y => $y );
+
+ok( UNIVERSAL::isa( $obj, 'PDL::Interpolate' ) );
+ok( $obj->library eq "Slatec" );
+ok( $obj->status == 1 );
+
+my ( $xi, $yi, $gi, $ans, $d );
+
+$xi = sequence(float,5) + 2.3;
+$yi = $obj->interpolate( $xi );
+ok( $obj->status == 1 );
+
+$ans = $xi*$xi + 0.5;
+$d = abs( $ans - $yi );
+ok( all $d <= 0.03 );
+
+( $yi, $gi ) = $obj->interpolate( $xi );
+ok( $obj->status == 1 );
+
+$ans = 2*$xi;
+$d = abs( $ans - $gi );
+ok( all $d <= 0.04 );
+
+# see how they cope with threading
+#
+$y = cat( $x*$x+43.3, $x*$x*$x-23 );
+
+$obj->set( x => $x, y => $y );
+ok( $obj->status == 1 );
+
+$yi = $obj->interpolate( $xi );
+ok( $obj->status == 1 );
+ok( (dims($yi) == 2) & ($yi->getdim(0) == $xi->getdim(0)) & ($yi->getdim(1) == 2) );
+
+$ans = cat( $xi*$xi+43.3, $xi*$xi*$xi-23 );
+$d = abs( $ans - $yi );
+ok( all $d <= 6 );
+
+# end
+
+
diff --git a/t/interpol.t b/t/interpol.t
new file mode 100644
index 0000000..8ae0515
--- /dev/null
+++ b/t/interpol.t
@@ -0,0 +1,29 @@
+
+# Simple test of the interpol routine
+
+use PDL::Lite;
+
+
+print "1..1\n";
+
+my $testNo = 1;
+
+
+
+my $yvalues = (new PDL( 0..5)) - 20;
+
+my $xvalues = -(new PDL (0..5))*.5;
+
+my $x = new PDL(-2);
+
+ok( $testNo++,$x->interpol($xvalues,$yvalues) == -16 );
+
+
+
+# Testing utility functions:
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
diff --git a/t/iotypes.t b/t/iotypes.t
new file mode 100644
index 0000000..ce021a4
--- /dev/null
+++ b/t/iotypes.t
@@ -0,0 +1,41 @@
+use PDL::LiteF;
+use PDL::Types ':All';
+
+use PDL::IO::FlexRaw;
+use PDL::Config;
+use File::Temp;
+
+use Test::More;
+use strict;
+
+# eventually this should test all our io routines with all
+# supported types
+
+# $SIG{__DIE__} = sub {print Carp::longmess(@_); die ;};
+BEGIN {
+ my @ntypes = (PDL::Types::typesrtkeys());
+ plan tests => scalar grep { ! m/^PDL_IND$/ } @ntypes;
+}
+
+our @types = map { print "making type $_\n";
+ new PDL::Type typefld($_,'numval') }
+ grep { ! m/^PDL_IND$/ } typesrtkeys();
+
+##my $data = $PDL::Config{TEMPDIR} . "/tmprawdata";
+my $data = File::Temp::tmpnam();
+
+for my $type (@types) {
+ print "checking type $type...\n";
+ my $pdl = sequence $type, 10;
+ my $hdr = writeflex $data, $pdl;
+ writeflexhdr($data,$hdr);
+ my $npdl = eval {readflex $data};
+ TODO: {
+ local $TODO = "readflex returns index instead of long";
+ ok ($pdl->type == $npdl->type &&
+ all $pdl == $npdl);
+ }
+}
+
+unlink $data, "${data}.hdr";
+
diff --git a/t/lgamma.t b/t/lgamma.t
new file mode 100755
index 0000000..1416510
--- /dev/null
+++ b/t/lgamma.t
@@ -0,0 +1,49 @@
+# -*-perl-*-
+
+use strict;
+use Test::More;
+use PDL;
+use PDL::LiteF;
+use Config;
+use PDL::Config;
+
+$| = 1;
+
+my $test_count = 6;
+my $eps = 1e-9;
+
+if($Config{cc} eq 'cl') {
+ plan skip_all => 'lgamma not implemented for MS compilers';
+ exit 0;
+}
+elsif ( $PDL::Config{WITH_BADVAL} ) {
+ plan tests => $test_count;
+}
+else {
+ # reduced testing
+ plan tests => $test_count - 2;
+}
+
+my @x = lgamma(-0.1);
+is(approx($x[0], 2.36896133272879), 1);
+is($x[1], -1);
+
+ at x = lgamma(1.1);
+is(approx($x[0], -0.0498724412598397), 1);
+is($x[1], 1);
+
+if($PDL::Config{WITH_BADVAL}) {
+ my $p = sequence (1);
+ $p->badvalue (0);
+ $p->badflag (1);
+
+ my @x = lgamma($p->index(0));
+ is($x[0]->badflag(), 1);
+ is($x[1]->badflag(), 1);
+}
+
+sub my_approx {
+ if($_[0] + $eps > $_[1] && $_[0] - $eps < $_[1]) {return 1}
+ return 0;
+}
+
diff --git a/t/limits_00.t b/t/limits_00.t
new file mode 100644
index 0000000..9174b9f
--- /dev/null
+++ b/t/limits_00.t
@@ -0,0 +1,16 @@
+
+use Test::More;
+
+BEGIN {
+ eval "use PDL::Slatec;";
+ if ( !$@ ) {
+ eval "use PDL::Graphics::Limits;";
+ plan tests => 1;
+ } else {
+ print "$@\n";
+ plan skip_all => 'PDL::Slatec not available';
+ }
+ use_ok('PDL::Graphics::Limits');
+};
+
+# end
diff --git a/t/limits_errb.t b/t/limits_errb.t
new file mode 100644
index 0000000..21f263f
--- /dev/null
+++ b/t/limits_errb.t
@@ -0,0 +1,56 @@
+
+use Test::More;
+use PDL;
+
+BEGIN {
+ eval "use PDL::Slatec;";
+ if ( !$@ ) {
+ eval "use PDL::Graphics::Limits;";
+ plan tests => 6;
+ } else {
+ plan skip_all => 'PDL::Slatec not available';
+ }
+};
+
+$x1 = pdl( 1, 2, 3 );
+$x2 = pdl( 2, 3, 4 );
+
+$xn = pdl( 0.5, 0.5, 0.5 );
+$xp = $xn / 2;
+
+$y1 = pdl( 10, 3, 4 );
+$y2 = pdl( 0, 2, 4 );
+
+ at udsets = ( [ [ $x1, $xn ], $y1 ], [ $x2, $y2 ] );
+ at range = limits( @udsets, { Bounds => 'MinMax', Clean => 'None' } );
+ok( eq_array( \@range, [ 0.5, 4, 0, 10 ] ), 'array: xerr symmetric, y none' );
+
+ at udsets = ( [ [ $x1, $xn ], $y1 ], [ [ $x2, undef, $xp ], $y2 ] );
+ at range = limits( @udsets, { Bounds => 'MinMax', Clean => 'None' } );
+ok( eq_array( \@range, [ 0.5, 4.25, 0, 10 ] ), 'array: xerr asymmetric, y none' );
+
+ at udsets = ( [ [ $x1, $xn, $xp ], $y1 ], [ $x2, $y2 ] );
+ at range = limits( @udsets, { Bounds => 'MinMax', Clean => 'None' } );
+ok( eq_array( \@range, [ 0.5, 4, 0, 10 ] ), 'array: xerr asymmetric, y none' );
+
+ at udsets = ( [ { x => $x1, xerr => $xn, y => $y1 }, { x => $x2, y => $y2 } ]);
+ at range = limits( @udsets, { VecKeys => [ 'x,=xerr', 'y'],
+ Bounds => 'MinMax',
+ Clean => 'None',
+ KeyCroak => 0 } );
+ok( eq_array( \@range, [ 0.5, 4, 0, 10 ] ), 'hash: xerr symmetric, y none' );
+
+ at udsets = ( [ { x => $x1, xerr => $xn, 'y' => $y1 } => ( 'x =xerr', 'y' ) ],
+ [ { x => $x2, xp => $xp, 'y' => $y2 } => ( 'x >xp', 'y') ] );
+ at range = limits( @udsets, { Bounds => 'MinMax', Clean => 'None' } );
+ ok( eq_array( \@range, [ 0.5, 4.25, 0, 10 ] ), 'hash: xerr asymmetric, y none' );
+
+ at udsets = ( [ { x => $x1, xn => $xn, xp => $xp, y => $y1 },
+ { x => $x2, y => $y2 } ] );
+ at range = limits( @udsets, { VecKeys => [ 'x <xn >xp', 'y' ],
+ Bounds => 'MinMax',
+ Clean => 'None',
+ KeyCroak => 0
+ } );
+ok( eq_array( \@range, [ 0.5, 4, 0, 10 ] ), 'hash: xerr asymmetric, y none' );
+
diff --git a/t/limits_keyspecs.t b/t/limits_keyspecs.t
new file mode 100644
index 0000000..fa42c8f
--- /dev/null
+++ b/t/limits_keyspecs.t
@@ -0,0 +1,78 @@
+
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+ eval "use PDL::Slatec;";
+ if ( !$@ ) {
+ eval "use PDL::Graphics::Limits;";
+ plan tests => 12;
+ } else {
+ plan skip_all => 'PDL::Slatec not available';
+ }
+};
+
+*parse_vecspec = \&PDL::Graphics::Limits::parse_vecspec;
+
+#################################################################
+
+# test parsing of hash key specs
+
+my @good = (
+ 'x<n>p&f' => { data => 'x',
+ errn => 'n',
+ errp => 'p',
+ trans => 'f' },
+
+ '<n>p&f' => { errn => 'n',
+ errp => 'p',
+ trans => 'f' },
+
+ 'x,<n,>p,&f' => { data => 'x',
+ errn => 'n',
+ errp => 'p',
+ trans => 'f' },
+
+ 'x <n >p &f' => { data => 'x',
+ errn => 'n',
+ errp => 'p',
+ trans => 'f' },
+
+
+ '<n>p&f' => { errn => 'n',
+ errp => 'p',
+ trans => 'f' },
+
+ '&f' => { trans => 'f' },
+
+ 'x' => { data => 'x' },
+
+ '&' => { trans => undef },
+
+ undef() => { },
+
+ '<>&' => { errn => undef,
+ errp => undef,
+ trans => undef },
+
+ '=s' => { errn => 's',
+ errp => 's' },
+
+
+);
+
+while( my ( $spec, $exp ) = splice( @good, 0, 2 ) )
+{
+ my $res = { parse_vecspec($spec) };
+ ok( eq_hash( $exp, $res ), defined $spec ? $spec : 'undef' );
+}
+
+my @bad = ( '<<' );
+
+for my $spec ( @bad )
+{
+ eval { parse_vecspec($spec) };
+ ok( $@, "$spec" );
+}
+
diff --git a/t/limits_normalize_dsets.t b/t/limits_normalize_dsets.t
new file mode 100644
index 0000000..fa45da6
--- /dev/null
+++ b/t/limits_normalize_dsets.t
@@ -0,0 +1,343 @@
+use PDL;
+
+print "1..21\n";
+
+my $got = 0;
+eval{require PDL::Slatec;};
+if(!$@) {$got = 1}
+
+if($got) {
+ eval{require PDL::Graphics::Limits;};
+ if($@) {$got = 0}
+ }
+
+unless($got) {
+ for(1..21){print "ok $_ - skipped\n"}
+ exit;
+ }
+
+*normalize_dsets = \&PDL::Graphics::Limits::normalize_dsets;
+*parse_vecspecs = \&PDL::Graphics::Limits::parse_vecspecs;
+
+# temporarily disable warnings to turn off Perl's
+# redefinition warning
+my $oldw;
+BEGIN {
+ $oldw = $^W;
+ $^W=0;
+}
+
+# so can use _eq_array w/ piddles.
+{
+ package PDL;
+ use overload 'eq' => \&PDL::eq,
+ 'bool' => sub { $_[0]->and } ;
+}
+
+BEGIN {
+ $^W=$oldw;
+}
+
+$x1 = pdl( 1, 2 );
+$y1 = pdl( 1, 2 );
+
+$xn = pdl( 0.5, 0.5 );
+$xp = pdl( 0.25, 0.25 );
+
+$x2 = pdl( 2, 3 );
+$y2 = pdl( 2, 4 );
+
+my %errs = ( en => undef, ep => undef );
+%attr = ( KeyCroak => 1 );
+
+ at rdsets = (
+ { MinMax => [ [ '', ''],
+ [ '', '']
+ ],
+ Vectors => [ { data => $x1 },
+ {
+ data => $y1 }
+ ]
+ },
+
+ { MinMax => [ [ '', ''],
+ [ '', '']
+ ],
+ Vectors => [ { data => $x2 },
+ {
+ data => $y2 }
+ ]
+ },
+ );
+
+
+ at udsets = ( [ $x1, $y1 ],
+ [ $x2, $y2 ] );
+ at dsets = normalize_dsets( { %attr }, @udsets );
+
+
+%d1 = %{$dsets[0]};
+for (keys(%d1)) {
+ print "1: $_: $d1{$_}\n";
+ my @d1 = @{$d1{$_}};
+ print " @d1\n";
+ }
+%d2 = %{$dsets[1]};
+for (keys(%d2)) {
+ print "2: $_: $d2{$_}\n";
+ my @d2 = @{$d2{$_}};
+ print " @d2\n";
+ }
+
+_ok( _eq_array( \@dsets, \@rdsets ), 1, "array" );
+
+
+my $args = { %attr, KeySpec => [ { data => 'x' }, { data => 'y' }, ] };
+
+ at udsets = ( [ { x => $x1, y => $y1 },
+ { x => $x2, y => $y2 } ] );
+ at dsets = normalize_dsets( $args, @udsets );
+_ok( _eq_array( \@dsets, \@rdsets ), 2, "hash" );
+
+
+ at udsets = ( [ { x => $x1, y => $y1 },
+ { x => $x2, y => $y2, z => 0 } ] );
+ at dsets = normalize_dsets( $args, @udsets );
+_ok( _eq_array( \@dsets, \@rdsets ), 3, "hash, extra data" );
+
+
+ at udsets = ( [ $x1, $y1 ],
+ [ { x => $x2, y => $y2 } ] );
+ at dsets = normalize_dsets( $args, @udsets );
+_ok( _eq_array( \@dsets, \@rdsets ), 4, "array and hash" );
+
+#############################################################
+
+ at udsets = ( $x1, $y1, [ { x => $x2, y => $y2 } ] );
+eval {
+ @dsets = normalize_dsets( $args,, @udsets );
+};
+_ok( $@ =~ /same dimensionality/, 5, "dimensions not equal" );
+
+ at udsets = ( [ $x1, $y1 ], [ $x1, { x => $x2, y => $y2 } ] );
+eval {@dsets = normalize_dsets( $args, @udsets ); };
+_ok( $@ =~ /unexpected data type/, 6, "bad arg mix" );
+
+ at udsets = ( [ $x1, $y1 ], [ { x => $x2, y => $y2 } ] );
+eval {
+ @dsets = normalize_dsets( $args, @udsets );
+};
+_ok( !$@, 7, "array hash combo" );
+
+#############################################################
+
+ at udsets = ( [ $x1, $y1 ] );
+ at dsets = normalize_dsets( { %attr, Trans => [ \&log ] }, @udsets );
+
+_ok( _eq_array( $dsets[0]{Vectors}, [
+ { data => $x1, trans => \&log },
+ { data => $y1 },
+ ]
+ ), 8, "array: global x trans" );
+
+ at udsets = ( [ [ $x1, \&log ], $y1 ] );
+ at dsets = normalize_dsets( { %attr }, @udsets );
+_ok( _eq_array( $dsets[0]{Vectors}, [
+ { data => $x1, trans => \&log },
+ { data => $y1 },
+ ]
+ ), 9, "array: local x trans" );
+
+ at udsets = ( [ [ $x1, \&log ], $y1 ] );
+ at dsets = normalize_dsets( { %attr, Trans => [ \&sin ]}, @udsets );
+_ok( _eq_array( $dsets[0]{Vectors}, [
+ { data => $x1, trans => \&log },
+ { data => $y1 },
+ ]
+ ), 10, "array: local override x trans" );
+
+ at udsets = ( [ [ $x1, undef, undef, undef ], $y1 ] );
+ at dsets = normalize_dsets( { %attr, Trans => [ \&sin ]}, @udsets );
+_ok( _eq_array( $dsets[0]{Vectors}, [
+ { data => $x1 },
+ { data => $y1 },
+ ]
+ ), 11, "array: local undef x trans" );
+
+#############################################################
+
+$keys = [ qw( x y ) ];
+%keys = ( KeySpec => parse_vecspecs( $keys ) );
+$udsets = [ { x => $x1, y => $y1 } ];
+ at dsets = normalize_dsets( { %attr, %keys, Trans => [ \&log ] }, $udsets );
+_ok( _eq_array( $dsets[0]{Vectors}, [
+ { data => $x1, trans => \&log },
+ { data => $y1 },
+ ]
+ ), 12, "hash: global x trans" );
+
+
+$udsets = [ { x => $x1, trans => \&log , y => $y1 } => ( '&trans' ) ];
+ at dsets = normalize_dsets( { %attr, %keys }, $udsets );
+_ok( _eq_array( $dsets[0]{Vectors}, [
+ { data => $x1, trans => \&log },
+ { data => $y1 },
+ ]
+ ), 13, "hash: local x trans 1" );
+
+
+$udsets = [ { x => $x1, trans => \&log , y => $y1 } => qw( x&trans y ) ];
+ at dsets = normalize_dsets( { %attr, KeySpec => [] }, $udsets );
+_ok( _eq_array( $dsets[0]{Vectors}, [
+ { data => $x1, trans => \&log },
+ { data => $y1 },
+ ]
+ ), 14, "hash: local x trans 2" );
+
+$udsets = [ { x => $x1, trans => \&log , y => $y1 } => qw( x&trans y ) ];
+ at dsets = normalize_dsets( { %attr, KeySpec => [], Trans => [\&sin] }, $udsets );
+_ok( _eq_array( $dsets[0]{Vectors}, [
+ { data => $x1, trans => \&log },
+ { data => $y1 },
+ ]
+ ), 15, "hash: local override x trans" );
+
+$udsets = [ { x => $x1, trans => undef , y => $y1 } => qw( x&trans y ) ];
+ at dsets = normalize_dsets( { %attr, KeySpec => [], Trans => [\&sin] }, $udsets );
+_ok( _eq_array( $dsets[0]{Vectors}, [
+ { data => $x1 },
+ { data => $y1 },
+ ]
+ ), 16, "hash: local undef x trans 1" );
+
+$udsets = [ { x => $x1, y => $y1 } => qw( x& y ) ];
+ at dsets = normalize_dsets( { %attr, KeySpec => [], Trans => [\&sin] }, $udsets );
+_ok( _eq_array( $dsets[0]{Vectors}, [
+ { data => $x1 },
+ { data => $y1 },
+ ]
+ ), 17, "hash: local undef x trans 2" );
+
+
+#############################################################
+
+ at udsets = ( [ [ $x1, $xn ], $y2 ] );
+ at dsets = normalize_dsets( { %attr }, @udsets );
+$exp = [ { data => $x1, errn => $xn, errp => $xn }, { data => $y2, } ];
+_ok( _eq_array( $dsets[0]{Vectors}, $exp), 18, "array: symmetric errors" );
+
+ at udsets = ( [ [ $x1, $xn, $xp ], $y2 ] );
+ at dsets = normalize_dsets( { %attr }, @udsets );
+$exp = [ { data => $x1, errn => $xn, errp => $xp }, { data => $y2, } ];
+_ok( _eq_array( $dsets[0]{Vectors}, $exp), 19, "array: asymmetric errors 1" );
+
+ at udsets = ( [ [ $x1, undef, $xp ], $y2 ] );
+ at dsets = normalize_dsets( { %attr }, @udsets );
+$exp = [ { data => $x1, errp => $xp }, { data => $y2, } ];
+_ok( _eq_array( $dsets[0]{Vectors}, $exp), 20, "array: asymmetric errors 2" );
+
+ at udsets = ( [ [ $x1, $xn, undef ], $y2 ] );
+ at dsets = normalize_dsets( { %attr }, @udsets );
+$exp = [ { data => $x1, errn => $xn }, { data => $y2, } ];
+_ok( _eq_array( $dsets[0]{Vectors}, $exp), 21, "array: asymmetric errors 3" );
+
+##############################################
+##############################################
+
+sub _ok {
+ if($_[0]) {print "ok $_[1] - $_[2]\n"}
+ else {print "not ok $_[1] - $_[2]\n"}
+}
+
+############################################
+
+sub __deep_check {
+ my($e1, $e2) = @_;
+ my $ok = 0;
+
+ my $eq;
+ {
+ # Quiet uninitialized value warnings when comparing undefs.
+ no warnings;
+
+ if( $e1 eq $e2 ) {
+ $ok = 1;
+ }
+ else {
+ if( UNIVERSAL::isa($e1, 'ARRAY') and
+ UNIVERSAL::isa($e2, 'ARRAY') )
+ {
+ $ok = _eq_array($e1, $e2);
+ }
+ elsif( UNIVERSAL::isa($e1, 'HASH') and
+ UNIVERSAL::isa($e2, 'HASH') )
+ {
+ $ok = _eq_hash($e1, $e2);
+ }
+ elsif( UNIVERSAL::isa($e1, 'REF') and
+ UNIVERSAL::isa($e2, 'REF') )
+ {
+ push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
+ $ok = __deep_check($$e1, $$e2);
+ pop @Data_Stack if $ok;
+ }
+ elsif( UNIVERSAL::isa($e1, 'SCALAR') and
+ UNIVERSAL::isa($e2, 'SCALAR') )
+ {
+ push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
+ $ok = __deep_check($$e1, $$e2);
+ }
+ else {
+ push @Data_Stack, { vals => [$e1, $e2] };
+ $ok = 0;
+ }
+ }
+ }
+
+ return $ok;
+}
+
+############################################
+
+sub _eq_array {
+ my($a1, $a2) = @_;
+ return 1 if $a1 eq $a2;
+
+ my $ok = 1;
+ my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
+ for (0..$max) {
+ my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
+ my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
+
+ push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
+ $ok = __deep_check($e1,$e2);
+ pop @Data_Stack if $ok;
+
+ last unless $ok;
+ }
+ return $ok;
+}
+
+#############################################
+
+sub _eq_hash {
+ my($a1, $a2) = @_;
+ return 1 if $a1 eq $a2;
+
+ my $ok = 1;
+ my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
+ foreach my $k (keys %$bigger) {
+ my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
+ my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
+
+ push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
+ $ok = __deep_check($e1, $e2);
+ pop @Data_Stack if $ok;
+
+ last unless $ok;
+ }
+
+ return $ok;
+}
+
+
diff --git a/t/limits_range.t b/t/limits_range.t
new file mode 100644
index 0000000..4608e5a
--- /dev/null
+++ b/t/limits_range.t
@@ -0,0 +1,53 @@
+
+use Test::More;
+use PDL;
+
+BEGIN {
+ eval "use PDL::Slatec;";
+ if ( !$@ ) {
+ eval "use PDL::Graphics::Limits;";
+ plan tests => 6;
+ } else {
+ plan skip_all => 'PDL::Slatec not available';
+ }
+};
+
+#################################################################
+
+$x1 = pdl( 1, 2 );
+$y1 = pdl( 1, 2 );
+
+$x2 = pdl( 2, 3 );
+$y2 = pdl( 2, 4 );
+
+ at minmax = ( 1, 3, 1, 4 );
+$minmax_hash = { q1 => { min => 1, max => 3 },
+ q2 => { min => 1, max => 4 } };
+ at minmax_range = ( 0.9, 3.1, 0.85, 4.15 );
+ at minmax_round = ( 0.5, 5, 0.5, 5 );
+
+ at udsets = ( [ $x1, $y1 ], [ $x2, $y2 ] );
+
+ at range = limits( @udsets, { Bounds => 'MinMax', Clean => 'None' } );
+ok( eq_array( \@range, \@minmax ), "MinMax, None" );
+
+$range = limits( @udsets, {Bounds => 'MinMax', Clean => 'None' } );
+ok( eq_hash( $range, $minmax_hash ), "MinMax, None, hash" );
+
+ at range = limits( @udsets, {Bounds => 'MinMax', Clean => 'RangeFrac' } );
+ok( eq_array( \@range, \@minmax_range ), "MinMax, Range" );
+
+ at range = limits( @udsets, {Bounds => 'MinMax', Clean => 'RoundPow' } );
+ok( eq_array( \@range, \@minmax_round ), "MinMax, Range" );
+
+
+$x1 = pdl( 1, 2, 3, 4 );
+$y1 = pdl( 0, 10, 3, 4 );
+
+ at range = limits( [ $x1, $y1 ], { Bounds => 'Zscale', Clean => 'None' } );
+ok( all(approx( pdl(@range), pdl ( 1, 4, -0.4, 8.9 ) )), 'Zscale, None' );
+
+ at range = limits( [ 1, 2 ], [ 3, 4 ], { Bounds => 'MinMax', Clean => 'None' } );
+ok( eq_array( \@range, [ 1, 3, 2, 4 ] ), "scalars in the mix " );
+
+
diff --git a/t/limits_round.t b/t/limits_round.t
new file mode 100644
index 0000000..20a8d2e
--- /dev/null
+++ b/t/limits_round.t
@@ -0,0 +1,66 @@
+
+use PDL::LiteF;
+use Test::More;
+
+BEGIN {
+ eval "use PDL::Slatec;";
+ if ( !$@ ) {
+ eval "use PDL::Graphics::Limits;";
+ plan tests => 37;
+ } else {
+ plan skip_all => 'PDL::Slatec not available';
+ }
+};
+
+*round_pow = \&PDL::Graphics::Limits::round_pow;
+
+ at round_tests =
+ (
+ [ -100, -200, -50 ],
+ [ -11, -20, -10 ],
+ [ -10, -20, -5 ],
+ [ -6, -10, -5 ],
+ [ -5, -10, -2 ],
+ [ -3, -5, -2 ],
+ [ -2, -5, -1 ],
+ [ -1 , -2 , -0.5 ],
+ [ -0.6 , -1 , -0.5 ],
+ [ -0.5 , -1 , -0.2 ],
+ [ -0.3 , -0.5 , -0.2 ],
+ [ -0.2 , -0.5 , -0.1 ],
+ [ -0.1 , -0.2 , -0.05 ],
+ [ -0.06, -0.1 , -0.05 ],
+ [ -0.05, -0.1 , -0.02 ],
+ [ -0.03, -0.05, -0.02 ],
+ [ -0.02, -0.05, -0.01 ],
+ [ -0.01, -0.02, -0.005 ],
+
+ [ 0, 0, 0 ],
+ [ 0.01, 0.005, 0.02 ],
+ [ 0.02, 0.01, 0.05 ],
+ [ 0.03, 0.02, 0.05 ],
+ [ 0.05, 0.02, 0.1 ],
+ [ 0.06, 0.05, 0.1 ],
+ [ 0.1, 0.05, 0.2 ],
+ [ 0.2, 0.1, 0.5 ],
+ [ 0.3, 0.2, 0.5 ],
+ [ 0.5, 0.2, 1 ],
+ [ 0.6, 0.5, 1 ],
+ [ 1, 0.5, 2 ],
+ [ 2, 1, 5 ],
+ [ 3, 2, 5 ],
+ [ 5, 2, 10 ],
+ [ 6, 5, 10 ],
+ [ 10, 5, 20 ],
+ [ 11, 10, 20 ],
+ [ 100, 50, 200 ],
+ );
+
+for my $test ( @round_tests )
+{
+ my $down = round_pow( down => $test->[0] );
+ my $up = round_pow( up => $test->[0] );
+ my $eps = abs($test->[0]) > 1 ? abs($test->[0])/1.0e-6 : 1.0e-6;
+
+ ok( approx($test->[1],$down,$eps) && approx($test->[2],$up,$eps), 'round_pow('. $test->[0] .')' );
+}
diff --git a/t/limits_trans.t b/t/limits_trans.t
new file mode 100644
index 0000000..ec09259
--- /dev/null
+++ b/t/limits_trans.t
@@ -0,0 +1,73 @@
+
+use Test::More;
+use PDL;
+
+BEGIN {
+ eval "use PDL::Slatec;";
+ if ( !$@ ) {
+ eval "use PDL::Graphics::Limits;";
+ plan tests => 8;
+ } else {
+ plan skip_all => 'PDL::Slatec not available';
+ }
+};
+
+$x1 = pdl( 1, 2, 3 );
+$x2 = pdl( 2, 3, 4 );
+
+$y1 = pdl( 10, 3, 4 );
+$y2 = pdl( -1, 2, 4 );
+
+sub trans { $_[0] * 10 };
+sub trans2 { $_[0] * 11 };
+
+ at udsets = ( [ $x1, [ $y1, \&trans ]], [ $x2, $y2 ] );
+ at limits = limits( @udsets, { Bounds => 'MinMax', Clean => 'None' } );
+ok( eq_array( \@limits, [ 1, 4, -1, 100 ] ), 'array: y1 trans' );
+
+ at udsets = ( [ $x1, $y1], [ $x2, $y2 ] );
+ at limits = limits( @udsets, { Trans => [ undef, \&trans ],
+ Bounds => 'MinMax',
+ Clean => 'None' } );
+ok( eq_array( \@limits, [ 1, 4, -10, 100 ] ), 'array: y* trans' );
+
+ at udsets = ( [ $x1, [ $y1, undef, undef, undef ] ], [ $x2, $y2 ] );
+ at limits = limits( @udsets, { Trans => [ undef, \&trans ],
+ Bounds => 'MinMax',
+ Clean => 'None' } );
+ok( eq_array( \@limits, [ 1, 4, -10, 40 ] ), 'array: y* trans, y1 undef' );
+
+ at udsets = ( [ $x1, [ $y1, \&trans ]], [ $x2, [ $y2, \&trans2 ]] );
+ at limits = limits( @udsets, { Bounds => 'MinMax', Clean => 'None' } );
+ok( eq_array( \@limits, [ 1, 4, -11, 100 ] ), 'array: y1 trans y2 trans2' );
+
+############################################################
+
+ at udsets = ([ { x => $x1, y => $y1, ytrans => \&trans }, { x => $x2, y => $y2 } ]);
+ at limits = limits( @udsets, { Bounds => 'MinMax', Clean => 'None',
+ VecKeys => [qw( x y&ytrans )], KeyCroak => 0
+ } );
+ok( eq_array( \@limits, [ 1, 4, -1, 100 ] ), 'hash: y1 trans' );
+
+ at udsets = ([ { x => $x1, y => $y1 }, { x => $x2, y => $y2 } ]);
+ at limits = limits( @udsets, { Bounds => 'MinMax', Clean => 'None',
+ VecKeys => [qw( x y )],
+ Trans => [ undef, \&trans ]
+ } );
+ok( eq_array( \@limits, [ 1, 4, -10, 100 ] ), 'hash: y* trans' );
+
+ at udsets = ([ { x => $x1, y => $y1, ytrans => undef },
+ { x => $x2, y => $y2 } ]);
+ at limits = limits( @udsets, { Bounds => 'MinMax', Clean => 'None',
+ VecKeys => [qw( x y&ytrans )], KeyCroak => 0,
+ Trans => [ undef, \&trans ],
+ } );
+ok( eq_array( \@limits, [ 1, 4, -10, 40 ] ), 'hash: y* trans y1 undef' );
+
+ at udsets = ([ { x => $x1, y => $y1, ytrans => \&trans },
+ { x => $x2, y => $y2, ytrans => \&trans2 } ]);
+ at limits = limits( @udsets, { Bounds => 'MinMax', Clean => 'None',
+ VecKeys => [qw( x y&ytrans )],
+ } );
+ok( eq_array( \@limits, [ 1, 4, -11, 100 ] ), 'hash: y1 trans y2 trans2' );
+
diff --git a/t/limits_trans_err.t b/t/limits_trans_err.t
new file mode 100644
index 0000000..c2213d8
--- /dev/null
+++ b/t/limits_trans_err.t
@@ -0,0 +1,44 @@
+
+use Test::More;
+use PDL;
+
+BEGIN {
+ eval "use PDL::Slatec;";
+ if ( !$@ ) {
+ eval "use PDL::Graphics::Limits;";
+ plan tests => 3;
+ } else {
+ plan skip_all => 'PDL::Slatec not available';
+ }
+};
+
+## TODO: { # I think this has been fixed
+## local $TODO = 'Needs to use approx() for float tests';
+
+ $x1 = pdl( 1, 2, 3 );
+ $x2 = pdl( 2, 3, 4 );
+
+ $xn = pdl( 0.5, 0.5, 0.5 );
+ $xp = $xn / 2;
+
+ $y1 = pdl( 10, 3, 4 );
+ $y2 = pdl( -1, 2, 4 );
+
+ @udsets = ( [ [ $x1, $xn ], $y1], [ $x2, $y2 ] );
+ @range = limits( @udsets, { Bounds => 'MinMax', Clean => 'None', Trans => [ \&log10 ], } );
+
+ is_deeply( \@range, [ log10(1-0.5), log10(4), -1, 10 ], 'x symmetric trans' );
+
+ @udsets = ( [ [ $x1, $xn ], $y1], [ [ $x2, undef, $xp ], $y2 ] );
+ @range = limits( @udsets, { Bounds => 'MinMax', Clean => 'None', Trans => [ \&log10 ], } );
+
+ is_deeply( \@range, [ log10(1-0.5), log10(4+0.25), -1, 10 ], 'x asymmetric trans' );
+
+ $y1 = pdl( 0.5, 1, 5 );
+ $ys = pdl( 0.5, 0.5, 0.5 );
+ @udsets = ( [ [ $y1, $ys ] ] );
+ @range = limits( @udsets, { Bounds => 'MinMax', Clean => 'None', Trans => [ \&log10 ], } );
+
+ is_deeply( \@range, [ log10(0.5), log10(5+0.5) ], 'illegal errbar lower bounds' );
+
+## }
diff --git a/t/limits_ulimits.t b/t/limits_ulimits.t
new file mode 100644
index 0000000..55ffda0
--- /dev/null
+++ b/t/limits_ulimits.t
@@ -0,0 +1,232 @@
+
+use Test::More;
+use PDL;
+
+BEGIN {
+ eval "use PDL::Slatec;";
+ if ( !$@ ) {
+ eval "use PDL::Graphics::Limits;";
+ plan tests => 26;
+ } else {
+ plan skip_all => 'PDL::Slatec not available';
+ }
+};
+
+#####################################################################
+# test user override limits. only need to worry about how they affect
+# the bounding algorithms. they shouldn't be affected by errors,
+# so don't toss them in the test.
+
+$x1 = pdl( 1, 2, 3 );
+$x2 = pdl( 2, 3, 4 );
+
+$y1 = pdl( 10, 8, 3 );
+$y2 = pdl( 0, 2, 4 );
+
+ at udsets_arr = ( [ $x1, $y1 ],
+ [ $x2, $y2 ] );
+
+ at udsets_hash = ( [ { x => $x1, y => $y1 },
+ { x => $x2, y => $y2 } ] );
+
+
+#############################################################3
+#### Bounds => MinMax
+
+%attr = ( Bounds => 'MinMax', Clean => 'None' );
+
+# array based
+
+ at tests = (
+ [ 'none 0',
+ [ ],
+ [ 1, 4, 0, 10 ]
+ ],
+
+ [ 'none 1',
+ [ [ ] ],
+ [ 1, 4, 0, 10 ]
+ ],
+
+ [ 'none 2',
+ [ [ ], [ ] ],
+ [ 1, 4, 0, 10 ]
+ ],
+
+ [ 'xmin',
+ [ [ -20 ] ],
+ [ -20, 4, 0, 10 ]
+ ],
+
+ [ 'xmax',
+ [ [ undef, 20 ] ],
+ [ 1, 20, 0, 10 ]
+ ],
+
+ [ 'xmin+xmax',
+ [ [ -20, 20 ] ],
+ [ -20, 20, 0, 10 ]
+ ],
+
+ [ 'ymin',
+ [ [ ], [ -20 ] ],
+ [ 1, 4, -20, 10 ]
+ ],
+
+ [ 'ymax',
+ [ [ ], [ undef, 20 ] ],
+ [ 1, 4, 0, 20 ]
+ ],
+
+ [ 'ymin+ymax',
+ [ [], [ -20, 20 ] ],
+ [ 1, 4, -20, 20 ]
+ ],
+
+ [ 'xmin+xmax+ymin+ymax',
+ [ [-20, 10], [ -20, 20 ] ],
+ [ -20, 10, -20, 20 ]
+ ],
+
+ );
+
+
+foreach my $test ( @tests )
+{
+ my ( $msg, $limits, $exp ) = @$test;
+
+ my @range = limits( @udsets_arr, { %attr, Limits => $limits } );
+ ok( mostly_eq_array( \@range, $exp ), "array: $msg" );
+}
+
+
+
+ at tests = (
+ [ 'none',
+ { },
+ [ 1, 4, 0, 10 ]
+ ],
+
+ [ 'xmin',
+ { x => { min => -20 } },
+ [ -20, 4, 0, 10 ]
+ ],
+
+ [ 'xmax',
+ { x => { max => 20 } },
+ [ 1, 20, 0, 10 ]
+ ],
+
+ [ 'xmin+xmax',
+ { x => { min => -20, max => 20 } },
+ [ -20, 20, 0, 10 ]
+ ],
+
+ [ 'ymin',
+ { y => { min => -20 } },
+ [ 1, 4, -20, 10 ]
+ ],
+
+ [ 'ymax',
+ { y => { max => 20 } },
+ [ 1, 4, 0, 20 ]
+ ],
+
+ [ 'ymin+ymax',
+ { y => { min => -20, max => 20 } },
+ [ 1, 4, -20, 20 ]
+ ],
+
+ [ 'xmin+xmax+ymin+ymax',
+ { x => { min => -20, max => 10 }, y => { min => -20, max => 20 } },
+ [ -20, 10, -20, 20 ]
+ ],
+
+ );
+
+foreach my $test ( @tests )
+{
+ my ( $msg, $limits, $exp ) = @$test;
+
+ my @range = limits( @udsets_hash, { %attr, Limits => $limits, VecKeys => [ qw/ x y / ] } );
+ ok( mostly_eq_array( \@range, $exp ), "hash: $msg" );
+}
+
+
+#############################################################
+#### Bounds => ZScale
+
+# just use arrays here; tests above suffice to ensure hashes are ok
+
+%attr = ( Bounds => 'Zscale', Clean => 'None' );
+
+ at tests = (
+ [ 'none',
+ [ ],
+ [ 1, 4, 0, 10.5 ]
+ ],
+
+ [ 'xmin',
+ [ [ -20 ] ],
+ [ -20, 4, 0, 10.5 ]
+ ],
+
+ [ 'xmax',
+ [ [ undef, 20 ] ],
+ [ 1, 20, 0, 10.5 ]
+ ],
+
+ [ 'xmin+xmax',
+ [ [ -20, 20 ] ],
+ [ -20, 20, 0, 10.5 ]
+ ],
+
+ [ 'ymin',
+ [ [ ], [ -20 ] ],
+ [ 1, 4, -20, 10.5 ]
+ ],
+
+ [ 'ymax',
+ [ [ ], [ undef, 20 ] ],
+ [ 1, 4, 0, 20 ]
+ ],
+
+ [ 'ymin+ymax',
+ [ [], [ -20, 20 ] ],
+ [ 1, 4, -20, 20 ]
+ ],
+
+ [ 'xmin+xmax+ymin+ymax',
+ [ [-20, 10], [ -20, 20 ] ],
+ [ -20, 10, -20, 20 ]
+ ],
+
+ );
+
+
+foreach my $test ( @tests )
+{
+ my ( $msg, $limits, $exp ) = @$test;
+
+ my @range = limits( @udsets_arr, { %attr, Limits => $limits } );
+ ok( mostly_eq_array( \@range, $exp ), "array: $msg" ) or diag "(@range), [@$exp]\n";
+}
+
+# check equality of array refs up to a tolerance
+sub mostly_eq_array {
+ my ($a, $b) = @_;
+
+ my $tol = 1e-9;
+
+ for (my $i=0;$i<@$a;$i++) {
+ return 0 unless (abs($$a[$i] - $$b[$i]) < $tol);
+ }
+
+ return 1;
+}
+
+
+
+
+
+
diff --git a/t/linfit.t b/t/linfit.t
new file mode 100644
index 0000000..f9d874d
--- /dev/null
+++ b/t/linfit.t
@@ -0,0 +1,129 @@
+use PDL::LiteF;
+BEGIN {
+ eval " use PDL::Fit::Linfit; ";
+ $loaded = ($@ ? 0 : 1);
+}
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+print "1..2\n";
+
+unless ($loaded) {
+ for (1..2) {
+ print "ok $_ # Skipped: probably PDL::Slatec not available.\n";
+ }
+ exit;
+}
+
+
+my $testNo = 1;
+
+
+# Simple Test Case:
+
+# Generate data from a set of functions
+my $xvalues = sequence(100);
+$data = 3*$xvalues + 2*cos($xvalues) + 3*sin($xvalues*2);
+
+# Fit functions are the linear, cos, and sin2x functions used in
+# the data generation step above:
+$fitFuncs = cat $xvalues, cos($xvalues), sin($xvalues*2);
+
+# Perform the fit, Coefs should equal 3,2,3
+my ($yfit, $coeffs) = PDL::linfit1d($data,$fitFuncs);
+
+my @coefs = $coeffs->list;
+
+ok( $testNo++, tapprox( $coefs[0], 3) && tapprox( $coefs[1], 2) && tapprox( $coefs[2], 3) );
+
+
+# More Complex Example
+
+
+my $noPoints = 501;
+
+my @expectedCoefs = qw( 0.988375918186647 -0.000278823311771375 0.161669997297754 0.0626069008452451);
+
+my $noCoefs = 4;
+my $i;
+my ($deltaT,$Amp,$lin,$HOper,$AmpHO,$Amphalf,$Ampfull);
+
+my @PulsedB;
+
+my @Pulse;
+my $psum = 0;
+
+my $pi = 3.1415926;
+
+my $Pwidth = 2000;
+my $pave;
+
+$deltaT = 4; # 4 nS increments
+$Amp = 2.8; # 2.8V amplitude of pulse
+$lin = .2;
+$HOper = 200; # HO period
+$AmpHO=.1;
+$Amphalf = .5;
+$Ampfull = .2;
+
+# generate waveform:
+for($i=0;$i<$noPoints;$i++){
+ $PulsedB[$i]=
+ -$lin*1e-3*$i*$deltaT +
+ $Amphalf*sin($pi/$Pwidth*$i*$deltaT) +
+ $Ampfull*sin(2*$pi/$Pwidth*$i*$deltaT) +
+ $AmpHO*sin(2*$pi/$HOper*$i*$deltaT);
+
+ $Pulse[$i] = $Amp*exp($PulsedB[$i]/20*2.3025851);
+ $psum += $Pulse[$i]; # used to get DC value
+
+ # printf(" %4d %g %g\n",$i,$PulsedB[$i],$Pulse[$i]);
+
+}
+
+$pave = $psum/$noPoints;
+
+# printf("DC Value = %g\n",$pave);
+
+
+# Make PDL from waveform:
+my $data = new PDL( \@Pulse);
+
+
+# setup matrix contains functions to fit
+for ($i=0; $i<$noPoints; $i++) {
+
+$functions[0][$i] = $pave;
+$functions[1][$i] = $i;
+$functions[2][$i] = sin($pi*$i/($noPoints-1));
+$functions[3][$i] = sin(2*$pi*$i/($noPoints-1));
+
+}
+
+my $fitFuncs = new PDL( \@functions);
+
+($yfit, $coeffs) = linfit1d( $data, $fitFuncs);
+
+ at coefs = $coeffs->list;
+
+ok( $testNo++, tapprox( $coefs[0], $expectedCoefs[0]) &&
+ tapprox( $coefs[1], $expectedCoefs[1]) &&
+ tapprox( $coefs[2], $expectedCoefs[2]) &&
+ tapprox( $coefs[3], $expectedCoefs[3])
+ );
+
+
+sub tapprox {
+ my($a,$b) = @_;
+ my $c = abs($a-$b);
+ my $d = ref($c) ? $c->{PDL}->max : $c ; # don't do a make if were are dealing
+ # with a scalar
+ $d < 0.00001;
+}
+# Testing utility functions:
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
diff --git a/t/lut.t b/t/lut.t
new file mode 100644
index 0000000..c047eec
--- /dev/null
+++ b/t/lut.t
@@ -0,0 +1,40 @@
+# -*-perl-*-
+
+use strict;
+use Test;
+
+BEGIN {
+ plan tests => 8;
+}
+
+use PDL::LiteF;
+use PDL::Types;
+use PDL::Graphics::LUT;
+
+sub tapprox {
+ my($a,$b) = @_;
+ my $d = max( abs($a-$b) );
+ $d < 0.0001;
+}
+
+my @names = lut_names();
+ok( $#names > -1, 1 ); # 1
+
+my @cols = lut_data( $names[0] );
+ok( $#cols, 3 ); # 2
+ok( $cols[0]->nelem, $cols[1]->nelem ); # 3
+ok( $cols[2]->get_datatype, $PDL_F ); # 4
+
+# check we can reverse things
+my @cols2 = lut_data( $names[0], 1 );
+ok( tapprox($cols[3]->slice('-1:0'),$cols2[3]), 1 ); # 5
+
+# check we know about the intensity ramps
+my @ramps = lut_ramps();
+ok( $#ramps > -1, 1 ); # 6
+
+# load in a different intensity ramp
+my @cols3 = lut_data( $names[0], 0, $ramps[0] );
+ok( $cols3[0]->nelem, $cols3[1]->nelem ); # 7
+ok( tapprox($cols[1],$cols3[1]), 1 ); # 8
+
diff --git a/t/lvalue.t b/t/lvalue.t
new file mode 100644
index 0000000..5de5745
--- /dev/null
+++ b/t/lvalue.t
@@ -0,0 +1,28 @@
+use strict;
+use English;
+
+use Test;
+
+use PDL::LiteF;
+use PDL::Lvalue;
+
+BEGIN {
+ if ( PDL::Lvalue->subs and !$PERLDB) {
+ plan tests => 3;
+ } else {
+ plan tests => 1;
+ print "ok 1 # Skipped: no lvalue sub support\n";
+ exit;
+ }
+}
+
+$| = 1;
+
+ok (PDL::Lvalue->subs('slice'));
+
+$a = sequence 10;
+eval '$a->slice("") .= 0';
+
+ok (!$@);
+
+ok ($a->max, 0);
diff --git a/t/magic.t b/t/magic.t
new file mode 100644
index 0000000..7933394
--- /dev/null
+++ b/t/magic.t
@@ -0,0 +1,58 @@
+# Test the dataflow magic & binding stuff
+# XXX DISABLED!
+
+use PDL::LiteF;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+print "1..1\n";
+
+ok(1,1);
+
+if (0) {
+
+print "1..6\n";
+
+$ind=1;
+
+$a = pdl 2,3,4;
+$a->doflow();
+
+$b = $a + 1;
+
+$c = $b * 2;
+
+ at cl = (-1,-1,-1);
+
+$c->bind(sub{ @cl = $c->list() });
+
+ok($ind++, ((join ',', at cl) eq "-1,-1,-1"));
+
+$a->set(0,5);
+
+ok($ind++, ((join ',', at cl) eq "-1,-1,-1"));
+
+$a->set(1,6);
+
+ok($ind++, ((join ',', at cl) eq "-1,-1,-1"));
+
+PDL::dowhenidle();
+
+ok($ind++, ((join ',', at cl) eq "12,14,10"));
+
+$a->set(2,7);
+
+ok($ind++, ((join ',', at cl) eq "12,14,10"));
+
+PDL::dowhenidle();
+
+ok($ind++, ((join ',', at cl) eq "12,14,16"));
+
+}
diff --git a/t/matmult.t b/t/matmult.t
new file mode 100644
index 0000000..4b907a9
--- /dev/null
+++ b/t/matmult.t
@@ -0,0 +1,51 @@
+use PDL::LiteF;
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless($result);
+ print "ok $no\n" ;
+}
+
+sub tapprox {
+ my($a,$b) = @_;
+ $c = abs($a-$b);
+ $d = max($c);
+ $d < 0.01;
+}
+
+print "1..5\n";
+
+$a = pdl [[ 1, 2, 3, 0],
+ [ 1, -1, 2, 7],
+ [ 1, 0, 0, 1]];
+
+$b = pdl [[1, 1],
+ [0, 2],
+ [0, 2],
+ [1, 1]];
+
+$c = pdl [[ 1, 11],
+ [ 8, 10],
+ [ 2, 2]];
+
+$res = $a x $b;
+
+ok(1,tapprox($c,$res));
+
+$eq = float [[1,1,1,1]]; # a 4,1-matrix ( 1 1 1 1 )
+
+# Check collapse: output should be a 1x2...
+ok(2,tapprox($eq x $b , pdl([[2,6]]) )); # ([4x1] x [2x4] -> [1x2])
+
+# Check dimensional exception: mismatched dims should throw an error
+eval '$z = $b x $eq'; # [2x4] x [4x1] --> error (2 != 1)
+ok(3, $@ ne "");
+
+# Check automatic scalar multiplication
+eval '$z = $b x 2;';
+
+ok(4, !$@ && tapprox($z,$b * 2));
+
+eval '$z = pdl(3) x $b;';
+ok(5, !$@ && tapprox($z,$b * 3));
diff --git a/t/matrix.t b/t/matrix.t
new file mode 100644
index 0000000..8db796f
--- /dev/null
+++ b/t/matrix.t
@@ -0,0 +1,15 @@
+use PDL::LiteF;
+use Test;
+
+BEGIN {
+ plan tests => 2;
+}
+
+use PDL::Matrix;
+my $m = mpdl([[1,2,1],[2,0,3],[1,1,1]]); # matrix with determinant 1
+
+my $tol = $^O =~ /win32/i ? 1e-6 : 1e-15;
+print "determinant: ",$m->det,"\n";
+ok abs($m->det - 1) < $tol ;
+ok abs($m->determinant - 1) < 1e-15;
+
diff --git a/t/matrixops.t b/t/matrixops.t
new file mode 100644
index 0000000..09b9ae0
--- /dev/null
+++ b/t/matrixops.t
@@ -0,0 +1,185 @@
+use PDL::LiteF;
+use Test;
+use Config;
+# sub ok {
+# my $no = shift;
+# my $result = shift;
+# print "not " unless $result;
+# print "ok $no\n";
+# }
+
+sub near {
+ my($a,$b,$tol) = @_;
+ $tol = 1e-14 unless defined $tol;
+ my $dist = abs($a - $b);
+ print STDERR "Max dist: ".$dist->max."\n" if any ($dist > $tol);
+ return ($dist <= $tol)->all;
+}
+
+BEGIN { plan tests => 30,
+}
+
+my $tol = 1e-14;
+
+eval 'use PDL::MatrixOps;';
+ok(!$@);
+
+
+### Check LU decomposition of a simple matrix
+
+$a = pdl([1,2,3],[4,5,6],[7,1,1]);
+eval '($lu,$perm,$par) = lu_decomp($a)';
+
+ok(!$@); # ran OK
+ok($par==-1); # parity is right
+ok(all($perm == pdl(2,1,0))); # permutation is right
+
+$l = $lu->copy;
+my $ldiag;
+($ldiag = $l->diagonal(0,1)) .= 1;
+my $tmp;
+($tmp = $l->slice("2,1")) .= 0;
+($tmp = $l->slice("1:2,0")) .= 0;
+
+$u = $lu->copy;
+($tmp = $u->slice("1,2")) .= 0;
+($tmp = $u->slice("0,1:2")) .= 0;
+
+ok(near($a,matmult($l,$u)->slice(":,-1:0"),$tol)); # LU = A (after depermutation)
+
+### Check LU decomposition of an OK singular matrix
+
+$b = pdl([1,2,3],[4,5,6],[7,8,9]);
+($lu,$perm,$par) = lu_decomp($b);
+
+ok(defined $lu);
+ok($lu->flat->abs->at(-1) < $tol);
+
+### Check inversion -- this also checks lu_backsub
+
+$a1 = inv($a,$opt={s=>1,lu=>\@a});
+$identity = zeroes(3,3); ($tmp = $identity->diagonal(0,1))++;
+
+ok(defined $a1);
+ok(ref ($opt->{lu}->[0]) eq 'PDL');
+ok(near(matmult($a1,$a),$identity,$tol));
+
+
+### Check inv() for matrices with added thread dims (bug #3172882 on sf.net)
+$a94 = pdl( [ 1, 0, 4, -1, -1, -3, 0, 1, 0 ],
+ [ 4, -4, -5, 1, -5, -3, -1, -2, 0 ],
+ [ -2, 2, -5, -1, 1, -3, -4, 3, -4 ],
+ [ -1, 4, -4, 2, 1, 3, -3, -4, -3 ],
+ );
+$a334 = $a94->reshape(3,3,4);
+eval '$a334inv = $a334->inv';
+
+ok(!$@); # ran OK
+ok(near(matmult($a334,$a334inv),$identity->dummy(2,4))); # right answer
+
+undef $a94; # clean up variables
+undef $a334; # clean up variables
+undef $a334inv; # clean up variables
+
+
+
+### Check LU backsubstitution (bug #2023711 on sf.net)
+
+
+$a = pdl([[2,1],[1,2]]);
+eval '($lu,$perm,$par) = lu_decomp($a)';
+
+ok(!$@); # ran OK
+ok($par==1); # parity is right
+ok(all($perm == pdl(0,1))); # permutation is right
+
+$bb = pdl([1,0]);
+eval '$xx = lu_backsub($lu,$perm,$bb)';
+ok(!$@); # ran OK
+my $xx_shape = pdl($xx->dims);
+my $bb_shape = pdl($bb->dims);
+ok(all($xx_shape == $bb_shape)); # check that soln and input have same shape
+ok(near($xx,pdl([2/3, -1/3]),$tol)); # LU = A (after depermutation)
+
+
+### Check attempted inversion of a singular matrix
+$b2=undef; # avoid warning from compiler
+eval '$b2 = inv($b,{s=>1})';
+ok(!$@);
+ok(!defined $b2);
+
+
+### Check threaded determinant -- simultaneous recursive det of four 4x4's
+$a = pdl([3,4,5,6],[6,7,8,9],[9,0,7,6],[4,3,2,0]); # det=48
+$b = pdl([1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]); # det=1
+$c = pdl([0,1,0,0],[1,0,0,0],[0,0,1,0],[0,0,0,1]); # det=-1
+$d = pdl([1,2,3,4],[5,4,3,2],[0,0,3,0],[3,0,1,6]); # det=-216
+$e = ($a->cat($b)) -> cat( $c->cat($d) );
+$det = $e->determinant;
+ok(all($det == pdl([48,1],[-1,-216])));
+
+### Check identity and stretcher matrices...
+ok((identity(2)->flat == pdl(1,0,0,1))->all);
+
+ok((stretcher(pdl(2,3))->flat == pdl(2,0,0,3))->all);
+
+ok((stretcher(pdl([2,3],[3,4]))->flat == pdl(2,0,0,3,3,0,0,4))->all);
+
+### Check eigens
+$a = pdl([3,4],[4,-3]);
+
+### Check that eigens runs OK
+eval {($vec,$val) = eigens $a};
+ok(!$@);
+
+### Check that it really returns eigenvectors
+$c = float(($a x $vec) / $vec);
+print "c is $c\n";
+ok(all($c->slice(":,0") == $c->slice(":,1")));
+
+### Check that the eigenvalues are correct for this matrix
+ok((float($val->slice("0")) == - float($val->slice("1")) and
+ float($val->slice("0") * $val->slice("1")) == float(-25)));
+
+### Check computations on larger matrix with known eigenvalue sum.
+my $m = pdl(
+ [ 1.638, 2.153, 1.482, 1.695, -0.557, -2.443, -0.71, 1.983],
+ [ 2.153, 3.596, 2.461, 2.436, -0.591, -3.711, -0.493, 2.434],
+ [ 1.482, 2.461, 2.5, 2.834, -0.665, -2.621, 0.248, 1.738],
+ [ 1.695, 2.436, 2.834, 4.704, -0.629, -2.913, 0.576, 2.471],
+ [-0.557, -0.591, -0.665, -0.629, 19, 0.896, 8.622, -0.254],
+ [-2.443, -3.711, -2.621, -2.913, 0.896, 5.856, 1.357, -2.915],
+ [ -0.71, -0.493, 0.248, 0.576, 8.622, 1.357, 20.8, -0.622],
+ [ 1.983, 2.434, 1.738, 2.471, -0.254, -2.915, -0.622, 3.214]);
+
+my $esum=0;
+eval {
+ ($vec,$val) = eigens($m);
+ $esum=sprintf "%.3f", sum($val); #signature of eigenvalues
+};
+#print STDERR "eigensum for the 8x8: $esum\n";
+ok($esum == 61.308);
+
+if(0){ #fails because of bad eigenvectors
+#Check an assymmetric matrix:
+$a = pdl ([4,-1], [2,1]);
+eval {
+ ($vec,$val) = eigens $a;
+ $esum=sprintf "%.3f", sum($val);
+};
+ok(!$@);
+ok($esum == 5);
+}
+
+$esum=0;
+eval {
+ $esum = sprintf "%.3f", sum scalar eigens_sym($m);
+};
+ok(!$@);
+ok($esum == 61.308);
+
+if(0){ #eigens for asymmetric matrices disbled
+#The below matrix has complex eigenvalues
+my $should_be_nan = eval { sum(scalar eigens(pdl([1,1],[-1,1]))) };
+ok( ! ($should_be_nan == $should_be_nan)); #only NaN is not equal to itself
+}
diff --git a/t/minuit.t b/t/minuit.t
new file mode 100644
index 0000000..1fef120
--- /dev/null
+++ b/t/minuit.t
@@ -0,0 +1,78 @@
+
+use PDL;
+use PDL::Config;
+use Test::More;
+
+BEGIN{
+ unless ($PDL::Config{WITH_MINUIT}) {
+ plan skip_all => 'PDL not built WITH_MINUIT';
+ exit;
+ }
+ eval " use PDL::Minuit; ";
+ unless ($@){
+ plan tests => 5;
+ }
+ else {
+ diag "$@\n";
+ plan skip_all => 'PDL::Minuit not available';
+ exit;
+ }
+}
+
+use File::Temp qw( tempfile tempdir );
+my $tempd = tempdir( CLEANUP => 1 ) or die "Couldn't get tempdir\n";
+
+require File::Spec;
+my $logfile = File::Spec->catfile($tempd, 'minuit.log.' . $$);
+
+END {
+ unlink $logfile if defined $logfile and -e $logfile;
+}
+
+$x = sequence(10);
+$y = 3.0 + 4.0*$x;
+
+mn_init(\&chi2,
+ {Log => $logfile,
+ Title => 'test title'});
+
+$pars = pdl(2.5,3.0);
+$steps = pdl(0.3,0.5);
+ at names = ('intercept','slope');
+
+mn_def_pars($pars,
+ $steps,
+ {Names => \@names});
+
+$arglis = pdl (3.0);
+
+$iflag = mn_excm('set pri',$arglis);
+ok($iflag == 0);
+
+$iflag = mn_excm('migrad');
+ok($iflag == 0);
+
+$iflag = mn_excm('minos');
+ok($iflag == 0);
+
+
+$emat = mn_emat();
+my $emat_test = pdl [[0.34545455, -0.054545455], [-0.054545455, 0.012121212]];
+my $diff = ((($emat - $emat_test)**2)->sum);
+ok($diff < 1e-6);
+
+ at temp = mn_pout(1);
+ok(($temp[0]-3) < 1e-6);
+
+ at test = mn_err(1);
+
+ at test = mn_stat();
+
+sub chi2{
+ my ($npar,$grad,$fval,$xval,$iflag) = @_;
+ if($iflag == 4){
+ $fval = (($y - $xval->slice(0) - $xval->slice(1)*$x)**2)->sumover;
+ }
+ return ($fval,$grad);
+}
+
diff --git a/t/misc.t b/t/misc.t
new file mode 100644
index 0000000..5b1342e
--- /dev/null
+++ b/t/misc.t
@@ -0,0 +1,209 @@
+
+# Test routine for PDL::IO::Misc module
+
+use strict;
+
+use PDL::LiteF;
+use PDL::IO::Misc;
+
+use PDL::Core ':Internal'; # For howbig()
+use PDL::Config;
+
+use File::Temp qw( tempfile tempdir );
+
+kill 'INT',$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+use Test::More tests => 19;
+
+sub tapprox {
+ my($a,$b) = @_;
+ my $c = abs($a-$b);
+ my $d = max($c);
+ $d < 0.0001;
+}
+
+my $tempd = tempdir( CLEANUP => 1 ) or die "Couldn't get tempdir\n";
+my ($fileh,$file) = tempfile( DIR => $tempd );
+
+############# Test rcols with colsep and missing fields ###################
+
+print $fileh <<EOD;
+1,6,11
+2,7,
+3,8,13
+4,,14
+5,10,15
+EOD
+close($fileh);
+
+{
+ local $PDL::undefval = -1;
+ $a = rcols $file, [], { colsep=>',' };
+}
+
+is( (sum($a<0)==2 && $a->getdim(0)==5 && $a->getdim(1)==3), 1, "rcols with undefval and missing cols" );
+unlink $file;
+
+############# Test rcols with filename and pattern #############
+
+($fileh,$file) = tempfile( DIR => $tempd );
+print $fileh <<EOD;
+1 2
+2 33 FOO
+3 7
+4 9 FOO
+5 66
+EOD
+close($fileh);
+
+($a,$b) = rcols $file,0,1;
+$a = long($a); $b=long($b);
+
+is( (sum($a)==15 && max($b)==66 && $b->getdim(0)==5), 1, "rcols with filename" );
+
+($a,$b) = rcols $file, "/FOO/",0,1;
+$a = long($a);
+$b=long($b);
+
+is( (sum($a)==6 && max($b)==33 && $b->getdim(0)==2), 1, "rcols with filename + pattern" );
+
+############# Test rcols with file handle with nothing left #############
+
+open my $fh, '<', $file;
+# Pull in everything:
+my @slurp = <$fh>;
+# Now apply rcols:
+$@ = '';
+$a = eval { rcols $fh };
+is($@, '', 'rcols does not die on a used file handle');
+close $fh;
+
+############### Test rgrep with FILEHANDLE #####################
+
+($fileh,$file) = tempfile( DIR => $tempd );
+print $fileh <<EOD;
+foo"1" -2-
+foo"2" Test -33-
+foo"3" jvjtvbjktrbv -7-
+foo"4" -9-
+fjrhfiurhe foo"5" jjjj -66-
+EOD
+close($fileh);
+
+open(OUT, $file) || die "Can not open $file for reading\n";
+($a,$b) = rgrep {/foo"(.*)".*-(.*)-/} *OUT;
+$a = long($a); $b=long($b);
+close(OUT);
+
+is( (sum($a)==15 && max($b)==66 && $b->getdim(0)==5), 1, "rgrep" );
+
+########### Explicit test of byte swapping #################
+
+$a = short(3); $b = long(3); # $c=long([3,3]);
+bswap2($a); bswap4($b);
+is(sum($a)==768 && sum($b)==50331648,1,"bswap2");
+
+############# Test rasc #############
+
+($fileh,$file) = tempfile( DIR => $tempd );
+print $fileh <<EOD;
+0.231862613
+0.20324005
+0.067813045
+0.040103501
+0.438047631
+0.283293628
+0.375427346
+0.195821617
+0.189897617
+0.035941205
+0.339051483
+0.096540854
+0.25047197
+0.579782013
+0.236164184
+0.221568561
+0.009776015
+0.290377604
+0.785569601
+0.260724391
+
+EOD
+close($fileh);
+
+$a = PDL->null;
+$a->rasc($file,20);
+is( abs($a->sum - 5.13147) < .01, 1, "rasc on null piddle" );
+
+$b = zeroes(float,20,2);
+$b->rasc($file);
+is( abs($b->sum - 5.13147) < .01, 1, "rasc on existing piddle" );
+
+eval '$b->rasc("file_that_does_not_exist")';
+like( $@, qr/Can't open/, "rasc on non-existant file" );
+
+unlink $file; # clean up
+
+#######################################################
+# Tests of rcols() options
+# EXCLUDE/INCLUDE/LINES/DEFTYPE/TYPES
+
+($fileh,$file) = tempfile( DIR => $tempd );
+print $fileh <<EOD;
+1 2
+# comment line
+3 4
+-5 6
+7 8
+EOD
+close($fileh);
+
+($a,$b) = rcols $file,0,1;
+is( $a->nelem==4 && sum($a)==6 && sum($b)==20, 1,
+ "rcols: default" );
+
+($a,$b) = rcols \*DATA,0,1;
+is( $a->nelem==4 && sum($a)==6 && sum($b)==20, 1,
+ "rcols: pipe" );
+
+($a,$b) = rcols $file,0,1, { INCLUDE => '/^-/' };
+is( $a->nelem==1 && $a->at(0)==-5 && $b->at(0)==6, 1,
+ "rcols: include pattern" );
+
+($a,$b) = rcols $file,0,1, { LINES => '-2:0' };
+is( $a->nelem==3 && tapprox($a,pdl(-5,3,1)) && tapprox($b,pdl(6,4,2)), 1,
+ "rcols: lines option" );
+
+use PDL::Types;
+($a,$b) = rcols $file, { DEFTYPE => long };
+is( $a->nelem==4 && $a->get_datatype==$PDL_L && $b->get_datatype==$PDL_L, 1,
+ "rcols: deftype option" );
+
+($a,$b) = rcols $file, { TYPES => [ ushort ] };
+is( $a->nelem==4 && $a->get_datatype==$PDL_US && $b->get_datatype==$PDL_D, 1,
+ "rcols: types option" );
+
+is( UNIVERSAL::isa($PDL::IO::Misc::deftype,"PDL::Type"), 1,
+ "PDL::IO::Misc::deftype is a PDL::Type object" );
+is( $PDL::IO::Misc::deftype->[0], double->[0],
+ "PDL::IO::Misc::deftype check" );
+
+$PDL::IO::Misc::deftype = short;
+($a,$b) = rcols $file;
+is( $a->get_datatype, short->[0], "rcols: can read in as 'short'" );
+
+unlink $file;
+
+($fileh,$file) = tempfile( DIR => $tempd );
+eval { wcols $a, $b, $fileh };
+is(!$@,1, "wcols" );
+unlink $fileh;
+
+1;
+
+__DATA__
+1 2
+# comment line
+3 4
+-5 6
+7 8
diff --git a/t/niceslice.t b/t/niceslice.t
new file mode 100644
index 0000000..1ebe6af
--- /dev/null
+++ b/t/niceslice.t
@@ -0,0 +1,224 @@
+use strict;
+use Test;
+
+use PDL::LiteF;
+
+BEGIN {
+ eval 'require PDL::NiceSlice';
+ unless ($@) {
+ plan tests => 44,
+ # todo => [37..40],
+ } else {
+ plan tests => 1;
+ print "ok 1 # Skipped: no sourcefilter support\n";
+ exit;
+ }
+}
+
+$| = 1;
+sub PDL::NiceSlice::findslice;
+sub translate_and_show {
+ my ($txt) = @_;
+ my $etxt = PDL::NiceSlice::findslice $txt;
+ print "$txt -> \n\t$etxt\n";
+ return $etxt;
+}
+
+
+ok (!$@);
+
+my $a = sequence 10; # shut up -w
+my $b = pdl(1);
+eval translate_and_show '$b = $a((5));';
+
+ok (!$@);
+ok($b->at == 5);
+
+eval translate_and_show '$b = $a->((5));';
+ok (!$@);
+ok($b->at == 5);
+
+my $c = PDL->pdl(7,6);
+eval translate_and_show '$b = $a(($c(1)->at(0)));';
+ok (!$@);
+ok($b->getndims == 0 && all $b == 6);
+
+# the latest versions should do the 'at' automatically
+eval translate_and_show '$b = $a(($c(1)));';
+ok (!$@);
+print "ERROR is $@\n" if($@);
+ok($b->getndims == 0 && all $b == 6);
+
+eval translate_and_show '$c = $a(:);';
+ok (!$@);
+print $@ if $@;
+ok ($c->getdim(0) == 10 && all $c == $a);
+
+my $idx = pdl 1,4,5;
+
+eval translate_and_show '$b = $a($idx);';
+ok (!$@);
+ok(all $b == $idx);
+
+# use 1-el piddles as indices
+my $rg = pdl(2,7,2);
+my $cmp = pdl(2,4,6);
+eval translate_and_show '$b = $a($rg(0):$rg(1):$rg(2));';
+ok (!$@);
+ok(all $b == $cmp);
+
+# mix ranges and index piddles
+my $twod = sequence 5,5;
+$idx = pdl 2,3,0;
+$cmp = $twod->slice('-1:0')->dice_axis(1,$idx);
+eval translate_and_show '$b = $twod(-1:0,$idx);';
+ok (!$@);
+ok(all $b == $cmp);
+
+#
+# modifiers
+#
+
+$a = sequence 10;
+eval translate_and_show '$b = $a($a<3;?)' ;
+ok (!$@);
+ok(all $b == pdl(0,1,2));
+
+# flat modifier
+$a = sequence 3,3;
+eval translate_and_show '$b = $a(0:-2;_);';
+ok (!$@);
+ok(all $b == sequence 8);
+
+# where modifier cannot be mixed with other modifiers
+$a = sequence 10;
+eval { translate_and_show '$b = $a($a<3;?_)' };
+ok ($@ =~ 'more than 1');
+
+# more than one identifier
+$a = sequence 3,3;
+eval translate_and_show '$b = $a(0;-|)';
+print "Error was: $@\n" if $@;
+ok (!$@);
+eval {$b++};
+print "\$b = $b\n";
+ok($b->dim(0) == 3 && all $b == 3*sequence(3)+1);
+ok($a->at(0,0) == 0);
+
+# do we ignore whitspace correctly?
+eval translate_and_show '$c = $a(0; - | )';
+print "Error was: $@\n" if $@;
+ok (!$@);
+ok (all $c == $b-1);
+
+# empty modifier block
+$a = sequence 10;
+eval translate_and_show '$b = $a(0; )';
+ok (!$@);
+ok ($b == $a->at(0));
+
+# modifiers repeated
+eval 'translate_and_show "\$b = \$a(0;-||)"';
+print "Error was: $@\n" if $@;
+ok ($@ =~ 'twice or more');
+
+# foreach/for blocking
+
+$a = '';
+eval translate_and_show "foreach \n" . ' $b(1,2,3,4) {$a .= $b;}';
+ok(!$@ and $a eq '1234');
+
+$a = '';
+eval translate_and_show 'for $b(1,2,3,4) {$a .= $b;}';
+ok(!$@ and $a eq '1234');
+
+$a = '';
+eval translate_and_show 'for my $b(1,2,3,4) {$a .= $b;}';
+ok(!$@ and $a eq '1234');
+
+$a = '';
+eval translate_and_show 'for our $b(1,2,3,4) {$a .= $b;}';
+ok(!$@ and $a eq '1234');
+
+$a = ''; # foreach and whitespace
+eval translate_and_show 'foreach my $b (1,2,3,4) {$a .= $b;}';
+ok(!$@ and $a eq '1234');
+
+$a = ''; my $t = ones 10; # foreach and imbedded expression
+eval translate_and_show 'foreach my $type ( $t(0)->list ) { $a .= $type }';
+ok(!$@ and $a eq '1');
+
+# block method access translation
+
+$a = pdl(5,3,2);
+my $method = 'dim';
+eval translate_and_show '$c = $a->$method(0)';
+print "c: $c\n";
+ok(!$@ && $c == $a->dim(0));
+
+#
+# todo ones
+#
+
+# whitespace tolerance
+
+$a= sequence 10;
+eval translate_and_show '$c = $a (0)';
+ok(!$@ && $c == $a->at(0));
+
+# comment tolerance
+
+eval translate_and_show << 'EOT';
+
+$c = $a-> # comment
+ (0);
+EOT
+
+ok(!$@ && $c == $a->at(0));
+
+eval translate_and_show << 'EOT';
+
+$c = $a-> # comment
+ # comment line 2
+ (0);
+EOT
+
+ok(!$@ && $c == $a->at(0));
+
+$a = ''; # foreach and whitespace + comments
+eval translate_and_show << 'EOT';
+
+foreach my $b # a random comment thrown in
+
+(1,2,3,4) {$a .= $b;}
+
+EOT
+
+ok(!$@ and $a eq '1234');
+
+# test for correct header propagation
+$a = ones(10,10);
+my $h = {NAXIS=>2,
+ NAXIS1=>100,
+ NAXIS=>100,
+ COMMENT=>"Sample FITS-style header"};
+$a->sethdr($h);
+$a->hdrcpy(1);
+eval translate_and_show '$b = $a(1:2,pdl(0,2));';
+
+# Old hdrcpy test (for copy-by-reference); this is obsolete
+# with quasi-deep copying. --CED 11-Apr-2003
+# ok (!$@ and $b->gethdr() == $h);
+if ( ok(!$@) ) {
+ my %bh = %{$b->gethdr};
+ my (@bhkeys) = sort keys %bh;
+ my %hh = %{$h};
+ my (@hhkeys) = sort keys %hh;
+ ok(join("", at bh{@bhkeys}) eq join("", at hh{@hhkeys}));
+}
+
+$a = ones(10);
+my $i = which $a < 0;
+my $ai;
+eval translate_and_show '$ai = $a($i);';
+ok(isempty $ai );
diff --git a/t/nsdatahandle.t b/t/nsdatahandle.t
new file mode 100644
index 0000000..d9d57ad
--- /dev/null
+++ b/t/nsdatahandle.t
@@ -0,0 +1,19 @@
+use strict;
+use Test;
+
+
+# check if PDL::NiceSlice clobbers the DATA filehandle
+use PDL::LiteF;
+
+plan tests => 1;
+
+$| = 1;
+
+use PDL::NiceSlice;
+
+my $data = join '', <DATA>;
+ok $data =~ "we've got data";
+
+__DATA__
+
+we've got data
diff --git a/t/ones.t b/t/ones.t
new file mode 100644
index 0000000..e5f8732
--- /dev/null
+++ b/t/ones.t
@@ -0,0 +1,31 @@
+# Test other such primitives also
+
+use PDL::LiteF;
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+# sub tapprox {
+# my($a,$b) = @_;
+# $c = abs($a-$b);
+# $d = max($c);
+# $d < 0.01;
+# }
+
+print "1..4\n";
+
+$b = double ones(2,3);
+
+$ind=1;
+
+
+ok($ind++,($b->dims)[0] == 2);
+ok($ind++,($b->dims)[1] == 3);
+print $b;
+ok($ind++,($b->at(1,1)) == 1);
+ok($ind++,($b->at(1,2)) == 1);
diff --git a/t/opengl.t b/t/opengl.t
new file mode 100644
index 0000000..4abd242
--- /dev/null
+++ b/t/opengl.t
@@ -0,0 +1,69 @@
+# -*-perl-*-
+BEGIN{
+ # Set perl to not try to resolve all symbols at startup
+ # The default behavior causes some problems because
+ # opengl.pd builds an interface for all functions
+ # defined in gl.h and glu.h even though they might not
+ # actually be in the opengl libraries.
+ $ENV{'PERL_DL_NONLAZY'}=0;
+}
+
+# use PDL::Graphics::OpenGL;
+
+sub hasDISPLAY {
+ return defined $ENV{DISPLAY} && $ENV{DISPLAY} !~ /^\s*$/;
+}
+
+use Test::More;
+
+BEGIN {
+ use PDL::Config;
+ if ( $PDL::Config{WITH_3D} ) { # check if compiled
+ if ( $PDL::Config{USE_POGL} ) { # check if using Perl OpenGL
+ if ( hasDISPLAY or exists($ENV{'PDL_INT'}) ) {
+ plan tests => 4;
+ use_ok("OpenGL $PDL::Config{POGL_VERSION}", qw(:all));
+ use_ok('PDL::Graphics::OpenGL::Perl::OpenGL');
+ } else { # no DISPLAY
+ plan tests => 2;
+ use_ok("OpenGL $PDL::Config{POGL_VERSION}", qw(:all));
+ use_ok('PDL::Graphics::OpenGL::Perl::OpenGL');
+ exit;
+ }
+ } else {
+ plan skip_all => 'Non-POGL TriD graphics not supported';
+ }
+ } else {
+ plan skip_all => 'TriD graphics not compiled';
+ }
+}
+
+#
+# Try opening 2 GL windows
+#
+
+SKIP: {
+
+ if ( hasDISPLAY and OpenGL::_have_glx ) {
+ eval { OpenGL::glpDisplay($ENV{DISPLAY}) };
+ skip "can't open X display", 2 if $@;
+ }
+
+ my $numwins = 2;
+ my @windows;
+ my $opt;
+ $opt->{width} = 90;
+ $opt->{height} = 90;
+
+ foreach(0..$numwins-1){
+ $opt->{x} = ($numwins % 10) *100;
+ $opt->{y} = int($numwins / 10) *100;
+ my $win=eval 'PDL::Graphics::OpenGL::OO->new($opt)';
+ if (! defined($win) ) {
+ skip "$@", 2 if $@ =~ /display mode not possible/;
+ } else {
+ isa_ok($win, 'PDL::Graphics::OpenGL::OO');
+ }
+ push @windows, $win;
+ }
+}
diff --git a/t/ops.t b/t/ops.t
new file mode 100644
index 0000000..95084a8
--- /dev/null
+++ b/t/ops.t
@@ -0,0 +1,158 @@
+use PDL::LiteF;
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+sub tapprox {
+ my($a,$b,$c,$d) = @_;
+ $c = abs($a-$b);
+ $d = max($c);
+ return $d < 0.01;
+}
+
+print "1..43\n";
+
+# $a0 = zeroes 3,5;
+# $b0 = xvals $a0;
+
+$a = xvals zeroes 3,5;
+
+$b = yvals zeroes 3,5;
+
+$c = $a + $b;
+
+ok(1,$c->at(2,2) == 4);
+ok(2,$c->at(2,3) == 5);
+eval '$c->at(3,3)';
+ok(3,$@ =~ /Position out of range/);
+
+$d = pdl 5,6;
+
+$e = $d - 1;
+ok(4,$e->at(0) == 4);
+ok(5,$e->at(1) == 5);
+$f = 1 - $d;
+ok(6,$f->at(0) == -4);
+ok(7,$f->at(1) == -5);
+
+# Now, test one operator from each group
+# biop1 tested already
+
+$a = pdl 0,1,2;
+$b = pdl 1.5;
+
+$c = $a > $b;
+
+ok(8,$c->at(1) == 0);
+ok(9,$c->at(2) == 1);
+
+$a = byte pdl 0,1,3;
+$c = $a << 2;
+
+ok(10,$c->at(0) == 0);
+ok(11,$c->at(1) == 4);
+ok(12,$c->at(2) == 12);
+
+
+$a = pdl 16,64,9;
+$b = sqrt($a);
+
+ok(13,tapprox($b,(pdl 4,8,3)));
+
+# See that a is unchanged.
+
+ok(14,$a->at(0) == 16);
+
+$a = pdl 1,0;
+$b = ! $a;
+ok(15,$b->at(0) == 0);
+ok(16,$b->at(1) == 1);
+
+$a = pdl 12,13,14,15,16,17;
+$b = $a % 3;
+
+ok(17,$b->at(0) == 0);
+ok(18,$b->at(1) == 1);
+ok(19,$b->at(3) == 0);
+# [ More modulus testing farther down! ]
+
+# Might as well test this also
+
+ok(20,tapprox((pdl 2,3),(pdl 2,3)));
+ok(21,!tapprox((pdl 2,3),(pdl 2,4)));
+
+# Simple function tests
+
+$a = pdl(2,3);
+ok(22, tapprox(exp($a), pdl(7.3891,20.0855)));
+ok(23, tapprox(sqrt($a), pdl(1.4142, 1.7321)));
+
+# And and Or
+
+ok(24, tapprox(pdl(1,0,1) & pdl(1,1,0), pdl(1,0,0)));
+ok(25, tapprox(pdl(1,0,1) | pdl(1,1,0), pdl(1,1,1)));
+
+# atan2
+ok (26, tapprox(atan2(pdl(1,1), pdl(1,1)), ones(2) * atan2(1,1)));
+
+$a = sequence (3,4);
+$b = sequence (3,4) + 1;
+
+ok (27, tapprox($a->or2($b,0), $a | $b));
+ok (28, tapprox($a->and2($b,0), $a & $b));
+ok (29, tapprox($b->minus($a,0), $b - $a));
+ok (30, tapprox($b - $a, ones(3,4)));
+
+# inplace tests
+
+$a = pdl 1;
+$sq2 = sqrt 2; # perl sqrt
+$a->inplace->plus(1,0); # trailing 0 is ugly swap-flag
+ok(31, tapprox $a, pdl 2);
+$warning_shutup = $warning_shutup = sqrt $a->inplace;
+ok(32, tapprox $a, pdl($sq2));
+$a = pdl 4;
+ok(33, tapprox 2, sqrt($a->inplace));
+
+# log10 now uses C library
+# check using scalars and piddles
+$a = log10(110);
+$b = log(110) / log(10);
+print "a: $a [ref(\$a)='", ref($a),"']\n";
+print "b: $b\n";
+ok(34, abs($a-$b) < 1.0e-5 );
+$a = log10(pdl(110,23));
+$b = log(pdl(110,23)) / log(10);
+print "a: $a\n";
+print "b: $b\n";
+ok(35, tapprox $a, $b );
+
+# check inplace
+ok(36, tapprox pdl(110,23)->inplace->log10(), $b );
+$data = ones 5;
+$data &= 0;
+ok(37, all $data == 0);
+$data |= 1;
+ok(38, all $data == 1);
+
+ok(39, all $data eq $data); # check eq operator
+
+
+# check proper modulus...
+$a = xvals(15)-7;
+$b = $a % 3;
+ok(40,sum($b != pdl(2,0,1,2,0,1,2,0,1,2,0,1,2,0,1)) == 0);
+$b = $a % -3;
+ok(41,sum($b != pdl(-1,0,-2,-1,0,-2,-1,0,-2,-1,0,-2,-1,0,-2))==0);
+$b = $a % 0;
+ok(42,sum($b != 0) == 0);
+#check that modulus works on PDL_Index types correctly
+$b = $a->qsorti;
+$c = $b % 3;
+ok(43,all($c->double==pdl("0 1 2 " x 5)));
+
diff --git a/t/pdl_from_string.t b/t/pdl_from_string.t
new file mode 100644
index 0000000..0d9e450
--- /dev/null
+++ b/t/pdl_from_string.t
@@ -0,0 +1,569 @@
+#!/usr/bin/perl
+#
+# This tests the new PDL constructor with a string argument.
+# There are three goals from the new functionality: (1) to allow
+# MATLAB to use familiar syntax to create arrays, (2) to allow
+# cut-n-paste of PDL print output as input for scripts and programs,
+# and (3) to allow easy ways to construct nan and inf values in piddles.
+#
+
+use Test::More tests => 113;
+use strict;
+use warnings;
+use Config;
+
+#############################
+# Loading and ISA tests - 2 #
+#############################
+
+BEGIN {
+ # if we've got this far in the tests then
+ # we can probably assume PDL::LiteF works!
+ #
+ use_ok( "PDL::LiteF" );
+}
+
+isa_ok( pdl("[1,2]"), "PDL", qq{pdl("[1,2]") returns a piddle} );
+
+###################
+# Basic Tests - 8 #
+###################
+
+ok( all(pdl([1,2])==pdl("[1,2]")), qq{pdl(ARRAY REF) equals pdl("ARRAY REF")});
+
+my $compare = pdl([
+ [1, 0, 8],
+ [6, 3, 5],
+ [3, 0, 5],
+ [2, 4, 2]
+]);
+
+my $test_string = <<EOPDL;
+ [
+ [1, 0, 8],
+ [6, 3, 5],
+ [3, 0, 5],
+ [2, 4, 2],
+ ]
+EOPDL
+
+my $t1 = pdl $test_string;
+ok(all(approx($t1, $compare)), "properly interprets good PDL input string");
+
+# See what happens when we remove the end commas
+$test_string =~ s/\],/]/g;
+
+my $t2 = pdl $test_string;
+ok(all(approx($t2, $compare)), "properly interprets good PDL input string sans ending commas");
+
+my $t3 = pdl '[1, 0, 8; 6, 3, 5; 3, 0, 5; 2, 4, 2]';
+ok(all(approx($t3, $compare)), "properly handles semicolons");
+
+my $t4 = pdl "$compare";
+ok(all(approx($t4, $compare)), "properly interprets good PDL output string");
+
+my $expected = pdl(1.2e3);
+my $got = pdl q[1.2e3];
+is($got, $expected, "Correctly interprets [1.2e3]");
+
+$expected = pdl(1.2e3, 4, 5.6e-7);
+$got = pdl q[1.2e3 4 5.6e-7];
+ok(all($got == $expected), "Correclty interprets [1.2e3 4 5.6e-7]");
+
+$expected = pdl(1.2e3, 4, 5.e-7);
+$got = pdl q[1.2e3 4 5.e-7];
+ok(all($got == $expected), "Correclty interprets [1.2e3 4 5.e-7]");
+
+
+###########################
+# Signs and operators - 6 #
+###########################
+
+# This functionality does not with the parsed (as opposed to eval'd) method
+# for building the pdl-from-string. I'm commenting out the tests that will
+# fail.
+
+# Now some more interesting tests
+my $t5 = pdl "[1 -4]";
+$compare = pdl [1, -4];
+ok(all(approx($t5, $compare)), "properly identifies negative numbers with white-space separation");
+
+my $t6 = pdl "[1 - 4]";
+$compare = pdl [1,-4];
+ok(all(approx($t6, $compare)), "properly affixes negation operator to right operand");
+
+ok(all(approx(pdl("[1 - .4]"), pdl([1,-0.4]))), "properly handles decimals");
+
+my $t8 = pdl <<EOPDL;
+[
+ [1,2,3; 4,-5,6]
+ [7 +8, 8 + 9; 10, - .11, 12e3]
+]
+EOPDL
+
+$compare = pdl([[[1,2,3], [4,-5,6]],[[7,8,8,9],[10,-.11,12e3]]]);
+ok(all(approx($t8, $compare)), "properly handles all sorts of stuff!");
+
+$compare = pdl [1,2,-5];
+my $t9 = pdl '[1 + 2 - 5]';
+ok(all(approx($t9, $compare)), "Another operator check for pdl_from_string");
+
+$compare = pdl [1, 2, -5];
+my $t10 = pdl '[1 +2 -5]';
+ok(all(approx($t10, $compare)), "Yet another operator check for pdl_from_string");
+
+#######################################
+# Semicolons as column seperators - 2 #
+#######################################
+
+$compare = pdl [[1], [2], [3]];
+my $t11 = pdl '[1;2;3]';
+ok(all(approx($t11, $compare)), "column check");
+
+$compare = pdl([[1,2,3],[4,5,6]]);
+my $t12 = pdl q[1 2 3; 4 5 6];
+ok(all(approx($t12, $compare)), "implicit bracketing check");
+
+##################################
+# Implicit bracketing checks - 9 #
+##################################
+
+$compare = pdl([1,2,3,4]);
+my $t13 = pdl q[1 2 3 4];
+my $t14 = pdl q[1,2,3,4];
+my $t15 = pdl '[1 2 3 4]';
+my $t16 = pdl '[1,2,3,4]';
+
+ok(all(approx($t13, $compare)), "Double-check implicit bracketing - no brackets");
+ok(all(approx($t14, $compare)), "Double-check implicit bracketing - no brackets and commas");
+ok(all(approx($t15, $compare)), "Double-check implicit bracketing - brackets");
+ok(all(approx($t16, $compare)), "Double-check implicit bracketing - brackets and commas");
+
+# check dimensions of tests
+ok($t13->ndims == 1, "Implicit bracketing gets proper number of dimensions - no brackets, no commas");
+ok($t14->ndims == 1, "Implicit bracketing gets proper number of dimensions - no brackets, commas");
+ok($t15->ndims == 1, "Implicit bracketing gets proper number of dimensions - brackets, no commas");
+ok($t16->ndims == 1, "Implicit bracketing gets proper number of dimensions - brackets and commas");
+
+$expected = pdl [];
+$got = pdl q[];
+ok(all($got == $expected), 'Blank strings are interpreted as empty arrays');
+# This generates an annoying warning, and the piddle should be Empty anyway
+#$expected = pdl [];
+$got = pdl q[[]];
+ok(all($got == $expected), 'Empty bracket is correctly interpreted');
+
+#############################
+# Bad, inf, nan checks - 15 #
+#############################
+
+my $bad_values = pdl q[nan inf -inf bad];
+
+# Bad value testing depends on whether nan and inf are represented as bad
+# values
+require PDL::Config;
+
+if($ActivePerl::VERSION || $Config{cc} eq 'cl') {
+ TODO: {
+ local $TODO = 'ActivePerl and/or perls built using MS compilers might fail this test';
+
+ if ($PDL::Config{BADVAL_USENAN}) {
+ ok($bad_values->isbad->at(0), 'sets nan to bad')
+ or diag("Zeroeth bad value should be bad but it describes itself as "
+ . $bad_values->at(0));
+ }
+ else {
+ ok($bad_values->at(0) != $bad_values->at(0), 'properly handles nan')
+ or diag("Zeroeth bad value should be nan but it describes itself as "
+ . $bad_values->at(0));
+ }
+ } # close TODO
+}
+else {
+ if ($PDL::Config{BADVAL_USENAN}) {
+ ok($bad_values->isbad->at(0), 'sets nan to bad')
+ or diag("Zeroeth bad value should be bad but it describes itself as "
+ . $bad_values->at(0));
+ }
+ else {
+ SKIP: {
+ skip "broken for PDL_Index", 1;
+ ok($bad_values->at(0) != $bad_values->at(0), 'properly handles nan')
+ or diag("Zeroeth bad value should be nan but it describes itself as "
+ . $bad_values->at(0));
+ }
+ }
+}
+
+# inf test: inf == inf but inf * 0 != 0
+ok(( $PDL::Config{BADVAL_USENAN} and $bad_values->isbad->at(1)
+ or $bad_values->at(1) == $bad_values->at(1)
+ and $bad_values->at(1) * 0.0 != 0.0), 'properly handles inf')
+ or diag("First bad value should be inf but it describes itself as " . $bad_values->at(1));
+# inf test: -inf == -1 * inf
+ok(( $PDL::Config{BADVAL_USENAN} and $bad_values->isbad->at(2)
+ or $bad_values->at(2) == $bad_values->at(2)
+ and $bad_values->at(2) * 0.0 != 0.0), 'properly handles -inf')
+ or diag("Second bad value should be -inf but it describes itself as " . $bad_values->at(2));
+SKIP: {
+ skip "because BADVAL_USENAN makes -inf and inf both bad, "
+ . "so checking signs is silly", 1 if $PDL::Config{BADVAL_USENAN};
+ ok($bad_values->at(2) == -$bad_values->at(1), "negative inf is numerically equal to -inf");
+}
+# bad test
+ok($bad_values->isbad->at(3), 'properly handles bad values')
+ or diag("Third bad value should be BAD but it describes itself as " . $bad_values->slice(3));
+
+my $infty = pdl 'inf';
+my $min_inf = pdl '-inf';
+my $nan = pdl 'nan';
+
+my $nan2 = $^O =~ /MSWin32/i && !$ActivePerl::VERSION && $Config{cc} ne 'cl' ? pdl (-((-1) ** 0.5))
+ : pdl '-nan';
+
+my $bad = pdl 'bad';
+
+if($ActivePerl::VERSION || $Config{cc} eq 'cl') {
+ TODO: {
+
+ local $TODO = 'ActivePerl and/or perls built using MS compilers might fail this test';
+
+ ok(( $PDL::Config{BADVAL_USENAN} and $infty->isbad
+ or $infty == $infty and $infty * 0.0 != 0.0), "pdl 'inf' works by itself")
+ or diag("pdl 'inf' gave me $infty");
+ ok(( $PDL::Config{BADVAL_USENAN} and $min_inf->isbad
+ or $min_inf == $min_inf and $min_inf * 0.0 != 0.0), "pdl '-inf' works by itself")
+ or diag("pdl '-inf' gave me $min_inf");
+ } # close TODO
+}
+else {
+ ok(( $PDL::Config{BADVAL_USENAN} and $infty->isbad
+ or $infty == $infty and $infty * 0.0 != 0.0), "pdl 'inf' works by itself")
+ or diag("pdl 'inf' gave me $infty");
+ ok(( $PDL::Config{BADVAL_USENAN} and $min_inf->isbad
+ or $min_inf == $min_inf and $min_inf * 0.0 != 0.0), "pdl '-inf' works by itself")
+ or diag("pdl '-inf' gave me $min_inf");
+}
+
+SKIP: {
+ skip "because BADVAL_USENAN makes -inf and inf both bad, "
+ . "so checking signs is silly", 1 if $PDL::Config{BADVAL_USENAN};
+ ok($min_inf == -$infty, "pdl '-inf' == -pdl 'inf'");
+}
+
+
+ if($ActivePerl::VERSION || $^O =~ /cygwin/i) {
+ TODO: {
+ local $TODO = 'Cygwin perl and/or ActivePerl might fail these tests';
+
+ ok(( $PDL::Config{BADVAL_USENAN} and $nan->isbad
+ or $nan != $nan), "pdl 'nan' works by itself")
+ or diag("pdl 'nan' gave me $nan");
+ ok(( $PDL::Config{BADVAL_USENAN} and $nan2->isbad
+ or $nan2 != $nan2), "pdl '-nan' works by itself")
+ or diag("pdl '-nan' gave me $nan2");
+ ok(( $PDL::Config{BADVAL_USENAN} and $nan->isbad
+ or $nan =~ /-/), "pdl 'nan' has a negative sign (MS Windows only)")
+ or diag("pdl 'nan' gave me $nan");
+ ok(( $PDL::Config{BADVAL_USENAN} and $nan2->isbad
+ or $nan2 !~ /-/), "pdl '-nan' doesn't have a negative sign (MS Windows only)")
+ or diag("pdl -'nan' gave me $nan2");
+ } #close TODO
+ }
+ else {
+ TODO: {
+ local $TODO = 'Sign of Nan depends on platform, still some loose ends';
+
+ ok(( $PDL::Config{BADVAL_USENAN} and $nan->isbad
+ or $nan != $nan), "pdl 'nan' works by itself")
+ or diag("pdl 'nan' gave me $nan");
+ ok(( $PDL::Config{BADVAL_USENAN} and $nan2->isbad
+ or $nan2 != $nan2), "pdl '-nan' works by itself")
+ or diag("pdl '-nan' gave me $nan2");
+
+ # On MS Windows, nan is -1.#IND and -nan is 1.#QNAN. IOW, nan has
+ # a leading minus sign, and -nan is not signed.
+ if($^O =~ /MSWin32/i) {
+ ok(( $PDL::Config{BADVAL_USENAN} and $nan->isbad
+ or $nan =~ /-/), "pdl 'nan' has a negative sign (MS Windows only)")
+ or diag("pdl 'nan' gave me $nan");
+ ok(( $PDL::Config{BADVAL_USENAN} and $nan2->isbad
+ or $nan2 !~ /-/), "pdl '-nan' doesn't have a negative sign (MS Windows only)")
+ or diag("pdl -'nan' gave me $nan2");
+ }
+ else {
+ ok(( $PDL::Config{BADVAL_USENAN} and $nan->isbad
+ or $nan !~ /-/), "pdl 'nan' has a positive sign")
+ or diag("pdl 'nan' gave me $nan");
+ ok(( $PDL::Config{BADVAL_USENAN} and $nan2->isbad
+ or $nan2 =~ /-/), "pdl '-nan' has a negative sign")
+ or diag("pdl '-nan' gave me $nan2");
+ }
+ } #close TODO
+ }
+
+ok($bad->isbad, "pdl 'bad' works by itself")
+ or diag("pdl 'bad' gave me $bad");
+
+# Checks for windows strings:
+$infty = pdl q[1.#INF];
+$nan = pdl q[-1.#IND];
+
+if($ActivePerl::VERSION || $Config{cc} eq 'cl') {
+ TODO: {
+
+ local $TODO = 'ActivePerl and/or perls built using MS compilers might fail this test';
+
+ ok(( $PDL::Config{BADVAL_USENAN} and $infty->isbad
+ or $infty == $infty and $infty * 0 != 0), "pdl '1.#INF' works")
+ or diag("pdl '1.#INF' gave me $infty");
+
+ ok(($PDL::Config{BADVAL_USENAN} and $nan->isbad
+ or $nan != $nan), "pdl '-1.#IND' works")
+ or diag("pdl '-1.#IND' gave me $nan");
+ } # close TODO
+}
+else {
+ ok(( $PDL::Config{BADVAL_USENAN} and $infty->isbad
+ or $infty == $infty and $infty * 0 != 0), "pdl '1.#INF' works")
+ or diag("pdl '1.#INF' gave me $infty");
+
+ ok(($PDL::Config{BADVAL_USENAN} and $nan->isbad
+ or $nan != $nan), "pdl '-1.#IND' works")
+ or diag("pdl '-1.#IND' gave me $nan");
+}
+
+########################
+# Pi and e checks - 10 #
+########################
+
+$expected = pdl(1)->exp;
+$got = pdl q[e];
+is($got, $expected, 'q[e] returns exp(1)')
+ or diag("Got $got");
+$got = pdl q[E];
+is($got, $expected, 'q[E] returns exp(1)')
+ or diag("Got $got");
+$expected = pdl(1, exp(1));
+$got = pdl q[1 e];
+ok(all($got == $expected), 'q[1 e] returns [1 exp(1)]')
+ or diag("Got $got");
+$got = pdl q[1 E];
+ok(all($got == $expected), 'q[1 E] returns [1 exp(1)]')
+ or diag("Got $got");
+$expected = pdl(exp(1), 1);
+$got = pdl q[e 1];
+ok(all($got == $expected), 'q[e 1] returns [exp(1) 1]')
+ or diag("Got $got");
+$got = pdl q[E 1];
+ok(all($got == $expected), 'q[E 1] returns [exp(1) 1]')
+ or diag("Got $got");
+$expected = pdl(1, exp(1), 2);
+$got = pdl q[1 e 2];
+ok(all($got == $expected), 'q[1 e 2] returns [1 exp(1) 2]')
+ or diag("Got $got");
+$got = pdl q[1 E 2];
+ok(all($got == $expected), 'q[1 E 2] returns [1 exp(1) 2]')
+ or diag("Got $got");
+
+# Already checked all the permutations of e, so just make sure that it
+# properly substitutes pi
+$expected = pdl(1, 4 * atan2(1,1));
+$got = pdl q[1 pi];
+ok(all($got == $expected), 'q[1 pi] returns [1 4*atan2(1,1)]')
+ or diag("Got $got");
+$got = pdl q[1 PI];
+ok(all($got == $expected), 'q[1 PI] returns [1 4*atan2(1,1)]')
+ or diag("Got $got");
+
+########################
+# Security checks - 10 #
+########################
+
+# Check croaking on arbitrary bare-words:
+eval {pdl q[1 foobar 2]};
+isnt($@, '', 'croaks on arbitrary string input');
+eval {pdl q[$a $b $c]};
+isnt($@, '', 'croaks with non-interpolated strings');
+
+# Install a function that knows if it's been executed.
+{
+ no warnings 'redefine';
+ my $e_was_run = 0;
+ sub PDL::Core::e { $e_was_run++ }
+
+ my $to_check = q[1 e 2];
+ sub PDL::Core::e { $e_was_run++ }
+ eval {pdl $to_check};
+ is($e_was_run, 0, "Does not execute local function e in [$to_check]");
+ $e_was_run = 0;
+
+ $to_check = q[1 +e 2];
+ sub PDL::Core::e { $e_was_run++ }
+ eval {pdl $to_check};
+ is($e_was_run, 0, "Does not execute local function e in [$to_check]");
+ $e_was_run = 0;
+
+ $to_check = q[1 e+ 2];
+ sub PDL::Core::e { $e_was_run++ }
+ eval {pdl $to_check};
+ is($e_was_run, 0, "Does not execute local function e in [$to_check]");
+ $e_was_run = 0;
+
+ $to_check = q[1e 2];
+ sub PDL::Core::e { $e_was_run++ }
+ eval {pdl $to_check};
+ is($e_was_run, 0, "Does not execute local function e in [$to_check]");
+ $e_was_run = 0;
+
+ $to_check = q[1e+ 2];
+ sub PDL::Core::e { $e_was_run++ }
+ eval {pdl $to_check};
+ is($e_was_run, 0, "Does not execute local function e in [$to_check]");
+ $e_was_run = 0;
+
+ $to_check = q[1+e 2];
+ sub PDL::Core::e { $e_was_run++ }
+ eval {pdl $to_check};
+ is($e_was_run, 0, "Does not execute local function e in [$to_check]");
+ $e_was_run = 0;
+
+ $to_check = q[1+e+ 2];
+ sub PDL::Core::e { $e_was_run++ }
+ eval {pdl $to_check};
+ is($e_was_run, 0, "Does not execute local function e in [$to_check]");
+ $e_was_run = 0;
+
+ $to_check = q[1 e123 2];
+ sub PDL::Core::e123 { $e_was_run++ }
+ eval {pdl $to_check};
+ is($e_was_run, 0, "Does not execute local function e123 in [$to_check]");
+ $e_was_run = 0;
+
+}
+
+###############################
+# Useful croaking output - 36 #
+###############################
+
+eval{ pdl q[1 l 3] };
+isnt($@, '', 'Croaks when invalid character is specified');
+like($@, qr/found disallowed character\(s\) 'l'/, 'Gives meaningful explanation of problem');
+eval{ pdl q[1 po 3] };
+isnt($@, '', 'Croaks when invalid characters are specified');
+like($@, qr/found disallowed character\(s\) 'po'/, 'Gives meaningful explanation of problem');
+
+# checks for croaking behavior for consecutive signs like +-2:
+eval{ pdl q[1 +-2 3] };
+isnt($@, '', 'Croaks when it finds consecutive signs');
+like($@, qr/found a \w+ sign/, 'Gives meaningful explanation of problem');
+eval{ pdl q[1 -+2 3] };
+isnt($@, '', 'Croaks when it finds consecutive signs');
+like($@, qr/found a \w+ sign/, 'Gives meaningful explanation of problem');
+
+# 'larger word' croak checks (36)
+foreach my $special (qw(bad inf pi)) {
+ foreach my $append (qw(2 e l)) {
+ eval "pdl q[1 $special$append 2]";
+ isnt($@, '', "Croaks when it finds $special$append");
+ like($@, qr/larger word/, 'Gives meaningful explanation of problem');
+ eval "pdl q[1 $append$special 2]";
+ isnt($@, '', "Croaks when it finds $append$special");
+ like($@, qr/larger word/, 'Gives meaningful explanation of problem');
+ }
+}
+
+# e croaks (6)
+my $special = 'e';
+foreach my $append (qw(2 e l)) {
+ eval "pdl q[1 $special$append 2]";
+ isnt($@, '', "Croaks when it finds $special$append");
+ eval "pdl q[1 $append$special 2]";
+ isnt($@, '', "Croaks when it finds $append$special");
+}
+
+# Basic 2D array
+# pdl> p $a = pdl q[ [ 1, 2, 3 ], [ 4, 5, 6 ] ];
+# pdl> p $a = pdl q[ 1 2 3 ; 4 5 6 ]
+# pdl> p $a = pdl '[ [ 1, 2, 3 ], [ 4, 5, 6 ] ]';
+#
+# [
+# [1 2 3]
+# [4 5 6]
+# ]
+
+# Basic 1D array
+# pdl> p $b = pdl [ 1, 2, 3, 4, 5, 6 ]
+# pdl> p $b = pdl q[ 1 2 3 4 5 6 ]
+# pdl> p $b = pdl q[1,2,3,4,5,6]
+# [1 2 3 4 5 6]
+
+# 1D array with signs
+# pdl> p $c = pdl [ 7, -2, +5 ]
+# pdl> p $c = pdl q[ 7 -2 +5 ]
+# pdl> p $c = pdl q[ 7, -2, +5 ]
+# [7 -2 5]
+
+# 1D array with mixed ops and signs
+# pdl> p $d = pdl [ 7 - 2, +5 ]
+# pdl> p $d = pdl q[ 7 - 2 +5 ]
+# [5 5]
+
+# ...another
+# pdl> p $d = pdl [ 7, -2 + 5 ]
+# pdl> p $d = pdl q[ 7 -2 + 5 ]
+# [7 3]
+
+# 1D array with ops, not signs
+# pdl> p $d = pdl [ 7 - 2 + 5 ]
+# pdl> p $d = pdl q[ 7 - 2 + 5 ]
+# 10
+
+# A [2,3,4] shape piddle
+# pdl> p $d = pdl [ [ [0, 1], [4, 0], [0, 3] ],
+# [ [2, 0], [4, 0], [4, 1] ],
+# [ [0, 1], [3, 2], [1, 4] ],
+# [ [1, 2], [2, 2], [2, 1] ] ];
+#
+# [
+# [
+# [0 1]
+# [4 0]
+# [0 3]
+# ]
+# [
+# [2 0]
+# [4 0]
+# [4 1]
+# ]
+# [
+# [0 1]
+# [3 2]
+# [1 4]
+# ]
+# [
+# [1 2]
+# [2 2]
+# [2 1]
+# ]
+# ]
+#
+# ...the same, just different formatting...
+#
+# [
+# [ [0 1] [4 0] [0 3] ]
+# [ [2 0] [4 0] [4 1] ]
+# [ [0 1] [3 2] [1 4] ]
+# [ [1 2] [2 2] [2 1] ]
+# ]
+
+# A 3x3 2D array
+# pdl> p pdl [ [1, 2, 3], [2, 1, 0], [2, 2, 1] ];
+# pdl> p $e = pdl q[ [ 1 2 3 ] ; [ 2 1 0 ] ; [ 2 2 1 ] ];
+# pdl> p pdl q[ 1 2 3 ; 2 1 0 ; 2 2 1 ] # this should be the same
+#
+# [
+# [1 2 3]
+# [2 1 0]
+# [2 2 1]
+# ]
diff --git a/t/pdlchar.t b/t/pdlchar.t
new file mode 100644
index 0000000..39795ac
--- /dev/null
+++ b/t/pdlchar.t
@@ -0,0 +1,64 @@
+#!/bin/perl -w
+
+#
+## Test of PDL::Char subclass -- treating byte PDLs as matrices of fixed strings
+#
+
+use PDL;
+use PDL::Char;
+use strict;
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+print "1..6\n";
+
+my $a = PDL::Char->new ([[['abc', 'def', 'ghi'],['jkl', 'mno', 'qrs']],
+ [['tuv', 'wxy', 'zzz'],['aaa', 'bbb', 'ccc']]]);
+
+my $stringized = $a->string;
+my $comp =
+qq{[
+ [
+ [ 'abc' 'def' 'ghi' ]
+ [ 'jkl' 'mno' 'qrs' ]
+ ]
+ [
+ [ 'tuv' 'wxy' 'zzz' ]
+ [ 'aaa' 'bbb' 'ccc' ]
+ ]
+]
+};
+
+
+ok(1, ($stringized eq $comp));
+$a->setstr(0,0,1, 'foo');
+ok(2, ($a->atstr(0,0,1) eq 'foo'));
+$a->setstr(2,0,0, 'barfoo');
+ok(3, ($a->atstr(2,0,0) eq 'bar'));
+$a->setstr(0,0,1, 'f');
+ok(4, ($a->atstr(0,0,1) eq "f"));
+$b = sequence (byte, 4, 5) + 99;
+$b = PDL::Char->new($b);
+$stringized = $b->string;
+$comp = "[ 'cdef' 'ghij' 'klmn' 'opqr' 'stuv' ] \n";
+ok(5, ($stringized eq $comp));
+
+
+
+# Variable-length string test
+my $varstr = PDL::Char->new( [ ["longstring", "def", "ghi"],["jkl", "mno", 'pqr'] ] );
+
+# Variable Length Strings: Expected Results
+my $comp2 =
+"[
+ [ 'longstring' 'def' 'ghi' ]
+ [ 'jkl' 'mno' 'pqr' ]
+]
+";
+
+ok(6, ("$varstr" eq $comp2));
diff --git a/t/pgplot.t b/t/pgplot.t
new file mode 100644
index 0000000..1e34a23
--- /dev/null
+++ b/t/pgplot.t
@@ -0,0 +1,146 @@
+# -*-perl-*-
+BEGIN{
+ # Set perl to not try to resolve all symbols at startup
+ # The default behavior causes some problems because
+ # the PGPLOT code defines interfaces for all PGPLOT functions
+ # whether or not they are linked.
+ $ENV{'PERL_DL_NONLAZY'}=0;
+}
+
+use strict;
+
+use PDL;
+use Test::More;
+
+BEGIN{
+ eval "use PDL::Graphics::PGPLOT; use PDL::Graphics::PGPLOT::Window;";
+ if ($@) {
+ plan skip_all => "Skipped: PDL::Graphics::PGPLOT not installed";
+ } elsif ( !exists($ENV{'DISPLAY'}) and !exists($ENV{HARNESS_ACTIVE}) ) {
+ # We have this after the PGPLOT module is loaded so that we test whether the
+ # module will at least load, even if we do not test it's
+ # functionality.
+ #
+ plan tests => 1;
+ pass("use ok for PGPLOT PDL modules # skip -- DISPLAY environment variable not set");
+ exit;
+ } else {
+ plan tests => 12;
+ }
+}
+
+sub get_answer () {
+ print STDERR "Does this look OK (y/n, y is default)? :";
+ my $answer = <STDIN>;
+ return $answer !~ m/n/i;
+}
+
+sub interactive ($$) {
+ my $flag = shift;
+ my $num = shift;
+ return unless $flag; # ie not interactive
+
+ if (1 == $num) {
+ print STDERR <<'EOD';
+PGPLOT X device... you should see a 6 inch (153 mm) x 4 inch (102 mm)
+X window with four plots in it. All four images should have tick marks
+on the outside of the axes.
+
+[ Scaled image of m51; scale [Scaled image of m51 with scale from
+ in pixels on both axes ] X=[-1.8, 2.0],Y=[-1.9, 1.9] arcmin,
+ with cal. wedge, centered in rect. frame]
+
+[ Square image of m51; scale [Square image of m51 with scale as above,
+ in pixels on both axes; ``shrink-wrapped'']
+ ``shrinkwrapped'' ]
+
+EOD
+ } elsif (2 == $num) {
+ print STDERR <<'EOD';
+==============================================================
+
+You should see four plots demonstrating pitch setting, justification,
+and alignment:
+
+[ Square image of m51 scaled to [Short, squat image of m51 with
+300 ppi (1.25 inches wide), aligned aspect ratio 1:2, width 1.25 inch,
+to bottom left corner of rect. plot and height 0.625 inch, shrinkwrapped
+box and cropped at the top. ] and placed at lower left of plot rgn]
+
+[ Square image of m51 scaled to [Tall, narrow image of m51 with
+300 ppi (1.25 inches wide), aligned aspect ratio 2:1, width 0.625 inch,
+to upper right corner of rect. plot and height 1.25 inch, shrinkwrapped
+box and cropped at the bottom. ] and placed at upper right of plot rgn]
+
+EOD
+ } else {
+ die "Internal error: unknown test number $num for interactive()!\n";
+ }
+ return get_answer();
+}
+
+my $interactive = exists($ENV{'PDL_INT'});
+my $skip_interactive_msg = "interactive tests not run since environment var PDL_INT not set";
+my $interactive_ctr = 0;
+
+###
+### Test code
+###
+
+my $dev = $ENV{'PGPLOT_DEV'} ? $ENV{'PGPLOT_DEV'} : "/xw";
+
+$dev = '/null' if exists $ENV{HARNESS_ACTIVE};
+
+my $w = PDL::Graphics::PGPLOT::Window->new(
+ Dev => $dev,
+ Size=> [6,4],
+ NX=>2, NY=>2,
+ Ch=>2.5, HardCH=>2.5);
+ok( UNIVERSAL::isa($w, "PDL::Graphics::PGPLOT::Window") );
+
+my $a = rfits('m51.fits');
+
+##############################
+# Page 1
+#
+foreach my $str ( (
+ '$w->imag($a,{Title=>"\$w->imag(\$a);"} );',
+ '$w->fits_imag($a,{Title=>"\$w->fits_imag(\$a);"});',
+ '$w->imag($a,{J=>1,Title=>"\$w->imag(\$a,{J=>1});"});',
+ '$w->fits_imag($a,{J=>1,Title=>"\$w->fits_imag(\$a,{J=>1});"});'
+ ) ) {
+ eval $str;
+ ok (!$@);
+}
+
+$interactive_ctr++;
+SKIP: {
+ skip $skip_interactive_msg, 1 unless $interactive;
+ ok(interactive($interactive, $interactive_ctr), "interactive tests");
+}
+
+##############################
+# Page 2
+#
+foreach my $str ( (
+ '$w->imag($a,{Pitch=>300,Align=>"LB",Title=>"\$w->imag(\$a,{Pitch=>300,Align=>LB})"});',
+ '$w->imag($a,{J=>.5,Pitch=>300,Align=>"LB",Title=>"\$w->imag(\$a,{J=>.5,Pitch=>300,Align=>LB})"});',
+ '$w->imag($a,{Pitch=>300,Align=>"RT",Title=>"\$w->imag(\$a,{Pitch=>300,Align=>RT})"});',
+ '$w->imag($a,{J=>2,Pitch=>600,Align=>"RT",Title=>"\$w->imag(\$a,{J=>2,Pitch=>600,Align=>RT}) ."});',
+ ) ) {
+ eval $str;
+ ok (!$@);
+}
+
+$interactive_ctr++;
+SKIP: {
+ skip $skip_interactive_msg, 1 unless $interactive;
+ ok(interactive($interactive, $interactive_ctr), "interactive tests");
+}
+
+eval '$w->close';
+ok (!$@);
+
+# End
+
+
diff --git a/t/physical.t b/t/physical.t
new file mode 100644
index 0000000..5976a10
--- /dev/null
+++ b/t/physical.t
@@ -0,0 +1,44 @@
+# Test ->*physical*(). This is not yet good enough: we need
+# nasty test cases,
+
+use PDL::LiteF;
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+sub tapprox {
+ my($a,$b) = @_;
+ $c = abs($a-$b);
+ $d = max($c);
+ $d < 0.01;
+}
+
+# Cheat
+print "1..1\n";
+print "ok 1\n";
+
+if(0) {
+
+print "1..6\n";
+
+$a = zeroes(4,4);
+ok(1,$a->isphysical());
+
+$b = xvals $a + 0.1 * yvals $a;
+$c = $b->slice("1:3:2,:");
+ok(2,! $c->isphysical());
+
+$d = $b->physical();
+ok(3, $d == $b);
+
+$e = $c->physical();
+ok(4, $e != $c);
+ok(5, $e->isphysical());
+
+ok(6, tapprox($c,$e));
+
+}
diff --git a/t/pic_16bit.t b/t/pic_16bit.t
new file mode 100644
index 0000000..0634b9a
--- /dev/null
+++ b/t/pic_16bit.t
@@ -0,0 +1,70 @@
+# Created on: Fri 14 Dec 2007 07:22:09 PM
+# Last saved: Fri 09 Dec 2011 01:57:56 PM
+#
+# This tests the 16-bit image capabilities of the rpic() and wpic()
+# commands. The new code works with PNM output files and PNG format
+# too.
+
+# Our new default testing framework
+use strict;
+use Test::More;
+
+use PDL;
+use PDL::NiceSlice;
+
+my ($test_pnmtopng);
+
+BEGIN {
+ eval "use PDL::IO::Pic;";
+ if ( !$@ ) {
+ $test_pnmtopng = 1;
+ plan tests => 5;
+ if($^O =~ /MSWin32/i) {
+ $test_pnmtopng = `pnmtopng --help 2>&1`;
+ $test_pnmtopng = $test_pnmtopng =~ /^pnmtopng:/ ? 1 : 0;
+ } elsif ( !defined( scalar( qx(pnmtopng --help 2>&1) ) ) ) {
+ $test_pnmtopng = 0;
+ }
+ } else {
+ plan skip_all => 'PDL::IO::Pic not available'
+ }
+ use_ok('PDL::IO::Pic');
+};
+
+$PDL::IO::Pic::debug=20;
+
+# test save/restore of 8-bit image
+my $a = sequence(16, 16);
+$a->wpic('tbyte_a.pnm');
+my $a_pnm = rpic('tbyte_a.pnm');
+ok(sum(abs($a-$a_pnm)) == 0, 'pnm byte image save+restore');
+unlink 'tbyte_a.pnm';
+
+SKIP: {
+ skip ": pnmtopng not found, is NetPBM installed?", 1 unless $test_pnmtopng;
+ $a->wpic('tbyte_a.png');
+ my $a_png;
+ unless ($^O =~ /MSWin32/i) { $a_png = rpic('tbyte_a.png') }
+ else { $a_png = rpic('tbyte_a.png', {FORMAT => 'PNG'}) }
+ ok(sum(abs($a-$a_png)) == 0, 'png byte image save+restore'); #test 3
+ unlink 'tbyte_a.png';
+};
+
+# test save/restore of 16-bit image
+my $a16 = sequence(256, 255)->ushort * 231;
+$a16->wpic('tushort_a16.pnm');
+my $a16_pnm = rpic('tushort_a16.pnm');
+ok(sum(abs($a16-$a16_pnm)) == 0, 'pnm ushort image save+restore'); # test 4
+unlink 'tushort_a16.pnm';
+
+SKIP : {
+ skip ": pnmtopng not found, is NetPBM installed?", 1 unless $test_pnmtopng;
+ $a16->wpic('tushort_a16.png');
+ my $a16_png;
+ unless($^O =~ /MSWin32/i) {$a16_png = rpic('tushort_a16.png')}
+ else {$a16_png = rpic('tushort_a16.png', {FORMAT => 'PNG'})}
+ ok(sum(abs($a16-$a16_png)) == 0, 'png ushort image save+restore'); # test 5 (fails on Win32 if not skipped)
+ unlink 'tushort_a16.png';
+ };
+
+# end
diff --git a/t/picnorgb.t b/t/picnorgb.t
new file mode 100644
index 0000000..bc351bf
--- /dev/null
+++ b/t/picnorgb.t
@@ -0,0 +1,136 @@
+# we need tests with index shuffling once vaffines are fixed
+
+my $numbad = 0;
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+ $numbad++ unless $result;
+ $result;
+}
+
+sub tapprox {
+ my($a,$b,$mdiff) = @_;
+ $mdiff = 0.01 unless defined($mdiff);
+ $c = abs($a-$b);
+ $d = max($c);
+ $d < $mdiff;
+}
+
+sub rpic_unlink {
+ my $file = shift;
+ my $pdl = PDL->rpic($file);
+ unlink $file;
+ return $pdl;
+}
+
+sub check {
+ my ($err,$i) = @_;
+ if ($err =~ /maxval is too large/) {
+ print STDERR
+ "skipping test $i (recompile pbmplus with PGM_BIGGRAYS!)\n"
+ } else {
+ print STDERR "skipping test $i (unknownm error: $err)\n"
+ }
+}
+
+sub rgb { $_[0]->getndims == 3 && $_[0]->getdim(0) == 3 }
+
+use PDL::LiteF;
+use PDL::IO::Pic;
+use PDL::ImageRGB;
+use PDL::Dbg;
+
+$PDL::debug = 1;
+$iform = 'PNMRAW'; # change to PNMASCII to use ASCII PNM intermediate
+ # output format
+
+# [FORMAT, extension, ushort-divisor,
+# only RGB/no RGB/any (1/-1/0), mxdiff]
+# no test of PCX format because seems to be severely brain damaged
+%formats = ('PNM' => ['pnm',1,0,0.01],
+ 'GIF' => ['gif',256,0,1.01],
+ 'TIFF' => ['tif',1,0,0.01],
+# 'RAST' => ['rast',256,0,1.01],
+# 'SGI' => ['rgb',1,0,0.01],
+ );
+
+# only test PNM format
+# netpbm has too many bugs on various platforms
+ at allowed = ();
+for ('PNM') { push @allowed, $_
+ if PDL->rpiccan($_) && defined $formats{$_} }
+
+$ntests = 3 * @allowed; # -1 due to TIFF converter
+$ntests-- if grep /^TIFF$/, @allowed;
+if ($ntests < 1) {
+ print("1..1\nok 1\n"); # dummy
+ exit;
+}
+
+print("1..$ntests\n");
+print "Testable formats on this platform:\n ".join(',', at allowed)."\n";
+
+$im1 = pdl([[0,65535,0], [256,256,256], [65535,256,65535]])->ushort;
+$im2 = byte $im1/256;
+
+# make the resulting file at least 12 byte long
+# otherwise we run into a problem when reading the magic (Fix!)
+$im3 = PDL::byte [[0,0,255,255,12,13],[1,4,5,6,11,124],
+ [100,0,0,0,10,10],[2,1,0,1,0,14],[2,1,0,1,0,14],
+ [2,1,0,1,0,14]];
+
+if ($PDL::debug) {
+ print $im1;
+ $im1->px;
+ print $im2;
+ $im2->px;
+ print $im3>0;
+ $im3->px;
+}
+
+# for some reason the pnmtotiff converter coredumps when trying
+# to do the conversion for the ushort data, haven't yet tried to
+# figure out why
+$n = 1;$usherr=0;
+foreach $format (sort @allowed) {
+ print " ** testing $format format **\n";
+ $form = $formats{$format};
+
+ eval '$im1->wpic("tushort.$form->[0]",{IFORM => "$iform"})'
+ unless $format eq 'TIFF';
+ if ($format ne 'TIFF' && $@) { check($@,$n); $usherr = 1 } else {$usherr=0}
+ $im2->wpic("tbyte.$form->[0]",{IFORM => "$iform"});
+ $im3->wpic ("tbin.$form->[0]",{COLOR => 'bw', IFORM => "$iform"});
+ $in1 = rpic_unlink("tushort.$form->[0]") unless
+ $usherr || $format eq 'TIFF';
+ $in2 = rpic_unlink("tbyte.$form->[0]");
+ $in3 = rpic_unlink("tbin.$form->[0]");
+
+ if ($format ne 'TIFF') {
+ $scale = ($form->[2] || rgb($in1) ? $im1->dummy(0,3) : $im1);
+ $comp = $scale / PDL::ushort($form->[1]);
+ ok($n++,$usherr || tapprox($comp,$in1,$form->[3]));
+ }
+ $comp = ($form->[2] || rgb($in2) ? $im2->dummy(0,3) : $im2);
+ ok($n++,tapprox($comp,$in2));
+ $comp = ($form->[2] || rgb($in3) ? ($im3->dummy(0,3)>0)*255 : ($im3 > 0));
+ $comp = $comp->ushort*$in3->max if $format eq 'SGI' && $in3->max > 0;
+ ok($n++,tapprox($comp,$in3));
+
+ if ($PDL::debug) {
+ print $in1->px unless $format eq 'TIFF';
+ print $in2->px;
+ print $in3->px;
+ }
+}
+
+use Data::Dumper;
+if ($numbad > 0) {
+ local $Data::Dumper::Pad = '#';
+ print "# Dumping diagnostic PDL::IO::Pic converter data...\n";
+ print Dumper(\%PDL::IO::Pic::converter);
+}
+
diff --git a/t/picrgb.t b/t/picrgb.t
new file mode 100644
index 0000000..7effa51
--- /dev/null
+++ b/t/picrgb.t
@@ -0,0 +1,139 @@
+# we need tests with index shuffling once vaffines are fixed
+my $numbad = 0;
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+ $numbad++ unless $result;
+ $result;
+}
+
+sub tapprox {
+ my($a,$b,$mdiff) = @_;
+ $mdiff = 0.01 unless defined($mdiff);
+ my $c = abs($a-$b);
+ my $d = max($c);
+ $d < $mdiff;
+}
+
+sub rpic_unlink {
+ my $file = shift;
+ my $pdl = PDL->rpic($file);
+ unlink $file;
+ return $pdl;
+}
+
+sub depends_on {
+ print "# ushort is ok with $_[0]\n"
+ if $PDL::IO::Pic::converter{$_[0]}->{ushortok};
+ return 1 if $PDL::IO::Pic::converter{$_[0]}->{ushortok};
+ return 256;
+}
+
+sub check {
+ my ($err,$i) = @_;
+ if ($err =~ /maxval is too large/) {
+ print STDERR
+ "skipping test $i (recompile pbmplus with PGM_BIGGRAYS!)\n"
+ } else {
+ print STDERR "skipping test $i (unknownm error: $err)\n"
+ }
+}
+
+sub mmax { return $_[0] > $_[1] ? $_[0] : $_[1] }
+
+$::warned = 0;
+sub tifftest {
+ my ($form) = @_;
+ return 0 unless $form eq 'TIFF';
+ warn "WARNING: you are probably using buggy tiff converters.
+ Check IO/Pnm/converters for patched source files\n" unless $::warned;
+ $warned = 1;
+ return 1;
+}
+
+use PDL;
+use PDL::IO::Pic;
+use PDL::ImageRGB;
+use PDL::Dbg;
+
+$PDL::debug = 0;
+$PDL::IO::Pic::debug = 0;
+$iform = 'PNMRAW'; # change to PNMASCII to use ASCII PNM intermediate
+ # output format
+
+# [FORMAT, extension, ushort-divisor,
+# only RGB/no RGB/any (1/-1/0), mxdiff]
+# no test of PCX format because seems to be severely brain damaged
+%formats = ('PNM' => ['pnm',1,0,0.01],
+ 'GIF' => ['gif',256,0,1.01],
+ 'TIFF' => ['tif',1,0,0.01],
+ 'RAST' => ['rast',256,0,0.01],
+# 'SGI' => ['rgb',1,1,0.01],
+ 'PNG' => ['png',1,1,0.01],
+ );
+
+# only test PNM format
+# netpbm has too many bugs on various platforms
+ at allowed = ();
+## for ('PNM') { push @allowed, $_
+for (keys %formats) {
+ if (PDL->rpiccan($_) && PDL->wpiccan($_) && defined $formats{$_}) {
+ push @allowed, $_;
+ }
+}
+
+$ntests = 2 * (@allowed);
+if ($ntests < 1) {
+ print("1..1\nok 1\n"); # dummy
+ exit;
+}
+
+print("1..$ntests\n");
+
+print "# Testable formats on this platform:\n# ".join(',', at allowed)."\n";
+
+
+$im1 = ushort pdl [[[0,0,0],[256,65535,256],[0,0,0]],
+ [[256,256,256],[256,256,256],[256,256,256]],
+ [[2560,65535,2560],[256,2560,2560],[65535,65534,65535]]];
+$im2 = byte ($im1/256);
+
+if ($PDL::debug){
+ print $im1;
+ print $im2;
+}
+
+$n = 1;
+$usherr = 0;
+foreach $form (sort @allowed) {
+ print "# ** testing $form format **\n";
+
+ $arr = $formats{$form};
+ eval '$im1->wpic("tushort.$arr->[0]",{IFORM => $iform});';
+ if ($@) { check($@,$n); $usherr = 1 } else { $usherr=0}
+ $im2->wpic("tbyte.$arr->[0]",{IFORM => $iform});
+
+ $in1 = rpic_unlink("tushort.$arr->[0]") unless $usherr;
+ $in2 = rpic_unlink("tbyte.$arr->[0]");
+
+ $comp = $im1 / PDL::ushort(mmax(depends_on($form),$arr->[1]));
+ print "# Comparison arr: $comp" if $PDL::debug;
+ ok($n++,$usherr || tapprox($comp,$in1,$arr->[3]) || tifftest($form));
+ ok($n++,tapprox($im2,$in2) || tifftest($form));
+
+ if ($PDL::debug) {
+ print $in1->px;
+ print $in2->px;
+ }
+}
+
+use Data::Dumper;
+if ($numbad > 0) {
+ local $Data::Dumper::Pad = '#';
+ print "# Dumping diagnostic PDL::IO::Pic converter data...\n";
+ print Dumper(\%PDL::IO::Pic::converter);
+}
+
diff --git a/t/plplot.t b/t/plplot.t
new file mode 100644
index 0000000..b48c289
--- /dev/null
+++ b/t/plplot.t
@@ -0,0 +1,543 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+use PDL;
+use PDL::Config;
+use Test::More;
+
+BEGIN{
+ use PDL::Config;
+ if($PDL::Config{WITH_PLPLOT}) {
+ if($^O =~ /mswin/i) {
+ warn "No PLPLOT_LIB env var set - this script will die after the first test if the font files are not found"
+ if !$ENV{PLPLOT_LIB};
+ }
+ plan tests => 37;
+ use_ok( "PDL::Graphics::PLplot" );
+ }
+ else {
+ plan skip_all => "PDL::Graphics::PLplot not installed";
+ }
+}
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+# Use svg driver because it should always be installed.
+my $dev = 'svg';
+
+my ($pl, $x, $y, $min, $max, $oldwin, $nbins);
+
+
+###
+# Initial test to work around font file brain damage: for some kinds of
+# PLplot errors, control never returns to us. FMH.
+# --CED
+###
+
+unless($^O =~ /mswin/i) { # Causes problems on Windows.
+ my $tmpdir = $PDL::Config{TEMPDIR} || "/tmp";
+ my $tmpfile = $tmpdir . "/foo$$.$dev";
+
+# comment this out for testing!!!
+ #my $pid = 0; my $a = 'foo';
+
+ if($pid = fork()) {
+ $a = waitpid($pid,0);
+ } else {
+ sleep 1;
+ $pl = PDL::Graphics::PLplot->new(DEV=>$dev,FILE=>$tmpfile);
+ exit(0);
+ }
+
+ ok( ($not_ok = $? & 0xff )==0 , "PLplot crash test" );
+ unlink $tmpfile;
+
+ if($not_ok) {
+ printf <<"EOERR" ;
+
+Return value $not_ok; a is $a; pid is $pid
+
+************************************************************************
+* PLplot failed the crash test: it appears to crash its owner process. *
+* This is probably due to a misconfiguration of the PLplot libraries. *
+* Next we\'ll try creating a test window from which will probably dump *
+* some (hopefully helpful) error messages and then die. *
+************************************************************************
+
+EOERR
+
+ }
+}
+else { # MS Windows only
+ my $ret = system("$^X", '-Mblib -MPDL -MPDL::Graphics::PLplot -e "$pl = PDL::Graphics::PLplot->new(DEV=>\"xfig\",FILE=>\"foo.xfig\")"');
+ ok( $ret == 0 , "PLplot crash test" );
+ unlink 'foo.xfig';
+}
+
+$pl = PDL::Graphics::PLplot->new (DEV => $dev,
+ FILE => "test02.$dev",
+ BACKGROUND => [255,255,255]);
+isa_ok( $pl, "PDL::Graphics::PLplot" ) or die;
+
+$x = sequence(10);
+$y = $x**2;
+$pl->xyplot($x, $y,
+ BOX => [-5,10,0,200],
+ PLOTTYPE => 'LINE');
+$pl->close;
+ok (-s "test02.$dev" > 0, "Simple line plot");
+
+$pl = PDL::Graphics::PLplot->new (DEV => $dev,
+ FILE => "test02a.$dev",
+ LINEWIDTH => 10,
+ BACKGROUND => [255,255,255]);
+$pl->xyplot($x, $y,
+ BOX => [-5,10,0,200],
+ PLOTTYPE => 'LINE');
+$pl->close;
+ok (-s "test02a.$dev" > 0, "Simple line plot with LINEWIDTH specified");
+
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test03.$dev",
+ BACKGROUND => 'WHITE');
+$pl->xyplot($x, $y, PLOTTYPE => 'POINTS', COLOR => 'BLUEVIOLET', SYMBOL => 1, SYMBOLSIZE => 4);
+$pl->close;
+ok (-s "test03.$dev" > 0, "Symbol plot");
+
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test04.$dev", FRAMECOLOR => 'BLUE');
+$pl->xyplot($x, $y, PLOTTYPE => 'LINEPOINTS', COLOR => [50,230,30]);
+$pl->close;
+ok (-s "test04.$dev" > 0, "Lines and symbols");
+
+$y = sequence(30)+1;
+my $m = (50* (exp(1/$y**2) - 1) * random (30,20))->xchg(0,1);
+my ($mean, $rms) = statsover($m);
+my $x1 = $mean + $rms;
+my $x2 = $mean - $rms;
+my $n = 500 - exp($y/5);
+
+#$pl = PDL::Graphics::PLplot->new (DEV => "xwin", FILE => "trillian.cosmic.ucar.edu:0");
+
+# Setting text to 1 like this does not work. text is hard coded in ps.c ;(
+#$pl = PDL::Graphics::PLplot->new (DEV => "psc", FILE => "test05.ps", OPTS => {'text' => '1'});
+
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test05.$dev");
+$pl->xyplot($x1, $y, COLOR => 'GREEN',
+ BOX => [($mean - $rms)->minmax, $y->minmax],
+ XBOX => 'bnst', # bottom line, bottom numbers, ticks, subticks
+ YBOX => 'bnst', # left line, left numbers, ticks, subticks
+ TITLE => 'Test statistics plot',
+ XLAB => 'X label',
+ YLAB => 'Y label');
+
+$pl->xyplot($x2, $y, COLOR => 'GREEN');
+$pl->xyplot($mean, $y, COLOR => 'RED');
+$pl->xyplot($n, $y, COLOR => 'BLUE',
+ XBOX => 'cmst', # top line, top numbers, ticks, subticks
+ YBOX => 'cst', # right line, ticks, subticks
+ BOX => [0, int(1.1*$n->max), $y->minmax]);
+$pl->text("Count", COLOR => 'PINK',
+ TEXTPOSITION => ['t', 3, 0.5, 0.5]); # top, 3 units out, string ref. pt in
+ # center of string, middle of axis
+
+$pl->close;
+ok (-s "test05.$dev" > 0, "Sample layer statistics plot");
+
+# test of setting page size.
+$pl = PDL::Graphics::PLplot->new (DEV => $dev,
+ FILE => "test06.$dev",
+ PAGESIZE => [50,80]);
+$x = sequence(10);
+$y = $x**2;
+$pl->xyplot($x, $y, PLOTTYPE => 'LINE');
+$pl->close;
+ok (-s "test06.$dev" > 0, "Setting pagesize");
+
+# test of lines with gaps (plgapline)
+$pl = PDL::Graphics::PLplot->new (DEV => $dev,
+ FILE => "test07.$dev");
+$x = sequence(10);
+$y = $x**2;
+$x->inplace->setbadat(5); # insert gap
+$y->inplace->setbadat(5); # insert gap
+$pl->xyplot($x, $y, PLOTTYPE => 'LINE');
+$pl->close;
+ok (-s "test07.$dev" > 0, "Line plot with gaps (plgapline)");
+
+# test of setting JUSTify = 1
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test08.$dev");
+$x = sequence(10);
+$y = $x**2;
+$pl->xyplot($x, $y, PLOTTYPE => 'LINEPOINTS', JUST => 1);
+$pl->close;
+ok (-s "test08.$dev" > 0, "Setting JUSTify = 1");
+
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test09.$dev");
+
+$pl->text("Test string outside of window", TEXTPOSITION => ['T', 1, 0, 0]);
+$pl->text("Test string inside window", TEXTPOSITION => [0, 0, 0.5, 0.5, 0]);
+$pl->close;
+ok (-s "test09.$dev" > 0, "Printing text inside and outside of plot window");
+
+my $pi = atan2(1,1)*4;
+my $a = (sequence(20)/20) * 2 * $pi;
+my $b = sin($a);
+my $c = cos($a);
+
+# test rainbow point plotting with color key
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test10.$dev");
+$pl->xyplot ($a, $b, SYMBOL => 850, SYMBOLSIZE => 1.5, PALETTE => 'RAINBOW', PLOTTYPE => 'POINTS', COLORMAP => $c);
+$pl->colorkey ($c, 'v', VIEWPORT => [0.93, 0.96, 0.15, 0.85]);
+$pl->colorkey ($c, 'h', VIEWPORT => [0.15, 0.85, 0.92, 0.95]);
+$pl->close;
+ok (-s "test10.$dev" > 0, "Colored symbol plot with key");
+
+# test reverse rainbow point plotting with color key
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test10a.$dev");
+$pl->xyplot ($a, $b, SYMBOL => 850, SYMBOLSIZE => 1.5, PALETTE => 'REVERSERAINBOW', PLOTTYPE => 'POINTS', COLORMAP => $c);
+$pl->colorkey ($c, 'v', VIEWPORT => [0.93, 0.96, 0.15, 0.85]);
+$pl->colorkey ($c, 'h', VIEWPORT => [0.15, 0.85, 0.92, 0.95]);
+$pl->close;
+ok (-s "test10a.$dev" > 0, "Colored symbol plot with key: reverse rainbow");
+
+# Test plot and color key (low level interface)
+plsdev ($dev);
+plsfnam ("test11.$dev");
+plspage (0,0, 600,600, 0,0);
+plinit();
+pladv (0);
+plvsta();
+plwind (0, 1, 0, 1);
+plvpor(0.1,0.85,0.1,0.9);
+
+plwind (0, 10, 0, 100);
+plcol0(1);
+plbox (0, 0, 0, 0, 'BCNST', 'BCNST');
+plpoin($x, $y, 2);
+
+# view port dimensions in normalized device coordinates
+my ($dev_xmin, $dev_xmax, $dev_ymin, $dev_ymax) = plgvpd();
+
+# view port dimensions in world coordinates
+my ($wld_xmin, $wld_xmax, $wld_ymin, $wld_ymax) = plgvpw();
+plvpor(0.86,0.90,0.1,0.9);
+plwind (0, 10, 0, 100);
+plbox (0, 0, 0, 0, '', 'TM');
+plscmap1l (0, PDL->new(0,1), PDL->new(0,360), PDL->new(0.5, 0.5), PDL->new(1,1), pdl []);
+for (my $i=0;$i<10;$i++) {
+ plcol1($i/10);
+ plfill (PDL->new(0,10,10,0), PDL->new($i*10,$i*10,($i+1)*10,($i+1)*10));
+}
+plend1();
+
+ok (-s "test11.$dev" > 0, "Colored symbol plot with key, via low level interface");
+
+ok (sum(pdl(0.1, 0.85, 0.1, 0.9) - pdl($dev_xmin->sclr, $dev_xmax->sclr, $dev_ymin->sclr, $dev_ymax->sclr)) == 0,
+ "plgvpd call works correctly");
+ok (abs(sum(pdl(-0.0001, 10.0001, -0.001, 100.001) - pdl($wld_xmin->sclr, $wld_xmax->sclr, $wld_ymin->sclr, $wld_ymax->sclr))) < 0.000001,
+ "plgvpw call works correctly");
+
+# Test shade plotting (low level interface)
+plsdev ($dev);
+plsfnam ("test12.$dev");
+plspage (0,0, 600,600, 0,0);
+plinit();
+pladv (0);
+plvpor(0.1, 0.9, 0.1, 0.9);
+plwind (-1, 1, -1, 1);
+plpsty(0);
+
+my $nx = 35;
+my $ny = 46;
+$x = (sequence($nx) - ($nx/2))/($nx/2);
+$y = (sequence($ny) - ($ny/2))/(($ny/2) - 1.0);
+my $xv = $x->dummy(1, $y->nelem);
+my $yv = $y->dummy(0, $x->nelem);
+my $z = -sin(7*$xv) * cos (7*$yv) + $xv**2 - $yv**2;
+my $nsteps = 15;
+my ($zmin, $zmax) = $z->minmax;
+my $clevel = ((sequence($nsteps)*(($zmax - $zmin)/($nsteps-1))) + $zmin);
+my $fill_width = 2;
+my $cont_color = 0;
+my $cont_width = 0;
+my $xmap = ((sequence($nx)*(2/($nx-1))) + -1); # map X coords linearly to -1 to 1
+my $ymap = ((sequence($ny)*(2/($ny-1))) + -1);
+my $grid = plAllocGrid ($xmap, $ymap);
+plshades($z, -1, 1, -1, 1,
+ $clevel, $fill_width,
+ $cont_color, $cont_width, 1,
+ 0, \&pltr1, $grid);
+plend1();
+
+ok (-s "test12.$dev" > 0, "3D color plot, low level interface");
+
+# test shade plots with higher level interface.
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test13.$dev");
+$pl->shadeplot ($z, $nsteps, BOX => [-1, 1, -1, 1], PALETTE => 'RAINBOW');
+$pl->colorkey ($z, 'v', VIEWPORT => [0.93, 0.96, 0.15, 0.85]);
+$pl->close;
+ok (-s "test13.$dev" > 0, "3D color plot, high level interface");
+
+# Test histogram plotting (low level interface)
+plsdev ($dev);
+plsfnam ("test14.$dev");
+plspage (0,0, 600,600, 0,0);
+plinit();
+pladv (0);
+plvpor(0.1, 0.9, 0.1, 0.9);
+$x = random(100)*100;
+($min, $max) = $x->minmax;
+$nbins = 15;
+$oldwin = 1; # dont call plenv
+
+plwind ($min, $max, 0, 100);
+plbox (0, 0, 0, 0, 'bcnst', 'bcnst');
+
+plhist ($x, $min, $max, $nbins, $oldwin);
+plend1();
+
+ok (-s "test14.$dev" > 0, "Histogram plotting, low level interface");
+
+# test histograms with higher level interface.
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test15.$dev");
+$pl->histogram ($x, $nbins, BOX => [$min, $max, 0, 100]);
+$pl->close;
+ok (-s "test15.$dev" > 0, "Histogram plotting, high level interface");
+
+# Test multiple plots per page (low level interface)
+plsdev ($dev);
+plsfnam ("test16.$dev");
+plspage (0,0, 300,600, 0,0);
+plssub (1,2);
+plinit();
+pladv (1);
+plvpor(0.1, 0.9, 0.1, 0.9);
+$x = random(100)*100;
+($min, $max) = $x->minmax;
+$nbins = 15;
+$oldwin = 1; # dont call plenv
+plwind ($min, $max, 0, 100);
+plbox (0, 0, 0, 0, 'bcnst', 'bcnst');
+plhist ($x, $min, $max, $nbins, $oldwin);
+
+pladv (2);
+plvpor(0.1, 0.9, 0.1, 0.9);
+$x = random(200)*100;
+($min, $max) = $x->minmax;
+$nbins = 15;
+$oldwin = 1; # dont call plenv
+
+plwind ($min, $max, 0, 100);
+plbox (0, 0, 0, 0, 'bcnst', 'bcnst');
+
+plhist ($x, $min, $max, $nbins, $oldwin);
+
+plend1();
+
+ok (-s "test16.$dev" > 0, "Multiple plots per page, low level interface");
+
+# test multiple pages per plot (high level interface)
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test17.$dev", SUBPAGES => [1,2]);
+$pl->histogram ($x, $nbins, BOX => [$min, $max, 0, 100]);
+$pl->histogram ($x, $nbins, BOX => [$min, $max, 0, 100], SUBPAGE => 2);
+$pl->close;
+ok (-s "test17.$dev" > 0, "Multiple plots per page, high level interface");
+
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test18.$dev");
+$x = sequence(10);
+$y = $x**2;
+$pl->xyplot($x, $y, PLOTTYPE => 'LINE', LINESTYLE => 2);
+$pl->close;
+ok (-s "test18.$dev" > 0, "Setting LINESTYLE");
+
+# test setting plot orientation
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test19.$dev", ORIENTATION => 1);
+$x = sequence(10);
+$y = $x**2;
+$pl->xyplot($x, $y, PLOTTYPE => 'LINE', LINESTYLE => 2);
+$pl->close;
+ok (-s "test19.$dev" > 0, "Setting plot orientation");
+
+# test symbol plotting
+$pl = PDL::Graphics::PLplot->new (DEV => $dev, FILE => "test20.$dev");
+$pl->setparm (BOX => [0,200,0,200]);
+for (my $x=0;$x<20;$x++) {
+ for (my $y=0;$y<20;$y++) {
+ my $xp = pdl(10*$x);
+ my $yp = pdl(10*$y);
+ $pl->xyplot($xp, $yp, PLOTTYPE => 'POINTS', SYMBOL => 20*$x+$y);
+ }
+}
+$pl->close;
+ok (-s "test20.$dev" > 0, "Symbol plotting");
+
+# test label plotting in multiple subpage plots
+$pl = PDL::Graphics::PLplot->new(DEV => $dev,
+ FILE => "test21.$dev",
+ PAGESIZE => [500,900],
+ SUBPAGES => [1,6]);
+my @colors = qw(GREEN BLUE RED BROWN BLACK YELLOW);
+
+for my $i (0..5) {
+
+ my $x = sequence(100)*0.1;
+ my $y = sin($x);
+
+ $pl->xyplot($x, $y,
+ COLOR => $colors[$i],
+ SUBPAGE => $i+1,
+ TITLE => "Title $i",
+ XLAB => "1 to 10",
+ YLAB => "sin(x)");
+
+}
+
+$pl->close;
+ok (-s "test21.$dev" > 0, "Multiple subpages");
+
+# test bar graphs
+$pl = PDL::Graphics::PLplot->new(DEV => $dev, FILE => "test22.$dev");
+$pl->bargraph([map { sprintf ("2002.%03d", $_) } (1..100)], 100*random(100), COLOR => 'BLUE');
+$pl->close;
+ok (-s "test22.$dev" > 0, "Bar graph");
+
+$pl = PDL::Graphics::PLplot->new(DEV => $dev, FILE => "test23.$dev");
+my @labels = ((map { sprintf ("2001.%03d", $_) } (240..365)), (map { sprintf ("2002.%03d", $_) } (1..100)));
+$pl->bargraph(\@labels, 100*random(scalar(@labels)), COLOR => 'GREEN');
+$pl->close;
+ok (-s "test23.$dev" > 0, "Bar graph part 2");
+
+$pl = PDL::Graphics::PLplot->new(DEV => $dev, FILE => "test23a.$dev");
+ at labels = ((map { sprintf ("2001.%03d", $_) } (240..365)), (map { sprintf ("2002.%03d", $_) } (1..100)));
+$pl->bargraph(\@labels, 100*random(scalar(@labels)), COLOR => 'GREEN', MAXBARLABELS => 30);
+$pl->close;
+ok (-s "test23a.$dev" > 0, "Bar graph part 3");
+
+$pl = PDL::Graphics::PLplot->new(DEV => $dev, FILE => "test23b.$dev");
+ at labels = ((map { sprintf ("2001.%03d", $_) } (240..365)), (map { sprintf ("2002.%03d", $_) } (1..100)));
+$pl->bargraph(\@labels, 100*random(scalar(@labels)), COLOR => 'GREEN', TEXTPOSITION => ['tv', 0.5, 0.0, 0.0]);
+$pl->close;
+ok (-s "test23b.$dev" > 0, "Bar graph part 4");
+
+$pl = PDL::Graphics::PLplot->new(DEV => $dev, FILE => "test23c.$dev");
+ at labels = ((map { sprintf ("2001.%03d", $_) } (240..365)), (map { sprintf ("2002.%03d", $_) } (1..100)));
+$pl->bargraph(\@labels, 100*random(scalar(@labels)), UNFILLED_BARS => 1, COLOR => 'GREEN', TEXTPOSITION => ['tv', 0.5, 0.0, 0.0]);
+$pl->close;
+ok (-s "test23c.$dev" > 0, "Bar graph part 5, unfilled boxes");
+
+$pl = PDL::Graphics::PLplot->new(DEV => $dev, FILE => "test24.$dev");
+$x = sequence(10);
+$y = $x**2;
+$pl->xyplot($x, $y, PLOTTYPE => 'LINE', XERRORBAR => ones(10)*0.5, XTICK => 2, NXSUB => 5,
+ YERRORBAR => $y*0.1, YTICK => 20, NYSUB => 10,
+ MINTICKSIZE => 2, MAJTICKSIZE => 3);
+$pl->close;
+ok (-s "test24.$dev" > 0, "Setting error bars and tick size");
+
+$pl = PDL::Graphics::PLplot->new(DEV => $dev, FILE => "test25.$dev");
+$x1 = sequence(20);
+my $y1 = $x1**2;
+
+$x2 = sequence(22);
+my $y2 = sqrt($x2);
+
+my $x3 = sequence(30);
+my $y3 = $x3**3;
+
+my $xs = [$x1, $x2, $x3];
+my $ys = [$y1, $y2, $y3];
+
+$pl->stripplots($xs, $ys, PLOTTYPE => 'LINE', TITLE => 'functions', YLAB => ['x**2', 'sqrt(x)', 'x**3']);
+$pl->close;
+ok (-s "test25.$dev" > 0, "Basic stripplots");
+
+$pl = PDL::Graphics::PLplot->new(DEV => $dev, FILE => "test26.$dev");
+$x1 = sequence(20);
+$y1 = $x1**2;
+
+$x2 = sequence(18);
+$y2 = sqrt($x2);
+
+$x3 = sequence(24);
+$y3 = $x3**3;
+
+my $x4 = sequence(27);
+$a = ($x4/20) * 2 * $pi;
+my $y4 = sin($a);
+
+$xs = [$x1, $x2, $x3, $x4];
+$ys = [$y1, $y2, $y3, $y4];
+$pl->stripplots($xs, $ys, PLOTTYPE => 'LINE', TITLE => 'functions',
+ YLAB => ['x**2', 'sqrt(x)', 'x**3', 'sin(x/20*2pi)'],
+ COLOR => ['GREEN', 'DEEPSKYBLUE', 'DARKORCHID1', 'DEEPPINK'], XLAB => 'X label');
+$pl->close;
+ok (-s "test26.$dev" > 0, "Multi-color stripplots");
+
+# test opening/closing of more than 100 streams (100 is the max number of plplot streams, close should
+# reuse plplot stream numbers).
+my $count = 0;
+for my $i (1 .. 120) {
+ my $pltfile = "test27.$dev";
+ my $win = PDL::Graphics::PLplot->new(DEV => $dev, FILE => $pltfile, PAGESIZE => [300, 300]);
+ $win->xyplot(pdl(0,1), pdl(0,1));
+ # print "Stream = ", plgstrm(), " Stream in object = ", $win->{STREAMNUMBER}, "\n";
+ $win->close();
+ if (-s $pltfile > 0) { $count++; unlink $pltfile }
+}
+ok ($count == 120, "Opening/closing of > 100 streams");
+
+
+SKIP: {
+ skip 'Not compiled with POSIX threads', 1 if (($PDL::Config{WITH_POSIX_THREADS} == 0) || ($^O =~/darwin/i));
+
+ my $pltfile = "test28.$dev";
+ if($^O =~ /MSWin32/i) {
+ system "$^X", '-Mblib -e "do \"t/plplot_no_fork.win32\""';
+ }
+ else {
+ if($pid = fork()) {
+ $a = waitpid($pid,0);
+ } else {
+
+ # Breakage seems to be a function of the grid size. For me, 34 did the trick.
+ # You may need to fiddle with it to reproduce trouble, so it's read from the
+ # command-line.
+ my $grid_size = 34;
+
+ # PThreads settings, uncomment to break:
+ set_autopthread_targ($grid_size); # large number to increase likelihood of trouble
+ set_autopthread_size(0); # zero ensures we get threading
+
+ # Add DEV unless you want it to prompt you:
+ my $pl = PDL::Graphics::PLplot->new(DEV => $dev, FILE => $pltfile);
+
+ # Some simple sequential data
+ my $xs = sequence($grid_size);
+ my $ys = sequence($grid_size)->transpose;
+
+ # Plot data so that increasing y-values have different colors:
+ $pl->xyplot($xs, $ys, PLOTTYPE => 'POINTS', COLORMAP => $ys);
+
+ $pl->close;
+ exit(0);
+ }
+ }
+
+ # If pthreads are working wrongly, the .svg file is messed up and much larger than usual
+ ok( (-s $pltfile <= 600_000) && (($? & 0xff ) == 0), "Fails to crash with POSIX threads");
+
+};
+
+unlink glob "test*.$dev"; # comment out for debug...
+
+# Local Variables:
+# mode: cperl
+# End:
diff --git a/t/plplot_no_fork.win32 b/t/plplot_no_fork.win32
new file mode 100755
index 0000000..372b17c
--- /dev/null
+++ b/t/plplot_no_fork.win32
@@ -0,0 +1,31 @@
+# This file run by plplot.t (MS Windows only).
+# We can't use fork() with plplot on Win32
+# as the Win32 fork() uses threading, and plplot is not thread-safe.
+# By instead running this separate script for the final test, we avoid the issue.
+use warnings;
+use blib;
+use PDL;
+use PDL::Graphics::PLplot;
+
+my $dev = 'svg';
+
+my $pltfile = "test28.$dev";
+
+my $grid_size = 34;
+
+# PThreads settings, uncomment to break:
+set_autopthread_targ($grid_size); # large number to increase likelihood of trouble
+set_autopthread_size(0); # zero ensures we get threading
+
+# Add DEV unless you want it to prompt you:
+my $pl = PDL::Graphics::PLplot->new(DEV => $dev, FILE => $pltfile);
+
+# Some simple sequential data
+my $xs = sequence($grid_size);
+my $ys = sequence($grid_size)->transpose;
+
+# Plot data so that increasing y-values have different colors:
+$pl->xyplot($xs, $ys, PLOTTYPE => 'POINTS', COLORMAP => $ys);
+
+$pl->close;
+exit(0);
diff --git a/t/pnm.t b/t/pnm.t
new file mode 100644
index 0000000..c057170
--- /dev/null
+++ b/t/pnm.t
@@ -0,0 +1,97 @@
+# we need tests with index shuffling once vaffines are fixed
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+sub tapprox {
+ my($a,$b,$mdiff) = @_;
+ $mdiff = 0.01 unless defined($mdiff);
+ $c = abs($a-$b);
+ $d = max($c);
+ $d < $mdiff;
+}
+
+sub rpnm_unlink {
+ my $file = shift;
+ my $pdl = rpnm($file);
+ unlink $file;
+ return $pdl;
+}
+
+
+use PDL::LiteF;
+use PDL::IO::Pnm;
+use PDL::Dbg;
+
+$PDL::debug = $PDL::debug = 0;
+$PDL::debug = 1 if defined($ARGV[0]) && $ARGV[0] =~ /-v/;
+
+# [FORMAT, extension, ushort-divisor,
+# only RGB/no RGB/any (1/-1/0), mxdiff]
+# no test of PCX format because seems to be severely brain damaged
+ at formats = ( ['PNM', 'pnm', 1, 0, 0.01],
+ ['GIF', 'gif',256, 0, 0.01],
+ ['TIFF','tif', 1, 0, 0.01],);
+
+## GIF doesn't handle 16-bit so it has 2 * 2 tests
+## while the other formats have 2 * 3 tests each
+## $ntests = 2 * 3 * @formats ;
+$ntests = 16;
+print("1..$ntests\n");
+
+$im1 = pdl([[0,65535,0], [256,256,256], [65535,256,65535]])->ushort;
+$im2 = byte($im1/256);
+
+# make the resulting file at least 12 byte long
+# otherwise we run into a problem when reading the magic (Fix!)
+$im3 = byte [[0,0,255,255,12,13],[1,4,5,6,11,124],
+ [100,0,0,0,10,10],[2,1,0,1,0,14],[2,1,0,1,0,14],
+ [2,1,0,1,0,14]];
+
+if ($PDL::debug) {
+ print $im1;
+ $im1->px;
+ print $im2;
+ $im2->px;
+ print $im3>0;
+ $im3->px;
+}
+
+# for some reason the pnmtotiff converter coredumps when trying
+# to do the conversion for the ushort data, haven't yet tried to
+# figure out why
+$n = 1;
+for $raw (0,1) {
+ foreach $form (@formats) {
+ print "# ** testing $form->[0] format **\n";
+
+ wpnm ($im1,"tushort.$form->[1]",'PGM',$raw)
+ unless $form->[0] eq 'GIF';
+ wpnm ($im2,"tbyte.$form->[1]",'PGM',$raw);
+ wpnm ($im3,"tbin.$form->[1]",'PBM',$raw);
+ $in1 = rpnm_unlink("tushort.$form->[1]") unless $form->[0] eq 'GIF';
+ $in2 = rpnm_unlink("tbyte.$form->[1]");
+ $in3 = rpnm_unlink("tbin.$form->[1]");
+
+ if ($form->[0] ne 'GIF') {
+ $scale = ($form->[3] ? $im1->dummy(0,3) : $im1);
+ $comp = $scale / $form->[2];
+ ok($n++,tapprox($comp,$in1,$form->[4]));
+ }
+ $comp = ($form->[3] ? $im2->dummy(0,3) : $im2);
+ ok($n++,tapprox($comp,$in2));
+ $comp = ($form->[3] ? ($im3->dummy(0,3)>0)*255 : ($im3 > 0));
+ $comp = $comp->ushort*65535 if $form->[0] eq 'SGI'; # yet another format quirk
+ ok($n++,tapprox($comp,$in3));
+
+ if ($PDL::debug) {
+ print $in1->px unless $form->[0] eq 'TIFF';
+ print $in2->px;
+ print $in3->px;
+ }
+ }
+}
diff --git a/t/poly.t b/t/poly.t
new file mode 100644
index 0000000..ad3cad0
--- /dev/null
+++ b/t/poly.t
@@ -0,0 +1,44 @@
+use PDL::LiteF;
+BEGIN {
+ eval " use PDL::Fit::Polynomial; ";
+ $loaded = ($@ ? 0 : 1);
+}
+
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+print "1..1\n";
+
+unless ($loaded) {
+ for (1..1) {
+ print "ok $_ # Skipped: probably PDL::Slatec not available.\n";
+ }
+ exit;
+}
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+$x = sequence(20)-10;
+$y = 30-2*$x+3*$x**2-2*$x**3;
+
+# Random numbers, generated by grandom($y)*100
+# Hard-wired to avoid OS seed variations barfing test
+
+$rand = pdl qw/65.735917 -40.510143 -122.07767 -19.591344 -139.76362
+106.44639 -0.30094068 -5.3129683 49.815455 97.247868 -9.3130775
+19.585472 8.5260268 -194.49596 73.822799 25.628967 133.36015 -2.6611465
+9.0335632 -0.82946383/;
+
+$y += $rand;
+
+#points $x,$y;
+
+$yfit = fitpoly1d($x,$y,4);
+
+#hold; line $x, $yfit;
+
+ok(1, max(abs($y-$yfit)) < 220); # need to add 10 for windows
diff --git a/t/polyroots.t b/t/polyroots.t
new file mode 100644
index 0000000..1192cb8
--- /dev/null
+++ b/t/polyroots.t
@@ -0,0 +1,24 @@
+use PDL::LiteF;
+use PDL::Math;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+print "1..1\n";
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+sub tapprox {
+ my($a,$b) = @_;
+ $c = abs($a-$b);
+ $d = max($c);
+ $d < 0.01;
+}
+
+ok(1, tapprox(qsort((polyroots(pdl(1,-55,1320,-18150,157773,-902055,
+3416930,-8409500,12753576,-10628640,3628800),zeroes(11)))[0]),1+sequence(10)));
+
diff --git a/t/pp_croaking.t b/t/pp_croaking.t
new file mode 100644
index 0000000..4371308
--- /dev/null
+++ b/t/pp_croaking.t
@@ -0,0 +1,31 @@
+# Test the error reporting for malformed PDL::PP code.
+use Test::More tests => 3;
+
+# Load up PDL::PP
+use PDL::PP qw(foo::bar foo::bar foobar);
+
+# Prevent file generation (does not prevent calling of functions)
+$PDL::PP::done = 1;
+
+# Check the loop malformed call:
+eval {
+ pp_def(test1 =>
+ Pars => 'a(n)',
+ Code => q{
+ loop %{
+ $a()++;
+ %}
+ }
+ );
+};
+
+my $err_msg = $@;
+isnt($@, undef, 'loop without dim name should throw an error');
+like($@, qr/Expected.*loop.*%\{/, 'loop without dim name should explain the error')
+ or diag("Got this error: $@");
+
+TODO: {
+ local $TODO = 'Have not figured out why @CARP_NOT is not working';
+ unlike($@, qr/PP\.pm/, 'Should not report error as coming from PDL::PP');
+};
+
diff --git a/t/pp_line_numbers.t b/t/pp_line_numbers.t
new file mode 100644
index 0000000..2e73ad2
--- /dev/null
+++ b/t/pp_line_numbers.t
@@ -0,0 +1,62 @@
+# DO NOT MODIFY - IT IS VERY FINICKY; see notes below.
+
+$^W = 0;
+
+# Five tests for each of two types:
+use Test::More tests => 10;
+use PDL::PP qw(foo::bar foo::bar foobar);
+
+# Add some tests for pp_line_numbers:
+pp_def(test1 =>
+ Pars => 'a(n)',
+ Code => pp_line_numbers (__LINE__, q{
+ /* line 13, First line */
+ threadloop %{
+ /* line 15, Line after threadloop */
+ loop (n) %{
+ /* line 17, Line after loop */
+ %}
+ /* line 19, Line after close of loop */
+ %}
+ /* line 21, Line after close of threadloop */
+ }),
+ GenericTypes => [qw(F D)],
+);
+
+pp_done;
+
+unlink 'foobar.pm';
+
+
+# Analyze the output of pp_line_numbers by checking the line numbering in
+# foobar.xs. Note that the line *after* the #line directive is assigned the
+# number of the #line directive. See http://gcc.gnu.org/onlinedocs/cpp/Line-Control.html
+my ($line, $file) = (1, 'foobar.xs');
+open my $fh, '<', 'foobar.xs';
+LINE: while(<$fh>) {
+ # Take note of explicit line directives
+ if (/#line (\d+) ".*"/) {
+ ($line, $file) = ($1, $2);
+ next LINE;
+ }
+
+ # look for items to check:
+ if (m|/\* line (\d+), (.*?) \*/|) {
+ my ($actual_line, $description) = ($1, $2);
+ is($line, $actual_line, $description);
+ }
+ $line++;
+}
+close $fh;
+unlink 'foobar.xs';
+
+__END__
+
+This test is very finicky because it uses __LINE__, but it also explicitly
+indicates the line numbers in the /* comments */. As such, if you add a line
+of text (comment or code) before or within the pp_def, all of the line
+numbers in the /* comments */ will be off. It's a minor headache to adjust
+them, so please just don't mess with this test, unless of course you wish to
+fix it. :-)
+
+--DCM, December 13, 2011
diff --git a/t/pptest.t b/t/pptest.t
new file mode 100644
index 0000000..be67965
--- /dev/null
+++ b/t/pptest.t
@@ -0,0 +1,92 @@
+use Test::More tests => 24;
+use Test::Warn;
+
+use PDL::LiteF;
+use PDL::Types;
+use PDL::Dbg;
+
+BEGIN
+{
+ warning_like{ require PDL::Tests; PDL::Tests->import; }
+ qr/deprecated.*PDL::Test::Fancy/,
+ "PP deprecation should emit warnings";
+}
+
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+# Is there any good reason we don't use PDL's approx function?
+sub tapprox {
+ my($a,$b,$c,$d) = @_;
+ $c = abs($a-$b);
+ $d = max($c);
+ return $d < 0.01;
+}
+
+$a = xvals(zeroes(byte, 2, 4));
+
+# $P() affine tests
+test_foop($a,($b=null));
+ok( tapprox($a,$b) )
+ or diag $b;
+
+test_foop($a->xchg(0,1),($b=null));
+ok( tapprox($a->xchg(0,1),$b) )
+ or diag $b;
+
+$vaff = $a->dummy(2,3)->xchg(1,2);
+test_foop($vaff,($b=null));
+ok( tapprox($vaff,$b) )
+ or diag ($vaff, $vaff->dump);
+
+
+# now in primitive.t
+# double qualifier
+#$a = ones(byte,3000);
+#test_dsumover($a,($b=null));
+#ok( $b->get_datatype, $PDL_D );
+#ok( $b->at, 3000 );
+
+# float qualifier
+$a = ones(byte,3000);
+test_fsumover($a,($b=null));
+is( $b->get_datatype, $PDL_F );
+is( $b->at, 3000 );
+
+# int+ qualifier
+for (byte,short,ushort,long,float,double) {
+ $a = ones($_,3000);
+ test_nsumover($a,($b=null));
+ is( $b->get_datatype, (($PDL_L > $_->[0]) ? $PDL_L : $_->[0]) );
+ is( $b->at, 3000 );
+}
+
+test_setdim(($a=null),10);
+is( join(',',$a->dims), "10" );
+ok( tapprox($a,sequence(10)) );
+
+# this used to segv under solaris according to Karl
+{ local $=0; # To suppress warnings of use of uninitialized value.
+ $ny=7;
+ $a = double xvals zeroes (20,$ny);
+ test_fooseg $a, $b=null;
+
+ ok( 1 ); # if we get here at all that is alright
+ ok( tapprox($a,$b) )
+ or diag($a, "\n", $b);
+}
+
+
+# test the bug alluded to in the comments in
+# pdl_changed (pdlapi.c)
+# used to segfault
+$xx=ones(float,3,4);
+$sl1 = $xx->slice('(0)');
+$sl11 = $sl1->slice('');
+$sl2 = $xx->slice('(1)');
+$sl22 = $sl2->slice('');
+
+test_fooflow2 $sl11, $sl22;
+
+ok(all $xx->slice('(0)') == 599);
+ok(all $xx->slice('(1)') == 699);
diff --git a/t/primitive.t b/t/primitive.t
new file mode 100644
index 0000000..10a76ec
--- /dev/null
+++ b/t/primitive.t
@@ -0,0 +1,241 @@
+# -*-perl-*-
+# Test ->slice(). This is not yet good enough: we need
+# nasty test cases,
+
+use PDL::LiteF;
+use PDL::Types;
+
+# kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+# PDL::Core::set_debugging(1);
+
+use strict;
+use Test::More;
+
+plan tests => 48;
+
+sub tapprox {
+ my($a,$b) = @_;
+ if((join ',',$a->dims) ne (join ',',$b->dims)) {
+ diag "APPROX: $a $b\n";
+ diag "UNEQDIM\n";
+ return 0;
+ }
+ my $d = max( abs($a-$b) );
+ if($d >= 0.01) {
+ diag "APPROX: $a $b\n";
+ diag "# APPROXFAIL: $a $b\n";
+ }
+ $d < 0.01;
+}
+
+my $a = PDL->pdl([[5,4,3],[2,3,1.5]]);
+
+ok(tapprox($a->average(), PDL->pdl([4, 2.16666])), "average"); # 1
+ok(tapprox($a->sumover(), PDL->pdl([12, 6.5])), "sumover"); # 2
+ok(tapprox($a->prodover(), PDL->pdl([60, 9])), "prodover"); # 3
+
+my $b = PDL->pdl(4,3,1,0,0,0,0,5,2,0,3,6);
+# diag "B: $b\n";
+my $c = ($b->xvals) + 10;
+# diag "C: $c\n";
+
+# diag "BW: ", $b->where, "\n";
+ok(tapprox($b->where($b>4), PDL->pdl(5,6)), "where with >"); # 4
+ok(tapprox($b->which, PDL->pdl(0,1,2,7,8,10,11)), "which"); # 5
+
+# diag "B, ",$b->which();
+# diag "C: $c\n";
+# diag "\nCI, ", $c->index($b->which());
+# diag "D\n";
+
+ok(tapprox($c->where($b), PDL->pdl(10,11,12,17,18,20,21)), "where with mask"); # 6
+
+##############################
+# originally in pptest
+$a = ones(byte,3000);
+dsumover($a,($b=null));
+is($b->get_datatype, $PDL_D, "get_datatype" ); # 7
+is($b->at, 3000, "at" ); # 8
+
+my $p = pdl [ 1, 2, 3, 4, 7, 9, 1, 1, 6, 2, 5];
+my $q = zeroes 5;
+minimum_n_ind $p, $q;
+ok(tapprox($q, pdl(0, 6, 7, 1, 9)), "minimum_n_ind"); # 9
+
+##############################
+# check that our random functions work with Perl's srand
+srand 5;
+my $r1 = random 10;
+srand 5;
+my $r2 = random 10;
+ok(tapprox($r1, $r2), "random and srand"); #10
+
+srand 10;
+$r1 = grandom 10;
+srand 10;
+$r2 = grandom 10;
+ok(tapprox($r1, $r2), "grandom and srand"); #11
+
+##############################
+# Test that whichND works OK
+my $r = xvals(10,10)+10*yvals(10,10);
+$a = whichND( $r % 12 == 0 );
+
+# Nontrivial case gives correct coordinates
+ok(eval 'sum($a != pdl([0,0],[2,1],[4,2],[6,3],[8,4],[0,6],[2,7],[4,8],[6,9]))==0', "whichND"); #12
+
+# Empty case gives matching Empty
+$a = whichND( $r*0 );
+ok($a->nelem==0, "whichND( 0*\$r ) gives an Empty PDL"); #13
+ok($a->ndims==2, "whichND( 0*\$r ) has 2 dims"); #14
+ok(($a->dim(0)==2 and $a->dim(1)==0), "whichND( 0*\$r ) is 2x0"); #15
+
+# Scalar PDLs are treated as 1-PDLs
+$a = whichND(pdl(5));
+ok($a->nelem==1 && $a==0, "whichND"); #16
+
+# Scalar empty case returns a 1-D vector of size 0
+$a = whichND(pdl(0));
+ok($a->nelem==0, "whichND of 0 scalar is empty"); #17
+ok($a->ndims==1, "whichND of 0 scalar has 1 dim"); #18
+ok($a->dim(0)==0, "whichND of 0 scalar: return 0 dim size is 0"); #19
+
+# Empty case returns Empty
+$b = whichND( which(pdl(0)) );
+ok($b->nelem==0, "whichND of Empty mask"); #20
+
+# Nontrivial empty mask case returns matching Empty -- whichND(Empty[2x0x2]) should return Empty[3x0]
+$b = whichND(zeroes(2,0,2));
+ok(($b->ndims==2 and $b->dim(0)==3 and $b->dim(1)==0), "whichND(Empty[2x0x2]) returns Empty[3x0]"); # 21
+
+
+##############################
+# Simple test case for interpND
+my $index;
+my $z;
+$a = xvals(10,10)+yvals(10,10)*10;
+$index = cat(3+xvals(5,5)*0.25,7+yvals(5,5)*0.25)->reorder(2,0,1);
+$z = 73+xvals(5,5)*0.25+2.5*yvals(5,5);
+eval '$b = $a->interpND($index);';
+ok(!$@); #16
+ok(sum($b != $z) == 0, "interpND"); #17
+
+##############################
+# Test glue
+$a = xvals(2,2,2);
+$b = yvals(2,2,2);
+$c = zvals(2,2,2);
+our $d;
+eval '$d = $a->glue(1,$b,$c);';
+ok(!$@); #18
+ok(zcheck($d - pdl([[0,1],[0,1],[0,0],[1,1],[0,0],[0,0]],
+ [[0,1],[0,1],[0,0],[1,1],[1,1],[1,1]])), "glue"); #19
+
+
+
+##############################
+# test new empty piddle handling
+$a = which ones(4) > 2;
+$b = $a->long;
+$c = $a->double;
+
+ok(isempty $a, "isempty"); #20
+ok($b->avg == 0, "avg of Empty"); #21
+ok(! any isfinite $c->average, "isfinite of Empty"); #22
+
+##############################
+# Test uniqvec
+$a = pdl([[0,1],[2,2],[0,1]]);
+$b = $a->uniqvec;
+eval '$c = all($b==pdl([[0,1],[2,2]]))';
+ok(!$@ && $c && $b->ndims==2, "uniqvec"); #23
+
+$a = pdl([[0,1]])->uniqvec;
+eval '$c = all($a==pdl([[0,1]]))';
+ok(!$@ && $c && $a->ndims==2, "uniqvec"); #24
+
+$a = pdl([[0,1,2]]); $a = $a->glue(1,$a,$a);
+$b = $a->uniqvec;
+eval '$c = all($b==pdl([0,1,2]))';
+ok(!$@ && $c && $b->ndims==2, "uniqvec"); #25
+
+##############################
+# Test bad handling in selector
+SKIP: {
+ skip "Bad handling not available", 3 unless $PDL::Bad::Status;
+
+ $b = xvals(3);
+ ok(tapprox($b->which,PDL->pdl(1,2)), "which"); #26
+ setbadat $b, 1;
+ ok(tapprox($b->which,PDL->pdl([2])), "which w BAD"); #27
+ setbadat $b, 0;
+ setbadat $b, 2;
+ is($b->which->nelem,0, "which nelem w BAD"); #28
+}
+
+############################
+# Test intersect & setops
+my $x = sequence(10);
+$a = which(($x % 2) == 0);
+$b = which(($x % 3) == 0);
+$c = setops($a, 'AND', $b);
+ok(tapprox($c, pdl([0, 6])), "setops AND"); #29
+$c = setops($a,'OR',$b);
+ok(tapprox($c, pdl([0,2,3,4,6,8,9])), "setops OR"); #30
+$c = setops($a,'XOR',$b);
+ok(tapprox($c, pdl([2,3,4,8,9])), "setops XOR"); #31
+
+
+##############################
+# Test uniqind
+$a = pdl([0,1,2,2,0,1]);
+$b = $a->uniqind;
+eval '$c = all($b==pdl([0,1,3]))';
+ok(!$@ && $c && $b->ndims==1, "uniqind"); #32
+
+$b = pdl(1,1,1,1,1)->uniqind; # SF bug 3076570
+ok(! $b->isempty); #33
+eval '$c = all($b==pdl([0]))';
+ok(!$@ && $c && $b->ndims==1, "uniqind, SF bug 3076570"); #34
+
+##############################
+# Test whereND
+SKIP: {
+ skip "have no whereND", 8 unless defined(&PDL::whereND);
+
+ $a = sequence(4,3,2);
+ $b = pdl(0,1,1,0);
+ $c = whereND($a,$b);
+ ok(all(pdl($c->dims)==pdl(2,3,2))) and #35
+ ok(all($c==pdl q[ [ [ 1 2] [ 5 6] [ 9 10] ]
+ [ [13 14] [17 18] [21 22] ] ]),
+ "whereND [4]"); #36
+
+ $b = pdl q[ 0 0 1 1 ; 0 1 0 0 ; 1 0 0 0 ];
+ $c = whereND($a,$b);
+ ok(all(pdl($c->dims)==pdl(4,2))) and #37
+ ok(all($c==pdl q[ 2 3 5 8 ; 14 15 17 20 ]),
+ "whereND [4,3]"); #38
+
+ $b = (random($a)<0.3);
+ $c = whereND($a,$b);
+ ok(all($c==where($a,$b)), "whereND vs where"); #39
+
+ # sf.net bug #3415115, whereND fails to handle all zero mask case
+ $b = zeros(4);
+ $c = whereND($a,$b);
+ ok($c->isempty, 'whereND of all-zeros mask'); #40
+
+ # Make sure whereND functions as an lvalue:
+ $a = sequence(4,3);
+ $b = pdl(0, 1, 1, 1);
+
+ eval q{
+ $a->whereND($b) *= -1;
+ };
+ is($@, '', 'using whereND in lvalue context does not croak');
+ #41
+ ok(all($a->slice("1:-1") < 0), 'whereND in lvalue context works');
+ #42
+}
diff --git a/t/primitive2.t b/t/primitive2.t
new file mode 100644
index 0000000..c48827b
--- /dev/null
+++ b/t/primitive2.t
@@ -0,0 +1,110 @@
+# Script to test some of the primitive operations for returning the correct values.
+#
+#
+# Testing utility functions:
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+sub tapprox {
+ my($a,$b) = @_;
+ my $c = abs($a-$b);
+ my $d = ref($c) ? max($c) : $c ; # don't do a make if were are dealing
+ # with a scalar
+ $c < 0.01;
+}
+
+
+###### Testing Begins #########
+print "1..27\n";
+
+
+use PDL::LiteF;
+
+
+$im = new PDL [
+ [ 1, 2, 3, 3 , 5],
+ [ 2, 3, 4, 5, 6],
+ [13, 13, 13, 13, 13],
+ [ 1, 3, 1, 3, 1],
+ [10, 10, 2, 2, 2,]
+ ];
+
+
+my @minMax = $im->minmax;
+# print "MinMax = ".join(", ", at minMax)."\n";
+
+my $testNo = 1;
+
+ok($testNo++, $minMax[0] == 1 );
+ok($testNo++, $minMax[1] == 13 );
+
+
+ok($testNo++, ($im x $im)->sum == 3429 );
+
+
+my @statsRes = $im->stats;
+
+ok($testNo++, tapprox($statsRes[0],5.36) );
+ok($testNo++, tapprox($statsRes[1],4.554) );
+ok($testNo++, tapprox($statsRes[2],3) );
+ok($testNo++, tapprox($statsRes[3],1) );
+ok($testNo++, tapprox($statsRes[4],13) );
+ok($testNo++, tapprox($statsRes[6],4.462));
+
+ at statsRes = $im->short->stats; # Make sure that stats are promoted to floating-point
+
+ok($testNo++, tapprox($statsRes[0],5.36) );
+ok($testNo++, tapprox($statsRes[1],4.554) );
+ok($testNo++, tapprox($statsRes[2],3) );
+ok($testNo++, tapprox($statsRes[3],1) );
+ok($testNo++, tapprox($statsRes[4],13) );
+ok($testNo++, tapprox($statsRes[6],4.462));
+
+# print "StatRes = ".join(", ", at statsRes)."\n";
+
+
+my $ones = ones(5,5);
+
+ at statsRes = $im->stats($ones);
+
+# print "StatRes with moments = ".join(", ", at statsRes)."\n";
+ok($testNo++, tapprox($statsRes[0],5.36) );
+ok($testNo++, tapprox($statsRes[1],4.554) );
+ok($testNo++, tapprox($statsRes[2],3) );
+ok($testNo++, tapprox($statsRes[3],1) );
+ok($testNo++, tapprox($statsRes[4],13) );
+ok($testNo++, tapprox($statsRes[6],4.462));
+
+# which ND test
+my $a= PDL->sequence(10,10,3,4);
+
+# $PDL::whichND_no_warning = 1;
+# ($x, $y, $z, $w)=whichND($a == 203);
+($x, $y, $z, $w) = whichND($a == 203)->mv(0,-1)->dog; # quiet deprecation warning
+
+ok($testNo++,$a->at($x->list,$y->list,$z->list,$w->list) == 203 );
+
+$a = pdl(1,2,3,4);
+$b = append($a,2);
+ok($testNo++,int(sum($b))==12);
+
+
+
+# clip tests
+ok($testNo++, tapprox($im->hclip(5)->sum,83) );
+
+ok($testNo++, tapprox($im->lclip(5)->sum,176) );
+
+
+ok($testNo++, tapprox($im->clip(5,7)->sum,140) );
+
+# indadd Test:
+$a = pdl( 1,2,3);
+$ind = pdl( 1,4,6);
+$sum = zeroes(10);
+indadd($a,$ind, $sum);
+ok($testNo++, tapprox($sum->sum,6) );
diff --git a/t/proj_transform.t b/t/proj_transform.t
new file mode 100644
index 0000000..dadae16
--- /dev/null
+++ b/t/proj_transform.t
@@ -0,0 +1,425 @@
+#!/usr/bin/perl
+
+#
+# t/proj_transform.t
+#
+# Test program for the PDL::Transform::Proj4 library
+#
+# Judd Taylor, Orbital Systems, Ltd.
+# judd.t at orbtialsystems.com
+#
+# 17 April 2008
+#
+
+use PDL;
+use Test::More;
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_PROJ} )
+ {
+ eval( " use PDL::Transform::Proj4; " );
+ if( !($@) )
+ {
+ $test_jpegtopnm = 1;
+ if($^O =~ /MSWin32/i)
+ {
+ $test_jpegtopnm = `jpegtopnm --help 2>&1`;
+ $test_jpegtopnm = $test_jpegtopnm =~ /^jpegtopnm:/ ? 1 : 0;
+ }
+ elsif ( !defined( scalar( qx(jpegtopnm --help 2>&1) ) ) )
+ {
+ $test_jpegtopnm = 0;
+ }
+ if( $PDL::Bad::Status )
+ {
+ if( $test_jpegtopnm )
+ {
+ plan tests => 22
+ }
+ else
+ {
+ plan skip_all => "The jpegtopnm utility (needed for proj_transform.t tests) not found.";
+ }
+ }
+ else
+ {
+ plan skip_all => "PDL::Transform::Proj4 requires the PDL::Bad module.";
+ }
+ }
+ else
+ {
+ plan skip_all => "PDL::Transform::Proj4 module compiled, but not available.";
+ }
+ }
+ else
+ {
+ plan skip_all => "PDL::Transform::Proj4 module not compiled.";
+ }
+}
+
+#
+# Test integration with PDL::Transform
+#
+
+BEGIN
+{
+ use_ok(PDL::Transform::Cartography); # TEST 1
+}
+
+### Get the vector coastline map (and a lon/lat grid), and load the Earth
+### RGB daytime image -- both of these are built-in to the module. The
+### coastline map is a set of (X,Y,Pen) vectors.
+###
+### This doesn't seem to be used. # chm 14-May-2009
+### my $coast = earth_coast()->glue( 1, graticule(15,1) );
+
+eval { my $map = earth_image( 'day' ) };
+
+if ($@) {
+ skip("earth_image() can not load test data", 21);
+} else {
+ pass("earth_image() loaded"); # TEST 2
+}
+
+my $map = earth_image( 'day' );
+$map->badflag(1);
+
+SKIP: {
+
+ my $checksum = unpack "%16C*", ${$map->get_dataref};
+ my $goodcheck = 56639;
+ if ($checksum != $goodcheck) {
+ skip "earth_image() map has bad checksum: $checksum (expected $goodcheck)", 20;
+ }
+
+ my $map_size = [500,500];
+
+ my @slices = (
+ "245:254,68:77,(0)",
+ "128:137,272:281,(0)",
+ "245:254,262:271,(0)",
+ "390:399,245:254,(0)",
+ "271:280,464:473,(0)"
+ );
+
+
+ ##############
+ # TESTS 3-7: #
+ ##############
+ # Get EQC reference data:
+ my @ref_eqc_slices = get_ref_eqc_slices();
+
+ # Check EQC map against reference:
+ my $eqc_opts = "+proj=eqc +lon_0=0";
+ my $eqc = eval '$map->map( t_proj( proj_params => $eqc_opts ), $map_size )';
+ if (! defined($eqc)) {
+ diag("PROJ4 error: $@\n");
+ skip "Possible bad PROJ4 install",20 if $@ =~ m/Projection initialization failed/;
+ }
+ foreach my $i ( 0 .. $#slices )
+ {
+ my $str = $slices[$i];
+ my $slice = $eqc->slice($str)->copy;
+ $slice->badflag(0);
+ # ok( "$slice" eq $ref_eqc_slices[$i], "check ref_eqc for slices[$i]" );
+ is( "$slice", $ref_eqc_slices[$i], "check ref_eqc for slices[$i]" );
+ }
+
+ ###############
+ # TESTS 8-12: #
+ ###############
+ # Get Ortho reference data:
+ my @ref_ortho_slices = get_ref_ortho_slices();
+
+ # Check Ortho map against reference:
+ my $ortho_opts = "+proj=ortho +ellps=WGS84 +lon_0=-90 +lat_0=40";
+ my $ortho = $map->map( t_proj( proj_params => $ortho_opts ), $map_size );
+ foreach my $i ( 0 .. $#slices )
+ {
+ my $str = $slices[$i];
+ my $slice = $ortho->slice($str)->copy;
+ $slice->badflag(0);
+ # ok( "$slice" eq $ref_ortho_slices[$i], "check ref_ortho for slices[$i]" );
+ is( "$slice", $ref_ortho_slices[$i], "check ref_ortho for slices[$i]" );
+ }
+
+ #
+ # Test the auto-generated methods:
+ #
+ ################
+ # TESTS 13-17: #
+ ################
+ my $ortho2 = $map->map( t_proj_ortho( ellps => 'WGS84', lon_0 => -90, lat_0 => 40 ), $map_size );
+ foreach my $i ( 0 .. $#slices )
+ {
+ my $str = $slices[$i];
+ my $slice = $ortho2->slice($str)->copy;
+ $slice->badflag(0);
+ # ok( "$slice" eq $ref_ortho_slices[$i], "check ref_ortho2 for slices[$i]" );
+ is( "$slice", $ref_ortho_slices[$i], "check ref_ortho2 for slices[$i]" );
+ }
+
+ ################
+ # TESTS 18-22: #
+ ################
+ # Get Robinson reference data:
+ my @ref_robin_slices = get_ref_robin_slices();
+
+ # Check Robinson map against reference:
+ my $robin = $map->map( t_proj_robin( ellps => 'WGS84', over => 1 ), $map_size );
+ foreach my $i ( 0 .. $#slices )
+ {
+ my $str = $slices[$i];
+ my $slice = $robin->slice($str);
+ # ok( "$slice" eq $ref_robin_slices[$i], "check ref_robin for slices[$i]" );
+ is( "$slice", $ref_robin_slices[$i], "check ref_robin for slices[$i]" );
+ }
+
+}
+exit(0);
+
+
+sub get_ref_robin_slices
+{
+ my @slices = ();
+ push(@slices, <<"END");
+
+[
+ [0 0 0 0 0 0 0 2 0 0]
+ [0 0 0 0 0 0 0 3 0 0]
+ [0 0 2 2 2 2 2 5 1 1]
+ [0 0 2 2 2 2 2 5 1 1]
+ [0 0 2 2 2 2 2 5 1 1]
+ [0 0 2 2 2 2 2 2 0 0]
+ [2 2 1 1 1 1 1 2 0 0]
+ [2 2 0 0 0 0 0 2 0 0]
+ [0 0 0 0 0 0 0 2 0 0]
+ [0 0 0 4 1 2 2 2 0 0]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [ 1 4 4 4 4 0 0 2 13 0]
+ [ 5 4 4 4 4 0 0 0 0 32]
+ [ 6 2 4 4 4 0 0 6 3 70]
+ [ 8 2 4 4 4 0 9 20 34 60]
+ [ 0 1 0 5 4 0 48 75 69 64]
+ [ 0 1 0 0 3 0 48 66 44 4]
+ [ 3 1 0 1 2 0 69 60 3 0]
+ [ 1 1 0 4 23 57 63 36 2 0]
+ [ 0 1 0 3 35 71 58 21 0 0]
+ [ 5 5 0 48 59 72 65 0 0 0]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [ 1 1 1 1 1 1 1 1 1 0]
+ [ 4 0 10 4 0 1 1 1 1 0]
+ [ 3 2 4 5 5 1 1 1 1 0]
+ [ 14 46 85 9 4 1 1 1 1 0]
+ [ 93 83 67 96 27 1 1 1 1 0]
+ [ 74 70 70 75 81 37 11 10 4 2]
+ [ 77 63 71 82 71 95 0 3 9 4]
+ [ 80 70 62 69 69 87 107 43 12 11]
+ [ 75 53 80 79 62 107 86 119 117 102]
+ [ 80 77 74 71 73 74 92 90 119 106]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [47 50 60 35 39 13 1 5 9 0]
+ [39 52 61 27 33 5 0 9 5 0]
+ [35 47 54 28 12 0 4 5 4 0]
+ [30 48 51 40 0 21 8 0 1 0]
+ [29 39 41 19 11 18 7 0 0 0]
+ [41 48 54 26 14 10 2 1 0 0]
+ [52 61 38 42 0 2 0 4 1 0]
+ [65 45 18 70 9 13 0 4 2 0]
+ [65 32 41 49 38 1 0 4 4 1]
+ [59 23 9 31 69 0 0 1 2 1]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [ 8 0 0 0 4 9 1 0 0 0]
+ [ 0 0 6 0 0 7 3 0 0 0]
+ [ 0 0 9 12 0 2 0 3 0 0]
+ [ 1 5 2 1 0 0 4 7 3 0]
+ [ 3 2 6 0 1 0 4 5 0 3]
+ [ 0 2 2 0 2 5 0 0 0 8]
+ [ 0 0 0 0 2 2 0 0 0 0]
+ [ 0 0 0 0 0 0 0 4 0 0]
+ [ 0 0 0 0 0 0 0 0 0 0]
+ [ 0 0 0 0 0 0 0 0 0 0]
+]
+END
+ return @slices;
+} # End of get_ref_robin_slices()...
+
+sub get_ref_ortho_slices
+{
+ my @slices = ();
+ push(@slices, <<"END");
+
+[
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+ [0 0 0 0 0 0 0 0 0 0]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [0 0 0 3 3 3 3 0 0 1]
+ [0 0 0 3 3 3 3 1 0 0]
+ [0 0 0 0 3 3 3 1 0 0]
+ [0 0 0 0 3 3 3 3 0 0]
+ [0 0 0 0 3 3 3 3 1 0]
+ [0 0 0 0 0 3 3 3 3 0]
+ [0 0 0 0 0 3 3 3 3 1]
+ [0 0 0 0 0 0 3 3 3 3]
+ [0 0 0 0 0 0 3 3 3 3]
+ [0 0 0 0 0 0 0 3 3 3]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [59 61 61 61 59 55 56 60 64 66]
+ [62 58 58 58 56 50 52 59 64 66]
+ [63 57 57 57 55 48 50 58 64 66]
+ [63 57 57 57 55 47 49 58 65 66]
+ [55 58 63 59 51 43 47 57 65 52]
+ [53 58 59 54 47 47 50 59 67 46]
+ [53 58 56 51 45 51 53 61 68 52]
+ [54 57 53 51 57 52 54 61 66 66]
+ [62 55 53 60 66 50 51 55 59 67]
+ [63 53 52 61 71 49 49 51 53 56]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [1 1 1 1 1 1 1 1 1 1]
+ [1 1 1 1 1 1 1 1 1 1]
+ [1 1 1 1 1 1 1 1 1 1]
+ [1 1 1 1 1 1 1 1 1 1]
+ [1 1 1 1 1 1 1 1 1 1]
+ [1 1 1 1 1 1 1 1 1 1]
+ [1 1 1 1 1 1 1 1 1 1]
+ [1 1 1 1 1 1 1 1 1 1]
+ [1 1 1 1 1 1 1 1 1 1]
+ [1 1 1 1 1 1 1 1 1 1]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [155 159 8 0 9 3 4 0 0 0]
+ [255 208 27 2 1 1 2 5 2 0]
+ [ 13 4 4 5 0 3 1 1 4 0]
+ [ 9 0 0 0 0 0 0 0 0 0]
+ [ 0 0 0 0 12 0 0 0 0 0]
+ [ 7 0 0 0 6 5 13 168 7 3]
+ [239 241 241 218 247 233 248 245 243 246]
+ [ 37 138 34 211 71 17 1 0 1 10]
+ [ 0 0 0 0 1 0 0 9 20 11]
+ [ 0 0 0 0 0 1 5 2 0 0]
+]
+END
+ return @slices;
+} # End of get_ref_ortho_slices()...
+
+sub get_ref_eqc_slices
+{
+ my @slices = ();
+ push(@slices, <<"END");
+
+[
+ [254 254 254 254 254 254 254 254 254 254]
+ [254 254 254 254 254 254 254 254 254 254]
+ [252 240 238 252 252 242 243 254 255 251]
+ [254 226 254 254 254 233 236 255 255 253]
+ [229 241 255 255 253 249 254 255 255 255]
+ [254 242 254 253 248 238 255 255 255 255]
+ [247 247 115 38 247 42 242 255 255 254]
+ [ 64 132 59 163 0 35 242 229 226 239]
+ [ 11 36 49 0 0 3 233 157 159 214]
+ [ 26 31 0 4 16 0 0 37 0 167]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [ 5 4 4 4 4 0 11 17 53 75]
+ [ 0 3 0 3 1 0 49 92 74 69]
+ [ 0 2 0 0 5 0 55 69 44 19]
+ [ 0 2 0 0 0 22 66 34 0 0]
+ [ 0 2 0 8 16 66 52 10 1 0]
+ [ 0 2 4 57 63 95 59 0 0 0]
+ [ 7 4 0 74 82 65 15 0 0 0]
+ [10 4 1 69 90 84 0 0 0 1]
+ [ 0 0 9 66 90 76 1 0 0 2]
+ [ 4 15 35 10 80 48 0 0 0 1]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [ 0 12 3 0 9 1 1 1 1 0]
+ [ 2 1 42 3 3 1 1 1 1 0]
+ [ 61 86 83 64 0 1 1 1 1 0]
+ [ 82 68 74 67 82 1 1 1 1 0]
+ [ 77 63 71 82 71 95 0 3 9 4]
+ [ 80 70 62 69 69 87 107 43 12 11]
+ [ 75 53 80 79 62 107 86 119 117 102]
+ [ 80 77 74 71 73 74 92 90 119 106]
+ [ 72 85 83 73 64 73 86 92 110 110]
+ [ 81 78 75 77 78 78 91 88 91 102]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [42 44 57 45 35 48 27 15 0 0]
+ [41 57 66 36 29 30 0 11 5 0]
+ [38 47 56 23 31 8 1 8 4 0]
+ [33 48 53 39 0 2 5 1 2 0]
+ [29 43 44 31 0 28 8 0 1 0]
+ [45 58 53 30 0 5 0 4 0 0]
+ [59 52 22 59 0 6 0 4 1 0]
+ [66 43 31 65 28 17 0 4 4 0]
+ [62 17 43 37 41 9 0 4 5 2]
+ [42 66 0 31 61 0 0 1 4 2]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [245 226 212 124 194 6 8 1 7 61]
+ [163 215 221 215 178 103 47 17 114 201]
+ [100 138 149 184 131 163 42 18 125 189]
+ [124 103 127 195 213 220 68 86 168 173]
+ [123 178 225 251 243 237 205 208 121 65]
+ [126 115 241 247 221 247 179 115 105 36]
+ [119 174 236 172 247 237 161 212 172 142]
+ [206 245 244 218 107 219 169 175 185 200]
+ [ 33 30 83 101 14 210 249 221 251 125]
+ [ 6 2 3 85 145 155 75 142 251 251]
+]
+END
+ return @slices;
+} # End of get_ref_eqc_slices()...
diff --git a/t/proj_transform2.t b/t/proj_transform2.t
new file mode 100644
index 0000000..936577e
--- /dev/null
+++ b/t/proj_transform2.t
@@ -0,0 +1,397 @@
+#!/usr/bin/perl
+
+#
+# t/proj_transform.t
+#
+# Test program for the PDL::Transform::Proj4 library
+#
+# Judd Taylor, Orbital Systems, Ltd.
+# judd.t at orbtialsystems.com
+#
+# 17 April 2008
+#
+
+use PDL;
+use Test::More;
+
+BEGIN
+{
+ use PDL::Config;
+ if ( $PDL::Config{WITH_PROJ} )
+ {
+ eval( " use PDL::Transform::Proj4; " );
+ if( !($@) )
+ {
+ if ( $PDL::Bad::Status )
+ {
+ plan tests => 20;
+ }
+ else
+ {
+ plan skip_all => "PDL::Transform::Proj4 module requires the PDL::Bad module!";
+ }
+ }
+ else
+ {
+ plan skip_all => "PDL::Transform::Proj4 module compiled, but not available.";
+ }
+ }
+ else
+ {
+ plan skip_all => "PDL::Transform::Proj4 module not compiled.";
+ }
+}
+
+#
+# Test integration with PDL::Transform
+#
+
+my $im = sequence(2048,1024)/2048/1024*255.99;
+$im = $im->byte;
+my $h = $im->fhdr;
+
+$h->{SIMPLE} = 'T';
+$h->{NAXIS} = 3;
+$h->{NAXIS1}=2048; $h->{CRPIX1}=1024.5; $h->{CRVAL1}=0;
+$h->{NAXIS2}=1024; $h->{CRPIX2}=512.5; $h->{CRVAL2}=0;
+$h->{NAXIS3}=3, $h->{CRPIX3}=1; $h->{CRVAL3}=0;
+$h->{CTYPE1}='Longitude'; $h->{CUNIT1}='degrees'; $h->{CDELT1}=180/1024.0;
+$h->{CTYPE2}='Latitude'; $h->{CUNIT2}='degrees'; $h->{CDELT2}=180/1024.0;
+$h->{CTYPE3}='RGB'; $h->{CUNIT3}='index'; $h->{CDELT3}=1.0;
+$h->{COMMENT}='Plate Caree Projection';
+$h->{HISTORY}='PDL Distribution Image, derived from NASA/MODIS data',
+
+$im->hdrcpy(1);
+$im->badflag(1);
+
+SKIP: {
+
+ my $map = $im->copy;
+
+ my $map_size = [500,500];
+
+ my @slices = (
+ "245:254,68:77,(0)",
+ "128:137,272:281,(0)",
+ "245:254,262:271,(0)",
+ "390:399,245:254,(0)",
+ "271:280,464:473,(0)"
+ );
+
+
+ ##############
+ # TESTS 1-5: #
+ ##############
+ # Get EQC reference data:
+ my @ref_eqc_slices = get_ref_eqc_slices();
+
+ # Check EQC map against reference:
+ my $eqc_opts = "+proj=eqc +lon_0=0";
+ my $eqc = eval '$map->map( t_proj( proj_params => $eqc_opts ), $map_size )';
+ if (! defined($eqc)) {
+ diag("PROJ4 error: $@\n");
+ skip "Possible bad PROJ4 install",20 if $@ =~ m/Projection initialization failed/;
+ }
+ foreach my $i ( 0 .. $#slices )
+ {
+ my $str = $slices[$i];
+ my $slice = $eqc->slice($str);
+ # ok( "$slice" eq $ref_eqc_slices[$i], "check ref_eqc for slices[$i]" );
+ is( "$slice", $ref_eqc_slices[$i], "check ref_eqc for slices[$i]" );
+ }
+
+ ###############
+ # TESTS 6-10: #
+ ###############
+ # Get Ortho reference data:
+ my @ref_ortho_slices = get_ref_ortho_slices();
+
+ # Check Ortho map against reference:
+ my $ortho_opts = "+proj=ortho +ellps=WGS84 +lon_0=-90 +lat_0=40";
+ my $ortho = $map->map( t_proj( proj_params => $ortho_opts ), $map_size );
+ foreach my $i ( 0 .. $#slices )
+ {
+ my $str = $slices[$i];
+ my $slice = $ortho->slice($str);
+ # ok( "$slice" eq $ref_ortho_slices[$i], "check ref_ortho for slices[$i]" );
+ is( "$slice", $ref_ortho_slices[$i], "check ref_ortho for slices[$i]" );
+ }
+
+ #
+ # Test the auto-generated methods:
+ #
+ ################
+ # TESTS 11-15: #
+ ################
+ my $ortho2 = $map->map( t_proj_ortho( ellps => 'WGS84', lon_0 => -90, lat_0 => 40 ), $map_size );
+ foreach my $i ( 0 .. $#slices )
+ {
+ my $str = $slices[$i];
+ my $slice = $ortho2->slice($str);
+ # ok( "$slice" eq $ref_ortho_slices[$i], "check ref_ortho2 for slices[$i]" );
+ is( "$slice", $ref_ortho_slices[$i], "check ref_ortho2 for slices[$i]" );
+ }
+
+ ################
+ # TESTS 16-20: #
+ ################
+ # Get Robinson reference data:
+ my @ref_robin_slices = get_ref_robin_slices();
+
+ # Check Robinson map against reference:
+ my $robin = $map->map( t_proj_robin( ellps => 'WGS84', over => 1 ), $map_size );
+ foreach my $i ( 0 .. $#slices )
+ {
+ my $str = $slices[$i];
+ my $slice = $robin->slice($str);
+ # ok( "$slice" eq $ref_robin_slices[$i], "check ref_robin for slices[$i]" );
+ is( "$slice", $ref_robin_slices[$i], "check ref_robin for slices[$i]" );
+ }
+
+}
+
+exit(0);
+
+
+sub get_ref_robin_slices
+{
+ my @slices = ();
+ push(@slices, <<"END");
+
+[
+ [43 43 43 43 43 43 43 43 43 43]
+ [44 44 44 44 44 44 44 44 44 44]
+ [44 44 44 44 44 44 44 44 44 44]
+ [45 45 45 45 45 45 45 45 45 45]
+ [45 45 45 45 45 45 45 45 45 45]
+ [46 46 46 46 46 46 46 46 46 46]
+ [46 46 46 46 46 46 46 46 46 46]
+ [47 47 47 47 47 47 47 47 47 47]
+ [47 47 47 47 47 47 47 47 47 47]
+ [48 48 48 48 48 48 48 48 48 48]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [138 138 138 138 138 138 138 138 138 138]
+ [138 138 138 138 138 138 138 138 138 138]
+ [139 139 139 139 139 139 139 139 139 139]
+ [139 139 139 139 139 139 139 139 139 139]
+ [140 140 140 140 140 140 140 140 140 140]
+ [140 140 140 140 140 140 140 140 140 140]
+ [141 141 141 141 141 141 141 141 141 141]
+ [141 141 141 141 141 141 141 141 141 141]
+ [141 141 141 141 141 141 141 141 141 141]
+ [142 142 142 142 142 142 142 142 142 142]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [133 133 133 133 133 133 133 133 133 133]
+ [134 134 134 134 134 134 134 134 134 134]
+ [134 134 134 134 134 134 134 134 134 134]
+ [135 135 135 135 135 135 135 135 135 135]
+ [135 135 135 135 135 135 135 135 135 135]
+ [136 136 136 136 136 136 136 136 136 136]
+ [136 136 136 136 136 136 136 136 136 136]
+ [136 136 136 136 136 136 136 136 136 136]
+ [137 137 137 137 137 137 137 137 137 137]
+ [137 137 137 137 137 137 137 137 137 137]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [125 125 125 125 125 125 125 125 125 125]
+ [126 126 126 126 126 126 126 126 126 126]
+ [126 126 126 126 126 126 126 126 126 126]
+ [127 127 127 127 127 127 127 127 127 127]
+ [127 127 127 127 127 127 127 127 127 127]
+ [128 128 128 128 128 128 128 128 128 128]
+ [128 128 128 128 128 128 128 128 128 128]
+ [129 129 129 129 129 129 129 129 129 129]
+ [129 129 129 129 129 129 129 129 129 129]
+ [130 130 130 130 130 130 130 130 130 130]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [229 229 229 229 229 229 229 229 229 229]
+ [230 230 230 230 230 230 230 230 230 230]
+ [230 230 230 230 230 230 230 230 230 230]
+ [231 231 231 231 231 231 231 231 231 231]
+ [231 231 231 231 231 231 231 231 231 231]
+ [232 232 232 232 232 232 232 232 232 232]
+ [232 232 232 232 232 232 232 232 232 232]
+ [233 233 233 233 233 233 233 233 233 233]
+ [234 234 234 234 234 234 234 234 234 234]
+ [234 234 234 234 234 234 234 234 234 234]
+]
+END
+ return @slices;
+} # End of get_ref_robin_slices()...
+
+sub get_ref_ortho_slices
+{
+ my @slices = ();
+ push(@slices, <<"END");
+
+[
+ [118 118 118 118 118 118 118 118 118 118]
+ [119 119 119 119 119 119 119 119 119 119]
+ [119 119 119 119 119 119 119 119 119 119]
+ [120 120 120 120 120 120 120 120 120 120]
+ [120 120 120 120 120 120 120 120 120 120]
+ [121 121 121 121 121 121 121 121 121 121]
+ [121 121 121 121 121 121 121 121 121 121]
+ [121 121 121 121 121 121 121 121 121 121]
+ [122 122 122 122 122 122 122 122 122 122]
+ [122 122 122 122 122 122 122 122 122 122]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [183 183 183 183 183 184 184 184 184 184]
+ [183 183 183 184 184 184 184 184 184 184]
+ [183 184 184 184 184 184 184 184 185 185]
+ [184 184 184 184 184 184 185 185 185 185]
+ [184 184 184 184 185 185 185 185 185 185]
+ [184 184 185 185 185 185 185 185 185 186]
+ [185 185 185 185 185 185 185 186 186 186]
+ [185 185 185 185 185 186 186 186 186 186]
+ [185 185 185 186 186 186 186 186 186 186]
+ [185 186 186 186 186 186 186 186 187 187]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [188 188 188 188 188 188 188 188 188 188]
+ [189 189 189 189 189 189 189 189 189 189]
+ [189 189 189 189 189 189 189 189 189 189]
+ [189 189 189 189 189 189 189 189 189 189]
+ [190 190 190 190 190 190 190 190 190 190]
+ [190 190 190 190 190 190 190 190 190 190]
+ [190 190 190 190 190 190 190 190 190 190]
+ [191 191 191 191 191 191 191 191 191 191]
+ [191 191 191 191 191 191 191 191 191 191]
+ [191 191 191 191 191 191 191 191 191 191]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [172 172 172 171 171 171 171 171 170 170]
+ [172 172 172 172 171 171 171 171 171 171]
+ [172 172 172 172 172 172 171 171 171 171]
+ [173 173 172 172 172 172 172 172 171 171]
+ [173 173 173 173 172 172 172 172 172 171]
+ [173 173 173 173 173 172 172 172 172 172]
+ [174 173 173 173 173 173 173 172 172 172]
+ [174 174 174 173 173 173 173 173 173 172]
+ [174 174 174 174 174 173 173 173 173 173]
+ [175 174 174 174 174 174 173 173 173 173]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [240 240 240 240 240 239 239 239 239 238]
+ [240 240 239 239 239 239 239 238 238 238]
+ [239 239 239 239 238 238 238 238 238 237]
+ [239 238 238 238 238 238 237 237 237 237]
+ [238 238 238 237 237 237 237 237 236 236]
+ [237 237 237 237 237 236 236 236 236 236]
+ [237 237 236 236 236 236 236 235 235 235]
+ [236 236 236 236 235 235 235 235 234 234]
+ [235 235 235 235 235 234 234 234 234 234]
+ [235 235 234 234 234 234 234 233 233 233]
+]
+END
+ return @slices;
+} # End of get_ref_ortho_slices()...
+
+sub get_ref_eqc_slices
+{
+ my @slices = ();
+ push(@slices, <<"END");
+
+[
+ [35 35 35 35 35 35 35 35 35 35]
+ [35 35 35 35 35 35 35 35 35 35]
+ [36 36 36 36 36 36 36 36 36 36]
+ [36 36 36 36 36 36 36 36 36 36]
+ [37 37 37 37 37 37 37 37 37 37]
+ [37 37 37 37 37 37 37 37 37 37]
+ [38 38 38 38 38 38 38 38 38 38]
+ [38 38 38 38 38 38 38 38 38 38]
+ [39 39 39 39 39 39 39 39 39 39]
+ [39 39 39 39 39 39 39 39 39 39]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [139 139 139 139 139 139 139 139 139 139]
+ [140 140 140 140 140 140 140 140 140 140]
+ [140 140 140 140 140 140 140 140 140 140]
+ [141 141 141 141 141 141 141 141 141 141]
+ [141 141 141 141 141 141 141 141 141 141]
+ [142 142 142 142 142 142 142 142 142 142]
+ [142 142 142 142 142 142 142 142 142 142]
+ [143 143 143 143 143 143 143 143 143 143]
+ [143 143 143 143 143 143 143 143 143 143]
+ [144 144 144 144 144 144 144 144 144 144]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [134 134 134 134 134 134 134 134 134 134]
+ [134 134 134 134 134 134 134 134 134 134]
+ [135 135 135 135 135 135 135 135 135 135]
+ [135 135 135 135 135 135 135 135 135 135]
+ [136 136 136 136 136 136 136 136 136 136]
+ [136 136 136 136 136 136 136 136 136 136]
+ [137 137 137 137 137 137 137 137 137 137]
+ [137 137 137 137 137 137 137 137 137 137]
+ [138 138 138 138 138 138 138 138 138 138]
+ [139 139 139 139 139 139 139 139 139 139]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [125 125 125 125 125 125 125 125 125 125]
+ [126 126 126 126 126 126 126 126 126 126]
+ [126 126 126 126 126 126 126 126 126 126]
+ [127 127 127 127 127 127 127 127 127 127]
+ [127 127 127 127 127 127 127 127 127 127]
+ [128 128 128 128 128 128 128 128 128 128]
+ [128 128 128 128 128 128 128 128 128 128]
+ [129 129 129 129 129 129 129 129 129 129]
+ [129 129 129 129 129 129 129 129 129 129]
+ [130 130 130 130 130 130 130 130 130 130]
+]
+END
+ push(@slices, <<"END");
+
+[
+ [237 237 237 237 237 237 237 237 237 237]
+ [238 238 238 238 238 238 238 238 238 238]
+ [238 238 238 238 238 238 238 238 238 238]
+ [239 239 239 239 239 239 239 239 239 239]
+ [239 239 239 239 239 239 239 239 239 239]
+ [240 240 240 240 240 240 240 240 240 240]
+ [240 240 240 240 240 240 240 240 240 240]
+ [241 241 241 241 241 241 241 241 241 241]
+ [241 241 241 241 241 241 241 241 241 241]
+ [242 242 242 242 242 242 242 242 242 242]
+]
+END
+ return @slices;
+} # End of get_ref_eqc_slices()...
diff --git a/t/pthread.t b/t/pthread.t
new file mode 100644
index 0000000..dd45c96
--- /dev/null
+++ b/t/pthread.t
@@ -0,0 +1,140 @@
+
+# XXX SOME TESTS DISABLED
+
+use PDL::LiteF;
+use Benchmark; # not using ':hireswallclock'
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ if($ENV{PDL_T}) {
+ if($result) { print "ok $no\n";return }
+ my ($p,$f,$l) = caller;
+ print "FAILED TEST $no AT $p $f $l\n";
+ } else {
+ print "not " unless $result ;
+ print "ok $no\n" ;
+ }
+}
+
+sub tapprox {
+ my($a,$b,$mdiff) = @_;
+ $mdiff = 0.01 unless defined($mdiff);
+ my $c = abs($a-$b);
+ my $d = max($c);
+ $d < $mdiff;
+}
+
+if (PDL::Core::pthreads_enabled) {
+ print "1..27\n";
+ $a = zeroes(2000000);
+ $b = zeroes(2000000);
+
+ $a->add_threading_magic(0,10);
+
+ timethese(50,{threaded => '$a += 1', unthreaded => '$b+= 1'});
+ print $a->slice('0:20'),"\n";
+ ok(1,tapprox($a,$b));
+
+ $a = sequence(3,10);
+ $b = ones(3);
+ $a->add_threading_magic(1,2);
+ $c = inner $a, $b;
+ print $c,"\n";
+ $a->remove_threading_magic;
+ $cc = $a->sumover;
+ print $cc,"\n";
+ ok(2,tapprox($c,$cc));
+
+ # Try multi-dim cases
+ $a = zeroes(200000,2,2);
+ $b = zeroes(200000,2,2);
+ $a->add_threading_magic(0,2);
+ $a+=1;
+ $b+=1;
+ ok(3, tapprox($a, $b));
+
+ ### Multi-dimensional incrementing case ###
+ ## This is performed multiple times to be sure that indexing isn't
+ ## messed up for the multiple pthreads
+ my $testNo = 4;
+ foreach (1..20){
+ $a = zeroes(3, 200000,2,2);
+ $a->add_threading_magic(1,2);
+ $a += 1;
+ ok( $testNo++, $a->max < 1.1 ); # Should never be greater than 1
+ }
+
+
+ ### Pthread Indexing Test ####
+ ### This checks for a problem seen in the dataflow back to the parent PDL (i.e. writeback xs code)
+ ### seen when pthreading is present
+
+ my $indexArg = pdl [[1]];
+
+ my $lutEx = pdl [[1,0],[0,1]];
+
+ # Do a pthreaded index operation
+ $lutEx->add_threading_magic(1,2);
+ $in = $lutEx->index($indexArg);
+
+ # Remove pthreading magic. This is a check to see if pthreading doesn't cause
+ # errors in the lazy evaluation of the index operation that occurs in the following
+ # inplace-assignment operation.
+ $lutEx->add_threading_magic(-1,-1);
+
+ # Do inplace assignment so that data is written back to the parent pdl:
+ # The lazy evaluation of the index operation will occur here first
+ $in .= 1;
+
+ # Check for writeback to the parent PDL working (should have three ones in the array)
+ my $lutExSum = $lutEx->sum;
+ ok( $testNo++, tapprox($lutExSum, pdl(3)) );
+
+ # Check for inplace assignment working. $in should be all ones
+ my $inSum = $in->sum;
+ ok( $testNo++, tapprox($inSum, pdl(2) ) );
+
+
+ ### Pthread Indexing Test ####
+ ### Similar test to above, but the pthreading magic is changed (not just
+ ### deleted) after the index operation
+
+ $indexArg = pdl [[1]];
+
+ $lutEx = pdl [[1,0,0,1],[0,1,0,1]];
+
+ # Do a pthreaded index operation
+ $lutEx->add_threading_magic(1,2);
+ $in = $lutEx->index($indexArg);
+
+ $in->make_physical; # make sure the initial indexing operation has taken place
+ # otherwise gets defered due to lazy evaluation.
+
+ # Remove pthreading magic, and then add it back on another dim with
+ # 4 threads. This is a check to see if pthreading doesn't cause
+ # errors in the writeback-code of the index operation that occurs in the following
+ # inplace-assignment operation.
+ $lutEx->add_threading_magic(-1,-1);
+ $lutEx->add_threading_magic(0,4);
+
+ # Do inplace assignment so that data is written back to the parent pdl:
+ # The lazy evaluation of the index operation will occur here first
+ $in .= 1;
+
+ # Check for writeback to the parent PDL working (should have three ones in the array)
+ #print $lutEx;
+ $lutExSum = $lutEx->sum;
+ ok( $testNo++, tapprox($lutExSum, pdl(5)) );
+
+ # Check for inplace assignment working. $in should be all ones
+ $inSum = $in->sum;
+ ok( $testNo++, tapprox($inSum, pdl(2) ) );
+
+} else {
+ print "1..1\n";
+ print "ok 1\n";
+}
+
diff --git a/t/pthreadBarf.t b/t/pthreadBarf.t
new file mode 100644
index 0000000..a62d9ab
--- /dev/null
+++ b/t/pthreadBarf.t
@@ -0,0 +1,66 @@
+
+# These tests check for proper deferred handling of barf and warn messages when pthreading.
+#
+use PDL::LiteF;
+use PDL::Image2D;
+use Test::More;
+
+use strict;
+
+if (PDL::Core::pthreads_enabled) {
+ plan tests => 2;
+} else {
+ plan tests => 2;
+ diag "Control test: pthreads not enabled";
+}
+
+## Check Handling of barf messages when pthreading ###
+
+# These statements will cause pthread to happen in two pthreads
+set_autopthread_targ(2);
+set_autopthread_size(0);
+
+# Because of the duplicate 8's interpolates barf (in the PPcode) will get
+# called. This should not cause a segfault
+my $x = float( [1, 2, 3, 4, 5, 8, 9, 10], [1, 2, 3, 4, 5, 8, 8, 8] );
+my $y = ($x * 3) * ($x - 2);
+
+# Setup to silence warning messages
+local $SIG{__WARN__} = sub { };
+# Catch barf messages by running in eval:
+eval{
+ my ( $ans, $err ) = interpolate(8.5, $x, $y );
+};
+
+ok( $@ =~ /identical abscissas/ , "interpolate barf" )
+ or diag "Error message should be 'identical abscissas': got\n>>>$@<<<\n";
+
+## Now Check Warning Messages with pthreading ###
+
+# Create an array of 2 bogus polygon indexes (bogus due to negative indexes)
+# Thes will make polyfill emit a warning message.
+
+# Single polygon
+my $poly = pdl([-1,1], [0,0]);
+$poly = $poly->reorder(1,0);
+
+# make second polygon have same indexes
+my $poly2 = $poly->copy;
+$poly = cat $poly, $poly2;
+
+my $mask = zeroes(5,5);
+
+#kill 'INT',$$;
+# Because of the negative indexes, a warning message
+# will be printed, which will cause segfault wheen pthreaded, if messages not deferred
+# properly
+
+# Setup to catch warning messages
+local $SIG{__WARN__} = sub { die $_[0] };
+
+eval{
+ polyfill($mask, $poly, 1);
+};
+
+ok( $@ =~ /errors during polygonfilling/ , "polyfill barf" )
+ or diag "Error message should be 'errors during polygonfilling': got\n>>>$@<<<\n";
diff --git a/t/pthread_auto.t b/t/pthread_auto.t
new file mode 100644
index 0000000..d6160c2
--- /dev/null
+++ b/t/pthread_auto.t
@@ -0,0 +1,126 @@
+
+# This test case is very similar to pthread.t, but it uses the auto pthread
+# interface, instead of specificaly setting pthread magic on individual PDLs
+
+use PDL::LiteF;
+
+BEGIN {
+ if ( $] < 5.008_008 ) {
+ require Benchmark; Benchmark->import();
+ warn "# Benchmark wallclock timings reported to the second. You\n";
+ warn "# may not measure a speedup with multiple CPU threads.\n";
+ } else {
+ require Benchmark; Benchmark->import(':hireswallclock');
+ }
+}
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ if($ENV{PDL_T}) {
+ if($result) { print "ok $no\n";return }
+ my ($p,$f,$l) = caller;
+ print "FAILED TEST $no AT $p $f $l\n";
+ } else {
+ print "not " unless $result ;
+ print "ok $no\n" ;
+ }
+}
+
+sub tapprox {
+ my($a,$b,$mdiff) = @_;
+ $mdiff = 0.01 unless defined($mdiff);
+ my $c = abs($a-$b);
+ my $d = max($c);
+ $d < $mdiff;
+}
+
+if (PDL::Core::pthreads_enabled) {
+
+
+ print "1..26\n";
+
+
+ $a = zeroes(2000000);
+ $b = zeroes(2000000);
+
+ # Set target of 10 threads to create, with no lower limit on the size
+ # of the PDL
+ set_autopthread_targ(10);
+ set_autopthread_size(0);
+
+ timethese(20,{threaded => '$a **= 1.3'});
+
+ ok( 1, get_autopthread_actual() == 10); # should have split into 10 threads
+
+ # Set target to 0 for comparison to unthreaded
+ set_autopthread_targ(0);
+ timethese(20,{unthreaded => '$b **= 1.3'});
+
+ print $a->slice('0:20'),"\n";
+ ok(2,tapprox($a,$b));
+
+ # Another Test Case
+ $a = sequence(3,10);
+ $b = ones(3);
+ set_autopthread_targ(2);
+ $c = inner $a, $b;
+ print $c,"\n";
+ $cc = $a->sumover;
+ print $cc,"\n";
+ ok(3,tapprox($c,$cc));
+
+ # Try multi-dim cases
+ set_autopthread_targ(2);
+ $a = zeroes(200000,2,2);
+ $b = zeroes(200000,2,2);
+ $a+=1;
+ set_autopthread_targ(0); # Turn off pthreading for $b adding
+ $b+=1;
+ ok(4, tapprox($a, $b));
+
+ ### Multi-dimensional incrementing case ###
+ ## This is performed multiple times to be sure that indexing isn't
+ ## messed up for the multiple pthreads
+ my $testNo = 5;
+ set_autopthread_targ(2);
+ foreach (1..20){
+ $a = zeroes(3, 200000,2,2);
+ $a += 1;
+ ok( $testNo++, $a->max < 1.1 ); # Should never be greater than 1
+ }
+
+
+ ### Pthread Indexing Test ####
+ ### This checks for a problem seen in the dataflow back to the parent PDL (i.e. writeback xs code)
+ ### seen when pthreading is present
+
+ my $indexArg = pdl [[1]];
+
+ my $lutEx = pdl [[1,0],[0,1]];
+
+ # Do a pthreaded index operation
+ $in = $lutEx->index($indexArg);
+
+
+ # Do inplace assignment so that data is written back to the parent pdl:
+ # The lazy evaluation of the index operation will occur here first
+ $in .= 1;
+
+ # Check for writeback to the parent PDL working (should have three ones in the array)
+ my $lutExSum = $lutEx->sum;
+ ok( $testNo++, tapprox($lutExSum, pdl(3)) );
+
+ # Check for inplace assignment working. $in should be all ones
+ my $inSum = $in->sum;
+ ok( $testNo++, tapprox($inSum, pdl(2) ) );
+
+
+
+} else {
+ print "1..1\n";
+ print "ok 1\n";
+}
+
diff --git a/t/reduce.t b/t/reduce.t
new file mode 100644
index 0000000..66c24fb
--- /dev/null
+++ b/t/reduce.t
@@ -0,0 +1,26 @@
+use PDL::LiteF;
+
+my $ctr = 1;
+sub ok {
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $ctr\n" ;
+ $ctr++;
+# print "[ $result ]\n";
+}
+
+my $ntests = 5;
+print "1..$ntests\n";
+
+
+use PDL::Reduce;
+
+$a = sequence 5,5;
+$b = $a->reduce('add',0);
+
+ok(all $b == $a->sumover);
+ok(all $a->reduce('add',1) == $a->mv(1,0)->sumover);
+ok(all $a->reduce('mult',1) == $a->mv(1,0)->prodover);
+# test the new reduce features
+ok($a->reduce('+',0,1) == sum $a); # reduce over list of dims
+ok(all $a->reduce(\&PDL::sumover) == $a->sumover); # use code refs
diff --git a/t/refs.t b/t/refs.t
new file mode 100644
index 0000000..f5fc15e
--- /dev/null
+++ b/t/refs.t
@@ -0,0 +1,60 @@
+
+# This test case points out a problem in the freeing
+# of used memory in 1.90_01
+
+use PDL::LiteF;
+# PDL::Core::set_debugging(1);
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+# sub tapprox {
+# my($a,$b,$c,$d) = @_;
+# $c = abs($a-$b);
+# $d = max($c);
+# $d < 0.01;
+# }
+
+print "1..2\n";
+
+if(1) {
+
+{
+sub ap {
+ my($a,$b) = @_;
+ my $c = abs($a-$b);
+ my $d = max($c);
+ 1;
+}
+
+my $a = pdl (1,2);
+my $b = pdl [[1,2],[1,2],[1,2]];
+my $c = $a->slice(',*3');
+$c->make_physical;
+ap($b,$c);
+$c = $b->clump(2);
+
+$b->make_physical;
+$c->make_physical;
+}
+
+ok(1,1);
+
+}
+
+
+
+$a = zeroes 4,5;
+
+$b = $a->slice('1:3:2,2:4:2');
+
+$b .= ones(2,2);
+
+print $a;
+
+ok(2,1);
diff --git a/t/requiredmods.t b/t/requiredmods.t
new file mode 100644
index 0000000..c3d2cf6
--- /dev/null
+++ b/t/requiredmods.t
@@ -0,0 +1,38 @@
+use Test;
+
+plan tests => 2;
+
+my @hasnt = ();
+my @test = (['Filter::Util::Call','Filter'],
+ ['Text::Balanced','Text::Balanced'],
+ );
+for my $mod (@test) {
+ eval "use $mod->[0]";
+ ok !$@;
+ push @hasnt, $mod->[1] if $@;
+}
+
+if (@hasnt) {
+ print STDERR << 'EOP';
+
+********************************************************
+* IMPORTANT: Your installation will not work since it *
+* lacks critical modules. *
+* ALL TESTS WILL FAIL UNLESS YOU IMMEDIATELY *
+* INSTALL THE FOLLOWING MODULES [available from CPAN]: *
+*
+EOP
+
+ for (@hasnt) { print STDERR "*\t$_\n" }
+
+
+ print STDERR << 'EOP';
+* *
+* Please install the missing module(s) and start the *
+* PDL build process again (perl Makefile.PL; ....) *
+* *
+********************************************************
+
+EOP
+
+}
diff --git a/t/rim.t b/t/rim.t
new file mode 100755
index 0000000..502d367
--- /dev/null
+++ b/t/rim.t
@@ -0,0 +1,44 @@
+use strict;
+use warnings;
+use PDL;
+use PDL::IO::Pic;
+use Test::More tests => 3;
+
+# The rim() function was failing badly for a number of reasons ...
+# and perhaps is still failing.
+# See http://mailman.jach.hawaii.edu/pipermail/pdl-porters/2012-July/004916.html
+# This script serves firstly as a reminder that rim() needs fixing,
+# and subsequently that it stays in a basically functional form.
+# AFAIK, this script itself breaks none of the rules regarding the
+# the usage of the rim() function - Sisyphus.
+
+my $cols = 3;
+my $rows = 3;
+
+my $ext = 'pnm';
+my $fmt = uc($ext);
+
+my $file = "ushort.$ext";
+
+my $in = sequence($cols, $rows)->ushort * 213;
+$in->wpic($file, {FORMAT => $fmt});
+
+my $out1 = rim($file, {FORMAT => $fmt});
+
+my $out2 = sequence($cols, $rows);
+rim($out2, $file, {FORMAT => $fmt});
+
+my $out3 = PDL->rpic($file, {FORMAT => $fmt});
+
+# Test 1
+ok(sum(abs($out1 - $out2)) == 0, "\$out1 & \$out2 are the same");
+
+# Test 2
+ok(sum(abs($out3 - $out2)) == 0, "\$out3 & \$out2 are the same");
+
+# Test 3
+ok(sum(abs($out1 - $in )) == 0, "\$out1 & \$in are the same");
+
+END {
+ unlink $file;
+};
diff --git a/t/round.t b/t/round.t
new file mode 100644
index 0000000..469e263
--- /dev/null
+++ b/t/round.t
@@ -0,0 +1,19 @@
+# -*-perl-*-
+
+use Test;
+
+BEGIN {plan tests=>1;}
+
+use PDL::LiteF;
+use PDL::Math;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+my $a = sequence(41) - 20;
+$a /= 4;
+#do test on quarter-integers, to make sure we're not crazy.
+
+my $ans_rint = pdl(-5,-5,-4,-4,-4,-4,-4,-3,-3,-3,-2,-2,-2,-2,-2,
+-1,-1,-1,0,0,0,0,0,1,1,1,2,2,2,2,2,3,3,3,4,4,4,4,4,5,5);
+
+ok(all(rint($a)==$ans_rint));
diff --git a/t/scope.t b/t/scope.t
new file mode 100644
index 0000000..b49cecf
--- /dev/null
+++ b/t/scope.t
@@ -0,0 +1,60 @@
+# Test if we can still do scopes ok - multiple uses etc..
+# Also see that PDL loaders get the correct symbols.
+
+
+print "1..10\n";
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+package A;
+use vars qw/$a/;
+# print "A: ",%A::,"\n";
+use PDL;
+
+# $a = zeroes 5,5;
+
+# print "A: ",%A::,"\n";
+
+$a = zeroes 5,5;
+
+# print "A: %A::\n";
+
+
+
+# print "AC: ",(bless {},A)->can("zeroes"),"\n";
+::ok(1,(bless {},A)->can("zeroes"));
+
+package B;
+use PDL;
+
+#print "B: ",%B::,"\n";
+#print "B: ",%B::,"\n";
+# $b = zeroes 5,5;
+# print "BC: ",(bless {},B)->can("zeroes"),"\n";
+::ok(2,(bless {},B)->can("zeroes"));
+
+package C;
+use PDL::Lite;
+::ok(3,!((bless {},C)->can("zeroes")));
+
+package D;
+use PDL::Lite;
+::ok(4,!((bless {},D)->can("zeroes")));
+
+package E;
+use PDL::LiteF;
+::ok(5,(bless {},E)->can("zeroes"));
+
+package F;
+use PDL::LiteF;
+::ok(6,(bless {},F)->can("zeroes"));
+
+::ok(7,!((bless {},C)->can("imag")));
+::ok(8,!((bless {},D)->can("imag")));
+::ok(9,!((bless {},E)->can("imag")));
+::ok(10,!((bless {},F)->can("imag")));
diff --git a/t/segfault.t b/t/segfault.t
new file mode 100644
index 0000000..0f1fe6c
--- /dev/null
+++ b/t/segfault.t
@@ -0,0 +1,11 @@
+# Tests for a segfault bug in PDL through 2.4.2
+# (Thanks, Alexey!)
+
+print "1..1\n";
+
+use PDL;
+use strict;
+my $x = pdl(1,2);
+my $y = bless \my $z,"ASFG";
+eval '$x != $y';
+print "ok 1\n" if($@ =~/Error - tried to use an unknown/);
diff --git a/t/simplex.t b/t/simplex.t
new file mode 100644
index 0000000..5654ffc
--- /dev/null
+++ b/t/simplex.t
@@ -0,0 +1,51 @@
+use PDL::LiteF;
+use Test;
+use strict;
+use warnings;
+
+BEGIN {
+ eval "use PDL::Opt::Simplex;";
+ unless ($@) {
+ plan tests => 8;
+ }
+ else {
+ plan tests => 1;
+ print "ok 1 # Skipped: PDL::Opt::Simplex not installed\n";
+ exit;
+ }
+}
+
+my $dis = pdl( 0, 1 );
+my $func = sub {
+ # f = x^2 + (y-1)^2 + 1
+ return sumover( ( $_[0] - $dis )**2 ) + 1;
+};
+
+my ( $opt, $ssize, $optval );
+my ( $x, $y );
+
+# first test
+( $opt, $ssize, $optval ) = PDL::Opt::Simplex::simplex(
+ pdl( [ 2, 2 ] ), pdl( [ 0.01, 0.01 ] ), 1e-4, 1e4, $func,
+);
+
+( $x, $y ) = $opt->list;
+
+ok( $x < 0.001 );
+ok( ( $y - 1 ) < 0.001 );
+ok( $ssize < 0.001 );
+ok( ( $optval - 1 ) < 0.001 );
+
+# second test
+my $logsub = sub {};
+( $opt, $ssize, $optval ) = PDL::Opt::Simplex::simplex(
+ pdl( [ [ -1, -1 ], [ -1.1, -1 ], [ -1.1, -0.9 ] ] ), pdl( [ 0.01, 0.01 ] ),
+ 1e-4, 1e4, $func,
+);
+
+( $x, $y ) = $opt->list;
+
+ok( $x < 0.001 );
+ok( ( $y - 1 ) < 0.001 );
+ok( $ssize < 0.001 );
+ok( ( $optval - 1 ) < 0.001 );
diff --git a/t/slatec.t b/t/slatec.t
new file mode 100644
index 0000000..871f429
--- /dev/null
+++ b/t/slatec.t
@@ -0,0 +1,277 @@
+# -*-perl-*-
+use PDL::LiteF;
+use PDL::Config;
+use Test::More;
+my $ntests;
+BEGIN {
+ eval " use PDL::Slatec; ";
+ $loaded = ($@ ? 0 : 1);
+ if ($loaded) {
+ $ntests = 40;
+ $ntests -= 3 unless ($PDL::Config{WITH_BADVAL}); # two fewer tests if no bad val support
+ plan tests => $ntests;
+ } else {
+ ## print STDERR "$@\n";
+ plan skip_all => 'PDL::Slatec not available';
+ }
+}
+
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub tapprox {
+ my($a,$b,$c,$d) = @_;
+ $c = abs($a-$b);
+ $d = max($c);
+# print "APR: $a,$b,$c,$d;\n";
+ $d < 0.001;
+}
+
+my $mat = pdl [1,0.1],[0.1,2];
+
+($eigvals,$eigvecs) = eigsys($mat);
+
+## print STDERR $eigvecs,$eigvals,"\n";
+
+ok(tapprox($eigvals,pdl(0.9901,2.009)));
+ok(!tapprox($eigvals,pdl(0.99,2.5)));
+
+ok(tapprox($eigvecs,pdl([0.995,-0.0985],[0.0985,0.995])));
+
+$mat = pdl [2,3],[4,5];
+
+$inv = matinv($mat);
+
+inner($mat->dummy(2),$inv->xchg(0,1)->dummy(1),($uni=null));
+
+## print STDERR $mat;
+## print STDERR $inv;
+
+## print STDERR $uni;
+
+ok(tapprox($uni,pdl[1,0],[0,1]));
+
+$det = $mat->det;
+## $det->dump;
+$deti = $inv->det;
+## $deti->dump;
+
+ok(tapprox($det,-2));
+ok(tapprox($deti,-0.5));
+
+# Now do the polynomial fitting tests
+
+
+if ($PDL::Config{WITH_BADVAL}) {
+
+ # Set up tests x, y and weight
+ my $y = pdl (1,4,9,16,25,36,49,64.35,32);
+ my $x = pdl ( 1,2,3,4,5,6,7,8,9);
+ my $w = pdl ( 1,1,1,1,1,1,1,0.5,0.3);
+
+ # input parameters
+ my $eps = pdl(0);
+ my $maxdeg = 5;
+
+ # Test with a bad value
+ $y->inplace->setbadat(3);
+ ($ndeg, $r, $ierr, $a) = polyfit($x, $y, $w, $maxdeg, $eps);
+
+ ## print STDERR "NDEG, EPS, IERR: $ndeg, $eps, $ierr\n";
+ ## print STDERR "poly = $r\n";
+
+ ok(($ierr == 1));
+
+ # Test with all bad values
+ $y = zeroes(9)->setbadif(1);
+ ($ndeg, $r, $ierr, $a) = polyfit($x, $y, $w, $maxdeg, $eps);
+
+ ## print STDERR "NDEG, EPS, IERR: $ndeg, $eps, $ierr\n";
+ ## print STDERR "poly = $r\n";
+
+ ok(($ierr == 2));
+
+ # Now test threading over a 2 by N matrix
+ # Set up tests x, y and weight
+ $y = pdl ([1,4,9,16,25,36,49,64.35,32],
+ [1,4,9,16,25,36,49,64.35,32],);
+ $x = pdl ([1,2,3,4,5,6,7,8,9],
+ [1,2,3,4,5,6,7,8,9],);
+ $w = pdl ([1,1,1,1,1,1,1,0.5,0.3],
+ [1,1,1,1,1,1,1,0.5,0.3],);
+ $y->inplace->setbadat(3,0);
+ $y->inplace->setbadat(4,1);
+ $eps = pdl(0,0);
+
+ ($ndeg, $r, $ierr, $a) = polyfit($x, $y, $w, $maxdeg, $eps);
+
+ ## print STDERR "NDEG, EPS, IERR: $ndeg, $eps, $ierr\n";
+ ## print STDERR "poly = $r\n";
+
+ ok((sum($ierr == 1) == 2));
+
+}
+
+# Set up tests x, y and weight
+$y = pdl (1,4,9,16,25,36,49,64.35,32);
+$x = pdl ( 1,2,3,4,5,6,7,8,9);
+$w = pdl ( 1,1,1,1,1,1,1,0.5,0.3);
+$maxdeg = 7;
+$eps = pdl(0);
+
+# Do the fit
+my ($ndeg, $r, $ierr, $a) = polyfit($x, $y, $w, $maxdeg, $eps);
+
+## print STDERR "NDEG, EPS, IERR: $ndeg, $eps, $ierr\n";
+## print STDERR "poly = $r\n";
+
+ok(($ierr == 1));
+
+
+# Test POLYCOEF
+
+my $c = pdl(4); # Expand about x = 4;
+
+my $tc = polycoef($ndeg, $c, $a);
+
+my @tc = $tc->list;
+my @r = $r->list;
+my $i = 0;
+
+foreach my $xpos ($x->list) {
+ my $ypos = 0;
+ my $n = 0;
+ foreach my $bit ($tc->list) {
+ $ypos += $bit * ($xpos- (($c->list)[0]))**$n;
+ $n++;
+ }
+ ## print STDERR "$xpos, $ypos, $r[$i]\n";
+
+ # Compare with answers from polyfit
+ ok(sprintf("%5.2f", $ypos) == sprintf("%5.2f", $r[$i]));
+ $i++;
+
+}
+
+# Try polyvalue with a single x pos
+my $xx = pdl([4]);
+my $nder = 3;
+
+my ($yfit, $yp) = polyvalue($ndeg, $nder, $xx, $a);
+
+## print STDERR "At $xx, $yfit and $yp\n";
+ok(int($yp->at(0)) == 8);
+
+# Test polyvalue
+$nder = 3;
+$xx = pdl(12,4,6.25,1.5); # Ask for multiple positions at once
+
+($yfit, $yp) = polyvalue($ndeg, $nder, $xx, $a);
+
+## print STDERR "At $xx is $yfit and $yp\n";
+
+# Simple test of expected value
+ok(int($yfit->at(1)) == 15);
+
+# test the PCHIP stuff
+
+## Test: chim/chic
+#
+$x = float( 3 .. 10 );
+my $f = $x*$x*$x + 425.42352;
+my $answer = 3.0*$x*$x;
+
+my ( $d, $err ) = chim( float($x), float($f) );
+
+ok(($err->getndims==0) & ($err->sum == 0));
+
+# don't check the first and last elements, as expect the
+# error to be largest there
+# value of 5% comes from tests on linux and solaris machines
+ok(all( slice( abs(($d - $answer)/$answer), '1:-2' ) < 0.05 ) );
+
+# compare the results of chic
+my $wk = $f->zeroes( 2 * $f->nelem );
+my $d2 = $f->zeroes;
+chic( pdl([0, 0]), pdl([0, 0]), 1, $x, $f, $d2, $wk, my $err2=null );
+ok(($err2->getndims==0) & ($err2->sum == 0));
+ok(all( abs($d2 - $d) < 0.02 ) );
+
+## Test: chsp
+#
+chsp( pdl([0, 0]), pdl([0, 0]), $x, $f, my $d3=null, $wk, my $err3=null );
+ok(($err3->getndims==0) & ($err3->sum == 0));
+ok(all( abs($d3 - $d) < 2 ) );
+
+## Test: chfd/chfe
+#
+my $xe = float( pdl( 4 .. 8 ) + 0.5 );
+my ( $fe, $de );
+( $fe, $de, $err ) = chfd( $x, $f, $d, 1, $xe );
+
+ok(($err->getndims==0) & ($err->sum == 0));
+
+$answer = $xe*$xe*$xe + 425.42352;
+ok(all( abs(($fe - $answer)/$answer) < 1.0e-5 ) );
+
+$answer = 3.0*$xe*$xe;
+ok(all( abs(($de - $answer)/$answer) < 0.02 ) );
+
+( $fe, $err ) = chfe( $x, $f, $d, 1, $xe );
+
+ok(($err->getndims==0) & ($err->sum == 0));
+
+$answer = $xe*$xe*$xe + 425.42352;
+ok(all( abs(($fe - $answer)/$answer) < 1.0e-5 ) );
+
+# Test: chcm
+#
+$x = float( 1, 2, 3, 5, 6, 7 );
+$f = float( 1, 2, 3, 4, 3, 4 );
+$ans = long( 1, 1, 1, -1, 1, 2 );
+
+( $d, $err ) = chim($x, $f);
+ok(($err->getndims==0) & ($err->sum == 2)); # 2 switches in monotonicity
+
+my $ismon;
+( $ismon, $err ) = chcm($x, $f, $d, 1);
+
+ok(($err->getndims==0) & ($err->sum == 0));
+ok($ismon->get_datatype == 3);
+ok(tapprox($ismon,$ans));
+
+## Test: chia
+#
+$x = double( sequence(11) - 0.3 );
+$f = $x * $x;
+( $d, $err ) = chim($x, $f);
+
+$ans = pdl( 9.0**3, (8.0**3-1.0**3) ) / 3.0;
+( $int, $err ) = chia($x, $f, $d, 1, pdl(0.0,1.0), pdl(9.0,8.0));
+ok(all($err == 0));
+ok(all( abs($int-$ans) < 0.04 ) );
+
+$hi = pdl( $x->at(9), $x->at(7) );
+$lo = pdl( $x->at(0), $x->at(1) );
+$ans = ($hi**3 - $lo**3) / 3;
+( $int, $err ) = chid( $x, $f, $d, 1, pdl(0,1), pdl(9,7) );
+ok(all($err == 0));
+ok(all( abs($int-$ans) < 0.06 ) );
+## print STDERR "int=$int; ans=$ans; int-ans=".($int-$ans)."\n";
+## print STDERR "ref ans=".(ref $ans)."\n";
+
+=pod ignore as have commented out chbs interface
+
+## Test: chbs - note, only tests that it runs successfully
+#
+my $nknots = 0;
+my $t = zeroes( float, 2*$x->nelem+4 );
+my $bcoef = zeroes( float, 2*$x->nelem );
+my $ndim = PDL->null;
+my $kord = PDL->null;
+$err = PDL->null;
+echbs( $x, $f, $d, 0, $nknots, $t, $bcoef, $ndim, $kord, $err );
+ok(all($err == 0));
+exit(0);
+=cut
+
diff --git a/t/slice-exceptions.t b/t/slice-exceptions.t
new file mode 100644
index 0000000..48f86ff
--- /dev/null
+++ b/t/slice-exceptions.t
@@ -0,0 +1,48 @@
+use strict;
+use warnings;
+use PDL;
+use Test::More;
+
+for my $start (0, 4, -4, 20, -20) {
+ for my $stop (0, 4, -4, 20, -20) {
+ # Generate a simple data piddle and a bad slice of that piddle
+ my $data = sequence(10);
+ my $slice = $data->slice("$start:$stop");
+
+ pass('Slice operation for properly formed slice does not croak');
+
+ # Calculate the expected dimension size:
+ my $expected_dim_size;
+ my $real_start = $start;
+ $real_start += 10 if $start < 0;
+ my $real_stop = $stop;
+ $real_stop += 10 if $stop < 0;
+ $expected_dim_size = abs($real_stop - $real_start) + 1
+ if 0 <= $real_stop and $real_stop < 10
+ and 0 <= $real_start and $real_start < 10;
+
+ my $expected_outcome_description
+ = defined $expected_dim_size ? 'is fine' : 'croaks';
+
+ my $dim1;
+ # Should croak when we ask about the dimension:
+ eval { $dim1 = $slice->dim(0) };
+ is($dim1, $expected_dim_size, "Requesting dim(0) on slice($start:$stop) $expected_outcome_description");
+
+ # Should *STILL* croak when we ask about the dimension:
+ eval { $dim1 = $slice->dim(0) };
+ is($dim1, $expected_dim_size, "Requesting dim(0) a second time on slice($start:$stop) $expected_outcome_description");
+
+ # Calculate the expected value
+ my $expected_value;
+ $expected_value = $data->at($real_start) if defined $expected_dim_size;
+
+ # Should croak when we ask about data
+ my $value;
+ eval { $value = $slice->at(0) };
+ is($value, $expected_value, "Requesting first element on slice($start:$stop) $expected_outcome_description");
+ }
+}
+
+
+done_testing;
diff --git a/t/slice.t b/t/slice.t
new file mode 100644
index 0000000..b8cc59b
--- /dev/null
+++ b/t/slice.t
@@ -0,0 +1,384 @@
+# -*-perl-*-
+#
+
+use strict;
+use Test::More;
+
+plan tests => 86;
+ ;
+use PDL::LiteF;
+
+# PDL::Core::set_debugging(1);
+
+# Useful for debugging. Removed by DJB whilst cleaning up the
+# tests
+#
+#sub kill_if_debug () {
+# kill INT,$$ if $ENV{UNDER_DEBUGGER};
+#}
+
+sub tapprox ($$) {
+ my $a = shift;
+ my $b = shift;
+ my $maxdiff = abs($a-$b)->max;
+ return $maxdiff < 0.01;
+}
+
+my ($a, $b, $c, $d, $e, $f);
+
+$a = (1+(xvals zeroes 4,5) + 10*(yvals zeroes 4,5));
+
+is($a->at(2,2), 23);
+
+$b = $a->slice('1:3:2,2:4:2');
+
+# diag($a); diag($b);
+
+is($b->at(0,0), 22);
+is($b->at(1,0), 24);
+is($b->at(0,1), 42);
+is($b->at(1,1), 44);
+
+#$b .= 0.5 * double ones(2,2);
+$b .= 0.5 * ones(2,2);
+
+is($b->at(1,0), 0.5);
+is($b->at(0,1), 0.5);
+
+is($a->at(1,2), 0.5);
+
+# Check that nothing happened to other elems
+is($a->at(2,2), 23);
+
+$a = pdl (1,2);
+$b = pdl [[1,2],[1,2],[1,2]];
+$c = $a->slice(',*3');
+
+# check dimensions, sum of elements and correct order of els (using tapprox)
+
+my $sum;
+# $c = $a->dummy(1,3);
+sumover($c->clump(-1),($sum=null));
+ok(tapprox($b,$c));
+is($sum->at, 9);
+
+is(join(',',$c->dims), "2,3");
+
+$b = pdl [[1,1,1],[2,2,2]];
+$c = $a->slice('*3,');
+sumover($c->clump(-1),($sum=null));
+
+ok(tapprox($b,$c));
+is($sum->at, 9);
+is(join(',',$c->dims), "3,2");
+
+# test stringify
+$a = zeroes(3,3);
+my $line = $a->slice(':,(0)');
+
+$a++;
+# $line += 0; # that's how to force an update before interpolation
+my $linepr = "$line";
+
+is($linepr, '[1 1 1]');
+
+# Test whether error is properly returned:
+
+$b = zeroes(5,3,3);
+$c = $b->slice(":,:,1");
+
+is(join(',',$c->dims), "5,3,1");
+
+eval { my $d = $c->slice(":,:,2"); "$d" };
+
+like($@, qr/out of bounds/, 'check slice bounds error handling') or diag "ERROR WAS: '$@'\n" if $@;
+
+$a = zeroes 3,3;
+
+$b = $a->slice("1,1:2");
+
+$b .= 1;
+
+
+$a = xvals zeroes 20,20;
+
+$b = $a->slice("1:18:2,:");
+$c = $b->slice(":,1:18:2");
+$d = $c->slice("3:5,:");
+$e = $d->slice(":,(0)");
+$f = $d->slice(":,(1)");
+
+"$b";
+"$c";
+"$d";
+"$e";
+"$f";
+
+is("$e", "[7 9 11]");
+is("$f", "[7 9 11]");
+
+# Make sure that vaffining is properly working:
+
+$a = zeroes 5,6,2;
+
+$b = (xvals $a) + 0.1 * (yvals $a) + 0.01 * (zvals $a);
+
+$b = $b->copy;
+
+$c = $b->slice("2:3");
+
+$d = $c->copy;
+
+# $c->dump;
+# $d->dump;
+
+$e = $c-$d;
+
+# $c->dump; $d->dump;
+
+is(max(abs($e)), 0);
+
+use PDL::Dbg;
+
+my ($im, $im1, $im2, $lut, $in);
+
+$im = byte [[0,1,255],[0,0,0],[1,1,1]];
+($im1 = null) .= $im->dummy(0,3);
+$im2 = $im1->clump(2)->slice(':,0:2')->px;
+
+ok(!tapprox(ones(byte,9,3),$im2));
+
+# here we encounter the problem
+$im2 = $im1->clump(2)->slice(':,-1:0')->px;
+ok(!tapprox(ones(byte,9,3),$im2));
+
+$a = xvals( zeroes 10,10) + 0.1*yvals(zeroes 10,10);
+ok(tapprox($a->mslice('X',[6,7]),
+ pdl([
+ [0.6, 1.6, 2.6, 3.6, 4.6, 5.6, 6.6, 7.6, 8.6, 9.6],
+ [0.7, 1.7, 2.7, 3.7, 4.7, 5.7, 6.7, 7.7, 8.7, 9.7]
+ ])));
+
+$lut = pdl [[1,0],[0,1]];
+$im = pdl [1];
+$in = $lut->xchg(0,1)->index($im->dummy(0));
+
+is("$in", "
+[
+ [0 1]
+]
+");
+
+$in .= pdl 1;
+
+is("$in", "
+[
+ [1 1]
+]
+");
+ok(tapprox($lut,pdl([[1,0],[1,1]])));
+
+# can we catch indices which are too negative?
+$a = PDL->sequence(10);
+$b = $a->slice('0:-10');
+is("$b", "[0]", "slice 0:-n picks first element");
+
+$b = $a->slice('0:-14');
+eval '"$b";';
+like($@, qr/slice ends out of bounds/);
+
+# Test of dice and dice_axis
+$a = sequence(10,4);
+is($a->dice([1,2],[0,3])->sum, 66, "dice");
+is($a->dice([0,1],'X')->sum, 124, "dice 'X'");
+
+# Test of Reorder:
+$a = sequence(5,3,2);
+my @newDimOrder = (2,1,0);
+$b = $a->reorder(@newDimOrder);
+
+# since doing floating-point arithmetic here, should probably
+# use a better test than "eq" here
+#
+is($b->average->average->sum , 72.5, "Test of reorder");
+
+$a = zeroes(3,4);
+$b = $a->dummy(-1,2);
+is(join(',',$b->dims), '3,4,2');
+
+$a = pdl(2);
+$b = $a->slice('');
+ok(tapprox($a, $b), "Empty slice");
+
+$a = pdl [1,1,1,3,3,4,4,1,1,2];
+$b = null;
+$c = null;
+rle($a,$b,$c);
+ok(tapprox($a, rld($b,$c)));
+
+$b = $a->mslice(0.5);
+ok(tapprox($b, 1), "mslice 1");
+
+$b = $a->mslice([0.5,2.11]);
+is("$b", "[1 1 1]", "mslice 2");
+
+$a = zeroes(3,3);
+$b = $a->splitdim(3,3);
+eval '$b->make_physdims';
+like($@, qr/^Splitdim: nthdim/, "make_physdim: Splitdim");
+
+$a = sequence 5,5;
+$b = $a->diagonal(0,1);
+is("$b", "[0 6 12 18 24]", "diagonal");
+
+$a = sequence 10;
+eval '$b = $a->lags(1,1,1)->make_physdims';
+like($@, qr/lags: dim out of range/, "make_physdim: out of range");
+
+eval '$b = $a->lags(0,-1,1)->make_physdims';
+like($@, qr/lags: step must be positive/, "make_physdim: negative step");
+
+eval '$b = $a->lags(0,1,11)->make_physdims';
+like($@, qr/too large/, "make_pyhsdim: too large");
+
+##############################
+# Tests of some edge cases
+$a = sequence(10);
+eval '$b = $a->slice("5")';
+ok(!$@, "simple slice works");
+ok(($b->nelem==1 and $b==5), "simple slice works right");
+
+eval '$b = $a->slice("5:")';
+ok(!$@, "empty second specifier works");
+ok(($b->nelem == 5 and all($b == pdl(5,6,7,8,9))), "empty second specifier works right");
+
+eval '$b = $a->slice(":5")';
+ok(!$@, "empty first specifier works");
+ok(($b->nelem == 6 and all($b == pdl(0,1,2,3,4,5))), "empty first specifier works right");
+
+##############################
+# White space in slice specifier
+eval ' $b = $a->slice(" 4:");';
+ok(!$@,"slice with whitespace worked - 1");
+ok(($b->nelem==6 and all($b==pdl(4,5,6,7,8,9))),"slice with whitespace works right - 1");
+eval ' $b = $a->slice(" :4");';
+ok(!$@,"slice with whitespace worked - 2");
+ok(($b->nelem==5 and all($b==pdl(0,1,2,3,4))),"slice with whitespace works right - 2");
+eval ' $b = $a->slice(" 3: 4 ");';
+ok(!$@,"slice with whitespace worked - 3");
+ok(($b->nelem==2 and all($b==pdl(3,4))),"slice with whitespace works right - 3");
+
+
+
+##############################
+# Tests of permissive slicing and dummying
+
+$a = xvals(5,5)+10*yvals(5,5);
+
+eval '$b = $a->slice("1,2,(0)")->make_physical';
+ok(!$@);
+is($b->ndims, 2, "slice->make_physical: ndims");
+is(pdl($b->dims)->sumover, 2, "slice->make_physical: dims");
+
+eval '$c = $a->slice("1,2,(1)")->make_physical';
+like($@, qr/too many dims/i, "slice->make_physical: too many dims");
+
+# Hmmm, think these could be split up but not sure exactly what is being
+# tested so leave as is (ish)
+#
+eval '$d = $a->slice("0:1,2:3,0")->make_physical';
+ok(!$@);
+ok(eval '$d->ndims == 3 && ((pdl($d->dims) == pdl(2,2,1))->sumover == 3)' && !$@);
+
+eval '$d = $a->slice("0:1,2:3,0")->xchg(0,2)';
+ok(!$@, "slice->xchg");
+
+ok(eval '$d->ndims == 3 && ((pdl($d->dims) == pdl(1,2,2))->sumover == 3)' && !$@);
+
+eval '$e = $a->dummy(6,2)';
+ok(!$@, "dummy");
+
+ok(eval '$e->ndims == 7 && ((pdl($e->dims) == pdl(5,5,1,1,1,1,2))->sumover==7)' && !$@);
+
+##############################
+# Tests of indexND (Nowadays this is just another call to range)
+
+my ($source, $index, $dest, $z);
+
+# Basic indexND operation
+$source = 10*xvals(10,10) + yvals(10,10);
+$index = pdl([[2,3],[4,5]],[[6,7],[8,9]]);
+eval '$a = $source->indexND( $index )';
+ok(!$@);
+ok(eval 'zcheck($a != pdl([23,45],[67,89]))', "eval of zcheck 1");
+
+# Threaded indexND operation
+$source = 100*xvals(10,10,2)+10*yvals(10,10,2)+zvals(10,10,2);
+$index = pdl([[2,3],[4,5]],[[6,7],[8,9]]);
+eval '$a = $source->indexND($index)';
+ok(!$@);
+ok(eval 'zcheck($a != pdl([[230,450],[670,890]],[[231,451],[671,891]]))', "eval of zcheck 2");
+
+
+##############################
+# Tests of range operator
+
+# Basic range operation
+$source = 10*xvals(10,10) + yvals(10,10);
+$index = pdl([[2,3],[4,5]],[[6,7],[8,9]]);
+
+eval '$dest = $source->range($index);';
+ok(!$@);
+ok(eval 'zcheck($dest != pdl([23,45],[67,89]));', "eval of zcheck 3");
+
+# Make a 3x3 range at each index
+eval '$dest = $source->range($index,3);';
+ok(!$@);
+
+# Check that the range has the correct size
+is($dest->ndims, 4, "ndims after range");
+ok(zcheck(pdl($dest->dims) != pdl(2,2,3,3)), "zcheck after range");
+
+#### Check boundary conditions
+eval '$z = $dest->copy;'; # Should throw range-out-of-bounds error
+ok($@); # should check actual error message here
+
+## Truncation
+eval '$z = $source->range($index,3,"t")->copy;';
+ok(!$@); # Should NOT throw range-out-of-bounds error.
+ok(zcheck($z->slice("(1),(1)") != pdl([[89,99,0],[0,0,0],[0,0,0]])));
+
+## Truncation on one axis, periodic on another; string syntax
+eval '$z = $source->range($index,3,"tp")';
+ok(zcheck($z->slice("(1),(1)") != pdl([[89,99,0],[80,90,0],[81,91,0]])));
+
+## Periodic on first axis, extension on another; list syntax
+eval '$z = $source->range($index,3,["e","p"]);';
+ok(zcheck($z->slice("(1),(1)") != pdl([[89,99,99],[80,90,90],[81,91,91]])));
+
+our $mt;
+eval 'our $mt = which(pdl(0))';
+ok("$mt" =~ m/^Empty/);
+
+our $dex = pdl(5,4,3);
+$z = $dex->range(zeroes(0)); # scalar Empties are autopromoted like scalar nonempties
+ok("$z" eq 'Empty[0]', "scalar Empty[0] indices handled correctly by range");
+
+$z = $dex->range(zeroes(1,0)); # 1-vector Empties are handled right.
+ok("$z" eq 'Empty[0]', "1-vector Empty[1,0] indices handled correctly by range");
+
+
+$z = $mt->range($dex,undef,'e');
+ok(all($z==0),"empty source arrays handled correctly by range");
+
+$z = $mt->range($mt);
+ok("$z" eq 'Empty[0]', "ranging an empty array with an empty index gives Empty[0]");
+
+$a = pdl(5,5,5,5);
+$z = $a->range($mt);
+ok("$z" eq 'Empty[0]');
+
+$z .= 2;
+ok(1); # should *not* segfault!
+ok(all($a==5)); # should *not* change $a!
+
diff --git a/t/storable.t b/t/storable.t
new file mode 100644
index 0000000..752f844
--- /dev/null
+++ b/t/storable.t
@@ -0,0 +1,81 @@
+# -*- cperl -*-
+
+use strict;
+use Test::More;
+
+BEGIN {
+ eval 'use Storable 1.03';
+ unless ($@) {
+ plan tests => 9;
+ } else {
+ plan skip_all => "Storable >= 1.03 not installed\n";
+ }
+ use Storable qw/freeze thaw/;
+}
+
+BEGIN {
+ use PDL::LiteF;
+ use PDL::Dbg;
+ use_ok('PDL::IO::Storable');
+}
+
+my ($data,$dfreeze,$dthaw,$olda,$pfreeze,$phash,$phthaw,$seq1,$seq1_tf,$seq2,$seq2_dc,$serialized);
+
+$a = sequence(2,2);
+# $a->dump;
+
+$serialized = freeze $a;
+
+$olda = thaw $serialized;
+# $olda->dump;
+
+ok(sum(abs($a-$olda))==0, 'PDL freeze/thaw');
+
+# $oldb = thaw $serialized;
+# $oldc = thaw $serialized;
+#
+# $PDL::Dbg::Infostr = "%T %D %S %A";
+# PDL->px;
+#
+# undef $oldb;
+# print $oldc;
+
+undef $a;
+
+$data = {
+ key1 => 1,
+ key2 => sequence(3),
+ key3 => 'hallo',
+};
+
+$dfreeze = freeze $data;
+$dthaw = thaw $dfreeze;
+
+isa_ok($dthaw, 'HASH'); # we got a HASH back
+
+ok(all($data->{key2} == $dthaw->{key2}), 'PDL in structure');
+
+$phash = bless {PDL => sequence 3}, 'PDL';
+can_ok($phash, 'freeze');
+
+$pfreeze = $phash->freeze;
+$phthaw = thaw $pfreeze;
+
+ok(all($phthaw == $phash), 'PDL has-a works with freeze/thaw');
+ok(UNIVERSAL::isa($phthaw,'HASH'), 'PDL is a hash');
+
+# Test that freeze + thaw results in new object
+$seq1 = sequence(3);
+$seq1_tf = thaw(freeze($seq1));
+$seq1->slice('1') .= 9;
+ok(! all($seq1 == $seq1_tf), 'Initialization from seraialized object') or
+ diag($seq1, $seq1_tf);
+
+# Test that dclone results in a new object
+# i.e. that dclone(.) == thaw(freeze(.))
+$seq2 = sequence(4);
+$seq2_dc = Storable::dclone($seq2);
+$seq2->slice('2') .= 8;
+ok(! all($seq2 == $seq2_dc), 'Initialization from dclone object') or
+ diag($seq2, $seq2_dc);
+
diff --git a/t/subclass.t b/t/subclass.t
new file mode 100644
index 0000000..17ae627
--- /dev/null
+++ b/t/subclass.t
@@ -0,0 +1,100 @@
+#!/usr/bin/perl
+#
+use PDL::LiteF;
+use Test::More tests => 6;
+
+# Test PDL Subclassing via hashes
+
+########### First test normal subclassing ###########
+
+package PDL::Derived;
+
+ at PDL::Derived::ISA = qw/PDL/;
+
+sub new {
+ my $class = shift;
+ my $x = bless {}, $class;
+ my $value = shift;
+ $$x{PDL} = $value;
+ $$x{SomethingElse} = 42;
+ return $x;
+}
+
+package main;
+
+# Create a PDL::Derived instance
+
+$z = PDL::Derived->new( ones(5,5) ) ;
+
+# PDL::Derived should have PDL properties
+
+$z++;
+
+ok(sum($z)==50, "derived object does PDL stuff");
+
+# And should also have extra bits
+
+ok($$z{SomethingElse}==42, "derived has extra bits" );
+
+# And survive destruction
+
+undef $z;
+
+ok(1==1, "survives distruction"); # huh?
+
+
+########### Now test magic subclassing i.e. PDL=code ref ###########
+
+package PDL::Derived2;
+
+# This is a array of ones of dim 'Coeff'
+# All that is stored initially is "Coeff", the
+# PDL array is only realised when a boring PDL
+# function is called on it. One can imagine methods
+# in PDL::Derived2 doing manipulation on the Coeffs
+# rather than actualizing the data.
+
+ at PDL::Derived2::ISA = qw/PDL/;
+
+sub new {
+ my $class = shift;
+ my $x = bless {}, $class;
+ my $value = shift;
+ $$x{Coeff} = $value;
+ $$x{PDL} = sub { return $x->cache };
+ $$x{SomethingElse} = 42;
+ return $x;
+}
+
+# Actualize the value (demonstrating cacheing)
+# One can imagine expiring the cache if say, Coeffs change
+
+sub cache {
+ my $self = shift;
+ my $v = $self->{Coeff};
+ $self->{Cache} = PDL->ones($v,$v)+2 unless exists $self->{Cache};
+ return $self->{Cache};
+}
+
+package main;
+
+# Create a PDL::Derived2 instance
+
+$z = PDL::Derived2->new(5);
+
+# PDL::Derived2 should have PDL properties
+
+$z++;
+
+ok(sum($z)==100, "derived2 has PDL properties");
+
+# And should also have extra bits
+
+ok($$z{SomethingElse}==42, "derived2 has extra bits" );
+
+# And survive destruction
+
+undef $z;
+
+ok(1==1, "derived2 survives destruction");
+
diff --git a/t/subclass2.t b/t/subclass2.t
new file mode 100644
index 0000000..34f1595
--- /dev/null
+++ b/t/subclass2.t
@@ -0,0 +1,133 @@
+#!/usr/bin/perl
+#
+
+### Example of subclassing #####
+### This script tests for proper output value typing of the major
+### categories of PDL primitive operations.
+### For example:
+### If $pdlderived is a PDL::derived object (subclassed from PDL),
+### then $pdlderived->sumover should return a PDL::derived object.
+###
+use PDL::LiteF;
+use Test::More tests => 13;
+
+
+# Test PDL Subclassing via hashes
+
+########### Subclass typing Test ###########
+
+## First define a PDL-derived object:
+package PDL::Derived;
+
+ at PDL::Derived::ISA = qw/PDL/;
+
+sub new {
+ my $class = shift;
+
+ my $data = $_[0];
+
+ my $self;
+ if(ref($data) eq 'PDL' ){ # if $data is an object (a pdl)
+ $self = $class->initialize;
+ $self->{PDL} = $data;
+ }
+ else{ # if $data not an object call inherited constructor
+ $self = $class->SUPER::new($data);
+ }
+
+
+ return $self;
+}
+
+####### Initialize function. This over-ridden function is called by the PDL constructors
+sub initialize {
+ my $class = shift;
+ my $self = {
+ PDL => PDL->null, # used to store PDL object
+ someThingElse => 42,
+ };
+ $class = (ref $class ? ref $class : $class );
+ bless $self, $class;
+}
+
+###### Derived Object Needs to supply its own copy #####
+sub copy {
+ my $self = shift;
+
+ # setup the object
+ my $new = $self->initialize;
+
+ # copy the PDL
+ $new->{PDL} = $self->{PDL}->SUPER::copy;
+
+ # copy the other stuff:
+ $new->{someThingElse} = $self->{someThingElse};
+
+ return $new;
+
+}
+## Now check to see if the different categories of primitive operations
+## return the PDL::Derived type.
+package main;
+
+# Create a PDL::Derived instance
+
+$z = PDL::Derived->new( ones(5,5) ) ;
+
+ok(ref($z)eq"PDL::Derived", "create derived instance");
+
+
+
+#### Check the type after incrementing:
+$z++;
+ok(ref($z) eq "PDL::Derived", "check type after incrementing");
+
+
+#### Check the type after performing sumover:
+$y = $z->sumover;
+ok(ref($y) eq "PDL::Derived", "check type after sumover");
+
+
+#### Check the type after adding two PDL::Derived objects:
+$x = PDL::Derived->new( ones(5,5) ) ;
+$w = $x + $z;
+ok(ref($w) eq "PDL::Derived", "check type after adding");
+
+#### Check the type after calling null:
+$a = PDL::Derived->null();
+ok(ref($a) eq "PDL::Derived", "check type after calling null");
+
+
+
+##### Check the type for a byops2 operation:
+$w = ($x == $z);
+ok(ref($w) eq "PDL::Derived", "check type for byops2 operation");
+
+##### Check the type for a byops3 operation:
+$w = ($x | $z);
+ok(ref($w) eq "PDL::Derived", "check type for byops3 operation");
+
+##### Check the type for a ufuncs1 operation:
+$w = sqrt($z);
+ok(ref($w) eq "PDL::Derived", "check type for ufuncs1 operation");
+
+##### Check the type for a ufuncs1f operation:
+$w = sin($z);
+ok(ref($w) eq "PDL::Derived", "check type for ufuncs1f operation");
+
+##### Check the type for a ufuncs2 operation:
+$w = ! $z;
+ok(ref($w) eq "PDL::Derived", "check type for ufuncs2 operation");
+
+##### Check the type for a ufuncs2f operation:
+$w = log $z;
+ok(ref($w) eq "PDL::Derived", "check type for ufuncs2f operation");
+
+##### Check the type for a bifuncs operation:
+$w = $z**2;
+ok(ref($w) eq "PDL::Derived", "check type for bifuncs operation");
+
+##### Check the type for a slicing operation:
+$a = PDL::Derived->new(1+(xvals zeroes 4,5) + 10*(yvals zeroes 4,5));
+$w = $a->slice('1:3:2,2:4:2');
+ok(ref($w) eq "PDL::Derived", "check type for slicing operation");
diff --git a/t/subclass3.t b/t/subclass3.t
new file mode 100644
index 0000000..afb143c
--- /dev/null
+++ b/t/subclass3.t
@@ -0,0 +1,166 @@
+#!/usr/bin/perl
+#
+use PDL::LiteF;
+use Test::More tests => 7;
+
+
+########### Test of method over-riding in subclassed objects ###########
+
+### Global Variable used to tell if method over-riding worked ###
+$main::OVERRIDEWORKED = 0;
+
+
+## First define a PDL-derived object:
+package PDL::Derived;
+
+ at PDL::Derived::ISA = qw/PDL/;
+
+
+sub new {
+ my $class = shift;
+
+ my $data = $_[0];
+
+ my $self;
+ if(ref($data) eq 'PDL' ){ # if $data is an object (a pdl)
+ $self = $class->initialize;
+ $self->{PDL} = $data;
+ }
+ else{ # if $data not an object call inherited constructor
+ $self = $class->SUPER::new($data);
+ }
+
+
+ return $self;
+}
+
+####### Initialize function. This over-ridden function is called by the PDL constructors
+sub initialize {
+ my $class = shift;
+ my $self = {
+ PDL => PDL->null, # used to store PDL object
+ someThingElse => 42,
+ };
+ $class = (ref $class ? ref $class : $class );
+ bless $self, $class;
+}
+
+###### Derived Object Needs to supply its own copy #####
+sub copy {
+ my $self = shift;
+
+ # setup the object
+ my $new = $self->initialize;
+
+ # copy the PDL
+ $new->{PDL} = $self->{PDL}->SUPER::copy;
+
+ # copy the other stuff:
+ $new->{someThingElse} = $self->{someThingElse};
+
+ return $new;
+
+}
+
+### Check of over-riding sumover
+### This sumover should be called from PDL->sum.
+### If the result is different from the normal sumover by $self->{SomethingElse} (42) then
+### we will know that it has been called.
+sub sumover{
+ my $self = shift;
+ my ($arg) = @_;
+ if( ! defined $arg){ # no-argument form of calling
+ $arg = $self->SUPER::sumover;
+ return $self->{someThingElse} + $arg;
+ }
+ else{ # one-argument form of calling
+ $self->SUPER::sumover($arg);
+ $arg += $self->{someThingElse};
+ }
+
+
+}
+
+#### test of overriding minmaximum. Calls inherited minmaximum and
+#### Sets the Global variable main::OVERRIDEWORKED if called ####
+sub minmaximum{
+ my $self = shift;
+ my ($arg) = @_;
+ $main::OVERRIDEWORKED = 1; # set the global variable so we know over-ride worked.
+ # print "In over-ridden minmaximum\n";
+ $self->SUPER::minmaximum(@_);
+}
+
+#### test of overriding inner. Calls inherited inner and
+#### Sets the Global variable main::OVERRIDEWORKED if called ####
+sub inner{
+ my $self = shift;
+ my ($arg) = @_;
+ $main::OVERRIDEWORKED = 1; # set the global variable so we know over-ride worked.
+ # print "In over-ridden inner\n";
+ $self->SUPER::inner(@_);
+}
+
+#### test of overriding which. Calls inherited which and
+#### Sets the Global variable main::OVERRIDEWORKED if called ####
+sub which{
+ my $self = shift;
+ my ($arg) = @_;
+ $main::OVERRIDEWORKED++; # set the global variable so we know over-ride worked.
+ # print "In over-ridden which\n";
+ $self->SUPER::which(@_);
+}
+
+#### test of overriding one2nd. Calls inherited one2nd and
+#### increments the Global variable main::OVERRIDEWORKED if called ####
+sub one2nd{
+ my $self = shift;
+ my ($arg) = @_;
+ $main::OVERRIDEWORKED++; # set the global variable so we know over-ride worked.
+ # print "In over-ridden one2nd\n";
+ $self->SUPER::one2nd(@_);
+}
+#######################################################
+package main;
+
+###### Testing Begins #########
+
+$im = new PDL::Derived [
+ [ 1, 2, 3, 3 , 5],
+ [ 2, 3, 4, 5, 6],
+ [13, 13, 13, 13, 13],
+ [ 1, 3, 1, 3, 1],
+ [10, 10, 2, 2, 2,]
+ ];
+
+
+# Check for PDL::sumover being called by sum
+ok($im->sum == 176, "PDL::sumover is called by sum" ); # result will be = 134 if derived sumover
+ # is not called, 176 if it is called.
+
+### Test over-ride of minmaximum:
+$main::OVERRIDEWORKED = 0;
+my @minMax = $im->minmax;
+ok($main::OVERRIDEWORKED == 1, "over-ride of minmaximum");
+
+
+### Test over-ride of inner:
+## Update to use inner, not matrix mult - CED 8-May-2010
+$main::OVERRIDEWORKED = 0;
+my $matMultRes = $im->inner($im);
+ok($main::OVERRIDEWORKED == 1, "over-ride of inner");
+
+### Test over-ride of which, one2nd
+$main::OVERRIDEWORKED = 0;
+# which ND test
+my $a= PDL::Derived->sequence(10,10,3,4);
+# $PDL::whichND_no_warning = 1;
+# my ($x, $y, $z, $w)=whichND($a == 203);
+# ok($main::OVERRIDEWORKED == 2, "whichND test");
+my ($x, $y, $z, $w) = whichND($a == 203)->mv(0,-1)->dog; # quiet deprecation warning
+ok($main::OVERRIDEWORKED == 1, "whichND worked"); # whitebox test condition, uugh!
+
+# Check to see if the clip functions return a derived object:
+ok(ref( $im->clip(5,7) ) eq "PDL::Derived", "clip returns derived object");
+ok(ref( $im->hclip(5) ) eq "PDL::Derived", "hclip returns derived object");
+ok(ref( $im->lclip(5) ) eq "PDL::Derived", "lclip returns derived object");
diff --git a/t/subclass4.t b/t/subclass4.t
new file mode 100644
index 0000000..faaa035
--- /dev/null
+++ b/t/subclass4.t
@@ -0,0 +1,89 @@
+#!/usr/bin/perl
+#
+use PDL::LiteF;
+use Test::More tests => 8;
+
+
+########### Test of Subclassed-object copying for simple function cases ###########
+
+
+## First define a PDL-derived object:
+package PDL::Derived;
+ at PDL::Derived::ISA = qw/PDL/;
+
+sub new {
+ my $class = shift;
+
+ my $data = $_[0];
+
+ my $self;
+ if(ref($data) eq 'PDL' ){ # if $data is an object (a pdl)
+ $self = $class->initialize;
+ $self->{PDL} = $data;
+ }
+ else{ # if $data not an object call inherited constructor
+ $self = $class->SUPER::new($data);
+ }
+
+ return $self;
+}
+
+####### Initialize function. This over-ridden function is called by the PDL constructors
+sub initialize {
+ my $class = shift;
+ my $self = {
+ PDL => PDL->null, # used to store PDL object
+ someThingElse => 42,
+ };
+ $class = (ref $class ? ref $class : $class );
+ bless $self, $class;
+}
+
+###### Derived Object Needs to supply its own copy #####
+sub copy {
+ my $self = shift;
+
+ # setup the object
+ my $new = $self->initialize;
+
+ # copy the PDL
+ $new->{PDL} = $self->{PDL}->SUPER::copy;
+
+ # copy the other stuff:
+ $new->{someThingElse} = $self->{someThingElse};
+
+ return $new;
+
+}
+
+
+#######################################################
+package main;
+
+###### Testing Begins #########
+
+# Create New PDL::Derived Object
+# (Initialize sets 'someThingElse' data member
+# to 42)
+$im = new PDL::Derived [
+ [ 1, 2, 3, 3 , 5],
+ [ 2, 3, 4, 5, 6],
+ [13, 13, 13, 13, 13],
+ [ 1, 3, 1, 3, 1],
+ [10, 10, 2, 2, 2,]
+ ];
+
+# Set 'someThingElse' Data Member to 24. (from 42)
+$im->{someThingElse} = 24;
+
+# Test to see if simple functions (a functions
+# with signature sqrt a(), [o]b() ) copies subclassed object correctly.
+my @simpleFuncs = (qw/
+bitnot sqrt abs sin cos not exp log10 /);
+
+foreach my $op( @simpleFuncs){
+
+ $w = $im->$op();
+
+ ok($w->{someThingElse} == 24, "$op subclassed object correctly");
+}
diff --git a/t/thread.t b/t/thread.t
new file mode 100644
index 0000000..bbfc9d0
--- /dev/null
+++ b/t/thread.t
@@ -0,0 +1,91 @@
+
+use PDL::LiteF;
+
+$|=1;
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+print "1..7\n";
+
+if(1) {
+$a = pdl [2,3,4],[5,6,7];
+$a->doflow;
+
+#print $a;
+# $a->jdump;
+
+$a2 = pdl 1;
+
+$b = $a + $a2;
+ok(1,"$b" eq <<END);
+
+[
+ [3 4 5]
+ [6 7 8]
+]
+END
+
+$c = $b * 2; # This should stay the same flowed structure.
+
+ok(2,"$c" eq <<END);
+
+[
+ [ 6 8 10]
+ [12 14 16]
+]
+END
+}
+
+# Then, the more difficult ways: explicit threading.
+
+# Dims: 3,3,2
+$a = pdl [[0,1,2],[3,4,5],[6,7,8]],[[10,11,12],[13,14,15],[16,17,18]];
+# print $a;
+
+$b = zeroes(3,3);
+$c = $b->thread(0,1);
+$b->make_physical();
+$c->make_physical();
+
+# print "B:\n"; $b->dump(); print "C:\n";$c->dump();
+
+maximum($a->thread(0,1),$c);
+# print "B:\n"; $b->dump(); print "C:\n";$c->dump();
+# print $b;
+
+ok(3,$b->at(0,0) == 10);
+ok(4,$b->at(1,1) == 14);
+
+# print "B:\n"; $b->dump(); print "C:\n";$c->dump();
+minimum($a->thread(0,1),$b->thread(0,1));
+# print $b;
+
+ok(5,$b->at(0,0) == 0);
+ok(6,$b->at(1,1) == 4);
+
+
+# Now, test 'unthread'.
+$a = zeroes(4,5,6);
+$b = $a->thread(1);
+$c = $b->unthread(2);
+
+ok(7,(join ',',$c->dims) eq "4,6,5");
+
+# $b->jdump; $c->jdump;
+
+#### Now, test whether the Perl-accessible thread works:
+
+$a = pdl [[0,1,2],[3,4,5],[6,7,8]],[[10,11,12],[13,14,15],[16,17,18]];
+$b = pdl [2,3,4];
+
+PDL::threadover_n($a,$b,sub {print "ROUND: @_\n"});
+
+# As well as with virtuals...
+
+PDL::threadover_n($a->slice("-1:0,-1:0"),$b,sub {print "ROUND: @_\n"});
diff --git a/t/thread_def.t b/t/thread_def.t
new file mode 100644
index 0000000..7d7ffc1
--- /dev/null
+++ b/t/thread_def.t
@@ -0,0 +1,79 @@
+use PDL::LiteF;
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+sub tapprox {
+ my($a,$b) = @_;
+ my($c,$d);
+ $c = abs($a-$b);
+ $d = max($c);
+ $d < 0.01;
+}
+
+$debug = $debug = 0;
+$PDL::debug = 1;
+print "1..5\n";
+
+$a = sequence(3,4);
+$b = yvals(zeroes(4,3)) + sequence(4);
+$c = $a->xchg(0,1)->slice(':,-1:0');
+
+# not very useful examples but simple and test the essentials
+thread_define 'tline(a(n);b(n))', over {
+ $_[0] .= $_[1];
+};
+
+thread_define 'tassgn(a(n,m);[o] b())', over {
+ # sumover($_[0],$_[1]);
+ $_[1] .= $_[0]->sum;
+};
+
+thread_define 'ttext(a(n=3)), NOtherPars => 1', over {
+ ${$_[1]} .= sprintf("%.3f %.3f %.3f,\n",$_[0]->list);
+ #join(' ',$_[0]->list) . ",\n";
+};
+
+thread_define 'tprint(a(n);b(n)), NOtherPars => 1', over {
+ ${$_[2]} .= "$_[1]";
+};
+
+PDL::Core::set_debugging(1) if $debug;
+tline($c,$b);
+
+print $a;
+print $b;
+
+ok(1,tapprox($c,$b));
+
+$c = ones(5); # produce an error
+eval('tline($a,$c)');
+print "Error was : $@\n";
+ok(2,$@ =~ /conflicting/);
+
+$a = ones(2,3,4)*sequence(4)->slice('*,*,:');
+print $a;
+tassgn($a,($b=null));
+print "$b\n";
+$b->dump;
+ok(3,tapprox($b,6*sequence(4)));
+
+# test if setting named dim with '=' raises error
+# correctly at runtime
+$a = sequence(4,4);
+$text="";
+eval('ttext($a, \$text)');
+print "Error was : $@\n";
+ok(4,$@ =~ /conflicting/);
+
+# test if dim=1 -> threaddim
+print "testing tprint\n";
+$a = sequence(3);
+$b = pdl [1];
+$text = "";
+tprint($a, $b, \$text);
+ok(5,$text eq '[1 1 1]');
diff --git a/t/transform.t b/t/transform.t
new file mode 100644
index 0000000..d23a359
--- /dev/null
+++ b/t/transform.t
@@ -0,0 +1,78 @@
+use PDL::LiteF;
+use Test;
+
+BEGIN {
+ plan tests => 10;
+}
+
+use PDL::Transform;
+
+##############################
+# Simple testing of the map autoscaling
+
+$a = sequence(5,5);
+
+# Identity transformation should be an expensive no-op
+# (autoscaled correctly)
+$b = $a->map(t_identity());
+ok( all($a==$b) );
+
+# Identity transformation on pixels should be a slightly less expensive
+# no-op (no autoscaling)
+$b = $a->map(t_identity,{pix=>1});
+ok( all($a==$b) );
+
+# Scaling by 2 and then autoscaling should be an expensive no-op
+# (scaled, then autoscaled back down)
+$b = $a->map(t_scale(2));
+ok( all($a==$b) );
+
+# Scaling by 2 in pixel coordinates should actually scale the image
+$b = $a->map(t_scale(2),{pix=>1});
+ok(all($b == $a*0.5));
+
+##############################
+# diab jerius' t_scale crash
+# (this is due to a problem with inplace flag handling in PDL <= 2.6; transform works around it)
+
+$a = pdl(49,49);
+$t = t_linear({scale=>pdl([1,3]), offset=>pdl([12,8])});
+$b = pdl( double, 2.2, 9.3);
+print "apply\n";
+$a->inplace->apply($t);
+print "add q\n";
+$a += $q;
+ok(1); # still here!
+
+##############################
+# bad value handling...
+
+if($PDL::Bad::Status) {
+ $a = sequence(5,5);
+ $t1 = t_linear(pre=>[1.5,2]);
+ $t2 = t_linear(pre=>[1,2]);
+
+ $a->badflag(1);
+
+ eval q{$b = $a->map($t1,{pix=>1,method=>'l'});};
+ ok(!$@);
+
+ ok($b->slice("0:1")->isbad->all and $b->slice(":,0:1")->isbad->all and $b->isbad->sum==16, "Bad values happen");
+
+ eval q{$b = $a->map($t1,{pix=>1,method=>'h'});};
+ ok($b->slice("0")->isbad->all and $b->slice(":,0:1")->isbad->all and $b->isbad->sum==13, "Bad values happen with 'h' method");
+
+
+} else {
+ skip(3, "Bad value support not included");
+}
+
+
+use PDL::IO::FITS;
+$m51 = rfits('m51.fits');
+$m51map = $m51->map(t_identity,{method=>'s'}); #SHOULD be a no-op
+ok(all($m51==$m51map));
+
+$m51_coords = pdl(0,0)->apply(t_fits($m51));
+$m51map_coords = pdl(0,0)->apply(t_fits($m51map));
+ok(all(approx($m51_coords, $m51map_coords,1e-8)));
diff --git a/t/trig.t b/t/trig.t
new file mode 100644
index 0000000..ebbcc1e
--- /dev/null
+++ b/t/trig.t
@@ -0,0 +1,26 @@
+# -*-perl-*-
+
+use Test;
+
+BEGIN { plan tests => 4; }
+
+use PDL::LiteF;
+use PDL::Math;
+
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+sub tapprox {
+ my($a,$b) = @_;
+ $c = abs($a-$b);
+ $d = max($c);
+ $d < 0.01;
+}
+
+ok( tapprox(sinh(0.3),0.3045) && tapprox(acosh(42.1),4.43305) );
+ok( tapprox(acos(0.3),1.2661) && tapprox(tanh(0.4),0.3799) );
+ok( tapprox(cosh(2.0),3.7621) && tapprox(atan(0.6),0.54041) );
+
+# inplace
+$a = pdl(0.3);
+$a->inplace->sinh;
+ok( tapprox($a, pdl(0.3045)) );
diff --git a/t/ufunc.t b/t/ufunc.t
new file mode 100644
index 0000000..2b71e53
--- /dev/null
+++ b/t/ufunc.t
@@ -0,0 +1,136 @@
+#!/usr/bin/perl
+#
+# Test some Basic/Ufunc routines
+
+use strict;
+use Test::More tests => 31;
+
+BEGIN {
+ # if we've got this far in the tests then
+ # we can probably assume PDL::LiteF works!
+ #
+ use_ok( "PDL::LiteF" );
+}
+$| = 1;
+
+sub tapprox ($$) {
+ my ( $a, $b ) = @_;
+ my $d = abs( $a - $b );
+ my $check = ($d <= 0.0001);
+ diag "diff = [$d]\n" unless $check;
+ return $check;
+}
+
+# set up test arrays
+#
+my $a = pdl(0,0,6,3,5,0,7,14,94,5,5,8,7,7,1,6,7,13,10,2,101,19,7,7,5); # sf.net bug #2019651
+my $a_sort = $a->qsort;
+my $b = pdl(55);
+my $b_sort = $b->qsort;
+my $c = cat($a,$a);
+my $c_sort = $c->qsort;
+my $d = sequence(10)->rotate(1);
+my $d_sort = $d->qsort;
+my $e = pdl([[1,2],[0,500],[2,3],[4,2],[3,4],[3,5]]);
+my $e_sort = $e->qsortvec;
+
+# Test a range of values
+ok( tapprox($a->pctover(-0.5), $a_sort->at(0)), "pct below 0 for 25-elem pdl" );
+ok( tapprox($a->pctover( 0.0), $a_sort->at(0)), "pct equal 0 for 25-elem pdl" );
+ok( tapprox($a->pctover( 0.9), 17), "pct equal 0.9 for 25-elem pdl [SF bug 2019651]" );
+ok( tapprox($a->pctover( 1.0), $a_sort->at($a->dim(0)-1)), "pct equal 1 for 25-elem pdl" );
+ok( tapprox($a->pctover( 2.0), $a_sort->at($a->dim(0)-1)), "pct above 1 for 25-elem pdl" );
+
+# test for sf.net bug report 2753869
+#
+my $x = sequence(10);
+ok( tapprox($x->pctover(0.2 ), 1.8 ), "20th percential of 10-elem piddle [SF bug 2753869]");
+ok( tapprox($x->pctover(0.23), 2.07), "23rd percential of 10-elem piddle [SF bug 2753869]");
+
+# test for sf.net bug report 2110074
+#
+ok( ( eval { pdl([])->qsorti }, $@ eq '' ), "qsorti coredump,[SF bug 2110074]");
+
+# Test inplace sorting
+$d->inplace->qsort;
+ok(all($d == $d_sort));
+
+# Test inplace sorting with bad values
+$d->setbadat(3);
+$d_sort = $d->qsort;
+$d->inplace->qsort;
+ok(all($d == $d_sort));
+
+# Test inplace lexicographical sorting
+$e->inplace->qsortvec;
+ok(all($e == $e_sort));
+
+# Test inplace lexicographical sorting with bad values
+$e->setbadat(1,3);
+$e_sort = $e->qsortvec;
+$e->inplace->qsortvec;
+ok(all($e == $e_sort));
+
+# test bad value handling with pctover
+#
+SKIP: {
+ skip "Bad value support not compiled", 4 unless $PDL::Bad::Status;
+
+ my $abad = $a;
+ $abad->badflag(1);
+ $abad->inplace->setvaltobad(7);
+ my $agood = $abad->where($abad->isgood);
+ my $allbad = $abad->where($abad->isbad);
+
+ ok( $abad->pctover(0.1) == $agood->pctover(0.1), "pctover(0.1) badvals" );
+ ok( $abad->pctover(0.9) == $agood->pctover(0.9), "pctover(0.9) badvals" );
+ ok( $allbad->pctover(0.1)->isbad, "pctover(0.1) all badvals" );
+ ok( $allbad->pctover(0.9)->isbad, "pctover(0.9) all badvals" );
+};
+
+# test for sf.net but report 3234141 "max() fails on nan"
+# NaN values are handled inconsistently by min, minimum, max, maximum...
+#
+TODO: {
+ local $TODO = "fixing max/min NaN handling";
+
+ my $inf = exp(~0>>1);
+ my $nan = $inf/$inf;
+ my $a = pdl($nan, 0, 1, 2);
+ my $b = pdl(0, 1, 2, $nan);
+
+ ok($a->min == $b->min, "min with NaNs");
+ ok($a->max == $b->max, "max with NaNs");
+}
+
+
+#Test subroutines directly.
+
+#set up piddles
+my $f=pdl(1,2,3,4,5);
+my $g=pdl (0,1);
+my $h=pdl(1, 0,-1);
+my $i=pdl (1,0);
+my $j=pdl(-3, 3, -5, 10);
+
+#Test percentile routines
+#Test PDL::pct
+ok (tapprox(PDL::pct($f, .5), 3), 'PDL::pct 50th percentile');
+ok (tapprox(PDL::pct($g, .76), 0.76), 'PDL::pct interpolation test');
+ok (tapprox(PDL::pct($i, .76), 0.76), 'PDL::pct interpolation not in order test');
+
+#Test PDL::oddpct
+ok (tapprox(PDL::oddpct($f, .5), 3), 'PDL::oddpct 50th percentile');
+ok (tapprox(PDL::oddpct($f, .79), 4), 'PDL::oddpct intermediate value test');
+ok (tapprox(PDL::oddpct($h, .5), 0), 'PDL::oddpct 3-member 50th percentile with negative value');
+ok (tapprox(PDL::oddpct($j, .1), -5), 'PDL::oddpct negative values in-between test');
+
+#Test oddmedian
+ok (PDL::oddmedian($g) == 0, 'Oddmedian 2-value piddle test');
+ok (PDL::oddmedian($h) == 0, 'Oddmedian 3-value not in order test');
+ok (PDL::oddmedian($j) == -3, 'Oddmedian negative values even cardinality test');
+
+#Test mode and modeover
+my $a = pdl([1,2,3,3,4,3,2],1);
+ok( $a->mode == 0, "mode test" );
+ok( all($a->modeover == pdl(3,0)), "modeover test");
diff --git a/t/unpdl.t b/t/unpdl.t
new file mode 100644
index 0000000..b5273e0
--- /dev/null
+++ b/t/unpdl.t
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+
+use PDL;
+use Test::More tests => 1;
+
+my $array = [
+ [[1,2],
+ [3,4]],
+ [[5,6],
+ [7,8]],
+ [[9,10],
+ [11,12]]
+];
+my $pdl = pdl $array;
+
+is_deeply( unpdl($pdl), $array, "back convert 3d");
+
diff --git a/t/vaffine.t b/t/vaffine.t
new file mode 100644
index 0000000..42777a2
--- /dev/null
+++ b/t/vaffine.t
@@ -0,0 +1,23 @@
+
+# Test vaffine optimisation
+
+use PDL::LiteF;
+
+print "1..1\n";
+
+sub ok {
+ my $no = shift ;
+ my $result = shift ;
+ print "not " unless $result ;
+ print "ok $no\n" ;
+}
+
+$x = zeroes(100,100);
+
+$y = $x->slice('10:90,10:90');
+
+$y++;
+
+ok(1, (not $y->allocated) ) ;
+
+
diff --git a/t/xvals.t b/t/xvals.t
new file mode 100644
index 0000000..4f4e0ef
--- /dev/null
+++ b/t/xvals.t
@@ -0,0 +1,72 @@
+use Test;
+BEGIN { plan tests => 4; }
+use PDL::LiteF;
+kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
+
+
+$a0 = zeroes(3,2);
+# $a0->doflow();
+
+ print $a0;
+
+$a1 = $a0->slice('(1)');
+
+ print $a1;
+
+# $a0->dump(); $a1->dump();
+
+# $a1->dump();
+
+$a1 += 4;
+
+# $a1->dump();
+
+ print $a1;
+
+$dummy = PDL::Core::new_or_inplace($a0);
+print $dummy;
+$dummy2 = $dummy->xchg(0,0);
+print $dummy2;
+# $dummy2->dump();
+# $dummy->dump();
+PDL::Primitive::axisvalues($dummy2);
+# $dummy2->dump();
+# $dummy->dump();
+print $dummy2;
+print $dummy;
+
+
+
+# $a1->dump();
+
+# $a0->dump(); $a1->dump();
+
+# print $a1;
+
+# print $a0;
+
+# print $a1;
+
+$a = xvals $a0;
+
+print $a;
+
+ok($a->at(0,0) == 0);
+ok($a->at(1,0) == 1);
+ok($a->at(2,0) == 2);
+ok($a->at(1,1) == 1);
+
+$a = zeroes 5,10;
+
+$b = yvals $a;
+
+$c = $b->copy();
+
+$d = $b-$c;
+
+print "$d,$b,$c";
+
+# print $a;
+
+print "OUTOUT\n";
+
diff --git a/utils/perldlpp.pl b/utils/perldlpp.pl
new file mode 100755
index 0000000..8480cdf
--- /dev/null
+++ b/utils/perldlpp.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+#
+use PDL::NiceSlice;
+
+my $prefile = "";
+
+{
+ local $/;
+ $prefile = <>;
+}
+
+my ($postfile) = &PDL::NiceSlice::perldlpp("PDL::NiceSlice", $prefile);
+
+print $postfile;
+
+__END__
+
+=head2 perldlpp.pl
+
+=for ref
+
+Script to filter PDL::NiceSlice constructs from argument file to STDOUT
+
+=for usage
+
+ perldlpp.pl file-w-niceslice.pm > file-no-niceslice.pm ( unix systems)
+ perl perldlpp.pl file-w-niceslice.pm > file-no-niceslice.pm (win32 systems)
+
+C<perldlpp.pl> is a preprocessor script for perl module files
+to filter and translate the PDL::NiceSlice constructs. The name of
+the file(s) to be filtered is given as argument to the command and the
+result of the source filtering is output to STDOUT.
+
+One use for this script is to preprocess the .pm files installed for
+PDL to remove the requirement for PDL::NiceSlice filtering in the
+core PDL modules. This allows PDL to be used with environments such
+as C<perlapp> that are not compatible with source code filters.
+
+It is planned to add C<Makefile> support for this filter to the PDL
+configure, build, and install process.
+
+=for example
+
+ # For example (using the unix shell):
+ mkdir fixed
+
+ # filter all pm files in this directory into fixed/
+ for pm in *.pm ; do perldlpp.pl $pm > fixed/$pm ; done
+
+ Now the fixed/*.pm files have been PDL::NiceSlice processed
+ and could be used to replace the original input files as
+ "clean" (no source filter) versions.
+
+=cut
+
+1;
diff --git a/win32/INSTALL b/win32/INSTALL
new file mode 100644
index 0000000..f20de2e
--- /dev/null
+++ b/win32/INSTALL
@@ -0,0 +1,140 @@
+Installing on Win32
+===================
+
+For instructions relating to the installation of PDL
+binaries (PPM packages) see the wiki:
+http://sourceforge.net/apps/mediawiki/pdl/index.php?title=Installing_PDL_on_Windows
+
+########################################################################
+########################################################################
+
+If you would like, instead, to build PDL from source,
+that's (generally) fairly straight forward.
+
+Certain parts of PDL (eg PDL::Slatec and PDL::Minuit)
+can't be built without a fortran compiler. In the docs
+that follow I call these parts (somewhat loosely) "the
+fortran stuff".
+The absence of a fortran compiler does not prevent one
+from building PDL - it simply means that the PDL that
+gets built does not include "the fortran stuff".
+
+
+
+To Build from Source
+--------------------
+1) You'll need a make utility and a compiler -
+ dmake/MinGW provides best mileage. To install them onto
+ 32-bit ActivePerl (if you don't already have them) simply:
+
+ ppm install MinGW
+
+ Sadly, this approach won't currently work at all
+ with 64-bit ActivePerl. The best way to get MinGW
+ support with 64-bit ActivePerl is to install one of the
+ "Personal Builds" of the MinGW64 compiler available from
+
+ http://sourceforge.net/projects/mingw-w64/files/Toolchains%20targetting%20Win64/
+
+ and install ExtUtils::FakeConfig from CPAN. But while
+ this is not all that difficult for those who are
+ well acquainted with compilers and perl, it's not as
+ straightforward as most novice programmers would like.
+ (If you need to take this approach and have difficulty
+ getting it configured, asking for help at somewhere like
+ http://www.perlmonks.org is probably your best bet.)
+
+ Another option with ActivePerl (both 32-bit and 64-bit)
+ is to use an appropriate Microsoft Compiler. This may
+ come at the cost of reduced mileage wrt "the fortran
+ stuff" and external libraries support.
+
+ Strawberry Perl (either 32-bit or 64-bit) is probably
+ the easiest path to take, as it comes with a ready-to-go
+ dmake utility and MinGW compiler. And, as of the perl-5.16.0
+ builds, it now includes a fortran compiler. For earlier
+ versions of Strawberry Perl a fortran compiler (suitable
+ for building "the fortran stuff") is readily available
+ as a separate download that can be installed straight
+ over the top of the Strawberry Perl installation. If
+ you have difficulty locating that fortran compiler
+ just ask on the Vanilla Perl mailing list. (See
+ http://lists.perl.org/list/win32-vanilla.html )
+
+2) Then, run:
+
+ cpan -i ExtUtils::F77 # Optional - this is for "the fortran stuff".
+ # It will fail if it can't find a g77 or gfortran
+ # compiler. If using a Microsoft compiler see
+ # "Other Options" below.
+ # Note that failure here does not prevent you from
+ # from building PDL. It just means that the PDL
+ # you build will be missing "the fortran stuff".
+
+ cpan -i PGPLOT # Optional - for PGPLOT graphics support.
+ # This will fail if the pgplot C library can't
+ # be found.
+ # It will also fail if no Fortran compiler is
+ # found---simpler to install using ppm
+ # (see above).
+
+ cpan -i OpenGL # Optional, but recommended - this is for PDL's
+ # TriD support.
+ # Also available via ppm (see above) if there
+ # is any problem building.
+
+ cpan -i PDL # Will first install any missing pre-requisites.
+ # This should succeed, but the PDL that's built
+ # will be missing some features if any of the
+ # above 'cpan -i ..' commands failed.
+
+If it's a developer release that you're trying to install
+then you'll need to specify the full distribution path info,
+e.g.:
+
+ cpan -i CHM/PDL-2.004_997.tar.gz
+
+
+
+Other Options
+-------------
+1) Using an MS compiler and f2c instead of MinGW/g77/gfortran
+
+ The capability of building "the fortran stuff" with an MS
+ compiler, f2c, and associated libraries libi77.lib and
+ libf77.lib probably still exists (but none of the current
+ PDL developers have any knowledge or experience with this option).
+
+ According to mythology, if you want to use f2c you need
+ to edit win32/win32f77.pl to reflect the location of f2c,
+ the libs and the include file f2c.h.
+
+ Then, you'll also need to run:
+
+ perl Makefile.PL F77CONF=win32/win32f77.pl
+
+ instead of simply:
+
+ perl Makefile.PL
+
+
+2) Building a "non-default" (custom) PDL
+
+ If you don't want to accept a (basic) "default" build
+ of PDL, download the source from CPAN, extract it
+ to some location, cd to that location and edit (the
+ self-documenting) perldl.conf accordingly.
+
+ Then run, in succession:
+
+ perl Makefile.PL
+ dmake test
+ dmake install
+
+ This enables building of such extras as:
+ a) PDL::IO::GD (needs the gd C library);
+ b) PDL::GSL::* modules (needs the gsl C library);
+ c) PDL::Graphics::PLplot (needs the plplot C library);
+ d) PDL::GIS::Proj & PDL::Transform::Proj4 (needs the proj4 C library);
+ e) PDL::FFTW (needs the fftw2 C library)
+
diff --git a/win32/win32f77.pl b/win32/win32f77.pl
new file mode 100644
index 0000000..45364a9
--- /dev/null
+++ b/win32/win32f77.pl
@@ -0,0 +1,122 @@
+package F77Conf;
+# a minimal hardcoded config designed for win32
+# using f2c
+use Config;
+
+BEGIN { $F77Conf::done = 0 }
+
+print "Config ",__PACKAGE__->config(),"\n";
+print "Compiler ",__PACKAGE__->compiler(),"\n";
+print "Runtime ",__PACKAGE__->runtime(),"\n";
+print "Trail_ ",__PACKAGE__->trail_() ? "yes" : "no", "\n";
+print "Cflags ",__PACKAGE__->cflags(),"\n";
+
+$F77Conf::libs = "C:\\temp\\f2c\\libf77.lib C:\\temp\\f2c\\libi77.lib";
+# include path and f2c location are buried in the __DATA__ section
+
+__PACKAGE__->mkcompiler;
+
+sub config {
+ return 'win32_f2c';
+}
+
+# change location of f2c libs to match your installation
+sub runtime {
+ $F77Conf::libs;
+}
+
+sub trail_ {
+ return 1;
+}
+
+sub compiler {
+ $myf77 = &mkcompiler;
+ return "$Config{perl} $myf77";
+}
+
+sub cflags {
+ return '';
+}
+
+sub testcompiler {
+ my ($this) = @_;
+ return 1; # for the moment bypass this
+ my $file = "/tmp/testf77$$";
+ my $ret;
+ open(OUT,">$file.f");
+ print OUT " print *, 'Hello World'\n";
+ print OUT " end\n";
+ close(OUT);
+ print "Compiling the test Fortran program...\n";
+ my ($compiler,$cflags) = ($this->compiler,$this->cflags);
+ system "$compiler $cflags $file.f -o ${file}_exe";
+ print "Executing the test program...\n";
+ if (`${file}_exe` ne " Hello World\n") {
+ print "Test of Fortran Compiler FAILED. \n";
+ print "Do not know how to compile Fortran on your system\n";
+ $ret=0;
+ }
+ else{
+ print "Congratulations you seem to have a working f77!\n";
+ $ret=1;
+ }
+ unlink("${file}_exe"); unlink("$file.f"); unlink("$file.o") if -e "$file.o";
+ return $ret;
+}
+
+sub tmpdir {
+ use Cwd;
+ my $dir = exists $ENV{TEMP} ? $ENV{TEMP} : exists $ENV{TMP} ? $ENV{TMP} :
+ cwd; # current working directory as last resort
+}
+
+sub mkcompiler {
+ my $myf77 = tmpdir().'\myf77';
+ unless ($F77Conf::done) {
+ open my $fi, ">$myf77" or
+ die "couldn't open $myf77";
+ use Config;
+
+ print $fi "$Config{startperl}\n";
+ print $fi join('',<DATA>);
+ close $fi;
+ }
+ $F77Conf::done = 1;
+ return $myf77;
+}
+
+1;
+
+
+__DATA__
+
+use Getopt::Std;
+use File::Basename;
+
+getopts('co:');
+$cflags = '/nologo /MD /W3 /GX /O2 /D "WIN32" /D "_CONSOLE" /D "_MBCS" /YX /c /I"c:/temp/f2c"'; # this must include the include path for your f2c.h !
+
+$out = '';
+$out = $opt_o if defined $opt_o;
+
+$fort = $ARGV[0];
+$fort =~ s|/|\\|g;
+
+$out =~ s|/|\\|g;
+$out = "/Fo\"$out\"";
+
+$c = $fort;
+$c =~ s/\.f$/.c/;
+$cdir = '-d' . dirname $c;
+$obj = $fort;
+$obj =~ s/\.f$/.obj/;
+$obj = $opt_o if defined $opt_o;
+$f2c = 'c:\\temp\\f2c\\f2c';
+print "$f2c $cdir $fort\n";
+system "$f2c $cdir $fort";
+die "error during f2c execution, no $c\n" unless -f $c;
+
+# now compile
+print "cl.exe $out $cflags $c\n";
+system "cl.exe $out $cflags $c";
+die "error during cl execution\n" unless -f $obj;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/pdl.git
More information about the debian-science-commits
mailing list